diff options
| author | Manoj Srivastava <srivasta@debian.org> | 2014-04-28 16:31:54 -0700 |
|---|---|---|
| committer | Manoj Srivastava <srivasta@debian.org> | 2014-04-28 16:31:54 -0700 |
| commit | 920d3d552a2535a91f212d7b7b06f0ae48d7228e (patch) | |
| tree | 525dd764440b4c9aef6b8774a6089af1cd254fef | |
vm (8.2.0b-1) unstable; urgency=low
* New upstream release. This has been in Beta for two years now, and
seems to work fine.
# imported from the archive
206 files changed, 99054 insertions, 0 deletions
@@ -0,0 +1,6051 @@ +-*-Text-*- + +This file contains the list of changes up to revision 7.19, developed +by Kyle Jones. For recent changes, please see the `NEWS' file. + + +VM 7.19 released (29 September 2004) + +* New variables: + + vm-stunnel-program-additional-configuration-file +* added vm-mouse-send-url-to-safari to send URLs to Safari under + Mac OS X. +* added docstrings for vm-mime-reader-map-* commands. +* normalized prefix key description layout in vm-mode docstring. +* added some missing MIME commands to menu entries. +* undo change in vm-preview-current-message that required + vm-auto-decode-mime-messages to be non-nil along with + vm-display-using-mime before creating the presentation + copy of a message. It has the unexpected side-effect of + breaking 'D' when vm-auto-decode-mime-messages is nil. + +VM 7.18 released (2 November 2003) + +* New variables: + + vm-default-new-folder-line-ending-type +* vm-mail-internal: use idle timers to run vm-update-composition-buffer-name + instead of post command hooks +* vm-decode-mime-layout: always delete a MIME object button after + doing a type conversion. +* vm-mail-send: bind coding-system-for-write to match the coding + system of mail-archive-file-name (if set) so that mail-do-fcc + writes to the file using the correct line endings. +* vm-make-tempfile-name, vm-make-tempfile: accept optional + second argument 'proposed-filename' which will be used if a + file with that name do not exist in vm-tempfile-directory. + If such a file exists, then a number and a dash will be prepended + to the proposed filename and the number will be incremented until no + such file exists. +* don't use vm-menu-fsfemacs-image-menu unless vm-use-menus is non-nil. +* vm-preview-current-message: require vm-auto-decode-mime-messages to + be non-nil along with vm-display-using-mime before creating the + presentation copy. This helps prevent selection of the presentation + buffer when the user likely needs to do M-x recover-file. + +VM 7.17 released (6 July 2003) + +* New commands: + + vm-create-imap-folder + + vm-delete-imap-folder + + vm-rename-imap-folder +* vm-edit-message-end: try to positoin the cursor in the message + window roughly where it was in the edit window. +* vm-read-imap-folder-name: allow vm-imap-make-session to return + nil without crashing. Also, bind vm-imap-ok-to-ask non-nil so + that vm-imap-make-session will interactively prompt for a + password. +* added menu entry to Folder menu for vm-visit-imap-folder. +* vm-imap-normalize-spec: convert auth method to * instead of the + IMAP folder name. +* vm-imap-get-message-flags: fixed flag retrieval so that it + actually works now. +* vm-handle-file-recovery-or-reversion: find an IMAP spec for the + buffer so that the spec is passed to the 'vm' command instead + of the buffer-file-name. This fixes a wrong-type-argument + error under M-x recover-file when done on a IMAP cache folder. +* tapestry.el: in tapestery-window-edges check for existence of + face-width and face-height in addition to window-pixel-edges. +* search for BASE64/QP encoder/decoder programs and set the + encoder/decoder program variable based on what we find. +* vm-mf-default-action: if object is convertible to a displayble + type mention the conversion that will happen in the action + string. + +VM 7.16 released (26 May 2003) + +* New commands: + + vm-visit-imap-folder + + vm-visit-imap-folder-other-window + + vm-visit-imap-folder-other-frame + + vm-save-message-to-imap-folder +* New variables: + + vm-imap-server-list +* vm-primary-inbox can now be a POP or IMAP mailbox specification. +* vm-mime-set-xxx-parameter: use the parameter name passed in + instead of assuming the name is "charset". The only calls to + this function passed in "charset" as the name, so this bug + wasn't affecting anything. +* vm-decode-mime-encoded-words: do charset conversion if needed. + Forgot to add this back when vm-mime-charset-converter-alist + was added. +* vm-send-mail-and-exit -> vm-mail-send-and-exit in vm-user-agent + definition. +* vm-mail-send-and-exit: dropped first arg requirement since the + argument isn't used anyway. +* compute POP cache filenames based on the POP mailbox spec with + the access method as "pop" and the authentication method and + port as asterisks. This prevents visiting the wrong file if + the user starts accessing a POP mailbox through a different + port or using a different access or authentication method. + Automatically migrate the old cache files to the new scheme as + we go. +* fixed convert -page typos. +* vm-set-redistributed-flag: fourth arg of vm-set-xxx-flag + call corrected to be vm-set-redistributed-flag instead of + vm-set-forwarded-flag. +* IMAP BYE responses are always untagged; changed code to match. + +VM 7.15 released (3 May 2003) + +* Makefile: filter echo's output through tr to avoid CRs + under Cygwin. +* Makefile: Use '>' instead of '>>' on first write to vm-autoload.el + to truncate the file otherwise it will grow each time it is updated. +* vm-mime-attach-message: arrange for forwarded flag of each + attached message to be set when the composition is sent. +* when cropping images call 'convert' with -page to avoid having + some kind of margin tacked on to the image. The strange + margin seems to be applied to GIFs but not JPGs. No idea why. +* fixed some defcustom variable declarations. +* vm-mime-reader-map-save-file: return the file name to which the object + was saved. +* vm-mime-burst-digest: remove blank lines at the beginning of + message/rfc822 bodies in a multipart/digest object, since they + most likely indicate an improperly packed digest rather than a + message with no headers. +* vm-make-tempfile: use vm-octal to clarify file mode setting. +* vm-make-image-strips: when building the script for incremental + display, don't quote the filenames. DJGPP cmdproxy.exe doesn't + interpret single quotes and using double quotes is pointless. + VM's arguments to 'convert' don't need quoting anyway. +* use vm-pop-check-connection to check POP connections before + trying to read data from them. The checker will signal an + error if the connection is closed or the process associated + with the connection has exited. +* use vm-imap-check-connection to check IMAP connections before + trying to read data from them, The checker will signal an error + if the connection is closed or the process associated with the + connection has exited. + +VM 7.14 released (27 March 2003) + +* moved (provide ...) to bottom of .el files. +* Made the vm-undo command undo everything the last command did. + E.g. vm-undo after vm-kill-subject undoes all of the related + deletes instead of just one of them. vm-undo-boundary is only + called from vm-add-undo-boundaries now. vm-add-undo-boundaries + is called from post-command-hook. + +VM 7.13 released (19 March 2003) + +* '(vm-marker -> (vm-marker in vm-mime-parse-entity. + +VM 7.12 released (14 March 2003) + +* vm-pop-make-session: use new stunnel configuration code + introduced in VM 7.11. This was only installed in + vm-imap-make-session previously. +* create MIME layout from plist instead of using a raw vector. + The layout struct is still a vector. +* save original layout when doing a layout conversion so that if + the object needs to be deleted we still ahve the correct object + endpoint in the folder buffer. In the old code the endpoints in + the converted object buffer would be used in the folder buffer + with disastrous results. + +VM 7.11 released (5 March 2003) + +* fixed check for usability of uncompface's -X flag, needed + symbol to be unquoted. +* fixed check for stunnel 4, check for non-zero exit code instead + of string, moved check to the time when stunnel is first run. +* vm-stunnel-configuration-args: fixed reversed v3/v4 logic. +* vm-stunnel-configuration-file: reuse the stunnel configuration + tempfile. +* vm-parse: fourth arg limits the number of matches before + returning. +* vm-parse: after we quit matching add everything after the last + match to the list that is returned, but do this ONLY if the + fourth arg 'matches' was specified. +* compute POP cache filenames based on the POP mailbox spec with + the password as an asterisk. This prevents visiting the wrong + file if the user has the password in the spec and later changes + their password. Automatically migrate the old password-based cache + files to the new scheme as we go. +* vm-pop-make-session: parse POP mailbox spec in a way that + permits colons in the user's password. +* install .el files before .elc files to avoid "source file newer + than compiled file" problems. +* added ] to char class exclusion in mailto spec in vm-url-regexp + to help with MS EXchange's [mailto:foo] syntax. + +VM 7.10 released (5 March 2003) + +* vm-menu-url-browser-menu: add third element to clipboard and + Konqueror entries--- VM's menu code under GNU Emacs requires it. +* treat device-type `gtk' like `x' under XEmacs so that + VM running on GTK-XEmacs will use window system features. +* vm-imap-move-mail: set use-body-peek after retrieving the + CAPABILITY results. (oops) +* Makeflie: default install target now installs the .el files. +* added support for version 4 of stunnel. + +VM 7.09 released (3 March 2003) + +* New variables: + + vm-mime-forward-local-external-bodies +* vm-mime-fsfemacs-encode-composition: if object is in a buffer, + write the buffer out to disk and insert the file contents instead + of copuying buffer to buffer. This avoids the trademark \201 + data corruption. +* vm-su-thread-indent: check for vm-summary-show-threads non-nil + before calling vm-th-thread-indentation. +* vm-summary-compile-format-1: added %(..%) format groups. +* don't forward Content-Length header. +* use results of CAPABILITY command to check for authentication methods + before trying to use them. +* use results of CAPABILITY command to decide whether to use + BODY.PEEK vs. RFC822.PEEK. +* vm-mime-attach-object-from-message: move window point to + beginning of the line after the inserted attachment if the + compositoin buffer is being displayed in a window. +* vm-mime-parse-entity-safe: set c-t-e to "7bit" if it is nil. +* vm-mime-fetch-url-with-programs: erase the work buffer between + tries of various URL fetch programs; this handles the case + where an URL fetcher outputs part of the data and then dies. +* added support for the `fetch' and `curl' URL fetch programs for + message/external-body. +* vm-mime-fsfemacs-encode-composition: call vm-mime-parse-entity + twice for already MIME'd objects. + vm-mime-xemacs-encode-composition similarly modified. +* vm-mime-fsfemacs-encode-composition: don't automatically + base64-encode non-composite non-text objects that already have + MIME headers. Use vm-mime-transfer-encode-layout on them + instead to produce the correct encoding. + vm-mime-xemacs-encode-composition similarly modified. +* dropped support for url-w3 retrieval method. It's interface too + crusty to continue using given the wide availabity of external + programs that do the job. +* vm-mime-display-internal-message/external-body: pulled + retrieval guts out and put into vm-mime-retrieve-external-body. +* added support for simple image manipulations, supported by + Imagemagick's `convert' program. Use mouse button 3 on an + image to see what you can do. +* added Konqueror to vm-menu-url-browser-menu. +* added option to send to the X clipboard to vm-menu-url-browser-menu. + +VM 7.08 released (14 February 2003) + +* New variables + + vm-mime-ignore-missing-multipart-boundary + + vm-url-browser-switches +* vm-mime-attach-object-from-message: decode object after stuffing it + into the work buffer. Two reasons: (1) the composition encoding + code doesn't expect base64 or QP encoded objects and will encode + them again, and (2) we shouldn't trust that the original object was + encoded properly so we should re-encode it since we're sending it. +* vm-mime-display-internal-multipart/alternative: a badly formed + mesage may cause VM to find no message parts so don't call + vm-decode-mime-layout unless best-layout is non-nil. +* vm-su-subject: compress \n[ \t]* to a single space. +* README: Added (vm) to the example VM entry in the 'dir' file. + Apparently the old entry won't work without it anymore. +* vm-mime-parse-entity-safe: error/error MIME layout needs to be + length 16; added a nil. Really need to macroize creation + of the layout object someday. +* vm-recover-file: call recover-file with call-interactively + instead of apply. +* vm-revert-buffer: call revert-buffer with call-interactively + instead of apply. +* vm-decode-mime-layout: check if layout has been converted + and don't try to convert it again if so. +* vm-vs-or, vm-vs-and: check existence of selector function and + signal error if not found. +* vm-md5-region: accept " -" and " *-" before the md5 checksum + because md5sum stupidly produces extra output on some systems. +* vm-imap-end-session: trying reading the response to the LOGOUT + command and see if we start hanging in some environments. +* vm-imap-make-session: don't query for password if the + authentiation method is "preauth". +* vm-visit-virtual-folder: select the message corresponding to + the real message the user used as a basis for this folder, if + there was one. Only honor the vm-jump-* variables if + there's no corresponding real message to use. +* vm-compose-mail: run mail-citation-hook or mail-yank-hooks or + the normal VM default action after yanking the message text. + Always position point in the body before running the yank + action. Don't assume the yank action is smart enough to + position point correctly before inserting the text. +* vm-recognize-imap-maildrops,vm-recognize-pop-maildrops: changed + regexp to allow colons in the last field. +* dropped single quotes in const choice values in defcustom for + vm-mime-alternative-select-method. +* Makefile: use \015 instead of \r with tr due to bug in Solaris + 8's tr which removes r's. +* vm-get-mail-itimer-function: correct use of timer-set-time; set + new firing time to now + vm-auto-get-new-mail instead of now + with a delta of vm-auto-get-new-mail, to avoid having + the timer expire repeatedly in the same second. Similar change + in vm-check-mail-itimer-function which support vm-mail-check-interval. + Similar change in vm-flush-itimer-function which supports vm-flush-interval. +* vm-decode-mime-message: vm-preview-read-messages -> + vm-preview-lines so that message previewing is turned off for + the 'raw' and 'all buttons' displays. +* vm-mail-send: bind select-safe-coding-system-function to nil + during call to mail-send to prevent Emacs from prodding user + about the FCC coding system. The coding system used should be + raw-text and VM sets buffer-file-coding-system to that. +* vm-stuff-attributes: don't clear modflag if stuffing for another + folder, since the information stuffed in that case is missing + the deleted flag if that flag was set. +* use defconst to set vm-faked-defcustom so that the checking + works correctly if vm-vars.el is loaded twice. +* vm-mime-parse-entity: find multipart boundaries, then recurse + into parts. This satisfies the new rule in RFC 2046 that outer + level multipart boundaries be recognized at any level of inner + nesting. +* vm-mime-send-body-to-file: removed let-binding of variable file + which was shadowing the function parameter of the same name. + This should make the function not ask about a filename even + when one has already been provided. +* define vm-folder-history as a function that returns t so that + when it is passed as the sixth arg to read-file-name under + Emacs 21 it does not cause void-function to be signaled when + completion is attempted. +* vm-mime-send-body-to-folder: force conversion to target folder's + type since the user doesn't know what type we're using in the + temp folder. +* vm-save-message: dno't try to honor vm-delete-after-saving if + the folder is read-only. +* vm-delete-duplicate-messages: compute hash on real folder + contents rather than virtual copy. Fixes utterly brokwn + behavior when run on a virtual folder. + +VM 7.07 released (5 June 2002) + +* vm-sort-messages: move first call of + vm-update-summary-and-mode-line out to callers. Threading bonks + if we call it in here. +* vm-assimilate-new-messages: resume calling + vm-update-summary-and-mode-line to clear the decks before + thread sorting. +* vm-toggle-threads-display: start calling + vm-update-summary-and-mode-line to clear the decks before + thread sorting. + +VM 7.06 released (3 June 2002) + +* vm-save-folder,vm-write-file: support vm-default-folder-permission-bits here, + since a folder might be created when it is saved. +* vm-save-message,vm-save-message-sans-headers: use the target + folder's line ending coding system for saves. If the target + doesn't exist use the local system's default. +* vm-write-string: don't set an explicit coding system for writes, + use the ambient value. +* vm-sort-messages: call vm-update-summary-and-mode-line to clear + the decks before sorting. +* vm-mail-internal: UNder FSF Emacs set the coposition buffer + coding system to 'raw-text' which should stop write-region from + question the coding system inside mail-do-fcc. + +VM 7.05 released (10 May 2002) + +* New variables: + + vm-default-folder-permission-bits +* Makefile: added install-el target. +* always set mode-popup-menu; it's value should not depend on the + value of vm-popup-menu-on-mouse-3. +* vm-stuff-folder-attributes: added status messages. +* vm-mime-discard-layout-contents: call vm-set-modflag-of on the + modified message. +* vm-preview-composition: add a newline at end of the preview + buffer if the composition lacks one. +* vm-url-decode-buffer: fixed brain-o; bind case-fold-search to t + instead of nil. +* use new vm-octal function instead of writing out UNIX permission + bits in decimal. +* defcustom :type fixes. +* added "image" to default value of vm-auto-displayed-mime-content-types. +* vm-mime-should-display-internal: ignore Content-Disposition as + it has no bearing on whether an object is displayed internally. +* vm-assimilate-new-messages: build threads very early if + vm-summary-show-threads is non-nil. Don't run + vm-update-summary-and-mode-line before sorting threads--- this + should no longer be necessary thanks to the change to to + vm-set-numbering-redo-start-point. +* vm-set-numbering-redo-start-point: compare message structs + instead of list conses. +* vm-unthread-message: only unthread if threads have been built + in a particular message's buffer. +* vm-thread-list: keep track of the youngest member of a thread. +* vm-sort-compare-thread: sort threads by youngest member instead + of by oldest member. Also sort thread siblings by date instead + of by message-id; sort by messge-id if dates are equal (rare). + +VM 7.04 released (18 April 2002) + +* New commands: + + vm-mime-attach-object-from-message (bound to $ a) +* New variables: + + vm-mime-ignore-composite-type-opaque-transfer-encoding +* fixed problem with a repeated char being displayed after an + X-Face when a non-MIME message is reselected. +* Makefile: remove CRs from the output of make-autoloads. Emacs + when run under Cygwin apparently emits them. +* vm-session-initialization: create gui-button-face under XEmacs + if it does not exist. +* vm-mime-display-internal-text/html: don't use W3 if + vm-mime-use-w3-for-text/html is nil. +* recognize 'mac' as a window system with mouse, image, and + multi-font support (FSF Emacs only). +* put vm-update-composition-buffer-name on post-command-idle-hook + instead of post-command-hook if the idle hook is available for + use. +* vm-menu-vm-menu: added commas to variable refernece so they + would be evalled in the backquote context. +* changed hook defcustoms to use 'hook instead of '(list function). +* vm-read-index-file: do thread sort if necessary since + vm-assimilate-new-messages isn't going to do it. +* default vm-thread-obarray and vm-thread-sort-obarray to non-nil + values so that if they are used as obarrays before + initialization an error will be signaled. +* vm-mime-pipe-body-to-queried-command: prompt with "Pipe object + to command:" instead of "Pipe to command:". +* make sure select-message-coding-system is fbound before overriding + its definition. Apparently early Emacs 20 versions do not define + it. +* vm-imap-read-object: move point past closing double quote to + fix parsing problem that caused VM to hang. +* vm-mime-display-button-xxxx: always insert the button, even we + have no method for displaying the MIME object. + +VM 7.03 released (4 March 2002) + +* fixed defcustom syntax errors. +* minor compiler warning cleanup. + +VM 7.02 released (3 March 2002) + +* New variables: + + vm-uncompface-program + + vm-icontopbm-program +* display X-Faces under Emacs 21 if necessary support programs + are available. +* vm-url-decode-buffer: accept lower cased hex digits in escapes + as per the URL spec RFC. +* map "unknown" charset to iso-8859-1 in + vm-mime-mule-charset-to-coding-alist. +* dropped use of defmacro in many places in favor of defsubst. +* use backquote macro instead of (list ...) in many places since + the old objection of differing backquote syntax between Emacs + versions no longer applies. +* define menu variables using defvar instead of defconst. +* use vm-revert-buffer and vm-recover-file in menus instead of + revert-buffer and recover-file because the menu-enabled form is + global for these symbols and VM's form was overriding the one + in the global Emacs menu. This problem only occur under FSF + Emacs. +* use defcustom instead of defvar for most user customization + variables. + +VM 7.01 released (22 January 2002) + +* New variables: + + vm-mime-use-w3-for-text/html +* new possible values for vm-mime-alternative-select-method: + (favorite ...) and (favorite-internal ...). +* vm-visit-pop-folder: use value of vm-last-visit-pop-folder if + interactive user entered an empty string as the folder. +* vm-mail-send: bind sendmail-coding-system to the binary coding + system and bind mail-send-nonascii to t so that mail-send will + leave us alone. +* redefine select-message-coding-system if it is fbound and we're + running FSF Emacs MULE. It doesn't like no-conversion as a + coding system, so we get it out of the way. +* define vm-image-too-small properly as an error condition. +* vm-scroll-forward-one-line, vm-scroll-backward-one-line: accept + a numeric prefix arg. +* vm-setup-ssh-tunnel: use copy-sequence on vm-ssh-program-switches + to avoid corrupting the list tail with nconc. +* vm-mime-can-convert-0: always return the conversion that + produces an internally displayable type if there is one. + Fallback to the externally displayable type if there is none + that can be displayed internally. +* vm-mime-can-convert-0: don't return a match when the target + type matches the original type. +* vm-mime-display-internal-image-xemacs-xxxx: wrap image extents + around spaces instead of newlines. Adjust newline insertion + code accordingly. Create image strips twice the default font + height to avoid having to match the font ascent value. Don't + use vm-monochrome-face except on XBM images. +* vm-display-image-strips-on-extents, + vm-display-some-image-strips-on-extents: Don't use + vm-monochrome-face except on XBM images. +* support completion-ignore-case variable. +* block interactive use of vm-expunge-pop-messages in a POP + folder. It's meant for folder linked to POP spool files, not + POP folders. +* use display-planes function to determine if Emacs 21 is running + on a "colorful" display. +* put image/xpm ahead of image/pbm in vm-mime-image-type-converter-alist. +* vm-parse-date: find year even if it's at the end of line. + +VM 7.00 released (2 December 2001) + +* New commands: + + vm-visit-pop-folder + + vm-visit-pop-folder-other-window + + vm-visit-pop-folder-other-frame +* New variables: + + vm-pop-folder-alist + + vm-pop-folder-cache-directory +* vm-parse-date: fixed search to allow monthday digits to occur + at the beginning of a string. +* vm-get-mail-itimer-function: skip buffer if bm-block-new-mail + is set. This avoids vm-get-spooled-mail signaling "can't get + new mail until you save this folder" later. Also check for + mail block and folder read-only before doing the expensive file + stat checks. +* vm-get-image-dimensions: don't search for the filename in + the 'identify' output. Apparently 'identify' will sometimes + substitute a different filename than we expect. Instead + just search for a space and then start looking for the image + dimensions from that point. +* moved setting of vm-folder-type in the POP trace buffer from + vm-pop-move-mail to vm-pop-make-session so that all callers get + of vm-pop-make-session get the feature. +* vm-assimilate-new-messages: check for new-messages non-nil + before attempting some things. Makes the function a bit more + efficient if we call it and no new messages are found. +* vm-pop-report-retrieval-status, + vm-imap-report-retrieval-status: report "post processing" if + 'need' value is nil. +* vm-pop-retrieve-to-crashbox -> vm-pop-retrieve-to-target +* vm-imap-retrieve-to-crashbox: use new "post processing" reporting. +* vm-pop-retrieve-to-target: use new "post processing" reporting. +* vm-expunge-pop-messages: record which messages were expunged by + stuffing nil into the car of the cell in vm-pop-retrieved-messages. + At the end strip out all the nils, leaving the data for messages + that we had problems expunging from the POP server. +* in vm-stuff-* functions check for vm-message-list non-nil + instead of vm-message-pointer. +* vm-pop-end-session: check whether the process is still open or + running before attempting to send the QUIT command. Also check + whether the process buffer is still alive before killing it. +* vm-get-spooled-mail: gutted, with most of it going into + vm-get-spooled-mail-normal. Calls vm-pop-synchronize-folder + for folders that use the POP access method. +* vm-session-initialization: when deciding whether to create the + vm-image-placeholder face check for image-type-available-p + being fbound, not vm-image-type-available-p. +* use <vm-image-face> instead of <face> as the name of the faces + used to display images under Emacs 19 and 20. +* vm-mime-display-internal-image-xemacs-xxxx: insert a newline + before the image if point is at the same position as the + beginning of the text portion of the message. Otherwise + there is no visible separation between the image and the + message headers. +* vm-pop-report-retrieval-status, + vm-imap-report-retrieval-status: record in the statblob the fact that some + status was reported. +* vm-pop-stop-status-timer, vm-imap-stop-status-timer: if any + status was reported, do (message "") to clear the echo area. + +VM 6.99 released (25 November 2001) + +* New commands: + + vm-scroll-forward-one-line + + vm-scroll-backward-one-line +* New variables: + + vm-imagemagick-identify-program + + vm-mime-display-image-strips-incrementally +* vm-do-folders-summary: bind default-directory to the directory + names when checking for subdirectories amongst its children + with vm-delete-directory-names. +* vm-get-image-dimensions: use the ImageMagick program 'identify' + instead of 'convert' to get the image dimensions. +* vm-thread-list: set done to t if we've run out of references + and we're not threading by subject (vm-thread-using-subject == + nil). Fixes infloop. +* use the vm-monochrome-image face for image glyphs instead of vm-xface + under XEmacs. +* use a face with a background stipple (vm-image-placeholder) + on the spaces used to display images in FSF Emacs 19. +* vm-display-image-strips-on-overlay-regions: store modified + flag value after the process buffer is selected, otherwise + we're recording the state of the wrong buffer. +* vm-mime-display-internal-image-fsfemacs-21-xxxx: If the image + strip is the same height as the font the image ascent ratio + must match font ascent ratio else the image strips will be + displayed with gaps between them. There's currently no way to + get font ascent information under Emacs 21. Use strips that + are twice the font height and a 50/50 ascent ratio to avoid + this problem. +* vm-make-image-strips: remainder math was wrong; fixed. Use new + remainder math in the sync branch. Use vm-make-tempfile + instead of vm-make-tempfile-name. +* when cutting images into strips give 'convert' an explicit + target type. Otherwise it might choose some unknown new type + that Emacs can't display. +* vm-parse-date: simplified the search for the monthday and the + year, hopefully reducing the problems with confusing 2-digit + years and monthdays. +* vm-thread-list: check and set 'oldest-date property on all the + messages. +* vm-mail-internal: eval the value of mail-signature and insert + the result if its value is not nil, t or a string. Also, if + mail-signature is a string, subject the result to the same + check for a proper signature separator. + +VM 6.98 released (18 November 2001) + +* New variables: + + vm-mime-use-image-strips + + vm-imagemagick-convert-program + + vm-w3m-program + + vm-mime-charset-converter-alist +* inline image display support for Emacs 19 and Emacs 20. +* vm-md5-region: deal with the " -\n" that md5sum appends to the + checksum output when summing stdin. +* vm-edit-message: set buffer-offer-save to t so that if user + types C-x C-c they won't lose their changes in the message edit + session without warning. +* vm-spool-files: remove any directories from vm-spool-files + that we slurped from environmental variables. There was a case + where a user's MAIL variable was set to /var/mail. I don't know + how widespread this practice is. +* when initializing vm-temp-file-directory check for C:\TEMP + before C:\. +* vm-setup-ssh-tunnel: instead of sleeping for a bit and hoping + that's long enough to establish a connection, read some output + from the tunnel before returning so we know that the connection + is established. vm-ssh-remote-c0mmand has to provide the output, + so its default value has been changed to produce output. +* vm-frame-loop: don't reset the starting frame placeholder unless + the starting frame was really deleted. Fixes an infloop when + quitting out of VM and the VM summary is visible in multiple + frames. +* try to use the ImageMagick 'convert' program (if available) to + convert image types that Emacs can't display internally into + images that Emacs can display. +* support the unregistered image/xbm, image/xpm and image/pbm + types, so that we can autoconvert unsupported image types to + these types under an Emacs that's compiled with minimal image + support. +* use w3m to retrieve URLs if specified in vm-url-retrieval-methods. +* make layout cache be the property list of a symbol instead of + an alist. +* use vm-make-tempfile in more places to produce private tempfiles + instead of vm-make-tempfile-name. +* vm-preview-composition: mnuge message separators that appear in + the message body. Use MMDF for the temp folder type. +* all your base no longer are belong to us. + +VM 6.97 released (28 October 2001) + +* New variables: + + vm-mime-require-mime-version-header +* SSL support for IMAP and POP. +* SSH tunnel support for IMAP and POP. +* uninstall toolbar goop from vm-mode-map under FSF Emacs if we're + creating a frame and vm-use-toolbar is nil. +* don't use a heuristic background map in the toolbar image spec + for the MIME icon. +* vm-make-tempfile-name: add a random elemnt to VM's temporary + file name. +* vm-pop-cleanup-region, vm-imap-cleanup-region: don't emit + CRLF->LF status messages. Say something about post-processing + in the normal status message instead. +* vm-mail-to-mailto-url: do session initialization stuff so that + the function can be called from gnuclient. This is apparently + useful for driving VM from a web browser that allows use of an + external mailer. +* vm-mime-encode-composition: undo buffer changes if an + error occurs during encoding. +* rename certain composition buffers on the fly as the recipient + headers change to reflect the new primary recipient(s). +* vm-submit-bug-report: call vm-session-initialization so the all + necessary goop is loaded, rather than doing a few 'require' + calls. This fixed the bug in the VM XEmacs package where + calling vm-submit-bug-report immediately after starting XEmacs + would cause (void-function vm-display) to be signaled. +* vm-th-parent: when extracting the parent message ID from the + In-Reply-To header, use the longest ID found, instead of the + first ID found. Store the result in the references slot in the + message struct, since that slot must be empty otherwise we + would be ignoring In-Reply-To. +* vm-thread-list: remove the clock skew loop-recovery-point + heuristic; seems to cause more breakage than it fixes. +* vm-mime-display-internal-image-fsfemacs-xxxx: use a unibyte buffer + as a work buffer when unpacking an image file. Apparently needed + to avoid the evil \201 corruption under Emacs 21. +* accept 'name' parameter as suggested filename for all MIME + types. Old broken software that sends this stuff will never go + away and complaints about it will never end. +* default vm-use-lucid-highlighting non-nil only if (require + 'highlight-headers) doesn't signal an error. +* vm-md5-region: call the MD5 program directly instead of using + sh -c. +* vm-pop-md5: call the MD5 program directly instead of using + sh -c. +* vm-check-for-spooled-mail, vm-get-spooled-mail: bind + case-fold-search to nil for comparisons against vm-recognize-*. +* vm-preview-current-message: do less work if the user will never + see the message in the previewed state. +* vm-preview-current-message: just MIME decode the headers rather + than the whole message if vm-preview-lines == 0. +* vm-mime-convert-undisplayable-layout: check exit status of + command and if non-zero return nil. Fixed all callers to deal + with this new reality. + +VM 6.96 released (5 September 2001) + +* print-autoloads: handle fset calls. There are paths through + the code that reach functions that are to be defined by fset + but lack autoload definitions. print-autoloads now creates + autoload definitions for them. +* vm-mime-encapsulate-messages: pluralization fix in MIME digest + preamble. Don't output "messages" if there's only one message in + the digest. +* vm-display-startup-message: update copyright date. Use + \251 under XEmacs to show the c-in-circle copyright glyph. + Can't rely on FSF Emacs being setup to display it. +* vm-mime-display-internal-application/octet-stream: honor + setting of vm-mime-delete-after-saving. +* vm-imap-move-mail: don't emit warning messages if BODY.PEEK + fails--- no one cares. Don't retry BODY.PEEK after it fails + the first time, it will never work. Use RFC822.PEEK henceforth + within this IMAP session. +* vm-toolbar-support-possible-p: check whether the variable + tool-bar-map is bound. Apparently tool-bar-mode is fboun + even when there is no toolbar support (e.g. under Windows). +* moved guts of vm-discard-cached-data to vm-discard-cached-data-internal. +* vm-mime-attach-message: corrected prompt in the "attach from + other folder" case. +* vm-summary-sprintf: decode encoded words in the final string if + we're not producing a tokenized result and vm-display-using-mime + is not nil. +* vm-mail-to-mailto-url: support full RFC2368 mailto URL spec. +* vm-pop-send-command: use one process-send-string call instead + of two, which should saves some packet overhead at the + expense of more string consing. +* vm-imap-send-command: use one process-send-string call instead + of three, which should saves some packet overhead at the + expense of more string consing. +* vm-imap-send-command: allow sending a string without a tag. + Also allow sending a string with a caller specified tag. +* vm-imap-make-session: don't send a tag with the CRAM-MD5 + challenge response. +* vm-do-summary: reuse the mouse-track overlays if possible, + instead of generating a new one each time. The old ones + apparently are never reclaimed by Emacs until the buffer is + killed and degrade editing performance in that buffer. +* vm-imap-ask-about-large-message: require simple "OK" response + after fetching headers instead of "OK FETCH". The "FETCH" part + may never come and isn't required. +* vm-save-folder: sweep though virtual folder associated with the + real folder and set their buffer modified flags to nil if they + are none of their real folders are modified. +* vm-thread-list: don't allow the first and last element of a multielement + thread list to be the same message-ID. This is a thread loop that + previously was previously undetected. +* vm-thread-list: remember the position in the thread list where + we first threaded using subject information and reset the + thread list to that point if we encountered a message ID we've + seen before. This is a heuristic to try to trim off + parents-by-subject that are only parents due to clock skew. + +VM 6.95 released (23 July 2001) + +* New variables: + + vm-mime-attachment-auto-suffix-alist +* vm-guess-digest-type: require a line consisting of 30 dashes in + addition to the 70 dashes line before guessing RFC 1153. +* vm-md5-region: add third arg that prevents re-search-forward + from signalling an error if it fails. +* vm-toolbar-update-toolbar: don't use the 'getmail' icon + as the helper button if 'getmail' is already on the toolbar. +* vm-toolbar-update-toolbar: don't use the 'mime icon + as the helper button if 'mime' is already on the toolbar. +* vm-mime-attach-message: if invoked on marked messages (C-c C-v + M N C-c C-m) attach the marked messages in the parent folder as + a digest. +* vm-mail-mode-remove-tm-hooks: remove global TM/SEMI hooks from + mail-setup-hook and mail-send-hook if vm-send-using-mime is + non-nil. Previously VM tried to remove the hooks locally but + that doesn't work. +* fixed negative Content-Length computation problem + - vm-find-leading-message-separator, + vm-find-trailing-message-separator: new type 'baremessage + means go to point-max. + - vm-pop-retrieve-to-crashbox, vm-imap-retrieve-to-crashbox: use + 'baremessage as old type during header conversion. Narrow to + region around message during this conversion so that folder + traversal functions can safely go to point-max without moving + past the end of the message. +* vm-pop-make-session, vm-imap-make-session: don't sleep for 2 + seconds after reporting a bad password unless the function was + called synchronously, i.e. not from a timer. +* vm-check-mail-itimer-function, vm-get-mail-itimer-function, + vm-flush-cached-data: when traversing the buffer list, check + whether a buffer is still alive before selecting it. Because + the loop calls input-pending-p, a timer or process-filter could + have killed one of the buffers. +* vm-delete-duplicate: remove duplicate addresses case + insensitively This is still sort of wrong, in that the only + the right hand side of the address should be treated this way. + But doing the right thing is hard. +* vm-mime-display-internal-image-xemacs-xxxx: make the image + extent be 'start-open' so that it is moved forward when text is + inserted at its position. This fixes the image doubling + problem if a mssage containing only an image is previewed with + vm-mime-deocde-for-preview set non-nil. +* vm-narrow-for-preview: added kludge to prevent images and button + art from being displayed at the edge of a preview cutoff during + MIME decode-for-preview. Everything beyond the cutoff is shifted + forward one character during MIME preview. (XEmacs only for now, but + might be needed for FSF Emacs 21). +* vm-mime-encapsulate-messages, vm-rfc934-encapsulate-messages, + vm-rfc1153-encapsulate-messages: do a better job of protecting + MIME headers. Sort the MIME headers to the top of the message + then skip past them before applying the user's header filter + variables. + +VM 6.94 released (9 July 2001) + +* in the defconst of vm-menu-mime-dispose-menu, check whether a + non-string s-expression is allowed as a menu element name + before trying to use one. Versions of XEmacs prior to 21.4 + don't allow expressions as item names. + +VM 6.93 released (23 June 2001) + +* New variables: + + vm-folder-file-precious-flag +* added CRAM-MD5 as an authentication method for IMAP. +* vm-su-do-date: interpret 2-digit years in the RFC-822 matching + case as 20XX if year starts with 0-6. +* vm-rfc1153-or-rfc934-burst-message: skip spaces in addition to + newlines that occur after a separator line. A digest has been + observed with that kind of deformity. +* treat enable-local-eval as we do enable-local-variables--- always + bind it to nil. +* vm: don't bind vm-auto-decode-mime-messages non-nil during + initial message preview if it is nil. +* vm-mime-display-internal-text/html: dropped (sleep-for 2). No one cares + enough about the "Need W3 to inline HTML" message to wait 2 + seconds afterward. +* added menu entry to allow MIME objects to be converted to + another type and displayed. The new type is determined by + vm-mime-type-converter-alist. +* added koi8-r to vm-mime-mule-charset-to-coding-alist (XEmacs only). +* vm-pop-read-list-response: check for nil return of + vm-pop-read-response before using return value. +* vm-pop-read-stat-response: check for nil return of + vm-pop-read-response before using return value. +* vm-encode-coding-region: use unwind-protect to make sure (well + more likely) that the work buffer always gets killed if it has + been created. +* vm-decode-coding-region: use unwind-protect to make sure (well + more likely) that the work buffer always gets killed if it has + been created. +* vm-mime-convert-undisplayable-layout: put object buffer on + garbage list sooner to make rarer the situation where the + buffer never gets deleted. +* Makefile: remove function definition of vm-its-such-a-cruel-world + after it is run. +* vm-md5-region: if vm-pop-md5-program exits non-zero, signal an + error. Also if the work buffer is not at least 32 bytes long, + signal an error. This prevents naive callers from assumption all is well + and using a possibly empty string as an MD5 hash. +* vm-md5-region: check the MD5 digest returned for non-hex-digit + characters and signal an error if any are found. +* vm-get-file-buffer: use find-buffer-visiting if it is fbound. +* vm-build-threads: fixed loop that removed child messages from a + parent when better information about a child's parent is found. + Previously the loop attempted to remove the same message from + the parent over and over. +* vm-build-threads: gather thread data using References and + In-Reply-To for all messages before using the Subject header. + This helps prevent the case where References says A is the + parent of B but because of clock skew B is older than A, which + can lead to B being considered the parent of A if A and B have + the same subject and vm-thread-using-subject is non-nil. + +VM 6.92 released (11 March 2001) + +* vm-imap-check-mail: throw to 'end-of-session instead of 'done. + Fixes problem of vm-spooled-mail-waiting not being set. +* vm-su-do-recipients: If there is no To or Apparently-To header, + use Newsgroups if available. +* vm-mime-display-external-generic: use a unibyte temp buffer for + base64 decoding if using FSF Emacs MULE. Otherwise our old + friend \201 crashes the party. +* vm-mime-find-leaf-content-id-in-layout-folder: add missing + layout argument to vm-mime-find-leaf-content-id. +* vm-mime-parse-entity: fixed regexps that match an empty content + description so that they match descriptions that only contain + spaces. +* vm-su-do-date: make +/- mandatory in the numeric timezone spec. + First digit of numeric timezone spec must be 0 or 1. +* vm-fill-paragraphs-containing-long-lines: ignore errors generated + by fill-paragraph. +* moved the code that catches the font-lock search bound error + from the XEmacs MIME composition encoder to the FSF Emacs + encoder. +* vm-mime-charset-internally-displayable-p: allow variable + vm-mime-default-face-charsets to apply to MULE-enabled Emacs + and XEmacs. + +VM 6.91 released (1 March 2001) + +* vm-mime-can-display-internal: check charset to verify that we + can display it when checking text/html. +* vm-auto-archive-messages: hide value of last-command when calling + vm-save-message. +* vm-mime-find-leaf-content-id: removed second arg in call to + vm-mm-layout-id since it only accepts one argument. +* vm-mime-transfer-encode-region: \\n -> \n in armor-dot check + regexp string. +* vm-mime-parse-entity-safe: dropped (sleep-for 2). No one cares + about syntax errors. +* vm-mime-base64-encode-region: if call to base64-encode-region + fails with wrong-number-of-arguments error call it with only + two args and do the B encoding cleanup separately. +* vm-mime-base64-decode-region: don't use the FSF Emacs base64 + decoding function, since it fails completely if it encounters + characters outside of the BASE64 alphabet. +* vm-mime-attachment-auto-type-alist: added the usual PDF, + Quicktime and Excel file extensions. +* vm-imap-move-mail: trying using obsolete RFC822.PEEK if + BODY.PEEK fails. +* vm-imap-retrieve-to-crashbox: support use of obsolete RFC822.PEEK. +* vm-so-sortable-datestring: use vm-timezone-make-date-sortable + instead of the bare timezone-make-date-sortable, which is less + capable of parsing badly formed Date headers. +* vm-mime-convert-undisplayable-layout: save the content type + parameters from the old type and give them to the new type. +* all your base are belong to us + +VM 6.90 released (9 January 2001) + +* vm-compose-mail: Use apply instead of funcall to call the yank + action. We aren't passing a list of arguments to the function. +* vm-mark-or-unmark-messages-same-author: compare author + addresses case insensitively. +* vm-emit-eom-blurb: ignore case when matching against + vm-summary-uninteresting-senders to match what + vm-su-interesting-from does. +* vm-mime-display-internal-text/html: use 'message' to display + any errors encountered. +* vm-mime-display-internal-text/enriched: use 'message' to display + any errors encountered. +* vm-yank-message: call vm-decode-mime-encoded-words in the correct buffer. +* default value of vm-auto-center-summary changed from nil to 0. + +VM 6.89 released (22 December 2000) + +* vm-yank-message: MIME decode the headers of the yanked message + if vm-display-using-mime is non-nil. +* vm-forward-message: if MIME forwarding, switch the buffer + containing the attached message to be multibyte to avoid the + appearance of our old friend \201 when the buffer contents are + inserted into the composition buffer. (FSF Emacs 20 only). +* vm-do-folders-summary: count messages in folders that lack + entries in the folders summary database using vm-grep-program. +* vm-do-folders-summary: ignore index files in the folder directories. +* vm-update-folders-summary-highlight: use intern-soft instead of + intern, since the symbol may not be present in the obarray. +* vm-mark-for-folders-summary-update: check for killed summary + before selecting folders summary buffer. +* vm-emit-eom-blurb: bind vm-summary-uninteresting-senders-arrow + to "" around call to vm-summary-sprintf. +* Makefile: Start using $(prefix) to be more GNUish. Try to + create the installation directories if they don't exist. +* vm-modify-folder-totals: wrong cells in the list were being + updated; fixed. +* vm-mime-run-display-function-at-point: return result of calling + the display function because callers expect it. This wasn't + happening in the FSF Emacs part of the conditional. + +VM 6.88 released (11 December 2000) + +* New variables: + + vm-folders-summary-mode-hook + + vm-grep-program + + vm-mmosaic-program + + vm-mmosaic-program-switches +* vm-determine-proper-charset: don't use MULE rules if operating + in a unibyte buffer. The non-MULE rules work better in that + case. Dropped use of vm-with-multibyte-buffer. +* use BODY.PEEK instead of RFC822.PEEK in IMAP message fetches, + since RFC822.PEEK has been made obsolete in RFC 2060. +* not decoding for preview if vm-preview-lines == 0 was a + mistake, as the header might still need decoding, so this + change was reversed. +* allow 8-bit chars in IMAP atoms. Microsoft Exchange emits them, + resistance is futile. +* keep IMAP trace buffer if a protocol error occurs. Code for + this was partially done, it's finished now. +* improved folders summary, new folders summary format specifier %s. +* vm-move-to-xxxx-button: fixed code assumption that buttons were + contiguous. +* qp-encode.c: get rid of non-constant initializers (nextc = + getchar()) to avoid warnings from Sun's compiler. +* vm-toolbar-fsfemacs-install-toolbar: "mime" now works in + vm-use-toolbar under FSF Emacs. +* don't display verbose "Waiting for POP QUIT" message unless + getting mail interactively. +* make vm-thread-loop-obarray a larger hash table. +* use vm-global-block-new-mail to prevent async reentrance into the POP + and IMAP code. Use vm-block-new-mail to prevent command-level + mail retrieval buffer locally. +* vm-check-mail-itimer-function: always check for mail. Now that + we're updating the folders summary we need to do the check even + if we know there is new mail from a previous check, so that the + summary is kept up to date. +* removed Mule menu from VM's commandeered menubar (FSF Emacs 20 only). +* C-c C-p in composition buffer binding changed from + vm-mime-preview-composition to vm-preview-composition. +* vm-sort-messages: fixed paren problem that broke non-thread + sorting while threading was enabled. +* vm-assimilate-new-messages: don't run vm-arrived-message-hook + and vm-arrived-messages-hook if being called for the first time + in this folder. Old check for this didn't work properly, so + now first-time status is passed in as a parameter. +* vm-emit-eom-blurb: use vm-summary-sprintf on full name so that + it is MIME decoded if necessary. +* vm-check-for-spooled-mail: don't skip remaining spool files + once we know there is mail waiting. We still need to retrieve + data for the remaining folders for the folders summary. + +VM 6.87 released (29 November 2000) + +* New commands: + + vm-delete-duplicate-messages +* vm-toolbar-fsfemacs-install-toolbar: fix logic reversal that + caused Emacs 21 toolbar to never be installed. +* reviewed coding-system-for-{read,write} usage everywhere and + brought it into line with current theory of how Emacs/MULE + works. coding-system-for-write is bound in more places because + in the Emacs 21.0.91 pretest, write-region, even when called + non-interactively, will query the user if it doesn't think the + buffer's coding system can be used to safely write out the + data. +* vm-mail-to-mailto-url: vm-url-decode -> vm-url-decode-string. +* vm-move-to-xxxx-button: next-etent-change -> next-extent-change. +* vm-move-to-xxxx-button: dropped point movement outside the loop + as it wasn't needed and actually broke things. +* vm-add-or-delete-message-labels: don't cycle through the + message list if there are no labels to act upon. +* vm-add-or-delete-message-labels: return a list of labels that were + rejected because they are not known. vm-add-existing-message-labels + expects this and it apparently hasn't been done in a long time. +* call base64-encode-region and base64-decode-region only if they + are subrs. +* vm-check-for-spooled-mail: save-excursion around the guts + of the let form that binds vm-block-new-mail to avoid the + restore-the-wrong-local-variable bug. +* vm-get-spooled-mail: save-excursion around the guts of the let + form that binds vm-block-new-mail to avoid the + restore-the-wrong-local-variable bug. +* vm-determine-proper-content-transfer-encoding: changed search + for non-ASCII chars from [\200-\377] to [^\000-\177] because FSF + Emacs 20 re-search-forward does not match 0200-0377 unibyte + chars in multibyte buffers. They only match in unibyte buffers. +* vm-unbury-buffer: wrapped call to switch-to-buffer in condition-case + in case it fails (dedicated window, minibuffer window) + +VM 6.86 released (26 November 2000) + +* New variables: + + vm-pop-read-quit-response (default value is t) +* reversed coding system changes introduced in VM 6.85 in + vm-line-ending-coding-system and vm-binary-coding-system, as + they were wrong. +* vm-minibuffer-complete-word: use minibuffer-prompt-end + function to determine where the prompt ends instead of + previous-property-change. +* vm-toolbar-fsfemacs-install-toolbar: use xbm images if the + display is not color-capable. +* vm-toolbar-fsfemacs-install-toolbar: don't use "mime-colorful" + as a basename when looking for an XBM for a non-color display. +* vm-toolbar-make-fsfemacs-toolbar-image-spec: use ":mask + heuristic" to make the toolbar pixmap/bitmap backgrounds track the + background of the tool-bar face. +* vm-mime-base64-encode-region: when using base64-encode-region + wrap it in a condition-case to catch errors and resignal all + errors with vm-mime-error. +* vm-mime-base64-decode-region: when using base64-decode-region + wrap it in a condition-case to catch errors and resignal all + errors with vm-mime-error. +* getmail-xx.xbm was a PBM file. No one noticed. Fixed. +* check for vm-fsfemacs-p before using overlay-put, overlay-get, + etc. in the extent/overlay compatibility functions. We can't + use the overlay emulation package's functions because VM needs + the functions to be able to handle plain extents also. +* vm-mime-fsfemacs-encode-composition: catch the "Invalid search + bound (wrong side of point)" error that font-lock can throw and + ignore it. +* vm-set-window-configuration: delete windows that are over + explicitly named buffers. This is meant as an aid to BBDB + users who might want to include a BBDB window in a + configuration but don't want the window to appear unless the + displayed buffer is non-empty. +* install the toolbar only once under FSF Emacs, since it will + appear everywhere vm-mode-map is used thereafter. +* panic buffoon's color changed from rgb:ff/7f/ff to rgb:e1/92/46 (tan). + +VM 6.85 released (23 November 2000) + +* New commands: + + vm-move-to-previous-button + + vm-move-to-next-button +* vm-end-of-message, vm-beginning-of-message: wrap vm-save-buffer-excursion + around the part of the function that does window selection since that can + change the current buffer. vm-narrow-to-page was noticing the + buffer change to the summary; vm-message-pointer was suddenly nil. +* made vm-create-virtual-folder, and by effect its callers, honor + vm-next-command-uses-marks. +* vm-apply-virtual-folder: honor vm-next-command-uses-marks. +* added no-suggested-filename arg to vm-mime-attach-file and + vm-mime-attach-object. +* vm-preview-current-message: don't decode for preview unless + vm-preview-lines is non-nil, as this is extra unnecessary work. +* vm-pop-end-session: read POP QUIT response; Microsoft Exchange + apparently will sometimes not expunge if we close the connection + without reading the response. +* set reasonable default value for vm-folders-summary-directories. +* vm-preview-current-message: don't block display of any type + other than message/external-body and externally displayed types + when supporting vm-mime-decode-for-preview. +* internal image support for v21 Emacs. +* toolbar support for v21 Emacs. +* Makefile: for 'make autoload' compile vm.el into vm.elc instead + of writing require statements directly into it, otherwise Emacs + 21 bitches. +* vm-binary-coding-system was returning no-conversion under FSF + Emacs, which is wrong--- it now returns raw-text. +* vm-minibuffer-complete-word: In Emacs 21, during a minibuffer + read the minibuffer contains the prompt as buffer text and that text + is read only. So we can no longer assume that (point-min) is + where the user-entered text starts so we must compute this + location. Calling previous-property-change is a kludge but it + seems to be the only thing that does the job. +* vm-mime-display-internal-message/external-body: for Emacs 21, + use a multibyte work buffer, otherwise the evil \201s appear + in the tempfile and utterly corrupt it. Also set + buffer-file-coding-system in the work buffer, since + write-region may be called in it later. +* dropped use of vm-with-unibyte-buffer. I don't think it is + needed any longer. +* vm-assimilate-new-messages: only run vm-arrived-messages-hook + if a new message has arrived. +* use a normal keymap instead of a sparse keymap for vm-mode-map. + +VM 6.84 released (15 November 2000) + +* vm-submit-bug-report: mail-user-agent should be a symbol not a + list--- fixed. +* vm-keep-some-buffers: kill a buffer even if it is modified + if it's value of buffer-offer-save is nil. +* vm-pop-make-session: if APOP authentication fails, remove the + saved password just like we do for PASS authentication. +* new variable and function vm-xemacs-file-coding-p tells whether + XEmacs was compiled with --with-file-coding=yes, which means + several things need to be treated the same as if MULE were + enabled. +* when deciding whether to call set-buffer-file-coding-system + just check fboundp instead of xemacs-mule-p or fsfemacs-mule-p. + This should help XEmacs-NT+file-coding. + +VM 6.83 released (14 November 2000) + +* New variables: + + vm-page-continuation-glyph + + vm-folders-summary-database + + vm-folders-summary-directories + + vm-folders-summary-format + + vm-frame-per-folders-summary +* New commands: + + vm-folders-summarize +* Makefile: moved vm-version.el to the beginning of the SOURCES + list so that "make debug" doesn't crash on unbound variables. +* vm-narrow-to-page: move to beginning of line only if we're not + at end of buffer. If we're at end of buffer, it usually means + forward-page failed to find a page delimiter and crashed into + point-max. +* vm-scroll-forward: after calling vm-narrow-to-page move to + either the new window start or the start of the text section of + the message, whichever is the greater buffer position. This + fixes the semi-broken backward paging over page delimiters and + fixed the broken forward scrolling over page delimiters after + scrolling backward through the same message. +* vm-narrow-to-page: use overlay/extent to display a "...more..." + type string at the end of a page. +* vm-scroll-forward: do (sit-for 0) to refresh display early so that + the end of message notice appears when it should when scrolling + over page delimiters. +* vm-mime-display-internal-text/html: insert placeholder + character before end marker before calling w3-region to avoid + end == start marker squashing problem. +* vm-submit-bug-report: reporter-submit-bug-report apparently + dropped support for the variable reporter-mailer in favor of + using mail-user-agent instead. Bind this variable as well the + old one so bug reporters can send attachments. +* vm: don't decode MIME if recover-file is likely to happen, + since recover-file does not work in a presentation buffer. +* vm-mail-to-mailto-url: decode URL before handing it to + vm-mail-internal. +* vm-mime-compile-format-1: removed code to decode and reencode + MIME encoded words, since these aren't needed in MIME button + format tags. +* give up on disabling font-lock around attachments. font-lock + users will just have to lose, because I don't see a clean way + to do it. Removed futile atemptes from code. +* vm-preview-current-message: don't MIME decode for preview if + vm-preview-lines == 0 since it's pointless in that case. +* vm-select-folder-buffer: make folder buffer selection + mandatory, generate error otherwise. New function + vm-select-folder-buffer-if-possible is to be used for + situations where buffer selection is not mandatory. +* moved vm-totals computation out of vm-emit-totals-blurb and into a + separate function. +* vm-expunge-folder: increment vm-modification-counter in the + real folder buffers to invalidate vm-totals. + +VM 6.82 released (10 November 2000) + +* New variables: + + vm-url-retrieval-methods + + vm-wget-program + + vm-lynx-program +* access-type=url support added for message/external-body. +* vm-visit-virtual-folder: call vm-fsfemacs-nonmule-display-8bit-chars. + This needs to be done for the same reasons as it needs to be done + in 'vm'. +* provide keymap prompt for # and ## (XEmacs only, unfortunately). +* vm-truncate-string: fixed to once again support a negative width + argument, even if we're using char-width. +* vm-mime-get-xxx-parameter: don't inadvertently truncate parameter + value at newline. +* vm-string-width: don't use Emacs 20's string width--- it + ignores buffer-display-table and thereby hoses the summary. + Using char-width on each character and summing the reuslt + gives the answer we want. +* vm-decode-coding-region: compute old region size based on the + source buffer rather than the work buffer, since they might + have different unibyte/multibyte status. +* vm-decode-coding-region: reverse order of insert/delete + sequence at the end to delete then insert. It fixes the + parsing of this header + From: "Cajsa Ottesj=?ISO-8859-1?B?9g==?=" <cajsao@ling.gu.se> + Apparently if ö is inserted before \366 in a multibyte buffer, + Emacs believes that the two characters are one character and + moves point forward past the \366. This loses because the \366 + needs to be deleted. +* vm-flush-cached-data: stuff last-modified, pop-retrieved and + imap-retrieved lists. +* vm-pop-move-mail: if we retrieved something, call vm-stuff-pop-retrieved. +* vm-imap-move-mail: if we retrieved something, call vm-stuff-imap-retrieved. +* vm-mime-display-internal-text/html: pass charset name to + vm-mime-charset-decode-region instead a layout. +* vm-mime-display-internal-text/enriched: pass charset name to + vm-mime-charset-decode-region instead a layout. +* vm-menu-mime-dispose-menu: convert extent or overlay into a + layout before using layout functions on it. +* vm-mime-send-body-to-folder: put leading and trailiing message + separators around the message in the temp folder. +* vm-mime-send-body-to-folder: clear buffer-modified flag before + entering vm-mode. +* call the mime-reader-map save functions from the dispose menu + instead of the low-level functions, so that + vm-mime-delete-after-saving is honored. +* vm-mime-can-display-internal: add 'deep' flag, which indicates + whether to check the subobject of a message/external-body + object. +* vm-mime-display-internal-multipart/alternative: use the new 'deep' + flag of vm-mime-can-display-internal. + +VM 6.81 released (7 November 2000) + +* vm-menu-mime-dispose-menu: take car of vm-mm-layout-type to get + type. (oops) +* vm-mime-display-internal-text/html: set end position after + inserting the MIME body (oops). +* vm-mime-display-internal-text/html: charset decode the body + after inserting it. +* vm-mime-display-internal-text/enriched: set end position after + inserting the MIME body (oops). +* vm-mime-display-internal-text/enriched: charset decode the body + after inserting it. + +VM 6.80 released (6 November 2000) + +* vm-scroll-forward: set window start to point-min if we just + exposed a hidden message window and we're transitioning frmo + previewing to showing a message. This fixes the buggy window start + marker drift caused by replacing unibyte chars with multibyte + chars (typically with decode-coding-region). +* vm-fsfemacs-nonmule-display-8bit-chars: dropped use of + standard-display-european and its attendant disp-table.el + in favor of directly creation and manipulation of display + tables. +* vm: call vm-fsfemacs-nonmule-display-8bit-chars to rectify + 8-bit char width conflct between summary and folder buffers and + to display undeclared 8-bit chars "properly" in the folder buffer. + +VM 6.79 released (5 November 2000) + +* vm-make-presentation-copy: force use of multibyte presentation + buffer. Otherwise non-ASCII characters won't be displayed + properly. (FSF Emacs 20 only). +* vm-summarize: force use of multibyte summary buffer. (FSF Emacs 20 only). +* vm-truncate-string: use char-width to determine a character's + display width when truncating a string. +* use vm-truncate-roman-string instead of vm-truncate-string in + various places that don't encounter non-Roman strings. (For + speed.) +* create vm-string-width to compute width of strings that might + contain glyphs with a column width > 1. Use this function in + various summary formatting functions. +* vm-assert: use let to bind debug-on-error to t instead of + setting it permanently with setq. +* turned on 8bit character character display in summary for + non-Mule FSF Emacs. +* vm-mime-charset-decode-region: add a face extent or a face text + property to a charset decoded region so that non-MULE XEmacs + and FSF Emacs can display non-ISO-8859-1 chars in the summary. + +VM 6.78 released (5 November 2000) + +* vm-save-message-sans-headers: if target file looks like a mail + folder, ask the user if they really want to append to it. +* vm-mime-base64-encode-region: when using Emacs' base64-encode-region + break long lines unless doing B-encoding. +* vm-mime-base64-encode-region: fixed indentation error that + moved kill-buffer outside the unwind-protect form, which hosed + the return value of the function. +* vm-decode-coding-region: mend MULE mangled end marker by an + explicit set-marker call, since nothing else seems to work. + Make other functions use this fixed marker as a reference so + that they don't forget where they are. +* vm-decode-mime-encoded-words: (goto-char end) after calling + vm-mime-charset-decode-region because decode-coding-region screws + with point and otherwise we will miss encoded words because of + this screwage. Same fix applied to vm-decode-mime-message-headers. +* vm-mime-can-display-internal: indicate that we can handle + message/external-body internally. +* vm-mime-display-internal-message/external-body: deal with the + possibility that the specified access method is unsupported--- + cleanup properly and return nil. +* vm-decode-mime-layout: deal with the possible failure of a + message/external-body object to be retrieved. It needs to be + treated differently than a local object. Offering to save it to + disk is useless. Either display a button or prevent the + existing button from being removed. +* new 'x' specifier for vm-mime-button-format-alist. +* vm-mime-display-internal-message/external-body: fixed reversed + anon-ftp/ftp logic where the user name would be requested for + anon-ftp and set to "anonymous" for normal FTP. +* vm-mime-display-internal-message/external-body: check for + ange-ftp-hook-function and efs-file-handler-function being + fbound to determine if FTP support is available. +* vm-mime-display-internal-message/external-body: catch + vm-mime-error signals and store error message in display-error + slot of layout for later display. +* vm-preview-current-message: don't auto-display + message/external-body when honoring vm-mime-decode-for-preview. +* vm-mime-display-internal-text/plain: drop fancy calculations to + rectify the end marker's position; vm-decode-coding-region now + fixes the end marker's position before returning. +* vm-mime-display-internal-text/html: drop fancy calculations to + rectify the end marker's position; vm-decode-coding-region now + fixes the end marker's position before returning. Hopefully + w3-region won't scramble the marker position... we'll see. +* vm-mime-display-internal-text/enriched: dropped use of + vm-with-unibyte-buffer. +* vm-decode-coding-region: use temp buffer for XEmacs also; + generalize code to work for XEmacs and FSF Emacs. + +VM 6.77 released (2 November 2000) + +* changed keybinding of vm-expunge-folder from # to ### so that + typing it accidentally is less likely. +* '$ w' now does what '$ s' used to do, i.e. saves a MIME object + to a file. +* '$ s' now saves the MIME object to a mail folder if the object + is a message, otherwise it behaves like '$ w'. +* added support for MIME type message/external-body. +* fixed duplicated menu titles in Emacs 20. +* use built-in base64 encoding and decoding functions if present + (FSF Emacs 20 only). +* moved vm-mime-delete-after-saving support out of + vm-mime-send-body-to-file and into + vm-mime-reader-map-save-file. +* make-autoloads: recognize defsubst. +* some code changes to make it possible for the mime headers and + body to be in different buffers. +* vm-mime-find-message/partials: recursively descend composite + message/* types. +* vm-gobble-crash-box: check if folder buffer is the same as the + crash box buffer--- if it is, signal an error. +* vm-mime-fsfemacs-encode-composition: turn off font-lock when + inserting an attached file into the composition buffer. Ditto + in vm-mime-xemacs-encode-composition. +* vm-pop-move-mail: ask user about lack of UIDL support, and skip + folder if the user absolutely wants messages left on server. +* use vm-make-work-buffer to create scratch buffers in many more places. +* save-excursions -> save-excursion +* vm-burst-digest-to-temp-folder: use buffer-disable-undo on the + temp folder buffer. +* vm-make-work-buffer: always create unibyte buffers. +* vm-mime-Q-encode-region: translate SPC to underscore after + quoted-printable encoding is done instead of before. +* vm-mime-charset-decode-region: used a wrapped version of + decode-coding-region (vm-decode-coding-region) if running under FSF Emacs. + The wrapped version encodes into a unibyte buffer then converts + the buffer to a multibyte buffer before insert the conrtents + into the region. Encoding into a unibyte buffer avoid the \201 + lossage. Switching to multibyte before inserting into the + region avoids corrupting some markers. +* vm-mime-display-external-generic: fixed typo that discarded the + message garbage list and replaced it with the folder garbage + list. The result is that MIME messages that invoke multiple + object viewers will now kill all the viewers when selecting a + new message. +* vm-preview-current-message: restrict MIME types that are + auto-displayed when honoring vm-mime-decode-for-preview. The + reason for this restriction is to allow a numeric vm-preview-lines + to remain useful in the face of opaque transfer encodings and + multipart messages, so we avoid launching external viewers + until the message is opened completely. +* vm-toolbar-install-toolbar: check for reasonable value of + vm-toolbar-pixmap-directory before calling vm-toolbar-initialize. +* vm-toolbar-initialize: remove check of + vm-toolbar-pixmap-directory, which is better done before + vm-toolbar-initialize is called. + +VM 6.76 released (5 September 2000) + +* New variables: + + vm-movemail-program-switches +* generate a random Message-ID for previewed compositions in case + the user wants to resend the preview somewhere. +* vm-fix-my-summary!!!: call vm-set-modflag-of on each message + whose summary we whack so that the summary cache is rewritten + when the folder is saved. +* vm-sort-messages: if this is not a thread sort and threading is + enabled, then disable threading and make sure the whole summary + is regenerated (to recalculate %I everywhere). +* vm-mime-display-internal-image-xxxx: set glyph baseline to 100% + to add scrolling in XEmacs 21.2. +* vm-generate-index-file-validity-check: set step value to 1 if + buffer size is smaller than 11 bytes. Step used to be 0 in + this case which led to infloop. +* added base64-encode.c, base64-decode.c, qp-encode.c, + qp-decode.c to the distribution. +* fixed problem in qp-decode.c where lines contain a single + character followed by newline would have the first character + dropped. +* vm-display: allow a string as a buffer argument, convert it to + a buffer internally. +* vm-print-message: don't set the current buffer to be the shell + output buffer, as this makes vm-set-window-configuration bail + out early because it wants to be in a VM related buffer. +* vm-pipe-message-to-command: don't set the current buffer to be the + shell output buffer, as this makes vm-set-window-configuration + bail out early because it wants to be in a VM related buffer. +* vm-print-message: don't use vm-display to display the shell + output buffer, use display-buffer instead and only use it if + the output buffer is not empty. +* vm-pipe-message-to-command: don't use vm-display to display the + shell output buffer, use display-buffer instead and only use it + if the output buffer is not empty. +* vm-print-message: use the vm-print-message config instead of + the vm-pipe-message-to-command config. +* vm-display: don't immediately set current buffer to be the buffer + to be displayed. This behavior made vm-set-window-configuration + bail out early. +* vm-discard-cached-data: call vm-garbage-collect-message before + flushing message caches. +* look for (fboundp 'w3-about) in addition to (fboundp 'w3-region) + to determine if text/html can be displayed internally. +* make after-save-hook local in VM folder buffers. +* vm-get-new-mail: make third arg to read-file-name nil, make + fourth arg t. +* vm-compose-mail: move to point-min before searching for the + header separator string. +* Removed bad quote in vm-delete-mime-object menu entry. +* vm-match-data: replaced with version that calls match-data to + figure out the number of valid \(..\) groups. Emacs 20.4 is + randomly signaling args-out-of-range if the arg to + match-beginning exceed the number of internally allocated + registers in the regexp engine or some such nonsense. +* vm-frame-loop: in the last deletion check, also check the + delete-me frame with vm-created-this-frame-p before deleting + it. +* vm-check-index-file-validity: allow for a nil modified time, + which can occur if the folder is empty. +* generalized vm-keep-mail-buffer into vm-keep-some-buffers and + made the former call the latter. +* keep POP and IMAP trace buffers if there is trouble making a connection. +* complain to user if APOP authentication is asked for but isn't + supported. Previously POP retrieval silently failed. +* vm-reorder-message-headers: For babyl folders, add a newline + before the EOOH line if header section does not end with two + newline. +* macroized most uses of coding system constants 'no-conversion + and 'binary, because 'no-conversion doesn't meant the same thing + in Emacs and XEmacs. +* vm: if buffer-file-coding-system is nil, set it to 'raw-text. + (FSF Emacs MULE only). +* removed duplicate (make-variable-buffer-local 'vm-pop-retrieved-messages) +* vm-parse-date: assume 2-digit year specifications < 70 are in + the 2000's rather than the 1900's. +* vm-mm-encoded-header: bind case-fold-search to t during + search for encoded words. + +VM 6.75 released (27 August 1999) + +* New variables: + + vm-mail-send-hook +* vm-mime-parse-entity: when checking for a content type of just + "text" allow for the possibility that there was no content-type + header at all. +* use XEmacs built-in MD5 support. +* vm-pop-md5: use shell-file-name instead of "/bin/sh". +* formatting and typo fixes in the manual and docstrings + from will@fumblers.org. + +VM 6.74 released (2 August 1999) + +* New variables: + + vm-mime-external-content-type-exceptions +* vm-mime-parse-entity: quietly treat "text" as a content type as + if it were "text/plain" and US-ASCII. +* vm-mime-discard-layout-contents: set m to be the layout's + message, not the end of the layout's body. + +VM 6.73 released (27 July 1999) + +* New variables: + + vm-mime-decode-for-preview + + vm-mime-delete-viewer-processes +* vm-mime-display-external-generic: put MIME temp files on the message + garbage list instead of the folder's garbage list. +* vm-delete-mime-object: copied check for the top-level MIME + object from FSF Emacs code to XEmacs code since the former is + the correct check to use. +* vm-mime-discard-layout-contents: discard cached byte and line + counts of the edited message. +* vm-sort-compare-thread: in the case where root message IDs are + different, if the message dates are identical, use string-lessp on + the message IDs to break the tie. This avoids having different + messages compare as equal, which makes the sort unstable. +* vm-mime-discard-layout-contents: recompute Content-Length + header if needed. +* vm-mime-can-display-internal: consider all text types except + text/html displayable if the character set is displayable. + For text/html continue to require W3. + +VM 6.72 released (21 May 1999) + +* New commands: + + vm-delete-mime-object +* New variables + + vm-mime-delete-after-saving + + vm-mime-confirm-delete + + vm-mime-default-face-charset-exceptions + + vm-paragraph-fill-column + + vm-imap-session-preauth-hook +* removed old, bogus definition of vm-session-initialization from + vm.folder.el +* added w32 as another name for win32 as a window system type. + (FSF Emacs only). +* changed default value of vm-mime-default-face-charsets to + include iso-8859-1 if running on a tty under FSF Emacs/Mule. +* vm-mime-parse-entity: move binding of case-fold-search to a + point after the set-buffer call to avoid having the binding + overriden by a buffer-local value. +* vm-mime-convert-undisplayable-layout: wrap call to vm-mm-layout + message in a call to vm-mime-make-message-symbol; a symbol + needs to be in the struct slot, not the raw message. +* signal an error if mail-alias-file is set and the user is not + the superuser. +* broke the message ID creation code out of + vm-mail-mode-insert-message-id-maybe. +* vm-su-do-date: allow a RFC 822 regexp to match a timezone spec + that lacks the leading plus or minus. +* bind jka-compr-compression-info-list to nil in various place to + avoid unwanted compression or decompression of data. +* vm-mime-send-body-to-file: bind jka-compr-compression-info-list + to nil instead of func-binding jka-compr-get-compression-info. +* vm-sort-messages: call vm-build-thread-lists (new function) + which calls vm-th-thread-list on each message in the folder. + This generates keys that the thread sort needs before the sort + happens instead of during it. Fixes thread sorting bugs. + +VM 6.71 released (8 April 1999) + +* vm-mime-display-internal-text/plain: get message struct from + the MIME layout instead of from vm-message-pointer, since the + latter is utterly the wrong place to find it in this context. + Also, don't fill if no-highlighting is non-nil. +* vm-add-or-delete-message-labels: propagate label additions in + virtual folders to the global lists of the underlying real folders. +* bind format-alist to nil around calls to insert-file-contents + in MIME composition encoding functions. + +VM 6.70 released (21 March 1999) + +* New variables: + + vm-fill-paragraphs-containing-long-lines +* vm-mime-display-internal-text/html: moved the code that rmeoves + read-only text properties into the vm-with-unibyte-buffer form. +* vm-make-presentation-copy: bind inhibit-read-only before tryign + to modify an existing presentation buffer. This is to avoid + stumbling over read-only text properties. +* vm-mime-insert-button: use 'append' instead of 'nconc' to add a + keymap parent. (FSF Emacs only) This avoids modifying the + child keymap and creating a circular keymap structure in a + subsequent call. + +VM 6.69 released (16 March 1999) + +* moved code that sets vm-xemacs-p, vm-fsfemacs-p, etc. to vm-version.el. + Moved other basic feature checking code to vm-version.el. +* Makefile: make sure vm-version gets loaded first, so the + version/feature checking code is run very early. Some of it is + needed by other modules at load time. +* added keymap for MIME buttons so you can display, save, pipe, + print from a tty. +* vm-mime-xemacs-encode-composition: use insert-file-contents + instead of insert-file-contents-literally and see what breaks. + This will allow EFS to work. +* default value of vm-mime-default-face-charsets no longer contains + "iso-8859-1" under FSF Emacs/Mule. 8-bit character display as + octal codes in a unibyte buffer unless standard-display-europeans + or equivalent is called, and we don't call this function under + MULE. +* vm-compose-mail: this function is a VM entry point so call + vm-session-initialization. + +VM 6.68 released (25 February 1999) + +* put user specified Netscape switches before the -remote stuff + in the arg list to Netscape. +* vm-imap-retrieve-to-crashbox: use char-after instead of + char-before since Emacs 19.34 doesn't have char-before. +* use vm-coding-system-name instead of coding-system-name. fset + vm-coding-system-name to coding-system-name if it exists, + otherwise use symbol-name. FSF Emacs doesn't have a + coding system object, so the name is the same as the coding + system symbol's name. +* vm-determine-proper-charset: wrap the guts of the function in a + vm-with-multibyte-buffer form to ensure we're looking at + characters instead of the raw encoding data when scanning for + the character sets that are present. +* vm-decode-mime-layout: support the old 'name' parameter when + supporting vm-infer-mime-types. +* vm-do-reply: don't match vm-subject-ignored-prefix against the + subject to determine if we prepend vm-reply-subject-prefix to + the subject or not. This reverts a change made in VM 6.47. +* vm-mm-layout: call vm-mime-parse-entity-safe instead of + vm-mime-parse-entity so that we get always get a layout back. + This avoids a MIME part completely disappearing if we can't + parse it. +* vm-mime-parse-entity-safe: use type "error/error" for the + layout returned if the MIME part can't be parsed. +* vm-mime-qp-encode-region: hex encode _ and ? for Q encoding as + required by RFC 2047. +* vm-mime-send-body-to-file: Func-bind jka-compr-get-compression-info + to 'ignore' to avoid double compression of saved MIME bodies that + are already compressed. +* vm-imap-make-session: quote (using IMAP quoting rules) login + name and password that are sent as part of the LOGIN command. + +VM 6.67 released (7 February 1999) + +* vm-mime-parse-entity-safe: pass message and passing-message-only + flag to vm-mime-parse-entity. +* vm-mime-parse-entity: wrong number of fields in the last layout + structure fixed. +* make MIME transfer encoding/decoding work buffers unibyte to + avoid corruption when characters are copied from them. (FSF + Emacs only). +* vm-mime-attach-message: store the message to attach in an + unibyte buffer instead of a multibyte buffer. +* vm-mime-fsfemacs-encode-composition: encode text regions using + coding system selected from vm-mime-mule-coding-to-charset-alist + instead of relying on buffer-file-coding-system to be set properly. +* vm-mime-fsfemacs-encode-composition: when handling the attachment + of a composite object, add MIME header section (if not already + provided) before parsing and transfer encoding the object. + vm-mime-xemacs-encode-composition similarly modified. + +VM 6.66 released (5 February 1999) + +* New variables: + + vm-mime-qp-decoder-program + + vm-mime-qp-decoder-switches + + vm-mime-qp-encoder-program + + vm-mime-qp-encoder-switches +* set-file-coding-system -> set-buffer-file-coding-system. +* vm-edit-message: force edit buffer to be unibyte (FSF Emacs + only). +* vm: force folder buffer to be unibyte (FSF Emacs only). +* wrap parts of various MIME decoding and display functions in + vm-with-unibyte-buffer so we can work with unwashed 8-bit data + directly. (FSF Emacs only). +* force some buffers we create to be unibyte buffers to avoid + conflabulation of 8-bit data. (FSF Emacs only). +* vm-find-trailing-message-separator: point still not moving backward + all the times that it should be, so go back to ignoring the return + value of vm-find-leading-message-separator and always moving backward. +* vm-mail-mode-insert-message-id-maybe: use the hostname variable + we so carefullly initialized, instead of just using + (system-name). +* vm-mime-base64-encode-region: if B encoding, strip newlines from + the work buffer instead of the buffer region we're converting. +* vm-mime-base64-encode-region: don't emit status message unless + the region we're encoding is larger than 200 chars. +* vm-mime-parse-entity: new fourth argument that tells the + function whether to use the message argument for positional + information or to just use it to struct in the message slot of + the MIME layout struct. Same for vm-mime-parse-entity-safe. + Use this new argument appropriately in various places so the + message slot gets filled in more places. + +VM 6.65 released (29 January 1999) + +* New commands: + + vm-mime-attach-buffer + + vm-mime-attach-message +* New variables: + + vm-subject-significant-chars +* changed vm-url-regexp to recognize file URLs. +* vm-reencode-mime-encoded-words: fixed infloop problems by updating + pos value to account for the insertion of the =?charset?B? stuff + at the beginning of the newly encoded region. +* big pile of typo fixes in the manual courtesy of Greg Shapiro. +* changes for Emacs 20 Mule: recognize coding system names, bind + coding-system-for-read and process-coding-system-alist to get + binary I/O. +* insert vm-digest-identifier-header-format header into digest + message created in temp folders created to view multipart/digest. + Needed to store link to parent message in MIME layout struct to + make this happen. +* vm-mime-attach-object: don't set 'mime-object property twice in + the FSF Emacs code. +* vm-so-sortable-subject: collapse consecutive whitespace chars + to a single space after prefix/suffix processing. + +VM 6.64 released (17 January 1999) + +* vm-mail-mode-insert-message-id-maybe: (stringp + 'mail-host-address) -> (stringp mail-host-address). +* vm-imap-retrieve-to-crashbox: for From_-with-Content-Length and + BellFrom_ folders, add a newline to the end of a message if the + message lacks one. +* vm-mime-display-internal-text/html: third arg to + remove-text-properties changed to be a plist as the function + requires. +* new edition of the user manual. +* updated README, new installation instructions for manual, + mention Web site +* vm-search18.el gone, vm-search19.el became vm-search.el. +* vm-pop-make-session: switched to the trace buffer earlier in + the function so that MULE coding system is set in correct + buffer. Add connection status messages to trace buffer. +* vm-imap-make-session: switched to the trace buffer earlier in + the function so that MULE coding system is set in correct + buffer. Added connection status messages to trace buffer. +* vm-submit-bug-report: use 'vm-mail instead of 'mail for sending + bug reports. Less confusing, and will work most of the time. + +VM 6.63 released (14 December 1998) + +* set selective-display to nil in various places in the code + where write-region and call-process-region (which calls + write-region) are called to avoid the CR -> LF translation. +* vm-load-window-configurations: added bind of + coding-system-for-read. +* vm-store-window-configurations: removed binding of + coding-system-for-read, moved coding-system-for-write binding + to be ambient only during the write-region call. +* removed all but one of the bindings of inhibit-read-only in the + MIME code. +* vm-mime-display-internal-text/html: Added a remove-text-properties + call to remove read-only text properties. +* vm-mime-attach-object: Don't allow attachment of object to a + composition buffer that has already been encoded. +* retain IMAP session trace buffer if a protocol error occurs. +* removed vm-iamp-store-failed error definition since it was + unused. +* 'w' summary format specifier now gives full weekday name. +* vm-mail-mode-insert-message-id-maybe: ensure RFC 822 compliant + month and day name by indexing the names from an alist instead + of relying on format-time-string. format-time-string's output + can't be trusted for this because of the dubious `locale' stuff + in the C library. +* for non-Content-Length based From_ types, don't require a year + >= A.D. 1000 at the end of the From line--- instead only require a + single digit. This change to deal with some evil mailer that + puts a numeric timezone at the end of the line. +* vm-make-presentation-buffer: remove buffer local foreground and + background colors set in the default face in the presentation + buffer. +* dropped the Videodrome joke from vm-submit-bug-report. +* vm-mime-fsfemacs-encode-composition: bind + file-name-buffer-file-type-alist so that a bit-for-bit binary + file read is assured. This matters only to NTEmacs. +* vm-mouse-send-url-to-netscape: Netscape 4.05 apparently doesn't + like the space after the comma in openURL(..., new-window) and + doesn't create a new window. So the space has been removed. +* read per-folder IMAP retrieved list at startup... forgot to add + code to do this. +* accept lower-case hex digits in quoted-printable encoding. +* vm-mime-composite-type-p: assume message/rfc822 and + message/news are the only composite "message" types. New ones + will have to be manually added. +* vm-misc.el: moved macros to vm-macro.el. +* Makefile: Preload vm-macro.el instead of vm-misc.el. + +VM 6.62 released (9 September 1998) + +* vm-mouse-send-url-to-netscape: Change commas to %2C to avoid + confusing Netscape -remote. +* vm-mime-display-external-generic: when searching for %f, ignore + %%f. +* vm-decode-mime-layoout: drop rule that causes unmatched text/* + and message/* MIME objects to be displayed as text plain. +* vm-mime-can-display-internal: don't load W3 just to see if + w3-region gets bound. If the user wants to view inline HTML, + they'll have to either load W3 explicitly or set up an autoload + for w3-region. + +VM 6.61 released (17 August 1998) + +* vm-find-trailing-message-separator: point wasn't being moved + backward when it should be. Change check to use the return + value of vm-find-leading-message-separator. +* vm-build-message-list: add the starting position of the garbage + to the garbage warning. + +VM 6.60 released (17 August 1998) + +* don't use gray75 to initialize gui-button-face under Windows + (FSF Emacs only). Use only primary colors instead. +* vm-find-trailing-message-separator: for From_ folders, don't + move point backward one char after finding the leading separator + unless that char is a newline. +* vm-skip-past-trailing-message-separator: for From_ folders + don't move point forward one character unless we're not at end + of buffer. +* vm-submit-bug-report: require vm-vars and vm-version modules. +* vm-visit-folder-other-frame: call vm-session-initialization + even if the command is not called interactively. + +VM 6.59 released (24 July 1998) + +* New variables: + + vm-default-From_-folder-type +* new folder type: BellFrom_. +* vm-mime-display-internal-multipart/alternative: call + vm-mime-should-display-internal with two arguments, as + required, instead of one. +* vm-munge-message-separators: if folder type arg is From_, use + BellFrom_ as type to produce folders that are less likely to be + misparsed by other mailers. +* quoted vm variables in docstrings in vm-vars.el with ` and ' + for hyper-apropos. Change previous other uses of `foo' to + ``foo''. + +VM 6.58 released (21 July 1998) + +* fixed typo in vm-mime-fsfemacs-encode-composition; e -> o. + +VM 6.57 released (21 July 1998) + +* added a defvar for timer-list in vm-folder.el. +* added defvars for standard-display-table, + buffer-display-table and buffer-file-type in vm-mime.el. +* added a defvar for mail-personal-alias-file in vm-reply.el. +* added defvars for lpr-command and lpr-switches. +* rewrote text/html inline display function to not need a temp + buffer, save-excursion, and save-restriction. Needed because + w3-region puts markers into the buffer that can't be copied + out. +* don't auto-create text body attachments that contain all + whitespace if the attachment will be at the beginning or end + of the composition. +* vm-imap-retrieve-to-crashbox: munge folder message separators + so the retrieved messages will be parsed correctly in the + target folder. +* vm-do-reply: don't use contents of In-Reply-To in generated + References header unless no References header is present. +* if vm-mime-alternative-select-method is best-internal, consider + a MIME object only if the user wants it displayed internally, + not just if it can be displayed internally. + +VM 6.56 released (14 July 1998) + +* vm-get-spooled-mail: set the non-file maildrop flag on each pass + though the loop. +* vm-get-spool-mail: restore expand-file-name call on the + maildrop so that tildes get expanded. +* store/use the same password for IMAP mailboxes on the same host. +* removed greeting block on Cyrus server. +* Shapiro typo fixes. + +VM 6.55 released (13 July 1998) + +* vm-mail-mode-insert-message-id-maybe: check mail-host-address + with stringp instead of boundp before using its value. +* vm-rfc1153-or-rfc934-burst-message: do digest separator unstuffing + on a per message basis and before message separator munging, so + that message separators exposed by the unstuffing get munged. +* registered vm-imap-protocol-error as a known error/exception. Use it. +* vm-check-for-spooled-mail: check spool filename against the IMAP + template before checking against the POP template, since the + POP template will match both. +* vm-imap-check-mail: bail early if message count in mailbox is zero. + +VM 6.54 released (13 July 1998) + +* first crack at IMAP support. +* New commands: + + vm-expunge-imap-messages +* New variables: + + vm-recognize-imap-maildrops + + vm-imap-auto-expunge-alist + + vm-imap-bytes-per-session + + vm-imap-expunge-after-retrieving + + vm-imap-max-message-size + + vm-imap-messages-per-session +* use vm-check-for-killed-folder before calling + vm-select-folder-buffer in a few functions that don't necessarily + need to select the folder buffer in order to run. +* vm-goto-message bound to M-g. +* vm-find-leading-message-separator: for From_ type folders + require that end of the leading separator line match + " [1-9][0-9][0-9][0-9]". Revisit in eight thousand years. +* rename vm-sprintf to vm-summary-sprintf. Use alists to store + compiled formats instead of using symbol property lists. +* vm-mime-xemacs-encode-composition: discard all but Content-ID + header in already MIME'd objects to avoid header duplication. + Same for vm-mime-fsfemacs-encode-composition. +* vm-mime-display-internal-text/html: If error signaled, catch + it, store the error message and return nil. +* more descriptive buffer name for header buffer used when asking + about POP retrievals. +* vm-mail-mode-insert-message-id-maybe: try harder to find a + hostname that has dots in it for the Message-ID header. +* made vm-pop-retrieved-messages a buffer-local variable, as the + table isn't meant to be shared among folders. +* vm-expunge-pop-messages: use password-less maildrop specs when + doing comparisons in skip code. Changed catch tag from 'skip + to 'replay to more accurately reflect what's happening. +* vm-pop-end-session: delete the trace buffer. +* vm-pop-make-session: generate a new buffer for each session + instead of reusing the same one. +* vm-expunge-pop-messages: set buffer-read-only to nil in + trouble-alert buffer before trying to modify erase it. + +VM 6.53 released (29 June 1998) + +* vm-mf-default-action: needed car of vm-mm-layout-type to + extract type string. +* vm-mime-display-button-xxxx: don't display button unless + there's a defined method for displaying the object. + +VM 6.52 released (28 June 1998) + +* New variables: + + vm-auto-displayed-mime-content-type-exceptions + + vm-mime-internal-content-type-exceptions +* vm-find-leading-message-separator: for From_ type folders, + reinstate requirement that there be two newlines before "From " + message separators. +* renamed vm-mime-should-display-external to vm-mime-can-display-internal. +* added big5 to vm-mime-mule-charset-to-coding-alist +* default value of vm-send-using-mime to always be t instead of + looking to see if the TM mime-setup feature is present. +* added a newline to the 'end' line of a uuencoded attachment if + there isn't one already; this to cope with the usual crocked PC + mail readers (may they reek). +* vm-mime-text-description: further identify a text part if it + has a standard signature in it. +* remove TM hooks from mail mode buffers if vm-send-using-mime is + non-nil. +* vm-mime-send-body-to-file: if user enters a directory name, use + it unconditionally. +* panic buffoon's color changed from rgb:00/df/ff to rgb:ff/7f/ff. +* use user-mail-address function in Bcc header (XEmacs only). +* use user-mail-address variable, if bound in, Bcc headers. +* replaced definition of vm-load-init-file in vm-startup.el with + the one from vm-folder.el. +* use vm-mime-default-action-string-alist only if VM knows how to + display the MIME object. Fiddle with the strings in the list. +* support foregroundToolBarColor symbol in the 'small' set of + toolbar pixmaps (XEmacs only). + +VM 6.51 released (15 June 1998) + +* don't call make-face if no face support is compiled into Emacs + (FSF Emacs only). +* enable inline display of text/html again. +* vm-mime-text-type-p: anchor string matches and add a trailing / + to assure matching only the correct types. +* more fiddling with newlines around the Content-Description + header, hopefully getting it right this time. +* correct "Display as Text" MIME menu item. +* vm-mime-charset-internally-displayable-p: check + vm-mime-mule-charset-to-coding-alist if vm-fsfemacs-mule-p is + non-nil. + +VM 6.50 released (10 June 1998) + +* vm-rename-current-mail-buffer: changed to recognize new default + composition buffer name introduced in 6.49. +* vm-mime-display-external-generic: append filename when supporting + COMMAND-LINE form. Copy program-list since we may need to modify + it. +* vm-discard-cached-data: set mime layout and mime encoded header + slots to nil in virtual messages. +* vm-session-initialization: initialize gui-button-face if not + already initialized (FSF Emacs only). +* vm-pop-move-mail: check vm-pop-auto-expunge-alist properly; + defaulting did not work as you would expect. +* enable image and multiple font support for Windows (XEmacs only). +* provide Content-Description headers for text surrounding + MIME attachments in compositions. +* vm-forward-message: provide Content-Description header for a + MIME forwarded message. +* use same filename extension as that of the suggested attachment + filename when creating a tempfile for use by an external MIME + viewer. + +VM 6.49 released (4 June 1998) + +* New variables: + + vm-infer-mime-types +* vm-pop-check-mail: return nil if UIDL returns an empty list. +* vm-mail-internal: default composition buffer name to "mail to ?" + instead of "*VM-mail*". +* added '$' to regexps in default value of + vm-mime-attachment-auto-type-alist. +* new semantics for vm-mime-external-content-types-alist: %-spec + expansion, shell command line syntax allowed. +* default value of vm-auto-decode-mime-messages changed from nil + to t. + +VM 6.48 released (1 June 1998) + +* New variables: + + vm-spooled-mail-waiting-hook + + vm-mime-uuencode-decoder-program + + vm-mime-uuencode-decoder-switches +* vm-delete-index-file: don't try to delete the file if + vm-index-file-suffix is not a string. +* show completions if completion-auto-help is non-nil. Needed to + replace car with caar in one place in vm-minibuffer-complete-word. +* vm-startup-with-summary: handle 0 case specially so that a + negative number is not passed to nth. +* make vm-mime-preview-composition an alias for + vm-preview-composition, fixing the typo that aliased + vm-preview-mime-composition instead. +* vm-auto-archive-messages: don't archive messages to the same + folder that the user is visiting. +* vm-mime-fsfemacs-encode-composition: encode last MIME part from + point to point-max instead of point-min to point-max. (FSF + Emacs/MULE only.) +* fixed regexp syntax for backslashes in [..] contexts. Need + four backslahses for every one to appear in the regexp. +* vm-discard-cached-data: set the mime-encoded-header-flag to nil. +* vm-mime-burst-message: reverse varref and funcall in `or' expression + to avoid skipping the rest of the vm-mime-burst-layout calls after + the first successful one. +* vm-check-pop-mail: use UIDL data to determine if messages in the + popdrop have been retrieved. +* vm-get-spooled-mail: always set vm-spooled-mail-waiting to nil + after doing a sweep through the spool files, whether mail was + retrieved or not. Not really correct but it is what the user + expects. + +VM 6.47 released (8 April 1998) + +* vm-write-string: bind buffer-read-only to nil before + attempting to modify the buffer. +* vm-auto-select-folder: Do the eval if the cdr of the alist pair + is anything other than a string, instead of it it is anything + other than an atom. +* vm-do-reply: match vm-subject-ignored-prefix against the subject + and don't prepend vm-reply-subject-prefix if there is a prefix + match. +* vm-buffer-to-label: map presentation buffers to the 'message + label. +* vm-scroll-forward: raise and select frame before setting window + configuration. +* vm-frame-totally-visible-p: Consider frame totally visible if + return value of frame-visible-p is not equal to nil or 'hidden. +* dropped `sender' synonym virtual selectors. +* If prefix arg is given to vm-visit-virtual-folder-* commands, say + "read only" in the prompt string. + +VM 6.46 released (30 March 1998) + +* don't clear Message-ID and Date headers after sending the message. + +VM 6.45 released (29 March 1998) + +* New variables: + + vm-mail-header-insert-date + + vm-mail-header-insert-message-id +* insert Message-ID header when message is sent, instead of when + the composition buffer is initialized. Remove any existing + Message-ID header before inserting. +* remove any existing Date header before inserting a new one. +* vm-discard-cached-data: thread sort folders that need it one + time instead of once for each message that has data discarded. +* vm-vs-not: use vm-with-virtual-selector-variables. +* vm-toolbar-mail-waiting-p: return t if vm-mail-check-interval + is not a number, since we can't determine if mail is waiting. +* drop extra space before single digit day numbers in Date + headers that are inserted into compositions. +* vm-edit-message: use set-keymap-parent to allow fallback to the + major mode keymap after searching vm-edit-message-map. +* vm-emit-eom-blurb: display information about recipients if + sender matches vm-summary-uninteresting-senders. +* use define-mail-user-agent to setup vm-user-agent. +* vm-create-virtual-folder-same-subject: match subjects with ^$ + regexp if subject is empty. +* vm-create-virtual-folder-same-author: match authors with ^$ + regexp if author is empty (probably not needed). +* vm-build-virtual-message-list: when updating the virtual message + list of the real message, copy list of virtual messages from + real message instead of a virtual and potentially unmirrored + message. + +VM 6.44 released (24 February 1998) + +* vm-resend-bounced-message: insert Resent-To header near the top + of the composition instead of near the bottom. +* provide second argument to format-time-string for older + versions of XEmacs that require it. + +VM 6.43 released (18 February 1998) + +* only use char-to-int if defined, use identity function + otherwise. +* 0 prepended to field width means to pad with zeroes instead of + spaces in vm-summary-format and vm-mime-button-format-alist. +* recognize %T in MIME button format specs. +* vm-mime-find-format-for-layout: fixed typo in fallback format +* always save the POP password in vm-pop-passwords, even if it is + listed in vm-spool-files. This is for the sake of + vm-expunge-pop-messages which typically deals with + password-less POP specifications. +* use 'highlight extent property for summary mouse tracking, + instead of mode-motion-hook. Seems to display considerably + faster. (XEmacs only). +* reuse summary mouse tracking extents/overlays instead of + constantly making new ones. +* removed autoload cookies from vm-easymenu functions. +* vm-mail-internal: add a Message-ID header. +* vm-mail-send: add a Date header if not already present. + +VM 6.42 released (16 February 1998) + +* New variables: + + vm-pop-expunge-after-retrieving + + vm-pop-auto-expunge-alist + + vm-mime-button-format-alist +* vm-save-message: don't set vm-last-save-folder if it is non-nil + and the user selected folder matches what vm-auto-folder-alist + would have chosen. Tried to do this in 6.41, but broke the + setting of vm-last-save-folder instead. +* vm-expunge-pop-messages: typo prngn -> progn. +* vm-expunge-pop-messages: check whether vm-make-pop-session + returns nil. +* vm-read-attributes: allow header without a label list. The + label part of the data in the header was added later and may + not be in the header of some older folders. +* dropped use of vm-with-virtual-selector-variables in favor of + using an alist. + +VM 6.41 released (11 February 1998) + +* New variables: + + vm-index-file-suffix +* New commands: + + vm-expunge-pop-messages +* default value of vm-circular-folders changed from 0 to nil. +* don't issue DELE commands on POP messages when retrieving + unless POP server doesn't support UIDL. If server supports + UIDL, remember what messages have been retrieved and avoid + retrieving them later. +* vm-save-message: don't set vm-last-save-folder if it is non-nil and the user + selected folder matches what vm-auto-folder-alist would have + chosen. +* vm-show-list: sort list before displaying it. +* vm-show-list: display list ordered top to bottom then left to + right, instead of left to right and then top to bottom. +* bind print-length to nil in some places to avoid truncation of + Lisp Objects in folder headers. +* vm-mime-encapsulate-messages: use vm-insert-region-from-buffer + so we're sure to do buffer switch and unnarrowing necessary to + retrieve the desired buffer contents. + +VM 6.40 released (30 January 1998) + +* New variables: + + vm-mime-7bit-composition-charset +* don't grey-out "Decode MIME" toolbar button after a message is + first decoded. Let user use the button to rotate through + decoding states like the 'D' key does. This applies only to + the separate MIME button, not the one that appears as part of + the `helper' button. +* vm-mark-or-unmark-messages-with-selector: removed extra count + argument from `message' call. +* vm-build-virtual-message-list: if dont-finalize is set, don't + set up the location vector or to obarray used to suppress + duplicate messages. In particular the latter causing empty + message lists to be returned since all the messages were + considered duplicates. +* support foregroundToolBarColor symbol in toolbar pixmaps + (XEmacs only). +* vm-rfc1153-or-rfc934-burst-message: Use current buffer as + folder buffer, instead of the buffer of specified message. +* vm-get-new-mail: signal error if we fail to find a folder + buffer through the normal means. +* sleep for 2 seconds instead of 1 second after "consider M-x + revert-buffer" message and after a quit is signaled and caught + in vm-get-spooled-mail. + +VM 6.39 released (20 January 1998) + +* New commands: + + vm-burst-digest-to-temp-folder + + vm-add-existing-message-labels +* vm-vs-header-or-text: vm-header-of -> vm-headers-of. +* fixed reversed fset definition of vm-vs-sender. +* don't grey-out "Decode MIME" menu entry after a message is + first decoded. Let user use menu entry to rotate through + decoding states like the 'D' key does. +* vm-check-emacs-version: Disallow running under Emacs 20. +* vm-mime-display-internal-multipart/digest: generate summary if + vm-startup-with-summary says so. Did the same for + vm-mime-display-internal-message/partial and + vm-mime-display-internal-message/rfc822. +* default vm-temp-directory to (getenv "TMPDIR") if result is + non-nil. +* vm-undo: signal an error if the current folder is read-only. +* vm-minibuffer-complete-word: set start of word to beginning of + buffers if not doing a multi-word read. +* vm-minibuffer-complete-word: if doing multi-word completion and + the word before point exactly matches something in the completion + list and the word also prefixes something else in the completion + list and last-command eq vm-minibuffer-complete-word, insert + a space, thereby letting the user complete the word. +* vm-mime-display-internal-text/enriched: Don't assume (car + errdata) is a string; it usually isn't. Format error data + properly. +* vm-print-message: write out the tempfile for the non-MIME lobe + of the conditional in the code, since it is needed there also. +* vm-read-virtual-selector: raise the selected frame before + reading from the minibuffer, so the user is less likely to type + into the wrong minibuffer window and hose themselves. +* vm-mime-fsfemacs-encode-composition: set coding-system-for-read + when inserting a file-based attachment to avoid MULE munging. + Protect value of buffer-file-coding-system from possible + changes by insert-file-contents. + +VM 6.38 released (15 January 1998) + +* add vm-virtual-selector-clause property to new selectors. +* vm-read-virtual-selector: removed hard coded list of selectors + that take an arument. Instead, read arg only for selectors that + have a vm-virtual-selector-arg-type property. +* fixed virtual folder numbering/infloop problem introduced in + 6.37. +* vm-mark-or-unmark-messages-with-virtual-folder: Mark virtual + messages instead of the underlying real messages when current + folder is a virtual folder. + +VM 6.37 released (29 December 1997) + +* Folders menu code: create directories by default in vm-folder-directory. +* added name parameter to vm-create-virtual-folder for use by + vm-create-virtual-folder-same-author and + vm-create-virtual-folder-same-subject to avoid regexp-quote + goop in the modeline. +* make sure the -should-delete-frame variables in vm-mouse.el are + initialized before use. +* vm-apply-virtual-folder bound to V X. +* added virtual folder selectors for all the attributes that + vm-set-message-attributes accepts. Added un- selectors so that + simple negations can be used with V C. Added header-or-text + selector. Added aliases for some selector names. +* New commands: + + vm-toggle-all-marks (bound to M V). + + vm-mark-matching-messages-with-virtual-folder (bound to M X). + + vm-unmark-matching-messages-with-virtual-folder (bound to M x). +* vm-update-summary-and-mode-line: copy value of default-directory + from folder buffer to the summary and presentation buffers. +* report null results in mark commands as "No message marked" + instead of "0 messages marked". + +VM 6.36 released (19 December 1997) + +* vm-yank-message: commented out text/html code. +* added toolbar initialization status message (XEmacs only). +* allow integers in the vm-use-toolbar toolbar specification, + which represent blank space in the toolbar. (XEmacs only). +* allow for the possibility that lpr-command and lpr-switches + are unbound. +* restore binding of C-? ; binding the delete keysym doesn't + affect the delete key on a dumb terminal when running FSF + Emacs. +* changed semantics of vm-temp-file-directory. Its value now + must end with the directory separator character used by the + local operating system. +* vm-mime-display-internal-text/enriched: catch errors in + enriched-decode and store it in the MIME layout struct for + future display. +* New commands: + + vm-create-virtual-folder-same-subject (bound to V S) + + vm-create-virtual-folder-same-author (bound to V A) +* vm-write-file: If write-file renames the folder buffer, rename + the summary buffer and presentation buffer to match. +* vm-mime-can-display-internal: don't assume enriched.el is + shipped with Emacs. Assume text/enriched is internally + displayable only if enriched-mode is fbound. +* vm-mime-fragment-composition: supply the "total" parameter in + all message/partial parts instead of just the last one. +* only delete the frame used for completion if VM created it. +* vm-fsfemacs-p: Don't insist on v19. + +VM 6.35 released (24 November 1997) + +* typo fixes +* Gregory Neil Shapiro's Emacs 20 MULE patches, which inserted + bindings for coding-system-for-read/write in various places. +* renamed vm-fsfemacs-19-p to vm-fsfemacs-p. +* Bound (control /) to vm-undo, bound backspace and delete + keysyms to vm-scroll-backward, dropped binding of "\C-?". +* added ;;;###autoload cookies to all VM entry points. +* vm-session-initialization: require 'vm first to make sure the basic + things are loaded before we try to do anything. +* dropped inline support for text/html. Too much pain right now. + Revisit later. +* recognize po:user type spool file and peaceably hand it off to + movemail. +* vm-mode-internal: install new fucntion vm-unblock-new-mail on + after-save-hook to allow retrieval of mail after a save of an + M-x recover-file'd folder. +* vm-pop-make-session: first argument to buffer-disable-undo is + required under XEmacs 19.14, so provide it. +* Use locate-data-directory if it exists when setting + vm-image-directory. +* vm-mail-internal: insert an extra newline before the inserted signature + so the user doesn't have to type one. (I give.) +* vm-mime-transfer-encode-layout: don't add a + Content-Transfer-Encoding header unless the encoding type of + the layout differs from what we require it to be. +* vm-mime-transfer-encode-region: downcase the return value so + string comparisons don't have to worry about case. QP encode + if armor-dot is set. +* vm-print-message: use a tempfile under Windows 95 or NT. + Apparently the losing print utils there don't understand stdin or + can't read from it. +* vm-mime-text-type-p renamed to vm-mime-text-type-layout-p. + The new version of vm-mime-text-type-p checks the type without a + layout wrapped around it. +* vm-mime-xemacs-encode-composition: For MULE, use binary coding + system when inserting an attached file if the type of the + attachment is not a textual MIME type. + +VM 6.34 released (15 September 1997) + +* vm: use other frame if folder is visible there. +* vm-auto-archive-messages: don't silently block archival + attempts to /dev/null; Emacs no longer complains about + writes to /dev/null. +* vm-toolbar-initialize: add line for 'getmail' button support + that got omitted somehow. +* vm-multiple-fonts-possible-p: added win32 as a window system + that supports multiple fonts. + +VM 6.33 released (19 July 1997) + +* vm-undisplay-buffer: don't delete frames unless both + vm-mutable-windows and pop-up-frames are not non-nil. Loop + over the remaining windows that display the target buffer and + make those windows display some other buffer. +* vm-mime-set-extent-glyph-for-type: use a list of instantiators, + use 'xpm instead of 'autodetect and fallback to [nothing] if + instantiation fails. +* vm-display-face: use the [nothing] instantiator on ttys. XEmcas + only. +* vm-toolbar-install-toolbar: change toolbar size specifier on + frame even if VM did not create the frame. This reverses the + change made in 6.32. +* vm-isearch: call vm-energize-urls to light up the URLs after a + search completes. +* vm-set-window-configuration: return the window configuration we + set. A change in 6.32 caused this not to be done. This confused + vm-display which relied on the return value to determine whether + vm-display-buffer needed to be called. +* don't recognize <URL:...> as an URL if it contains a newline. +* vm-scroll-backward: make argument optional. + +VM 6.32 released (30 May 1997) + +* vm-toolbar-install-toolbar: don't change toolbar size specifier + on frame unless VM created the frame. +* vm-mail-send: move attribute change before possible deletion of + the buffer due to vm-keep-sent-messages == nil. +* remove references to vm-record-current-window-configuration + since it is not being used and will never be used. +* vm-mouse-read-file-name-event-handler: don't delete the completion + frame before reading keyboard input. This should avoid making + the user hunt for the frame that contains the correct minibuffer + window to type into. +* default value of vm-mutable-frames changed to t, and the + semantics of this variable have been changed to hopefully be + more like what users expect it to be. +* use cache slot of MIME layout struct as an alist everywhere + to avoid having display functions confuse each other with their + different cache entries. +* vm-mime-display-internal-image-xxxx: use device tag lists to have + a text tag displayed on ttys and the image itself on image-capable + devices. +* added optional `to' argument to vm-mail commands. +* mouse support changed so that it is installed whenever mouse + support may be possible instead of only if it is possible on + the current device.. Significant only under XEmacs currently. +* use multiple frames on ttys, where available. +* vm-scroll-forward: don't scroll if we're auto decoding MIME and + the message needed to be decoded. +* vm-mail-internal: support mail-personal-alias-file, fall back + to ~/.mailrc if it is nil. + +VM 6.31 released (11 May 1997) + +* vm-toolbar-support-possible-p: don't check device type, install + toolbar if the 'toolbar feature is present. +* vm-toolbar-initialize: check for device-on-window-system-p + before looking at device-bitplanes, in case the selected device + is a tty. +* use '(win) tag sets on toolbar specifiers to prevent toolbars + from being attached to non-window system frames. +* vm-multiple-fonts-possible-p: conditionalize checks on + XEmacs/Emacs to avoid looking at the window-system variable + under XEmacs where it should not be used. +* set scrollbar height only if (featurep 'scrollbar) and under + XEmacs. Previously we checked if set-specifier was fbound. +* vm-mime-preview-composition: copy value of enriched-mode to + the temp buffer so that the MIME encoding code knows what to do. +* set perms to 600 on MIME tempfiles before writing to them. + There's still a race window where access can be gained to + such files, but it should be very small assuming NFS is not + involved. +* added new 'display-error' slot to the MIME layout struct to + avoid overloading the cache slot... and fixed a bug thereby, due + to vm-mime-display-external-generic trying to use the contents + of the cache slot when there was an error message there. +* vm-mime-display-internal-message/rfc822: bind buffer-read-only + to nil before trying to insert text into the presentation + buffer. +* vm-burst-digest will now descend into nested MIME layouts to find + digests to burst. + +VM 6.30 released (28 April 1997) + +* vm-mail-send: rename and/or delete the composition buffer before + trying to make the replied/forward/etc. attribute change, since + the user might abort that action. E.g. "... really edit the buffer?" +* changed code to use XEmacs 20.2 MULE variables and functions + instead of the 20.0 functions. +* treat inlined message/rfc822 like multipart/mixed except we also + insert the forwarded headers message and decode any encoded + words in them. +* support enriched-mode in composition buffers. +* replaced some repeated calls to car with varrefs. +* vm-make-presentation-copy: bind inhibit-read-only to disable + read-only text properties before calling erase-buffer. +* vm-rfc1153-or-rfc934-burst-message: don't insert a trailing + message separator if we're bursting the first message. +* rewrote vm-menu-support-possible-p to not factor device type + into its decision. For a multi-device XEmacs what is not + possible now might be possible later, so let the menus be + instantiated even if they aren't necessarily visible on the + currently selected device. + +VM 6.29 released (23 April 1997) + +* default value of vm-honor-mime-content-disposition now nil. +* disable the setting of stack-trace-on-error for now. +* fixed a few places where MIME layout vectors were created with + too many slots and one place with too few slots. +* Makefile: doc fixes +* Shapiro typo fixes. + +VM 6.28 released (22 April 1997) + +* added status messages for vm-mark-all-messages and vm-clear-all-marks. +* vm-mime-set-extent-glyph-for-type: don't croak on unknown + types. +* vm-thread-mark-for-summary-update: when skipping already marked + messages don't skip the part of the loop that moves the list + pointer forward. :-P +* rerun vm-menu-install-known-virtual-folders-menu after creating + on-the-fly virtual folders because the folder menu gets hosed + by the let-bound value of vm-virtual-folder-alist. +* added hack to vm-mail-send-and-exit to try and improve window + configuration behavior under XEmacs when vm-keep-sent-messages + is nil. +* vm-mime-composite-type-p: don't consider message/partial and + message/external-body as a composite types. +* fixed nested MIME encoding to check types recursively all the + way down to make sure the 7bit/8bit rules are followed. +* vm-forward-message: use message/rfc822 instead of multipart/digest. +* vm-send-digest: fixed preamble insert for MIME digests to + insert into the composition buffer instead of directly into the + digest buffer. + +VM 6.27 released (16 April 1997) + +* vm-mime-rewrite-failed-button: add newline to displayed error + string. +* vm-menu-goto-event: use event-closest-point instead of + event-point so that we get locality of point when a click + occurs over a glyph (XEmacs only). +* vm-mime-display-button-xxxx: say "attempt to display" instead of + "display", as the button doesn't know if there is a functional + display function for the type. +* vm-mime-xemacs-encode-composition: dropped calls to + encode-coding-region for now. They were screwing up marker + positions. +* vm-mime-xemacs-encode-composition: protect value of + file-coding-system from changes when inserting attachment file + contents. +* vm-mime-display-internal-text/html: don't call w3-region if it + isn't bound, just set error string and return nil. +* vm-thread-mark-for-summary-update: don't mark if vm-thread-list-of + slot is nil; use nil in this slot to mean we've already marked + this message. + +VM 6.26 released (13 April 1997) + +* added missing application/octet-stream button display function. +* Shapiro typo fixes + +VM 6.25 released (13 April 1997) + +* copied vm-note-emacs-version to vm-menu.el so that it is + available at load time for use there. +* converted mona stamps to XPMs as XEmacs can't display the GIF versions. +* vm-mime-transfer-encode-layout: mark encoding in transfer + encoded leaves, forgot this previously (oops). +* default value of vm-mime-ignore-mime-version now t. +* restored vm-xemacs-p, vm-xemacs-mule-p and vm-fsfemacs-19-p + functions to avoid breaking third party code that rely on them + being present (sigh). +* dropped vm-mime-attach-mime-file from the vm-mail-mode keymap and + menu. +* vm-show-list: binding to button release events in XEmacs didn't + work. Should probably use mouse-track hooks instead of binding + keys but until we do that go back to binding button press events. +* vm-mouse-get-mouse-track-string: check whether we're running + Emacs/XEmacs rather than whether functions are defined to avoid + using the wrong overlay/extent interface. +* initialize mail-default-reply-to from REPLYTO environmental + variable if value is nil (used to be if value is t). +* vm: moved call to vm-preview-current-message after the summary + generatation/display code. The summary might completely + obscure the view of the message buffer, so previewing should + occur after that so that vm-show-current-message knows whether + the message was visible and therefore also knows whether to + mark the message as read. +* vm-keep-mail-buffer: don't kill a buffer if it marked as + modified, even if the number of `kept' messages would be + exceeeded by keeping it. Presumably if a buffer is modified + the user has resumed composing in it and so we should not delete + it. +* added vm-mouse-send-url-to-netscape-new-window and + vm-mouse-send-url-to-mosaic-new-window functions for use as + values of vm-url-browser. +* dropped use of vm-check-for-killed-folder in menubar and + toolbar enabled-p functions. We wrap troublesome calls to + vm-select-folder-buffer in (condition-case ...) now to avoid a + "Folder has been killed" error from hosing the toolbar/mnunebar + and XEmacs permanently. +* don't use application/octet-stream's button function for all + application subtypes. Added a separate function to be used for + subtypes other than octet-stream. +* vm-mime-attach-object: if type is nil, use text/plain as the + type when calling vm-mime-set-extent-glyph-for-type. +* don't fold content-disposition headers if + vm-mime-avoid-folding-content-type is non-nil. +* don't add an extra newline after the unfolded content-type of the + last text subpart. +* vm-mime-preview-composition: remove mail header separator after + the message is encoded since the encoder won't work without it. + +VM 6.24 released (9 April 1997) + +* default value of vm-mime-avoid-folding-content-type now t due + to pervasive broken Solaris sendmail installations that mangle + the headers of messages with folded Content- headers. +* vm-mime-make-multipart-boundary: shortened multipart boundaries to + avoid long header lines when vm-mime-avoid-folding-content-type is + t. +* include the missing audio_stamp images in the distribution. +* set version variables at startup and refer to them rather than + calling vm-xemacs-p, etc. repeatedly. +* vm-summary-highlight-region: overlays and extents aren't + interchangable in this context, so behave based on Emacs/XEmacs + version to avoid any overlay/extent emulations, and also to + avoid having make-overlay's sudden appearance give us + heartburn. +* don't fset vm-extent-property, vm-make-extent, etc. unless they + are undefined. This is to avoid changing their definition in + the middle of an Emacs session and thereby mixing usage the + overlay/extent interfaces. +* vm-mime-set-extent-glyph-for-layout: fixed reversed colorfulness + test. +* vm-mime-set-extent-glyph-for-type: mona_stamp is a GIF not an XPM. +* more overlay/extent interface cleanup. +* reenabled internal text/html code. +* vm-yank-message: decode text/html and text/enriched in the + composition buffer. +* attach image glyphs to attachment tags in composition buffers + (XEmacs only). +* print a warning and continue if x-vm- header seems corrupted. + old behavior was to just croak an error and wedge the mailer. +* vm-print-message: default count to 1 if passed no arguments. + +VM 6.23 released (4 April 1997) + +* default value of vm-honor-mime-content-disposition now t. +* Makefile: default VM build type is now back to `autoload'. +* vm-rfc1153-or-rfc934-burst-message: use point instead of + (match-end 0) when deleting the message separator. +* vm-rfc1153-or-rfc934-burst-message: trim excessive newlines + only after we know that we are looking at a valid message separator. +* vm-su-message-id: discard chaff preceding message ID. +* vm-mime-fragment-composition: 'send -> '8bit to match + documentation of vm-mime-8bit-text-transfer-encoding. +* vm-mime-fragment-composition: call vm-add-mail-mode-header-separator + at the end so the buffer could be sent again. +* vm-mime-preview-composition: call vm-remove-mail-mode-header-separator. +* avoid starting new timers if old timers are still active (FSF + Emacs only). +* vm-mime-encode-composition: split code into FSF Emacs and + XEmacs functions. This should avoid mixing usage of the extent + and overlay interfaces, which loses with Nuspl's overlay.el + emulation. +* default vm-temp-file-directory to C:\ if /tmp is not a directory + and C:\ is. +* use insert-file-contents instead of insert-file-contents-literally + when inserting MIME attachments into compositions when encoding. + insert-file-contents-literally bypasses CRLF -> LF processing + under NTEmacs, apparently. +* if vm-auto-displayed-mime-content-types or Content-Disposition + says to display message/rfc822 or message/news inline and + immediately display them as text/plain. If displaying them due + to button activation, use a folder instead. +* use different menu for mailto: URLs since the old one didn't + really do what it advertised, i.e. didn't allow mailto URLs to + be send to other browsers. +* added reduced color MIME art for 8-bit displays that used to only be + used with displays with 16-bit or better displays. +* cache MIME art image glyphs for reuse to save load time. +* wrap calls to timezone-make-date-sortable in (condition-case ...) + to avoid crashing on bad dates. +* gave up on using frame-totally-visible-p since it is still + broken in 19.15. + +VM 6.22 released (22 March 1997) + +* vm-mime-encode-composition: insert-file-contents-literally + doesn't move point. the code assumed it does and corrupted + attachments as a result. +* vm-gobble-crash-box: remove/rename crash box even if it is + zero-length. + +VM 6.21 released (21 March 1997) + +* vm-save-folder: call clear-visited-file-modtime if folder was + deleted to avoid "File changed on disk" warnings later. +* vm-mime-qp-encode-region: bounds check (1+ inputpos) before + using it to avoid referencing outside a clipping region. +* vm-mime-encode-composition: do the insert/delete dance to avoid + text leaking into overlays in the file insertion case. + +VM 6.20 released (18 March 1997) + +* vm-menu-support-possible-p: allow menu code to operate under + NextStep. window-system == ns. +* New variables: + + vm-mosaic-program-switches + + vm-netscape-program-switches + + vm-mime-ignore-mime-version + + vm-presentation-mode-hook (you were right, i was wrong) +* vm-decode-mime-messages: run the highlighting code +* vm-mime-display-internal-multipart/digest: copied folder display + code from the message/rfc822 handler since they should work the + same and message/rfc822 works properly with vm-mutable-windows + == nil. +* make gui-button-face be the unconditional default value for + vm-mime-button-face. +* vm-virtual-quit: make sure vm-message-pointer is non-nil before + trying to run vm-message-id-number-of on it. +* vm-howl-if-eom: don't search other frames for the buffer's + window. Under XEmacs calling select-window on such a window + causes its frame to be selected and it stays selected despite + the call being wrapped in a save-window-excursion. I don't + think we really want to report end of message status in a + window in a non-selected frame anyway. +* removed reference to user-mail-address variable, because it might be + set to nil. +* vm-show-list: bind command to mouse release events instead of + mouse press events in XEmacs. +* vm-preview-current-message: set vm-mime-decoded to nil; it is + not enough to just let vm-make-presentation-copy do this. +* use full contents of References headers to avoid holes in + threads due to missing parent messages. +* insert an X-Mailer in composition buffers. Music! Fun! Horoscopes! + And bug tracking. +* removed "Parsing MIME message..." status messages until I come + up with a better way to write these status message only when + we're doing something that might take a while. + +VM 6.19 released (8 March 1997) + +* New user data functions: + + vm-user-composition-folder-buffer + + vm-user-composition-real-folder-buffers +* vm-print-message: make printing of MIME message work more like + non-MIME messages; print visible headers, print tags for + non-textual body parts. +* vm-mime-insert-button: don't set keymap parent to be the + current local map unless that map exists (i.e. is non-nil). +* catch errors when decoding encoded words and substitute an error + indicator for the string that we could not parse. +* vm-set-xxxx-flag: don't set attribute flag until after the undo + information is recorded. The buffer modification might be + nixed by the user via the clash detection query, so we need to + be sure we're past that code before committing to the attribute + change. +* vm-set-labels: same as vm-set-xxxx-flag and for same reason. + +VM 6.18 released (4 March 1997) + +* New variables: + + vm-mime-composition-armor-from-lines +* use Dispose menu as the mode menu in the presentation buffer. +* vm-mime-encode-composition: do insert/delete dance to avoid + inserting into attachment overlays. +* vm-print-command now decodes the MIME message before printing. +* vm-determine-proper-charset: use assoc instead of + vm-string-assoc when searching MULE alists since symbosl are + used tor charsets there. +* added 'print' item to mime dispose menu. +* vm-display: make buffer current buffer running + vm-undisplay-buffer-hook. +* vm-make-presentation-copy: don't set frame deletion hooks unless + multiple frames are possible. +* fixed bug where X-Faces were unrecognized if the X-Face header + name used DiFfErEnT case than XEmacs' autodetect code expected. +* returned to using the day's date as part of the saved crash box + name used when vm-keep-crash-boxes is set. +* somehow we didn't get scroll-in-place turned off in + presentation buffers; done now. +* added support for message/news type, which is handled mostly + like message/rfc822. +* new mime-dispose menu entries. +* don't check again for new mail if we already know some is waiting. +* add extended status reporting during POP message retrieval. +* vm-get-spooled-mail: if we know we've already retrieved some + mail, catch keyboard-quit from vm-spool-move-mail and + vm-pop-move-mail, so crash box contents can be processed + immediately after the quit. + +VM 6.17 released (27 February 1997) + +* vm-pop-read-past-dot-sentinel-line: use re-search-forward + instead of search-forward (oops). +* don't use match-string; it is a macro in XEmacs 19.14 and this + makes byte compiled code that doesn't know this fact blow up + under 19.14. +* added content disposition popup menu on attachment tags. +* don't use intangible text property on attachment tags (breaks + menu code). +* set zone-of message slot to "" if timezone missing from a Date + header that looks like UNIX-ctime format. +* avoid using the symbol name `obarray'. +* treat consecutive rfc934 message boundaries as one boundary + when bursting. +* fixed boundary test in rfc934/rfc1153 digest bursting code to + requires the headers only if not looking at the last boundary. + should have been doing this already, but the boolean logic was + wrong. +* skip >From lines when reordering headers. +* added assert statement to vm-mime-encode-composition to try to + track the disappearing attachment bug. +* vm-preview-current-message: unbury folder or presentation + buffer depending on which one we use for the current message. + This is a further effort to improve vm-mutable-windows == nil + behavior. + +VM 6.16 released (25 February 1997) + +* check for vm-xemacs-mule-p before using file-coding-system and + friends, and also strengthen the checks that vm-xemacs-mule-p + does. +* vm-mime-fake-attachment-overlays: don't use `pos' twice in a let + statement. +* still more coding system fiddling; use get-coding-system to + normalize coding-system values before comparing with eq. +* bind buffer-read-only to nil when encoding/decoding folder for MULE. +* make timers go away if interval vars indicate this should be + done, or if all vm-mode buffers are gone. +* vm-run-command-on-region: bind binary-process-input for DOS/Windows. +* vm-mime-base64-encode-region: if B encoding, strip out line + breaks after encoding if using an external encoder. +* vm-resend-bounced-message: use Resent- headers. +* extend mail mode menu. +* put VM mail mode menu on menubar (FSF Emacs). +* display content type information in the MIME button even if + Content-Description is present. +* retire vm-unsaved-message. +* vm-run-command-on-region: don't visit file to determine how + large it is. + +VM 6.15 released (20 February 1997) + +* move start of attachment tag out of header section. +* vm-mime-preview-composition: don't copy extents under XEmacs. +* use text properties for attachment tags in FSF Emacs. +* vm-mime-attach-file: pass description from interactive spec + into function. +* better handling of M-x vm-mode w.r.t. coding systems under Mule. +* Shapiro typo fixes. + +VM 6.14 released (19 February 1997) + +* New variables: + + vm-pop-max-message-size + + vm-mail-check-interval + + vm-pop-messages-per-session + + vm-pop-bytes-per-session + + vm-image-directory + + vm-mime-default-face-charsets + + vm-mime-charset-font-alist +* vm-get-spooled-mail: ncons -> nconc. +* vm-mime-parse-entity: allow trailing LWSP-chars on boundary + lines. +* vm-make-presentation-copy: don't bury folder buffer when + displaying presentation buffer. +* vm-get-spooled-mail: block signaling of errors if mail has + already been appended to the folder. Just display a message + and continue. +* vm-gobble-crash-box: don't try to rename the crash box unless + we actually put something into it. +* vm-pop-move-mail: don't use a filter function. This should + avoid consing and discarding big strings while downloading a + maildrop and avoid swamping Emacs' heap with them. +* fixed a couple of attachment tag seepage problems. +* for subpart parse errors cram (car (cdr data)) into the + description slot rather than the car; braino... the string is + further down the list. +* vm-delete-duplicates: don't croak if vm-chop-full-name-function + can't extract an address. +* vm-yank-message: search more than one level deep for textual + MIME part when yanking a message into a composition buffer. +* added image stamps for MIME types that are displayed with the + MIME buttons under XEmacs (> 15bit displays only). +* vm-pop-retrieve-to-crashbox: don't search from the beginning of + message each time new output is added to the POP buffer. +* suppress prompt for POP password unless the user ran a command that + caused mail to be retrieved. +* vm-auto-select-folder: pass clump argument to vm-get-header-contents. +* don't let attachment be inserted into the header section of a message. +* should-use-dialog-box -> use-dialog-box +* simplify crashbox renaming to just use "Z" + a random number and + check for existence of the destination file before renaming. + This avoids the need for a one second sleep to avoid name + collisions. +* Makefile: use -insert in rule to build vm.info to support + XEmacs 19.14's broken command line parsing. +* new `getmail' toolbar button available under XEmacs. +* vm-mime-send-body-to-file: reread file name if user inputs a + directory name, using the dir plus the default filename as the + new default filename. +* default value of vm-flush-interval now 90, was `t'. +* require at least one valid header and a From header in messages + in RFC1153 and RFC934 digests. If the requirement is not met, + assume the prior message boundary was not valid unless it was + the boundary at the end of the digest. +* ignore line lengths when doing "Q" and "B" encoded word encoding. +* reverted to pre-6.05 version of vm-scroll-forward-internal. + The pos-visible-in-window-p check still doesn't work correctly in the + face of window size changes. Only scrolling the buffer is an + accurate indicator of whether we're on the last page. +* Makefile: default VM build type is now `noautoload'. +* vm-decode-mime-messages: if called interactively and we're + previewing, call vm-show-current-message so the body will be + displayed. +* set timer to delete POP processes two seconds after the session + ends to try to evade a race condition in the TCP protocol that + causes long delays when closing a socket. +* give up on using mail-extract-address-components. +* use proper file coding systems for reading and writing for + XEmacs/MULE. +* vm-mime-encode-composition: prefer params attached to the + extent over parameters in the body of the an already-MIMEd + object, since the information is guaranteed valid. It also + avoids losing the quotes on boundary parameters. +* vm-show-current-message: check value of vm-mime-decoded in + correct buffer, i.e. the folder buffer not the presentation + buffer. +* stopped using w3-region. +* put MIME encoded words in the summary cache instead of decoded + words to avoid losing Kanji and other long coded char types on saves. +* set scroll-in-place to nil in VM folder and presentation buffers. +* keep quoted copy of some structured fields of MIME headers for + later use. Useful if we want to inherit the type and + parameters of a subpart. +* vm-mail-internal: set vm-mail-mode-map-parented for the XEmacs + case as well as the FSF Emacs case. +* trimmed vm-mail-mode-map of some key bindings that already + appear in mail-mode-map. +* replace some FSF Emacs menubar command entries in Mail mode. +* vm-kill-subject: type fix vm-move-after-deleting -> vm-move-after-killing + +VM 6.13 released (7 February 1997) + +* set file-precious-flag to t in vm-mode buffers. +* vm-mime-qp-encode-region: call vm-insert-char properly when + inserting linebreaks (sigh). +* vm-menu-toggle-menubar: save-excursion around recursive calls + to avoid a buffer change. Symptom of bug was that menubar + toggling didn't work if the presentation buffer was the + current buffer. +* don't use 'replicating property on attachment tag extents under + XEmacs as they tend to make XEmacs crash. +* vm-forward-message: don't use vm-forward-list in temp buffer + when miming; it has a nil value there instead of the needed + message list. +* signal an error if the user tries to attach a directory, + nonexistent file or unreadable file to a MIME composition. +* stuff attributes by reverse physical order. This should + decrease the amount of gap motion when stuffing attributes in + folders that have been sorted by some key other than + physical-order (thank you Bob Glickstein for this speedup + idea). +* vm-thread-list: don't remove the head of thread-list when a + loop is detected. Symptom was that threading without using the + Subject header was often broken. I guess + vm-thread-using-subject == nil is not a popular setting. +* vm-show-current-message: moved setting of vm-system-state back + inside the conditional that checks whether the folder or + presentation buffer is visible. Having it outside seemed to be + causing pain for vm-preview-lines == nil users, bane of + life. :-/ +* vm-delete-buffer-frame: removes itself from + vm-undisplay-buffer-hook, as it did before some recent changes. + +VM 6.12 released (6 February 1997) + +* New commands: + + vm-mime-encode-composition + + vm-mime-preview-composition +* New variables: + + vm-mime-avoid-folding-content-type + + vm-mime-display-function +* Retired variables: + + vm-summary-subject-no-newlines +* replace newlines with spaces in all subjects and full names + displayed in the summary. +* vm-guess-digest-type: listp -> vectorp. The MIME layout struct + type changed since this code was last looked at. +* don't let subpart parse errors make the parse of the whole MIME + message fail. Return a default type upon encountering a + non-top-level parse error. +* vm-forward-message: like vm-send-digest, use an attachment in + the composition buffer if vm-send-using-mime is non-nil. +* more status messages for things that take a while to execute. +* set default value of vm-send-using-mime based of featurep + 'mime-setup to try and avoid bad interaction with TM. +* vm-mime-qp-encode-region: don't use insert-string, since it + does different things in Emacs and XEmacs +* MIME header-decode strings that go into the summary cache that + are taken from headers that can contain encoded words. +* add "MIME-Version:" and "Content-" to the default list of + headers (vm-resend-bounced-headers) that are kept when + resending a bounced message. +* don't treat multiple occurrences of all headers like the + multiple occurrence of a recipient header. Old behavior was to + clump all header instance contents together separated by ", ". + Now some headers clump, some don't, and some clump with a + different separator string. +* don't move message pointer if deleting after archiving even if + vm-move-after-deleting is non-nil. + +VM 6.11 released (3 February 1997) + +* vm-mime-encode-composition: don't encode the whole message when + trying to encode the last text part. +* vm-yank-message: use (car parts) instead of `o' inside the MIME + part insertion loop. Symptom, nothing was inserted when + yanking a multipart message +* changed default value of vm-auto-displayed-mime-content-types + to ("text" "multipart"). + +VM 6.10 released (3 February 1997) + +* New variables: + + vm-honor-mime-content-disposition + + vm-mime-attachment-save-directory +* vm-mime-display-internal-message/partial: changed incorrect + reference to layout to (car p-list). Symptom of the bug was + the "total" parameter would not be found unless it was present + in the message that was current when the message/partial button + was activated. +* vm-check-emacs-version: allow VM to run on v20 Emacs/XEmacs. +* removed bogus default value of vm-frame-parameter-alist. +* vm-yank-message: when yanking a MIME message, don't yank + non-text parts. +* fixed problem with vm-show-current-message being called twice + if you put the cursor on a non-current MIME message in the + summary and hit RET. The symptom was that you would get the + `all button' MIME display instead of the `decoded' display. +* discard any directory components from default filename provided + via a MIME object. +* fixed buggy handling of multipart/alternative to pick the best part + rather than the last displayable part. +* vm-decode-mime-message: when doing the `buttons' display, + display buttons for all non-composite objects, i.e. make all + multipart types transparent. +* treat multipart/parallel exactly like multipart/mixed. +* vm-mail-send: take precautions so that VM doesn't manhandle the + wrong buffer if the composition buffer is killed inside mail-send. +* vm-mime-qp-decode-region: treat CR after = like a soft local + line break. The message is supposed to be written in the local + newline convention (LF only) by the time VM sees it, but when + was life ever easy? Why am I sure that I'll be visiting this + again? +* run w3-region in its own buffer and wrap it in save-excursion / + save-window-excursion to prevent it from fiddling with VM's + window environment, clip region and point. +* make sure the presentation buffer has a license to kill frames if + vm-frame-per-folder is non-nil. +* put quotes around boundary parameters in multipart messages + that VM creates, since the random boundary strings might + contain a /, which requires quoting. + +VM 6.09 released (30 January 1997) + +* MIME composition (support for vm-send-using-mime) +* New commands: + + vm-mime-attach-file + + vm-mime-attach-mime-file +* New variables: + + vm-mime-8bit-composition-charset + + vm-mime-8bit-text-transfer-encoding + + vm-mime-attachment-auto-type-alist + + vm-mime-max-message-size +* fixed range check bug in vm-mark-or-unmark-summary-region. +* don't ignore whether the text/plain internal display function + fails when used as a fallback display function for textual + types. Unsupportable charsets might make it fail; should + default to application/octet-stream in that case. +* fixed MIME parsing in virtual folders. +* don't move window point when decoding MIME messages if the + presentation buffer's window is the selected window. +* added a third state for vm-decode-mime-messages to show all + buttons before going back to the raw data. +* fixed frame-iconified-p typos. +* fixed vm-mime-convert-undisplayable-layout to return a layout + instead of a status message :-P. +* avoid using make-local-variable on kill-buffer-hook in some + buffers since this is now apparently a no-no. +* check Emacs version and signal an error if the version the user + is using is too old to run VM. +* fixed really doof bit shift and masking errors in + vm-mime-qp-encode-region. + +VM 6.08 released (26 January 1997) + +* New commands: + + vm-mark-summary-region + + vm-unmark-summary-region +* New variables: + + vm-spool-file-suffixes + + vm-crash-box-suffix + + vm-make-spool-file-name + + vm-make-crash-box-name +* vm-mime-base64-encode-region: fixed typo base64-decoder -> + base64-encoder. +* save-excursion around switch-to-buffer in 'vm and + 'vm-visit-virtual-folder startup code to avoid possibly + switching to the summary or presentation buffer. +* don't propagate vm-ml-sort-keys to the presentation buffer. +* make sure buttons start at the beginning of a line after the + first decoding pass. +* support the native-sound-only-on-console variable under XEmacs. +* added image/tiff support for XEmacs. +* vm-mail-send-and-exit: respect the buffer stack; don't make VM + buffers rise in the stack after sending a message by forcing + the display of a VM buffer with vm-display. +* vm-mail-send-and-exit: don't attach VM buffers to the + unsuspecting frame that we land on after deleting the + composition frame. +* vm-mail-send: protect the value of this-command in a couple of + places. +* Under XEmacs, give the vm-summary-overlay extent a `t' + start-open property to avoid text leaking into that extent from + summary entries earlier in the buffer when such entries are + updated. + +VM 6.07 released (23 January 1997) + +* New variables: + + vm-raise-frame-at-startup + + vm-mouse-track-summary +* vm-goto-new-frame: ditch the sit-for code; it screws with + window-start. +* vm-display: always raise frame if doing a buffer display, + unless invoker says not to. +* vm-preview-current-message: run the select-message hooks before + copying to the presentation buffer. Maybe this will allow the + font-lock stuff that users put on these hooks to work. +* fixed bug where application subtypes were ignored. +* mark folder buffer for update after displaying raw MIME data + with 'D'. The toolbar wasn't being updated. +* add enabled-p function for Quit and Helper toolbar buttons. +* set default values for vm-toolbar-helper-icon and + vm-toolbar-delete/undelete-icon so that greyed buttons are + displayed when a non-VM mode buffer is current. +* vm-inhibit-startup-message variable retired. +* added XEmacs support for audio/basic. +* vm-mime-send-body-to-file: show default filename, if any, in prompt. +* vm-build-virtual-message-list: make virtual folder inherit the + global label lists of all the associated real folders. +* fixed totally gubbed handling of multipart/parallel. +* use shell-command-switch instead of "-c" when running shell + command lines. + +VM 6.06 released (21 January 1997) + +* New variables: + + vm-mime-type-converter-alist + + vm-move-after-killing +* fixed matching of <URL:blah> tags under FSF Emacs to ignore the + bracketing. +* narrow to the message clip region in both the folder and + presentation buffers to avoid confusing peripatetic users who + insist on looking at the wrong buffer. +* bury the folder buffer when using the presentation buffer. + Again this is to make it harder for users to stumble over it. +* changed "Click" to "Click mouse-2" in the buttons so users won't + try mouse-1. +* added support for deprecated "name" parameter of + application/octet-stream to specify a default filename. +* added support for image/png under XEmacs. +* added support for message/partial assembly. +* added support for message/parallel display. +* default charset to us-ascii is some places where it was not + being done. +* set frame deletions hook in the presentation buffer. +* ignore Content-Description header if it is empty or all whitespace. +* fixed vm-mouse-3-help so that balloon help is displayed; first + sexp in a function apparently is always considered to be a + docstring and is not returned. +* be more verbose when doing MIME decoding and display so the + user knows what's going on. +* evade the awful XEmacs file dialog box. +* vm-mouse-send-url-at-position: call `widen' to avoid + referencing a positon outside the clip region. +* complain about invalid virtual selectors if the user enters one. +* keep track of the frames that VM creates so that we don't + delete frames that VM didn't create. +* don't delete frames that VM did not create. +* do a sit-for immediately after creating a frame so that the + status messages will appear in the new frame. This is mostly + for XEmacs. +* vm-make-presentation-copy: don't leave the folder buffered unnarrowed +* filled in some gaps in vm-supported-window-configurations. +* stopped passing vm-Next-message and vm-Previous-message to + vm-display; we use the official names now. +* set buffer-file-type to t temporarily when writing POP + transcript buffer contents to crashbox. +* attach toolbar to frame as well as to buffer if VM created the + frame we're displaying the toolbar on. +* run vm-menu-setup-hook under XEmacs also. +* (require 'disp-table) before calling standard-display-european + to insure that standard-display-table gets initialized _before_ + lambda-binding it (FSF Emacs only). +* vm-options-file -> vm-preferences-file. +* vm-mouse-button-2: don't call vm-preview-current-message; + vm-follow-summary-cursor already does this. +* default value of vm-forwarding-digest-type changed to "mime". +* default value of vm-digest-send-type changed to "mime". +* vm-decode-mime-messages: if message is already decoded, then + display the raw MIME data instead. +* use vm-chop-full-name-function in vm-su-do-recipients instead + of the home brewed regexps. +* vm-display: don't call raise-frame unless either a) the + window's frame we want displayed is not visible, i.e. is + unmapped or iconified, or b) the invoker specifically demands + that we raise the frame. +* vm-scroll-forward/vm-scroll-backward: demand that the folder + buffer frame be raised. +* Shapiro typo fixes + +VM 6.05 released (15 January 1997) + +* New variables: + + vm-popup-menu-on-mouse-3 + + vm-frame-per-completion + + vm-burst-digest-messages-inherit-labels +* fixed bug in vm-set-summary-redo-start-point and + vm-set-numbering-redo-start-point that caused expunges in + virtual folders to have screwy numbering and summary entries + that don't correspond to real messages. +* display MIME messages using non-US-ASCII character sets. (Only + ISO-8859-1 for Emacs 19.34 and XEmacs 19.14, many more for + XEmacs 20.0. +* decode MIME headers, e.g. =?ISO-2022-JP?B?GyRCPGkyLBsoQiAbJEJDTkknGyhC?= +* set buffer-file-type, binary-process-input, and + binary-process-output correctly for DOS and Windows systems. + Hopefully this will cure the MIME decoding problems seen there. +* copy current menubar before toggling menubar to the XEmacs + global menu when running under XEmacs. This is done to avoid + discarding menu entries added by minor modes like mailcrypt. +* support mailto: URLs internally. +* support RFC 1738 <URL:blah> style tags. +* changed some virtual folder selector functions to handle being + passed a virtual message instead of a real message. This + allowed virtual messages to be passed to all selectors, which + is what selectors like vm-vs-marked needed to work properly. +* default value of vm-digest-burst-type changed from "rfc934" to + "guess". +* vm-set-window-configuration: if current buffer is a mail-mode + buffer, use it for the `composition' buffer for window + configuration purposes instead of the one found by + vm-find-composition-buffer. Proximity implies affinity, I + hope. +* typo fix: vm-mm-mime-layout should have been vm-mm-layout in + vm-guess-digest-type. +* vm-scroll-forward-internal: check for vm-text-end-of visible + before attempting to scroll, signal end-of-buffer if it is + visible. +* vm-mime-parse-entity: set buffer to real message's folder buffer +* added extra save-excursion to various functions to protect + against point motion in the buffer to which the function + temporarily switches. +* force display of either the folder buffer or the presentation + buffer after creating the temp folder in the message/rfc822 + internal handler. +* force display of either the folder buffer or the presentation + buffer after sending a message and undisplaying the composition + buffer... this before trying for a window configuration that + is indifferent about displaying any particular buffer. This + should allow the vm-mutable-windows == nil crowd to see the + correct buffer more often after sending a message. +* vm-guess-digest-type: limit search for rfc1153 separator to the + end of the message being burst. +* fixed brokenness in VM's invocation of the FSF Emacs interval + timers so that they actually work now. +* vm-reorder-message-headers: don't cons strings to copy + headers. Use positions instead and move text around solely + via buffer to buffer copies. This should prevent VM from + consing itself and Emacs into oblivion when faced with hundreds + of To/Cc headers. +* display text/html internally using w3-region if w3-region is + bound after (require 'w3). +* consider iso-8859-1 charset messages `plain' for the purposes + of deciding whether MIME decoding is needed. +* made qp decoder not think the end of the region was an equal + sign. +* under XEmacs don't default vm-mime-button-face to + gui-button-face on ttys. gui-button-face is plain on ttys so + use bold-italic instead. +* remove references to underline in the sexpr default for + vm-mime-button-face. +* documentation improvements + +VM 6.04 released (9 January 1997) + +* mime-error -> vm-mime-error +* &optioanl to &optional in def of vm-mime-base64-decode-region +* require some diagnostic output before signaling an error when a + MIME external decoder exits non-zero. +* save-excursion when running quit hook to avoid buffer changes. +* don't call facep if it isn't bound. FSF Emacs when compiled + without window system support doesn't have face support either. +* use reasonable toolbar width and height values if glyph-width + and glyph-height return 0, as they do sometimes at startup. +* typo fixes from Shapiro. + +VM 6.03 released (8 January 1997) + +* made vm-show-current-message use vm-mime-plain-message-p to + decide whether to use the presentation buffer, just as + vm-preview-current-message does, to avoid calling + vm-decode-mime-message when there is no prep'd presentation + buffer. +* fixed calls to vm-run-command-on-region to use apply so that + last arg could be an arg list. +* fixed parsing bug in vm-mime-plain-message-p; use \(.*\) instead of + \\(.*\\) inside a regexp string. +* made vm-decode-mime-message refuse to decode plain messages. +* more work on vm-quit and friends to make sure buffers are + buried or killed when they should be. +* turn off undo record keeping in temp work buffers. +* removed undo button from the fallback VM popup menu under FSF + Emacs. +* vm-mime-send-body-to-file: fixed reversed logic after asking + "File exists, overwrite? " +* fixed (wrong-type-argument (number-or-markerp nil)) bug in + vm-mime-base64-decode-region; botched eob test cause char-after + to be called at eob and the result was used in a numeric + comparison. +* rewrote vm-determine-proper-content-transfer-encoding, fix a + small bug with the line length check. +* fixed parsing of empty MIME bodies +* vm-discard-cached-data: for each affect folder and virtual + folder if there's an associated presentation buffer, call + vm-preview-current-message to rectify the contents of the + presentation buffer with the new reality. +* force inclusion of MIME headers into forwarded and digestified + messages if the message is not plain. +* do CRLF -> LF conversion for text and message types after + base64 decoding. +* disallow multipart types to be sent to an external viewer. +* doc improvements + +VM 6.02 released (8 January 1997) + +* New variables: + + vm-mime-base64-decoder-switches + + vm-mime-base64-encoder-switches +* empty the presentation buffer after expunging if the resultant + folder is empty. +* fixed bug in vm-edit-message; when computing the cursor offset + from the start of the message, it was using the value of point + from the folder buffer when it should have used the value in + the presentation buffer if the latter buffer existed. +* bury the presentation buffer in those places where the folder + buffer and summary are also buried. +* fixed bug in vm-mime-base64-decode-region that would corrupt + the last two bytes in a body if there were two padding bytes of + the end. +* use process-kill-without-query on external viewer processes. +* made vm-run-command-on-region use it arg-list parameter +* decode base64 or quoted-printable text in message bodies yanked into + composition buffers. +* remove undo button from vm-menu-vm-menu, which is the popup + menu that mostly mirrors the main VM menubar. The button + doesn't have much value in a popup menu and I think it is + angering ntemacs. +* ensured case insensitive matching of MIME Content-Type + parameter names. +* don't display the Decode MIME toolbar button, don't enable the + Decode MIME menu entry, and don't use the presentation buffer + if the message is of type text/plain; charset=us-ascii and has + no opaque transfer encoding. +* don't show autosave and backup file names in the *Files* window. + +VM 6.01 released (7 January 1997) + +* fixed bug that caused a message not to be displayed if + vm-auto-decode-mime-messages is non-nil. +* fixed FSF Emacs specific bug that cause mouse-2 and mouse-3 to + not work correctly over URLs. +* fixed vm-mime-burst-layout to allow bursting of all subtypes of + MIME type "message". +* messages of unknown subtypes of MIME type "message" are + displayed as text/plain, which is more likely to be correct + than treating them as message/rfc822. +* added popup menus to the MIME buttons. +* typo fixes + +VM 6.00 released (6 January 1997) + +* MIME reader support, digest send/burst, resend bounce +* New commands: + + vm-burst-mime-digest + + vm-send-mime-digest + + vm-send-mime-digest-other-frame + + vm-decode-mime-message +* New variables: + + vm-display-using-mime + + vm-mime-alternative-select-method + + vm-mime-digest-discard-header-regexp + + vm-mime-digest-headers + + vm-auto-displayed-mime-content-types + + vm-auto-decode-mime-messages + + vm-mime-internal-content-types + + vm-mime-external-content-types-alist + + vm-mime-button-face + + vm-mime-base64-decoder-program + + vm-mime-base64-encoder-program + + vm-temp-file-directory +* Use local-map property on URL overlays so that URLs can now be + activated by pressing RET in FSF Emacs. This feature was + already present under XEmacs. +* Check for buffer-file-name non-nil or buffer-offer-save non-nil + before we warn the user about quitting without saving changes. + Also use this check before trying to save the folder during a + quit. +* vm-mode now sets buffer-offer-save to t. +* panic buffoon's color changed from yellow to rgb:00/df/ff +* made use of the [Emacs] and [Undo] menubar button conditional + on not being under Windows 95 or NT. Those versions of Emacs + don't handle menubar buttons. +* use FSF Emacs' interval timer package if not (featurep 'itimer). + +VM 5.97 released (22 December 1996) + +* temporarily set print-length to nil while VM is writing out + Lisp objects. +* changed vm-menu-support-possible-p to accept 'win32 as a + window-system value that means menu support is possible. +* fixed parse problem in vm-parse-addresses with () and "". Also + change code not to put empty strings recipients in the returned + list. +* made vm-toolbar a user variable. Experimental. +* documentation fixes + +VM 5.96 released (9 June 1996) + +* started shipping a pre-built vm.elc file for those who can't + build VM. +* changed predictate function that determines whether menu support is + possible; there can be window system support without menubar + support. +* changed build procedure to not concatenate .elc files when + building the autoloadable version of the program. The + concatenation broke Emacs' dynamic loading feature, which some + users wanted to use. +* fixed typo in default setting of vm-default-folder-type; if + system-configuration was unbound, vm-default-folder-type would + be set to From instead of From_. +* vm-quit-just-bury: reordered burying and undisplaying actions + again to try to keep undisplaying from bringing one of the + buried buffers back to the top of the buffer list. +* vm-follow-summary-cursor: the position at end of buffer now + belongs to the last message. +* New variables: + + vm-virtual-mode-hook +* use extent-end-position instead of extent-live-p since XEmacs + 19.11 doesn't have extent-live-p. +* added ( and ) to characters that cannot be part of an URL path. +* changed 'count' local variable in let s-exp to 'undel-count' to + avoid conflict with prefix arg parameter also called 'count' +* changed vm-help to use (describe-function major-mode) instead + of (describe-mode) since in Emacs and XEmacs describe-mode + describes minor modes, too. +* fixed infinite loop bug in vm-frame-loop. Needed to make sure + that the frame we start in could never be a minibuffer-only + frame because the loop will never visit a minibuffer-only frame + again and thus never terminate. + +VM 5.95 released (18 August 1995) + +* vm-find-leading-message-separator: for From_ type folders, + removed requirement that there be two newlines before "From " + message separators. +* don't change summary and numbering redo start points once they + are set to t. This got screwed up when I fixed other problems + in vm-expunge-folder. +* vm: always do window configuration setup if doing full startup. +* Shapiro typo fixes +* default value of vm-startup-with-summary now t. +* default value of vm-follow-summary-cursor now t. +* call delete-other-windows before running reporter-submit-bug-report + so the user has the full screen to work with. +* vm-edit-message-other-frame: lambda-bound vm-frame-per-edit to + nil when calling vm-edit-message. +* vm-mouse-send-url: fixed calls to vm-unsaved-message that had a + missing arg. +* vm-keyboard-read-string: make RET do completion and exit the + minibuffer (non multi-word reads only). +* fixed auto correction in vm-read-string. +* set default-directory before running auto-save-mode in + vm-mail-internal so the auto-save file name picks up the + directory change. + +VM 5.94 released (4 August 1995) + +* use window instead of frame in set-mouse-position call (XEmacs + 19.12 only). +* vm-warp-mouse-to-frame-maybe: nil coordinates mean that the + mouse is not really within the frame, so move it. (FSF Emacs + only). +* use regexp-quote on header contents passed to + vm-menu-create-*-virtual-folder functions. +* don't set keymap parents for any extent local keymaps because + this breaks minor-mode-map-alist, which breaks isearch. +* don't actually select frames in vm-frame-loop since this + affects the buffer stack. +* vm-quit-just-bury: moved vm-bury-buffer calls after the + vm-display calls; the latter may have been partially undoing + some of the burying. +* vm-mail-send-and-exit: moved vm-bury-buffer call after the + vm-display call; the latter may have been partially undoing + some of the burying. +* expect From_-with-Content-Length folders by default on IBM AIX + systems. +* added toolbar button help messages. +* added URL balloon help messages +* added electric header balloon help messages +* added status messages for when URLs are sent to browsers. +* added "https" to the URL match regexp. + +VM 5.93 released (25 July 1995) + +* fixed null menu problem if vm-use-menus == 1 (FSF Emacs only); + menu map wasn't being built. +* tollbar -> toolbar typo in vm-toolbar.el. +* vm-find-leading-message-separator: for From_ type added + requirement that something that looks like a header or + ">From " be on the line after the From_ line. +* truncate ultralong buffer names generated by + vm-rename-current-buffer-function. +* vm-auto-archive-messages: don't really save message if the + destination folder is /dev/null. + +VM 5.92 released (19 July 1995) + +* vm-set-summary-pointer: check vm-su-start-of for nil value + before trying to go to its position. +* reuse vm-summary-overlay instead of deleting and recreating it. +* fixed dup menu entries in FSF Emacs menubar toggled menubar. + +VM 5.91 released (19 July 1995) + +* fixed dup menu problem in FSF Emacs. +* vm-expunge-folder: disabled summary updates of expunged messages. +* fixed typo in vm-use-menus default value. +* check for multi-frame support before trying to create a frame + in vm-edit-message. +* efficiency tweaks in vm-toolbar-can-recover-p and + vm-update-message-summary; avoid work most of the time + by testing for the common bailout cases early. + +VM 5.90 released (16 July 1995) + +* use vm-set-deleted-flag-of instead of vm-set-deleted-flag in + vm-expunge-folder. Should make expunging much faster since + many wasted summary updates are eliminated. +* use a different symbol name for every menubar binding, as + opposed to just a different symbol. (FSF Emacs only.) FSF + Emacs seems to match against the names. + +VM 5.89 released (16 July 1995) + +* deal with system-configuration not being bound. +* don't call buffer-substring with three args in + vm-buffer-substring-no-proprerties. buffer-substring only + takes two args in FSF Emacs. +* fixed XEmacs toggle menu button. +* added menu toggle button for FSF Emacs. +* changed Undo menu into an Undo button in FSF Emacs. +* don't fset most of the vm-toolbar-*-command variables if they are + already fbound; lets the user customize them from ~/.vm. +* new semantics for vm-use-toolbar. +* new semantics for vm-use-menus. +* vm-update-message-summary: changed insertion/deletion dance so + that window point moves to the beginning of the current summary + entry instead of the beginning of the next summary entry when + an attribute change occurred and the cursor is in a + summary entry but not at beginning of line. +* added "Recover" toolbar button that appears in conjunction with + "Auto save file is newer..." + +VM 5.88 released (13 July 1995) + +* New variables: + + vm-frame-per-summary + + vm-frame-per-edit + + vm-rename-current-buffer-function + + vm-thread-using-subject +* default window configuration for editing-message now full + screen instead of split with summary. +* moved calls to vm-set-hooks-for-frame-deletion to avoid having + the hooks attached to the wrong buffer. +* swapped first and second args to mapconcat in vm-print-message. +* check for killed folder buffer in toolbar enabled-p functions + to avoid the wildebeest-botfly-toolbar-enabled-p-death-spiral + bug in XEmacs 19.12. Actually it looks like that bug was fixed + before 19.12 was released. +* check for killed folder buffer in menubar enabled-p functions + to avoid the wildebeest-botfly-menubar-enabled-p-death-spiral + bug in XEmacs 19.12. Unlike the toolbar counterpart, this is + bug still exists in 19.12. +* vm-read-file-name: allow old value of file-name-history to be + used if history is nil. +* panic buffoon's color changed from DarkGreen to yellow. +* call device-type without any args. device defaults to + (selected-device) anyway. +* put a save-excursion around the parts of vm-delete-buffer-frame + that might change Emacs' idea of the `current buffer'. Lack of + this save-excursion caused vm-undisplay-buffer-hook for another + buffer to be modified by remove-hook. +* vm-read-string: don't pop up mouse interface if the completion + list is empty. instead just run the keyboard interface. +* don't try to add to menubar if it is nil. (XEmacs only) +* recognize rmail, rmail-input and rmail-mode as alternate names + for vm. for (defalias 'rmail 'vm). +* Shapiro typo fixes. +* match Content-Length header case insensitively. +* hide the 19.29 Help menu; tag moved from help to help-menu. +* don't log uninteresting status messages in *Messages* + log. (Emacs 19.29 only.) +* use vm-save-restriction instead of save-restriction in + vm-run-message-hook. +* vm-show-list: fix lossage if list item is wider than the + window; avoid division by zero by setting a min value of 1 for + columns. +* vm-easymenu.el: If callback is a symbol use it in the menu + keymap instead of the uninterned menu-function-XXX symbols. + This allows Emacs' menu code to set this-command properly + when launching a command from the menubar. +* default value of vm-convert-folder-types is now t. +* instead of putting buffer objects into the virtual folder spec + for anonymous virtual folders, use a s-expression that returns + a buffer object. +* fixed bug where forwarding a zero length message would put the + forwared message outside the digest separators. +* default values of vm-trust-From_-with-Content-Length and + vm-default-folder-type now vary depending on the system type. + Solaris and usg-unix-v users are set to use Content-Length + folders. +* support mail-archive-file-name and mail-self-blind in + vm-resend-message. +* xbm bitmaps added for XEmacs 19.13 xbm toolbar support. +* fixed infinite loop bug in vm-window-loop. Needed to make sure + that the window we start in could never be a minibuffer window + because the loop will never visit a minibuffer window and thus + never terminate. +* obfuscated calls to screen-* in vm-warp-mouse-to-frame-maybe to + avoid stimulating the Emacs 19.29 byte compiler bug. +* prefer References over In-Reply-To when looking for a message + parent when threading. +* fixed infinite loop bug in vm-mark-thread-subtree; check for + messages that we've already seen to avoid child is a parent of + the child problem that can occur in subject threading. +* strip text properties from all strings to be used in the + attributes and summary cache. It should be OK now to use + font-lock (i.e. text properties) in a VM folder buffer under + FSF Emacs now. + +VM 5.87 released (16 June 1995) + +* New variables: + + vm-search-other-frames + + vm-summary-update-hook +* when searching for a window displaying a buffer, always search the + selected frame first. +* frame-map slot of window configuration set to nil to avoid + unreadable objects being printed into the window configuration + file. +* vm-menu-print-message -> vm-print-message +* made the highlight-headers-regexp defvar in vm-vars.el match the + one in XEmacs' highlight-headers.el so it doesn't matter if VM + is loaded before highlight-headers.el. +* warp mouse to center of frame instead of left corner. +* only run vm-arrived-message-hook on new messages not messages + already in the folder at startup. +* fixed bug where a message deletion in one folder caused the + "undelete" toolbar button to appear in another folder. +* Shapiro typo fixes + +VM 5.86 released (6 June 1995) + +* toolbar support (XEmacs 19.12 only) +* New commands: + + vm-print-message +* New variables: + + vm-use-toolbar + + vm-toolbar-orientation + + vm-print-command + + vm-print-command-switches +* vm-summary-highlight-face's default value is now 'bold (was nil). +* vm-highlighted-header-face's default value is now 'bold (was 'highlight). +* vm-mail-send-and-exit: always undisplay buffer if it is alive + after runnning vm-mail-send. Previously it would undisplay + only if the current buffer were the same after running vm-mail-send. +* fixed call in vm-bury-buffer to pass the argument to along + bury-buffer. +* region not narrowed properly for vm-display-xface, so it + searched the whole message, which in turn could cause selection of + large messages to take a looong time. Fixed. +* vm-display-xface: use set-glyph-face instead of + set-extent-face. +* dropped 'highlight property from the xface extent. +* if non-nil let vm-highlighted-header-regexp override + highlight-headers-regexp so user can have VM specific highlight + if desired. This was done before, but was undone in one of the + releases. +* rolled (save-window-excursion (switch-to-buffer ...)) into + vm-unbury-buffer. +* used vm-unbury-buffer in vm-continue-composing-message to avoid + having the window configuration code pick a different composition + buffer than vm-continue-composing-message did. +* added netbsd to the system types that get + vm-berkeley-mail-compatibility turned on by default. +* clickable *Completions* +* mouse triggered commands now use mouse interface to read filenames. +* mouse triggered commands now use mouse interface to do + completing reads of strings. +* fixed typo in completion list show function tab-stop-list -> + tab-stops. This was causing the ragged completions display. +* vm-sort-messages: signal error is no sort keys provided. +* vm: moved visited-folders-menu installation and the running of + vm-visit-folder-hook so that they are executed even if "auto + save file is newer ..." +* fixed places where VM was unconditionally warping the mouse. +* added (provide ...) calls for all vm-*.el files. +* added version number to vm-mode help. + +VM 5.85 released (2 June 1995) + +* dropped reporter.el and timezone.el from distribution +* merged tree-menu.el into vm-menu.el; renamed functions to avoid + conflicts with the real tree-menu.el. +* no more SUPPORT_EL and SUPPORT_ELC in Makefile +* New variables: + + vm-warp-mouse-to-new-frame + + vm-use-lucid-highlighting + + vm-display-xfaces +* patched vm-current-time-zone to understand timezone offsets + that are not an integral number of hours from GMT. +* frame deletion hooks now detach themselves from buffer after one + execution. +* added menubar buttons to toggle between buffer local and global + menubars (XEmacs only). +* lambda-bound vm-follow-summary-cursor to t in vm-mouse-button-2 + so mouse-2 selection in the summary will always work. +* make vm-select-frame a no-op in tty-only Emacs +* use set-specifier to turn off horizontal scrollbar instead of + the variable buffer-scrollbar-height, which is gone + now. (XEmacs 19.12 only) +* changed vm-url-regexp to not match some common trailing + punctuation. +* added missing call to vm-move-message-pointer to + vm-next-message so that it would start at the message after the + current message when vm-circular-folders is non-nil and a move + is being retried non-dogmatically. +* fixed args to re-search-forward in the URL search code. The + search bound wasn't being set. +* vm-find-trailing-message-separator: if Content-Length header + doens't point to the start of another message or end of folder, + search for "^From " starting at the original search point. We + used to start at the point Content-Length told us to go, but + that can make VM clump many messages together if the incorrect + Content-Length value is very large. +* fixed logic in vm-display so that if the buffer is visible and + is required to be displayed and the applied window + configuration undisplays it, notice and display it again. +* region not narrowed properly for vm-energize-headers, so it + searched the whole message, which in turn could cause selection of + large messages to take a looong time. Fixed. +* bury-buffer -> vm-bury-buffer in most places. vm-bury-buffer + buries the buffer in all frames (XEmacs only). No change in + behavior for FSF Emacs. +* fixed vm-expunge-folder: numbering and summary redo start points may need + to be recomputed on each iteration of the message loop in the + case of virtual mirrored expunges. The code previously assumed + the first expunged message in a folder would correspond to the correct + redo start point. This is only true for unmirrored virtual + expunges or real expunges. +* dropped duplicate Reply-To from vm-resend-bounced-headers. +* Shapiro typo fixes. + +VM 5.84 released (26 May 1995) + +* fixed known-virtual-folders menu to use vm-visit-virtual-folder + instead of vm-visit-folder. +* vm-continue-composing-message now creates a frame for the + composition if vm-frame-per-composition is non-nil. +* fixed vm-iconify-frame-xxx so that it gives iconify-screen an + arg since it churlishly requires one. +* vm-delete-buffer-frame: added condition that the target frame + must be the selected frame to be unconditionally deleted. Also + added call to vm-delete-windows-or-frames-on to clear remaining + windows and frames that might be displaying a buffer. +* Added Visit tags to the known-virtual-folders and + visited-folders menus. + +VM 5.83 released (25 May 1995) + +* fixed incorrect mode menus selection that was due to mode-popup-menu being + set before major-mode. +* fixed menubar Dispose menu +* made vm fall back to `folder' if `primary-folder' parameters not + specified in vm-frame-parameter-alist. +* vm: at startup, reuse summary frame if available when looking + for a frame displaying the folder buffer. Supposedly did this + in 5.82 but I fluffed the change. +* dropped second arg 't' to vm-sort-messages in the menus. Legacy + stuff from 5.72.L, bad juju. +* renamed support packages to vm- prefixed names to keep from + picking up old or non-vm-simpatico versions. +* vm-easymenu.el: renamed a couple of easy-menu- functions to + further avoid picking up bad versions. +* zapped "File" menu when VM is using the whole menubar. Should + have been zapped already but file -> files in 19.29 and I'm + testing mostly with 19.29. +* moved frame creation before call to vm-preview-current-message + in vm. Try to help the BBDB crowd. +* made the options file optional, as it should be. +* added "Mail" item to menubar in mail-mode (XEmacs only). +* Folders menu deep-sixed for FSF Emacs. + +VM 5.82 released (25 May 1995) + +* New commands: + + vm-iconify-frame +* New variables: + + vm-iconify-frame-hook + + mode-popup-menu (FSF Emacs only, XEmacs already has this) +* full menubar for FSF Emacs. +* popup menu for vm-mode, vm-summary-mode and vm-virtual-mode is + now the Dispose menu, rather than the whole VM menu set. +* menu consolidations +* set keymap parent of vm-mail-mode-map to mail-mode-map. +* run URL browsers as background commands so that when you quit Emacs + you don't have to quit the browser. +* fixed "M A" and "M a" bindings to point to correct commands. +* vm-visit-virtual-folder: moved summary display after folder + display so the summary is displayed in the correct frame. +* vm: at startup, reuse summary frame if available when looking + for a frame displaying the folder buffer. +* disable "Make Folders Menu" entry if vm-folder-directory is + nil. +* popup menus for the Subject and From headers. +* fixed "new directory" menu to allow mkdir in + vm-folder-directory itself. +* "emacs -f vm" now ignores vm-frame-per-folder. +* added `primary-folder' frame type for vm-frame-parameter-alist. + +VM 5.81 released (22 May 1995) + +* backquote use in menu and mouse code removed, due to use of newer backquoting + features that were unsupported in older Emacses. +* Shapiro typo fixes. + +VM 5.80 released (22 May 1995) + +* vm-su-do-author still not quite right, code not falling through + to chop-full-name phase if Full-Name header existed but was empty. +* fixed reversed sense of Page Up/Down menu items. +* added "physical order" to the sort menu. +* match-fetch-field -> mail-fetch-field in vm-menu-can-send-mail-p. +* use two lines of "---" instead of "===" for compatibility with + XEmacs 19.11. +* changed how vm-folder-history is updated. Now VM always + updates the variable itself, and doesn't let read-file-name + alter it. This is so we get a real history of folders visited, + and not a history of what the user typed, typos and all. +* New variables: + + vm-url-browser + + vm-url-search-limit + + vm-highlight-url-face + + vm-netscape-program + + vm-mosaic-program + + vm-menu-setup-hook +* popup menu in Mail Mode now works if you run vm-mail before + any other VM command. An initialization omission broke this + before. + +VM 5.79 released (19 May 1995) + +* New commands: + + vm-mark-messages-same-author + + vm-unmark-messages-same-author +* New variable: + + vm-frame-parameter-alist +* don't update vm-folder-history for XEmacs, it's done + automatically. Continue to update vm-folder-history for FSF + Emacs since it needs it. +* updated various Emacs-typecheck functions to rely on the + contents of emacs-version first and foremost. +* vm-mouse-set-fsfemacs-mouse-track-highlight changed to use + overlays instead of text properties. + +VM 5.78 released (18 May 1995) + +* needed to pass file history as sixth arg to read-file-name + instead of fifth arg. +* needed to pass variable name as history instead of its value. +* FSF Emacs' read-file-name doesn't take six args, needed a wrapper + function to pass it only five args if it balks at six. +* stopped using add-hook for vm-folder-history +* vm-other-frame and vm-visit-folder-other-frame needed wrappers + to set vm-frame-per-folder to nil so they wouldn't create too many + frames. + +VM 5.77 released (18 May 1995) + +* send APOP command with two args instead of one, as the spec demands. +* vm-display-buffer makes the buffer to be displayed or + undisplayed the current buffer before searching for display + hooks. Useful for having buffer local display hooks. +* start n at 2 in vm-rename-current-mail-buffer. +* indention -> indentation +* integrated Heiko Muenkel's vm-folder-menu.el; required addition + of tree-menu.el to distribution. +* New file: vm-menu.el, which contains the menus and menu code. +* New variables: + + vm-frame-per-folder + + vm-frame-per-composition + + vm-use-menus +* New commands: + + vm-quit-just-iconify +* New files: + + easymenu.el + + tree-menu.el + + vm-mouse.el + + vm-menu.el +* mouse support +* vm-pipe-message-to-command now takes 3 C-u's to mean use the + visible headers plus the text section. +* changed vm-munge-message-separators to munge messages in + From_-with-Content-Length folders, too. Necessary now since + From_-with-Content-Length parsing falls back to a pseudo type + From_ if no Content-Length header is found. This fixes a + digest bursting bug that occurred if From_ message separators + appeared in a message that was being burst into a + From_-with-Content-Length folder. +* strip doublequotes from recipient full names as we do for sender full + names. +* Changed Makefile to use vm-byteopts.el for the support stuff + too. +* updated vm-grok-From_-* to reject inappropriate types better. +* made vm-next-command-uses-marks set this-command. Needed for + the menubar invocation of the command. +* vm-su-do-author: moved blank full name test before the address + gets chopped. Also changes search regexp from "^[ \t]+$" to + "^[ \t]*$" to catch "". +* added a folder history list which is used by vm-visit-folder*. +* composing-message default configuration changed to "full screen + composition". Previously it was "summary on top, composition + on bottom". + +VM 5.76 released (7 May 1995) + +* "\.el$" -> "\\.el$" in make-autoloads. +* moved message separator unstuff call before the header + conversions in vm-rfc1153-or-rfc934-burst-message. Unstuff + must come first or the Content-Length offsets might be + invalidated by it. +* if full name is just whitespace, use the address instead in summary cache. +* vm-burst-digest now can be invoked on marked messages via + vm-next-command-uses-marks. +* prefix arg to isearch commands now toggles value of + vm-search-using-regexps. +* don't delete after saving when archiving if vm-delete-after-saving + is non-nil and vm-delete-after-archiving is nil. +* fixed bug in vm-physically-move-message that was causing + vm-headers-of marker corruption. This bug could have caused + serious folder corruption in BABYL folders, due to the headers + that are copied for this folder type. +* turned off dynamic docstrings and lazy loading in + vm-byteopts.el. This is a preemptive strike against the new + features of the byte compiler that will appear in FSF Emacs + 19.29. +* docstring typo fixes. + +VM 5.75 released (30 April 1995) + +* reinstated code that turns on auto-save-mode in + vm-mail-internal. Thought it was redundant; it ain't. +* fixed bug in vm-set-xxxx-flag. The same message was being put + into all the undo record lists, which loses when the folder + containing that message goes away. +* fixed bug in vm-save-message. needed to call + vm-error-if-folder-empty in the (interactive ...) spec before + relying on the value of vm-message-pointer to have a non-nil + value. +* fixed bug in vm-convert-folder-type-headers; search for + trailing message separator was starting in the wrong place--- + needed an extra save-excursion around code that computed + content-length. +* fixed bug in vm-find-trailing-message-separator. Needed to + move backward to start of separator after the fallback "^From " + search. +* output from movemail is no longer considered fatal. If + call-process returns a number, then the error is considered + fatal only if this number is non-zero. Otherwise upon + unexpected output, a warning message is issued and VM carries + on. +* added status message in vm-pop-move-mail to count out messages + as they are retrieved. + +VM 5.74 released (24 April 1995) + +* added new test data for mail-extract-address-components to + catch its failure to handle "" in some older versions. +* expand ~/ instead of ~ in vm-mail-internal, so that + default-directory's value ends in a slash. +* fixed bug in vm-{next,previous}-message-same-subject that left + vm-message-pointer at the wrong position if the search for a + message with the same subject failed. +* FSF Emacs 19.28.90 breaks make-autoloads by adding a *Messages* + buffer with a default-directory different from the directory VM + started in. This buffer ends up being selected, which makes + find-file-noselect not read in the wanted VM source file. + Fixed this. +* From_-with-Content-Length folder type now less strict. + (Uncle!) If the position indicated by Content-Length doesn't + look like a message separator point, VM searches forward for a + line beginning with "From ". A side effect of this is that a + bug is fixed in the digest bursting code that affected bursting a + message in a From_-with-Content-Length folder. +* skip >From at the beginning of MMDF messages. I don't know if + SCO is at fault or SCO system sysadmins, but I'm tired of these + bug reports. +* <= should have been >= in tapestry-first-window, oops. +* in vm-discard-cached-data, the header markers needed to be + discarded before the message was rethreaded, otherwise the + threader and summary functions would use the invalid markers. +* Shapiro typo fixes + +VM 5.73 released (7 April 1995) + +* allow a default non-nil value for vm-folder-read-only to work. +* moved the running of vm-arrived-message-hook into + vm-assimialte-new-messages. +* expand folders, crash box and primary inbox using vm-folder-directory + as root if path is relative; this wasn't being done everywhere. +* new reporter.el +* stop padding the monthday +* added reply-to to the default value of vm-resend-bounced-headers +* if mail-default-reply-to == t init with (getenv "REPLYTO") for + compatibility with FSF Emacs v19.29 change. +* changed vm-pop-send-command to not put the user's password in + the trace buffer. +* set default-directory to either vm-folder-directory or ~ in + vm-mail-internal. This cut down on autosave errors due to + unwritable directories. +* fixed bug in tapestry.el that caused recreation of tapestries + with horizontally split windows to be off by one in size. +* made tapestry.el use window-pixel-edges in XEmacs, if + available. Apparently the window-edges function is going away. +* fixed bug in tapestry-first-window. menu-bar-lines frame + parameter can be non-zero when Lucid menubar is enabled even + though the menubar doesn't steal lines form the topmost window. +* fixed bug in vm-build-virtual-message-list, the next folder + after a directory in the virtual folder spec was being skipped. +* vm-thread-indention -> vm-th-thread-indention typo +* fix call to error in vm-help-tale, too many args. +* vm-run-user-summary-function was using the virtual message in + some contexts; changed to use the real message in all contexts. +* changed vm-set-edited-flag-of to a function, rolled common code + from several functions that use vm-set-edited-flag-of into it, + made the buffer modification flag always get set when the + 'edited' flag changes. +* New variable: vm-arrived-messages-hook. +* removed call to auto-save-default in vm-mail-internal as I + don't see why it would ever be needed. +* changed vm-get-folder-type to accept start and end args; + vm-pop-retrieve-to-crashbox uses these to specify where to scan + in the POP trace buffer to determine if there is a folder type. +* %+ -> %& in mode line spec. %+ got usurped by RMS into + something else. %& now does what %+ was supposed to do. +* fixed bug in vm-expunge-folder. It did not work properly with + marks because parts of the code assumed that mp always traversed + vm-message-list, which was not true if marks were being used. +* made the virtual folder spec parser skip auto-save files and + backup files when globbing the contents of a directory. + +VM 5.72 released (29 May 1994) + +* doc fixes +* fixed vm-after-revert-buffer-hook to not attack non-VM buffers. +* changed calls to find-file-name-handler to specify the + operation; I don't care why. +* run hooks in vm-arrived-message-hook for messages returned by + the call to vm-assimilate-new-messages. +* call vm-find-leading-message-separator before calling + vm-skip-past-leading-message-separator in the vm-stuff- + functions. This avoids stuffing headers before the leading + message separator due to vm-skip-past-leading-message-separator + being confused by newlines at the beginning of folder. + +VM 5.71 released (25 May 1994) + +* (fboundp 'mail-signature-file) -> (boundp 'mail-signature-file). + graaaggg. +* vm-mutable-window non-nil non-t special behavior + eliminated. +* added `exit-minibuffer' to the list of commands VM will do + window config setup for. This is so that recover-file and + revert-buffer, which read from the minibuffer but do not + protect the value of this-command, have window configuration + done for them. +* fixed VM support for revert-buffer for v19.23 Emacs; + revert-buffer now preserves some marker positions across the + reversion and this hosed VM's check for reversion since it used + the marker clumping as an indicator of the reversion. v19.23 + has a new after-revert-hook that VM uses. +* Shapiro and Foiani typo fixes. + +VM 5.70 released (18 May 1994) + +* added missing quote in (fboundp mail-signature-file) in vm-reply.el. + +VM 5.69 released (18 May 1994) + +* vm-munge-message-separators needed (goto-char start). +* fixed vm-munge-message-separators to pay attention to + first arg, folder-type. +* fixing vm-munge-message-separators exposed a bug in + vm-convert-folder-type; trailing message separators were getting + munged inappropriately because of a bad search bound due to a + marker being shifted. +* digest bursting code also needed to be fixed, now that + vm-munge-message-separators is actually doing the (goto-char start); + match-data needed to be saved and restored, needed to start + munging after inserting the leading message separator instead of + before inserting it. +* moved message order gobbling into vm-assimilate-new-messages; + needed because thread sorting is done there and message order + gobbling needed to be done before thread sorting. +* In FSFmacs 19.23, find-file-name-handler takes two args, it + used to take only one. The second arg is not optional. Fixed + code to deal with the one or two arg versions of this function. +* tink message modflag if we encounter a v4 attributes header in + vm-read-attributes. The idea is that if the user saves the + folder we get rid of those retro headers, so the user gets a + fast summary thereafter. +* get rid of vm-unhighlight-region, since it adds text properties + that we definitely don't want to find their way in the summary + cache headers. +* made signature insertion work more like mail-mode; use + mail-signature-file for lemacs compatibility, insert the + mail-signature string itself, instead of using it as a file + name (oops). +* don't go to point-max if to is null in vm-mail-internal--- keep + point just after the header/text separator line. +* added the word "encapsulation" to RFC 934 digest start. +* fixed babyl label reading bug; needed to skip past comma after + attributes. +* use regexp-quote on mail-header-separator before using it as a + search string; can't count on users not putting plusses and other + regexp crap in it. +* dropped def of vm-highlight-region. +* dropped the spaces after the commas in the label strings. + Previous convention seems to be to not display them. +* doc string fixes. + +VM 5.68 released (12 April 1994) + +* vm-resend-bounced-message now strips Sender. +* for From_-with-Content-Length in vm-find-leading-message-separator + use (match-end 1) instead of (match-beginning 0). +* fixed code in vm-find-trailing-message-separator so that it + allows mutiple bogus newlines at the end of a message at the + end of a From_-with-Content-Length folder. Turns out this code + is really needed, and I found out after I broke it. +* vm-byte-count -> vm-su-byte-count in vm-save-message. +* removed unneeded (setq vm-need-summary-pointer-update t) forms in + vm-motion.el. +* don't flush in vm-flush-cached-data if vm-message-list is nil. +* header highlighting is now done using overlays + instead of text properties in FSF 19. This should cure the + "text property leaking in to the summary cache" problem. +* summary highlighting is now done using overlays in FSF Emacs and + extents Lucid Emacs 19. +* header highlight under Lucid Emacs is now done using the + out of the box header highlighting functionality. +* Shapiro typo fixes. + +VM 5.67 released (6 April 1994) + +* used match-end instead of match-beginning in + vm-find-leading-message-separator for From_-with-Content-Length + folders. (ack!) +* revised some docstrings. +* added docstrings for many internal functions. +* made vm-find-and-set-text-of to set start of text section to + (point-max) if \n\n wasn't found. This is more likely to be + right than setting it to (point) when the search fails. +* put kludge in make-autoloads to deal with v19 autoload fifth + arg breakage. +* vm-auto-archive-messages now natters about what it's doing, + since it's often long running and slow. +* don't stuff labels unless there are messages in the folder. +* fixed a couple of calls to format that had too few args. + +VM 5.66 released (26 March 1994) + +* added call to vm-unhighlight-region to turn off highlighing of + headers gathered from the folder buffer. +* set current buffer to real message's buffer, not virtual + message's buffer, in vm-save-message-sans-headers. +* use `signal' with folder-read-only instead of calling `error' + in vm-save-message. +* fixed type mismatch error message in vm-save-message; must use + (vm-message-type-of m) instead vm-folder-type because current + buffer is the target folder buffer and not the source buffer + during buffer->buffer saves. Went ahead and changed the + buffer->file code for consistency. +* changed all calls to get-file-buffer to vm-get-file-buffer, + which makes all file->buffer mapping try truenames as well as + unchased names. +* allow leading newlines in From_ and From-_with-Content-Length + type folders. +* allow multiple trailing newlines in From-_with-Content-Length + type folders. +* moved call to vm-convert-folder-type-headers up a bit in + vm-convert-folder-type, as content-length header generation + needs the old folder type's trailing message separator to be + present. This makes everything-but-mmdf -> + From_-with-Content-length crash box conversion work right. + Apparently no one ever tried this. +* moved call to vm-convert-folder-type-headers up a bit in + vm-change-folder-type, as content-length header generation + needs the old folder type's trailing message separator to be + present. This makes everything-but-mmdf -> + From_-with-Content-length folder conversion work right. + Apparently no one ever tried this. +* fixed marker shift problem in vm-change-folder-type that caused + inserted trailing message separators to be stripped. + Conversion from From_-with-Content-Length to other folder types + triggered this because there's no trailing message separator + for From_-with-Content-Length folders. +* don't clump messages together if Content-Length is wrong. + this meant moving the content-length goop from + vm-find-leading-message-separator to + vm-find-trailing-message-separator, which is where it should + have been anyway. +* insert "-- \n" before the signature. not worth the + argument or unending bug reports. +* fix code that assumes a non-nil value for buffer-file-name in + folder buffers. + +VM 5.65 released (17 March 1994) + +* fixed reverse link bug in vm-expunge-folder that was causing + renumbering to bug out. +* "folder buffer has been deleted" for those who could not figure + this out on their own. +* dot unquote fix in 5.64 wasn't quite right; try again. +* turning off threading now sorts by physical order to avoid the + misleading modeline display. +* vm-{mark,unmark}-message-same-subject now follows the summary + cursor. +* fixed logic error in vm-unthread-message; messages without + parents were not being unthreaded. +* dropped unused ref to unread-command-event. +* same subject mark commands now report the number of messages + they mark or unmark. +* don't mark buffer modified unless sort actually changed the + message order. +* dropped vm-preview-current-message call in vm-save-folder; + we'll see what the effects are. + +VM 5.64 released (9 March 1994) + +* dropped call to widen in vm-do-reply, unneeded now that + vm-yank-message is called instead of doing the yanking + internal to vm-do-reply. +* always do the stuff in vm-set-buffer-modified-p regardless of + the real modified flag's value. +* unquote _all_ leading dots in inbound POP messages. +* don't call vm-preview-current-message in an possibly empty + folder in vm-assimilate-new-messages. +* don't override pre-sort by calling vm-gobble-message-order in vm. + +VM 5.63 released (7 March 1994) + +* Shapiro typo fixes +* dropped duplicate buffer suppression in vm-build-virtual-message-list; + not currently needed and doesn't work anyway. +* avoid globally setting tab-stop-list in vm-minibuffer-show-completions. +* fixed free var ref "form" in vm-read-password. +* dropped some unreferenced vars in tapestry.el +* replaced (get-file-buffer buffer-file-name) with + (current-buffer) in vm-get-spooled-mail, an obvious + optimization. +* check inbox against name and truename in vm-get-spooled-mail to + avoid being tripped by find-file-visit-truename being non-nil + and get-file-buffer's obliviousness thereof. + +VM 5.62 released (6 March 1994) + +* vm-burst-digest was honoring vm-delete-after-bursting in the + real folder instead of the virtual one; fixed. +* vm-add-message-labels didn't work in a virtual folder because + vm-label-obarray was uninitialized; fixed. +* onw -> one in vm-visit-folder-other-window +* vm-get-new-mail, and vm-save-folder now map themselves over the + associated real folders when applied to a virtual folder. +* since vm-save-folder now has a meaning when applied to virtual + folders, vm-save-and-expunge-folder works for virtual folders. +* moved (intern (buffer-name) vm-buffers-needing-display-update) + into vm-set-buffer-modified-p and out of vm-save-folder. +* incremented vm-modification-counter in vm-toggle-virtual-mirror. +* incremented vm-modification-counter in vm-build-virtual-message-list. +* fixed vm-su-line-count to use the real message offsets, not + the virtual message offsets. +* fixed expunge in unmirrored virtual folder to remove virtual + messages from the virtual message list of the real message. + +VM 5.61 released (3 March 1994) + +* moved vm-session-initialization and vm-load-init-file to + vm-startup.el so as to avoid autoloading vm-folder.el for M-x + vm-mail. +* removed call to vm-follow-summary-cursor from vm-mail so as to + avoid autoloading vm-motion.el for M-x vm-mail. +* added L to regexp string in vm-compile-format. +* changed vm-error-if-folder-empty to complain about the folder + type being unrecognized if that is the reason the folder is + deemed empty. +* changed modeline to reflect the "unrecognized folder type" + condition. +* use epoch::selected-window instead screen-selected-window if it + is fbound. + +VM 5.60 released (1 March 1994) + +* vm-set-edited-flag -> vm-set-edited-flag-of +* forgot to fix interactive spec of vm-yank-message; fixed. +* vm-search18.el: signal error if vm-isearch is attempted in a + virtual folder. + +VM 5.59 released (26 February 1994) + +* was calling pos-visible-in-window-p in wrong window in + vm-scroll-forward; fixed, which takes care of preview/scrolling + problems introduced in VM 5.58. +* fixed interactive spec of vm-yank-message-other-folder +* call vm-yank-message with only one arg in + vm-yank-message-other-folder +* made vm-help-tale be a little less rude. +* '?' gives help in vm-read-string +* dropped top level requires in favor of autoloads +* use vm-selected-frame everywhere, instead of error-free-call +* do multi-screens in Lucid Emacs like multi-frames in FSFmacs. + +VM 5.58 released (26 February 1994) + +* New variables: + + vm-included-text-headers + + vm-included-text-discard-header-regexp + + vm-summary-highlight-face +* New commands: + + vm-add-message-labels (la) + + vm-delete-message-labels (ld) + + vm-virtual-help (V?) +* new semantics for vm-yank-message +* lookup vm-spool-move-mail and vm-pop-move-mail in + file-name-handler-alist. +* set stop-point properly if using marks in + vm-auto-archive-messages. +* in Makefile rm -f vm-search.el to evade a read only copy. +* don't assume the subject thread obarray is setup properly or + ditto for the message id thread obarray. User may have + interrupted the thread build and screwed things up. +* V? gives some help for V commands. +* put ... after mark help. +* Shapiro typo fixes. +* switch to virtual buffer before comparing edited message to + current message. also compare the underlying real messages + instead of the possibly virtual ones. this makes the current + message be repreviewed appropriately if it is virtual. +* don't generate a summary in vm if recover-file is likely to happen, + since recover-file does nothing useful in a summary buffer. +* changed VM to use \040 instead of \020 in babyl attribute parsing code. + obvious error in babyl spec. +* small change to vm-minibuffer-complete-word to handle label + reading. since we don't demand a match for label reads, we + have to let the user insert a space for multi-word reads. +* undo now says what it is doing. +* undo now moves the message pointer to the message that it is + affecting. +* fixed vm-scroll-forward to mark message as read _and_ scroll + when point-max isn't visible on screen. should help with + vm-preview-lines == t. + +VM 5.57 released (18 February 1994) + +* added missing refs to -other-window and -other-frame commands in + root commands so that window configurations work. +* shuffled targets in Makefile a bit. +* integerp -> natnump in vm-start-itimers-if-needed +* doc string updates. +* added missing -other-frame to the send-digest commands that + needed them. fixes the infinite frames, infinite recursion + problem. +* don't assume a match when descending a nested auto folder + alist. +* Shapiro typo fixes. +* New commands: + + vm-set-message-attributes (bound to `a') +* made vm-auto-select-folder signal errors. +* default value of vm-check-folder-types is now t. +* fix modeline at end of vm-auto-archive-messages; + vm-save-message whacks it. +* use unwind-protect in vm-auto-archive-messages to make sure + mode line gets fixed if there's an error. +* deal with type 'unknown' in vm-save-message and vm-gobble-crash-box +* warn user about unparsable filth at end of folder. +* fixed typos of &optional in vm-startup.el +* indicate when threading display is enabled in the summary modeline. +* clear modification flag undos after saving folder. +* always setting vm-system-state to showing is wrong; changed it + back to the way it was before 5.56. +* display sort keys in summary modeline when they are valid. +* used more care when lambda-binding inhibit/enable-local-variables + must be careful not to change buffers while inside such a let + binding as it might screw users who set local values of those + variables. + +VM 5.56 released (14 February 1994) + +* vm-save-folder no longer expunges, this also means that 'q' and + 'S' keys no longer expunge. +* New commands: + + vm-save-and-expunge-folder + + vm-quit-just-bury + + vm-other-frame + + vm-visit-folder-other-frame + + vm-visit-virtual-folder-other-frame + + vm-mail-other-frame + + vm-reply-other-frame + + vm-reply-include-text-other-frame + + vm-followup-other-frame + + vm-followup-include-text-other-frame + + vm-send-digest-other-frame + + vm-send-rfc934-digest-other-frame + + vm-send-rfc1153-digest-other-frame + + vm-forward-message-other-frame + + vm-forward-message-all-headers-other-frame + + vm-resend-message-other-frame + + vm-resend-bounced-message-other-frame + + vm-edit-message-other-frame + + vm-summarize-other-window + + vm-other-window + + vm-visit-folder-other-window + + vm-visit-virtual-folder-other-window + + vm-mail-other-window +* New variables: + + vm-quit-hook + + vm-digest-identifier-header-format + + vm-confirm-mail-send +* non-nil non-t vm-delete-empty-folders now means ask first. +* select last message in real folder instead of first at startup + if no unread messages are present (vm-thoughtfully-select-message). +* in vm-get-spooled-mail expand inbox file name rooted in folder + directory if path is relative. +* don't do physical order sort unless moving messages physically + in vm-sort-messages. avoids markers pointing to nowhere at + virtual folder startup with the threads display enabled. +* don't call display-buffer in vm-display-buffer unless + vm-mutable-windows is t. +* always set vm-system-state to showing in vm-show-current-message, + even if message is not visible. The message-not-visible case is + handled in vm-scroll-forward. +* moved window config of vm-quit to the beginning of the command + instead of the end. +* added new window configuration action class: quitting +* don't assume new and unread flags are mutually exclusive in + vm-show-current-message, they aren't for babyl folders. +* fixed tapestry-set-window-map to coerce Emacs into giving space + to the right window in the root window case. Works for FSF + v19 Emacs. +* ignore trailing spaces in subject for threading and other "same + subject" purposes. +* changed call to vm-update-summary-and-mode-line to + vm-preview-current-message in the new same-subject motion + commands (oops). +* gave vm-virtual-mode a docstring. +* don't allow vm-auto-archive-messages to recurse if a message + archives to the same folder that it currently lives in. +* slightly restructured modeline to deal with new and unread flags + both being set in babyl messages. +* burst digest fixes for From_-with-Content-Length and babyl + folders. +* make require-final-newline be buffer local in VM buffers. +* don't set vm-block-new-mail in vm-mode-internal; it messes up + the value set by the file recovery code. +* dropped frame configuration part of VM window configuration + code. too restrictive. +* use vm-default-folder-type in vm-save-message for empty folders. +* don't use sets for marking messages for summary updates; just + consing up a list is much faster and the dups don't matter much + with the speedy new summary code. +* use an obarray for vm-buffers-needing-display-update +* dropped sets.el from the distribution. +* put cursor in the To header for vm-resend-bounced-message. +* don't do Berkeley Mail compatibility stuff unless the current + folder type is From_. +* use unwind-protect in vm-stuff-attributes to make sure folder + modified status is reset properly on non-local exit. +* don't change modflag-of for virtual messages in + vm-build-virtual-message-list; virtual messages don't use this + flag anyway. +* added a level of indirection for virtual-messages-of so print + will work on a message struct. + +VM 5.55 released (9 February 1994) + +* vm-set-babyl-frob-flag -> vm-set-babyl-frob-flag-of +* rewrote vm-delete-duplicates again; this one doesn't pitch the + full names in hack-addresses mode. +* made vm-get-header-contents put grouping ^\(...) around the + header name regexp instead of just prepending ^. +* vm-yank commands now in the composing-message action class. +* made use of the bundled reporter.el and timezone.el optional in + Makefile. +* New commands: + + vm-next-message-same-subject + + vm-previous-message-same-subject +* fixed bug in vm-assimilate-new-messages; work was being done to + a virtual folder even if no new messages were added. +* internal thread tree is now built on demand. +* some mods to vm-sort-messages to deal with calls by threading + code and values of vm-folder-read-only and vm-move-messages-physically. +* moved scattered autoload defs into vm-startup.el. +* doc string updates. +* errors from call to vm-expunge-folder are no longer ignored in + vm-save-folder. +* default window configuration now uses the split screen mode for + everything. +* dropped the skip-newlines-at-top-of-folder code. +* dropped single quotes from around sed command; unneeded since + we're not calling the shell. +* made vm-change-folder-type work; fixed babyl related problems + along the way. +* run copy-sequence on new-messages before sorting in + vm-assimilate-new-messages to keep sorting from scrambling the + value we need to return. +* fixed bugs in vm-convert-folder-type; have to be careful about + update order since some code depends on correct separator + strings being present. +* added special code to the POP mail retriever needed for babyl + crash boxes. +* block mail new mail retrieval while we're getting new mail; + timer processes might be fired up while the POP code is running. +* added another missing set-buffer-modified-p in vm-gobble-crash-box. + +VM 5.54 released (4 February 1994) + +* made vm-discard-cached-data fill the cache with nils instead of + allocating a new array. necessary so that the virtual messages + get their caches wiped too. +* vm-edit-message now unhightlights the edit buffer. +* moved unthread/rethread stuff from vm-edit-message-end to + vm-discard-cached-data. +* removed thread data prerefs from vm-edit-message and + vm-discard-cached-data; I no longer think they are needed. +* changed emacs to $(EMACS) in Makefile for make-autoloads run. + +VM 5.53 released (3 Feburary 1994) + +* got rid of reuse of count variable in vm-delete-message; used + del-count instead. this was hosing motion after + vm-delete-message-backward. +* fixed bugs in vm-delete-duplicates; was calling vm-delqual with + an unfrobbed list of addresses; if 'all' was non-nil was + resetting list and setcdr'ing prev inappropriately. +* Shapiro typo fixes. +* fixed vm-set-xxxx-flag to not add to the undo record list + twice; more confusion due to virtual folders. + +VM 5.52 released (3 February 1994) + +* BABYL file support. +* fixed noautoload target in Makefile to depend on reporter.elc. +* actually put the reporter.el file in the distribution (oops) +* fixed vm-set-xxxx-flag to notice the real message when a + virtual message flag is set. +* added loop detection code to vm-thread-list. +* added 'redistributed' message attribute, because BABYL files + support this. vm-resend-message makes a message + 'redistributed'. +* %A summary format spec now seven characters wide instead of + six. +* no longer set vm-message-pointer in composition buffers. It + doesn't look like it's used anywhere anymore. +* needed make-local-variable calls in some places in vm-reply.el to + avoid referencing a global variable. +* don't auto-get-new-mail if vm-folder-read-only is non-nil. +* don't try to startup folder read only for vm-yank-message-other-folder. +* fixed logic error in vm-assimilate-new-messages; if real folder + was empty; the first new messages that arrived would not be + offered to virtual folders for assimilation. +* fixed logic error in vm-build-virtual-message-list that causes + new message list not to be installed into an empty virtual + folder if vm-build-virtual-message-list was passed a message + list. +* added some code to vm-save-message and vm-assimilate-new-messages to + get the message pointer set properly when live folders inherit their + first message from another folder. +* rewrote vm-delete-duplicates to use an obarray. +* fixed another file name expansion in wrong dir problem in + vm-save-message. +* fixed bug in vm-pop-move-mail; needed (car (cdr ...)) instead + of (car ...) to get password from assoc list. +* unhighlight text copied into composition buffers. +* use mail-position-on-field in vm-send-digest. +* anonymous virtual folders now can acquire new messages when + their real folders do. +* drop error free calls in vm-window-loop in favor of checking + for only one window before doing a delete-window. Lucid Emacs + blows away the containing screen if you delete the last + ordinary window. +* preserve buffer modified status of virtual folder after + erase-buffer call in vm-do-needed-mode-line-update. +* replaced timezone-floor with Kanazawa Yuzi's fixed version. +* don't makunbound unless there are no message left with a + subject; previously it was done when there was one message left + that was a child of the subject, which was quite wrong. This + required keeping track of every message with a particular + subject, which wasn't being done before. +* reset thread-indention-of cache and thread-list-of in vm-unthread-message +* move vm-keep-mail-buffer further down in vm-mail-send so that + attribute update code can do its work before the buffer + potentially goes away. +* fixed logic error in vm-save-message; non-conversion error + message check was reversed regarding virtual messages. +* made vm-save-message report the number of messages saved, +* made vm-delete-message and vm-undelete-message report the + number of messages deleted/undeleted if marks are used. +* made vm copy the read-only state of a visited folder--- if the + file was read-only when vm first visits it, the folder will + be read-only, too. +* added read-only flag to vm-mode; prefix arg interactively. +* New variables: + + vm-summary-subject-no-newlines + + vm-keep-crash-boxes +* New commands: + + vm-toggle-virtual-mirror + + vm-change-folder-type +* virtual-messages-of in real message was not being updated for + non-mirrored virtual folders... wrong wrong wrong. fixed. +* vm-stuff-virtual-attributes was stuffing the data using the + header offsets of the virtual message instead of the real + message's offsets... (woo, woo!) fixed. +* doc string fixes +* preserve summary buffer modified status when doing summary + buffer updates since it's supposed to reflect the folder + buffer's status. +* moved vm-summary-redo-hook run to be in the summary buffer. +* made unmirrored virtual message not share a summary with real + messages (oops). +* moved vm-su-summary preref to fill the cache out of + vm-mark-for-summary-update and into vm-stuff-attributes. +* changed vm-check-for-killed-summary to be a function, and made + it reset su-start-of and su-end-of of all messages if the + summary buffer has been killed. +* changed thread indent calculator to start counting from the + first ancestor that is in the current folder, instead of always + counting from the root message. +* set require-final-newline to nil for vm-mode buffers. needed for + babyl folders. +* added more test data to detect brokenesses in mail-extr.el. + +VM 5.51 released (29 January 1994) + +* docstring fixes. +* fixed logic behind how schedule-reindents is set in + vm-build-threads; startup with ought to be somewhat faster. +* check for vm-message-pointer == nil in vm-sort-messages to + avoid problems when sorting by thread at startup. +* added reporter.el to distribution. +* changed %* to %+ in modeline in hopeful anticipation of this + being added to v19 Emacs. +* made sure summary modflag was updated after folder saves; needed + to add folder buffer to vm-buffers-needing-display-update. +* changed vm-force-mode-line-update to use force-mode-line-update + if it is bound. +* made vm-make-virtual-copy restore the modified status of the + virtual folder buffer after doing the copy. + +VM 5.50 released (28 January 1994) + +* found and fixed another bug in the threading code that can + cause looping; interned a symbol into the wrong obarray. +* made vm-save-message-sans-headers remember that last file + written to, and not claim that a file was written to when it + wasn't. +* made vm-save-message not claim that a folder was written to + when it wasn't, and to not visit files, check folder types and + so on when the prefix arg given was 0. +* fixed doc for vm-summary-uninteresting-senders; pointer -> arrow. +* made sets-typetag be defvar'd instead of defconst'd. avoids + trouble if sets.el is reloaded. +* fixed expunge; it was checking for virtual message after the + virtual message list of the message had been emptied. +* fixed vm-build-virtual-message-list; when new messages were + assimilated, the old message list overlapped the new causing + duplicates in vm-virtual-messages-of. +* dropped the rest of the undocumented stuff for hilit19. + +VM 5.49 released (25 January 1994) + +* changed timezone.el not to call abs directly. +* changed vm-mail-send-and-exit to notice if it's no longer in + the composition buffer after vm-mail-send and not to bury + whatever buffer it happens to be in. +* changed make-autoloads to use Lisp, create proper interactive + autoloads and to include the doc strings. +* cached date of oldest message in a thread; thread display now + sorts threads in chronological order of the oldest message + known to have been in the thread during this VM session. +* fixed threading by subject bug, that I suspect caused endless + looping in some folders. +* fixed some of the problems with vm-mutable-windows non-t + non-nil; most in tapestry.el; one in vm-window.el. +* doc fix in vm-summary-format var doc, h -> H. + +VM 5.48 released (23 January 1994) + +* @cp -> cp in Makefile. +* fixed bug in vm-load-window-configurations where + vm-window-configurations is set to t. +* Shapiro typos fixes. +* added timezone.el to the distribution. + +VM 5.47 released (23 January 1994) + +* vm-window-configuration-file now has a default value of + "~/.vm.windows". +* vm-default-window-configuration is now used if reading a + configuration failed. previously it would not be used if the + file vm-window-configuration-file pointed to did not exist or + was empty. +* expunge caused highlighted area to move over to some unwanted + areas of text. made highlighting function nuke the face + property of the whole message to try to clean this up before the + user gets to see it. user will still see it during searches, + oh well. real fix is for Emacs to move the properties when the + text shifts because of insert/delete, which I think Emacs will + do in the next release. +* first crack at thread support. + New variables: + + vm-summary-show-threads + + vm-summary-thread-indent-level + * vm-subject-ignored-prefix + * vm-subject-ignored-suffix + New commands: + + vm-toggle-threads-display (C-t) + + vm-goto-parent-message (^) + + vm-mark-thread-subtree (M T) + + vm-unmark-thread-subtree (M t) +* Variables that went away: + + vm-summary-show-message-numbers +* summary format specifiers %n and %* are allowed again. +* added slot in message struct for the summary to use for its + padded copy of the message number. everything else uses the + unpadded number. +* fixed vm-expunge-folder; a couple of problems with initiating + expunges from a virtual folder--- some stuff was being done + twice, and the physical expunge was occurring in the virtual + buffer instead of the real buffer. +* gave vm-mark-for-summary-update an optional arg that says + "don't kill the summary entry cache". this is used by thread + and marks commands, which don't change anything that the + summary entry could cache. +* vm-visit-virtual-folder, vm-get-new-mail and vm-burst-digest + work harder at keeping the totals blurb on the screen in the + face of autoload messages, summary status, etc. +* made vm-set-numbering-redo-{start,end}-point update + vm-buffers-needing-display-update. +* made vm-undisplay-buffer not use save-excursion, which + apparently does a switch-to-buffer in v18 Emacs. +* made vm-undisplay-buffer not select a dead window, since this + can crash v18 Emacs. Rewrote it to use + vm-delete-windows-or-frames-on which already has the smarts + about not selecting dead windows. +* don't emit totals blurb in vm unless it's a full startup. + cured problem of calling (message ...) when totals-blurb is nil. +* changed call to buffer-disable-undo to use fboundp to check + first, and call buffer-flush-undo if it is not fbound. +* disable undo in the summary buffer. +* updated vm-mode doc with missing variables and keys. +* changed make-autoloads to create proper autoload defs for + macros and to trim the suffixes from the file names. +* folder is now expanded properly in vm-visit-folder before + calling vm. +* if call of read-file-name with five args fails (v18 doesn't + take the INITIAL-INPUT arg) call it with the expansion dir set + to what would have been the fifth arg. +* Shapiro typo fixes. +* don't signal error in vm-expunge-folder if there are no deleted + messages. +* fixed summary rebuild problem in vm-expunge-folder related to + virtual folders. +* changed vm-kill-subject to use vm-so-sortable-subject +* added new action class "marking-message" and put the mark and unmark + commands in it. +* some of the motion commands now follow the summary cursor. +* dropped a bit of stupidity at the end of + vm-next-command-uses-marks; why o why was I prereading the next + input event? +* fixed message assimilation into virtual folders. +* made vm-move-message-forward silently not try to move a message + physically if it's in a virtual folder. +* updated documentation for vm-get-new-mail. +* dropped the refcard from the distribution. +* if summary format doesn't match the cache summary format, force + a restuff of the cache of all messages when the folder is saved. + +VM 5.46 released (17 January 1994) + +* added header highlighting for FSF Emacs 19. + + slightly different sematics for vm-highlighted-header-regexp + to match the new header name matching rules. + + new variable vm-highlighted-header-face to specify what face + to use for highlighting. +* fixed make-autoloads to create autoloads pointing to .elc files + instead of .el files. +* updated laggard copyright notice in startup message. +* chopped out undocumented hook for hilit19 in + vm-preview-current-message. + +VM 5.45 released (17 January 1994) + +* Shapiro typo fixes +* editing a message that already had an edit buffer caused window + config failure; window config code couldn't find the edit + buffer, because the current buffer was not the edit buffer. + fixed by calling set-buffer for this case in vm-edit-message. +* dropped unneeded calls to vm-previous-window in vm-window.el. + calling (next-window w 'nomini) is sufficient to avoid the + minibuffer and to avoid drifting into another frame while + evading the minibuffer. +* make vm-next-message do its own window configuration when + called by vm-delete-message and others, so auto-motion pops up + the correct configuration. +* VM now has a default window configuration. +* the unwind form in set-tapestry could select a dead frame; we + now check with frame-live-p before selecting the saved frame. +* removed the kludge from tapestry-set-frame-map, it didn't work + reliably anyway. +* changed vm-undisplay-buffer not to delete a frame unless there + only one window in it. +* VM now autoloads all of its modules on demand. some functions + moved to different modules for better locality of related + functions. some care given to how display update lists + were built so as to avoid calling summary update functions on + messages that actually are part of a folder that does not have a + summary. Turned out mostly to be a waste, the summary gets + loaded almost immediately unless serious contortions are made. +* New files: + make-autoloads - build the autoload defs + vm-startup.el - contains all VM entry point functions + vm-minibuf.el - contains most of VM's minibuffer read functions. +* work harder at vm startup to keep the totals blurb on the + screen despite all the autoload tripe blasting the + minibuffer. +* added a documented cardinality function to sets.el. +* made vm-emit-eom-blurb not call vm-su-full-name, which avoids + dragging in the summary code unnecessarily. +* check for killed folder buffer in vm-mark-replied and + vm-mark-forwarded to avoid trying to set-buffer to a killed + buffer. +* moved a ( in a docstring right to avoid it being in column 0. + +VM 5.44 released (16 January 1994) + +* fixed free variable reference (length) in vm-edit.el. +* added a few missing commands to the supported window + configurations list. +* wrapped call to mail-send in save-excursion to protect against + a buffer change. +* moved call of vm-rename-current-mail-buffer in front of + vm-keep-mail-buffer so that if vm-keep-sent-messages is nil we + won't rename some random buffer because the current buffer had + been killed. +* added doc for vm-submit-bug-report to vm-mode doc. +* added optional first argument to tapestry which allow + specification of which frames to return info about. +* made vm-save-window-configuration record configuration info + only about the selected frame if vm-mutable-frames is nil. +* %* format spec no longer allowed in summary format, for the + same reason the %n spec was disallowed. +* made the "get new mail" call of vm-assimilate-new-messages in + vm not read message attributes, so we don't inherit X-VM stuff + from messages sent by others. +* was calling select-frame in set-tapestry, changed to call + tapestry-select-frame instead. +* made tapestry and set-tapestry no change Emacs' idea of what the + selected-frame is. +* made vm-set-window-configuration more friendly to errors + + if the window config requires a summary buffer and none is + present and the folder buffer isn't displayed either, then + display the folder buffer where the summary would have been + displayed if it existed. + + if the window config requires an edit, composition, or + summary buffer and it is not present, delete windows and + frames that would have displayed it. +* moved "hide" check in vm-scroll-forward to be prior to the + first usage to the window we're checking. +* Shapiro typo fixes, as usual, sigh. +* more virtual folder selectors +* made virtual folder selectors that require dates be more + flexible and fill in incomplete date specifications. +* removed redundant and incorrect calls to vm-check-count from + vm-mark-message and vm-unmark-message. +* fixed bug in vm-timezone-make-date-sortable; used car to access + chace when should have used cdr. +* New commands: + + vm-mark-matching-messages + + vm-unmark-matching-messages + + vm-create-virtual-folder + + vm-apply-virtual-folder +* default value of vm-virtual-mirror is now t. +* added missing mapping of vm-virtual-mode to `message' in + vm-set-window-configuration. +* fixed sent-before and sent-after selectors to call + vm-so-sortable-datestring instead of vm-so-sortable-date. +* modeline indicates folder virtuality by surrounding the buffer + name with parens, eats less space than "virtual " particularly + when the folder are nested. +* fixed vm-beginning-of-message and vm-end-of-message so they + again work when invoked from the summary buffer. +* added vm-beginning-of-message, vm-end-of-message, and + vm-expose-hidden-headers to the reading-message action class. +* changed vm-expose-hidden-headers to force the displaying of the + folder buffer. +* changed calls of get-buffer-window to vm-get-buffer-window so + that searches for buffers in windows fan out to all frames when + it is appropriate. +* added let-bind of buffer-read-only to nil around call to + erase-buffer in vm-do-needed-mode-line-update. +* rewrote vm-mark-for-summary-update again, and hopefully got it + right this time. +* fixed problem in vm-virtual-quit; vm-message-list needed to have + expunged messages stripped before vm-message-pointer was rehomed + there. virtual folder can now shrink to 0 messages without errors. +* fixed some bad logic in vm-assimilate-new-messages that caused + the summary to be rebuilt every time you ran M-x vm. + +VM 5.43 released (14 January 1994) + +* changed another reference to window-frame in tapestry.el that I + missed, sigh. +* added vm-mutable-frames to var list in vm-submit-bug-report +* put vm-edit-message-end and vm-edit-message-abort into the + reading-message and startup action classes. +* changed vm-set-window-configuration to bail if the current + buffer isn't a VM related buffer. +* changed vm-set-window-configuration to create some descriptive + buffers when a configured buffer can't be found, to let users + when they've flubbed the window configuration setup. +* made vm-convert-folder-header-types a bit more robust +* made vm-find-leading-message-separator go to point-max for + From_-with-Content-Length folders if no separator is found just + as it does for the other folder types. +* made vm-edit-message-end properly recompute the Content-Length + header for the From_-with-Content-Length type. +* made vm-edit-message-end munge message separators that it finds + in an edited message before the message is reincorporated into + the folder. +* made vm-convert-folder-types munge message separators of the + new folder type as part of the conversion process. +* Greg Shapiro's and Andy Scott's typo fixes +* %n spec is gone from the summary format; new summary cache code + would cause the messaage number to be cached and this caused + many problems. +* New variables: + + vm-summary-arrow + + vm-summary-show-message-numbers +* New command: + + vm-forward-message-all-headers + +VM 5.42 released (13 January 1994) + +* made tapestry-frame-map call tapestry-window-frame instead of + window-frame directly, which bombs under v18 Emacs. +* made vm-get-mail-itimer-function call + vm-assimilate-new-messages with a first arg non-nil, so that + attributes found in newly arrived messages will be ignored. +* removed some local-set-key calls in vm-do-reply that I forget + to take out. +* dropped the keymap parent stuff altogether, mimic mail-mode + bindings in VM's mail mode, use vm-edit-message-map and simply + override text mode map or whatever, copy the vm-mode-map to + create the summary mode map. +* drop cat-chow from the variable list in vm-submit-bug-report. +* added a salutation and subject to vm-submit-bug-report +* corrected vm-edit-message-end typo in vm-vars.el +* moved vm-isearch-forward back to M-s, took vm-isearch-backward + off C-r. +* vm-goto-message now does not follow the summary cursor if a + prefix argument is given. +* added vm-mail-send-and-exit to the reading-message and startup + action classes. ought to keep the *scratch* buffer from popping + after sending mail when reasonable window configurations are enabled. +* New variables: + + vm-trust-From_-with-Content-Length +* signature now appears after forwarded messages and digests, + instead of before them. +* added tapestry autoloads. +* removed more references to vm-ml-attributes-string +* turned off modification flag in crashbox buffer after folder + conversion to keep kill-buffer silent. +* turn on Emacs 19 compatbility in vm-byteopts.el. + +VM 5.41 released (10 January 1994) + +* fixed "~/INBOX" dreg in vm-get-folder-type. +* added more test data to detect for broken + mail-extract-address-components implementations +* added SHELL = /bin/sh to Makefile. +* added a current folder buffer slot to message struct so that + (marker-buffer (vm-start-of message)) is no longer necessary. +* VM no longer changes the message pointer on async auto-get-new-mail + unless the folder was previously empty. +* VM now queries for a POP password if the password is "*" in + vm-spool-files. +* made vm-visit-virtual-folder honor vm-startup-with-summary. +* older Lucid Emacs versions apparently don't have the improved + insert-file-contents; changed test in vm-get-folder-type to deal + with it. +* took vm-yank-message-other-folder off C-c y. +* some fixes for the keymap troubles + + use keymap parenting when we can + + vm-mail-mode-map + + vm-edit-message-map +* added support for the System V Content-Length folder type. +* much work on the display code + + added vm-display clearinghouse function for display work + + per command window configuration support added. + + weird window configuration related scrolling bugs fixed +* New variables: + + vm-mutable-frames + + vm-display-buffer-hook + + vm-undisplay-buffer-hook + + vm-reply-ignored-reply-tos + + vm-move-messages-physically + + vm-tale-is-an-idiot + + vm-summary-pointer-update-hook +* Variables that went away: + + vm-retain-message-order (message order is always retained now.) + + vm-mail-window-percentage (have to use window configs for this now.) +* frame support added to tapestry.el +* file recovery and reversion now deals with virtual folders. +* SPC now invokes completion in vm-read-string, which means + minibuffer reads of sort keys now have completion on both TAB + and SPC. +* various minor contortions to quiet the compiler. + + added some defvars + + moved error condition puts to vm-misc.el + + added a compile-time preloaded file vm-byteopts.el +* added documentation for more VM entry points to README. +* strip quotes from ends of full name in vm-su-do-author. +* fixed attribute stuffing code to properly correct the changed + value of vm-headers-of in all cases. +* made sets.el use prin1-to-string instead of (format "%S" ...) + since %S doesn't work under v18 Emacs. +* save the correct modeline variables in vm-search18.el; + vm-ml-attributes-string is gone. +* change vm-su-do-month to avoid using all those symbols +* rewrote vm-search19.el to work and work better. +* vm-isearch-forward moves from M-s to C-s +* vm-isearch-backward command created. +* vm-isearch-backward on C-r +* made the message separator string generator functions look at + the local variable that they set. by looking at the wrong + variable they used the wrong folder type. +* added needed narrow-to-region to vm-pop-retrieve-to-crashbox + so that folder type could be correctly deduced. +* jwz improvements + + fixed width hh:mm:ss + + negative precision in summary spec means truncate from the right + + vm-delete-duplicates rewritten to be slow (and not reorder elements) + + vm-delete-duplicates also handles addresses specially if asked +* fixed bug in vm-default-chop-full-name; it should result a + non-nil value in the 'address' part of the list. +* fixed typo in vm.texinfo +* fixed unnoticeable bug in vm-set-{summary,numbering}-redo-start-point +* fixed vm-expunge-folder to not do redundant sets of the summary + and numbering start points. +* fixed vm-expunge-folder to be lock out interrupts at + appropriate places. +* fixed vm-expunge-folder to expunge the real message when a + mirrored virtual message is expunged. +* changed vm-build-virtual-message-list to allow a list to be + built from a virtual folder's message list by looking through + it to the real messages underneath. This is a prelude to + on-the-fly virtual folder creation. +* added many new virtual folder selectors, including 'and', 'or' + and 'not'. +* vm-resend-message now strips the Sender header from the message. +* vm-move-message-forward locks out interrupts in the right place + to protect message list integrity. +* fixed vm-sort-messages bug that caused it to put the message + into the wrong physical order. +* added two commands: vm-move-message-forward-physically and + vm-move-message-backward-physically. +* fixed bug in vm-resend-bounced-message; if it found no header + separator line it would insert one in the wrong place. +* new semantics for vm-startup-with-summary +* entire summary entries now cached, which means almost now work + to generate a summary at startup now. +* VM now does summary, numbering and modeline updates even if it + is quitting. virtual folder displays will be out of sync otherwise. +* VM now ignores message attributes that arrive attached to new mail. +* last vm-gargle-uucp dreg removed. +* VM no longer sets inbox file permissions to 600. +* added some undocumented hooks for hilit19.el until it starts + using the proper hook variables. +* added protection for the variable this-command to the + (interactive) forms that needed it. +* added protection for the variable last-command to the + (interactive) forms that needed it. + +VM 5.40 released (21 December 1993) + +* made vm-edit-message-end preview if edited message is current; + comparison bug caused it not to. +* removed extra definition of vm-do-needed-mode-line-update +* fixed mail-extract-address-components test code. +* fixed problem with summary mode line not being updated if + expunge empties the folder. +* fixed Makefile install target to copy vm.info to $(INFODIR)/vm . +* more doc corrections from Greg Shapiro. +* fixed long line Summaries node in Info document. +* fixed bug in vm-default-chop-full-name, should use list instead + of cons for the return value. + +VM 5.39 released (21 December 1993) + +* sanity checked all bindings of case-fold-search. +* sanity checked all searches for reasonable ambient values of + case-fold-search. +* adopted most of Kevin Rodgers latest round of changes to + vm-su-do-author, to parse full names and addresses a bit better. +* changed 'file' to 'folder' in vm-save-message to fix an invalid + variable reference. +* New variables: + + vm-check-folder-types + + vm-convert-folder-types +* Variables that have gone away: + + vm-gargle-uucp + (wrote this for late eighties melee, things are different now) +* added call to set-window-point in vm-preview-current-message so + that window-point is set properly in time for a vm-howl-if-eom + call from a parent function. +* fixed set-xxxx-flag and vm-update-message-summary to create + correct update lists taking into account virtual folders. The + code wasn't quite right. +* fixed vm-update-message-summary not to try to use buffer-name + to determine if the vm-su-start-of is a live buffer. Just + marker-buffer will do, apparently. Killing the summary should + safe to do again. +* added a vm-submit-bug-report command based on reporter.el. +* emit totals blurb in various places before selecting a message + to prevent the non-previewers from altering the new message + count and confusing themselves. +* checked for existence of vm-arrived-message-hook before running + the loop. +* put vm-howl-if-eom after the vm-update-summary-and-mode-line + because the howl contains the message number and the correct + message number may not be computed in some cases until after the + update. +* fixed many bugs with virtual folders. +* incremented vm-modification-counter in vm-burst-digest which + should make the totals blurb be recomputed; previous it wasn't. +* removed a couple of (apparently) unneeded re-search-forward's in the + message yanking code. +* added X400-Received to a couple of the default header discard + lists. +* fixed POP retriever to check for servers that DON'T strip + message separators. +* -hooks vs. -hook; hobgoblins win. +* added some defvars to quiet the v19 compiler (a little) +* made vm-spool-move-mail kill the miserable buffer if nothing + went wrong. +* added doc string for vm-summary-mode-hook +* added more general date parser +* added 'H' (hh:mm) summary specifier +* normalized vm-su-year, at least 3 or 4 digits always. +* made vm-auto-archive-messages be applicable to marked messages + only. +* made MNMU == Mu, i.e. vm-unmark-message is applicable to marked messages. +* made vm-next-message and friends applicable to marked messages. +* incorporated typo and spelling fixes from Gregory Shapiro +* fixed vm-get-folder-type to widen before trying to get to the + beginning of the buffer. +* updated README +* change mode line update code to not create strings at every + update. +* changed update code to not rebuild the mode line regardless of + whether it did or did not change. +* fixed bug in vm-write-string; point was not supposed to be + restored on exit. +* fixed bug in vm-save-message; said write-region when I meant + insert-buffer-substring. +* used new insert-file-contents features in v19 Emacses to + replace running sed. +* called vm-su-from instead of vm-from-of in + vm-rfc1153-or-rfc934-burst-message; vm-from-of can be return + nil. +* fixed vm-leading-message-separator and + vm-trailing-message-separator to use the + right type variable. +* made nil an allowable value for vm-forwarding-digest-type. +* changed vm-stuff-attributes to use insert-before-markers which + should keep the attributes headers from leaking into view. + (window-start is a marker you see and ...) +* changed the RFC 934 digest banners messages, they were scaring + the tourists. +* changed dashes to spaces in mode line. +* 'make' != 'make all' in Makefile anymore +* Info file created is now named vm.info. + +VM 5.38 released (16 December 1993) + +* made vm function check vm-block-new-mail before calling + vm-get-spooled-mail and thereby avoid having an error signaled + after M-x recover-file. +* putting a call to vm-howl-if-eom into vm-show-current-message + was a mistake. moved to vm-scroll-forward, which is a better + place for it. +* changed vm-delete-message to really honor vm-circular-folders + if vm-move-after-deleting is nil. Also fixed a similar problem + in vm-undelete-message, plus a typo where delete was used when + undelete should have been. +* fixed vm-so-sortable-subject, needed case-fold-search set to t. +* changed vm-pop-move-mail to clear the trace buffer before + trying to open a connection. This is to prevent confusion + about old output in the trace buffer. +* fixed endless loop bug in vm-mail-yank-default that occur when + vm-included-text-prefix is "". +* changed folder parser back to just matching "From " for the From_ type. +* New variables: + + vm-summary-mode-hook + + vm-summary-uninteresting-senders-arrow + + vm-summary-mode-map +* Slightly different semantics for vm-summary-uninteresting-senders. + +VM 5.37 released (15 December 1993) + +* fixed "wrong type argument" arrayp nil problem in + vm-pipe-message-to-command. (m -> (car mlist)) +* fixed "intersting" and "vm-message-type" typos in vm-summary.el +* added a clarification about byte-compiler warnings in the + README file and corrected a typo in an autoload line; one of + the vm's should be vm-mode. +* fixed vm-delete-window-configuration to actually read a window + configuration. Not sure when this was broken or whether it + actually ever worked! +* fixed unescaped quotes in docstring for + vm-summary-uninteresting-senders +* made vm-edit-message be a bit more careful about what it sets + the edit buffers local value of vm-message-pointer to be. +* made the string returned by vm-safe-popdrop-string look a bit + better. +* added support for mail-default-headers +* added defvars for mail-default-headers and mail-signature for + v18 Emacs, to avoid referencing symbols with void values. +* fixed bug in vm-resend-message that caused the first to the + current message to be copied into the composition buffer. +* fixed problem with vm-expunge-folder not updating the display + after completing its work iff the current message was not + expunged. +* made vm-show-current-message not mark a message as read unless + the folder buffer had a window opened on it. +* added (vm-howl-if-eom) to vm-show-current-message now that it + checks for a window. +* prevent effects of vm-summary-uninteresting-senders from + leaking into non-summary areas. +* New variable: + + vm-retrieved-spooled-mail-hook +* added vm-last-save-folder internal variable to track the last + visited folder and offer it as a default for the next + vm-visit-folder. + +VM 5.36 released (14 December 1993) + +* no more marker sharing between message in real folders. + Previously the start and end pointers were shared between + consecutive messages. +* changed vm-clear-all-marks only update messages that actually + have marks, and only update the summaries of updated messages. +* let* -> let in some places +* dropped one *+ regexp from vm-kill-subject +* vm-move-after-deleting non-nil and non-t means move as if + vm-circular-folder is nil. +* virtual-folders work now +* vm-preview-lines == t means preview but display a windowful of text +* fixed mark-even-if-inactive type in vm-reply.el; replies under + transient mark mode should work now under FSF v19. +* doc fixes and changes +* fixed bug in vm-scroll-backward, numeric prefix args other than + simple strings of C-u's were causing inappropriate forward + scrolling. +* removed strange no-op in vm-record-and-change-message-pointer +* default value of vm-preview-read-messages is now nil. +* call-process doesn't return a exit status in all Emacs, only + check exit status of movemail run on those Emacses that return + it. +* digest code redone, refurbished. +* RFC1153 digest support +* more status messages at startup so user knows Emacs is still + alive while visiting a large folder. +* protected against letter bombs when vm-visit-when-saving is t. +* grouping code is gone +* New variables: + + vm-forwarded-headers + + vm-unforwarded-header-regexp + + vm-forwarding-digest-type + + vm-digest-burst-type + + vm-digest-send-type + + vm-rfc934-digest-headers + + vm-rfc934-digest-discard-header-regexp + + vm-rfc1153-digest-headers + + vm-rfc1153-digest-discard-header-regexp + + vm-auto-get-new-mail + + vm-recognize-pop-maildrops + + vm-jump-to-new-messages + + vm-jump-to-unread-messages + + vm-mail-mode-hook + + vm-edit-message-hook + + vm-resend-bounced-headers + + vm-resend-bounced-discard-header-regexp + + vm-resend-headers + + vm-resend-discard-header-regexp + + vm-init-file + + vm-summary-uninteresting-senders + + vm-summary-redo-hook + + vm-reply-hook + + vm-mail-hook + + vm-resend-bounced-message-hook + + vm-resend-message-hook + + vm-send-digest-hook + + vm-select-message-hook + + vm-select-new-message-hook + + vm-select-unread-message-hook + + vm-arrived-message-hook + + vm-visit-folder-hook +* Variables that have gone away: + + vm-group-by + + vm-rfc934-forwarding + + vm-edit-message-mode-map +* timer based auto-retrieval of new mail implemented +* 'vm' function cleanup and should protect and warn about precious + auto save files. +* dropped the vm-buffer-modified-p kludge +* new semantics for vm-spool-files +* M-x recover-file works properly in a VM folder buffer now. +* fixed defvar of vm-spool-files so that VM can be dumped with Emacs. +* vm-resend-bounced-message now has header trimming variables +* vm-resend-message now has header trimming variables and works + like other outbound mail commands. +* regexps are now allowed in the HEADER-NAME field in + vm-auto-folder-alist +* when reading the folder name, vm-save-message now uses the + default folder name as initial input if it is a directory. +* VM now always stuffs attributes in vm-save-message; to do otherwise can + cause the deleted' attribute to be saved sometimes. +* change vm-save functions to update the summary as they work so + that if an error occurs the display will be up-to-date. +* ditched overlay-keymap +* ditched header highlighting code +* fixed vm-yank-message-other-folder to restore window environ + before yanking the message. +* fixed vm-pipe-message-to-command to save read its command in + the right context. +* made vm-save-message convert messages to the target folders + format if necessary. +* POP support via vm-spool-files +* made how VM matches headers be consistent. Put a colon at the + end of header names if you want exact matches, leave it off if + you just want prefixes. + +VM 5.35 released (25 August 1993) + +* fixed vm-fsf-emacs-19-p to not confuse FSF Emacs with Lucid +* changed code to deal with screen.el's rename to tapestry.el +* set enable-local-variables to nil in vm-build-virtual-message-list +* began work on code in vm-virtual.el to get virtual folders to + work right. not finished yet. +* expanded and reorganized message structure for virtual folders +* added patch from jwz to use set-keymap parent in + vm-edit-message under Lucid Emacs. + +VM 5.34 released (15 August 1993) + +* used -l texinfmt explicitly in Makefile to get texinfo-format-buffer loaded + under Emacs 19.18+. +* ditched use of vm-overlay-keymap in FSF 19 Emacs. +* use unread-command-events for FSF v19 in vm-next-command-uses-marks +* moved to using buffer-disable-undo rather than + buffer-flush-undo; hooked them together for compatibility with + v18. +* set folder type in more places and allowed empty folders to + match all types. +* made vm-rename-current-mail-buffer look for Bcc header for + possible addition to buffer name, before defaulting to the + anonymous horse. +* fixed vm-edit-message-end bug; needed to widen so + insert-buffer-substring inserts the whole edit-buf into the + folder buffer. +* added a bunch of patches from Jamie Zawinski--- some for general + VM bugs, some to let VM run under Lucid Emacs. + - support for Lucid Emacs keymaps in vm-overlay-keymap + - fixed some inadvertent free variable references + - use % instead of mod to avoid getting clobbered by cl.el macros + - check return status of movemail + - support enable-local-variables for FSF19 and Lucid + - use next-command-event if present for Lucid Emacs + - bind zmacs-regions so that (mark) behaves like (mark t) + - add support for mail-citation-hook for FSF19. + - regexp fix in vm-compile-format that should fix a format + bug as well at comply with whatever new POSIX regexp rot + has come down the pike. +* more regexp fixes so that Emacs won't take an eternity to + start VM +* vm.texinfo fixes +* fixed logic error in dealing with vm-visible-headers and + vm-invisible-header-regexp. If header was matched by both + variables it would be displayed, which is wrong. + +VM 5.33 released (11 April 1993) + +* fixed "wrong type argument arrayp, nil" error when primary + inbox is empty. +* applied Frank Bresz's fix for vm-visit-folder expanding the + minibuffer read filename in the wrong directory. +* applied Jamie Z's fix for the old, old scrolling problem when + scrolling from the summary buffer. +* changed default value of vm-flush-interval to t. +* fixed Makefile to say *.el instead of . so compilation will + occur even if there are no .elc files. + +VM 5.32 released (2 March 1992) + +* changed `|' not to send the message separator strings to the command. +* fixed bug in vm-parse-addresses; no longer considers an empty + string or a string composed only of whitespace to be an address. +* fixed bug in vm-compatible-folder-p; kill-buffer may make Emacs go + to an random buffer. +* reorganized the sources, moved everything out of vm.el so vm.el + can be used as a temp file. VM compiles to one object file now. +* Prefix arg to `c' (vm-continue-composing-message) now allows + selection of unmodified Mail mode buffers. +* Fixed the problem with the startup message appearing every time + you invoked VM instead of just the first time. +* Fixed problem with first message displayed at startup not + having its headers highlighted properly. +* axed the Full-Name header. +* New variable: vm-mail-header-from +* removed addresses from Cc that are already in To in replies. +* window configurations + - commands + vm-apply-window-configuration + vm-save-window-configuration + vm-delete-window-configuration + vm-window-help + - variables + vm-window-configuration-file +* used $(EMACS) instead of emacs in the Makefile. +* fixed bug in vm-save-message, needed to restuff deleted messages + to suppress the delete flag. +* New command: vm-mark-help +* moved the license into the texinfo document, and made the + license display code use the Info subsystem. +* The Info document goes into the file `vm' now; the README and + Makefile were changed to reflect this. +* vm-visit-folder depended on insert-default-directory being + non-nil in order to find folders in the folder directory. vm + now temp bind default-directory to folder-directory to make + sure that relative paths resolve in that directory. +* VM now handles the in-reply-to argument to vm-mail-internal (oops). +* Reply-To instead of Reply-to in outbound mail, a concession to + broken mailers. +* Fixed vm-grok functions to give up only in the case of MMDF folders. + A nil value of vm-folder-type could confuse it otherwise. This + is an interim fix. + +VM 5.31 released (31 March 1991) + +* kill-buffer in vm-parse-address may cause a change to a random + buffer; added save-excursion. +* moved vm-parse-addresses to vm.el, since it's used in the + summary and in replies. +* fixed problem with retaining correct message order across + multiple saves and expunges. +* no longer generate an empty In-Reply-To if mailer didn't + provide message-ID. + +VM 5.30 released (26 March 1991) + +* vm-resend-message now inserts a Resent-To header. +* changed default value of vm-visible-headers to show Resent-From + and Resent-Date. +* fixed bug in vm-thoughtfully-select-message, return value was + sometimes incorrect. +* fixed bug in vm-save-message, summary and message renumbering + were being deferred too long in the destination folder when + saving between visited folders. fix similar deferral bug in + vm-burst-digest. +* rfc822-addresses is no longer needed to support + vm-reply-ignored-addresses. This should keep addresses + from being stripped of comments inappropriately. +* VM now reorders before grabbing the bookmark, as it should. +* vm-mail-internal now subsumes the function of mail-setup so as to + avoid some of the choices made in mail-setup. +* removed the conditionals from around calls to vm-mail-internal + since it cannot fail; vm-mail-internal no longer returns the + token value of t. +* centralized the code that removes duplicates from lists of + addresses, message-ids, etc, and fixed a bug in it. +* used duplicate removal code on address lists +* in replies, if To is empty and Cc isn't then To = Cc, Cc = nil +* used vm-parse-addresses in vm-su-do-recipients, which should do + better than the simple address parser used there before. +* vm-mail-internal now automatically adds a Full-Name header. +* vm-flush-interval == t now means flush after every change +* vm-save-message now check whether the per message modflag is set + before stuffing the message attributes. +* (setq file-precious-flag t) is no longer done by vm-mode-internal. +* vm-reply puts together an appropriate Newsgroups header. + +VM 5.29 released (18 March 1991) + +* fixed References being inserted after mail-header-separator +* made a couple of VM find-file-hooks not assume that because + they've been installed vm-message-list has been initialized. +* removed last of \\[...] usage; might as well be consistent + since these things waste more time than they save. + +VM 5.28 released (16 March 1991) + +* fixed buffer renaming error; check for name collisions +* vm-goto-message now tries to follow the summary cursor first; + if it does, then it doesn't try to move again. +* fixed another bookmark problem; problem really inside + vm-expunge-folder, some variables needed to be set even if + quitting. +* removed the expand-file-name loop from vm-save-message, since + it would loop endlessly if vm-folder-directory was a relative + path name. +* fixed code in vm-save-message that assumed some VM specific + local variables would have sane values in a non VM mode buffer. +* VM maintains the References header in replies. + +VM 5.27 released (14 March 1991) + +* fixed bug in vm-stuff-message-order; needed (cdr vm-message-list) + instead of (cdr vm-message-pointer). +* centralized code that VM executes once per Emacs session. +* eliminated the need for immediately loading other libraries + during the load of the main VM Lisp file, which should fix a + bug in the Makefile. +* cleaned up the vm function a bit, the code that tries to make + make sure that the totals blurb in left at the bottom of the + screen after startup is less grungy now. +* fuzzier grouping, spaces at end of the subject and after re: + are ignored. +* killing a killed buffer breaks older versions Andy Norman's + homebrewed kill-buffer function in gnuserv.el. VM no longer + stimulates the bug. +* fixed a couple of summary pointer update bugs in the VM + isearch code. +* better bindings for the mark commands. +* vm-forward-message just calls vm-send-digest when user tries to + use it with marks, instead of just chiding the user. +* VM feeps even less on motion errors to avoid disturbing + sensitive souls and sleeping spouses. +* various documentation corrections +* fixed bug bookmark bug; bookmark was being stuffed too soon, + i.e. before messages were renumbered properly +* when mail is sent the outbound mail buffer is renamed to "sent + ..." to indicate that the mail has been sent. +* New command: vm-resend-message +* New command: vm-continue-composing-message +* `|' uses marks now + +VM 5.26 released (6 March 1991) + +* vm-move-message-forward now sets the proper variables to get + the message order saved. +* fixed bug in vm-stuff-message-order; message numbers needed to + be redone sometimes before saving. +* fixed bug in vm-revert-to-physical-order, it was not recording + the message order change properly either. +* prefix arguments to vm and vm-visit-folder now cause VM to + visit the folder read-only. +* altered conditional in vm that decides whether to get new mail; +* indiscriminately scrubbing slashes from reply buffer auto save + file names proved to be a humorous mistake. I've decided that + post-modification of the auto save file name is a bad thing, so + VM doesn't do any of the scrubbing anymore. I leave it up to + make-auto-save-file-name to do the right thing, since it's its + job anyway. +* documentation fixes in vm-reply.el +* 'g' now switches to the primary inbox if you weren't there + already and there is new mail. + +VM 5.25 released (3 March 1991) + +* got rid of vm-local-message-list and vm-local-message-pointer + +VM 5.24 released (2 March 1991) + +* New variable: vm-retain-message-order +* New command: vm-move-message-forward +* New command: vm-move-message-backward +* VM finally gets doubly links message lists. vm-previous-message + should be much faster on large folders now. +* removed some unnecessary code at the end of the routine that + reverts the message-list back to physical-ordering. +* added missing function vm-delete-directories to vm-virtual.el +* added `/' to the list of characters that get scrubbed out of + the auto-save-file-name's of reply buffers. +* added > description to the doc string of vm-mode. +* move-after-deleting and move-after-undeleting now signal error + only if non-interactive and not executing a keyboard macro. +* New variable: vm-edit-message-mode-map +* C-c C-c now works like C-c ESC when editing a message. +* substitute-command-keys now used in vm-edit-message since it + should be relatively cheap. +* doc string correction in vm-delete-message. + +VM 5.23 released + +* fixed display bug with virtual folders; virtual folder would + switch real buffers when changing messages but the display + wouldn't display the buffer containing the new current message. +* changed the vm-group-by algorithm; now uses buckets, should be + much faster. +* append a newline if necessary after inserting an edit buffer into the + folder, to keep the message separator from becoming a part of + the message. +* Made the "No new mail" message go away after a while. +* fixed bug where VM assumed buffer-file-name would always be + non-nil. +* fixed bug in vm-gobble-deleted-messages that caused + VM via vm-expunge-folder to bomb on empty folders. +* fixed another bug in vm-gobble-deleted-messages that caused + it to mark a folder modified if an expunge was attempted on an + empty folder. +* further centralized summary updates and renumbering activities +* couldn't remember why require-final-newline was set to nil in + vm-mode and vm-virtual-mode buffers so I got rid of it. +* "No new messages" -> "No messages gathered" in vm-get-new-mail. +* made `g' go ahead and get new mail even if the current folder + isn't the primary inbox. + +VM 5.22 released (beta-testable in Feb 22, 1991) + +* fixed obscure bug in vm-write-file-hook that might have bitten + someone some day; vm-message-list vs. vm-local-message-list. +* updated startup message and README to say where to send bug reports. +* added support for timer based checkpointing. +* New variable: vm-flush-interval +* VM now gets along with revert-buffer and recover-file. +* VM undo will now delete the auto-save-file when appropriate. +* Folder saves with C-x C-s and C-x C-w don't get the -??- + uncertainty indicators anymore. C-x s still does though, alas. +* vm-set-buffer-modified-p changed to make the setting of the + buffer's modification flag be tried first, so that file locking + and file supersession threat aborts are handled cleanly. +* added code (that really works) to clear the question from the + minibuffer after vm-quit gets its answer. +* tiny cleanup in mail buffer name used by vm-send-digest + +VM 5.21 released + +* the auto-save file name scrubber was broken. I also discovered + that Emacs` aset function is broken. +* vm-keep-sent-messages didn't quite work right; used rassq instead + of memq... + +VM 5.20 released + +* fixed doc string for vm-scroll-forward and vm-scroll-backward +* removed whitespace from auto-save-file-names in VM Mail Mode + buffers. trimmed shell metacharacters as well. +* fixed doc error for vm-resend-bounced-message (bound to M-r not C-r) +* the default value of vm-confirm-quit is now 0. +* corrected documentation on vm-confirm-quit. +* variable initialization now in vm-vars.el +* VM scroll commands, page narrowing functions and other + functions that schlep about in the current message moved to + vm-page.el. +* New variable: vm-keep-sent-messages +* VM now reports the "right" number of new and unread messages at + startup, even if previewing is disabled. +* added code to clear the question from the minibuffer after + vm-quit gets its answer. + +VM 5.19 released + +* fixed bug in vm-gobble-deleted-messages that causes the summary + to be botched if the first message was expunged and the second + message wasn't. +* call to vm-set-buffer-modified-p made clearer. +* fixed bug in vm-expunge-folder and vm-update-summary-and-mode-line + that caused a botched summary if all the messages + in a folder were expunged. +* moved the vm-version variable initialization into + another separate file. +* vm-save-folder is now more verbose when it does it's work. +* vm-beginning-of-message and vm-end-of-message now push point + onto the mark ring just like their beginning-of-buffer/end-of-buffer + counterparts. +* removed incorrect vm-system-state change in vm-beginning-of-message +* vm-save-folder now handles prefix args like save-buffer does. +* vm-mail now works if called before the rest of VM is loaded. + +VM 5.18 released + +* VM now ignores garbage (e.g. blank lines) at the beginning of a folder. +* C-x C-s and C-x C-w will now save the folder if invoked from + the summary buffer. + +VM 5.17 released + +* fixed bug in vm-build-=virtual-message-list that kept other + virtual folder selectors from working.] +* fixed bug in vm-get-new-mail when gathering messages from + another folder instead of the spool. +* added autoload for vm-visit-virtual-folder to vm.el +* fixed bug in parsing of MAILPATH environmental variable. +* fixed bug in vm-expose-hidden-headers; if message is unread + body is not inadvertently displayed. + +VM 5.16 released + +* message structs are no longer directly self-referential. A + symbol must now be dereferenced. This was done to allow the + debugger to be used on VM. +* vm-get-spooled-mail no longer assumes that there's always mail + in an existing spool file. + +VM 5.15 released to the beta-testers + +* slight cleanup in vm-assimilate-new-messages +* added some calls to vm-select-folder-buffer to some commands + that needed it. Basically this means commands that call + another command to do most of their work but do not call this + second command interactively, which result in + vm-set-folder-variables not always being called when it's + needed. + +VM 5.14 released + +* New variable: `vm-delete-after-archiving' +* New variable: `vm-delete-after-bursting' +* VM now avoids the use of the default *mail* buffer. Outgoing + mail buffers are given more descriptive names, and more than + one can exist concurrently. + +VM 5.13 released + +* vm-kill-subject bug fixed; report of number of killed message + was broken. +* changed vm-message-list to vm-local-message-list in vm-do-summary + +VM 5.12 released + +* last couple of changes to the grouping code didn't make it into the + previous patch. + +VM 5.11 released + +* added a check for a killed summary buffer to vm-group-message. +* references to vm-local- variables still weren't right; there + are now no references at all to their global counterparts. + +VM 5.10 released + +* grouping code wasn't setting vm-local- vars... this didn't + generate an error when I tested it with a virtual folder, but + better safe than... +* summary code now tries not to do a total rebuild after getting + new mail or expunging. This should give a considerable time + savings on large folders. +* another type of bounced message delimiter added to the searches + in vm-resend-bounced-message. + +VM 5.09 released + +* New variable: `vm-folder-read-only' +* removed all the "clever" code at the end of vm-quit that tried + to do nice thing if we landed on a VM buffer. +* vm-kill-subject now reports the number of messages that have + been deleted. +* fixed bug in implementation of vm-reply-subject-prefix; test + condition was reversed, and the string-match for the prefix was + not anchored at the beginning of the header contents as it + should have been. +* fixed problem where expunging immediately after C-x C-s would not show + folder as being modified, even if some messages were expunged. +* virtual folders + - New variables: + + vm-virtual-folder-alist + + vm-virtual-mirror + - New commands: + + vm-visit-virtual-folder +* vm-proportion-windows now handles vertical windows appropriately. +* vm-expose-hidden-headers now automatically jumps to top of message. +* VM no longer stuffs headers into expunged messages before saving the + folder (oops). +* fixed bug in handling of negative prefix arguments (broken everywhere). +* fixed bug in the message save functions, last-command was being + clobbered on interactive calls, which made the commands inapplicable + to marked messages. +* fixed bug in vm-delete-message-backward; vm-follow-summary-cursor was + not being called. +* vm-resend-bounced-message moved from C-r to M-r. +* support for Grapevine added to vm-resend-bounced-message. + +VM 5.08 released + +* commands that send mail now inherit the default-directory of the + folder buffer. +* 86ed last paragraph of vm-burst-digest docstring left by an + overzealous documentation Muse. +* better error handling when getting months and month numbers. + bogus Date: header shouldn't make VM explode now. +* the code that supported vm-reply-ignored-addresses had a typo: + "to" where "cc" should have been--- fixed. +* fixed problem with *mail* buffer not being displayed after C-r + (vm-resend-bounced-message). I believe this is in fact a bug in + save-excursion. +* New variable: vm-auto-folder-case-fold-search +* Updated regexp that groks RFC 822 dates to reflect new policy as of + RFC 1123, i.e. four digit year numbers. +* vm-mail need not be invoked from within VM now. + +VM 5.07 released + +* purged the overlay-arrow filth, enough is enough. +* changed incorrect reference to m to (car mp) in vm-write-file-hook. +* removed incorrect call to backup-buffer in vm-gobble-crash-box +* fixed full name parsing botch that left trailing quote on doublequoted names. +* more virtual folders code added + +VM 5.06 released + +* vm-save-restriction modified to hide its uninterned vars in a (let ...) + because the byte-compiler interns them. :-( +* fixed problem with vm-resend-bounced-message; mail-header-separator + was not being inserted into the message. +* fixed another problem with vm-resend-bounced-message; code needed to + be inside the save-restriction call instead of outside it. +* some early virtual folder stubs added. + +VM 5.05 released + +* Changed vm-thoughtfully-select-message to rely on vm-system-state to + determine whether to jump to a new message or not. Made mods to other + VM function to insure the vm-system-state always has the right value. +* New variable: vm-digest-preamble-format +* New variable: vm-digest-center-preamble +* cleanups in the header stuffing routines +* added a modify flag to each message struct; should save time when + saving by restuffing only those messages that need it. + +VM 5.04 released + +* fixed problem with the summary arrow drifting out of view in the summary + window. +* fixed problem with visible/invisible variables startup consistency + checking. +* disabled file locking in places where it is inappropriate; this should + make startup a bit faster. +* made vm-show-current-message do something sensible if a page-delimiter + is at the beginning of the text portion of the message, and + vm-honor-page-delimiters is non-nil. +* made vm-honor-page-delimiters override the value of vm-preview-lines + if honoring vm-preview-lines would require displaying past a page + boundary. +* fixed problem where VM wasn't detecting end of message when honoring + page delimiters. +* fixed problem with editing and already edited message not setting the + buffer modification flag; also fixed similar problem with unsetting the + edited flag. +* added a page break indicator via overlay-arrow. The overlay-arrow + vars are buffer local, so there shouldn't be any squabbles over their + use. + +VM 5.03 released + +* fixed problem with point and the summary arrow not coinciding at startup. +* MAILPATH again; bash doesn't use `%' as sh does, it uses `?'. +* Changed Makefile. `make' alone no longer rebuilds the texinfo stuff; + `make all' does that now. +* Fixed Makefile; vm.info wasn't being saved after formatting (oops). + +VM 5.02 released + +* Changed defconst to defvar in the definition of vm-summary-format; + this is a leftover from debugging. +* Makefile wasn't loading ./vm.elc before forcing compilation of all + modules. Depending on the circumstances an old vm.elc could be loaded + with predictably bad results. +* Added -q to Emacs invocations in Makefile to avoid grot in .emacs files. +* New command: vm-delete-message-backward (C-d), a concession to + RMAILoids. Maybe now they'll get off my BACK about this. :-) +* doc corrections and additions +* modified vm-su-do-author to handle double quoted full names better. + +VM 5.01 released + +* fixed MAILPATH parsing; forgot about "%message" stuff that could be + tacked onto the end of the filenames. +* added check to the mail gathering routines to make sure the folder types + of the source and destination folders are compatible. +* fixed bug involving vm-totals in vm-assimilate-new-messages. +* doc corrections + +VM 5.00 released for alpha testing (sometime in 1990) + +* `t' now toggles exposing/hiding normally invisible headers. +* VM now writes much more cached info into its data header resulting in + much faster startup. +* New variable `vm-invisible-header-regexp'. +* Cached a regular expression that shows how to find the beginning of the + reordered headers (assuming the user permits such cached data to be + used, then VM won't reorder message headers every time a folder is + visited. +* Status and X-VM-... headers are now updated in place instead of always + putting them at the top of the message. +* vm-delete-header unused, went away. +* Doesn't feep on "No next unread message." +* `written' and `forwarded' attributes added. +* macroized (if vm-mail-buffer (set-buffer vm-mail-buffer)) into + (vm-select-folder-buffer) +* modularized the header highlighting and folder buffer display functions. +* fixed < and > to behave properly when invoked from the summary buffer. +* vm-last-save-folder now gets the fully expanded version of the folder name. +* vm-visit-folder now defaults to vm-last-save-folder if it is non-nil, + and the user hits RET at the interactive prompt. +* old vm-mode now vm-mode-internal; new vm-mode now interactively callable. +* vm-get-new-mail now takes a prefix argument to mean gather mail from a + user specified folder instead of from the usual spool files. +* vm-auto-archive-messages now ask user confirmation before saving each + message if given a prefix arg. +* Fixed botched interpretation of Berkeley Status headers. +* VM now loads ~/.vm the first time it is executed in an Emacs session. +* New variable `vm-move-after-undeleting'. +* Added a trailing slash to the if-all-else-fails setting of + vm-spool-directory. +* Fixed problem where the totals blurb would not be redisplayed after + the copyright info if vm-startup-with-summary is t. +* `vm' now only does (switch-to-buffer mail-buffer) if it was not + invoked via vm-mode. +* vm-howl-if-eom-visible has forsaken pos-visible-in-window-p in favor + of just doing a scroll-up and howling if an error occurs. This + obviates the need for vm-show-current-message to do a sit-for before + calling vm-howl-... +* Implemented the standard VM included text code as a call to + vm-yank-message and a default yank function. This default yank + function is not called if the user already has a mail-yank-hook in place. +* If the FOLDER-NAME part of auto-folder-alist evaluates to a list, + then it is considered to be another auto-folder-alist and is scanned + like vm-auto-folder-alist. +* New variable `vm-auto-next-message'. +* New variable `vm-auto-center-summary'. +* VM can now survive the death of its summary buffer. +* VM no longer uses overlay-arrow; the summary arrow is now written into + the summary buffer directly. +* %t and %T now supported to show recipient addresses and full names in + the summary. +* vm-gargle-uucp extended to cover %t addresses. +* New variable `vm-honor-page-delimiters'. +* New variable `vm-reply-subject-prefix'. +* vm-quit now squawks if invoked from a non-VM buffer. It used to just + kill whatever buffer it was invoked from. +* vm-folder-type now automated; is no longer a user variable. +* message marks +* the end of message notification has been removed. +* group by recipient +* New variable: vm-reply-ignored-addresses +* `U' now marks messages unread. +* skip variables value = t now means skip inappropriate messages + dogmatically, no exceptions. Non-nil and non-t value now gives old + behavior. +* attributes are now stuffed before saving a message to a folder. +* bookmarks +* vm-yank-message-other-folder +* support for MAIL and MAILPATH environmental variables +* after getting new mail jump to the first unread message only if the + last command executed was not a message scan command, e.g. + vm-scroll-forward, vm-isearch-forward. +* summary mode-line-format format now mirrors that of the folder buffer +* vm-buffer-modified-p returns, folder buffer is now read-only. +* 'L' now loads ~/.vm +* vm-mode is quieter and less obtrusive now, vm now works with crypt.el + and with vm-mode present in auto-mode-alist. +* you can now save a message in a folder to that same folder, in effect + duplicating it. +* `M' format spec now gives numeric month. +* message editing +* `j' discards cache data +* C-r (vm-resend-bounced-message). +* New variable: vm-confirm-quit +* New behavior for vm-visit-when-saving if it is non-nil and non-t. +* `A' no longer archives messages marked for deletion. +* prefix arg to vm-burst-digest now makes it copes with non-standard + digests, at least to a certain extent. +* New format spec %A gives longer attribute summary; less column overloading. +? vm-read-mh-folder + +gnu.emacs.vm.info started Feb 1, 1991 + + http://groups.google.com/group/gnu.emacs.vm.info/browse_frm/month/1991-02 + + +VM 4.11 released May 30, 1989 (posted on comp.emacs) + +* VM has learned how to deal with MMDF folders + +VM 4.10 released May 23, 1989 (posted on comp.emacs) + + The first public release of VM + http://groups.google.com/group/comp.emacs/browse_frm/month/1989-05 + +------- + +Kyle Jones's note (written on Apr 27, 1997) + +The earliest record I have of anything VM related is April 1989. +Sometime in the spring of 1989, I wrote the first version of VM +and gave it to a few friends. The first net release was 4.10, +sometime in June of that same year. All releases up to that +point were to a small group of people, mostly college friends who +I knew used Emacs. + +VM was originally written to run under GNU Emacs 18.52. I didn't +seem to get seriously interested in supporting v19 GNU Emacs until +the summer of 1993. + +5.00 was a private alpha release, sometime in 1990 I think. + +I know that Jamie [Zawinski] was shipping VM with XEmacs as early as +v19.9. But beyond that I have no idea. + + @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. @@ -0,0 +1,180 @@ +PRE-COMPILED BINARIES +===================== + +If you have downloaded binaries for Gnu Emacs version 22 or 23, you +can unpack it to a directory, say ~/vm, and go to step (3) below. + +However, this build assumes that you are not using any supporting +libraries such as BBDB, W3 or W3M. If you are using such libraries, +please rebuild VM as indicated below. + +If you are using XEmacs, you need to do your own build. + +USING CONFIGURE +=============== + +0) autoconf: If you get VM from the revision control, the `configure' script + is not included. You have to run `autoconf' to create it. If you got VM + from a public release, you should skip this step. + +1) configure: First you need to decide the various options. + + --with-emacs the emacs you will use to compile (can be a Unix path) + --prefix the prefix for the installation (default /usr/local) + --with-other-dirs the directories to use for loading any extra + emacs-lisp libraries during compilation + + The default installation locations are as follows: + + a) GNU Emacs: + lisp files goto ${prefix}/share/emacs/site-lisp, + data files go to ${prefix}/share/vm, and + doc files go to ${prefix}/share/doc/vm-X.Y.Z, and + info files go to ${prefix}/share/info, (overridable with + --with-lispdir=..., --with-etcdir=..., --with-docdir=... + and --infodir=...). + + b) XEmacs: + lisp files go to ${prefix}/lib/xemacs/site-packages/lisp/vm, + data files go to ${prefix}/lib/xemacs/site-packages/etc/vm, + doc files go to ${prefix}/lib/vm-X.Y.Z, + info files to ${prefix}/lib/xemacs/site-packages/info, (overridable + with --with-lispdir=..., --with-etcdir=..., --with-docdir=... + and --infodir=...). + + Run M-x describe-installation in XEmacs for hints on where to + install the files for XEmacs. + + NOTE: VM 8.1.1 and older versions used an option --with-pixmapdir, + which is now replaced by --with-etcdir. + + ATTENTION: Files byte-compiled with GNU Emacs are NOT COMPATIBLE with + XEmacs and you may experience strange problems during startup if you do + so. Even between different versions of the same Emacs, there can be + problems! + + EXAMPLES: + + a) GNU Emacs+BBDB users run: + ./configure --with-other-dirs=/absolute/path/to/bbdb/lisp + + b) XEmacs+BBDB users run: + ./configure --with-emacs=xemacs --with-other-dirs=/path/to/bbdb/lisp + + c) GNU Emacs+BBDB+Emacs-w3m users run: + ./configure --with-other-dirs="/absolute/path/to/bbdb/lisp;/absolute/path/to/emacs-w3m" + + d) XEmacs with no additional packages + ./configure --with-emacs=xemacs + +2) make: Compile everything by running: + + make + + You may ignore the byte compiler warnings. However any messages from + `make' indicate problems or deficiencies in the installation, such as + missing libraries. + +3) Installing the files + + a) To use VM from the built directory + + You can use VM directly from the directory where you built it, without + any further installation. To activate VM, follow these steps: + + Add the "lisp" and "info" directories in the VM built directory to the + Emacs search paths, e.g. if you have built vm in ~/vm, add the following + to your ~/.emacs or ~/.xemacs/init.el files. + + (add-to-list 'load-path + (expand-file-name "~/vm/lisp")) + (add-to-list 'Info-default-directory-list + (expand-file-name "~/vm/info")) + + IMPORTANT: If there are any old VM-related autoloads in your + emacs init file, you should remove them. The current version of + VM takes care of its own autoloading. + + GNU Emacs: Load the autoloads by hand by adding + + (require 'vm-autoloads) + + to their ~/.emacs. + + XEmacs: Since XEmacs has a built-in distribution of VM, you have two + options. (i) You can delete the built-in package in the XEmacs + xemacs-packages directory. Then the new copy of VM in ~/vm/lisp + will get loaded. (ii) You can include the following line in + your ~/.xemacs/init.el file: + + (load-library "~/vm/lisp/auto-autoloads") + + Info files: Add the following lines to the `dir' file in your + user-maintained info directory. If you don't have one, you can create + a new `dir' file in ~/vm/info. + + * VM: (vm.info). VM Mail Reader + * VM-PCrisis: (vm-pcrisis.info). Personality Crisis package for VM + + Note that vm-pcrisis is a separate add-on package (not officially a + part of VM). + + b) To use VM from system directories: Run + + make install + + This will install VM files in the locations chosen in the `configure' + step. + + You are now ready to use VM. C-h i should start up the Emacs Info + system. If you have installed the Info documents properly, you can use + the online documentation to teach yourself how to use VM. + +COMPANION PACKAGES +================== + +VM uses companion packages for address book maintenance and HTML +display. VM will work fine even if the companion packages are +unavailable, but the best functionality is obtained with them. + +* BBDB or "Big Brother Insidious DataBase" is an address book + application that runs within Emacs. It is able to watch the email + addresses in the headers of your email addresses and record them in + the database. + + Assuming that you have compiled VM with BBDB included in the + `lispdir' list, include the following lines in your .emacs to turn + on BBDB support: + + (require 'bbdb) + (bbdb-initialize 'vm) + +* For rendering HTML messages, VM can make use of the following Emacs + libraries: + + - Emacs/W3 - a web browser written by William Perry in Emacs Lisp. + It is said to be slow and its current maintenance (in 2010) is + weak. + + - Emacs/W3M - an Emacs interface to the text-mode web browser W3M. + + For guidance on installing either of these libraries, please check + their EmacsWiki pages and their own installation instructions. + + VM can also make use of the following external text-mode web + browsers (as basically converters from html to plain text). + + - Lynx - A fast text-based web browser that runs under Unix. + Developed at the University of Kansas. + + - W3M - Possibly the best text-based web browser. Written by + Akinori Ito and his team, it runs fast and renders pages + as true to form as possible in plain text. + + VM can check the libraries available on your path and pick the best + one for HTML rendering, but you can also specify the choice + explicitly by including in your .emacs file, e.g., + + (setq vm-mime-text/html-handler 'emacs-w3m) + + Other than 'emacs-w3m, you can also use 'w3, 'w3m and 'lynx. diff --git a/Makefile.in b/Makefile.in new file mode 100755 index 0000000..91d0d2c --- /dev/null +++ b/Makefile.in @@ -0,0 +1,101 @@ +@SET_MAKE@ + +# location of required programms +BZR = bzr --no-plugins +prefix = @prefix@ +MKDIR = @MKDIR@ +TAR = @TAR@ +RM = @RM@ +XARGS = @XARGS@ +prefix = @prefix@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ + +srcdir = @srcdir@ +datadir= @datadir@ +datarootdir= @datarootdir@ +etcdir = @etcdir@ +pixmapdir = @pixmapdir@ +docdir = @docdir@ + +SUBDIRS = lisp info src pixmaps + +# the list of source (documentation) files +SOURCES = NEWS +SOURCES += CHANGES +SOURCES += README +SOURCES += TODO +SOURCES += COPYING + + +############################################################################## + +.PHONY: all install clean distclean + +all: vm-load.el + @for i in $(SUBDIRS) ; do ($(MAKE) -C $$i) || exit 1; done + +Makefile vm-load.el: %: config.status @srcdir@/%.in + ./config.status $@ + +@srcdir@/configure: @srcdir@/configure.ac + cd @srcdir@ ; autoconf + ./config.status --recheck + +config.status: @srcdir@/configure + ./config.status --recheck + +install: install-pkg + @for i in $(SUBDIRS) ; do ($(MAKE) -C $$i install) || exit 1; done + +install-pkg: + $(MKDIR) -p "$(DESTDIR)$(docdir)" + $(MKDIR) -p "$(DESTDIR)$(etcdir)" + for i in $(SOURCES) ; do \ + echo "Installing $$i in '$(DESTDIR)$(docdir)' and '$(DESTDIR)$(etcdir)'" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(docdir)" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(etcdir)" ; \ + done ; + +clean: + @for i in $(SUBDIRS) ; do ($(MAKE) -C $$i clean) || exit 1; done + +distclean: + @for i in $(SUBDIRS) ; do ($(MAKE) -C $$i distclean) || exit 1; done + +push: + $(BZR) push + +############################################################################## +PKGDIR = $(shell pwd)/,,package/ +PKGINFO = $(PKGDIR)/lisp/vm/_pkg.el +xemacs-package: + if [ "x@EMACS_FLAVOR@" != "xxemacs" ]; then \ + echo "ERROR: Current build dir not configured for XEmacs,"; \ + echo "ERROR: Please re-run configure with --with-emacs=xemacs."; \ + exit 1; \ + fi + -$(RM) -rf ,,package + cd lisp; make PACKAGEDIR=$(PKGDIR)/lisp/vm install-pkg + cd info; make info_dir=$(PKGDIR)/info install-pkg + cd src; make info_dir=$(PKGDIR)/bin install-pkg + echo ";;;###autoload" > $(PKGINFO) + echo "(package-provide 'vm'" > $(PKGINFO) + echo " :version 0.7" >> $(PKGINFO) + echo ' :author-version "'`$(BZR) revno "@top_srcdir@"`'"' >> $(PKGINFO) + echo " :type 'regular)" >> $(PKGINFO) + mkdir $(PKGDIR)/pkginfo; + touch $(PKGDIR)/pkginfo/MANIFEST.vm; + cd $(PKGDIR); find -type f | cut -c3- > pkginfo/MANIFEST.vm + cd ,,package; $(TAR) -cvzf ../vm-pkg.tar.gz * + +############################################################################## +release:: + ./release.sh + +snapshot:: + ./release.sh snapshot + +tags:: + etags lisp/*.el contrib/*.el info/vm.texinfo NEWS @@ -0,0 +1,1193 @@ +IMPORTANT + + If you are upgrading from a previous version of VM, please look through + all the CHANGES sections below since that version to see how you might be + affected. + +Status + + VM is currently being maintained by a 'VM development team' consisting of + Uday S Reddy, Ulrich Müller, Tim Cross and Arik Mitschang. More + volunteers to help with the maintenance are quite welcome. + + Project home page: http://www.nongnu.org/viewmail + + Mailing list: viewmail-info@nongnu.org + + Bug report: viewmail-bugs@nongnu.org + (Please use `M-x vm-submit-bug-report' within VM) + + News group: gmane.emacs.viewmail on news.gmane.org + (gnu.emacs.vm.info is defunct) + + Please DO NOT use the Usenet newsgroup gnu.emacs.vm.info because it has an + unreliable mail link to the mailing list. You can however browse the + archives of the newsgroup at Google Groups. + +VM 8.2.0b (2011-12-28) + + CHANGES + + * New customization variable `vm-spam-score-headers' allows the + extraction of spam scores. (Replaces the former variable + `vm-vs-spam-score-headers' used by vm-avirtual.el.) + + * The variable `vm-mime-alternative-select-method' renamed to + `vm-mime-alternative-show-method' to make it clear that it only applies + to the viewing of messages. The new variable + `vm-mime-alternative-yank-method' controls the selection of + alternatives for citation in replies. + + * `vm-submit-bug-report' now uses Emacs message-mode for composing the + bug report (whereas it previously used mail-mode with VM-specific + tweaks). Please do C-h m to find the functions you might need. + + * Terminology: Interactively created virtual folders are now called + "Search Folders". They have a stronger connection to their parent + folders and inherit some attributes, e.g., the read-only property. + + IMPROVEMENTS + + * New variable `vm-mail-use-sender-address' allows `vm-mail' to pick up + the sender of the current message as the recipient of a new message + composition. + + * See the new info manual section on "IMAP folders" for newly documented + functions. In particular, `vm-list-imap-folders' now lists the message + counts in the IMAP folders. + + * New variable: `vm-sort-messages-by-delivery-date' allows messages to be + sorted by the date of their delivery instead of the date sent. + + * New virtual folder selectors added: `message-id', `uid' (for IMAP) and + `uidl' (for POP). + + * New command `vm-create-virtual-folder-of-threads' (bound to `V T') + allows you to select entire threads into a virtual folder instead of + individual messages. There are also new virtual folder selectors + `thread' and `thread-all'. + + * The trace of POP/IMAP sessions are retained in buffers named "trace of + POP session..." or "trace of IMAP session...". They are useful for + troubleshooting any problems with mail server connections. + + * Setting `vm-stunnel-program' to nil asks VM to use the built-in SSL + functionality of Emacs, available in Gnu Emacs 24. + + * New functions `vmpc-folder-match' and `vmpc-folder-account-match' in + the vm-pcrisis package. + + * New variable `vm-mail-auto-save-directory' where message composition + buffers are auto-saved. + +VM 8.2.0a (2011-02-28) + + CHANGES + + * The configuration of headers-only messages, introduced in 8.1.90a, has + changed. The variable `vm-load-headers-only' has been replaced by a + new variable `vm-enable-external-messages'. It should be set to 'imap + to allow external messages in IMAP folders and + `vm-imap-max-message-size' be customized to control the size of + messages that will be external. + + * If you download mail from IMAP spool files, the 8.1.x versions of + VM had a bug which allowed the the `X-VM-IMAP-Retrieved' headers + to grow unnecessarily. This can slow down the saving of folders + into which you downloaded IMAP mail. To solve the problem, run + the command `vm-prune-imap-retrieved-list' after installing + version 8.2.0. (See the info manual under "IMAP Spool Files".) + + * A set of inessential key bindings (a, b, e, i, w, L, M-l, !, <, >, *, + %) have been removed from the standard VM key bindings. If you would + like to use them, add the line: + (vm-legacy-key-bindings) + to your vm-preferences-file (~/.vm.preferences). To use the current + key bindings instead, use the line + (vm-current-key-bindings) + Or, you might bind these keys to some other operations of your choice. + + However, `vm-edit-message' is available via a new key binding `C-c + C-e'. + + * The default value of `vm-url-browser-function' (invoked by mouse-2) is + changed to 'browse-url, which is an Emacs standard web-browsing + function. To invoke your favourite browser, customize + `browse-url-browser-function'. Cf. Emacs manual. + + * The mouse-3 context menu for URL's in messages updated to eliminate + obsolete web browsers. Entries added for Firefox, Mozilla and Opera. + + * The function `vm-mouse-send-url-to-konqueror-new-browser' renamed + to `vm-mouse-send-url-to-konqueror-new-window', to be consistent + with other similar functions. + + * The default settings of `vm-mime-deleteable-types' and + `vm-mime-saveable-types' do not include the types listed in + `vm-mime-external-content-types-alist'. You might need to add them + explicitly in your vm-preferences-file. + + * The variable name `vm-auto-displayed-mime-content-types' changed + to `vm-mime-auto-displayed-content-types' for consistency with + other variable names. (The corresponding `-exceptions' variable + changed as well.) + + * The variable name `vm-mime-attachment-infer-type-for-text-attachments' + changed to `vm-infer-mime-types-for-text'. + + * Plain text forwarding has been extended to deal with MIME attachments. + The command `vm-forward-message-plain' (bound to `Z') uses this method. + (The normal `z' key forwards messages encapsulated using + `vm-forwarding-digest-type'.) There are also associated variables + `vm-forwarded-headers-plain' and `vm-unforwarded-header-regexp-plain', + which determine the headers included in the forwards. + + * The meaning of the variable `vm-included-mime-types-list' is + changed. It need only mention MIME type/subtype pairs that are + not handled by default. The types "text/plain", "text/enriched" + and "message/rfc822" are now handled by default. + + * The attributes vector has been expanded to 16 elements for + compatibility with Mozilla Thunderbird. The first time a folder + is written, this will cause extra time to be taken for "stuffing" + the attributes. But this is only a one-time cost. + + * New variable `vm-include-mime-attachments' allows the inclusion of + MIME attachments in replies. This functionality was originally + part of vm-pine.el under the name `vm-mime-yank-attachments'. + That functionality is now obsolete. Replace references to + `vm-mime-yank-attachments' in your customization by the new variable. + + * The command `vm-flag-message-read' (.) introduced in 8.1.93a is + renamed to `vm-mark-message-read' for consistency of terminology. + + IMPROVEMENTS + + * New option 'internal-only for `vm-mime-honor-content-disposition', + which means the content-disposition will be honored for only internally + displayable types. + + * New variable `vm-mime-alternative-yank-method' controls the selection + of MIME alternatives during yanking of messages (as well as including and + forwarding). + + * Added a variable `vm-verbosity' to control the granularity of + informative messages displayed by VM. Levels 5-8 are recommended, with + 8 corresponding to the current level. + + * New operations for manual control of thread indentation for + dealing with long (and deep) message threads. See info under + "Threaded Summaries". + + * A number of "point-to-point" attachment operations have been + added: + - `vm-dired-attach-file' and `vm-dired-do-attach-files' from + dired buffers. + - `vm-attach-message-to-composition' and + `vm-reader-map-attach-to-composition' from VM folders. + - a drag-and-drop feature that can be used in the window system. + + * New command `vm-switch-to-folder' defined to quickly return to a + previously buried folder. (Originally in vm-rfaddons.) + + * New custom command `vm-toggle-best-mime' in vm-rfaddons to toggle + between 'best and 'best-internal' MIME altrenatives. (Thanks to + Alley Stoughton for this addition.) + + * New variable `vm-include-text-basic' can be used to enable the + fallback method of quoting message text in replies. It should + be normally left with the default value of nil. + + * VM refrains from repeatedly checking for new mail once it has + found some new mail on the spool. Set `vm-mail-check-always' to + override this behavior. + + * When a predefined virtual folder is quit, all the component + folders that it depends on will also be quit automatically. + + * When an interactive virtual folder is quit, the message pointer + in the virtual folder is transferred to the original folder. + This facility can be used to search for particular messages by + using virtual folders. + + * Restored the [Emacs] and [Undo] menu buttons that were removed in + version 8.0.8. For environments that do not support such buttons, + drop-down menus will be used instead. The variable + `vm-use-menubar-buttons' can be used to use drop-down menus + always. (Thanks to Tim Cross for the fixes.) + + * Hooks `vm-arrived-message-hook' and `vm-arrived-messages-hook' + made to work correctly for IMAP folders. + + * New variable `vm-thunderbird-folder-directory' and command + `vm-visit-thunderbird-folder' allow the handling of Thunderbird + folders without interference with VM's own folders. + + * New variable `vm-sort-subthreads' allows the internal messages of + threads to be sorted into subthreads (the default) or via the + normal sorting criteria. + + * Better support for message/external-body MIME type, with + external-bodies loaded on demand. If you have + message/external-body as an element in + `vm-mime-auto-displayed-content-types', you should remove it to + access the new functionality. + + * Newly documented commands: `[' (`vm-previous-button') and `]' + (`vm-next-button') allow navigation inside message + presentation buffers. + + * New command: `!' (`vm-toggle-flag-message') allows you to flag a + message as being important. This adds a "!" mark in the Summary + line for the message and highlights it with the high-priority face. + + * New variable: `vm-summary-visible' specifies which messages + should remain visible in folded thread summaries. + + * New feature: vm-mime-external-content-types-alist allows + emacs-lisp functions to be used for external viewing, e.g., + you can use `browse-url-of-file' to view html . + +VM 8.1.93a (2010-08-28) + + CHANGES + + ** New feature: Invoking vm-load-init-file with a prefix argument + loads the init-file (~/.vm) without loading the preferences-file + (~/.vm.preferences). This is a good way to run VM with the + default settings, much like `emacs -Q'. We are advising all + users to split their init-files to make use of this feature. See + info section on "Starting Up". + + ** New feature: vm-summary-enable-faces allows summary lists with + faces turned on. (This was formerly an add-on contributed by + Robert Fenk under the name vm-summary-faces-mode. But there are + several changes. In particular, the face names do not end in + "-face" following the Emacs naming conventions.) See the info + section on "Summaries" for more information. If you currently + use the u-vm-color package for colorizing the Summary buffers, + please remove the feature, i.e., delete a line like + (add-hook 'vm-summary-mode-hook 'u-vm-color-summary-mode) + from your VM initialization file. + + ** Commands renamed: + `vm-mime-save-all-attachments' => `vm-save-all-attachments'(C-c C-s) + `vm-mime-delete-all-attachments' => `vm-delete-all-attachments'(C-c C-d) + + IMPROVEMENTS + + * Sorting of messages extended to work with threads. By default, + threads are sorted by "activity", i.e., the date of their most + recent activity. But they can also be sorted by other sort keys. + (The variable `vm-sort-threads-by-youngest-date' is now defunct.) + + * New feature: thread-folding in the Summary window allows message + threads to be collapsed into single line summaries. The + following new variables control the behavior of thread folding. + `vm-summary-enable-thread-folding', + `vm-summary-show-thread-count' and + `vm-summary-thread-folding-on-motion' + New commands: + `vm-toggle-thread' (T), `vm-expand-all-threads' (E) and + `vm-collapse-all-threads' (C). + See the info file for details. Thanks to Arik Mitschang for this + contribution. + + * New experimental feature: `vm-enable-thread-opeartions' enables + "thread operations", a method of invoking operations (such as + deleting or saving) on message threads. See the info file for + details. Thanks to Arik Mitschang for this contribution. + + * New variables: `vm-summary-thread-indentation-by-references' + controls whether threads are indented by their original nesting + level or according to the nesting level within the folder. + `vm-summary-maximum-thread-indentation' specifies the maximum + depth of indentation to be displayed. + + * New command: `vm-kill-thread-subtree' (K) allows a thread subtree + to be deleted. This amounts to the same thing as + `vm-delete-message' invoked as a thread operation. + + * The calculation of threads improved using Jamie Zawinski's + ideas. Threads are correctly identified even if some of the + messages are missing. + + * Added EasyPG storage of passwords for mail server accounts. See + info index under "passwords". + + * Virtual folder facility extended to work with POP and IMAP + folders. But, there are still some outstanding problems with it. + + * Resolved performance problems in summary generation. It works + quite fast now. + + * New variable: `vm-mime-parts-display-separator' allows you to + insert a string as a separator between MIME parts. + + * New command: `vm-save-attachments' allows you to save all the + attachments of a message under your own file names instead of the + original file names given in the message. + + * New command: `vm-flag-message-read' (.) allows you to mark an + unread or new message as read. + + BUG FIXES + + * Fixed various issues flagged by the Emacs 23 compiler warnings. + +VM 8.1.925a (2010-07-17) +VM 8.1.92a (2010-07-10) + + IMPROVEMENTS + + * Headers-only mode (external messages) for IMAP folders is now + completed. It operates by fetching messages into the Folder buffers, + leading to a more reliable operation. + + * New command `vm-list-imap-folders' can be used to list the + folders on an IMAP server. + + * In headers-only mode for external messages, a limited number of + messages can be fetched on demand for message preview. New variable + `vm-fetched-message-max' specifies this number. (Default is 10.) + + * New variable `vm-imap-default-account' allows IMAP-FCC copies to + be routed there. + + * New variable `vm-imap-server-timeout' allows timeout during a wait + for output from an IMAP server. + + * New variable `vm-imap-ensure-active-sessions' asks VM to ensure + that an IMAP session is active before issuing commands. + +VM 8.1.90a (2010-05-11) + + IMPROVEMENTS: + + ** This version contains an experimental feature of using IMAP folders in + "headers-only" mode for external server messages, with body loaded only + on demand. This helps to keep the folder sizes small and VM to run + faster. However, this code is in a preliminary stage. Please use it + with CAUTION. + + variable: vm-load-headers-only (or vm-enable-external-messages) + + If set to t, all new messages will be loaded to the cache-folder + in headers-only mode. The body is loaded on demand when a + message is displayed in the Presentation Buffer. This is a + temporary load and is lost as soon as you move to another + message. + + To permanently load a message body into the Folder Buffer, use: + + command: vm-load-message (bound to 'o') + + This command discards the current body of the message, if any, + and refreshes it from the server copy. + + command : vm-unload-message (bound to 'O') + + This command discards the current body of the message from the + Folder Buffer and leaves it empty. + + FAILURE RECOVERY: If the cache folder gets corrupted for any + reason, just delete it from the file system. A new cache folder + will be generated upon the next visit. + + * New variable `vm-imap-refer-to-inbox-by-account-name' allows IMAP + folders named "INBOX" to be referred to by their account names + inside VM. + + * The command `vm-fix-my-summary!!!' renamed to `vm-fix-my-summary' + to make it easier to type. + + * The chatter of minibuffer messages during paging of mail is + reduced: messages about MIME decoding are emitted only if the new + variable `vm-emit-messages-for-mime-decoding' is non-nil, and + messages about end of messages are emitted only of + `vm-auto-next-message' is non-nil. + + * IMAP session dialogue restructured using UID queries, which makes + VM more reliable in handling real-time changes on the server side. + + * New variable `vm-imap-connection-mode' can be set to 'offline to + allow IMAP cache folders to be used offline. After connecting to + the network, do `C-u M-x vm-imap-synchronize' to force full + synchronization. + + * Improved error messages arising in IMAP sessions wih the server. + + * New variable `vm-do-fcc-before-mime-encode' (formerly in + vm-rfaddons) allows you to save fcc copies of messages before + mime-encoding them. + + ** New variables `vm-expunge-before-quit' and `vm-expunge-before-save' + introduced to allow automatic expunge. They are nil by default. + +VM 8.1.2 + + * VM made safe for use with Gnu Emacs 23, by removing a few calls + to the `next-line' function (which was redefined in this Emacs). + + * Several critical problems with Thunderbird inter-operability + were corrected. Manual section on Thunderbird folders added. + + * Extended Org mode email links to work for virtual folders. + + CHANGES + + ** The default values of `vm-pop-expunge-after-retrieving' and + `vm-imap-expunge-after-retrieving' changed to nil to help new + users. + + * `vm-fill-long-lines-in-reply' initialized to the default value + of `fill-column'. + + * All MIME messages are now decoded in the Presentation buffer, + unless they have US-ASCII as their charset. In particular, + messages with 8bit charsets are treated this way. Such messages + are not regarded "plain messages" any more. + +VM 8.1.1 (2010-04-26) + + ** The variable vm-always-use-presentation-buffer is deprecated. + Please remove all settings for this variable in your init file. + The default behaviour will be to always use the presentation + buffer. Report any problems that might arise as a result. + + * Extended Org mode email links to handle POP and IMAP folders. + (Use org-vm.el in the VM contrib directory until the Org mode + distribution gets updated.) + + * Added autoloads for easy inter-operation with the Org mode. + + * Added a section on History and Administration in the info manual. + + * Made the autoloads compatible with VM 7.19 instructions. + + * Fixed the build process to treat version info better. + + * Removed a few incompatibilites with XEmacs. + + * Mode line format reverted to the original one in 7.19. The new + mode line format is available in the variable + `vm-mode-line-format-robf'. It can be installed by adding a + vm-mode-hook. + +VM 8.1.0 (2010-03-21) + + KNOWN PROBLEMS: + + * Automatic filling is turned off for some plain text messages for + safety reasons. Please help us by sending us sample messages + for which filling fails. + + * IMAP folders occasionally give spurious connection errors. + Doing vm-get-new-mail ('g') resumes the connection. + + MAJOR NEW FEATURES: + + * Support for reading and replying to messages in HTML. + + * Full support for IMAP servers. (See "IMPROVEMENTS for + imap-folders" below.) + + CHANGES: + + ** New boolean variable `vm-word-wrap-paragraphs' controls the word + wrapping of paragraphs in messages using the longlines library. + The variable is set to nil by default. When it is set to t, + paragraphs are word wrapped and the value of the variable + `vm-fill-paragraphs-containing-long-lines' is immaterial (as + long it is non-nil). Set vm-word-wrap-paragraphs to nil to + enable the usual filling functionality. + + ** vm-pgg is not loaded by default because it is a set up as an + add-on. Users should load it from their .emacs file by using + the sequence + (require 'vm-autoloads) + (require 'vm-pgg) + + ** The variable `vm-mime-show-alternatives' is deprecated. Set + the variable `vm-mime-alternative-show-method' to 'all to + get the same effect. + + * Moved Robert's user-defined summary functions to the core: + - S for human readable size + - P for indication of attachments + - p for indication of a postponed message + + IMPROVEMENTS: + + * Display number of drafts and postponed messages in the modeline + and use a more compact modeline. To use this feature, include + this line in your .vm file: + + (setq vm-mode-line-format vm-mode-line-format-robf) + + * The variable `vm-paragraph-fill-column', previously removed in + earlier versions of this release, is brought back. + + ** The commands `vm-mime-save-all-attachments' and + `vm-mime-delete-all-attachments' have been moved to the VM core + (from vm-rfaddons). New variables: + vm-mime-deletable-types + (formerly `vm-mime-delete-all-attachments-types') + vm-mime-deletable-type-exceptions + (formerly `vm-mime-delete-all-attachments-types-exceptions') + vm-mime-savable-types + (formerly `vm-mime-save-all-attachments-types') + vm-mime-savable-type-exceptions + (formerly `vm-mime-save-all-attachments-types-exceptions') + vm-mime-attachment-save-directory + vm-mime-attachment-source-directory + vm-mime-all-attachments-directory + See the info file section on MIME attachments for details. + + The options for vm-rfaddons.el should not include + `save-all-attachments' and should be removed if it is currently + being used. The option `take-action-on-attachments' is not + included by default. + + * `vm-quit-no-change' offers to delete the auto-save file if there is + one. (This wasn't getting done due to a bug in FSF Emacs.) + + * `vm-delete-duplicate-messages' now works by comparing message ID's. + (from Noah Friedman's vm-addons). + + * New boolean variable `vm-sort-threads-by-youngest-date' allows + threads to be sorted by their youngest date or oldest date. + + * `vm-yank-message' function streamlined a bit. New variable + `vm-include-text-from-presentation' can be used to extract the + included message text from the presentation buffer. + + ** text/html handling controlled by a new variable + `vm-mime-text/html-handler' which is set to 'auto-select by + default. It causes VM to locate the best library among + emacs-w3m, external w3m, w3 and lynx to display html + internally. (This replaces the earlier variable + `vm-mime-use-w3-for-text/html'.) + + ** vm-delete-duplicate-messages now works by comparing message ID's. + (from Noah Friedman's vm-addons). + + * vm-yank-message function streamlined somewhat. New variable + `vm-include-text-from-presentation' used to extract message text + from presentation buffer. (This replaces the variable + `vm-reply-include-presentation' used in vm-rfaddons.) + + * The variable `vm-mime-yank-attachments' is set to nil by default, + so that we are not surprised by unexpectedly large mail messages. + + * The variable `vm-mime-require-mime-version-header' is set to nil + by default, so that we will be tolerant of bad MIME senders. + + * Allow for sorting the headers of composition buffers by calling the + function `vm-reorder-message-headers' interactively. You may configure + the order by the new variable `vm-mail-header-order'. This can be + useful if some broken MUAs (e.g. Tobit) mess up the messages due to the + header order. + + * Added hiding and protection of headers in composition buffers. See the + new variable `vm-mail-mode-hidden-headers' for customization. (Thanks to + Eric Schulte for the initial code posted in gnu.emacs.vm.info) + + * Added the function `vm-mime-list-part-structure' to list the mime part + structure of a message. + + * Added function `vm-mime-nuke-alternative-text/html' which can be used to + get rid of alternative text/html parts. + + * VMPC: Better action reader and a default profile which is used if no + email addresses could be found. The meaning of the arguments for + `vmpc-prompt-for-profile' has been slightly simplified, see the doc + string for details. + + * Removed `vm-paragraph-fill-column', the value is now taken from + `vm-fill-paragraphs-containing-long-lines' thus allowing to fill to the + available window with. + + * Replaced `vm-fill-paragraphs-containing-long-lines' by the faster and + more flexible version from vm-rfaddons.el. Also cleaned up calls to the + fill function and removed code duplication. The code using longline.el + remains in vm-rfaddons.el, but it must be used explicitly now in an + advice. + + * Moved the variable `vm-fill-long-lines-in-reply-column' from + vm-rfaddons.el to VM core. It is not necessary to hook the fill + function, just set the variable. + + * Errors caused by `vm-retrieved-spooled-mail-hook' are reported and + assimilation of messages continues instead of aborting. + + * Handle filenames also from the disposition fields "name", "filename*" + and "name*", where the latter two get decoded as they might contain 8bit + chars. + + * Uncoupled searching of MIME images from source location. The search + should be a bit smarter now allowing to place the images outside of the + source tree now. + + * Added syncing of message status when visiting a mbox of Thunderbird. + Not all message flags are interchangeable and the message summary + file (.msf) of Thunderbird will get removed by VM in order to force + Thunderbird to rebuild it. Also VMs folder index will be skipped if + it is older than the folder in order to update VMs message status flags. + + * Improved text/html displaying by w3m. Inline images are now extracted + correctly and they also display now. Added a generic handler code to + support also other HTML handlers. + + * Added variable `vm-restore-saved-summary-formats' to restore + each folder's summary format to what was saved previously. + (Uday S. Reddy) + + * A prefix argument to `vm-fix-my-summary!!!' will kill a folders local + summary format which was restored by `vm-restore-saved-summary-formats'. + + * The button for an image or PDF shows a thumbnail now when possible. + This requires ImageMagick. (Thanks to Eric Schulte for the idea and + initial code.) + + * Allow to reorder messages headers before sending by setting the new + variable `vm-mail-reorder-message-headers'. + + * Allow UTF-8 encoded messages to be displayed on tty. (Ulrich Müller) + + BUG FIXES + + * `vm-quit-no-change' made to honour the setting of the variable + `delete-auto-save-files'. (Uday S. Reddy) + + * Allow the use of iso-8859-1 for outgoing mail under Emacs 23 + (instead of spurious iso-2022-jp). (Ulrich Müller) + + * Coding system set to binary when reading and writing to allow + for 8-bit content. (Julian Bradfield) + + IMPROVEMENTS for pop-folders (Uday S. Reddy) + + * Added the variable `vm-pop-debug' to keep trace buffers. + + * New commands `vm-pop-start-bug-report' and `vm-pop-submit-bug-report' + which track POP session details. + + + IMPROVEMENTS for imap-folders (Uday S. Reddy) + + ** New variable `vm-imap-account-alist' allows multiple IMAP + accounts to be handled uniformly. The variable + `vm-imap-server-list' is now obsolete. IMAP folders should be + specified in the minibuffer using the account:mailbox format. + See the info node on IMAP folders. + + * New variable `vm-load-headers-only' to enable headers-only + downloading of IMAP folders. (This is still experimental.) + + * IMAP-FCC is extended to work for virtual folders, but only if + the real parent message is an IMAP message. + + * Made server expunge more robust. Added new variable + `vm-imap-expunge-retries' to force retries for sluggish servers. + + * Allow message attributes as well as labels to be saved on server. + + * Changed vm-imap-get-new-mail to do synchronization: reading and writing + message attributes & labels, expunge messages in the cache. Added + variable `vm-imap-sync-on-get' to control this behavior. + + * Added command `vm-imap-synchronize' to do full synchronization. + + * Trapping IMAP server errors uniformly. + + * Added variable `vm-imap-tolerant-of-bad-imap' to allow minor + violations of the IMAP spec by IMAP servers. + + * New commands `vm-imap-start-bug-report' and `vm-imap-submit-bug-report' + which track IMAP session details. + +VM 8.0.14 2009-12-16 + + BUGFIXES + + * Removed an incompatibility of the mapvector procedure with XEmacs. + +VM 8.0.13 2009-11-29 + + MANAGEMENT CHANGES: + + * VM being maintained by "VM development team", vm@lists.launchpad.net, + consisting of Robert Fenk, Uday Reddy and Ulrich Müller. + + BUGFIXES: + + * VM-Cache entries were broken by encoding the pretty printed cache string + instead of the individual strings. This bug was introduced in 8.0.10 by + the bug fix for correctly storing the cached multibyte summary entries. + It causes building of the summary to fail. Broken cache entries are now + detected and removed while loading a folder. + +VM 8.0.12 2008-11-05 + + IMPROVEMENTS: + + * Display version info when calling `vm-version' interactively. (Thanks + to Ulrich Müller) + + * Yanking of messages uses the same MIME decoding as the presentation + now. See the new variable `vm-mime-yank-attachments' to configure if + attachments are also yanked. + + * `u-vm-color.el' is bundled and maintained with VM now. Ulf Jasper handed + it over to me as he switched to Gnus. + + BUGFIXES: + + * Detect w3 by using `locate-library' instead of checking for a bound + `w3-about'. (Thanks to Klaus Straubinger) + + * vm.revno.el was not installed anymore b "make install". (Thanks to + Ulrich Müller for reporting) + + * Insert `emacs-version' instead of creating wrong version string for + XEmacs, i.e. the patch level was the major version. (Thanks to Stephen + Turnbull) + + * Correctly locate the data directory for the pixmaps when running as a + XEmacs package. + + * Check for some MIME character sets that may be available in recent + XEmacs. (Thanks to Aidan Kehoe for the patch) + + * Some documentation fixes. (Thanks to Michael Ernst for the patches) + + * Fixed infinite loop in vm-mime-encode-words on XEmacs 21.5-b28. + (Thanks to Aidan Kehoe for the patch) + + * Detect "score" (additionally to "hits") in "X-Spam-Status:" headers in + `vm-su-spam-score-aux'. (Patch from Michael Ernst) + + * Typo fix in vm-pcrisis.texinfo. (Patch from Michael Ernst) + + * Header encoding was BASE64 instead of QP by default and it was not + encoding whole words, but only the 8bit chars instead. (Thanks to Ulrich + Müller for reporting) + + * MIME text parts interleaved by attachments are now correctly yanked, + e.g. when replying to a message. + + * Limit the buffer-name length and sanitize the used characters. (Thanks + to Mark Diekhans for reporting) + + * Do not fail on corrupted address headers. (Reported by John Covici) + + * Fixed GTK detection and toolbar handling for newer Emacs 22 versions. + +Public bug reported: + +VM 8.0.11 2008-08-11 + + BUGFIXES: + + * Removed dependency of vm-revno.el to other lisp sources to avoid + building it in a release bundle. (Thanks to Ralf Fassel) + +VM 8.0.10 2008-07-22 + + NOTES: + + * This is the first version of VM 8.* to be also released as a XEmacs + package. + + IMPROVEMENTS: + + * Added missing documentation for `vm-user-agent', "?" binding and + 'vm-delete-duplicate-messages'. (Thanks to Alan Wehmann) + + * `vm-message-history.el' now uses a buffer similar to the summary for + browsing the history. The buffer replaces the summary buffer when + present. Duplicate history entries will be removed. + + * Define and use `vm-replace-in-string' which is `replace-in-string' + from XEmacs to avoid clashes with other GNU Emacs packages defining + it differently. Unfortunately, GNU Emacs still does not provide this + handy function. (Thanks to José Miguel Figueroa) + + * MIME encoding of header will automatically happen now and has been moved + from `vm-rfaddons.el' to `vm-mime.el' and `vm-vars.el'. + + BUGFIXES: + + * Rewrote `vm-message-history.el' to also work for XEmacs. + + * Leading lines of a yanked message were accidently taken as headers and + got removed if `vm-reply-include-presentation' was t. + + * Fixed encoding of headers for trailing 8 bit characters. (Thanks to + Lutz Euler for the patch) + + * Decode (QP-)encoded clear text before decrypting it. + + * Use nil as default for `vm-mime-8bit-composition-charset' and thus + enable proper detection of right charset. (Thanks to Naoki Saito for + reporting and debugging) + + * Fixed bug in `vm-mime-display-external-generic' for GNU Emacs 23 causing + corrupted content in the output file. The old code has been replaced by + a call to `vm-mime-send-body-to-file' which avoids duplication and works. + There has been some special handling for `vm-fsfemacs-mule-p', but the + actual reason for this was unclear so it has been removed. + + * Correctly handle `vm-enable-addons' being t. + + * Correctly store UTF-8 strings in the X-VM-v5-Data header to avoid + corruption of summary lines. (Thanks to Yuning Feng for reporting) + + * Correctly encode multibyte subjects. (Thanks to Yuning Feng for the + patch) + + * Use BASE64 for header encoding when there are special chars not quoted + by QP normally. You may configure this by `vm-mime-encode-headers-type'. + + * qp-decode program handles premature end of QP-encoded stream now + gracefully. (Thanks to Ralf Fassel for the bug report, fix and testing) + + * Added missing newline after "Content-Type" when using the command + `vm-mime-attach-object-from-message'. (Thanks to Dan Freed) + +VM 8.0.9 2008-02-20 + + BUGFIXES: + + * Added documentation to `vm-mime-external-content-types-alist' that no + extra single quotes should be used around %f as the file name is already + quoted for the shell. (Thanks to Martin Schwenke) + + * Fixed version number generation in release script. It was broken for + 8.0.8, i.e. it was showing 8.0.x-xemacs-542 instead. Now also other + branch related information is stored in the file vm-revno.el. + +VM 8.0.8 2008-02-11 + + IMPROVEMENTS: + + * Reactivated "Allow defadvice on function `vm' by recursing on session + start". It should work correctly now. + + * Added interactive `vm-pipe-message-to-command-discard-output' and + the non-interactive `vm-pipe-message-to-command-to-string' for using + it in own functions. + + * Added `vm-pipe-messages-to-command*' for bulk piping messages to a + single command, i.e. like saving to a pipe. This is substantially + faster than `vm-pipe-message-to-command*' which call the command on + each message separately. You may want to use it to feed spamassasin. + + * Modified key bindings for piping messages, i.e. "|" is a prefix key + now. Type it twice to get the old pipe command, "|d" will call the + discard the output, just display some infos in the mode line. "|s" + will call `vm-pipe-messages-to-command' and "|n" will also call it + but discard the output. + + * Removed vm-easymenu.el and use easymenu.el instead. + + * In `vm-save-message-preview', ask the user if the output file already + exists instead of silently overwriting it. + + BUG FIXES: + + * Moved [Undo] to Dispose menu and [Emacs] to Help menu as these do not + work in Emacs 22 anymore when on the menu bar. + + * Fixed intermixing of signature and quoted text in reply if + `vm-reply-include-presentation' is t. (Thanks to Roland Winkler for + debugging and reporting) + + * Fixed yanking of presentation from wrong folder when folder is virtual. + (Thanks to Roland Winkler for reporting) + + * Redistributed flag not displayed in presentation buffer mode line. + https://bugzilla.redhat.com/show_bug.cgi?id=428248 (Thanks to Jonathan + Underwood for the fix) + + * `vm-submit-bug-report' gets the variables dynamically now and thus does + not miss new ones or references old ones anymore. + + * Correctly determine the real folder when postponing compositions started + from a virtual folder. (Thanks to Uday S. Reddy for reporting and + debugging) + + * Avoid crash when `vm-mouse-set-mouse-track-highlight' is not called + within a summary buffer or without a valid message pointer. + + * Do not disable modes which do not exist. (Thanks to Uday S. Reddy for + reporting) + + * Set correct coding-system-for-read for the real messages of + virtual folders. (Thanks to Julian Bradfield) + +VM 8.0.7 2008-01-05 + + BUG FIXES: + + * Disable only those minor modes listed in the variable + `vm-disable-modes-before-encoding' before encoding a + composition. (Thanks to Alley for reporting and debugging) + + * Removed recursion from function `vm' added by 8.0.6, as it + causes startup troubles. + + * Removed extra newline before attachment buttons. (Thanks to Alley for + reporting) + + * Removed wrongly used calls to `interactive-p'. (Thanks to Alley for + reporting and debugging) + +VM 8.0.6 2008-01-02 + + IMPROVEMENTS: + + * Rewrote INSTALL to be more consistent and more understandable. + + * Allow defadvice on function `vm' by recursing on session start. (Thanks + to Blueman for the code) + + BUG FIXES: + + * Ignore empty reply-to in `vm-ignored-reply-to'. + + * Quoted the variable `vm-summary-format' in a doc string. + + * Fixed typos in the docstring of `vm-mail-send-and-exit'. + + * Disable all minor modes before encoding a composition. This results in + faster encoding when font-lock was enabled and avoids problems when + parts of a MIME object button get expanded due to an abbrev and thus the + extent/overlay gets split into two separate parts causing an encoding + error. + + * Avoid duplicate mime buttons during decoding. (Thanks to Alley for + reporting) + + * Mask 8 bit chars by 0xff in `vm-mime-qp-encode-region' to avoid crash + for those with all higher order bits set (negative ones?) (Thanks to + Blueman for the fix.) + +VM 8.0.5 2007-11-03 + + BUG FIXES: + + * Fixed bug caused by fixing `vm-drop-buffer-name-chars' in 8.0.4. There + is a 20-40% chance to create a new bug when fixing one. Regression + tests would be nice, but we do not have any for VM ;-/ + +VM 8.0.4 2007-11-02 + + IMPROVEMENTS: + + * Require cl.el at compile-time only. (Thanks to John J. Foerch) + + * Quiet compiler warning about old style backquotes. (Thanks to John + J. Foerch) + + BUG FIXES: + + * Correctly call custom-add-load. (Thanks to John J. Foerch and + Jonathan.underwood) + + * Fixed building of vm-cus-load.el for Emacs 21. + + * Use the old default for `vm-primary-inbox', i.e. "~/INBOX". + + * Honor a t in `vm-drop-buffer-name-chars' as documented. + +VM 8.0.3 2007-08-15 + + IMPROVEMENTS: + + * Unified `vm-continue-what-message', i.e. first check for composition + buffers, if none exist then for saved drafts. Also added new variable + `vm-zero-drafts-start-compose'. + + BUG FIXES: + + * Fixed building of autoloads for GNU Emacs. + + * Docfixes for vm-pine.el (Thanks to Stephen Eglen). + + * Resurrected `vm-add-reply-subject-prefix' which was lost by the commit + of revno 91. + + * Search for BZR only if bzrdir exists and use locate-file only when + defined. + + * Use vm-mime-8bit-composition-charset as a fallback also for MULE Emacs. + + * Fixed defcustom of vm-keep-crash-boxes and vm-spool-files. + + * Fixed the section headers of the NEWS file. + +VM 8.0.2 2007-07-25 + + IMPROVEMENTS: + + * Added --with-pixmapdir to configure the location of the pixmaps. + + * DESTDIR-Patch (Ulrich Müller). + + BUG FIXES: + + * Avoid overflow of `buffer-undo-list' when inserting or encoding + big attachments. + + * defcustom of `vm-mime-all-attachments-directory' should list nil. + + * Honor pre VM 8.0.0 values of `vm-folder-directory' and + `vm-primary-inbox'. This should eliminate problems with users which + never changed the defaults. + + * Use "cygwin-mount" to fix paths when available. + + * Activate summary faces only when requested by vm-enable-addons. + + * Fixed defcustom of `vm-enable-addons' and added documentation. + + * "make install" creates $(bindir) now. + + * Separate paths (e.g. otherdirs) only by semicolons to avoid problems on + Win32. + + * Handle paths with spaces correctly. + + * Install also pixmaps for GTK enabled Emacs. + + * Just use the first subject when replying/forwarding to a set of + messages. This avoids long filenames for saved composition buffers. + + * Ensure we are compiling with an emacs version >= 21. + + * Encode headers regexp and case-fold-search corrected. (Ulrich Müller) + + * vm-summary-faces-mode does not leak extents anymore. + +VM 8.0.1 2007-06-29 + + NOTES: + + In order to get more features from vm-rfaddons set the variable + `vm-enable-addons' in your ~/.vm. + + BUG FIXES: + + * A saner default for vm-shrunken-header-face. + + * Added documentation on vm-shrunken-headers-face and + vm-shrunken-headers-keymap. + + * Added a new custom group `vm-faces' for faces. + + * Added autoload token for vm-user-agent. + + * Use INSTALL_PROGRAM instead of INSTALL_DATA for programs. + + * Do not set vm-folder-directory if there is ~/INBOX. If VM does not get + mail after upgrading from 7.19 it is probably due to the new default for + vm-folder-directory, which was nil before. + + * Revised the bindings and enabled features to a hopefully less + controversial setting. + +VM 8.0.0 2007-05-31 + + NOTES: + + VM is now in my hands and I will do my best to keep it alive! -- Robert + + ,-------------------------------------------------------------------------- + | From: Kyle Jones <kyle_jones@wonderworks.com> + | To: Robert Widhopf-Fenk <hack@robf.de> + | Date: Wed, 21 Feb 2007 13:11:32 -0800 + | Subject: Handing over VM? + | + | Robert Widhopf-Fenk writes: + | > Hi Kyle, + | > + | > I have been maintaining VM "unofficially" for the last few + | > years and now I want to become the official maintainer of + | > VM. + | > + | > Do I get your OK? + | + | Yes. Obviously I've moved on, though I've been slow to admit it + | to myself. Good luck. + `-------------------------------------------------------------------------- + + * My (robf) VM extensions are now activated by default, where it makes + sense to me. + + * Releases are numbered now MAJOR.MINOR.PATCHLEVEL, where MAJOR is + increased when fundamental changes occur, MINOR for new features and + PATCHLEVEL for bugfix releases. + + * New cleaner source tree layout. + + * Better built system based on configure. Autoloads are generated only + for those functions marked with the autoload token now, which are mainly + interactive function. Thus, loading occurs only on demand and startup + should be faster. + + BUG FIXES: + + * All bugs reported to gnu.emacs.vm.bugs, gnu.emacs.vm.info and directly + to me are fixed either by the patches posted by others or me. + + * If there are any missing autoloads, please report them and add a + (require 'vm-SOURCE) to your ~/.vm! + + * Probably added numerous new bugs. + + + IMPROVEMENTS: compared to 7.19 (not vmrf) + + * A new icon set based on vm-small-pixmaps.tgz which was floating around. + This one should fit by height to the one used in XEmacs and Emacs 22, + but it is slightly larger than those used in Emacs 21. If you see the + old icons, the please set the variables `vm-image-directory' and + `vm-toolbar-pixmap-directory' to nil in your ~/.vm! + + * vm-mime-type-converter-alist now also works when replying to messages, + i.e. for text/html one can use lynx or w3m for the conversion. + (setq vm-mime-type-converter-alist + '(("text/html" "text/plain" "lynx -force_html -dump /dev/stdin"))) + + * Postponing (draft handling) of compositions and continuing of drafts, in + fact any messages also those from other people. (Info node: Sending + Messages) + + * New mail header insertion functions for return-receipts, mail-priority + and FCC. + + * More virtual folder selectors and replacements of other functions based + on selectors. (Info node: Virtual Folders) + + * vm-serial.el provides message templates for composition and + personalizes mass emails. (Info node: TODO) + + * vm-biff.el for popups with a list of new messages. + + * vm-rfaddons.el has various stuff, look at the source if you are curious + or miss some VM feature, as it might already be there! + + +VMRF 7.19.187 2006-10-12 + +VMRF 2006-09 + + Mentioned on gnu.emacs.vm.info as a fork. + + +Local Variables: +mode: text +coding: utf-8 +End: @@ -0,0 +1,155 @@ +VM was written by Kyle Jones! Hail Kyle! The last release from Kyle +was 7.19. + +VM's home page up to version 7.19 on the World Wide Web is at +http://www.wonderworks.com/vm and the FAQ is still hosted there. + +The later versions of VM have been maintained by the user community. +The current 'VM development team' (vm@lists.launchpad.net) consists of +of Robert Widhof-Fenk, Ulrich Müller and Uday Reddy, but contributions +from various other users and developers have also been incorporated in +them. See the info manual for a full list of contributors. + +******************************************************************************* +VERSION INFO + +The VM versions 8.2.0 and up are designed to work with: + +- XEmacs version 21.4 or higher, with MULE support + +- Gnu Emacs versions 22 or higher + +(While Gnu Emacs 21 is permitted, it is not recommended.) + +The users of vcard's need a vcard.el package with vcard-api-version +2.0. (A suitable version of vcard.el is included in this distribution.) + +******************************************************************************** +INSTALLATION + +Read INSTALL and follow the instructions to compile and setup VM. + +If you are new to VM, see example.vm for example configuration +settings (in a '~/.vm' file). Read more in the VM manual on 'info'. + +******************************************************************************* +BUGS + +Please report bugs in VM using the VM function + M-x vm-submit-bug-report +This function formats an email report including the entire state of VM +which can be used to diagnose and fix the bug. Please include +information about how to reproduce the problem. + +Please report any problems or bugs otherwise they cannot be fixed! + +If you are not sure that the problem is a bug or that it could be of +general importance to other users, you are welcome to discuss it on +the USENET groups gnu.emacs.vm.bugs or gnu.emacs.vm.info! However, it +is not always possible to diagnose problems without full information +about your VM settings. So, filing a bug report is necessary. + +******************************************************************************* +Homepage + +The new homepage of VM is at http://www.nongnu.org/viewmail/ hosted by +Savannah. The latest downloads of VM can also be found here. + +The source code of VM is at http://launchpad.net/vm hosted by +Launchpad. + +Eventually, we may migrate to a single site for both the facilities. + +******************************************************************************* +Wiki + +The Wiki at http://www.emacswiki.org/emacs/CategoryViewMail is best +suited to conserve code snippets, cooking guides or feature requests. + +******************************************************************************* +Code Repository + +We maintain the source code using Bazaar (http://bazaar-vcs.org/). + +If you want to get the latest development version of VM, or want to +contribute changes you may want to branch from the follwing launchpad +URI: + + lp:vm + +which is short for the full URL: + + http://bazaar.launchpad.net/~vm/vm/trunk + + +# create your own branch from the trunk +# the 'lp' URL's do they same job as the 'http' URL's above. +bzr get lp:vm # for the main trunk +(or) +bzr get lp:vm/8.2.x # for the latest version in the 8.2.x series +# get updates +bzr pull +# start hacking +emacs vm-pgg.el +# commit your changes +bzr commit +# Generate a bundle of your changes for merging +bzr bundle-revisions --output=xy-changes.diff +# Attach the bundle to a mail (rather than doing cut&paste) and send +# it to vm @ lists.launchpad.net with a descriptive subject. +# Alternatively, upload it to your space on Launchpad +bzr push lp:~username/vm/branchname +# Then send a message to vm @ lists.launchpad.net requesting merge + +******************************************************************************* +Get involved + +The project home is at + + http://launchpad.net/vm + +Registering on launchpad is painless process and makes it convenient +to participate in the development of VM (or other Launchpad projects). + +The "Bugs" tracker is where we keep track of the bugs that need fixing +as well as TODO items. + +The "Blueprints" section records our future development plans. + + + +******************************************************************************* +COMMENTS + +In addition to Kyle Jones's original VM, this version includes +various contributions from Robert Widhopf-Fenk and others. + +Extensions for VM written by Robert: +- vm-pine.el for draft handling and other Pine inspired functions. +- vm-ps-print.el for nice ps-printing functions +- vm-rfaddons.el adds various add-ons to VM +- vm-grepmail a grepmail interface for VM +- vm-avirtual.el brings additional virtual folder selectors and functions + for spam tagging +- vm-biff.el is a xbiff within VM, notifying you of new mail +- vm-serial.el templates for mails, personalized serial mails +- vm-summary-faces.el face base on virtual selectors + +Additional extensions for VM from other people: +- vm-pcrisis.el by Rob Hodges for people with personal crisis which need + to rewrite headers automatically. +- vcard.el by Noah Friedman <friedman 'at' splode.com> for + vm-vcard.el displaying vcards within VM. + +Enhancements: + +- Support for reading HTML messages using Emacs packages and external +applications, as well as replying to HTML messages. + +- IMAP server support by Uday Reddy + + +Local Variables: +mode: text +coding: utf-8 +End: diff --git a/README.headers-only b/README.headers-only new file mode 100755 index 0000000..1048674 --- /dev/null +++ b/README.headers-only @@ -0,0 +1,51 @@ +The headers-only operation has an outstanding bug which occurs very +infrequently and is difficult to track down. + +- It only affects the headers-only downloading of IMAP messages. All +other features of VM are unaffected. + +- It has only been observed on Gnu Emacs 23. (There is a possibility +that it has something to do with the Emacs 23 word-wrapping +functionality, but that is only a guess at this point. If you turn on +word-wrapping or visual-line-mode by default, you should remove the +default because it will get used in VM folder buffers otherwise.) + +- Whenever the problem was observed, it caused the body of a message +to be inserted in the *midst* of its headers instead of inserting it +after the headers. An example follows. + +- The failure recovery is to delete or rename the imap-cache folder on +disk and force VM to generate a new cache folder. (Renaming it is a +better idea. You can then send me a sample of the error and I might +be able to garner some information from it.) + +- Permanent damage can occur if you save a message from the IMAP +folder to a local folder and delete the IMAP copy. If the message had +corruption before you saved it, the corrupted copy would have been +saved. So, keep an eye out for the problem whenever you save a +message. + +----- + +The problem should be normally visible. Here is an example: + +From: "Lucas, Simon M" <...> +To: ... +Subject: Re: Unemployment rate among CS graduates +Date: Sun, 4 Jul 2010 16:09:35 +0100 +X-SoCS-Spam-DQogT25lIG1vcmUgdGhpbmcgdG8gY29uc2lkZXIgd2l0aCB0aGVzZSBzdGF0cyBpcw0KIHRoZWly +IHJlbGlhYmlsaXR5Lg0KDQogSWYgeW91IHNlbGVjdCBjb21wdXRlciBzY2llbmNlIGFuZCBzb3J0... + +The correct message should have been: + +From: "Lucas, Simon M" <...> +To: ... +Subject: Re: Unemployment rate among CS graduates +Date: Sun, 4 Jul 2010 16:09:35 +0100 +X-SoCS-Spam-Score: 0.0 + +DQogT25lIG1vcmUgdGhpbmcgdG8gY29uc2lkZXIgd2l0aCB0aGVzZSBzdGF0cyBpcw0KIHRoZWly +IHJlbGlhYmlsaXR5Lg0KDQogSWYgeW91IHNlbGVjdCBjb21wdXRlciBzY2llbmNlIGFuZCBzb3J0 + +The body of the message got inserted 13 places above the correct position. + @@ -0,0 +1,149 @@ +This file lists the bugs, feature requests and wishes for future versions +of VM. If you are missing anything please let me know! + +****************************************************************************** +EVERGREENS + +There are some things which probably will never be fixed ... + + * Update the info file. News should also be there not in the NEWS file? + + * Cleanup and reorganize the code. + + * Better doc strings: VM has nearly none in the core, just my own extensions + have been documented properly using "M-x checkdoc RET". + + * Enable sane extensions and configurations: The default should satisfy most + people, but still allow one to disable what they dislike. + + * Integrate more extensions from others into the core. + +****************************************************************************** +BUGS + +The bugs which should be fixed before the next release: + + * Syncing with Mozilla-Status may corrupt folder + +The bugs that remain unsolved: + + * Sometimes the cursor is not restored correctly in GNU Emacs when visiting + a folder multiple times during an Emacs session. + + * VM is dead slow in marking/deleting/... when a folder has thousands of + messages. + +****************************************************************************** +ROADMAP + +The features planed for one of the next releases. + +The order hints on the priority, but it is no gurantee. + + * Folding of threads in the summary + + * Display draft status in the modeline. (partially done) + + * Break up the customize stuff into more and smaller sub categories. + + * GNU Emacs: does not highlight attachment buttons in compositions + + * Merge changes from the Debian package. + + * Some of the user defined summary functions should become internal ones. + E.g.: has-attachments, text/html, size, draft, ... + + * Better HTML support for both displaying and replying, but probably not for + composition as there is no urge to surrender here! There should be a test + for w3m-emacs, w3, lynx, w3m and the best method should be selected by + default if not configured by the user. + + HTML only messages should be converted to mixed/alternative parts by + vm-assimilate-html-message. vm-mime-show-alternatives should probably + be smart enough to display all but the chosen part as button. + + "D" should switch between mixed/alternative parts and the undecoded + resp. button representation. + + * Click in mailto: link does not work when being used from w3 buffers. + + * Virtual selectors matching on specific mime parts, e.g. + (vm-vs-text regexp): matching only text parts and those which can be + converted to text. + (vm-vs-attachment regexp): matching the disposition of parts + + * Improved (i)search support: Only text parts and certain headers should be + searched and it should also work for virtual folders. We might utilize + virtual folder selectors here. [1] + + * Better IMAP support, i.e. just fetch headers, sync, offline, search. It is + really bad now and thus I do use Thunderbird at work! + + * Maildir support: It is a nice format and possibly can fix the problem of + huge mail folders, as VM must not read the whole buffer into memory, just + the index. Also it would allow for using external indexing tools like + http://www.rpcurnow.force9.co.uk/mairix/ and make folders really virtual. + + * Virtual folders everywhere, i.e. only one physical folder. VM should + not read the folder into a buffer, but only query relevant messages from + an maildb-backend. + + * S/MIME PKI support. + +****************************************************************************** +REST + +The unsorted and remaining ones. + + * Marking + Delete is dead slow on folders with many (>2000) messages. + + * Shortcut to expunge a single message. + +From EU + + * Fix bugs when marking threads by "M T". Sometimes it misses some messages, + IMHO ones of broken MUAs not setting the References: header, but hey we + cannot fix them so let's work around them. + + * for text/alternative messages, when the plain text part is + displayed internally, [add variable that will allow to] show icon + for the html (or rich text) part, which will allow to delete it + easily using $d. I now have to edit these by hand... + + * The binding of mouse-3 overrides the usual usage of mouse-3 which + is very useful. An option to allow binding this menu to another + key (C-mouse-3?) would be great. + + * when attachments appear with no empty line separating them from the + text, the attachment icon appears on the same line as the text + before it. this results in poor appearance (I think), Would be + much nicer to show the attachment icon on a separate line, rather + than continued on the last text line as now. + + * Typing h when in the presentation window makes vm display only a + single windows with headers rather than adding a headers window to + the presentation mode window. (when in vm, change to presentation + buffer, type C-x1 and then h" + + * When reading mail I have the frame divided into three windows: + headers, presentation and BBDB. When replying from the header + window, the reply window just replaces the headers window, leaving + the presentation window and the BBDB window unchanged. The + resulting reply window is too small... would be good to have it + replace all three windows (headers, presentation, BBDB) until the + reply is sent. + +****************************************************************************** +REFERENCES + +[1] Newsgroups: gnu.emacs.vm.info + Subject: Re: Improved search for mixed (mime) ascii/html folders? + +[2] Message-ID: <1159541555.884682.318660@c28g2000cwb.googlegroups.com> + Newsgroups: gnu.emacs.vm.info + Subject: VM feature requests + Date: 29 Sep 2006 07:52:35 -0700 + +;;; Local Variables: *** +;;; mode:text *** +;;; End: *** diff --git a/configure b/configure new file mode 100755 index 0000000..05774fd --- /dev/null +++ b/configure @@ -0,0 +1,3677 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.68 for VM 8.2.0b. +# +# Report bugs to <vm@lists.launchpad.net>. +# +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +# +# Copyright (C) 2009-2010 VM Development Team <vm@lists.launchpad.net> +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: vm@lists.launchpad.net about your system, including any +$0: error possibly output before this message. Then install +$0: a modern shell, or manually run the script under such a +$0: shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 </dev/null +exec 6>&1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='VM' +PACKAGE_TARNAME='vm' +PACKAGE_VERSION='8.2.0b' +PACKAGE_STRING='VM 8.2.0b' +PACKAGE_BUGREPORT='vm@lists.launchpad.net' +PACKAGE_URL='' + +ac_unique_file="configure.ac" +ac_subst_vars='LTLIBOBJS +LIBOBJS +LINKPATH +SYMLINKS +PACKAGEDIR +OTHERDIRS +info_dir +FLAGS +EMACS_VERSION +EMACS_FLAVOR +pixmapdir +etcdir +lispdir +EMACS_PROG +TEXI2DVI +MAKEINFO +TAR +XARGS +GREP +MKDIR +LS +RM +LN_S +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +SET_MAKE +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_emacs +with_lispdir +with_etcdir +with_docdir +with_other_dirs +with_package_dir +with_symlinks +with_linkpath +' + ac_precious_vars='build_alias +host_alias +target_alias' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures VM 8.2.0b to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/vm] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of VM 8.2.0b:";; + esac + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-emacs=PROG choose which flavor of Emacs to use + --with-lispdir=DIR where to install lisp files + --with-etcdir=DIR where to install data files + --with-docdir=DIR where to install doc files + --with-other-dirs=DIRS set other needed lisp directories (a list of + semicolon separated paths) + --with-package-dir=DIR set the Emacs package directory to DIR + --with-symlinks install VM by linking instead of copying [[no]] + --with-linkpath=PATH path to symlink from if `pwd' does not work + +Report bugs to <vm@lists.launchpad.net>. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +VM configure 8.2.0b +generated by GNU Autoconf 2.68 + +Copyright (C) 2010 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. + +Copyright (C) 2009-2010 VM Development Team <vm@lists.launchpad.net> +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by VM $as_me 8.2.0b, which was +generated by GNU Autoconf 2.68. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5 ; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Name of the application +# Version (release) number +# Contact address + + + + +ac_config_files="$ac_config_files Makefile lisp/Makefile info/Makefile src/Makefile pixmaps/Makefile vm-load.el" + + +# Common system utilities checking: +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +# Extract the first word of "rm", so it can be a program name with args. +set dummy rm; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_RM+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $RM in + [\\/]* | ?:[\\/]*) + ac_cv_path_RM="$RM" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_RM="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_RM" && ac_cv_path_RM="/bin/rm" + ;; +esac +fi +RM=$ac_cv_path_RM +if test -n "$RM"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RM" >&5 +$as_echo "$RM" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +# Extract the first word of "ls", so it can be a program name with args. +set dummy ls; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_LS+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $LS in + [\\/]* | ?:[\\/]*) + ac_cv_path_LS="$LS" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_LS="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_LS" && ac_cv_path_LS="/bin/ls" + ;; +esac +fi +LS=$ac_cv_path_LS +if test -n "$LS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LS" >&5 +$as_echo "$LS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +# Extract the first word of "mkdir", so it can be a program name with args. +set dummy mkdir; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_MKDIR+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MKDIR in + [\\/]* | ?:[\\/]*) + ac_cv_path_MKDIR="$MKDIR" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_MKDIR="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_MKDIR" && ac_cv_path_MKDIR="/bin/mkdir" + ;; +esac +fi +MKDIR=$ac_cv_path_MKDIR +if test -n "$MKDIR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR" >&5 +$as_echo "$MKDIR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +# Extract the first word of "grep", so it can be a program name with args. +set dummy grep; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $GREP in + [\\/]* | ?:[\\/]*) + ac_cv_path_GREP="$GREP" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_GREP="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_GREP" && ac_cv_path_GREP="/bin/grep" + ;; +esac +fi +GREP=$ac_cv_path_GREP +if test -n "$GREP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GREP" >&5 +$as_echo "$GREP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + +# External programs checking: + # Extract the first word of "xargs", so it can be a program name with args. +set dummy xargs; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_XARGS+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$XARGS"; then + ac_cv_prog_XARGS="$XARGS" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_XARGS="xargs" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +XARGS=$ac_cv_prog_XARGS +if test -n "$XARGS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XARGS" >&5 +$as_echo "$XARGS" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${XARGS}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No xargs program found." >&5 +$as_echo "$as_me: WARNING: *** No xargs program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** make clean/tarball will not work." >&5 +$as_echo "$as_me: WARNING: *** make clean/tarball will not work." >&2;} + fi + for ac_prog in gtar tar +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_TAR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$TAR"; then + ac_cv_prog_TAR="$TAR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_TAR="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +TAR=$ac_cv_prog_TAR +if test -n "$TAR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TAR" >&5 +$as_echo "$TAR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$TAR" && break +done + + if test "x${TAR}" = "xtar" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking that tar is GNU tar" >&5 +$as_echo_n "checking that tar is GNU tar... " >&6; } + ${TAR} --version > /dev/null 2>&1 || TAR= + if test "x${TAR}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi + fi + if test "x${TAR}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No GNU tar program found." >&5 +$as_echo "$as_me: WARNING: *** No GNU tar program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Some targets will be unavailable." >&5 +$as_echo "$as_me: WARNING: *** Some targets will be unavailable." >&2;} + fi + # Extract the first word of "makeinfo", so it can be a program name with args. +set dummy makeinfo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MAKEINFO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MAKEINFO"; then + ac_cv_prog_MAKEINFO="$MAKEINFO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_MAKEINFO="makeinfo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MAKEINFO=$ac_cv_prog_MAKEINFO +if test -n "$MAKEINFO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAKEINFO" >&5 +$as_echo "$MAKEINFO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${MAKEINFO}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No makeinfo program found." >&5 +$as_echo "$as_me: WARNING: *** No makeinfo program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** Info files will not be built." >&5 +$as_echo "$as_me: WARNING: *** Info files will not be built." >&2;} + fi + # Extract the first word of "texi2dvi", so it can be a program name with args. +set dummy texi2dvi; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_TEXI2DVI+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$TEXI2DVI"; then + ac_cv_prog_TEXI2DVI="$TEXI2DVI" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_TEXI2DVI="texi2dvi" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +TEXI2DVI=$ac_cv_prog_TEXI2DVI +if test -n "$TEXI2DVI"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEXI2DVI" >&5 +$as_echo "$TEXI2DVI" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test "x${TEXI2DVI}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** No texi2dvi program found." >&5 +$as_echo "$as_me: WARNING: *** No texi2dvi program found." >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: *** DVI and PDF files will not be built." >&5 +$as_echo "$as_me: WARNING: *** DVI and PDF files will not be built." >&2;} + fi + + +# Check whether --with-emacs was given. +if test "${with_emacs+set}" = set; then : + withval=$with_emacs; EMACS_PROG="${withval}" +else + for ac_prog in emacs xemacs +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_EMACS_PROG+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$EMACS_PROG"; then + ac_cv_prog_EMACS_PROG="$EMACS_PROG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_prog_EMACS_PROG="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +EMACS_PROG=$ac_cv_prog_EMACS_PROG +if test -n "$EMACS_PROG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_PROG" >&5 +$as_echo "$EMACS_PROG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$EMACS_PROG" && break +done + +fi + + if test "x${EMACS_PROG}" = "x" ; then + as_fn_error $? "*** No Emacs program found." "$LINENO" 5 + fi + # EMACS TYPE ################################################## + { $as_echo "$as_me:${as_lineno-$LINENO}: checking checking emacs-type of ${EMACS_PROG}" >&5 +$as_echo_n "checking checking emacs-type of ${EMACS_PROG}... " >&6; } + cat > conftest.el <<TEST +(princ (format "%s" (if (featurep 'xemacs ) 'xemacs 'emacs))) +TEST + EMACS_FLAVOR=`"${EMACS_PROG}" --no-site-file --batch -l conftest.el | ${GREP} .` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${EMACS_FLAVOR}" >&5 +$as_echo "${EMACS_FLAVOR}" >&6; } + # EMACS VERSION ############################################### + { $as_echo "$as_me:${as_lineno-$LINENO}: checking checking emacs-version of ${EMACS_PROG}" >&5 +$as_echo_n "checking checking emacs-version of ${EMACS_PROG}... " >&6; } + cat > conftest.el <<TEST +(princ (format "%d" emacs-major-version)) +TEST + EMACS_VERSION=`"${EMACS_PROG}" --no-site-file --batch -l conftest.el | ${GREP} .` + if test ${EMACS_VERSION} -lt 21; then + as_fn_error $? "Emacs version ${EMACS_VERSION} is too old, 21 is minimum!" "$LINENO" 5 + fi + # EMACS DEPENDENT SETTINGS #################################### + # We may add a version check here ... + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${EMACS_VERSION}" >&5 +$as_echo "${EMACS_VERSION}" >&6; } + + # Copied from gnus aclocal.m4 + +# Check whether --with-lispdir was given. +if test "${with_lispdir+set}" = set; then : + withval=$with_lispdir; lispdir=${withval} +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where .elc files should go" >&5 +$as_echo_n "checking where .elc files should go... " >&6; } + if test -z "$lispdir"; then + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix + fi + datarootdir="\$(prefix)/share" + datadir="${datarootdir}" + if test "$EMACS_FLAVOR" = "xemacs"; then + datarootdir="\$(prefix)/lib" + datadir="${datarootdir}/${EMACS_FLAVOR}/site-packages/etc" + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-packages/lisp/vm" + else + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-lisp/vm" + fi + for thedir in share lib; do + potential= + if test -d "${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/lisp/vm" + else + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-lisp/vm" + fi + break + fi + done + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lispdir" >&5 +$as_echo "$lispdir" >&6; } + + + +# Check whether --with-etcdir was given. +if test "${with_etcdir+set}" = set; then : + withval=$with_etcdir; etcdir=${withval} +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where data files should go" >&5 +$as_echo_n "checking where data files should go... " >&6; } + if test -z "$etcdir"; then + etcdir="${datadir}/vm" + fi + pixmapdir="${etcdir}/pixmaps" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $etcdir" >&5 +$as_echo "$etcdir" >&6; } + + + + +# Check whether --with-docdir was given. +if test "${with_docdir+set}" = set; then : + withval=$with_docdir; docdir=${withval} +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where doc files should go" >&5 +$as_echo_n "checking where doc files should go... " >&6; } + if test -z "$docdir"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + docdir="${etcdir}" + else + docdir="${datarootdir}/doc/vm" + fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $docdir" >&5 +$as_echo "$docdir" >&6; } + + +# if test "x${EMACS_FLAVOR}" = "xemacs" ; then +# PACKAGEDIR="${prefix}/share/emacs/site-lisp" +# else +# PACKAGEDIR="${HOME}/.xemacs/xemacs-packages" +# fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking which options to pass on to (X)Emacs" >&5 +$as_echo_n "checking which options to pass on to (X)Emacs... " >&6; } + if test "x$FLAGS" = "x"; then + if test "x$EMACS_FLAVOR" = "xxemacs"; then + FLAGS="-batch -no-autoloads -l \$(srcdir)/vm-build.el" + else + FLAGS="-batch -q -no-site-file -no-init-file -l \$(srcdir)/vm-build.el" + fi + else + FLAGS=$FLAGS + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FLAGS" >&5 +$as_echo "$FLAGS" >&6; } + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where the TeXinfo docs should go" >&5 +$as_echo_n "checking where the TeXinfo docs should go... " >&6; } + if test "$infodir" = "\${datarootdir}/info"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + info_dir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/info" + else + info_dir="\${datarootdir}/info" + fi + else + info_dir=$infodir + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $info_dir" >&5 +$as_echo "$info_dir" >&6; } + + + + + +# Check whether --with-other-dirs was given. +if test "${with_other_dirs+set}" = set; then : + withval=$with_other_dirs; + + OTHERDIRS="${withval}" + +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking otherdirs" >&5 +$as_echo_n "checking otherdirs... " >&6; } + cat > conftest.el <<TEST + (let ((otherdirs (delete "" (split-string "${OTHERDIRS}" ";"))) + absolutedirs + dir) + (while otherdirs + (setq dir (expand-file-name (vm-fix-cygwin-path (car otherdirs))) + otherdirs (cdr otherdirs)) + (if (not (file-exists-p dir)) + (error "Directory %S does not exist!" dir) + (add-to-list 'absolutedirs dir))) + (princ (format "%S" absolutedirs))) +TEST + OTHERDIRS=`"${EMACS_PROG}" --no-site-file --batch -l ${srcdir}/lisp/vm-build.el -l conftest.el | tr -d "\r\n"` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTHERDIRS" >&5 +$as_echo "$OTHERDIRS" >&6; } + + + +# is there a sane way to set this to a useful default? + + + +# Check whether --with-package-dir was given. +if test "${with_package_dir+set}" = set; then : + withval=$with_package_dir; + + PACKAGEDIR="${withval}" + +fi + + + + + + +# Check whether --with-symlinks was given. +if test "${with_symlinks+set}" = set; then : + withval=$with_symlinks; + + SYMLINKS="${withval}" + +else + SYMLINKS="no" +fi + + + + + + +# Check whether --with-linkpath was given. +if test "${with_linkpath+set}" = set; then : + withval=$with_linkpath; + + LINKPATH="${withval}" + +fi + + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -p' + fi +else + as_ln_s='cp -p' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by VM $as_me 8.2.0b, which was +generated by GNU Autoconf 2.68. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to <vm@lists.launchpad.net>." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +VM config.status 8.2.0b +configured by $0, generated by GNU Autoconf 2.68, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2010 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "lisp/Makefile") CONFIG_FILES="$CONFIG_FILES lisp/Makefile" ;; + "info/Makefile") CONFIG_FILES="$CONFIG_FILES info/Makefile" ;; + "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;; + "pixmaps/Makefile") CONFIG_FILES="$CONFIG_FILES pixmaps/Makefile" ;; + "vm-load.el") CONFIG_FILES="$CONFIG_FILES vm-load.el" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' <conf$$subs.awk | sed ' +/^[^""]/{ + N + s/\n// +} +' >>$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + +# configure.ac ends here diff --git a/configure.ac b/configure.ac new file mode 100755 index 0000000..11e4331 --- /dev/null +++ b/configure.ac @@ -0,0 +1,291 @@ +# configure.ac --- configuration setup for VM + +# Author: Robert Widhopf-Fenk <hack@robf.de> + +# Copyright (C) 2006-2007 Robert Widhopf-Fenk <hack@robf.de> +# Copyright (C) 2010 Uday S Reddy <reddyuday@launchpad.net> + +# VM is free software; you can redistribute it and/or modify it under the +# terms of the GNU Library General Public License as published by the Free +# Software Foundation; either version 2 of the License, or (at your option) +# any later version. + +# VM is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for +# more details. + +# You should have received a copy of the GNU Library General Public License +# along with this program; if not, write to the Free Software Foundation, +# Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +# Process this file with autoconf to produce a new configure script + +# VM_ARG_SUBST(VAR, OPTION, VAL, DESC[, DEFAULT[, ACTION]]) +# +# Substitute the autoconf variable VAR to a value specified by the user +# option --with-OPTION[=VAL] (described by DESC), or with a DEFAULT value. +# If an additional ACTION is given, it is executed at the top of the +# ACTION-IF-FOUND part of AC_ARG_WITH. +# #### WARNING: pay attention to the quoting of ACTION if given !!!!! +AC_DEFUN([VM_ARG_SUBST], +[ + AC_SUBST([$1]) + AC_ARG_WITH([$2], + AC_HELP_STRING([--with-][$2]ifelse($3, [], [], [=$3]), + [$4]ifelse($5, [], [], [ [[[$5]]]])), + [ + ifelse($6, [], [], $6) + $1="${withval}" + ], + ifelse($5, [], [], [$1="$5"])) +]) + +# Find a (g)tar program and make sure it is GNU one. A failure is not fatal +# since tar is needed for non critical targets only. +AC_DEFUN([VM_PROG_GNU_TAR], + [ AC_CHECK_PROGS(TAR, gtar tar) + if test "x${TAR}" = "xtar" ; then + AC_MSG_CHECKING([that tar is GNU tar]) + ${TAR} --version > /dev/null 2>&1 || TAR= + if test "x${TAR}" = "x" ; then + AC_MSG_RESULT(no) + else + AC_MSG_RESULT(yes) + fi + fi + if test "x${TAR}" = "x" ; then + AC_MSG_WARN([*** No GNU tar program found.]) + AC_MSG_WARN([*** Some targets will be unavailable.]) + fi ]) + +# Find an xargs program. A failure is not fatal, only clean/tarball will not +# work +AC_DEFUN([VM_PROG_XARGS], + [ AC_CHECK_PROG(XARGS, xargs, xargs) + if test "x${XARGS}" = "x" ; then + AC_MSG_WARN([*** No xargs program found.]) + AC_MSG_WARN([*** make clean/tarball will not work.]) + fi ]) + +# Find a makeinfo program. A failure is not fatal, only info files won't be +# built. +AC_DEFUN([VM_PROG_MAKEINFO], + [ AC_CHECK_PROG(MAKEINFO, makeinfo, makeinfo) + if test "x${MAKEINFO}" = "x" ; then + AC_MSG_WARN([*** No makeinfo program found.]) + AC_MSG_WARN([*** Info files will not be built.]) + fi ]) + +# Find a texi2dvi program. A failure is not fatal, only dvi and pdf files +# won't be built. +AC_DEFUN([VM_PROG_TEXI2DVI], + [ AC_CHECK_PROG(TEXI2DVI, texi2dvi, texi2dvi) + if test "x${TEXI2DVI}" = "x" ; then + AC_MSG_WARN([*** No texi2dvi program found.]) + AC_MSG_WARN([*** DVI and PDF files will not be built.]) + fi ]) + +# Choose an Emacs flavor according to the --with-emacs user option, or try +# emacs and xemacs. +# We use EMACS_PROG instead of EMACS to avoid colliding with Emacs' own +# internal environment. +AC_DEFUN([VM_PROG_EMACS], + [ AC_ARG_WITH([emacs], + AC_HELP_STRING([--with-emacs=PROG], + [choose which flavor of Emacs to use]), + [ EMACS_PROG="${withval}" ], + [ AC_CHECK_PROGS(EMACS_PROG, emacs xemacs) ]) + if test "x${EMACS_PROG}" = "x" ; then + dnl This is critical enough to generate an error and not a warning... + AC_MSG_ERROR([*** No Emacs program found.]) + fi + # EMACS TYPE ################################################## + AC_MSG_CHECKING([checking emacs-type of ${EMACS_PROG}]) + cat > conftest.el <<TEST +(princ (format "%s" (if (featurep 'xemacs ) 'xemacs 'emacs))) +TEST + EMACS_FLAVOR=`"${EMACS_PROG}" --no-site-file --batch -l conftest.el | ${GREP} .` + AC_MSG_RESULT([${EMACS_FLAVOR}]) + # EMACS VERSION ############################################### + AC_MSG_CHECKING([checking emacs-version of ${EMACS_PROG}]) + cat > conftest.el <<TEST +(princ (format "%d" emacs-major-version)) +TEST + EMACS_VERSION=`"${EMACS_PROG}" --no-site-file --batch -l conftest.el | ${GREP} .` + if test ${EMACS_VERSION} -lt 21; then + AC_MSG_ERROR([Emacs version ${EMACS_VERSION} is too old, 21 is minimum!]) + fi + # EMACS DEPENDENT SETTINGS #################################### + # We may add a version check here ... + AC_MSG_RESULT([${EMACS_VERSION}]) + + # Copied from gnus aclocal.m4 + AC_ARG_WITH(lispdir,[ --with-lispdir=DIR where to install lisp files], lispdir=${withval}) + AC_MSG_CHECKING([where .elc files should go]) + if test -z "$lispdir"; then + dnl Set default value + theprefix=$prefix + if test "x$theprefix" = "xNONE"; then + theprefix=$ac_default_prefix + fi + datarootdir="\$(prefix)/share" + datadir="${datarootdir}" + if test "$EMACS_FLAVOR" = "xemacs"; then + datarootdir="\$(prefix)/lib" + datadir="${datarootdir}/${EMACS_FLAVOR}/site-packages/etc" + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-packages/lisp/vm" + else + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-lisp/vm" + fi + for thedir in share lib; do + potential= + if test -d "${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/lisp/vm" + else + lispdir="${datarootdir}/${EMACS_FLAVOR}/site-lisp/vm" + fi + break + fi + done + fi + AC_MSG_RESULT($lispdir) + AC_SUBST(lispdir) + + AC_ARG_WITH(etcdir,[ --with-etcdir=DIR where to install data files], etcdir=${withval}) + AC_MSG_CHECKING([where data files should go]) + if test -z "$etcdir"; then + dnl Set default value + etcdir="${datadir}/vm" + fi + pixmapdir="${etcdir}/pixmaps" + AC_MSG_RESULT($etcdir) + AC_SUBST(etcdir) + AC_SUBST(pixmapdir) + + AC_ARG_WITH(docdir,[ --with-docdir=DIR where to install doc files], docdir=${withval}) + AC_MSG_CHECKING([where doc files should go]) + if test -z "$docdir"; then + dnl Set default value + if test "$EMACS_FLAVOR" = "xemacs"; then + docdir="${etcdir}" + else + docdir="${datarootdir}/doc/vm" + fi + fi + AC_MSG_RESULT($docdir) + AC_SUBST(docdir) + +# if test "x${EMACS_FLAVOR}" = "xemacs" ; then +# PACKAGEDIR="${prefix}/share/emacs/site-lisp" +# else +# PACKAGEDIR="${HOME}/.xemacs/xemacs-packages" +# fi + + AC_SUBST(EMACS_PROG) + AC_SUBST(EMACS_FLAVOR) + AC_SUBST(EMACS_VERSION) +]) + +# copied from gnus aclocal.m4 +AC_DEFUN([VM_BUILD_FLAGS], [ + AC_MSG_CHECKING([which options to pass on to (X)Emacs]) + if test "x$FLAGS" = "x"; then + if test "x$EMACS_FLAVOR" = "xxemacs"; then + FLAGS="-batch -no-autoloads -l \$(srcdir)/vm-build.el" + else + FLAGS="-batch -q -no-site-file -no-init-file -l \$(srcdir)/vm-build.el" + fi + else + FLAGS=$FLAGS + fi + AC_MSG_RESULT($FLAGS) + AC_SUBST(FLAGS) +]) + + +# Copied from gnus aclocal.m4 (AC_PATH_INFO_DIR) +AC_DEFUN([VM_PATH_INFO_DIR], [ + AC_MSG_CHECKING([where the TeXinfo docs should go]) + dnl Set default value. This must be an absolute path. + if test "$infodir" = "\${datarootdir}/info"; then + if test "$EMACS_FLAVOR" = "xemacs"; then + info_dir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-packages/info" + else + info_dir="\${datarootdir}/info" + fi + else + info_dir=$infodir + fi + AC_MSG_RESULT($info_dir) + AC_SUBST(info_dir) +]) + +# --with-other-dir option +AC_DEFUN([VM_OTHERDIRS], + [ VM_ARG_SUBST([OTHERDIRS], [other-dirs], [DIRS], + [set other needed lisp directories (a list of semicolon separated paths)], + [],) + AC_MSG_CHECKING([otherdirs]) + cat > conftest.el <<TEST + (let ((otherdirs (delete "" (split-string "${OTHERDIRS}" ";"))) + absolutedirs + dir) + (while otherdirs + (setq dir (expand-file-name (vm-fix-cygwin-path (car otherdirs))) + otherdirs (cdr otherdirs)) + (if (not (file-exists-p dir)) + (error "Directory %S does not exist!" dir) + (add-to-list 'absolutedirs dir))) + (princ (format "%S" absolutedirs))) +TEST + OTHERDIRS=`"${EMACS_PROG}" --no-site-file --batch -l ${srcdir}/lisp/vm-build.el -l conftest.el | tr -d "\r\n"` + AC_MSG_RESULT($OTHERDIRS) + AC_SUBST(OTHERDIRS) +]) + +############################################################################## +AC_INIT([VM], [8.2.0b], [vm@lists.launchpad.net]) +# Name of the application +# Version (release) number +# Contact address + +AC_COPYRIGHT([Copyright (C) 2009-2010 VM Development Team <vm@lists.launchpad.net>]) + +AC_CONFIG_SRCDIR([configure.ac]) +AC_CONFIG_FILES([Makefile lisp/Makefile info/Makefile src/Makefile pixmaps/Makefile vm-load.el]) + +# Common system utilities checking: +AC_PROG_MAKE_SET +AC_PROG_INSTALL +AC_PROG_LN_S +AC_PATH_PROG(RM, rm, /bin/rm) +AC_PATH_PROG(LS, ls, /bin/ls) +AC_PATH_PROG(MKDIR, mkdir, /bin/mkdir) +AC_PATH_PROG(GREP, grep, /bin/grep) + +# External programs checking: +VM_PROG_XARGS +VM_PROG_GNU_TAR +VM_PROG_MAKEINFO +VM_PROG_TEXI2DVI + +VM_PROG_EMACS +VM_BUILD_FLAGS +VM_PATH_INFO_DIR +VM_OTHERDIRS + +# is there a sane way to set this to a useful default? +VM_ARG_SUBST([PACKAGEDIR], [package-dir], [DIR], + [set the Emacs package directory to DIR],) + +VM_ARG_SUBST([SYMLINKS], [symlinks], [], + [install VM by linking instead of copying], [no]) + +VM_ARG_SUBST([LINKPATH], [linkpath], [PATH], + [path to symlink from if `pwd' does not work]) + +AC_OUTPUT + +# configure.ac ends here diff --git a/contrib/attempted-locking.diff b/contrib/attempted-locking.diff new file mode 100755 index 0000000..93f59cf --- /dev/null +++ b/contrib/attempted-locking.diff @@ -0,0 +1,105 @@ +# Bazaar revision bundle v0.8 +# +# message: +# first shot at improving the locking. +# committer: rpgoldman@real-time.com +# date: Sun 2006-10-08 18:19:49.986000061 -0500 + +=== modified file vm-folder.el +--- vm-folder.el ++++ vm-folder.el +@@ -2993,6 +2993,8 @@ + buffer-file-name))) + (vm-get-spooled-mail nil)) + (progn ++ ;; if we've got new mail, then lock the buffer.... ++ (lock-buffer) + ;; don't move the message pointer unless the folder + ;; was empty. + (if (and (null vm-message-pointer) +@@ -3185,6 +3187,9 @@ + vm-default-folder-permission-bits)) + (save-buffer prefix)) + (and oldmodebits (set-default-file-modes oldmodebits)))) ++ ;; if the folder's been locked (it should have been), then ++ ;; unlock it. ++ (unlock-buffer) + (vm-set-buffer-modified-p nil) + ;; clear the modified flag in virtual folders if all the + ;; real buffers associated with them are unmodified. +@@ -3630,6 +3635,9 @@ + mail-waiting )))) + + (defun vm-get-spooled-mail (&optional interactive) ++ "Gets new spooled mail according to the folder-access method. ++Returns a list of new messages \(not sure what the data type of ++\"message\" is in this context\)." + (if vm-block-new-mail + (error "Can't get new mail until you save this folder.")) + (cond ((eq vm-folder-access-method 'pop) + +=== modified file vm-startup.el +--- vm-startup.el ++++ vm-startup.el +@@ -153,7 +153,7 @@ + (coding-system-for-read + (vm-line-ending-coding-system))) + (message "Reading %s..." file) +- (prog1 (find-file-noselect file) ++ (prog1 (vm-find-file-noselect file) + ;; update folder history + (let ((item (or remote-spec folder + vm-primary-inbox))) +@@ -223,6 +223,8 @@ + ;; If the buffer's not modified then we know that there can be no + ;; messages in the folder that are not on disk. + (or (buffer-modified-p) (setq vm-messages-not-on-disk 0)) ++ ;; if the buffer's been modified, it should be locked... ++ (and (buffer-modified-p) (lock-buffer)) + (setq first-time (not (eq major-mode 'vm-mode)) + preserve-auto-save-file (and buffer-file-name + (not (buffer-modified-p)) +@@ -393,6 +395,33 @@ + (if (not (input-pending-p)) + (message totals-blurb))))))) + ++;;; helper function ++(defun vm-find-file-noselect (filename) ++ (let* ((buffer (find-file-noselect filename)) ++ (lock (file-locked-p filename))) ++ (cond ((null lock) ++ ;; not locked, no worries ++ buffer) ++ ((eq lock t) ++ ;; this xemacs has the buffer locked. I don't believe that ++ ;; this should be a problem, either. Unless it means that ++ ;; I've introduced a bug, and not properly unlocked things... ++ (warn "Buffer is locked by this emacs. Unexpected -- please report.") ++ buffer) ++ (t ++ ;; the lock value is the name of the locking user ++ (let ((query-result (ask-user-about-lock ++ filename lock))) ++ (cond ((eq query-result t) ++ ;; steal the lock ++ buffer) ++ ((null query-result) ++ (save-excursion ++ (set-buffer buffer) ++ (setq buffer-read-only t)) ++ (message "Opening folder read-only.") ++ buffer))))))) ++ + ;;;###autoload + (defun vm-other-frame (&optional folder read-only) + "Like vm, but run in a newly created frame." + +# revision id: rpgoldman@real-time.com-20061008231949-1bd9467b25ca41b8 +# sha1: 9ee06c49007ffdec241f9f0f4206dda2e327015f +# inventory sha1: afad72f633b5cbae416178d327931a735786f2f0 +# parent ids: +# hack@robf.de-20061005191950-d7498e730daa5855 +# base id: hack@robf.de-20061005191950-d7498e730daa5855 +# properties: +# branch-nick: vm + diff --git a/contrib/org-html-mail.el b/contrib/org-html-mail.el new file mode 100755 index 0000000..d026a95 --- /dev/null +++ b/contrib/org-html-mail.el @@ -0,0 +1,96 @@ +;; Copyright © 2008 Eric Schulte +;; +;; WYSWYG, html mail composition using orgmode +;; +;; For mail composed using the orgstruct-mode minor mode, this +;; provides the option of sending the mail in html format using +;; org-export-as-html. +;; +;; To use place this file in your path, and add the following to you +;; .emacs file +;; +;; ;; org-mode in my mail +;; (defun turn-on-full-org-mailing () +;; ;;(turn-on-orgstruct) +;; (turn-on-orgstruct++) +;; (turn-on-orgtbl) +;; (load "org-html-mail.el")) +;; (add-hook 'mail-mode-hook 'turn-on-full-org-mailing) +;; +;; Then when composing mail send as an html message by using a prefix +;; argument on the send command, so "\C-u\C-c\C-c". Your mail will be +;; converted to html using org's export command, the appropriate mime +;; headers will be attached, and then your normal send command will be +;; executed. +;; +;; For discussion see "sending html mail using VM" at +;; http://groups.google.com/group/gnu.emacs.vm.info/browse_frm/month/2008-01 + +(defun orgstruct-hijacker-command-21 (arg) + "In Structure, run `org-ctrl-c-ctrl-c'. Outside of Structure +check for a prefix argument and if buffer name contains `mail', +and run orgstruct-send-as-html, or run the binding of +`\C-c\C-c'." + (interactive "p") + (vm-inform 6 "calling html send mail") + (save-excursion + (if (org-context-p (quote headline) (quote item)) + (org-run-like-in-org-mode (quote org-ctrl-c-ctrl-c)) + (if (orgstruct-send-as-html-should-i-p arg) + (progn (vm-inform 6 "sending as html mail") (orgstruct-send-as-html)) + (let (orgstruct-mode) + (call-interactively + (key-binding "\C-c\C-c"))))))) + +(defun orgstruct-send-as-html-should-i-p (arg) + "lets be pretty sure we have a prefix argument and are actually +in a mail buffer" + (goto-char (point-min)) + (if (and arg + (> arg 1) + (equal major-mode 'mail-mode)) + t)) + +(defun orgstruct-send-as-html () + "Export the body of the mail message to html using +`org-export-as-html' then send the results as a text/html +Content-Type message" + ;; adjust mime type + (goto-char (point-min)) + (insert "MIME-Version: 1.0\n") + (insert "Content-Type: text/html\n") + (search-forward mail-header-separator) + (let* ((mail-text-point (point)) + (mail-buffer (current-buffer)) + ;; have to write the file because org needs a path to export + (tmp-file (make-temp-name + (expand-file-name "mail" temporary-file-directory))) + ;; because we probably don't want to skip part of our mail + (org-export-skip-text-before-1st-heading nil) + ;; makes the replies with ">"s look nicer + (org-export-preserve-breaks t) + ;; takes care of setting all my org-local-vars, if no + ;; previous org usage + (org-local-vars (or org-local-vars + (org-get-local-variables))) + (html + (progn + (write-file tmp-file) + ;; convert to html + ;; mimicing org-run-like-in-org-mode + (eval (list 'let org-local-vars + (list 'org-export-region-as-html + 'mail-text-point + '(point-max) 't ''string)))))) + (switch-to-buffer mail-buffer) + (set-visited-file-name nil) + (delete-file tmp-file) + ;; replace text with html + (goto-char mail-text-point) + (delete-region (point) (point-max)) + (insert "\n") + (insert html) + ;; send the mail + (let (orgstruct-mode) + (call-interactively + (key-binding "\C-c\C-c"))))) diff --git a/contrib/org-vm.el b/contrib/org-vm.el new file mode 100755 index 0000000..6f547c3 --- /dev/null +++ b/contrib/org-vm.el @@ -0,0 +1,144 @@ +;;; org-vm.el --- Support for links to VM messages from within Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Uday S Reddy <reddyuday at launchpad dot net> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.35trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; This file implements links to VM messages and folders from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. +;; +;; This file has been enhanced with ability to store links to POP and +;; IMAP folders, and works only for VM versions 8.1.1 and up. USR 2010-04-26 + +;;; Code: + +(require 'org) + +;; Declare external functions and variables +(declare-function vm-preview-current-message "ext:vm-page" ()) +(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) +(declare-function vm-get-header-contents "ext:vm-summary" + (message header-name-regexp &optional clump-sep)) +(declare-function vm-isearch-narrow "ext:vm-search" ()) +(declare-function vm-isearch-update "ext:vm-search" ()) +(declare-function vm-select-folder-buffer "ext:vm-macro" ()) +(declare-function vm-su-message-id "ext:vm-summary" (m)) +(declare-function vm-su-subject "ext:vm-summary" (m)) +(declare-function vm-su-to-names "ext:vm-summary" (m)) +(declare-function vm-su-full-name "ext:vm-summary" (m)) +(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) +(declare-function vm-folder-name "ext:vm-folder" ()) +(defvar vm-message-pointer) +(defvar vm-folder-directory) + +;; Install the link type +(org-add-link-type "vm" 'org-vm-open) +(add-hook 'org-store-link-functions 'org-vm-store-link) + +;; Implementation +(defun org-vm-store-link () + "Store a link to a VM folder or message." + (when (or (eq major-mode 'vm-summary-mode) + (eq major-mode 'vm-presentation-mode)) + (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) + (vm-follow-summary-cursor) + (save-excursion + (vm-select-folder-buffer) + (let* ((message (vm-real-message-of (car vm-message-pointer))) + (buffer (vm-buffer-of message)) + (folder (with-current-buffer buffer + (if (fboundp 'vm-folder-name) ; defined in VM 8.1.1 + (vm-folder-name) + (buffer-file-name)))) + (subject (vm-su-subject message)) + (to (vm-su-to-names message)) + (from (vm-su-full-name message)) + (message-id (vm-su-message-id message)) + desc link) + (org-store-link-props :type "vm" :from from :to to :subject subject + :message-id message-id) + (setq message-id (org-remove-angle-brackets message-id)) + (setq folder (abbreviate-file-name folder)) + (if (and vm-folder-directory + (string-match (concat "^" (regexp-quote vm-folder-directory)) + folder)) + (setq folder (replace-match "" t t folder))) + (setq desc (org-email-link-description)) + (setq link (org-make-link "vm:" folder "#" message-id)) + (org-add-link-props :link link :description desc) + link)))) + +(defun org-vm-open (path) + "Follow a VM message link specified by PATH." + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in VM link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + ;; The prefix argument will be interpreted as read-only + (org-vm-follow-link folder article current-prefix-arg))) + +(defun org-vm-follow-link (&optional folder article readonly) + "Follow a VM link to FOLDER and ARTICLE." + (require 'vm) + (setq article (org-add-angle-brackets article)) + (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) + ;; ange-ftp or efs or tramp access + (let ((user (or (match-string 1 folder) (user-login-name))) + (host (match-string 2 folder)) + (file (match-string 3 folder))) + (cond + ((featurep 'tramp) + ;; use tramp to access the file + (if (featurep 'xemacs) + (setq folder (format "[%s@%s]%s" user host file)) + (setq folder (format "/%s@%s:%s" user host file)))) + (t + ;; use ange-ftp or efs + (require (if (featurep 'xemacs) 'efs 'ange-ftp)) + (setq folder (format "/%s@%s:%s" user host file)))))) + (when folder + (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) + (sit-for 0.1) + (when article + (require 'vm-search) + (vm-select-folder-buffer) + (widen) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (not (re-search-forward + (concat "^" "message-id: *" (regexp-quote article)))) + (error "Could not find the specified message in this folder")) + (vm-isearch-update) + (vm-isearch-narrow) + (vm-preview-current-message) + (vm-summarize))))) + +(provide 'org-vm) + +;; arch-tag: cbc3047b-935e-4d2a-96e7-c5b0117aaa6d + +;;; org-vm.el ends here diff --git a/contrib/vm-blueman.el b/contrib/vm-blueman.el new file mode 100755 index 0000000..e93771b --- /dev/null +++ b/contrib/vm-blueman.el @@ -0,0 +1,120 @@ +;From: blueman <NOSPAM@nospam.com> +;Subject: Function to fit displayed mime images to width +;Newsgroups: gnu.emacs.vm.info +;Date: Tue, 12 Dec 2006 18:07:44 GMT + +;Was going through some old code and would like to share this helpful +;function.. + +;; Stretch/Shrink mime image to fit exactly in frame width. +;; The shrink functionality is particularly helpful since images displayed +;; by emacs look wacked when they extend past a line width +(defun vm-mime-fitwidth-image (extent) +"Stretch/Shrink mime image to fit exactly in frame width (JJK)." + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + dims tempfile factor) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq dims (vm-get-image-dimensions tempfile)) + (setq factor (/ (float (* (1- (frame-width)) (frame-char-width))) (car dims))) + (vm-mime-frob-image-xxxx extent + "-scale" + (concat (int-to-string (* factor (car dims))) + "x" + (int-to-string (* factor (nth 1 dims))))))) + +;; Functionality to add above function to standard attachment menu +(add-hook 'vm-menu-setup-hook + (lambda () + (require 'easymenu) + (easy-menu-add-item vm-menu-fsfemacs-image-menu + nil + ["Fit to width" + (vm-mime-run-display-function-at-point 'vm-mime-fitwidth-image) + (stringp vm-imagemagick-convert-program)] + "4x Larger" ) + (easy-menu-add-item vm-menu-fsfemacs-attachment-menu + nil + ["Save attachment..." + (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-file) + t ] + "Set Content Disposition..." ) + (easy-menu-add-item vm-menu-fsfemacs-attachment-menu + nil + ["Delete attachment..." + (vm-delete-mime-object) + t ] + "Set Content Disposition..." ) + (easy-menu-add-item vm-menu-fsfemacs-attachment-menu + nil + ["Attach to message..." + (vm-mime-run-display-function-at-point + 'vm-attach-object-to-composition) + t ] + "Set Content Disposition..." ) + (easy-menu-add-item vm-menu-fsfemacs-attachment-menu + nil + ["Display as Ascii" + (vm-mime-run-display-function-at-point + 'vm-mime-display-body-as-text) + t ] + "Set Content Disposition..." ) + (easy-menu-add-item vm-menu-fsfemacs-attachment-menu + nil + ["Pipe to Command" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-queried-command-discard-output) + t ] + "Set Content Disposition..." ) + )) + + + +;From: blueman <NOSPAM@nospam.com> +;Subject: Function to retrieve mail via fetchmail from emacs/vm +;Newsgroups: gnu.emacs.vm.info +;Date: Tue, 12 Dec 2006 18:31:57 GMT + +;Was going through some old code and would like to share this helpful +;function.. + +;Note this runs the users local fetchmail process as configured by +;~/.fetchmailrc +(defun vm-fetchmail () +"*Fetch mail asynchronously from remote server (JJK)" + (interactive) + (cond + ((file-executable-p vm-fetchmail-function) + (set-process-sentinel + (start-process "Fetchmail" "*Fetchmail*" vm-fetchmail-function) + 'vm-fetchmail-sentinel) + (vm-inform 5 "Fetching new mail...")) + (t (error "Error: Fetchmail not found on system!")))) + +(defvar vm-fetchmail-function "/usr/bin/fetchmail" +"Function used to fetch remote mail (JJK)") + +(defun vm-fetchmail-sentinel (process status) + (beep t) + (setq status (substring status -2 -1)) + (vm-inform 5 "Finished fetching... %s" + (if (string= status "d") "*New mail*" + (setq status (string-to-number status)) + (cond + ((= status 1) "No new mail") + ((= status 2) "Error opening socket") + ((= status 3) "User authentication failed") + ((= status 4) "Fatal protocol error") + ((= status 5) "Syntax error") + ((= status 6) "Bad permissions on run control file") + ((= status 7) "Error condition reported by server") + ((= status 8) "Client-side exclusion error") + ((= status 9) "Lock busy") + (t "Other error"))))) + diff --git a/contrib/vm-bogofilter.el b/contrib/vm-bogofilter.el new file mode 100755 index 0000000..1b1de99 --- /dev/null +++ b/contrib/vm-bogofilter.el @@ -0,0 +1,389 @@ +;;; vm-bogofilter.el version 1.1.4 +;; +;; An interface between the VM mail reader and the bogofilter spam filter. +;; +;; Copyright (C) 2003-2006 by Bjorn Knutsson +;; +;; Home page: http://www.cis.upenn.edu/~bjornk/ +;; +;; Bjorn Knutsson, CIS, 3330 Walnut Street, Philadelphia, PA 19104-6389, USA +;; +;; +;; Based on vm-spamassassin.el v1.1, Copyright (C) 2002 by Markus Mohnen +;; +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Version history: +;; v 1.1.4: Change in the way bogofilter is called +;; * No longer uses formail to process mails +;; * Slightly improved error handling +;; v 1.1.3: Minor edits +;; * Documentation updates +;; * Error checking for bogofilter calls. +;; * vm-bogofilter-delete-spam variable. +;; Set to cause spam to be automatically deleted. +;; * vm-bogofilter-setup function. +;; Automatically called on loading, but can be called again +;; to re-initialize the vm-bogofilter setup +;; v 1.1.2: Borg assimilation version (12-Sep-2003) +;; * Great minds think alike. Olivier Cappe independently +;; created his own version of vm-bogofilter.el based on +;; vm-spamassassin.el with the same basic functions. +;; He submitted a patch to my version to harmonize them. +;; * Added comment about vm-delete-after-archiving, as suggested +;; by Olivier. +;; v 1.1.1: minor edits +;; * Chris McMahan submitted a patch that disables running +;; bogfilter on incoming mail. While at first potentially +;; confusing, this means that you can run bogofilter via +;; e.g. procmail filters, and then use vm-bogofilter.el to +;; (re-)educate bogofilter about false positives/negatives. +;; * Documentation of a folder problem added +;; v 1.1: functional update +;; * Changed re-training functions to also re-tag the the message +;; in the VM folder, thus making the tag on the message in VM +;; be consistent with bogofilter's opinion about the message. +;; Notice!! If you use the tag in the message, you should be +;; aware that a message re-classified as spam may still not +;; be tagged as spam by bogofilter, and vice versa, if the +;; bogofilter database contains too many counter-examples. +;; The old re-training functions are still present, if you +;; prefer not to muck around with your inbox. They've been +;; renamed vm-bogofilter-is-spam-old/vm-bogofilter-is-clean-old +;; and works as before. +;; v 1.0.1: update +;; * Very minor edits of texts, no functional changes. +;; v 1.0: initial release +;; * First release, based on Markus Mohnen's vm-spamassassin +;; +;; +;; To use this program, you need reasonably recent versions of VM from +;; http://www.wonderworks.com/vm) and bogofilter from +;; http://sourceforge.net/projects/bogofilter/ +;; +;; This version of the interface has been developed for, and tested +;; with, VM version 7.17 and later, and bogofilter version 0.17.4 and +;; later. Some features used /require/ bogofilter version 0.15.0 and +;; later but no testing of versions earlier than 0.17.4 has been done. +;; It has been tested with bogofilter versions up to 0.93.2 +;; +;; (Former RMAIL-users should read the BUGS-note about the BABYL-format) +;; +;;; Installation: +;; +;; Put this file on your Emacs-Lisp load path and add following into your +;; ~/.vm startup file +;; +;; (require 'vm-bogofilter) +;; +;; +;;; Usage: +;; +;; Whenever you get new mail bogofilter will be invoked on them. Mail +;; detected as spam will be tagged by bogofilter, and you can use +;; existing mechanisms to dispose of them. +;; +;; For example, if you append this line to your .vm (or modify your +;; existing auto-folder-alist), you could then have messages tagged as +;; spam automatically saved in a separate 'spam' folder: +;; +;; (setq vm-auto-folder-alist '(("^X-Bogosity: " ("Yes," . "spam")))) +;; +;; If you want your auto-folder to be used every time you've received +;; new mail, just add the following to your .vm: +;; +;; (add-hook 'vm-arrived-messages-hook 'vm-auto-archive-messages) +;; +;; You can also set (setq 'vm-delete-after-archiving t) to make VM +;; automatically delete archived spams from the main folder. +;; +;; +;; If a message is tagged as spam incorrectly, you can re-train +;; bogofilter by calling the function vm-bogofilter-is-clean on that +;; message. Similarly, calling vm-bogofilter-is-spam will re-train +;; bogofilter to recognize a clean-marked message as spam. +;; +;; These functions can be bound to keys in your .vm, for example: +;; +;; (define-key vm-mode-map "K" 'vm-bogofilter-is-spam) +;; (define-key vm-mode-map "C" 'vm-bogofilter-is-clean) +;; +;; would define K (shift-k) as the key to declare the current message +;; as spam, while C (shift-c) as the key to declare the current +;; message as clean. +;; +;; Re-training with the old functions (still available) would not +;; re-tag messages, while the new ones will. Re-training may or may +;; not change the spam-status of a message. Because of the way +;; bogofilter works, even a message explicitly declared as spam may +;; not be tagged as spam if there are enough similar non-spam +;; messages. Remember, bogofilter is not trained to recognize +;; individual messages, but rather patterns. You may have to train +;; bogofilter on a number of spam messages before it recognizes any of +;; them as spam. See the documentation for bogofilter. Notice also +;; that even if the tag changes, this will not undo actions previously +;; taken based on the tag, e.g. moving spam to a spamfolder with +;; auto-folders. +;; +;; If you have a small database, running bogofilter without '-u' may +;; be better in the beginning. If you want to run without '-u', it +;; can easily be accomplished. Just: +;; +;; M-x customize<return> vm-bogofilter<return> +;; +;; Then change the Program Options to just '-p -e' and the Unspam to +;; '-n' and Spam to '-s'. +;; +;; Now, bogofilter will not auto-train, and you must instead use the +;; vm-bogofilter-is-spam and vm-bogofilter-is-clean to manually tag +;; messages. (If you've bound them to keys, it will be quite simple.) +;; +;;; BUGS: +;; +;; One know bug is that formail will not like it if the input is not +;; in the format it expects and knows. Even though it's supposed to +;; know BABYL, this does not work. +;; +;; A related problem is that if you have the wrong folder type +;; selected, then sometimes, VM will merge messages. You can check the +;; raw folder to see if you have a blank line before the "From "-line +;; separating messages. See the documentation for vm-default-folder-type +;; +;; vm-bogofilter is not very smart about errors. If an error occurs +;; during any operation that tags or re-tags messages, the message(s) +;; being processed will be *lost*. If errors occur during initial +;; processing, the lost mails can sometimes be recovered since VM will +;; save the folder *after* receiving new mails, but *before* +;; processing hooks, e.g. vm-bogofilter. If you notice the errors +;; before saving the folder, you can copy the old file, close VM, +;; rename your copy to the original folder name and then start VM +;; again. Naturally, anything that happened to the folder after +;; fetching new mail will be lost, e.g. bogofilter tagging etc. +;; +;;; Customization: +;; +;; M-x customize RET vm-bogofilter + +;;; Code: + +(eval-when-compile (require 'vm)) + +;;; Customisation: + +(defgroup vm-bogofilter nil + "VM Spam Filter Options" + :group 'vm) + +(defcustom vm-bogofilter-program "bogofilter" + "*Name of the bogofilter program." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-program-options "-u -p -e" + "*Options for the bogofilter program. Since we use bogofilter as a +filter, '-p' must be one of the options, while '-e' tells bogofilter +that it is embedded, and thus should not signal spam/ham with return +values. +* The flag '-u' controls if bogofilter automatically learns from its own +classification. You may not want to use this flag if bogofilter still is +learning to classify, or if you do not have the discipline to correct every +mis-classification." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-program-mbox "-M" + "*Options for the bogofilter program. This flags tells bogofilter +how to process mailboxes, i.e., multiple messages." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-program-options-unspam "-Sn" + "*Options for the bogofilter program when declaring a spam-marked +message as clean. The default, '-Sn', assumes that bogofilter already +has trained itself on the message, e.g. by running it with '-u' during +classification. If this is the initial training, use '-n' instead." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-program-options-spam "-Ns" + "*Options for the bogofilter program when declaring a clean-marked +message as spam. The default, '-Ns', assumes that bogofilter already +has trained itself on the message, e.g. by running it with '-u' during +classification. If this is the initial training, use '-s' instead." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-program-options-reclassify "-p -e" + "*Options for the bogofilter program when declaring a clean-marked +message as spam. +*See vm-bogofilter-program-options for a discussion of the options." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-formail-program "formail" + "*Name of the program used to split a sequence of mails." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-formail-program-options "-s" + "*Options for the 'vm-bogofilter-formail-program'. After this +arguments, the name of the bogofilter program will be passed." + :group 'vm-bogofilter + :type 'string) + +(defcustom vm-bogofilter-invoke-through-vm t + "*When true, bogofilter will be invoked through the +vm-retrieved-spooled-mail-hook. If you have procmail or some other +MTA configured to filter through bogofilter already, then set this to +nil to speed vm-startup. +*NOTE: This variable is only consulted on startup, so if you change +it, it will take effect the next time vm-bogofilter is loaded, or +vm-bogofilter-setup is called." + :group 'vm-bogofilter + :type 'boolean) + +(defcustom vm-bogofilter-delete-spam nil + "*When true, mark messages for deletion when reclassifying as spam. +*NOTE: This does not affect the initial classification, only when messages +are explicitly marked as spams by the vm-bogofilter-is-spam function." + :group 'vm-bogofilter + :type 'boolean) + +(defun vm-bogofilter-arrived-message () + "The function used to do the actual filtering. It is used as a value for +vm-retrieved-spooled-mail-hook." + (save-excursion + (vm-save-restriction + (let ((tail-cons (vm-last vm-message-list)) + (buffer-read-only nil)) + (widen) + (if (null tail-cons) + (goto-char (point-min)) + (goto-char (vm-text-end-of (car tail-cons))) + (beginning-of-line) + (forward-line) + ) + (vm-inform 5 "Filtering new messages... ") + (let ((res (call-process-region (point) (point-max) + (or shell-file-name "sh") + t t nil shell-command-switch + (concat vm-bogofilter-program " " + vm-bogofilter-program-options " " + vm-bogofilter-program-mbox)))) + + (if (and res (not (and (integerp res) (zerop res)))) + (error "Something went wrong filtering new messages (exit %s)" + res) + (delete-region (point) (point-max)))) + (vm-inform 5 "Filtering new messages... done.") + ) + ) + ) + ) + +(defun vm-bogofilter-is-spam-old () + "Declare that a clean-marked message is spam" + (interactive) + (vm-follow-summary-cursor) + (vm-pipe-message-to-command + (concat vm-bogofilter-program " " vm-bogofilter-program-options-spam) nil) + ) + +(defun vm-bogofilter-is-clean-old () + "Declare that a spam-marked message is clean" + (interactive) + (vm-follow-summary-cursor) + (vm-pipe-message-to-command + (concat vm-bogofilter-program " " vm-bogofilter-program-options-unspam) nil) + ) + +(defun vm-bogofilter-is-spam () + "Declare that a clean-marked message is spam, and re-tag message" + (interactive) + (vm-bogofilter-retag "spam" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-spam) + (if vm-bogofilter-delete-spam + (vm-delete-message 1)) + ) + +(defun vm-bogofilter-is-clean () + "Declare that a spam-marked message is clean, and re-tag message" + (interactive) + (vm-bogofilter-retag "clean" vm-bogofilter-program-options-reclassify vm-bogofilter-program-options-unspam) + ) + +;; Based on vm-pipe-message-to-command +(defun vm-bogofilter-retag (text switch &optional switch2) + "Workhorse function for re-tagging of messages." + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-read-only) + (vm-error-if-folder-empty) + (save-excursion + (let ((message (vm-real-message-of (car vm-message-pointer))) + (buffer (get-buffer-create "*Shell Command Output*")) + ) + + (save-excursion + (set-buffer buffer) + (erase-buffer)) + (set-buffer (vm-buffer-of message)) + (vm-save-restriction + (vm-save-buffer-excursion + (widen) + (goto-char (vm-headers-of message)) + (narrow-to-region (point) (vm-text-end-of message)) + (vm-inform 6 "Re-classifying message as %s." text) + (if (not (eq switch2 nil)) + (progn + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil buffer nil shell-command-switch + (concat vm-bogofilter-program " " + switch2) + ) + (vm-inform 6 "Message re-classified as %s, updating tag." + text) + )) + (let ((buffer-read-only nil) + (buffer (get-buffer-create "*Shell Command Output*"))) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil t nil shell-command-switch + (concat vm-bogofilter-program " " + switch) + ) + (delete-region (point) (vm-text-end-of message))) + (vm-discard-cached-data) + (vm-inform 6 "Message re-classified and tagged as %s." text) + (vm-present-current-message) + (vm-update-summary-and-mode-line) + ))))) + +;;; Hooking into VM + +(defun vm-bogofilter-setup () + "Initialize vm-bogofilter." + (interactive) + (if vm-bogofilter-invoke-through-vm + (add-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message) + (remove-hook 'vm-retrieved-spooled-mail-hook 'vm-bogofilter-arrived-message))) + +(vm-bogofilter-setup) + +(provide 'vm-bogofilter) + +;;; vm-bogofilter.el ends here diff --git a/contrib/vm-mime-display-internal-application.el b/contrib/vm-mime-display-internal-application.el new file mode 100755 index 0000000..54fec40 --- /dev/null +++ b/contrib/vm-mime-display-internal-application.el @@ -0,0 +1,204 @@ +;;; vm-mime-display-internal-application.el --- Display application attachments +;;; -*-unibyte: t; coding: iso-8859-1;-*- + +;; Copyright © 2004 Kevin Rodgers + +;; Author: Kevin Rodgers <ihs_4664@yahoo.com> +;; Created: 11 Jun 2004 +;; Version: $Revision: 1.5 $ +;; Keywords: mail, mime +;; RCS: $Id: vm-mime-display-internal-application.el,v 1.5 2004/07/14 23:29:04 kevinr Exp $ + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be +;; useful, but WITHOUT ANY WARRANTY; without even the implied +;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. See the GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public +;; License along with this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, +;; MA 02111-1307 USA + +;;; Commentary: + +;; VM does not provide a way to display additional MIME media types +;; internally. This file defines a new user variable to control which +;; application/* subtypes can be displayed within Emacs: +;; C-h v vm-mime-internal-application-subtypes +;; +;; It also defines user commands to register a subtype and to install +;; all registered subtypes as internally displayable applications: +;; M-x vm-mime-register-internal-application +;; M-x vm-mime-install-internal-applications +;; +;; Usage: +;; (load-library "vm-mime-display-internal-application") +;; (vm-mime-register-internal-application "foo" t) ; to run foo-mode +;; (vm-mime-register-internal-application "bar" 'baz-mode) +;; (vm-mime-install-internal-applications) + +;;; Code: + +(require 'vm) + +(defvar vm-mime-internal-application-subtypes + ;; see http://www.iana.org/assignments/media-types/application/ + '(("emacs-lisp" . t) ; lisp-mode.el + ("tar" . t) ; tar-mode.el + ("arc" . archive-mode) ; arc-mode.el + ("lzh" . archive-mode) ; arc-mode.el + ("zip" . archive-mode) ; arc-mode.el + ("zoo" . archive-mode) ; arc-mode.el + ;; For file-name-handler subtypes, let find-file-noselect -> + ;; after-find-file -> (normal-mode t) choose the mode. Specify + ;; ignore instead of normal-mode for these subtypes, so that the + ;; optional FIND-FILE argument doesn't override enable-local-variables. + ("gzip" . ignore) ; jka-compr.el + ("bzip2" . ignore) ; jka-compr.el + ("compress" . ignore)) ; jka-compr.el + "List of MIME \"application/*\" subtypes that should be displayed internally. + +Each (SUBTYPE . MODE) element maps the \"applicaton/SUBTYPE\" MIME +content type to the major MODE used to display it. Both the MODE and +`vm-mime-display-internal-application/SUBTYPE' functions must be +defined. + +If MODE is t, SUBTYPE-mode is used to display \"application/SUBTYPE\" +attachments.") + +(defvar vm-mime-internal-application-x-subtypes nil + "*If non-nil, display application/x-SUBTYPE attachments the same as application/SUBTYPE attachments. +See `vm-mime-internal-application-subtypes'.") + +(defadvice vm-mime-can-display-internal (after application/xxxx activate + compile) + "Respect `vm-mime-internal-application-subtypes'." + (or ad-return-value + (setq ad-return-value + (let* ((layout (ad-get-arg 0)) + (type (car (vm-mm-layout-type layout))) + (subtype (if (vm-mime-types-match "application" type) + (substring type (1+ (match-end 0))))) + (mode (if subtype + (vm-mime-can-display-internal-application + subtype)))) + (if mode + (let ((charset (or (vm-mime-get-parameter layout "charset") + "us-ascii"))) + (or (vm-mime-charset-internally-displayable-p charset) + (vm-mime-can-convert-charset charset)))))))) + +(defun vm-mime-can-display-internal-application (subtype) + "Return the Emacs mode for displaying \"application/SUBTYPE\" MIME objects." + (catch 'major-mode + (let ((subtypes vm-mime-internal-application-subtypes) + mode) + (while subtypes + (if (or (equal subtype (car (car subtypes))) + (and vm-mime-internal-application-x-subtypes + (equal subtype (concat "x-" (car (car subtypes)))))) + (cond ((and (eq (cdr (car subtypes)) 't) + (fboundp (setq mode (intern (concat subtype "-mode"))))) + (throw 'major-mode mode)) + ((fboundp (setq mode (cdr (car subtypes)))) + (throw 'major-mode mode)))) + (setq subtypes (cdr subtypes))) + nil))) + +(defun vm-mime-display-internal-application/xxxx (layout) + "Display LAYOUT in its own buffer." + ;; see vm-mime-display-external-generic + (let* ((tempfile (or (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-application/xxxx) + (let ((suffix + (or (vm-mime-extract-filename-suffix layout) + (vm-mime-find-filename-suffix-for-type + layout))) + (filename + (or (vm-mime-get-disposition-parameter layout + "filename") + (vm-mime-get-parameter layout "name")))) + (vm-make-tempfile-name suffix filename)))) + (type (car (vm-mm-layout-type layout))) + (subtype (if (vm-mime-types-match "application" type) + (substring type (1+ (match-end 0)))))) + (vm-mime-send-body-to-file layout nil tempfile) + (vm-register-message-garbage-files (list tempfile)) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-application/xxxx + tempfile) + (let* ((inhibit-local-variables t) + (enable-local-variables nil) + (enable-local-eval nil) + (pop-up-frames vm-mutable-frame-configuration) + (pop-up-windows vm-mutable-window-configuration) + (mode (vm-mime-can-display-internal-application subtype))) + (pop-to-buffer + (find-file-noselect tempfile)) ; (with-auto-compression-mode ...) + (or (eq major-mode mode) + (funcall mode)) +;; (when pop-up-frames +;; (set-window-dedicated-p (selected-window) t)) + (cond (pop-up-frames + (add-hook 'kill-buffer-hook 'delete-frame t t)) + (pop-up-windows + (add-hook 'kill-buffer-hook 'delete-window t t)))))) + +(defun vm-mime-register-internal-application (subtype mode) + "Add (SUBTYPE . MODE) to `vm-mime-internal-application-subtypes'. +Also define the `vm-mime-display-internal-application/SUBTYPE' and +`vm-mime-display-button-application/SUBTYPE' functions. + +If MODE is nil, just define the functions." + (interactive + (let* ((subtype (completing-read "Subtype: " + vm-mime-internal-application-subtypes)) + (subtype-mode (fboundp (intern (concat subtype "-mode")))) + (completion-ignore-case nil) + (mode (intern (completing-read (if subtype-mode + "Mode: (default t) " + "Mode: ") + obarray + (lambda (s) + (and (fboundp s) + (string-match "-mode\\'" + (symbol-name s)))) + t nil nil (if subtype-mode "t"))))) + (or (eq mode 't) + (fboundp mode) ; i.e. (equal (symbol-name mode) "") + (error "Undefined mode: %s" mode)) ; (unintern mode) + (list subtype mode))) + (if mode + (setq vm-mime-internal-application-subtypes + (cons (cons subtype mode) vm-mime-internal-application-subtypes))) + (let ((internal + (intern (concat "vm-mime-display-internal-application/" subtype))) + (button + (intern (concat "vm-mime-display-button-application/" subtype)))) + (defalias internal 'vm-mime-display-internal-application/xxxx) + (fset button (lambda (layout) + (vm-mime-display-button-xxxx layout nil))) + (if vm-mime-internal-application-x-subtypes + (progn + (defalias (intern (concat "vm-mime-display-internal-application/x-" + subtype)) + internal) + (defalias (intern (concat "vm-mime-display-button-application/x-" + subtype)) + button))))) + +(defun vm-mime-install-internal-applications () + "Define display and button functions for each registered subtype. +See `vm-mime-internal-application-subtypes'." + (interactive) + (let ((subtypes vm-mime-internal-application-subtypes)) + (while subtypes + (vm-mime-register-internal-application (car (car subtypes)) nil) + (setq subtypes (cdr subtypes))))) + +;;; vm-mime-display-internal-application.el ends here diff --git a/contrib/vm-mime.el-w3m.patch b/contrib/vm-mime.el-w3m.patch new file mode 100755 index 0000000..88fa068 --- /dev/null +++ b/contrib/vm-mime.el-w3m.patch @@ -0,0 +1,134 @@ +=== modified file 'vm-mime.el' +--- vm-mime.el 2006-08-21 21:17:05 +0000 ++++ vm-mime.el 2006-09-18 23:09:23 +0000 +@@ -2060,49 +2060,87 @@ + (defun vm-mime-display-internal-text (layout) + (vm-mime-display-internal-text/plain layout)) + ++(autoload 'w3m-region "w3m" "Render region using w3m") ++ ++(defcustom vm-mime-renderer-for-text/html 'w3 ++ "The HTML renderer to use for internal display. ++W3M is usually faster and better than W3." ++ :group 'vm ++ :type '(choice (const w3) ++ (const w3m))) ++ ++(defun vm-mime-display-internal-text/html-with-w3m (start end) ++ (save-restriction ++ (narrow-to-region start end) ++ (let ((w3m-safe-url-regexp "\\`cid:") ++ w3m-force-redisplay) ++ (goto-char (point-max)) ++ (insert-before-markers "z") ++ (w3m-region (point-min) (1- (point-max))) ++ (goto-char (point-max)) ++ (delete-char -1)) ++ ++ (when (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) ++ (add-text-properties (point-min) (point-max) ++ (list 'keymap w3m-minor-mode-map))))) ++ ++(defun vm-mime-display-internal-text/html-with-w3 (start end) ++ ;; w3-region apparently deletes all the text in the ++ ;; region and then insert new text. This makes the ++ ;; end == start. The fix is to move the end marker ++ ;; forward with a placeholder character so that when ++ ;; w3-region delete all the text, end will still be ++ ;; ahead of the insertion point and so will be moved ++ ;; forward when the new text is inserted. We'll ++ ;; delete the placeholder afterward. ++ (goto-char end) ++ (insert-before-markers "z") ++ (w3-region start (1- end)) ++ (goto-char end) ++ (delete-char -1)) ++ + (defun vm-mime-display-internal-text/html (layout) +- (if (and (fboundp 'w3-region) +- vm-mime-use-w3-for-text/html) +- (condition-case error-data +- (let ((buffer-read-only nil) +- (start (point)) +- (charset (or (vm-mime-get-parameter layout "charset") +- "us-ascii")) +- end buffer-size) +- (message "Inlining text/html, be patient...") +- (vm-mime-insert-mime-body layout) +- (setq end (point-marker)) +- (vm-mime-transfer-decode-region layout start end) +- (vm-mime-charset-decode-region charset start end) +- ;; w3-region apparently deletes all the text in the +- ;; region and then insert new text. This makes the +- ;; end == start. The fix is to move the end marker +- ;; forward with a placeholder character so that when +- ;; w3-region delete all the text, end will still be +- ;; ahead of the insertion point and so will be moved +- ;; forward when the new text is inserted. We'll +- ;; delete the placeholder afterward. +- (goto-char end) +- (insert-before-markers "z") +- (w3-region start (1- end)) +- (goto-char end) +- (delete-char -1) +- ;; remove read-only text properties +- (let ((inhibit-read-only t)) +- (remove-text-properties start end '(read-only nil))) +- (goto-char end) +- (message "Inlining text/html... done") +- t ) +- (error (vm-set-mm-layout-display-error +- layout +- (format "Inline HTML display failed: %s" +- (prin1-to-string error-data))) +- (message "%s" (vm-mm-layout-display-error layout)) +- (sleep-for 2) +- nil )) +- (vm-set-mm-layout-display-error layout "Need W3 to inline HTML") +- (message "%s" (vm-mm-layout-display-error layout)) +- nil )) ++ (let ((render-func ++ (cond ((eq vm-mime-renderer-for-text/html 'w3m) ++ 'vm-mime-display-internal-text/html-with-w3m) ++ ((eq vm-mime-renderer-for-text/html 'w3) ++ 'vm-mime-display-internal-text/html-with-w3) ++ (t ++ (vm-set-mm-layout-display-error ++ layout ++ (concat "Inline HTML display failed: function " ++ (symbol-name vm-mime-inline-render-function-for-text/html) ++ " not found. Please bind a valid function to vm-mime-inline-render-function-for-text/html.")) ++ (message "%s" (vm-mm-layout-display-error layout)) ++ nil)))) ++ (if (fboundp render-func) ++ (condition-case error-data ++ (let ((buffer-read-only nil) ++ (start (point)) ++ (charset (or (vm-mime-get-parameter layout "charset") ++ "us-ascii")) ++ end buffer-size) ++ (message "Inlining text/html, be patient...") ++ (vm-mime-insert-mime-body layout) ++ (setq end (point-marker)) ++ (vm-mime-transfer-decode-region layout start end) ++ (vm-mime-charset-decode-region charset start end) ++ ++ (funcall render-func start end) ++ ++ ;; remove read-only text properties ++ (let ((inhibit-read-only t)) ++ (remove-text-properties start end '(read-only nil))) ++ (goto-char end) ++ (message "Inlining text/html... done") ++ t ) ++ (error (vm-set-mm-layout-display-error ++ layout ++ (format "Inline HTML display failed: %s" ++ (prin1-to-string error-data))) ++ (message "%s" (vm-mm-layout-display-error layout)) ++ (sleep-for 2) ++ nil )))))) + + (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) + (let ((start (point)) end need-conversion + diff --git a/contrib/vm-sumurg.el b/contrib/vm-sumurg.el new file mode 100755 index 0000000..c9be3fc --- /dev/null +++ b/contrib/vm-sumurg.el @@ -0,0 +1,988 @@ +;; $Header: /home/jcb/Source/Emacs/RCS/vm-sumurg.el,v 1.30 2011/12/19 14:55:59 jcb Exp $ +;;; vm-sumurg.el -- Adding urgency indicators to summary +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 2011 Julian Bradfield +;; +;; Author: Julian Bradfield +;; Status: Tested for VM 8.2.x running under XEmacs +;; Keywords: VM helpers +;; X-URL: http://homepages.inf.ed.ac.uk/jcb/Software/emacs/ +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + + +;;; Commentary: +;; This file provides an add-on to VM so that messages with certain +;; labels are tagged in bright colours, associated with urgency levels. +;; Messages labelled "*" (urgency level 1) are yellow; +;; Messages labelled "**" (urgency level 2) are orange; +;; Messages labelled "***" (urgency level 3) are red. +;; Messages labelled "****" (urgency level 4) are blinking magenta! +;; The summary modeline contains a count of the number of urgent messages. +;; A virtual folder with messages of urgency level n can be obtained +;; by V U n, or by middle-clicking on the count in the modeline. +;; It also puts a count of composition buffers in the modeline, in green, +;; to remind you that they're there. +;; In addition, messages can be set to become urgent in the future. +;; +;; The main interface is vm-sumurg-set-urgency, which see. +;; This is not bound to a key here, as VM binds all sensible keys +;; already. I bind it to * with +;; (define-key vm-mode-map "*" 'vm-sumurg-set-urgency) +;; but that overrides the default binding to vm-burst-digest. +;; +;; At one time, this worked on FSF Emacs, but I haven't tried it for +;; a long time; it's only known to work on XEmacs. + +;;; Code: + +(require 'vm) +(require 'vm-summary) +(require 'vm-vars) +(require 'vm-undo) +(require 'vm-folder) +(require 'vm-message) +(require 'vm-macro) +(require 'vm-misc) + +; this is the list of colours associated with each urgency level. +; it is customizable only before loading---subsequent changes will +; not affect the faces used in the summary. +; It is an array indexed by urgency level. The 0th entry is used +; for hacky internal purposes. +(defvar vm-sumurg-colarray + [ nil "yellow" "orange" "red" "magenta" ]) +; colour for the composition buffer reminder +(defvar vm-sumurg-compcolor "green") + +(make-face 'vm-sumurg-rightnow-face) +(set-face-background 'vm-sumurg-rightnow-face (aref vm-sumurg-colarray 4)) +(set-face-foreground 'vm-sumurg-rightnow-face "white") +(set-face-blinking-p 'vm-sumurg-rightnow-face t) +(make-face 'vm-sumurg-veryurgent-face) +(set-face-background 'vm-sumurg-veryurgent-face (aref vm-sumurg-colarray 3)) +(set-face-foreground 'vm-sumurg-veryurgent-face "white") +(make-face 'vm-sumurg-urgent-face) +(set-face-background 'vm-sumurg-urgent-face (aref vm-sumurg-colarray 2)) +(set-face-foreground 'vm-sumurg-urgent-face "black") +(make-face 'vm-sumurg-pending-face) +(set-face-background 'vm-sumurg-pending-face (aref vm-sumurg-colarray 1)) +(set-face-foreground 'vm-sumurg-pending-face "black") +(make-face 'vm-sumurg-comp-face) +(set-face-background 'vm-sumurg-comp-face vm-sumurg-compcolor) +(set-face-foreground 'vm-sumurg-comp-face "black") + +; stick the faces into an array for convenience +; note that this is inserting facenames, not faces +(defconst vm-sumurg-facearray + [ nil vm-sumurg-pending-face vm-sumurg-urgent-face + vm-sumurg-veryurgent-face vm-sumurg-rightnow-face ]) + +; each of these symbols holds a string to go in the modeline +(defconst vm-sumurg-symarray + [ nil vm-sumurg-modeline-pending vm-sumurg-modeline-urgent + vm-sumurg-modeline-veryurgent vm-sumurg-modeline-rightnow ]) + + +(defun vm-sumurg-level-of (m) + (if (member "****" (vm-labels-of m)) 4 + (if (member "***" (vm-labels-of m)) 3 + (if (member "**" (vm-labels-of m)) 2 + (if (member "*" (vm-labels-of m)) 1 0))))) + +; assuming that m is a message, highlight it in yellow, orange or red +; according as it has a *, **, or *** label. +(defun vm-sumurg-highlight-message () + (vm-sumurg-add-highlights (string-to-number (vm-number-of m)) + (vm-su-start-of m) (vm-su-end-of m) + (vm-sumurg-level-of m) + )) + +(defadvice vm-summary-highlight-region (after vm-sumurg-vshr activate compile) + (vm-sumurg-highlight-message)) + +(defvar vm-sumurg-counter [0 0 0 0 0]) + +(defvar vm-sumurg-comp-counter 0) +(defvar vm-sumurg-comp-counted nil) +(make-variable-buffer-local 'vm-sumurg-comp-counted) +;; This is a global (not per buffer) marker of composition buffers +(defvar vm-sumurg-modeline-comp nil) + +(defun vm-sumurg-comp-hook () + ; in case mail-mode is switched off and on for some reason + (if vm-sumurg-comp-counted t + (setq vm-sumurg-comp-counter (1+ vm-sumurg-comp-counter)) + (setq vm-sumurg-comp-counted t) + ;; set the comp entry + (setq vm-sumurg-modeline-comp + (if (> vm-sumurg-comp-counter 0) + (format "%d%s" vm-sumurg-comp-counter "C"))) + (redraw-modeline t))) + +(add-hook 'mail-mode-hook 'vm-sumurg-comp-hook) + +(defun vm-sumurg-comp-end-hook () + (when vm-sumurg-comp-counted + (setq vm-sumurg-comp-counted nil) + (setq vm-sumurg-comp-counter (1- vm-sumurg-comp-counter)) + ;; set the comp entry + (setq vm-sumurg-modeline-comp + (if (> vm-sumurg-comp-counter 0) + (format "%d%s" vm-sumurg-comp-counter "C"))) + (redraw-modeline t))) + +(add-hook 'vm-mail-send-hook 'vm-sumurg-comp-end-hook) +(add-hook 'kill-buffer-hook 'vm-sumurg-comp-end-hook) + +(defvar vm-sumurg-urgency-array nil) + +(defvar vm-sumurg-default-time "00:01" + "*The time at which urgency changes happen when no specific time is given.") + +(defun vm-sumurg-set-modeline-entries () + ;; map across urgency levels setting the modeline entry + ;; and noting which is the highest we have + (let ((maxl 0) count) + (mapcar (lambda (level) + (setq count (aref vm-sumurg-counter level)) + (set (aref vm-sumurg-symarray level) + (if (> count 0) + (format "%d%s" count (substring "****" 0 level)))) + (if (> count 0) (setq maxl level))) + '( 1 2 3 4)) + ;; if there's a rightnow message, enable the blinker, else disable + (if (eq maxl 4) + (vm-sumurg-blinker-enable) + (vm-sumurg-blinker-disable)) + ;; in fsfmacs, we can't set faces within the modeline, and it's + ;; easy not to notice the urgent flag. So we set the modeline + ;; foreground to an appropriate colour for this frame only. + ;; This is pretty heavy-handed, but maybe better than nothing. + ;; there seems to be no clean way to restore the original foreground. + ;; So the summary mode hook stashes in colarray[0], which is then + ;; right for this code. + ;; ARGH ARGH ARGH FSF LOSSAGE :-) + ;; this fails with virtual folders: the modeline in the frame + ;; of the original folder isn't updated. + ;; I can see absolutely no non-horrible solution to this. + (if vm-fsfemacs-p + (set-face-foreground 'modeline + (aref vm-sumurg-colarray maxl) + (selected-frame))))) + +(defun vm-sumurg-add-highlights (mnum start end level) + ;; decrement the counter for the message's previous urgency level + (let ((olevel (aref vm-sumurg-urgency-array mnum))) + (if (> olevel 0) + (aset vm-sumurg-counter olevel (1- (aref vm-sumurg-counter olevel)))) + (aset vm-sumurg-urgency-array mnum level) + (if (> level 0) + (progn + (aset vm-sumurg-counter level (1+ (aref vm-sumurg-counter level))) + (cond (vm-xemacs-p + ;; re-use extents, and delete them when not required + (let ((e (extent-at (/ (+ start end)) + (current-buffer) 'vm-sumurg))) + ;; why not 1- end ? Because the extent is right-open + ;; so it gets deleted any by the summary update (see code) + (if e t + (setq e (make-extent start end)) + (set-extent-property e 'start-open t) + ;; this was t. But I don't know why, and nil seems + ;; to avoid the problem with the selected message + ;; not updating. + (set-extent-property e 'detachable nil) + (set-extent-property e 'vm-sumurg t) + ) + (set-extent-property e 'face + (aref vm-sumurg-facearray level)))) + (vm-fsfemacs-p + ;; why 1- ? Because then the overlay gets deleted by + ;; the process of summary update. + (let ((e (make-overlay start (1- end)))) + (overlay-put e 'evaporate t) + (overlay-put e 'face (aref vm-sumurg-facearray level)))))) + ;; level 0: emacs, delete the extent + (cond (vm-xemacs-p + (let ((e (extent-at (/ (+ start end)) + (current-buffer) 'vm-sumurg))) + (if e (delete-extent e)))))) + (vm-sumurg-set-modeline-entries))) + +(defvar vm-sumurg-check-pending-in-progress nil) + +;; this holds an obarray used to record whether a message has +;; a timer set on it +(defvar vm-sumurg-timer-obarray nil) +(make-variable-buffer-local 'vm-sumurg-timer-obarray) + +;; check a message for a future urgency level, and set a timer +(defun vm-sumurg-check-future (m) + (mapcar (lambda (label) + (when (string-match "^\\(\\*+\\)\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)\\(?:[tT]\\([0-9][0-9]\\):\\([0-9][0-9]\\)\\)?$" label) + (let* ((day (string-to-number (match-string 4 label))) + (month (string-to-number (match-string 3 label))) + (year (string-to-number (match-string 2 label))) + (hour 0) (min 0) + time tmp + (hhmmregex "^\\([0-9][0-9]\\):\\([0-9][0-9]\\)$") + (now (current-time)) + (level (- (match-end 1) (match-beginning 1))) + (vm-message-pointer (list m)) + ) + (if (match-beginning 5) + (progn (setq hour (string-to-number (match-string 5 label))) + (setq min (string-to-number (match-string 6 label)))) + (when vm-sumurg-default-time + (if (string-match hhmmregex vm-sumurg-default-time) + (progn (setq hour + (string-to-number + (match-string 1 vm-sumurg-default-time))) + (setq min + (string-to-number + (match-string 2 vm-sumurg-default-time)))) + (message "Trying to fix up default time %s" + vm-sumurg-default-time) + (condition-case nil + (progn (setq tmp + (vm-sumurg-parse-date + ;; avoid the "add a day to early" + (concat "+0 " vm-sumurg-default-time))) + (setq vm-sumurg-default-time + (format-time-string "%H:%M" (car tmp))) + (message "Fixed to %s" vm-sumurg-default-time) + (setq tmp (decode-time (car tmp))) + (setq hour (nth 2 tmp)) + (setq min (nth 1 tmp))) + (error (progn (message "Unable to fix - clearing") + (setq vm-sumurg-default-time nil))))))) + ;; it seems to be a bad move to mess with labels + ;; while rebuilding a summary, so if this is called + ;; from check-pending, we'll schedule a timeout immediately + ;; rather than actually doing the actions now. + (setq time (encode-time 0 min hour day month year)) + (if (and (time-less-p time now) + (null vm-sumurg-check-pending-in-progress)) + (progn + (save-excursion + (vm-add-or-delete-message-labels label 1 nil)) + ;; let's try to clear the label out of the global list + ;; to avoid indefinite build-up + (unintern (concat (vm-su-message-id m) label) + vm-sumurg-timer-obarray) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of m))) + (unintern label vm-label-obarray)) + (save-excursion (vm-sumurg-set-urgency level nil 1 m)) + ) + ;; set a timeout + ;; but not if there's already one set for this message + ;; and label + (when (not (and vm-sumurg-timer-obarray + (intern-soft + (concat (vm-su-message-id m) label) + vm-sumurg-timer-obarray))) + (if (null vm-sumurg-timer-obarray) + (let ((o (make-vector 29 0))) + (setq vm-sumurg-timer-obarray o) + ;; copy it to the other buffer + ;; we expect always to be in the summary + ;; buffer here, but just in case... + (save-excursion + (set-buffer (or vm-mail-buffer vm-summary-buffer)) + (setq vm-sumurg-timer-obarray o)))) + (intern (concat (vm-su-message-id m) label) + vm-sumurg-timer-obarray) + (setq time (time-subtract time now)) + (setq time (time-add time (list 0 1))) ; to avoid jiggles + (setq time (+ (* 65536 (car time)) (cadr time))) + (if (<= time 0) (setq time 0.1)) + ;; if the time is too big to represent, set it to a week + ;; then it'll get re-calculated. + (if (> time (* 7 86400)) (setq time (* 7 86400))) + (message "setting timer on msg %s in %.0f seconds" + (vm-su-message-id m) time) + (add-timeout time + (lambda (arg) + (when (buffer-live-p (car arg)) + (save-excursion + (set-buffer (car arg)) + (let ((mp vm-message-list)) + (while (and mp + (not (equal + (vm-message-id-of + (car mp)) + (cadr arg)))) + (setq mp (cdr mp))) + (if mp + (vm-sumurg-check-future (car mp)))) + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (intern (buffer-name) + vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line)))) + (list (current-buffer) (vm-su-message-id m))) + )) + ))) + (vm-labels-of m)) +) + + +(defconst vm-sumurg-pending-extent + (if vm-xemacs-p + (let ((e (make-extent nil nil)) + (k (make-sparse-keymap))) + (set-extent-face e 'vm-sumurg-pending-face) + (set-extent-keymap e k) + (set-extent-property e 'help-echo "button2 selects pending messages") + (define-key k [(button2)] + (lambda () (interactive "@") (vm-sumurg-showurgent 1))) + e + ))) + +(defconst vm-sumurg-urgent-extent + (if vm-xemacs-p + (let ((e (make-extent nil nil)) + (k (make-sparse-keymap))) + (set-extent-face e 'vm-sumurg-urgent-face) + (set-extent-keymap e k) + (set-extent-property e 'help-echo "button2 selects urgent messages") + (define-key k [(button2)] + (lambda () (interactive "@") (vm-sumurg-showurgent 2))) + e + ))) + +(defconst vm-sumurg-veryurgent-extent + (if vm-xemacs-p + (let ((e (make-extent nil nil)) + (k (make-sparse-keymap))) + (set-extent-face e 'vm-sumurg-veryurgent-face) + (set-extent-keymap e k) + (set-extent-property e 'help-echo + "button2 selects very urgent messages") + (define-key k [(button2)] + (lambda () (interactive "@") (vm-sumurg-showurgent 3))) + e + ))) + + +(defconst vm-sumurg-rightnow-extent + (if vm-xemacs-p + (let ((e (make-extent nil nil)) + (k (make-sparse-keymap))) + (set-extent-face e 'vm-sumurg-rightnow-face) + (set-extent-keymap e k) + (set-extent-property e 'help-echo + "button2 selects very urgent messages") + (define-key k [(button2)] + (lambda () (interactive "@") (vm-sumurg-showurgent 4))) + e + ))) + + +(defconst vm-sumurg-comp-extent + (if vm-xemacs-p + (let ((e (make-extent nil nil)) + (k (make-sparse-keymap))) + (set-extent-face e 'vm-sumurg-comp-face) + (set-extent-keymap e k) + (set-extent-property e 'help-echo + "button2 switches to a composition buffer") + (define-key k [(button2)] + (lambda () (interactive) (vm-continue-composing-message))) + e + ))) + + +; modeline element for xemacs +(defvar vm-sumurg-modeline-element + (cond (vm-xemacs-p + (list + (list 'vm-sumurg-modeline-comp + (list vm-sumurg-comp-extent "" + 'vm-sumurg-modeline-comp)) + (list 'vm-sumurg-modeline-pending + (list vm-sumurg-pending-extent "" + 'vm-sumurg-modeline-pending)) + (list 'vm-sumurg-modeline-urgent + (list vm-sumurg-urgent-extent "" + 'vm-sumurg-modeline-urgent)) + (list 'vm-sumurg-modeline-veryurgent + (list vm-sumurg-veryurgent-extent "" + 'vm-sumurg-modeline-veryurgent)) + (list 'vm-sumurg-modeline-rightnow + (list vm-sumurg-rightnow-extent "" + 'vm-sumurg-modeline-rightnow)))) + (vm-fsfemacs-p + (list + (list 'vm-sumurg-modeline-comp + (list "" 'vm-sumurg-modeline-comp)) + (list 'vm-sumurg-modeline-pending + (list "" 'vm-sumurg-modeline-pending)) + (list 'vm-sumurg-modeline-urgent + (list "" 'vm-sumurg-modeline-urgent)) + (list 'vm-sumurg-modeline-veryurgent + (list "" 'vm-sumurg-modeline-veryurgent)) + (list 'vm-sumurg-modeline-rightnow + (list "" 'vm-sumurg-modeline-rightnow)) +)))) + + +; stick it at the end +(add-hook 'vm-summary-mode-hook + (if vm-xemacs-p + (lambda () + (setq vm-sumurg-counter (vector 0 0 0 0 0)) + (if (memq vm-sumurg-modeline-element modeline-format) + t + (setq modeline-format + (append modeline-format vm-sumurg-modeline-element)))) + (lambda () + (aset vm-sumurg-colarray 0 (face-foreground 'modeline)) + (setq vm-sumurg-counter (vector 0 0 0 0 0)) + (setq mode-line-format + (append mode-line-format vm-sumurg-modeline-element))))) + +(make-variable-buffer-local 'vm-sumurg-counter) +(make-variable-buffer-local 'vm-sumurg-modeline-pending) +(make-variable-buffer-local 'vm-sumurg-modeline-urgent) +(make-variable-buffer-local 'vm-sumurg-modeline-veryurgent) +(make-variable-buffer-local 'vm-sumurg-modeline-rightnow) +(make-variable-buffer-local 'vm-sumurg-urgency-array) + +;; takes a modeline format, and returns the same with any +;; substantive occurrence of vm-ml-labels prefixed by +;; the extent (at function call time) vm-ml-sumurg-extent + +(defvar vm-ml-sumurg-extent nil) +(make-variable-buffer-local 'vm-ml-sumurg-extent) +(defun vm-sumurg-munge-modeline (x) + (if (consp x) + (cons (car x) (mapcar 'vm-sumurg-munge-modeline (cdr x))) + (if (eq x 'vm-ml-labels) + (list vm-ml-sumurg-extent "" 'vm-ml-labels) + x))) + +;; hook into vm mode to set the modeline format +(defun vm-sumurg-vm-mode-hook-fn () + (setq vm-ml-sumurg-extent (make-extent nil nil)) + (setq modeline-format (vm-sumurg-munge-modeline modeline-format))) + +(add-hook 'vm-mode-hook ' vm-sumurg-vm-mode-hook-fn) +(add-hook 'vm-presentation-mode-hook ' vm-sumurg-vm-mode-hook-fn) + +(require 'advice) + +(defadvice vm-do-needed-mode-line-update + (before vm-sumurg-dnmlu activate compile) + (when (and vm-message-pointer vm-ml-sumurg-extent) + (set-extent-face vm-ml-sumurg-extent + (aref vm-sumurg-facearray + (vm-sumurg-level-of (car vm-message-pointer)))) + (if vm-presentation-buffer + (save-excursion + (set-buffer vm-presentation-buffer) + (set-extent-face vm-ml-sumurg-extent + (aref vm-sumurg-facearray + (vm-sumurg-level-of + (car vm-message-pointer)))))))) + + +; given a pointer into a message list, return the first element +(defun vm-first (mp) + (let (prev) + (while (setq prev (vm-reverse-link-of (car mp))) + (setq mp prev)) + mp)) + + +; this assumes that m-list points to the message list being summarized +(defun vm-sumurg-check-pending () + (let ((vm-sumurg-check-pending-in-progress t)) + (if (null m-list) + (vm-sumurg-set-modeline-entries) + (let* ((this (string-to-number (vm-number-of (car m-list)))) + (last (string-to-number (vm-number-of (car (vm-last m-list))))) + (curlen (length vm-sumurg-urgency-array)) + (newlen (1+ last)) + i l + ) + (when (> newlen curlen) + (setq newlen (+ newlen (/ newlen 20))) + (setq vm-sumurg-urgency-array + (vconcat vm-sumurg-urgency-array + (make-vector (- newlen curlen) 0)))) + (setq i this) + (while (< i newlen) + (setq l (aref vm-sumurg-urgency-array i)) + (when (> l 0) + (aset vm-sumurg-counter l (1- (aref vm-sumurg-counter l))) + (aset vm-sumurg-urgency-array i 0)) + (setq i (1+ i))) + (mapcar (lambda (m) + (vm-sumurg-check-future m) (vm-sumurg-highlight-message)) + m-list))))) + +(add-hook 'vm-summary-update-hook 'vm-sumurg-highlight-message) +(add-hook 'vm-summary-redo-hook 'vm-sumurg-check-pending) + +; code for blinking the rightnow messages +(defvar vm-sumurg-blinker-needed nil) +(make-variable-buffer-local 'vm-sumurg-blinker-needed) +(defvar vm-sumurg-blinker-blink nil) +(defvar vm-sumurg-blinker-timeout-id nil) +(defvar vm-sumurg-blinker-in-focus nil) +(defun vm-sumurg-blinker-callback (junk) + (if vm-sumurg-blinker-in-focus + (if vm-sumurg-blinker-blink + (progn (setq vm-sumurg-blinker-blink nil) + (set-face-background 'vm-sumurg-rightnow-face "magenta")) + (setq vm-sumurg-blinker-blink t) + (set-face-background 'vm-sumurg-rightnow-face "cyan")) + (disable-timeout vm-sumurg-blinker-timeout-id) + (setq vm-sumurg-blinker-timeout-id nil) + (setq vm-sumurg-blinker-blink nil) + (set-face-background 'vm-sumurg-rightnow-face "magenta"))) +(defun vm-sumurg-blinker-select-frame-hook () + (setq vm-sumurg-blinker-in-focus + (and (eq (frame-type (selected-frame)) 'x) vm-sumurg-blinker-needed)) + (if (and vm-sumurg-blinker-in-focus + (null vm-sumurg-blinker-timeout-id)) + (setq vm-sumurg-blinker-timeout-id + (add-timeout 1 'vm-sumurg-blinker-callback nil 1)))) +(defun vm-sumurg-blinker-deselect-frame-hook () + (setq vm-sumurg-blinker-in-focus nil)) +(defun vm-sumurg-blinker-enable () + (setq vm-sumurg-blinker-needed t) + (if vm-mail-buffer + (vm-copy-local-variables vm-mail-buffer 'vm-sumurg-blinker-needed)) + (if vm-presentation-buffer + (vm-copy-local-variables vm-presentation-buffer + 'vm-sumurg-blinker-needed)) + (add-hook 'select-frame-hook 'vm-sumurg-blinker-select-frame-hook) + (add-hook 'deselect-frame-hook 'vm-sumurg-blinker-deselect-frame-hook) + (vm-sumurg-blinker-select-frame-hook)) +(defun vm-sumurg-blinker-disable () + (remove-hook 'select-frame-hook 'vm-sumurg-blinker-select-frame-hook) + (remove-hook 'deselect-frame-hook 'vm-sumurg-blinker-deselect-frame-hook) + (setq vm-sumurg-blinker-in-focus nil) + (setq vm-sumurg-blinker-needed nil) + (if vm-mail-buffer + (vm-copy-local-variables vm-mail-buffer 'vm-sumurg-blinker-needed)) + (if vm-presentation-buffer + (vm-copy-local-variables vm-presentation-buffer + 'vm-sumurg-blinker-needed)) + ) + +; bound to vm-virtual-folder-alist in following command +(defvar vm-sumurg-urgent-folder-alist + '( + ;; start virtual folder definition + ("pending" + (nil ; no real folder + (label "*") + (label "**") + (label "***") + (label "****") + )) + ("urgent" + (nil ; no real folder + (label "**") + (label "***") + (label "****") + )) + ("very urgent" + (nil ; no real folder + (label "***") + (label "****") + )) + ("right now!" + (nil ; no real folder + (label "****") + )) + ) + ) + + +; set urgency level: clears other labels of different urgencies +; This is not bound to a key here, because I can't think of the +; right keybinding. I use *, but that's vm-burst-digest standardly. +(defun vm-sumurg-set-urgency (level &optional date count msg clear) + "*Set the urgency level of a message. +Interactively, this prompts for an urgency level from 0 (unmarked) to 4, +and sets the message's urgency accordingly. + +A numeric prefix argument is treated in the usual way, setting the +following N messages to the given urgency level. + +If called with a simple prefix argument (C-u), it first prompts +for a date on which the message is to be set to the given urgency level. +If called with a double prefix argument (C-u C-u), it clears any pending +urgency changes on the message. + +The date can be given in several reasonable forms: + +ISO: 2012-01-22 +European numeric: 22/01/2012 or 22/01/12 +British traditional: 22 January 2012 or 22 Jan 2012 or Jan 22, 2012 + (month names can be given either in full, or as the first three letters) +Except in ISO format, the year can be omitted, and the next such date will +be assumed. + +For the next few days, there are two options: a weekday name, which may be +given in full, or with the first three, or first two, letters. It may be +followed by week (or wk for the really lazy), to add another seven days. +For example: + monday + tue + wed week + +Alternatively, a number of days in the future may be given by +N: ++1 tomorrow ++2 day after tomorrow ++ tomorrow (N.B. means +1 not +0) + +Any date spec may be preceded or followed by a time spec, in several +reasonable formats: 19:27 19.27 19h27 7.27 pm 19h 7pm. +Specifically any of h : . is recognized as a separator; am and pm are +recognized in either case and with or without full stops; the separator +and minutes may be omitted, provided that h or am/pm is used. + (To avoid confusion with years, military format 1927 is not accepted.) + +A time spec normally means that time on the given date. In the special case +where there is only a time spec, and the date is empty, it means the next +occurrence of that time: e.g. at 19:00, a date/time spec of 09:00 means +the following morning. + +A date spec without a time spec will become active according to the value +of `vm-sumurg-default-time', which should be a string containing a time +in any of the above formats. This defaults to \"00:01\"; it might be useful to +set it to, say, \"08:30\", so that messages don't become urgent until you get +to the office! (Note: the value of `vm-sumurg-default-time' that counts is +that when the urgency is set, or when VM loads the mail folder, whichever +happens later.)" + + (interactive + (let ((prompt "Urgency level (0-4): ") + level date timep count clear) + (when (consp current-prefix-arg) + (if (= (prefix-numeric-value current-prefix-arg) 16) + (setq clear t) + (setq date (vm-sumurg-parse-date (read-string "Date to set: "))) + (setq timep (cadr date)) + (setq date (format-time-string + (if timep "%Y-%m-%dT%H:%M" "%Y-%m-%d") + (car date))) + (setq prompt (concat "On " date " set urgency level (1-4): "))) + (setq current-prefix-arg nil)) + (if clear t (setq level (read-number prompt t))) + (setq count (prefix-numeric-value current-prefix-arg)) + (list level date count nil clear))) + (if (null count) (setq count 1)) + (if (and (not clear) (or (< level 0) (> level 4))) + (error "%d is not a known urgency level" level)) + (when (null msg) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-read-only) + (vm-error-if-folder-empty) + (let ((vm-message-pointer vm-message-pointer)) + (if msg (setq vm-message-pointer (list msg))) + (if clear + (mapcar (lambda (label) + (when (string-match "^\\*+[-0-9:t]+$" label) + (vm-add-or-delete-message-labels label count nil) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of + (car vm-message-pointer)))) + (unintern label vm-label-obarray)))) + (vm-labels-of (car vm-message-pointer))) + (if date + (progn + (vm-add-or-delete-message-labels + (concat (substring "****" 0 level) date) count 'all) + (vm-sumurg-check-future (car vm-message-pointer))) + (vm-add-or-delete-message-labels + "* ** *** ****" count nil) + (vm-add-or-delete-message-labels + (substring "****" 0 level) count 'all))) +; ;; for reasons I don't understand, the display of the selected message +; ;; doesn't get updated - some interaction with the highlight face, +; ;; I guess. So call highlight message explicitly +; (let ((m (car vm-message-pointer))) +; (save-excursion +; (set-buffer vm-summary-buffer) +; (vm-sumurg-highlight-message)))) +; (let ((modified (buffer-modified-p))) +; (set-buffer-modified-p t) +; (vm-do-needed-mode-line-update) +; (set-buffer-modified-p modified)) +)) + +; form a buffer with pending messages +(defun vm-sumurg-showurgent (level) + "Make a virtual folder containing messages whose urgency is greater +than or equal to the given value (prompted for, when interactive)." + (interactive "nUrgency level (1-4): ") + (if (or (< level 1) (> level 4)) (error "%d is not a known urgency level")) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (let ((vm-virtual-folder-alist vm-sumurg-urgent-folder-alist) + ; scream. Problem1: these folder defns get installed + ; on the menu bar; problem2: vm-install-known-virtual-folders-menu + ; doesn't handle empty alists correctly, so we can't + ; just run it again after exiting the let form + ; (and anyway, we don't want them on the new folder's menu) + ; Therefore: hackety hack HACK: + ; somebody tell me how to do this right + (keepfn (symbol-function 'vm-menu-install-known-virtual-folders-menu))) + (unwind-protect + (progn + (fset 'vm-menu-install-known-virtual-folders-menu (lambda () nil)) + (vm-apply-virtual-folder + (cond ((= level 1) "pending") + ((= level 2) "urgent") + ((= level 3) "very urgent") + ((= level 4) "right now!") + ))) + (fset 'vm-menu-install-known-virtual-folders-menu keepfn)))) + + +(define-key vm-mode-map "VU" 'vm-sumurg-showurgent) + +; add item to the virtual menu +(require 'vm-menu) + +(let ((mp vm-menu-virtual-menu) + mprev + (item (vector "Make Urgent Virtual Folder" 'vm-sumurg-showurgent t))) + (while (and mp (or (not (stringp (car mp))) + (not (string-match "^--*$" (car mp))))) + (setq mprev mp) + (setq mp (cdr mp))) + (if mprev + (setcdr mprev (cons item mp)) + (setq vm-menu-virtual-menu (cons item mp)))) + + +; routines to parse dates in a reasonable format. +; Returns a list (TIME TIMEP). +; The TIME is a time value, corresponding to the given date string. +; If the date string contains no time specifier, the time is zero hours, +; and TIMEP is nil. If the date string contained a time value, +; TIMEP is t. +; Time specifiers have the form hh:mm or hh.mm, optionally +; preceded by a T (for the benefit of ISO format), and optionally +; followed by am or pm (which we handle correctly). + + +(defun vm-sumurg-parse-date (s) + (let ((now (current-time)) + (case-fold-search t) + (ts) + (hh 0) (mm 0) (xm) (timep) + (timeregexp (eval-when-compile + (concat + ;; XEmacs bug: ^ not recognized after shy group open, so + ;; put it as second alternative + "\\(?:[_t]\\|^\\|\\s-\\)\\s-*" ; start with beginning, T + ; or whitespace + "\\([0-9][0-9]?\\)" ; the hours + ;; now either we have minutes followed by an optional + ;; am/pm, or we have a compulsory h/am/pm + ;; open, and first alternative + "\\(?:[h:.]\\([0-9][0-9]\\)\\s-*\\(?:\\([ap]\\)\\.?m\\.?\\)?" + ;; second alternative + "\\|\\s-*\\(?:h\\|\\([ap]\\)\\.?m\\.?\\)\\)")) +) + (date)) + (setq date (decode-time now)) + ;; look for and remove a time string + ;; we want to allow either minutes or h/am/pm to be omitted, + ;; but not both. Unfortunately, there's no way to avoid writing + ;; the pm/am twice. + (when (or (when (string-match timeregexp s) + (setq ts s) + (setq s (replace-match "" nil nil s)) + (setq timep t)) + (and vm-sumurg-default-time + (setq ts vm-sumurg-default-time) + (or (string-match timeregexp ts) + (error 'invalid-argument + "vm-sumurg-default-time not in a valid time format" + 'vm-sumurg-default-time)))) + (setq hh (string-to-number (match-string 1 ts))) + (if (match-beginning 2) + (setq mm (string-to-number (match-string 2 ts)))) + (setq xm (or (match-string 3 ts) (match-string 4 ts))) + (when xm + (if (or (equal xm "a") (equal xm "A")) + (if (equal hh 12) (setq hh 0)) + (if (< hh 12) (setq hh (+ hh 12)))))) + (list (apply 'encode-time + (cond + ;; +n or empty + ((string-match "^\\s-*\\(?:\\+\\([0-9]*\\)\\)?\\s-*$" s) + (list 0 mm hh + (+ (nth 3 date) + (if (null (match-beginning 1)) + ;; empty, today. If a time was given, and + ;; it's before now, then make it tomorrow + (if (and timep + (or (< hh (nth 2 date)) + (and (= hh (nth 2 date)) + (< mm (nth 1 date))))) + 1 + 0) + (if (equal (match-beginning 1) (match-end 1)) 1 + (string-to-number (match-string 1 s))))) + (nth 4 date) + (nth 5 date))) + ;; fooday week + ((string-match + (eval-when-compile (concat "^\\s-*" ; white space at beginning + "\\(?:" ; start of day match + ;; given a string, build a regexp that matches + ;; the first 2 letters, + ;; the first three letters, or the whole + ;; string. I.e. monday will + ;; match mo, mon, monday + (mapconcat + (lambda (d) + (concat "\\(" (substring d 0 2) + "\\(?:" (substring d 2 3) + "\\(?:" (substring d 3) "\\)?\\)?\\)") + ) + '("sunday" "monday" "tuesday" "wednesday" + "thursday" "friday" "saturday") "\\|") + "\\)" ; end of day match + "\\s-*" ; white space + "\\(w\\(?:ee\\)?k\\)?" ; week match + "\\s-*$" ; white space to end + )) ; end of constructed regexp + s) + (let* ((week (match-string 8 s)) + (wdaynum (let ((i 1)) + (while (and (< i 8) (null (match-beginning i))) + (setq i (1+ i))) + (if (>= i 8) nil (1- i)))) + (todaynum (nth 6 date)) + ) + (if (> wdaynum todaynum) + t ; do nothing: the day's coming up + (setq wdaynum (+ 7 wdaynum))) + (if week (setq wdaynum (+ 7 wdaynum))) + (list 0 mm hh (+ (- wdaynum todaynum) (nth 3 date)) (nth 4 date) + (nth 5 date)) + )) ; end of first clause + ;; iso date, nice and easy + ((string-match + "^\\s-*\\([12][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)\\s-*$" + s) + (list 0 mm hh (string-to-number (match-string 3 s)) + (string-to-number (match-string 2 s)) + (string-to-number (match-string 1 s)))) + ;; and traditional dates + ((string-match + "^\\s-*\\([0-9][0-9]?\\)/\\([0-9][0-9]?\\)\\(?:/\\([0-9]+\\)\\)?\\s-*$" + s) + (let ((d (string-to-number (match-string 1 s))) + (m (string-to-number (match-string 2 s))) + (y (if (match-beginning 3) + (string-to-number (match-string 3 s))))) + (when (null y) + (setq y (nth 5 date)) + (if (or (< m (nth 4 date)) + (and (= m (nth 4 date)) (<= d (nth 3 date)))) + (setq y (1+ y)))) + (if (< y 100) (setq y (+ 2000 y))) + (list 0 mm hh d m y))) + ;; 5 jan yy + ((string-match + (eval-when-compile (concat + "^\\s-*\\([0-9][0-9]?\\)\\s-*\\(?:" ; initial white + ; space and number + ;; construct a month matcher: bracket n is month n-1 + (mapconcat + (lambda (m) + (concat "\\(" (substring m 0 3) + "\\(?:" (substring m 3) "\\)?\\)")) + '("january" "february" "march" "april" "may" "june" "july" + "august" "september" "october" "november" "december") + "\\|") + "\\)\\s-*\\([0-9]+\\)?\\s-*$" ; end of month group, and year + )) s) + (let ((d (string-to-number (match-string 1 s))) + (m (let ((i 2)) + (while (and (< i 14) (null (match-beginning i))) + (setq i (1+ i))) + (if (>= i 14) + (error 'internal-error + "matched impossible month in vm-sumurg-parse-date") + (1- i)))) + (y (if (match-beginning 14) + (string-to-number (match-string 14 s))))) + (when (null y) + (setq y (nth 5 date)) + (if (or (< m (nth 4 date)) + (and (= m (nth 4 date)) (<= d (nth 3 date)))) + (setq y (1+ y)))) + (if (< y 100) (setq y (+ 2000 y))) + (list 0 mm hh d m y))) + ;; and the same, for jan 5, yy + ((string-match + (eval-when-compile (concat + "^\\s-*\\(?:" ; initial white space + ;; construct a month matcher: bracket n is month n-1 + (mapconcat + (lambda (m) + (concat "\\(" (substring m 0 3) + "\\(?:" (substring m 3) "\\)?\\)")) + '("january" "february" "march" "april" "may" "june" "july" + "august" "september" "october" "november" "december") + "\\|") + "\\)\\s-*\\([0-9][0-9]?\\)\\(?:,\\s-*\\([0-9]+\\)\\)?\\s-*$" + ; end of month group, day and year + )) s) + (let ((d (string-to-number (match-string 13 s))) + (m (let ((i 1)) + (while (and (< i 13) (null (match-beginning i))) + (setq i (1+ i))) + (if (>= i 13) + (error 'internal-error + "matched impossible month in vm-sumurg-parse-date") + i))) + (y (if (match-beginning 14) + (string-to-number (match-string 14 s))))) + (when (null y) + (setq y (nth 5 date)) + (if (or (< m (nth 4 date)) + (and (= m (nth 4 date)) (<= d (nth 3 date)))) + (setq y (1+ y)))) + (if (< y 100) (setq y (+ 2000 y))) + (list 0 mm hh d m y))) + (t + (error 'invalid-argument + (concat s " is not a recognized date format")))) + ; end of cond + ) timep))) ; end of defn + + +(provide 'vm-sumurg) diff --git a/debian/.git-dpm b/debian/.git-dpm new file mode 100644 index 0000000..ac27887 --- /dev/null +++ b/debian/.git-dpm @@ -0,0 +1,8 @@ +# see git-dpm(1) from git-dpm package +6dc310ec5fd37e85c91a565f709f809ef851d13c +6dc310ec5fd37e85c91a565f709f809ef851d13c +d21c89fce37a2e4e3b80ebf88da597daa767ba16 +d21c89fce37a2e4e3b80ebf88da597daa767ba16 +vm_8.1.2.orig.tar.gz +cf40f9343a45ea414b4c3bc2df6792988d836e94 +706846 diff --git a/debian/NEWS.Debian b/debian/NEWS.Debian new file mode 100644 index 0000000..bee8e79 --- /dev/null +++ b/debian/NEWS.Debian @@ -0,0 +1,10 @@ +vm (8.0.12-2) unstable; urgency=low + + * This version of VM does not work with Emacs 21 and lower, since those + versions are missing the custom-autoload function which is used + invm-autoloads.el. As a result, no autoloads for vm are defined, + making vm completely unusable with emacs21. VM no longer byte compiles + itself for those versions. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 06 Jan 2009 11:12:31 -0600 + diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..9a74fee --- /dev/null +++ b/debian/changelog @@ -0,0 +1,3612 @@ +vm (8.2.0b-1) unstable; urgency=low + + * New upstream release. This has been in Beta for two years now, and + seems to work fine. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 28 Apr 2014 16:31:54 -0700 + +vm (8.1.2-2.1) unstable; urgency=low + + * Non-maintainer upload. + * Fixed texinfo warnings and errors leading to an FTBFS (Closes: #712368) + + -- Hilko Bengen <bengen@debian.org> Sat, 23 Nov 2013 16:25:12 +0100 + +vm (8.1.2-2) unstable; urgency=low + + * Also add emacs24 to the postinst, so we register with ucf + * Bug fix: "deletes shipped file during installation: + /usr/share/emacs/site-lisp/vm/vm-autoloads.el", thanks to Andreas + Beckmann (Closes: #706373). + + -- Manoj Srivastava <srivasta@debian.org> Mon, 29 Apr 2013 13:02:37 -0700 + +vm (8.1.2-1) unstable; urgency=low + + * New upstream release + * Bug fix: "unowned files after purge (policy 6.8, 10.8)", thanks to + Andreas Beckmann. We don't need that file, so we should not install it + in the first place. (Closes: #656219). + * Bug fix: "vm/w3m incorrectly displays HTML Mime contents with charset + different from locale", thanks to comcap@free.fr. This has been fixed + in this new upstream version. (Closes: #635909). + + -- Manoj Srivastava <srivasta@debian.org> Sun, 28 Apr 2013 00:22:49 -0700 + +vm (8.1.0-1) unstable; urgency=low + + * New upstream version + * [20fe869]: Merge branch 'upstream' into topic--debian + * Bug fix: "sc-cite-original citation hook fails for mime encoded + messages", thanks to Klaus Reichl (Closes: #550859). + * Bug fix: "8bit characters are not escapes in In-reply-to field", + thanks to Neil Brown (Closes: #434565). + * Bug fix: "vm-mime-encode-headers may mess up recipient addresses", + thanks to Francois Fleuret (Closes: #553402). + + -- Manoj Srivastava <srivasta@debian.org> Sun, 28 Mar 2010 08:03:45 -0700 + +vm (8.0.13-1) unstable; urgency=low + + * New upstream release. The project isunder new management now. This is + a bug fixing release, which handles a flaw in caching. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 29 Nov 2009 11:48:54 -0600 + +vm (8.0.12-7) unstable; urgency=low + + * Told lintian to stop parsing old changelogs. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 01 Nov 2009 20:21:57 -0600 + +vm (8.0.12-6) unstable; urgency=low + + * Take extra care to remove cruft during remove and/or purge. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 20 Oct 2009 09:59:26 -0500 + +vm (8.0.12-5) unstable; urgency=low + + * [e457f1c]: [topic--debian]: remove references to vm-easymenu + Bug fix: "vm.el still references vm-easymenu, which has gone", thanks + to Klaus Reichl (Closes: #470263). + + -- Manoj Srivastava <srivasta@debian.org> Mon, 12 Oct 2009 22:59:37 -0500 + +vm (8.0.12-4) unstable; urgency=low + + * New release to bring package into conformance with latest policy. + * [88e374f]: [vm]: Info files are now installed using triggers + + -- Manoj Srivastava <srivasta@debian.org> Sun, 16 Aug 2009 16:58:04 -0500 + +vm (8.0.12-3) unstable; urgency=low + + * A new, bug fixing release. + * [1493c77]: [vm] Remove files from the site-lisp directory + This was caught by piuparts. + * Updated Standards version to 3.8.2.0. Also, use emacs23 instead of + emacs22, now that it has entered testing. + * Info files are now installed using triggers. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 13 Aug 2009 12:38:42 -0500 + +vm (8.0.12-2) unstable; urgency=low + + * This version of VM does not work with Emacs 21 and lower, since those + versions are missing the custom-autoload function which is used + invm-autoloads.el. As a result, no autoloads for vm are defined, + making vm completely unusable with emacs21. VM no longer byte compiles + itself for those versions. Remove support for emacs20 and emacs21 in + emacsen.{install,remove}, add support for emacs23. Also add an + NEWS.Debian file to document this change. + Bug fix: "broken with emacs21 - (void-function custom-autoload)", + thanks to Sven Joachim (Closes: #508543). + * [c9a55df]: Added missing autoload cookie for + vm-decode-postponed-mime-message. For good measure, add an autoload + directive to the vm-init file as well. + Bug fix: "Now requires forced load of vm-pine ", thanks to Dirk + Eddelbuettel (Closes: #516591). + * [debiandir:a9a97a6]: remove call to install-docs, since this is now + done with triggers. + * [debiandir:263c26a]: Remove configure generated files in clean target + + -- Manoj Srivastava <srivasta@debian.org> Sun, 22 Mar 2009 02:19:48 -0500 + +vm (8.0.12-1) unstable; urgency=low + + * New upstream release + [b68c89b] Merge branches 'upstream', 'topic--debian' and 'topic--base64' + [580b1fe] Merge branch 'upstream' into topic--debian + [5007800] Merge branch 'upstream' into topic--base64 + [f6416fc] Imported vm-8.0.12 + IMPROVEMENTS: + + Display version info when calling `vm-version' interactively. + (Thanks to Ulrich Mueller) + + Yanking of messages uses the same MIME decoding as the presentation + now. See the new variable `vm-mime-yank-attachments' to configure if + attachments are also yanked. + + `u-vm-color.el' is bundled and maintained with VM now. Ulf Jasper + handed it over to me as he switched to Gnus. + BUGFIXES: + + Detect w3 by using `locate-library' instead of checking for a bound + `w3-about'. (Thanks to Klaus Straubinger) + + vm.revno.el was not installed anymore b "make install". (Thanks to + Ulrich Mueller for reporting) + + Insert `emacs-version' instead of creating wrong version string for + XEmacs, i.e. the patch level was the major version. (Thanks to Stephen + Turnbull) + + Correctly locate the data directory for the pixmaps when running as a + XEmacs package. + + Check for some MIME character sets that may be available in recent + XEmacs. (Thanks to Aidan Kehoe for the patch) + + Some documentation fixes. (Thanks to Michael Ernst for the patches) + + Fixed infinite loop in vm-mime-encode-words on XEmacs 21.5-b28. + (Thanks to Aidan Kehoe for the patch) + + Detect "score" (additionally to "hits") in "X-Spam-Status:" headers in + `vm-su-spam-score-aux'. (Patch from Michael Ernst) + + Typo fix in vm-pcrisis.texinfo. (Patch from Michael Ernst) + + Header encoding was BASE64 instead of QP by default and it was not + encoding whole words, but only the 8bit chars instead. (Thanks to Ulrich + Mueller for reporting) + + MIME text parts interleaved by attachments are now correctly yanked, + e.g. when replying to a message. + + Limit the buffer-name length and sanitize the used characters. (Thanks + to Mark Diekhans for reporting) + + Do not fail on corrupted address headers. (Reported by John Covici) + + Fixed GTK detection and toolbar handling for newer Emacs 22 versions. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 06 Nov 2008 23:16:48 -0600 + +vm (8.0.11-1) unstable; urgency=low + + * New upstream release. Excerpted changes: + + Removed dependency of vm-revno.el to other lisp sources to avoid + building it in a release bundle. (Thanks to Ralf Fassel) + + Added missing documentation for `vm-user-agent', "?" binding and + 'vm-delete-duplicate-messages'. (Thanks to Alan Wehmann) + + `vm-message-history.el' now uses a buffer similar to the summary for + browsing the history. The buffer replaces the summary buffer when + present. Duplicate history entries will be removed. + + Define and use `vm-replace-in-string' which is `replace-in-string' + from XEmacs to avoid clashes with other GNU Emacs packages defining + it differently. Unfortunately, GNU Emacs still does not provide this + handy function. (Thanks to José Miguel Figueroa) + + MIME encoding of header will automatically happen now and has been moved + from `vm-rfaddons.el' to `vm-mime.el' and `vm-vars.el'. + + Leading lines of a yanked message were accidently taken as headers and + got removed if `vm-reply-include-presentation' was t. + + Fixed encoding of headers for trailing 8 bit characters. (Thanks to + Lutz Euler for the patch) + + Decode (QP-)encoded clear text before decrypting it. + + Use nil as default for `vm-mime-8bit-composition-charset' and thus + enable proper detection of right charset. (Thanks to Naoki Saito for + reporting and debugging) + + Fixed bug in `vm-mime-display-external-generic' for GNU Emacs 23 causing + corrupted content in the output file. The old code has been replaced by + a call to `vm-mime-send-body-to-file' which avoids duplication and works. + There has been some special handling for `vm-fsfemacs-mule-p', but the + actual reason for this was unclear so it has been removed. + + Correctly handle `vm-enable-addons' being t. + + Correctly store UTF-8 strings in the X-VM-v5-Data header to avoid + corruption of summay lines. (Thanks to Yuning Feng for reporting) + + Correctly encode multibyte subjects. (Thanks to Yuning Feng for the + patch) + + Use BASE64 for header encoding when there are special chars not quoted + by QP normally. You may configure this by `vm-mime-encode-headers-type'. + + qp-decode program handles premature end of QP-encoded stream now + gracefully. (Thanks to Ralf Fassel for the bug report, fix and testing) + + Added missing newline after "Content-Type" when using the command + `vm-mime-attach-object-from-message'. (Thanks to Dan Freed) + + -- Manoj Srivastava <srivasta@debian.org> Fri, 29 Aug 2008 15:24:42 -0500 + +vm (8.0.9-4) unstable; urgency=low + + * Updated the control file to reflect moving the package to a public git + repository at http://git.debian.org/git/users/srivasta/debian/vm.git + * Bug fix: "vm: Error while loading 50vm-init", thanks to Laurent + Bonnaud. Since the variable is defined in vm-vars, as is the missing + function, wrap the setting of the pixamp directory in an + eval-after-load vm-vars. (Closes: #475646). + + -- Manoj Srivastava <srivasta@debian.org> Sun, 27 Apr 2008 22:51:03 -0500 + +vm (8.0.9-3) unstable; urgency=low + + * Correct setting in vm-init.el, based on guidance by Kurt Hornik. The + directory setting were wrong, and now we just let the upstream default + remain for vm-image-directory, and add a setting for + vm-toolbar-pixmap-directory that reflects the upstream version, + modified for Debian variations. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 03 Apr 2008 00:07:29 -0500 + +vm (8.0.9-2) unstable; urgency=high + + * Bug fix: "vm: Installer overwrites vm-init.el before it uses it.", + thanks to Klaus Reichl. Thanks to Sven Joachim for finding the bug, + and for a patch. Closes: #465748,#470275 + * Make sure we delete files from /usr/share/emacs/site-lisp/vm on + removal (these are not conffiles, so can go on removal, instead of + hanging around until purged). + + -- Manoj Srivastava <srivasta@debian.org> Wed, 19 Mar 2008 13:38:12 -0500 + +vm (8.0.9-1) unstable; urgency=low + + * New upstream release + * Added documentation to `vm-mime-external-content-types-alist' that no + extra single quotes should be used around %f as the file name is already + quoted for the shell. (Thanks to Martin Schwenke) + * Fixed version number generation in release script. It was broken for + 8.0.8, i.e. it was showing 8.0.x-xemacs-542 instead. Now also other + branch related information is stored in the file vm-revno.el. + * Reactivated "Allow defadvice on function `vm' by recursing on session + start". It should work correctly now. + * Added interactive `vm-pipe-message-to-command-discard-output' and + the non-interactive `vm-pipe-message-to-command-to-string' for using + it in own functions. + * Added `vm-pipe-messages-to-command*' for bulk piping messages to a + single command, i.e. like saving to a pipe. This is substantially + faster than `vm-pipe-message-to-command*' which call the command on + each message separately. You may want to use it to feed spamassasin. + * Modified key bindings for piping messages, i.e. "|" is a prefix key + now. Type it twice to get the old pipe command, "|d" will call the + discard the output, just display some infos in the mode line. "|s" + will call `vm-pipe-messages-to-command' and "|n" will also call it + but discard the output. + * Removed vm-easymenu.el and use easymenu.el instead. + * In `vm-save-message-preview', ask the user if the output file already + exists instead of silently overwriting it. + * Moved [Undo] to Dispose menu and [Emacs] to Help menu as these do not + work in Emacs 22 anymore when on the menu bar. + * Fixed intermixing of signature and quoted text in reply if + `vm-reply-include-presentation' is t. (Thanks to Roland Winkler for + debugging and reporting) + * Fixed yanking of presentation from wrong folder when folder is virtual. + (Thanks to Roland Winkler for reporting) + * Redistributed flag not displayed in presentation buffer mode line. + https://bugzilla.redhat.com/show_bug.cgi?id=428248 (Thanks to Jonathan + Underwood for the fix) + * `vm-submit-bug-report' gets the variables dynamically now and thus does + not miss new ones or references old ones anymore. + * Correctly determine the real folder when postponing compositions started + from a virtual folder. (Thanks to Uday S. Reddy for reporting and + debugging) + * Avoid crash when `vm-mouse-set-mouse-track-highlight' is not called + within a summary buffer or without a valid message pointer. + * Do not disable modes which do not exist. (Thanks to Uday S. Reddy for + reporting) + * Fix compilation of autoloads. Closes: 465748 + + -- Manoj Srivastava <srivasta@debian.org> Thu, 21 Feb 2008 16:22:43 -0600 + +vm (8.0.7-1) unstable; urgency=low + + * New upstream release Closes: #435917 + This is a pretty major release. Releases are numbered now + MAJOR.MINOR.PATCHLEVEL, where MAJOR is increased when fundamental + changes occur, MINOR for new features and PATCHLEVEL for bugfix + releases. Better built system based on configure. Autoloads are + generated only for those functions marked with the autoload token now, + which are mainly interactive function. Thus, loading occurs only on + demand and startup should be faster. + * We now prefer emacs22, though we still install on emacs21. Closes: #434022 + + -- Manoj Srivastava <srivasta@debian.org> Fri, 08 Feb 2008 21:15:32 -0600 + +vm (7.19-14) unstable; urgency=low + + * Bug fix: "vm: Please support emacs22", thanks to Sven Joachim + (Closes: #432105). + + -- Manoj Srivastava <srivasta@debian.org> Sat, 07 Jul 2007 15:11:00 -0500 + +vm (7.19-13) unstable; urgency=low + + * Added XS-VCS-Arch and XS-VCS-Browse to debian/control + * Bug fix: "vm: suggests unavailable package mime-codecs", thanks to + Sven Joachim (Closes: #412371). + + -- Manoj Srivastava <srivasta@debian.org> Tue, 17 Apr 2007 19:45:51 -0500 + +vm (7.19-12) unstable; urgency=medium + + * Bug fix: "vm: Byte-compilation very slow under Emacs 22", thanks to + Tim Cross. This would be a low risk improvement for etch. + (Closes: #410492). + * Bug fix: "vm should depend on emacs21 *OR emacs-snapshot*", thanks to + Philippe Queinnec. I've decided to add emacs-snapshot to the + dependencies, since this is likely to be a more popular option as time + goes on. Also, the package already byte-compiles and otherwise fully + supports emacs22 (and emacs23, which is what I tend to use now), so + this is essentially bringing the control file up to speed. + (Closes: #398877). + * These two improvements now make emacs-snapshot a full status supported + version for VM. There is no code change -- the code already supported + emacs-snapshot, and is known to work. This just allows people to + uninstall emacs21 (without the control file change, one had to have + emacs21 and emacs-snapshot both installed for emqacs-snapshot to be + supported, which is rather silly. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 24 Feb 2007 10:10:53 -0600 + +vm (7.19-11) unstable; urgency=medium + + * Bug fix: "vm: purging the package fails (ucf unavailable)", thanks to + Bill Allombert (Closes: #389966). + + -- Manoj Srivastava <srivasta@debian.org> Fri, 29 Sep 2006 14:18:38 -0500 + +vm (7.19-10) unstable; urgency=low + + * Suggest stunnel, since we need something like that to provide secure + access to remote mail. + * Bug fix: "vm: please Recommend: or Suggest: stunnel", thanks to Daniel + Kahn Gillmor (Closes: #381066). + + -- Manoj Srivastava <srivasta@debian.org> Mon, 21 Aug 2006 21:53:47 -0500 + +vm (7.19-9) unstable; urgency=low + + * Split control file into two versions -- and select a control file + based on whether or not we have been instructed to build mime-codecs. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 27 Feb 2006 09:48:12 -0600 + +vm (7.19-8) unstable; urgency=low + + * Don't build mime-codecs any longer, due to several grave issues with + the code. Instead, document how people may use the perl one liners in + VM, thanks to Daniel Kahn Gillmor. + * Bug fix: "mime-codecs should be dropped", thanks to Manoj Srivastava + done. (Closes: #329683). + * Bug fix: "mime-codecs: base64-decode fails to properly decode many + valid base64-encoded files", thanks to Daniel Kahn Gillmor. Instead of + trying out the patch provided (thanks for that, it was appreciated), I + decided to instead drop the mime-codecs package entirely, since the + perl one liners can easily replace them -- and these modules are + already in perl, an essential package. (fixes: #338115). + * Bug fix: "mime-codecs: please support [file name] and [-o + outputfile]", thanks to Martin Michlmayr. We no longer ship + mime-codecs. (fixes: #213443). + * Bug fix: "vm: Skip byte-compilation when already done", thanks to + Peter S Galbraith (Closes: #338559). + + -- Manoj Srivastava <srivasta@debian.org> Sat, 3 Dec 2005 16:44:16 -0600 + +vm (7.19-7) unstable; urgency=low + + * Bug fix: "vm: doesn't use debconf for prompting", thanks to Lars + Wirzenius. Hmm. We don't even have a /usr/lib/emacs/site-lisp/site-start.el + anymore, and /etc/emacs/site-start.el has not mentioned vm-init since + at least 2002, and probably a lot longer than that. The chances of + someone still having a reference to vm-init in there are pretty low + --- and even then, it should be handled silently. This work around was + added in 1998; I doubt if such buggy systems still survive -- and if + people have cruft lying around since 1998, and are trying to install vm + after 7 years, well, there shall be issues. In any case, we still try + to fix things silently, and we still issue a diagnostic. I just don't + think this is worth a debconf note anymore. (Closes: #333297). + + -- Manoj Srivastava <srivasta@debian.org> Sat, 22 Oct 2005 00:15:10 -0500 + +vm (7.19-6) unstable; urgency=low + + * Fix a FTBS bug due to the changed behaviour of texi2html. Also, use + /usr/share/menu instead of /usr/lib/menu + * Bug fix: "vm-mime-Q-encode-region dies if region ends with newline", + thanks to Michael Ernst (Closes: #319821). + + -- Manoj Srivastava <srivasta@debian.org> Mon, 8 Aug 2005 11:28:22 -0500 + +vm (7.19-5) unstable; urgency=low + + * Bug fix: "vm: does not start vm: vm-mouse-install-mouse fails", thanks + to Daniel Martins. I am not sure why this works for me, but not for + the reporter -- but an autoload costs little, so add one to the init + function. (Closes: #309962). + + -- Manoj Srivastava <srivasta@debian.org> Sat, 9 Jul 2005 14:21:48 -0500 + +vm (7.19-4) unstable; urgency=low + + * Bug fix: "vm: Please do not discriminate against XEmacs", thanks to + Dirk Eddelbuettel. Well, back in the mists of time, VM was packaged to + be byte-compiled for XEmacs, but the XEmacs maintainer at that time + asked me to cease and desist. Times change, so that is reverted. + (Closes: #306876). + * Bug fix: "vm: purge doesn't", thanks to Ian Zimmerman. This should be + better. (Closes: #303519). + + -- Manoj Srivastava <srivasta@debian.org> Mon, 2 May 2005 23:57:59 -0500 + +vm (7.19-3) unstable; urgency=low + + * Bug fix: "vm: package description typo(s) and the like", thanks to + Florian Zumbiehl (Closes: #300050). + + -- Manoj Srivastava <srivasta@debian.org> Thu, 17 Mar 2005 20:10:30 -0600 + +vm (7.19-2) unstable; urgency=medium + + * vm-mime-display-external-generic does not quote spaces when calling + external commands -- and since VM does not use mailcap, but instead + uses vm-mime-external-content-type-alist, this fix is relevant. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 2 Nov 2004 14:32:58 -0600 + +vm (7.19-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New variables: + + vm-stunnel-program-additional-configuration-file + * added vm-mouse-send-url-to-safari to send URLs to Safari under + Mac OS X. + * added docstrings for vm-mime-reader-map-* commands. + * normalized prefix key description layout in vm-mode docstring. + * added some missing MIME commands to menu entries. + * undo change in vm-preview-current-message that required + vm-auto-decode-mime-messages to be non-nil along with + vm-display-using-mime before creating the presentation + copy of a message. It has the unexpected side-effect of + breaking 'D' when vm-auto-decode-mime-messages is nil. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 30 Sep 2004 16:08:43 -0500 + +vm (7.18-9) unstable; urgency=low + + * Removed the obsolete needs="dwww" menu entry. Now we use the + preferred doc-base method. + * Bug fix: "vm: Can't cycle among decoded/summary/raw views of MIME + messages", thanks to Reid Priedhorsky (Closes: #250559). + + -- Manoj Srivastava <srivasta@debian.org> Tue, 22 Jun 2004 23:38:50 -0500 + +vm (7.18-8) unstable; urgency=low + + * Bug fix: "vm: wrong path in README.debian.gz", thanks to Diego Biurrun + (Closes: #243377). + + -- Manoj Srivastava <srivasta@debian.org> Tue, 20 Apr 2004 13:51:42 -0500 + +vm (7.18-7) unstable; urgency=low + + * Bug fix: "silent error while loading 50vm-init.el", thanks to Jeff Nye + If vm-mime-default-face-charsets is unbound, set it to the default + value. (Closes: #241074). + + -- Manoj Srivastava <srivasta@debian.org> Fri, 2 Apr 2004 12:14:16 -0600 + +vm (7.18-6) unstable; urgency=low + + * Added 8859-15 to the list of charsets to display in the default face + in vm. Also added a short README about mime handling in VM. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 14 Mar 2004 13:21:00 -0600 + +vm (7.18-5) unstable; urgency=low + + * removed dependency relationship with emacs20 + * Bug fix: "vm: Please update Dependencies to exim4", thanks to Marc + Haber (Closes: #228596). + + -- Manoj Srivastava <srivasta@debian.org> Fri, 6 Feb 2004 03:17:03 -0600 + +vm (7.18-4) unstable; urgency=low + + * FTBFS: missing build-depends. Bah. The buildd's do not respect + Build-Depends-Indep. Duplicated the dependency into Build-Depends as a + workaround for this buildd flaw. (Closes: #224461). + + -- Manoj Srivastava <srivasta@debian.org> Tue, 23 Dec 2003 13:29:22 -0600 + +vm (7.18-3) unstable; urgency=low + + * Move to the new build system, and the new SCM system. Now the source + packages are full arch categories. + * Bug fix: "/usr/bin/qp-decode: say program name on error output", + thanks to Dan Jacobson. Do the same for base64-decode as well. + (Closes: #222580). + + -- Manoj Srivastava <srivasta@debian.org> Sat, 6 Dec 2003 00:28:22 -0600 + +vm (7.18-2) unstable; urgency=low + + * The last upload was corrupted. This is a major bugfix release. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 12 Nov 2003 23:15:14 -0600 + +vm (7.18-1) unstable; urgency=low + + * New upstream release. Excerpted changes: + * New variables: + + vm-default-new-folder-line-ending-type + * vm-mail-internal: use idle timers to run vm-update-composition-buffer-name + instead of post command hooks + * vm-decode-mime-layout: always delete a MIME object button after + doing a type conversion. + * vm-mail-send: bind coding-system-for-write to match the coding + system of mail-archive-file-name (if set) so that mail-do-fcc + writes to the file using the correct line endings. + * vm-make-tempfile-name, vm-make-tempfile: accept optional + second argument 'proposed-filename' which will be used if a + file with that name do not exist in vm-tempfile-directory. + If such a file exists, then a number and a dash will be prepended + to the proposed filename and the number will be incremented until no + such file exists. + * don't use vm-menu-fsfemacs-image-menu unless vm-use-menus is non-nil. + * vm-preview-current-message: require vm-auto-decode-mime-messages to + be non-nil along with vm-display-using-mime before creating the + presentation copy. This helps prevent selection of the presentation + buffer when the user likely needs to do M-x recover-file. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 11 Nov 2003 14:35:03 -0600 + +vm (7.17-1) unstable; urgency=low + + * New upstream. excerpted changes: + * New commands: + + vm-create-imap-folder + + vm-delete-imap-folder + + vm-rename-imap-folder + * vm-edit-message-end: try to positoin the cursor in the message + window roughly where it was in the edit window. + * vm-read-imap-folder-name: allow vm-imap-make-session to return + nil without crashing. Also, bind vm-imap-ok-to-ask non-nil so + that vm-imap-make-session will interactively prompt for a + password. + * added menu entry to Folder menu for vm-visit-imap-folder. + * vm-imap-normalize-spec: convert auth method to * instead of the + IMAP folder name. + * vm-imap-get-message-flags: fixed flag retrieval so that it + actually works now. + * vm-handle-file-recovery-or-reversion: find an IMAP spec for the + buffer so that the spec is passed to the 'vm' command instead + of the buffer-file-name. This fixes a wrong-type-argument + error under M-x recover-file when done on a IMAP cache folder. + * tapestry.el: in tapestery-window-edges check for existence of + face-width and face-height in addition to window-pixel-edges. + * search for BASE64/QP encoder/decoder programs and set the + encoder/decoder program variable based on what we find. + * vm-mf-default-action: if object is convertible to a displayble + type mention the conversion that will happen in the action + string. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 13 Jul 2003 15:57:12 -0500 + +vm (7.16-1) unstable; urgency=low + + * New upstream. excerpted changes: + * New commands: + + vm-visit-imap-folder + + vm-visit-imap-folder-other-window + + vm-visit-imap-folder-other-frame + + vm-save-message-to-imap-folder + * New variables: + + vm-imap-server-list + * vm-primary-inbox can now be a POP or IMAP mailbox specification. + * vm-mime-set-xxx-parameter: use the parameter name passed in + instead of assuming the name is "charset". The only calls to + this function passed in "charset" as the name, so this bug + wasn't affecting anything. + * vm-decode-mime-encoded-words: do charset conversion if needed. + Forgot to add this back when vm-mime-charset-converter-alist + was added. + * vm-send-mail-and-exit -> vm-mail-send-and-exit in vm-user-agent + definition. + * vm-mail-send-and-exit: dropped first arg requirement since the + argument isn't used anyway. + * compute POP cache filenames based on the POP mailbox spec with + the access method as "pop" and the authentication method and + port as asterisks. This prevents visiting the wrong file if + the user starts accessing a POP mailbox through a different + port or using a different access or authentication method. + Automatically migrate the old cache files to the new scheme as + we go. + * fixed convert -page typos. + * vm-set-redistributed-flag: fourth arg of vm-set-xxx-flag + call corrected to be vm-set-redistributed-flag instead of + vm-set-forwarded-flag. + * IMAP BYE responses are always untagged; changed code to match. + + + -- Manoj Srivastava <srivasta@debian.org> Tue, 27 May 2003 12:26:50 -0500 + +vm (7.15-1) unstable; urgency=low + + * New upstream. excerpted changes: + * Makefile: filter echo's output through tr to avoid CRs + under Cygwin. + * Makefile: Use '>' instead of '>>' on first write to vm-autoload.el + to truncate the file otherwise it will grow each time it is updated. + * vm-mime-attach-message: arrange for forwarded flag of each + attached message to be set when the composition is sent. + * vm-decode-mime-encoded-words: do charset conversion if needed. + Forgot to add this back when vm-mime-charset-converter-alist + was added. + * when cropping images call 'convert' with -page to avoid having + some kind of margin takcked on to the image. The strange + margin seems to be applied to GIFs but not JPGs. No idea why. + * fixed some defcustom variable declarations. + * vm-mime-reader-map-save-file: return the file name to which the object + was saved. + * vm-mime-burst-digest: remove blank lines at the beginning of + message/rfc822 bodies in a multipart/digest object, since they + most likely indicate an improperly packed digest rather than a + message with no headers. + * vm-make-tempfile: use vm-octal to clarify file mode setting. + * vm-make-image-strips: when building the script for incremental + display, don't quote the filenames. DJGPP cmdproxy.exe doesn't + interpret single quotes and using double quotes is pointless. + VM's arguments to 'convert' don't need quoting anyway. + * use vm-pop-check-connection to check POP connections before + trying to read data from them. The checker will signal an + error if the connection is closed or the process associated + with the connection has exited. + * use vm-imap-check-connection to check IMAP connections before + trying to read data from them, The checker will signal an error + if the connection is closed or the process associated with the + connection has exited. + + + -- Manoj Srivastava <srivasta@debian.org> Sun, 4 May 2003 01:52:45 -0500 + +vm (7.14-1) unstable; urgency=low + + * New upstream. excerpted changes: + * moved (provide ...) to bottom of .el files. + * Made the vm-undo command undo everything the last command did. + E.g. vm-undo after vm-kill-subject undoes all of the related + deletes instead of just one of them. vm-undo-boundary is only + called from vm-add-undo-boundaries now. vm-add-undo-boundaries + is called from post-command-hook. + + + -- Manoj Srivastava <srivasta@acm.org> Sat, 29 Mar 2003 00:07:15 -0600 + +vm (7.13-1) unstable; urgency=low + + * New upstream. excerpted changes: + * vm-pop-make-session: use new stunnel configuration code + introduced in VM 7.11. This was only installed in + vm-imap-make-session previously. + * create MIME layout from plist instead raw vector. layout strut + is still a vector. + * save original layout when doing a layout conversion so that if + the object needs to be deleted we still ahve the correct object + endpoint in the folder buffer. In the old code the endpoints in + the converted object buffer would be used in the folder buffer + with disastrous results. + * '(vm-marker -> (vm-marker in vm-mime-parse-entity. + + + -- Manoj Srivastava <srivasta@acm.org> Wed, 19 Mar 2003 22:59:38 -0600 + +vm (7.11-1) unstable; urgency=low + + * New upstream. excerpted changes: + * New variables: + + vm-mime-forward-local-external-bodies + * vm-mime-fsfemacs-encode-composition: if object is in a buffer, + write the buffer out to disk and insert the file contents instead + of copuying buffer to buffer. This avoids the trademark \201 + data corruption. + * vm-su-thread-indent: check for vm-summary-show-threads non-nil + before calling vm-th-thread-indentation. + * vm-summary-compile-format-1: added %(..%) format groups. + * don't forward Content-Length header. + * use results of CAPABILITY command to check for authentication methods + before trying to use them. + * use results of CAPABILITY command to decide whether to use + BODY.PEEK vs. RFC822.PEEK. + * vm-mime-attach-object-from-message: move window point to + beginning of the line after the inserted attachment if the + compositoin buffer is being displayed in a window. + * vm-mime-parse-entity-safe: set c-t-e to "7bit" if it is nil. + * vm-mime-fetch-url-with-programs: erase the work buffer between + tries of various URL fetch programs; this handles the case + where an URL fetcher outputs part of the data and then dies. + * added support for the `fetch' and `curl' URL fetch programs for + message/external-body. + * vm-mime-fsfemacs-encode-composition: call vm-mime-parse-entity + twice for already MIME'd objects. + vm-mime-xemacs-encode-composition similarly modified. + * vm-mime-fsfemacs-encode-composition: don't automatically + base64-encode non-composite non-text objects that already have + MIME headers. Use vm-mime-transfer-encode-layout on them + instead to produce the correct encoding. + vm-mime-xemacs-encode-composition similarly modified. + * dropped support for url-w3 retrieval method. It's interface too + crusty to continue using given the wide availabity of external + programs that do the job. + * vm-mime-display-internal-message/external-body: pulled + retrieval guts out and put into vm-mime-retrieve-external-body. + * added support for simple image manipulations, supported by + Imagemagick's `convert' program. Use mouse button 3 on an + image to see what you can do. + * added Konqueror to vm-menu-url-browser-menu. + * added option to send to the X clipboard to vm-menu-url-browser-menu. + * vm-menu-url-browser-menu: add third element to clipboard and + Konqueror entries--- VM's menu code under GNU Emacs requires it. + * treat device-type `gtk' like `x' under XEmacs so that + VM running on GTK-XEmacs will use window system features. + * vm-imap-move-mail: set use-body-peek after retrieving the + CAPABILITY results. (oops) + * Makeflie: default install target now installs the .el files. + * added support for version 4 of stunnel. + * fixed check for usability of uncompface's -X flag, needed + symbol to be unquoted. + * fixed check for stunnel 4, check for non-zero exit code instead + of string, moved check to the time when stunnel is first run. + * vm-stunnel-configuration-args: fixed reversed v3/v4 logic. + * vm-stunnel-configuration-file: reuse the stunnel configuration + tempfile. + * vm-parse: fourth arg limits the number of matches before + returning. + * vm-parse: after we quit matching add everything after the last + match to the list that is returned, but do this ONLY if the + fourth arg 'matches' was specified. + * compute POP cache filenames based on the POP mailbox spec with + the password as an asterisk. This prevent visiting the wrong + file if the user has the password in the spec and later changes + their password. Automatically migrate the old password-based cache + files to the new scheme as we go. + * vm-pop-make-session: parse POP mailbox spec in a way that + permits colons in the user's password. + * install .el files before .elc files to avoid "source file newer + than compiled file" problems. + * added ] to char class exclusion in mailto spec in vm-url-regexp + to help with MS EXchange's [mailto:foo] syntax. + + -- Manoj Srivastava <srivasta@acm.org> Thu, 13 Mar 2003 09:22:46 -0600 + +vm (7.08-2) unstable; urgency=low + + * Suggest mime-codecs. closes: Bug#181776 + + -- Manoj Srivastava <srivasta@acm.org> Thu, 20 Feb 2003 11:02:50 -0600 + +vm (7.08-1) unstable; urgency=low + + * New upstream. excerpted changes: + * New variables + + vm-mime-ignore-missing-multipart-boundary + + vm-url-browser-switches + * vm-mime-attach-object-from-message: decode object after stuffing it + into the work buffer. Two reasons: (1) the composition encoding + code doesn't expect base64 or QP encoded objects and will encode + them again, and (2) we shouldn't trust that the original object was + encoded properly so we should re-encode it since we're sending it. + * vm-mime-display-internal-multipart/alternative: a badly formed + mesage may cause VM to find no message parts so don't call + vm-decode-mime-layout unless best-layout is non-nil. + * vm-su-subject: compress \n[ \t]* to a single space. + * README: Added (vm) to the example VM entry in the 'dir' file. + Apparently the old entry won't work without it anymore. + * vm-mime-parse-entity-safe: error/error MIME layout needs to be + length 16; added a nil. Really need to macroize creation + of the layout object someday. + * vm-recover-file: call recover-file with call-interactively + instead of apply. + * vm-revert-buffer: call revert-buffer with call-interactively + instead of apply. + * vm-decode-mime-layout: check if layout has been converted + and don't try to convert it again if so. + * vm-vs-or, vm-vs-and: check existence of selector function and + signal error if not found. + * vm-md5-region: accept " -" and " *-" before the md5 checksum + because md5sum stupidly produces extra output on some systems. + * vm-imap-end-session: trying reading the response to the LOGOUT + command and see if we start hanging in some environments. + * vm-imap-make-session: don't query for passwor dif the + authentiation method is "preauth". + * vm-visit-virtual-folder: select the message corresponding to + the real message the user used as a basis for this folder, if + there was one. Only honor the vm-jump-* variables if + there's no correspoinding real message to use. + * vm-compose-mail: run mail-citation-hook or mail-yank-hooks or + the normal VM default action after yanking the message text. + Always position point in the body before running the yank + action. Don't assume the yank action is smart enough to + position point correctly before inserting the text. + * vm-recognize-imap-maildrops,vm-recognize-pop-maildrops: changed + regexp to allow colons in the last field. + * dropped single quotes in const choice values in defcustom for + vm-mime-alternative-select-method. + * Makefile: use \015 instead of \r with tr due to bug in Solaris + 8's tr which removes r's. + * vm-get-mail-itimer-function: correct use of timer-set-time; set + new firing time to now + vm-auto-get-new-mail instead of now + with a delta of vm-auto-get-new-mail, to avoid having + the timer expire repeatedly in the same second. Similar change + in vm-check-mail-itimer-function which support vm-mail-check-interval. + Similar change in vm-flush-itimer-function which supports vm-flush-interval. + * vm-decode-mime-message: vm-preview-read-messages -> + vm-preview-lines so that message previewing is turned off for + the 'raw' and 'all buttons' displays. + * vm-mail-send: bind select-safe-coding-system-function to nil + during call to mail-send to prevent Emacs from prodding user + about the FCC coding system. The coding system used should be + raw-text and VM sets buffer-file-coding-system to that. + * vm-stuff-attributes: don't clear modflag if stuffing for another + folder, since the information stuffed in that case is missing + the deleted flag if that flag was set. + * use defconst to set vm-faked-defcustom so that the checking + works correctly if vm-vars.el is loaded twice. + * vm-mime-parse-entity: find multipart boundaries, then recurse + into parts. This satisfies the new rule in RFC 2046 that outer + level multipart boundaries be recognized at any level of inner + nesting. + * vm-mime-send-body-to-file: removed let-binding of variable file + which was shadowing the function parameter of the same name. + This should make the function not ask about a filename even + when one has already been provided. + * define vm-folder-history as a function that returns t so that + when it is passed as the sixth arg to read-file-name under + Emacs 21 it does not cause void-function to be signaled when + completion is attempted. + * vm-mime-send-body-to-folder: force conversion to target folder's + type since the user doesn't know what type we're using in the + temp folder. + * vm-save-message: dno't try to honor vm-delete-after-saving if + the folder is read-only. + * vm-delete-duplicate-messages: compute hash on real folder + contents rather than virtual copy. Fixes utterly brokwn + behavior when run on a virtual folder. + + + -- Manoj Srivastava <srivasta@acm.org> Mon, 17 Feb 2003 21:35:00 -0600 + +vm (7.07-5) unstable; urgency=low + + * Remove old emacs19 directory closes: Bug#179682 + + -- Manoj Srivastava <srivasta@debian.org> Mon, 10 Feb 2003 10:03:46 -0600 + +vm (7.07-4) unstable; urgency=low + + * Make sure ucf database is cleaned up on purge + + -- Manoj Srivastava <srivasta@debian.org> Sun, 10 Nov 2002 22:03:39 -0600 + +vm (7.07-3) unstable; urgency=low + + * Make sure the log file is user readable closes: Bug#167791 + + -- Manoj Srivastava <srivasta@debian.org> Wed, 6 Nov 2002 03:20:07 -0600 + +vm (7.07-2) unstable; urgency=low + + * Also install vm.html closes: Bug#161086 + * Make sure that the uncompiled .el files are still in the load-path, + though close tothe end. closes: Bug#155043 + + -- Manoj Srivastava <srivasta@debian.org> Tue, 29 Oct 2002 18:09:05 -0600 + +vm (7.07-1) unstable; urgency=low + + * Use which, not command -v. + * New upstream. excerpted changes: + * vm-sort-messages: move first call of + vm-update-summary-and-mode-line out to callers. Threading boks + if we call it in here. + * vm-assimilate-new-messages: resume calling + vm-update-summary-and-mode-line to clear the decks before + thread sorting. + * vm-toggle-threads-display: start calling + vm-update-summary-and-mode-line to clear the decks before + thread sorting. + * vm-save-folder,vm-write-file: support + vm-default-folder-permission-bits here, + since a folder might be created when it is saved. + * vm-save-message,vm-save-message-sans-headers: use the target + folder's line ending coding system for saves. If the target + doesn't exist use the local system's default. + * vm-write-string: don't set an explicit coding system for writes, + use the ambient value. + * vm-sort-messages: call vm-update-summary-and-mode-line to clear + the decks before sorting. + * vm-mail-internal: UNder FSF Emacs set the coposition buffer + coding system to 'raw-text' which should stop write-region from + question the coding system inside mail-do-fcc. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 13 Jun 2002 15:40:00 -0500 + +vm (7.05-1) unstable; urgency=low + + * New upstream bug fixing release. Excerpted change: + * New variables: + + vm-default-folder-permission-bits + * Makefile: added install-el target. + * always set mode-popup-menu; it's value should not depend on the + value of vm-popup-menu-on-mouse-3. + * vm-stuff-folder-attributes: added status messages. + * vm-mime-discard-layout-contents: call vm-set-modflag-of on the + modified message. + * vm-preview-composition: add a newline at end of the preview + buffer if the composition lacks one. + * vm-url-decode-buffer: fixed brain-o; bind case-fold-search to t + instead of nil. + * use new vm-octal function instead of writing out UNIX permission + bits in decimal. + * defcustom :type fixes. + * added "image" to default value of vm-auto-displayed-mime-content-types. + * vm-mime-should-display-internal: ignore Content-Disposition as + it has no bearing on whether an object is displayed internally. + * vm-assimilate-new-messages: build threads very early if + vm-summary-show-threads is non-nil. Don't run + vm-update-summary-and-mode-line before sorting threads--- this + should no longer be necessary thanks to the change to to + vm-set-numbering-redo-start-point. + * vm-set-numbering-redo-start-point: compare message structs + instead of list conses. + * vm-unthread-message: only unthread if threads have been built + in a particular message's buffer. + * vm-thread-list: keep track of the youngest member of a thread. + * vm-sort-compare-thread: sort threads by youngest member instead + of by oldest member. Also sort thread siblings by date instead + of by message-id; sort by messge-id if dates are equal (rare). + + -- Manoj Srivastava <srivasta@debian.org> Sun, 12 May 2002 23:13:27 -0500 + +vm (7.04-2) unstable; urgency=low + + * Override the lintian warning about postinst not setting user doc link + for mime codecs. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 22 Apr 2002 08:44:00 -0500 + +vm (7.04-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New commands: + + vm-mime-attach-object-from-message (bound to $ a) + * New variables: + + vm-mime-ignore-composite-type-opaque-transfer-encoding + * fixed problem with a repeated char being displayed after an + X-Face when a non-MIME message is reselected. + * Makefile: remove CRs from the output of make-autoloads. Emacs + when run under Cygwin apparently emits them. + * vm-session-initialization: create gui-button-face under XEmacs + if it does not exist. + * vm-mime-display-internal-text/html: don't use W3 if + vm-mime-use-w3-for-text/html is nil. + * recognize 'mac' as a window system with mouse, image, and + multi-font support (FSF Emacs only). + * put vm-update-composition-buffer-name on post-command-idle-hook + instead of post-command-hook if the idle hook is available for + use. + * vm-menu-vm-menu: added commas to variable refernece so they + would be evalled in the backquote context. + * changed hook defcustoms to use 'hook instead of '(list function). + * vm-read-index-file: do thread sort if necessary since + vm-assimilate-new-messages isn't going to do it. + * default vm-thread-obarray and vm-thread-sort-obarray to non-nil + values so that if they are used as obarrays before + initialization an error will be signaled. + * vm-mime-pipe-body-to-queried-command: prompt with "Pipe object + to command:" instead of "Pipe to command:". + * make sure select-message-coding-system is fbound before overriding + its definition. Apparently early Emacs 20 versions do not define + it. + * vm-imap-read-object: move point past closing double quote to + fix parsing problem that caused VM to hang. + * vm-mime-display-button-xxxx: always insert the button, even we + have no method for displaying the MIME object. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 21 Apr 2002 04:46:16 -0500 + +vm (7.03-1) unstable; urgency=low + + * fixed defcustom syntax errors. + * minor compiler error cleanup. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 6 Mar 2002 00:46:29 -0600 + +vm (7.01-5) unstable; urgency=low + + * debian-pkg-add-load-path-item apparently does not add the item to the + load path. This is different from the test function that Sam wrote, + and thuis the load-path was not set. Unfortunately, this bug was + masked on my box since emacs21 happily searches subdirs. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 20 Feb 2002 02:34:21 -0600 + +vm (7.01-4) unstable; urgency=low + + * Preserve user changes in the site-start.d file. Also, do not delete + the start file when removed, only when purged. This also requires that + the start file do nothing when the package has actually been removed. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 13 Feb 2002 22:41:26 -0600 + +vm (7.01-3) unstable; urgency=low + + * With smtpmail in modern emacsen, we do not depend on external MTA's. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 2 Feb 2002 20:30:27 -0600 + +vm (7.01-2) unstable; urgency=low + + * Conform to the latest emacs policy about laod paths. + + -- Manoj Srivastava <srivasta@debian.org> Fri, 1 Feb 2002 15:35:51 -0600 + +vm (7.01-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New variables: + + vm-mime-use-w3-for-text/html + * new possible values for vm-mime-alternative-select-method: + (favorite ...) and (favorite-internal ...). + * vm-visit-pop-folder: use value of vm-last-visit-pop-folder if + interactive user entered an empty string as the folder. + * vm-mail-send: bind sendmail-coding-system to the binary coding + system and bind mail-send-nonascii to t so that mail-send will + leave us alone. + * redefine select-message-coding-system if it is fbound and we're + running FSF Emacs MULE. It doesn't like no-conversion as a + coding system, so we get it out of the way. + * define vm-image-too-small properly as an error condition. + * vm-scroll-forward-one-line, vm-scroll-backward-one-line: accept + a numeric prefix arg. + * vm-setup-ssh-tunnel: use copy-sequence on vm-ssh-program-switches + to avoid corrupting the list tail with nconc. + * vm-mime-can-convert-0: always return the conversion that + produces an internally displayable type if there is one. + Fallback to the externally displayable type if there is none + that can be displayed internally. + * vm-mime-can-convert-0: don't return a match when the target + type matches the original type. + * vm-mime-display-internal-image-xemacs-xxxx: wrap image extents + around spaces instead of newlines. Adjust newline insertion + code accordingly. Create image strips twice the default font + height to avoid having to match the font ascent value. Don't + use vm-monochrome-face except on XBM images. + * vm-display-image-strips-on-extents, + vm-display-some-image-strips-on-extents: Don't use + vm-monochrome-face except on XBM images. + * support completion-ignore-case variable. + * block interactive use of vm-expunge-pop-messages in a POP + folder. It's meant for folder linked to POP spool files, not + POP folders. + * use display-planes function to determine if Emacs 21 is running + on a "colorful" display. + * put image/xpm ahead of image/pbm in vm-mime-image-type-converter-alist. + * vm-parse-date: find year even if it's at the end of line. + + + -- Manoj Srivastava <srivasta@debian.org> Thu, 24 Jan 2002 20:26:03 -0600 + +vm (7.00-1) unstable; urgency=low + + * Add a patch from Ian Jackson that creates a new interactive virtual + folder selector `sexp', which prompts for an string, asking for an + S-expression. You type in a string, which gets turned into a LISP + object with `read', and used as the actual selector. closes: Bug#122450 + * New upload fixes image display bug for emacs21. closes: Bug#123990 + * New upstream version. Excerpted changes: + * New commands: + + vm-visit-pop-folder + + vm-visit-pop-folder-other-window + + vm-visit-pop-folder-other-frame + * New variables: + + vm-pop-folder-alist + + vm-pop-folder-cache-directory + * vm-parse-date: fixed search to allow monthday digits to occur + at the beginning of a string. + * vm-get-mail-itimer-function: skip buffer if bm-block-new-mail + is set. This avoids vm-get-spooled-mail signaling "can't get + new mail until you save this folder" later. Also check for + mail block and folder read-only before doing the expensive file + stat checks. + * vm-get-image-dimensions: don't search for the filename in + the 'identify' output. Apparently 'identify' will sometimes + substitute a different filename than we expect. Instead + just search for a space and then start looking for the image + dimensions from that point. + * moved setting of vm-folder-type in the POP trace buffer from + vm-pop-move-mail to vm-pop-make-session so that all callers get + of vm-pop-make-session get the feature. + * vm-assimilate-new-messages: check for new-messages non-nil + before attempting some things. Makes the function a bit more + efficient if we call it and no new messages are found. + * vm-pop-report-retrieval-status, + vm-imap-report-retrieval-status: report "post processing" if + 'need' value is nil. + * vm-pop-retrieve-to-crashbox -> vm-pop-retrieve-to-target + * vm-imap-retrieve-to-crashbox: use new "post processing" reporting. + * vm-pop-retrieve-to-target: use new "post processing" reporting. + * vm-expunge-pop-messages: record which messages were expunged by + stuffing nil into the car of the cell in vm-pop-retrieved-messages. + At the end strip out all the nils, leaving the data for messages + that we had problems expunging from the POP server. + * in vm-stuff-* functions check for vm-message-list non-nil + instead of vm-message-pointer. + * vm-pop-end-session: check whether the process is still open or + running before attempting to send the QUIT command. Also check + whether the process buffer is still alive before killing it. + * vm-get-spooled-mail: gutted, with most of it going into + vm-get-spooled-mail-normal. Calls vm-pop-synchronize-folder + for folders that use the POP access method. + * vm-session-initialization: when deciding whether to create the + vm-image-placeholder face check for image-type-available-p + being fbound, not vm-image-type-available-p. + * use <vm-image-face> instead of <face> as the name of the faces + used to display images under Emacs 19 and 20. + * vm-mime-display-internal-image-xemacs-xxxx: insert a newline + before the image if point is at the same position as the + beginning of the text portion of the message. Otherwise + there is no visible separation between the image and the + message headers. + * vm-pop-report-retrieval-status, + vm-imap-report-retrieval-status: record in the statblob the fact + that some status was reported. + * vm-pop-stop-status-timer, vm-imap-stop-status-timer: if any + status was reported, do (message "") to clear the echo area. + + + -- Manoj Srivastava <srivasta@debian.org> Sun, 16 Dec 2001 22:55:56 -0600 + +Old Changelog: + +vm (6.98-1.0.1) unstable; urgency=low + + New feature: + * Interactive vm-create-virtual-folder has a new selector type `sexp' + which lets you type in a selector of your own as a LISP expression + (which will not be eval'd). Eg, + V C sexp RET (not (header "X-RBL-Warning")) RET + + -- Ian Jackson <ian@davenant.greenend.org.uk> Tue, 4 Dec 2001 20:43:32 +000 + +vm (6.99-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New commands: + + vm-scroll-forward-one-line + + vm-scroll-backward-one-line + * New variables: + + vm-imagemagick-identify-program + + vm-mime-display-image-strips-incrementally + * vm-do-folders-summary: bind default-directory to the directory + names when checking for subdirectories amongst its children + with vm-delete-directory-names. + * vm-get-image-dimensions: use the ImageMagick program 'identify' + instead of 'convert' to get the image dimensions. + * vm-thread-list: set done to t if we've run out of references + and we're not threading by subject (vm-thread-using-subject == + nil). Fixes infloop. + * use the vm-monochrome-image face for image glyphs instead of vm-xface + under XEmacs. + * use a face with a background stipple (vm-image-placeholder) + on the spaces used to display images in FSF Emacs 19. + * vm-display-image-strips-on-overlay-regions: store modified + flag value after the process buffer is selected, otherwise + we're recording the state of the wrong buffer. + * vm-mime-display-internal-image-fsfemacs-21-xxxx: If the image + strip is the same height as the font the image ascent ratio + must match font ascent ratio else the image strips will be + displayed with gaps between them. There's currently no way to + get font ascent information under Emacs 21. Use strips that + are twice the font height and a 50/50 ascent ratio to avoid + this problem. + * vm-make-image-strips: remainder math was wrong, fixed Use new + remainder math in the sync branch. Use vm-make-tempfile + instead of vm-make-tempfile-name. + * when cutting images into strips give 'convert' an explicit + target type. Otherwise it might choose some unknown new type + that Emacs can't display. + * vm-parse-date: simplified the search for the monthday and the + year, hopefully reducing the problems with confusing 2-digit + years and monthdays. + * vm-thread-list: check and set 'oldest-date property on all the + messages. + * vm-mail-internal: eval the value of mail-signature and insert + the result if its value is not nil, t or a string. Also, if + mail-signature is a string, subject the result to the same + check for a proper signature separator. + * The new sources are actually in the package. closes: Bug#120476 + * Also set vm-image-directory to the images location closes: Bug#120494 + + -- Manoj Srivastava <srivasta@debian.org> Sat, 1 Dec 2001 20:37:41 -0600 + +vm (6.98-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New variables: + + vm-mime-use-image-strips + + vm-imagemagick-convert-program + + vm-mime-charset-converter-alist + * inline image display support for Emacs 19 and Emacs 20. + * vm-md5-region: deal with the " -\n" that md5sum appends to the + checksum output when summing stdin. + * vm-edit-message: set buffer-offer-save to t so that if user + types C-x C-c they won't lose their changes in the message edit + session without warning. + * vm-spool-files: remove any directories from vm-spool-files + that we slurped from environmental variables. There was a case + where a user's MAIL variable was set to /var/mail. I don't know + how widespread this practice is. + * when initializing vm-temp-file-directory check for C:\TEMP + before C:\. + * vm-setup-ssh-tunnel: instead of sleeping for a bit and hoping + that's long enough to establish a connection, read some output + from the tunnel before returning so we know that the connection + is established. vm-ssh-remote-c0mmand has to provide the output, + so its default value has been changed to produce output. + * vm-frame-loop: don't reset the starting frame placeholder unless + the starting frame was really deleted. Fixes an infloop when + quitting out of VM and the VM summary is visible in multiple + frames. + * try to use the ImageMagick 'convert' program (if available) to + convert image types that Emacs can't display internally into + images that Emacs can display. + * support the unregistered image/xbm, image/xpm and image/pbm + types, so that we can autoconvert unsupported image types to + these types under an Emacs that's compiled with minimal image + support. + * use w3m to retrieve URLs if specified in vm-url-retrieval-methods. + * make layout cache be the property list of a symbol instead of + an alist. + * use vm-make-tempfile in more places to produce private tempfiles + instead of vm-make-tempfile-name. + * vm-preview-composition: mnuge message separators that appear in + the message body. Use MMDF for the temp folder type. + * all your base no longer are belong to us. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 20 Nov 2001 09:34:36 -0600 + +vm (6.97-3) unstable; urgency=low + + * Fixed minor typo in the long description. closes: Bug#118770 + + -- Manoj Srivastava <srivasta@debian.org> Tue, 13 Nov 2001 15:15:13 -0600 + +vm (6.97-2) unstable; urgency=low + + * vm now allows emacs21 to fill the dependency. closes: Bug#117664 + + -- Manoj Srivastava <srivasta@debian.org> Fri, 2 Nov 2001 02:42:47 -0600 + +vm (6.97-1) unstable; urgency=low + + * Added emacs21 to the list of known emacsen (I ahve beeen using it + with the pre releases) + * Fixed typo in description. closes: Bug#115819 + * Remove files created on the fly as well. closes: Bug#117140 + * New upstream version. Excerpted changes: + * New variables: + + vm-mime-require-mime-version-header + * SSL support for IMAP and POP. + * SSH tunnel support for IMAP and POP. + * uninstall toolbar goop from vm-mode-map under FSF Emacs if we're + creating a frame and vm-use-toolbar is nil. + * don't use a heuristic background map in the toolbar image spec + for the MIME icon. + * vm-make-tempfile-name: add a random elemnt to VM's temporary + file name. + * vm-pop-cleanup-region, vm-imap-cleanup-region: don't emit + CRLF->LF status messages. Say something about post-processing + in the normal status message instead. + * vm-mail-to-mailto-url: do session initialization stuff so that + the function can be called from gnuclient. This is apparently + useful for driving VM from a web browser that allows use of an + external mailer. + * vm-mime-encode-composition: undo buffer changes if an + error occurs during encoding. + * rename certain composition buffers on the fly as the recipient + headers change to reflect the new primary recipient(s). + * vm-submit-bug-report: call vm-session-initialization so the all + necessary goop is loaded, rather than doing a few 'require' + calls. This fixed the bug in the VM XEmacs package where + calling vm-submit-bug-report immediately after starting XEmacs + would cause (void-function vm-display) to be signaled. + * vm-th-parent: when extracting the parent message ID from the + In-Reply-To header, use the longest ID found, instead of the + first ID found. Store the result in the references slot in the + message struct, since that slot must be empty otherwise we + would be ignoring In-Reply-To. + * vm-thread-list: remove the clock skew loop-recovery-point + heuristic; seems to cause more breakage than it fixes. + * vm-mime-display-internal-image-fsfemacs-xxxx: use a unibyte buffer + as a work buffer when unpacking an image file. Apparently needed + to avoid the evil \201 corruption under Emacs 21. + * accept 'name' parameter as suggested filename for all MIME + types. Old broken software that sends this stuff will never go + away and complaints about it will never end. + * default vm-use-lucid-highlighting non-nil only if (require + 'highlight-headers) doesn't signal an error. + * vm-md5-region: call the MD5 program directly instead of using + sh -c. + * vm-pop-md5: call the MD5 program directly instead of using + sh -c. + * vm-check-for-spooled-mail, vm-get-spooled-mail: bind + case-fold-search to nil for comparisons against vm-recognize-*. + + + -- Manoj Srivastava <srivasta@debian.org> Mon, 29 Oct 2001 10:56:17 -0600 + +vm (6.96-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * print-autoloads: handle fset calls. There are paths through + the code that reach functions that are to be defined by fset + but lack autoload definitions. print-autoloads now creates + autoload definitions for them. + * vm-mime-encapsulate-messages: pluralization fix in MIME digest + preamble. Don't output "messages" if there's only one message in + the digest. + * vm-display-startup-message: update copyright date. Use + \251 under XEmacs to show the c-in-circle copyright glyph. + Can't rely on FSF Emacs being setup to display it. + * vm-mime-display-internal-application/octet-stream: honor + setting of vm-mime-delete-after-saving. + * vm-imap-move-mail: don't emit warning messages if BODY.PEEK + fails--- no one cares. Don't retry BODY.PEEK after it fails + the first time, it will never work. Use RFC822.PEEK henceforth + within this IMAP session. + * vm-toolbar-support-possible-p: check whether the variable + tool-bar-map is bound. Apparently tool-bar-mode is fboun + even when there is no toolbar support (e.g. under Windows). + * moved guts of vm-discard-cached-data to vm-discard-cached-data-internal. + * vm-mime-attach-message: corrected prompt in the "attach from + other folder" case. + * vm-summary-sprintf: decode encoded words in the final string if + we're not producing a tokenized result and vm-display-using-mime + is not nil. + * vm-mail-to-mailto-url: support full RFC2368 mailto URL spec. + * vm-pop-send-command: use one process-send-string call instead + of two, which should saves some packet overhead at the + expense of more string consing. + * vm-imap-send-command: use one process-send-string call instead + of three, which should saves some packet overhead at the + expense of more string consing. + * vm-imap-send-command: allow sending a string without a tag. + Also allow sending a string with a caller specified tag. + * vm-imap-make-session: don't send a tag with the CRAM-MD5 + challenge response. + * vm-do-summary: reuse the mouse-track overlays if possible, + instead of generating a new one each time. The old ones + apparently are never reclaimed by Emacs until the buffer is + killed and degrade editing performance in that buffer. + * vm-imap-ask-about-large-message: require simple "OK" response + after fetching headers instead of "OK FETCH". The "FETCH" part + may never come and isn't required. + * vm-save-folder: sweep though virtual folder associated with the + real folder and set their buffer modified flags to nil if they + are none of their real folders are modified. + * vm-thread-list: don't the first and last element of a multielement + thread list to be the same message-ID. This is a thread loop that + previously was previously undetected. + * vm-thread-list: remember the position in the thread list where + we first threaded using subject information and reset the + thread list to that point if we encountered a message ID we've + seen before. This is a heuristic to try to trim off + parents-by-subject that are only parents due to clock skew. + + + -- Manoj Srivastava <srivasta@debian.org> Sat, 8 Sep 2001 01:52:17 -0500 + +vm (6.95-1) unstable; urgency=low + + * Fixed the info install and remove sectrions for vm. closes: Bug#106847 + * New upstream version. + * Excerpted changes: + * New variables: + + vm-mime-attachment-auto-suffix-alist + * vm-guess-digest-type: require a line consisting of 30 dashes in + addition to the 70 dashes line before guessing RFC 1153. + * vm-md5-region: add third arg that prevents re-search-forward + from signalling an error if it fails. + * vm-toolbar-update-toolbar: don't use the 'getmail' icon + as the helper button if 'getmail' is already on the toolbar. + * vm-toolbar-update-toolbar: don't use the 'mime icon + as the helper button if 'mime' is already on the toolbar. + * vm-mime-attach-message: if invoked on marked messages (C-c C-v + M N C-c C-m) attach the marked messages in the parent folder as + a digest. + * vm-mail-mode-remove-tm-hooks: remove global TM/SEMI hooks from + mail-setup-hook and mail-send-hook if vm-send-using-mime is + non-nil. Previously VM tried to remove the hooks locally but + that doesn't work. + * fixed negative Content-Length computation problem + - vm-find-leading-message-separator, + vm-find-trailing-message-separator: new type 'baremessage + means go to point-max. + - vm-pop-retrieve-to-crashbox, vm-imap-retrieve-to-crashbox: use + 'baremessage as old type during header conversion. Narrow to + region around message during this conversion so that folder + traversal functions can safely go to point-max without moving + past the end of the message. + * vm-pop-make-session, vm-imap-make-session: don't sleep for 2 + seconds after reporting a bad password unless the function was + called synchronously, i.e. not from a timer. + * vm-check-mail-itimer-function, vm-get-mail-itimer-function, + vm-flush-cached-data: when traversing the buffer list, check + whether a buffer is still alive before selecting it. Because + the loop calls input-pending-p, a timer or process-filter could + have killed one of the buffers. + * vm-delete-duplicate: remove duplicate addresses case + insensitively This is still sort of wrong, in that the only + the right hand side of the address should be treated this way. + But doing the right thing is hard. + * vm-mime-display-internal-image-xemacs-xxxx: make the image + extent be 'start-open' so that it is moved forward when text is + inserted at its position. This fixes the image doubling + problem if a mssage containing only an image is previewed with + vm-mime-deocde-for-preview set non-nil. + * vm-narrow-for-preview: added kludge to prevent images and button + art from being displayed at the edge of a preview cutoff during + MIME decode-for-preview. Everything beyond the cutoff is shifted + forward one character during MIME preview. (XEmacs only for now, but + might be needed for FSF Emacs 21). + * vm-mime-encapsulate-messages, vm-rfc934-encapsulate-messages, + vm-rfc1153-encapsulate-messages: do a better job of protecting + MIME headers. Sort the MIME headers to the top of the message + then skip past them before applying the user's header filter + variables. + + + -- Manoj Srivastava <srivasta@debian.org> Mon, 30 Jul 2001 13:10:01 -0500 + +vm (6.94-2) unstable; urgency=low + + * Remove cross pollution between vm and mime codecs. closes: Bug#106032 + * Updated the long description to be in line with the current state of + VM documentation: up to date. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 22 Jul 2001 23:37:54 -0500 + +vm (6.94-1) unstable; urgency=low + + * New upstream version. + * Excerpted changes: + * in the defconst of vm-menu-mime-dispose-menu, check whether a + non-string s-expression is allowed as a menu element name + before trying to use one. Versions of XEmacs prior to 21.4 + don't allow expressions as item names. + + -- Manoj Srivastava <srivasta@debian.org> Fri, 13 Jul 2001 12:28:07 -0500 + +vm (6.93-1) unstable; urgency=low + + * New upstream version. + * Excerpted changes: + * New variables: + + vm-folder-file-precious-flag + * added CRAM-MD5 as an authentication method for IMAP. + * vm-su-do-date: interpret 2-digit years in the RFC-822 matching + case as 20XX if year starts with 0-6. + * vm-rfc1153-or-rfc934-burst-message: skip spaces in addition to + newlines that occur after a separator line. A digest has been + observed with that kind of deformity. + * treat enable-local-eval as we do enable-local-variables--- always + bind it to nil. + * vm: don't bind vm-auto-decode-mime-messages non-nil during + initial message preview if it is nil. + * vm-mime-display-internal-text/html: dropped (sleep-for 2). No one + cares enough about the "Need W3 to inline HTML" message to wait 2 + seconds afterward. + * added menu entry to allow MIME objects to be converted to + another type and displayed. The new type is determined by + vm-mime-type-converter-alist. + * added koi8-r to vm-mime-mule-charset-to-coding-alist (XEmacs only). + * vm-pop-read-list-response: check for nil return of + vm-pop-read-response before using return value. + * vm-pop-read-stat-response: check for nil return of + vm-pop-read-response before using return value. + * vm-encode-coding-region: use unwind-protect to make sure (well + more likely) that the work buffer always gets killed if it has + been created. + * vm-decode-coding-region: use unwind-protect to make sure (well + more likely) that the work buffer always gets killed if it has + been created. + * vm-mime-convert-undisplayable-layout: put object buffer on + garbage list sooner to make rarer the situation where the + buffer never gets deleted. + * Makefile: remove function definition of vm-its-such-a-cruel-world + after it is run. + * vm-md5-region: if vm-pop-md5-program exits non-zero, signal an + error. Also if the work buffer is not at least 32 bytes long, + signal an error. This prevents naive callers from assumption all + is well and using a possibly empty string as an MD5 hash. + * vm-md5-region: check the MD5 digest returned for non-hex-digit + characters and signal an error if any are found. + * vm-get-file-buffer: use find-buffer-visiting if it is fbound. + * vm-build-threads: fixed loop that removed child messages from a + parent when better information about a child's parent is found. + Previously the loop attempted to remove the same message from + the parent over and over. + * vm-build-threads: gather thread data using References and + In-Reply-To for all messages before using the Subject header. + This helps prevent the case where References says A is the + parent of B but because of clock skew B is older than A, which + can lead to B being considered the parent of A if A and B have + the same subject and vm-thread-using-subject is non-nil. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 4 Jul 2001 14:31:49 -0500 + +vm (6.92-1) unstable; urgency=low + + * New upstream version. This version fixes the problem with attachments, + closes: Bug#93447, Bug#86066 + * No longer depend on emacs19. closes: Bug#82679 + * Excerpted changes: + * vm-imap-check-mail: throw to 'end-of-session instead of 'done. + Fixes problem of vm-spooled-mail-waiting not being set. + * vm-su-do-recipients: If there is no To or Apparently-To header, + use Newsgroups if available. + * vm-mime-display-external-generic: use a unibyte temp buffer for + base64 decoding if using FSF Emacs MULE. Otherwise our old + friend \201 crashes the party. + * vm-mime-find-leaf-content-id-in-layout-folder: add missing + layout argument to vm-mime-find-leaf-content-id. + * vm-mime-parse-entity: fixed regexps that match an empty content + description so that they match descriptions that only contain + spaces. + * vm-su-do-date: make +/- mandatory in the numeric tiemzone spec. + First digit of numeric timezone spec must be 0 or 1. + * vm-fill-paragraphs-containing-long-lines: ignore errors generated + by fill-paragraph. + * moved the code that catches the font-lock search bound error + from the XEmacs MIME composition encoder to the FSF Emacs + encoder. + * vm-mime-charset-internally-displayable-p: allow variable + vm-mime-default-face-charsets to apply to MULE-enabled Emacs + and XEmacs. + + + -- Manoj Srivastava <srivasta@debian.org> Mon, 16 Apr 2001 08:55:30 -0500 + +vm (6.91-1) unstable; urgency=low + + * Added Lintian overrides, so that the postinst not setting the symlink + warning should be gone. + * New upstream version. Excerpted changes: + * vm-mime-can-display-internal: check charset to verify that we + can display it when checking text/html. + * vm-auto-archive-messages: hide value of last-command when calling + vm-save-message. + * vm-mime-find-leaf-content-id: removed second arg in call to + vm-mm-layout-id since it only accepts one argument. + * vm-mime-transfer-encode-region: \\n -> \n in armor-dot check + regexp string. + * vm-mime-parse-entity-safe: dropped (sleep-for 2). No one cares + about syntax errors. + * vm-mime-base64-encode-region: if call to base64-encode-region + fails with wrong-number-of-arguments error call it with only + two args and do the B encoding cleanup separately. + * vm-mime-base64-decode-region: don't use the FSF Emacs base64 + decoding function, since it fails completely if it encounters + characters outside of the BASE64 alphabet. + * vm-mime-attachment-auto-type-alist: added the usual PDF, + Quicktime and Excel file extensions. + * vm-imap-move-mail: trying using obsolete RFC822.PEEK if + BODY.PEEK fails. + * vm-imap-retrieve-to-crashbox: support use of obsolete RFC822.PEEK. + * vm-so-sortable-datestring: use vm-timezone-make-date-sortable + instead of the bare timezone-make-date-sortable, which is less + capable of parsing badly formed Date headers. + * vm-mime-convert-undisplayable-layout: save the content type + parameters from the old type and give them to the new type. + * all your base are belong to us + + + -- Manoj Srivastava <srivasta@debian.org> Sat, 10 Mar 2001 15:53:38 -0600 + +vm (6.90-1) unstable; urgency=low + + * Mostly bug fixes. + * vm-compose-mail: Use apply instead of funcall to call the yank + action. We aren't passing a list of arguments to the function. + * vm-mark-or-unmark-messages-same-author: compare author + addresses case insensitively. + * vm-emit-eom-blurb: ignore case when matching against + vm-summary-uninteresting-senders to match what + vm-su-interesting-from does. + * vm-mime-display-internal-text/html: use 'message' to display + any errors encountered. + * vm-mime-display-internal-text/enriched: use 'message' to display + any errors encountered. + * vm-yank-message: call vm-decode-mime-encoded-words in the correct buffer. + * default value of vm-auto-center-summary changed from nil to 0. + * Removed any relationship with emacs19, since that has been removed + from stable. closes: Bug#82788 + * since around mid 6.80's, VM has started using grep -c to determine the + number of new messages. Before, it just looked at the time stamp and + hence did not muck with access times of the spool file. This messes + with other biff like programs out there. At present, the only option + is to turn vm mail check off; this is already reported as a bug. Stay + tuned. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 28 Jan 2001 18:13:38 -0600 + +vm (6.89-1) unstable; urgency=low + + * Mostly bug fixes. + * vm-yank-message: MIME decode the headers of the yanked message + if vm-display-using-mime is non-nil. + * vm-forward-message: if MIME forwarding, switch the buffer + containing the attached message to be multibyte to avoid the + appearance of our old friend \201 when the buffer contents are + inserted into the composition buffer. (FSF Emacs 20 only). + * vm-do-folders-summary: count messages in folders that lack + entries in the folders summary database using vm-grep-program. + * vm-do-folders-summary: ignore index files in the folder directories. + * vm-update-folders-summary-highlight: use intern-soft instead of + intern, since the symbol may not be present in the obarray. + * vm-mark-for-folders-summary-update: check for killed summary + before selecting folders summary buffer. + * vm-emit-eom-blurb: bind vm-summary-uninteresting-senders-arrow + to "" around call to vm-summary-sprintf. + * Makefile: Start using $(prefix) to be more GNUish. Try to + create the installation directories if they don't exist. + * vm-modify-folder-totals: wrong cells in the list were being + updated; fixed. + * vm-mime-run-display-function-at-point: return result of calling + the display function because callers expect it. This wasn't + happening in the FSF Emacs part of the conditional. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 26 Dec 2000 17:36:06 -0600 + +vm (6.88-1) unstable; urgency=low + + * New upstream revision. The changes are: + * New variables: + + vm-folders-summary-mode-hook + + vm-mmosaic-program + + vm-mmosaic-program-switches + * vm-determine-proper-charset: don't use MULE rules if operating + in a unibyte buffer. The non-MULE rules work better in that + case. Dropped use of vm-with-multibyte-buffer. + * use BODY.PEEK instead of RFC822.PEEK in IMAP message fetches, + since RFC822.PEEK has been made obsolete in RFC 2060. + * not decoding for preview if vm-preview-lines == 0 was a + mistake, as the header might still need decoding, so this + change was reversed. + * allow 8-bit chars in IMAP atoms. Microsoft Exchange emits them, + resistance is futile. + * keep IMAP trace buffer if a protocol error occurs. Code for + this was partially done, it's finished now. + * improved folders summary, new folders summary format specifier %s. + * vm-move-to-xxxx-button: fixed code assumption that buttons were + contiguous. + * qp-encode.c: get rid of non-constant initializers (nextc = + getchar()) to avoid warnings from Sun's compiler. + * vm-toolbar-fsfemacs-install-toolbar: "mime" now works in + vm-use-toolbar under FSF Emacs. + * don't display verbose "Waiting for POP QUIT" message unless + getting mail interactively. + * make vm-thread-loop-obarray a larger hash table. + * use vm-global-block-new-mail to prevent async reentrance into the POP + and IMAP code. Use vm-block-new-mail to prevent command-level + mail retrieval buffer locally. + * vm-check-mail-itimer-function: always check for mail. Now that + we're updating the folders summary we need to do the check even + if we know there is new mail fmor a previous check, so that the + summary so kept up to date. + * removed Mule menu from VM's commandeered menubar (FSF Emacs 20 only). + * C-c C-p in composition buffer binding changed from + vm-mime-preview-composition to vm-preview-composition. + * vm-sort-messages: fixed paren problem that broke non-thread + sorting while threading was enabled. + * vm-assimilate-new-messages: don't run vm-arrived-message-hook + and vm-arrived-messages-hook if being called for the first time + in this folder. Old check for this didn't work properly, so + now first-time status is passed in as a parameter. + * vm-emit-eom-blurb: use vm-summary-sprintf on full name so that + it is MIME decoded if necessary. + * vm-check-for-spooled-mail: don't skip remaining spool files + once we know there is mail waiting. We still need to retrieve + data for the remaining folders for the folders summary. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 18 Dec 2000 13:45:59 -0600 + +vm (6.87-1) unstable; urgency=low + + * New upstream revision. The changes are: + * New commands: + + vm-delete-duplicate-messages + * New variables: + + vm-pop-read-quit-response (default value is t) + * vm-toolbar-fsfemacs-install-toolbar: fix logic reversal that + caused Emacs 21 toolbar to never be installed. + * reviewed coding-system-for-{read,write} usage everywhere and + brought it into line with current theory of how Emacs/MULE + works. coding-system-for-write is bound in more places because + in the Emacs 21.0.91 pretest, write-region, even when called + non-interactively, will query the user if it doesn't think the + buffer's coding system can be used to safely write out the + data. + * vm-mail-to-mailto-url: vm-url-decode -> vm-url-decode-string. + * vm-move-to-xxxx-button: next-etent-change -> next-extent-change. + * vm-move-to-xxxx-button: dropped point movement outside the loop + as it wasn't needed and actually broke things. + * vm-add-or-delete-message-labels: don't cycle through the + message list if there are no labels to act upon. + * vm-add-or-delete-message-labels: return a list of labels that were + rejected because they are not known. vm-add-existing-message-labels + expects this and it apparently hasn't been done in a long time. + * call base64-encode-region and base64-decode-region only if they + are subrs. + * vm-check-for-spooled-mail: save-excursion around the guts + of the let form that binds vm-block-new-mail to avoid the + restore-the-wrong-local-variable bug. + * vm-get-spooled-mail: save-excursion around the guts of the let + form that binds vm-block-new-mail to avoid the + restore-the-wrong-local-variable bug. + * vm-determine-proper-content-transfer-encoding: changed search + for non-ASCII chars from [\200-\377] to [^\000-\177] because FSF + Emacs 20 re-search-forward does not match 0200-0377 unibyte + chars in multibyte buffers. They only match in unibyte buffers. + * vm-unbury-buffer: wrapped call to switch-to-buffer in condition-case + in case it fails (dedicated window, minibuffer window) + * reversed coding system changes introduced in VM 6.85 in + vm-line-ending-coding-system and vm-binary-coding-system, as + they were wrong. + * vm-minibuffer-complete-word: use minibuffer-prompt-end + function to determine where the prompt ends instead of + previous-property-change. + * vm-toolbar-fsfemacs-install-toolbar: use xbm images if the + display is not color-capable. + * vm-toolbar-fsfemacs-install-toolbar: don't use "mime-colorful" + as a basename when looking for an XBM for a non-color display. + * vm-toolbar-make-fsfemacs-toolbar-image-spec: use ":mask + heuristic" to make the toolbar pixmap/bitmap backgrounds track the + background of the tool-bar face. + * vm-mime-base64-encode-region: when using base64-encode-region + wrap it in a condition-case to catch errors and resignal all + errors with vm-mime-error. + * vm-mime-base64-decode-region: when using base64-decode-region + wrap it in a condition-case to catch errors and resignal all + errors with vm-mime-error. + * getmail-xx.xbm was a PBM file. No one noticed. Fixed. + * check for vm-fsfemacs-p before using overlay-put, overlay-get, + etc. in the extent/overlay compatibility functions. We can't + use the overlay emulation package's functions because VM needs + the functions to be able to handle plain extents also. + * vm-mime-fsfemacs-encode-composition: catch the "Invalid search + bound (wrong side of point)" error that font-lock can throw and + ignore it. + * vm-set-window-configuration: delete windows that are over + explicitly named buffers. This is meant as an aid to BBDB + users who might want to include a BBDB window in a + configuration but don't want the window to appear unless the + displayed buffer is non-empty. + * install the toolbar only once under FSF Emacs, since it will + appear everywhere vm-mode-map is used thereafter. + * panic buffoon's color changed from rgb:ff/7f/ff to rgb:e1/92/46 (tan). + + -- Manoj Srivastava <srivasta@debian.org> Fri, 1 Dec 2000 02:13:21 -0600 + +vm (6.85-1) unstable; urgency=low + + * New upstream revision. The changes are: + * New commands: + + vm-move-to-previous-button + + vm-move-to-next-button + * vm-end-of-message, vm-beginning-of-message: wrap vm-save-buffer-excursion + about part of function that does window selection since that can + change the current buffer. vm-narrow-to-page was noticing the + buffer change to the summary; vm-message-pointer was suddenly nil. + * made vm-create-virtual-folder, and by effect its callers, honor + vm-next-command-uses-marks. + * vm-apply-virtual-folder: honor vm-next-command-uses-marks. + * added no-suggested-filename arg to vm-mime-attach-file and + vm-mime-attach-object. + * vm-preview-current-message: don't decode for preview unless + vm-preview-lines is non-nil, as this is extra unnecessary work. + * vm-pop-end-session: read POP QUIT response; Microsoft Exchange + apparently will sometimes not expunge if we close the connection + without reading the response. + * set reasonable default value for vm-folders-summary-directories. + * vm-preview-current-message: don't block display of any type + other than message/external-body and externally displayed types + when supporting vm-mime-decode-for-preview. + * internal image support for v21 Emacs. + * toolbar support for v21 Emacs. + * Makefile: for 'make autoload' compile vm.el into vm.elc instead + of writing require statements directly into it, otherwise Emacs + 21 bitches. + * vm-binary-coding-system was returning no-conversion under FSF + Emacs, which is wrong, now returns raw-text. + * vm-minibuffer-complete-word: In Emacs 21, during a minibuffer + read the minibuffer contains propt as buffer text and that text + is read only. So we can no longer assume that (point-min) is + where the user-entered text starts so we must compute this + location. Calling previous-property-change is a kludge but it + seems ot be the only thing that does the job. + * vm-mime-display-internal-message/external-body: for Emacs 21, + use a multibyte work buffer, otherwise the evil \201s appear + in the tempfile and utterly corrupt it. Also set + buffer-file-coding-system in the work buffer, since + write-region may be called in it later. + * dropped use of vm-with-unibyte-buffer. I don't htink it is + needed any longer. + * vm-assimilate-new-messages: only run vm-arrived-messages-hook + if a new message has arrived. + * use a normal keymap instead of a sparse keymap for vm-mode-map. + + + -- Manoj Srivastava <srivasta@debian.org> Fri, 24 Nov 2000 23:42:45 -0600 + +vm (6.84-1) unstable; urgency=low + + * New upstream revision. The changes are: + * vm-submit-bug-report: mail-user-agent should be a symbol not a + list--- fixed. + * vm-keep-some-buffers: kill a buffer even if it is modified + if it's value of buffer-offer-save is nil. + * vm-pop-make-session: if APOP authentcation fails, remove the + saved password just like we do for PASS authentication. + * new variable and function vm-xemacs-file-coding-p tells whether + XEmacs was compiled with --with-file-coding=yes, which means + several things need to be treated the same as if MULE were + enabled. + * when deciding whether to call set-buffer-file-coding-system + just check fboundp instead of xemacs-mule-p or fsfemacs-mule-p. + This should help XEmacs-NT+file-coding. + + * New variables: + + vm-page-continuation-glyph + + vm-folders-summary-database + + vm-folders-summary-directories + + vm-folders-summary-format + + vm-frame-per-folders-summary + * New commands: + + vm-folders-summarize + * Makefile: moved vm-version.el to the beginning of the SOURCES + list so that "make debug" doesn't crash on unbound variables. + * vm-narrow-to-page: move to beginning of line only if we're not + at end of buffer. If we're at end of buffer, it usually means + forward-page failed to find a page delimiter and crashed into + point-max. + * vm-scroll-forward: after calling vm-narrow-to-page move to + either the new window start or the start of the text section of + the message, whichever is the greater buffer position. This + fixes the semi-broken backward paging over page delimiters and + fixed the broken forward scrolling over page delimiters after + scrolling backward through the same message. + * vm-narrow-to-page: use overlay/extent to display a "...more..." + type string at the end of a page. + * vm-scroll-forward: do (sit-for 0) to refresh display early so that + the end of message notice appears when it should when scrolling + over page delimiters. + * vm-mime-display-internal-text/html: insert placeholder + character before end marker before calling w3-region to avoid + end == start marker squashing problem. + * vm-submit-bug-report: reporter-submit-bug-report apparently + dropped support for the variable reporter-mailer in favor of + using mail-user-agent instead. Bind this variable as well the + old one so bug reporters can send attachments. + * vm: don't decode MIME if recover-file is likely to happen, + since recover-file does not work in a presentation buffer. + * vm-mail-to-mailto-url: decode URL before handing it to + vm-mail-internal. + * vm-mime-compile-format-1: removed code to decode and reencode + MIME encoded words, since these aren't needed in MIME button + format tags. + * give up on disabling font-lock around attachments. font-lock + users will just have to lose, because I don't see a clean way + to do it. Removed futile atemptes from code. + * vm-preview-current-message: don't MIME decode for preview if + vm-preview-lines == 0 since it's pointless in that case. + * vm-select-folder-buffer: make folder buffer selection + mandatory, generate error otherwise. New function + vm-select-folder-buffer-if-possible is to be used for + situations where buffer selection is not mandatory. + * moved vm-totals computation out of vm-emit-totals-blurb and into a + separate function. + * vm-expunge-folder: increment vm-modification-counter in the + real folder buffers to invalidate vm-totals. + * New variables: + + vm-url-retrieval-methods + + vm-wget-program + + vm-lynx-program + * access-type=url support added for message/external-body. + * vm-visit-virtual-folder: call vm-fsfemacs-nonmule-display-8bit-chars. + This needs to be done for the same reasons as it needs to be done + in 'vm'. + * provide keymap prompt for # and ## (XEmacs only, unfortunately). + * vm-truncate-string: fixed to once again support a negative width + argument, even if we're using char-width. + * vm-mime-get-xxx-parameter: don't inadvertently truncate parameter + value at newline. + * vm-string-width: don't use Emacs 20's string width--- it + ignores buffer-display-table and thereby hoses the summary. + Using char-width on each character and summing the reuslt + gives the answer we want. + * vm-decode-coding-region: compute old region size based on the + source buffer rather than the work buffer, since they might + have different unibyte/multibyte status. + * vm-decode-coding-region: reverse order of insert/delete + sequence at the end to delete then insert. It fixes the + parsing of this header + From: "Cajsa Ottesj=?ISO-8859-1?B?9g==?=" <cajsao@ling.gu.se> + Apparently if ö is inserted before \366 in a multibyte buffer, + Emacs believes that the two characters are one character and + moves point forward past the \366. This loses because the \366 + needs to be deleted. + * vm-flush-cached-data: stuff last-modified, pop-retrieved and + imap-retrieved lists. + * vm-pop-move-mail: if we retrieved something, call vm-stuff-pop-retrieved. + * vm-imap-move-mail: if we retrieved something, call vm-stuff-imap-retrieved. + * vm-mime-display-internal-text/html: pass charset name to + vm-mime-charset-decode-region instead a layout. + * vm-mime-display-internal-text/enriched: pass charset name to + vm-mime-charset-decode-region instead a layout. + * vm-menu-mime-dispose-menu: convert extent or overlay into a + layout before using layout functions on it. + * vm-mime-send-body-to-folder: put leading and trailiing message + separators around the message in the temp folder. + * vm-mime-send-body-to-folder: clear buffer-modified flag before + entering vm-mode. + * call the mime-reader-map save functions from the dispose menu + instead of the low-level functions, so that + vm-mime-delete-after-saving is honored. + * vm-mime-can-display-internal: add 'deep' flag, which indicates + whether to check the subobject of a message/external-body + object. + * vm-mime-display-internal-multipart/alternative: use the new 'deep' + flag of vm-mime-can-display-internal. + + -- Manoj Srivastava <srivasta@debian.org> Fri, 17 Nov 2000 12:20:14 -0600 + +vm (6.81-1) unstable; urgency=low + + * New upstream revision, with tonnes of changes for emacs 20 + + -- Manoj Srivastava <srivasta@debian.org> Wed, 8 Nov 2000 10:58:09 -0600 + +vm (6.76-3) unstable; urgency=low + + * fixed silly typo in dependency; we need miome-codecs, not + vm-encoders. closes: Bug#74198 + + -- Manoj Srivastava <srivasta@debian.org> Sat, 4 Nov 2000 14:46:02 -0600 + +vm (6.76-2) unstable; urgency=low + + * Change the rules file not to require emacs in the binary arch + phase. closes: Bug#71354 + + -- Manoj Srivastava <srivasta@debian.org> Fri, 15 Sep 2000 13:07:10 -0500 + +vm (6.76-1) unstable; urgency=low + + * At last, emacs20 compatibility. This is a new upstream + version. excerpted changes: closes: Bug#69189 + # New variables: + + vm-movemail-program-switches + # generate a random Message-ID for previewed compositions in case + the user wants to resend the preview somewhere. + # vm-fix-my-summary!!!: call vm-set-modflag-of on each message + whose summary we whack so that the summary cache is rewritten + when the folder is saved. + # vm-sort-messages: if this is not a thread sort and threading is + enabled, then disable threading and make sure the whole summary + is regenerated (to recalculate %I everywhere). + # vm-mime-display-internal-image-xxxx: set glyph baseline to 100% + to add scrolling in XEmacs 21.2. + # vm-generate-index-file-validity-check: set step value to 1 if + buffer size is smaller than 11 bytes. Step used to be 0 in + this case which led to infloop. + # added base64-encode.c, base64-decode.c, qp-encode.c, + qp-decode.c to the distribution. + # fixed problem in qp-decode.c where lines contain a single + character followed by newline would have the first character + dropped. + # vm-display: allow a string as a buffer argument, convert it to + a buffer internally. + # vm-print-message: don't set the current buffer to be the shell + output buffer, as this makes vm-set-window-configuration bail + out early because it wants to be in a VM related buffer. + # vm-pipe-message-to-command: don't set the current buffer to be the + shell output buffer, as this makes vm-set-window-configuration + bail out early because it wants to be in a VM related buffer. + # vm-print-message: don't use vm-display to display the shell + output buffer, use display-buffer instead and only use it if + the output buffer is not empty. + # vm-pipe-message-to-command: don't use vm-display to display the + shell output buffer, use display-buffer instead and only use it + if the output buffer is not empty. + # vm-print-message: use the vm-print-message config instead of + the vm-pipe-message-to-command config. + # vm-display: don't immediately set current buffer to be the buffer + to be displayed. This behavior made vm-set-window-configuration + bail out early. + # vm-discard-cached-data: call vm-garbage-collect-message before + flushing message caches. + # look for (fboundp 'w3-about) in addition to (fboundp 'w3-region) + to determine if text/html can be displayed internally. + # make after-save-hook local in VM folder buffers. + # vm-get-new-mail: make third arg to read-file-name nil, make + fourth arg t. + # vm-compose-mail: move to point-min before searching for the header + separator string. + # Removed bad quote in vm-delete-mime-object menu entry. + # vm-match-data: replaced with version that calls match-data to + figure out the number of valid \(..\) groups. Emacs 20.4 is + randomly signaling args-out-of-range if the arg to + match-beginning exceed the number of internally allocated + registers in the regexp engine or some such nonsense. + # vm-frame-loop: in the last deletion check, also check the + delete-me frame with vm-created-this-frame-p before deleting + it. + # vm-check-index-file-validity: allow for a nil modified time, + which can occur if the folder is empty. + # generalized vm-keep-mail-buffer into vm-keep-some-buffers and + made the former call the latter. + # keep POP and IMAP trace buffers if there is trouble making a connection. + # complain to user if APOP authentication is asked for but isn't + supported. Previously POP retrieval silently failed. + # vm-reorder-message-headers: For babyl folders, add a newline + before the EOOH line if header section does not end with two + newline. + # macroized most uses of coding system constants 'no-conversion + and 'binary, because 'no-conversion doesn't meant the same thing + in Emacs and XEmacs. + # vm: if buffer-file-coding-system is nil, set it to 'raw-text. + (FSF Emacs MULE only). + # removed duplicate (make-variable-buffer-local 'vm-pop-retrieved-messages) + # vm-parse-date: assume 2-digit year specifications < 70 are in + the 2000's rather than the 1900's. + # vm-mm-encoded-header: bind case-fold-search to t during + search for encoded words. + * Added new package for the included mime transport encoder/decoders. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 6 Sep 2000 12:08:15 -0500 + +vm (6.75-9) unstable; urgency=low + + * Added documentation and conflicts to reflact the fact that vm and + semi/wemi do not happily co-exist. closes: Bug#62048 + + -- Manoj Srivastava <srivasta@debian.org> Sat, 15 Apr 2000 01:47:57 -0500 + +vm (6.75-8) frozen unstable; urgency=low + + * Use absolute links when related links would not work, for the + /usr/doc/latex2tml symlink. + * Added a dependency on fileutiles >=4.0, since the package would fail + to install with older fileutils. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 27 Mar 2000 12:29:26 -0600 + +vm (6.75-7) frozen unstable; urgency=high + + * A recent change to the postinst whacked the compilation phase. This + fixes what would be an important bug. closes: bug#59725 + + -- Manoj Srivastava <srivasta@debian.org> Mon, 6 Mar 2000 16:03:02 -0600 + +vm (6.75-6) frozen unstable; urgency=low + + * Fixed an upgrade bug when /usr/doc happens to be a symlink, and does + not point to /usr/share/doc. A couple of people were bitten by this. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 28 Feb 2000 22:27:05 -0600 + +vm (6.75-5) frozen unstable; urgency=low + + * The postinst was vulnerable to being affected by symlinks (if, for + some reason, the prerm failed). This has happended for latex2html; and + created a grave bug. + * There was a bug in the postinst in a case statement, that caused + installation to fail for certain situations. + * Also fixed an lintian warning + + -- Manoj Srivastava <srivasta@debian.org> Tue, 8 Feb 2000 20:16:49 -0600 + +vm (6.75-4) experimental; urgency=low + + * his is the experimental version of VM with support for + emacs20. Please note that the author says that this may cause lossage + due to infelicitous behaviour en emacs20. The Debian developer uses + this version, but may merely have been lucky. Use this at your own + risk. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 1 Sep 1999 01:33:42 -0500 + +vm (6.75-3) unstable; urgency=low + + * Darnit. Forgot to change the changelog for the last upload. This one + is again meant for unstable. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 1 Sep 1999 01:21:00 -0500 + +vm (6.75-2) unstable; urgency=low + + * This is the experimental version of VM with support for + emacs20. Please note that the author says that this may cause lossage + due to infelicitous behaviour en emacs20. The Debian developer uses + this version, but may merely have been lucky. Use this at your own + risk. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 30 Aug 1999 22:30:28 -0500 + +vm (6.75-1) unstable; urgency=low + + * New upstream version. Still no support for emacs20. Excerpted changes: + * New variables: + + vm-mail-send-hook + * vm-mime-parse-entity: when checking for a content type of just + "text" allow for the possibility that there was no content-type + header at all. + * use XEmacs built-in MD5 support. + * vm-pop-md5: use shell-file-name instead of "/bin/sh". + * formatting and typo fixes in the manual and docstrings + from will@fumblers.org. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 30 Aug 1999 22:04:38 -0500 + +vm (6.74-2) experimental; urgency=low + + * This is the experimental version of VM with support for + emacs20. Please note that the author says that this may cause lossage + due to infelicitous behaviour en emacs20. The Debian developer uses + this version, but may merely have been lucky. Use this at your own + risk. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 3 Aug 1999 12:17:40 -0500 + +vm (6.74-1) unstable; urgency=low + + * Starting with this version, vm shall not try and byte compile for + emacs20 emacsen. VM has only depended upon emacs19, but it would + compile on emacs20 as well. However, emacs 20.4 was released recently, + but Kyle still does not feel comfortable with it. Therefore, until the + upstream supports emacs20, vm shall not compile under it. Instead, + there shall be an experimental version of vm that shall depend on + emacs20 as well and support it, but the user uses that at their own + risk. I personally have been using vm on emacs20 with no mishap, but + that is just one data point. + * Excerpted changes: + * New variables: + + vm-mime-external-content-type-exceptions + * vm-mime-parse-entity: quietly treat "text" as a content type as + if it were "text/plain" and US-ASCII. + * vm-mime-discard-layout-contents: set m to be the layout's + message, not the end of the layout's body. + * New variables: + + vm-mime-decode-for-preview + + vm-mime-delete-viewer-processes + * vm-mime-display-external-generic: put MIME temp files on the message + garbage list instead of the folder's garbage list. + * vm-delete-mime-object: copied check for the top-level MIME + object from FSF Emacs code to XEmacs code since the former is + the correct check to use. + * vm-mime-discard-layout-contents: discard cached byte and line + counts of the edited message. + * vm-sort-compare-thread: in the case where root message IDs are + different, if the message dates are identical, use string-lessp on + the message IDs to break the tie. This avoids having different + messages compare as equal, which makes the sort unstable. + * vm-mime-discard-layout-contents: recompute Content-Length + header if needed. + * vm-mime-can-display-internal: consider all text types except + text/html displayable if the character set is displayable. + For text/html continue to require W3. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 3 Aug 1999 12:01:43 -0500 + +vm (6.72-1) unstable; urgency=low + + * Excerpted changes: + * New commands: + + vm-delete-mime-object + * New variables + + vm-mime-delete-after-saving + + vm-mime-confirm-delete + + vm-mime-default-face-charset-exceptions + + vm-paragraph-fill-column + + vm-imap-session-preauth-hook + * removed old, bogus definition of vm-session-initialization from + vm.folder.el + * added w32 as another name for win32 as a window system type. + (FSF Emacs only). + * changed default value of vm-mime-default-face-charsets to + include iso-8859-1 if running on a tty under FSF Emacs/Mule. + * vm-mime-parse-entity: move binding of case-fold-search to a + point after the set-buffer call to avoid having the binding + overriden by a buffer-local value. + * vm-mime-convert-undisplayable-layout: wrap call to vm-mm-layout + message in a call to vm-mime-make-message-symbol; a symbol + needs to be in the struct slot, not the raw message. + * signal an error if mail-alias-file is set and the user is not + the superuser. + * broke the message ID creation code out of + vm-mail-mode-insert-message-id-maybe. + * vm-su-do-date: allow a RFC 822 regexp to match a timezone spec + that lacks the leading plus or minus. + * bind jka-compr-compression-info-list to nil in various place to + avoid unwanted compression or decompression of data. + * vm-mime-send-body-to-file: bind jka-compr-compression-info-list + to nil instead of func-binding jka-compr-get-compression-info. + * vm-sort-messages: call vm-build-thread-lists (new function) + which calls vm-th-thread-list on each message in the folder. + This generates keys that the thread sort needs before the sort + happens instead of during it. Fixes thread sorting bugs. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 15 Jul 1999 15:57:47 -0500 + +vm (6.71-2) unstable; urgency=low + + * VM not creates multiple vm.info-? files. Remember to install all of + them. closes: Bug#38041 + + -- Manoj Srivastava <srivasta@debian.org> Thu, 20 May 1999 11:15:38 -0500 + +vm (6.71-1) unstable; urgency=low + + * Excerpted changes: + * vm-mime-display-internal-text/plain: get message struct from + the MIME layout instead of from vm-message-pointer, since the + latter is utterly the wrong place to find it in this context. + Also, don't fill if no-highlighting is non-nil. + * vm-add-or-delete-message-labels: propagate label additions in + virtual folders to the global lists of the underlying real folders. + * bind format-alist to nil around calls to insert-file-contents + in MIME composition encoding functions. + * New variables: + + vm-fill-paragraphs-containing-long-lines + * vm-mime-display-internal-text/html: moved the code that rmeoves + read-only text properties into the vm-with-unibyte-buffer form. + * vm-make-presentation-copy: bind inhibit-read-only before tryign + to modify an existing presentation buffer. This is to avoid + stumbling over read-only text properties. + * vm-mime-insert-button: use 'append' instead of 'nconc' to add a + keymap parent. (FSF Emacs only) This avoids modifying the + child keymap and creating a circular keymap structure in a + subsequent call. + * moved code that sets vm-xemacs-p, vm-fsfemacs-p, etc. to vm-version.el. + Moved other basic feature checking code to vm-version.el. + * Makefile: make sure vm-version gets loaded first, so the + version/feature checking code is run very early. Some of it is + needed by other modules at load time. + * added keymap for MIME buttons so you can display, save, pipe, + print from a tty. + * vm-mime-xemacs-encode-composition: use insert-file-contents + instead of insert-file-contents-literally and see what breaks. + This will allow EFS to work. + * default value of vm-mime-default-face-charsets no longer contains + "iso-8859-1" under FSF Emacs/Mule. 8-bit character display as + octal codes in a unibyte buffer unless standard-display-europeans + or equivalent is called, and we don't call this function under + MULE. + * vm-compose-mail: this function is a VM entry point so call + vm-session-initialization. + + + -- Manoj Srivastava <srivasta@debian.org> Thu, 13 May 1999 14:47:30 -0500 + +vm (6.68-1) unstable; urgency=low + + * Added doc-base support. + * New upstream version. Please NOTE: Kyle has retracted support for emacs + 20.3, saying that there is an bug in that version of emacs whence a + buffer string copy does not copy the contents of the buffer, causing + mail to be distorted. I have personally committed to using emacs20 v + 20.3, and I have never experienced this bug. However, the chance does + exist (and has existed for all emacs20+vm combinations); use this on + emacs20 at your own risk. (I have changed VM so it does at least + compile on Emacs 20.3). + * Excerpted changes: + * put user specified Netscape switches before the -remote stuff + in the arg list to Netscape. + * vm-imap-retrieve-to-crashbox: use char-after instead of + char-before since Emacs 19.34 doesn't have char-before. + * use vm-coding-system-name instead of coding-system-name. fset + vm-coding-system-name to coding-system-name if it exists, + otherwise use symbol-name. FSF Emacs doesn't have a + coding system object, so the name is the same as the coding + system symbol's name. + * vm-determine-proper-charset: wrap the guts of the function in a + vm-with-multibyte-buffer form to ensure we're looking at + characters instead of the raw encoding data when scanning for + the character sets that are present. + * vm-decode-mime-layout: support the old 'name' parameter when + supporting vm-infer-mime-types. + * vm-do-reply: don't match vm-subject-ignored-prefix against the + subject to determine if we prepend vm-reply-subject-prefix to + the subject or not. This reverts a change made in VM 6.47. + * vm-mm-layout: call vm-mime-parse-entity-safe instead of + vm-mime-parse-entity so that we get always get a layout back. + This avoids a MIME part completely disappearing if we can't + parse it. + * vm-mime-parse-entity-safe: use type "error/error" for the + layout returned if the MIME part can't be parsed. + * vm-mime-qp-encode-region: hex encode _ and ? for Q encoding as + required by RFC 2047. + * vm-mime-send-body-to-file: Func-bind jka-compr-get-compression-info + to 'ignore' to avoid double compression of saved MIME bodies that + are already compressed. + * vm-imap-make-session: quote (using IMAP quoting rules) login + name and password that are sent as part of the LOGIN command. + * vm-mime-parse-entity-safe: pass message and passing-message-only + flag to vm-mime-parse-entity. + * vm-mime-parse-entity: wrong number of fields in the last layout + structure fixed. + * make MIME transfer encoding/decoding work buffers unibyte to + avoid corruption when characters are copied from them. (FSF + Emacs only). + * vm-mime-attach-message: store the message to attach in an + unibyte buffer instead of a multibyte buffer. + * vm-mime-fsfemacs-encode-composition: encode text regions using + coding system selected from vm-mime-mule-coding-to-charset-alist + instead of relying on buffer-file-coding-system to be set properly. + * vm-mime-fsfemacs-encode-composition: when handling the attachment + of a composite object, add MIME header section (if not already + provided) before parsing and transfer encoding the object. + vm-mime-xemacs-encode-composition similarly modified. + * New variables: + + vm-mime-qp-decoder-program + + vm-mime-qp-decoder-switches + + vm-mime-qp-encoder-program + + vm-mime-qp-encoder-switches + * set-file-coding-system -> set-buffer-file-coding-system. + * vm-edit-message: force edit buffer to be unibyte (FSF Emacs + only). + * vm: force folder buffer to be unibyte (FSF Emacs only). + * wrap parts of various MIME decoding and display functions in + vm-with-unibyte-buffer so we can work with unwashed 8-bit data + directly. (FSF Emacs only). + * force some buffers we create to be unibyte buffers to avoid + conflabulation of 8-bit data. (FSF Emacs only). + * vm-find-trailing-message-separator: point still not moving backward + all the times that it should be, so go back to ignoring the return + value of vm-find-leading-message-separator and always moving backward. + * vm-mail-mode-insert-message-id-maybe: use the hostname variable + we so carefullly initialized, instead of just using + (system-name). + * vm-mime-base64-encode-region: if B encoding, strip newlines from + the work buffer instead of the buffer region we're converting. + * vm-mime-base64-encode-region: don't emit status message unless + the region we're encoding is larger than 200 chars. + * vm-mime-parse-entity: new fourth argument that tells the + function whether to use the message argument for positional + information or to just use it to struct in the message slot of + the MIME layout struct. Same for vm-mime-parse-entity-safe. + Use this new argument appropriately in various places so the + message slot gets filled in more places. + + + -- Manoj Srivastava <srivasta@debian.org> Sat, 27 Feb 1999 23:38:16 -0600 + +vm (6.65-2) unstable; urgency=low + + * vm-search.el had gone missing, for some reason. fixes: BUG#32658 + + -- Manoj Srivastava <srivasta@debian.org> Sun, 31 Jan 1999 16:21:57 -0600 + +vm (6.65-1) unstable; urgency=low + + * New upstream version. This is trhe forst version ratified for emacs20. + + -- Manoj Srivastava <srivasta@debian.org> Fri, 29 Jan 1999 11:35:18 -0600 + +vm (6.64-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * vm-mail-mode-insert-message-id-maybe: (stringp + 'mail-host-address) -> (stringp mail-host-address). + * vm-imap-retrieve-to-crashbox: for From_-with-Content-Length and + BellFrom_ folder, add a newline to the end of a message if the + message lacks one. + * vm-mime-display-internal-text/html: third arg to + remove-text-properties changed to be a plist as the function + requires. + * new edition of the user manual. + * updated README, new installation instructions for manual, + mention Web site + * vm-search18.el gone, vm-search19.el became vm-search.el. + * vm-pop-make-session: switched to the trace buffer earlier in + the function so that MULE coding system is set in correct + buffer. Add connection status messages to trace buffer. + * vm-imap-make-session: switched to the trace buffer earlier in + the function so that MULE coding system is set in correct + buffer. Added connection status messages to trace buffer. + * vm-submit-bug-report: use 'vm-mail instead of 'mail for sending + bug reports. Less confusing, and will work most of the time. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 26 Jan 1999 18:33:33 -0600 + +vm (6.63-2) unstable; urgency=low + + * Uncomment call to update menu on postrm. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 9 Jan 1999 12:25:05 -0600 + +vm (6.63-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * set selective-display to nil in various places in the code + where write-region and call-process-region (which calls + write-region) are called to avoid the CR -> LF translation. + * vm-load-window-configurations: added bind of + coding-system-for-read. + * vm-store-window-configurations: removed binding of + coding-system-for-read, moved coding-system-for-write binding + to be ambient only during the write-region call. + * removed all but one of the bindings of inhibit-read-only in the + MIME code. + * vm-mime-display-internal-text/html: Added a remove-text-properties + call to remove read-only text properties. + * vm-mime-attach-object: Don't allow attachment of object to a + composition buffer that has already been encoded. + * retain IMAP session trace buffer if a protocol error occurs. + * removed vm-iamp-store-failed error definition since it was + unused. + * 'w' summary format specifier now gives full weekday name. + * vm-mail-mode-insert-message-id-maybe: ensure RFC 822 compliant + month and day name by indexing the names from an alist instead + of relying on format-time-string. format-time-string's output + can't be trusted for this because of the dubious `locale' stuff + in the C library. + * for non-Content-Length based From_ types, don't require a year + >= A.D. 1000 at the end of the From line--- instead only require a + single digit. This change to deal with some evil mailer that + puts a numeric timezone at the end of the line. + * vm-make-presentation-buffer: remove buffer local foreground and + background colors set in the default face in the presentation + buffer. + * dropped the Videodrome joke from vm-submit-bug-report. + * vm-mime-fsfemacs-encode-composition: bind + file-name-buffer-file-type-alist so that a bit-for-bit binary + file read is assured. This matters only to NTEmacs. + * vm-mouse-send-url-to-netscape: Netscape 4.05 apparently doesn't + like the space after the comma in openURL(..., new-window) and + doesn't create a new window. So the space has been removed. + * read per-folder IMAP retrieved list at startup... forgot to add + code to do this. + * accept lower-case hex digits in quoted-printable encoding. + * vm-mime-composite-type-p: assume message/rfc822 and + message/news are the only composite "message" types. New ones + will have to be manually added. + * vm-misc.el: moved macros to vm-macro.el. + * Makefile: Preload vm-macro.el instead of vm-misc.el. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 9 Jan 1999 06:19:51 -0600 + +vm (6.62-4) frozen unstable; urgency=low + + * Fixed a problem with the remove/purge process in which the byte + compiled files would be left behind. Since VM is in a bug fix mode, no + new code has been introduced; and this bug fix should be justification + to include in frozen. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 25 Nov 1998 11:32:03 -0600 + +vm (6.62-3) unstable; urgency=low + + * Try and make the installation quieter. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 3 Nov 1998 23:43:01 -0600 + +vm (6.62-2) unstable; urgency=low + + * Enhanced mail-mode-smart-tab to use bbdb-complete-name in the headers + if and only if bbdb is already loaded into emacs. In the body, tab + still is tab-to-tab-stop. This enhancement comes at the request of + Dirk Eddelbuettel <edd@debian.org>. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 17 Sep 1998 22:45:22 -0500 + +vm (6.62-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * vm-mouse-send-url-to-netscape: Change commas to %2C to avoid + confusing Netscape -remote. + * vm-mime-display-external-generic: when searching for %f, ignore + %%f. + * vm-decode-mime-layoout: drop rule that causes unmatched text/* + and message/* MIME objects to be displayed as text plain. + * vm-mime-can-display-internal: don't load W3 just to see if + w3-region gets bound. If the user wants to view inline HTML, + they'll have to either load W3 explicitly or set up an autoload + for w3-region. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 10 Sep 1998 09:42:40 -0500 + +vm (6.61-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * vm-find-trailing-message-separator: point wasn't being moved + backward when it should be. Change check to use the return + value of vm-find-leading-message-separator. + * vm-build-message-list: add the starting position of the garbage + to the garbage warning. + * don't use gray75 to initialize gui-button-face under Windows + (FSF Emacs only). Use only primary colors instead. + * vm-find-trailing-message-separator: for From_ folders, don't + move point backward one char after finding the leading separator + unless that char is a newline. + * vm-skip-past-trailing-message-separator: for From_ folders + don't move point forward one character unless we're not at end + of buffer. + * vm-submit-bug-report: require vm-vars and vm-version modules. + * vm-visit-folder-other-frame: call vm-session-initialization + even if the command is not called interactively. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 30 Aug 1998 13:14:22 -0500 + +vm (6.59-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New variables: + + vm-default-From_-folder-type + * new folder type: BellFrom_. + * vm-mime-display-internal-multipart/alternative: call + vm-mime-should-display-internal with two arguments, as + required, instead of one. + * vm-munge-message-separators: if folder type arg is From_, use + BellFrom_ as type to produce folders that are less likely to be + misparsed by other mailers. + * quoted vm variables in docstrings in vm-vars.el with ` and ' + for hyper-apropos. Change previous other uses of `foo' to + ``foo''. + * fixed typo in vm-mime-fsfemacs-encode-composition; e -> o. + * added a defvar for timer-list in vm-folder.el. + * added defvars for standard-display-table, + buffer-display-table and buffer-file-type in vm-mime.el. + * added a defvar for mail-personal-alias-file in vm-reply.el. + * added defvars for lpr-command and lpr-switches. + * rewrote text/html inline display functoin to not need a temp + buffer, save-excursion, and save-restriction. Needed because + w3-region puts markers into the buffer that can't be copied + out. + * don't auto-create text body attachments that contain all + whitespace if the attachment will be at the beginning or end + of the composition. + * vm-imap-retrieve-to-crashbox: munge folder message separators + so the retrieved messages will be parsed correctly in the + target folder. + * vm-do-reply: don't use contents of In-Reply-To in generated + References header unless no References header is present. + * if vm-mime-alternative-select-method is best-internal, consider + a MIME object only if the user wants it displayed internally, + not just if it can be displayed internally. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 25 Jul 1998 15:42:27 -0500 + +vm (6.56-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * vm-get-spooled-mail: set the non-file maildrop flag on each pass + though the loop. + * vm-get-spool-mail: restore expand-file-name call on the + maildrop so that tildes get expanded. + * store/use the same password for IMAP mailboxes on the same host. + * removed greeting block on Cyrus server. + * Shapiro typo fixes. + * vm-mail-mode-insert-message-id-maybe: check mail-host-address + with stringp instead of boundp before using its value. + * vm-rfc1153-or-rfc934-burst-message: do digest separator unstuffing + on a per message basis and before message separator munging, so + that message separators exposed by the unstuffing get munged. + * registered vm-imap-protocol-error as a known error/exception. Use it. + * vm-check-for-spooled-mail: check spool filename against the IMAP + template before chaecking against the POP template, since the + POP template will match both. + * vm-imap-check-mail: bail early if message count in mailbox is zero. + * first crack at IMAP support. + * New commands: + + vm-expunge-imap-messages + * New varisbles: + + vm-recognize-imap-maildrops + + vm-imap-auto-expunge-alist + + vm-imap-bytes-per-session + + vm-imap-expunge-after-retrieving + + vm-imap-max-message-size + + vm-imap-messages-per-session + * use vm-check-for-killed-folder before calling + vm-select-folder-buffer in a few functions that don't necessarily + need to select the folder buffer in order to run. + * vm-goto-message bound to M-g. + * vm-find-leading-message-separator: for From_ type folders + require that end of the leading separator line match + " [1-9][0-9][0-9][0-9]". Revisit in eight thousand years. + * rename vm-sprintf to vm-summary-sprintf. Use alists to store + compiled formats instead of using symbol property lists. + * vm-mime-xemacs-encode-composition: discard all but Content-ID + header in already MIME'd objects to avoid header duplication. + Same for vm-mime-fsfemacs-encode-composition. + * vm-mime-display-internal-text/html: If error signaled, catch + it, store the error message and return nil. + * more descriptive buffer name for header buffer used when asking + about POP retrievals. + * vm-mail-mode-insert-message-id-maybe: try harder to find a + hostname that has dots in it for the Message-ID header. + * made vm-pop-retrieved-messages a buffer-local variable, as the + table isn't meant to be shared among folders. + * vm-expunge-pop-messages: use password-less maildrop specs when + doing comparisons in skip code. Changed catch tag from 'skip + to 'replay to more accurately reflect what's happening. + * vm-pop-end-session: delete the trace buffer. + * vm-pop-make-session: generate a new buffer for each session + instead of reusing the same one. + * vm-expunge-pop-messages: set buffer-read-only to nil in + trouble-alert buffer before trying to modify erase it. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 15 Jul 1998 09:16:04 -0500 + +vm (6.53-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * vm-mf-default-action: needed car of vm-mm-layout-type to + extract type string. + * vm-mime-display-button-xxxx: don't display button unless + there's a defined method for displaying the object. + * New variables: + + vm-auto-displayed-mime-content-type-exceptions + + vm-mime-internal-content-type-exceptions + * vm-find-leading-message-separator: for From_ type folders, + reinstate requirement that there be two newlines before "From " + message separators. + * renamed vm-mime-should-display-external to vm-mime-can-display-internal. + * added big5 to vm-mime-mule-charset-to-coding-alist + * default value of vm-send-using-mime to always be t instead of + looking to see if the TM mime-setup feature is present. + * added a newline to the 'end' line of a uuencoded attachmentsif + there isn't one already; this to cope with the usual crocked PC + mail readers (may they reek). + * vm-mime-text-description: further identify a text part if it + has a standard signature in it. + * remove TM hooks from mail mode buffers if vm-send-using-mime is + non-nil. + * vm-mime-send-body-to-file: if user enters a directory name, use + it unconditionally. + * panic buffoon's color changed from rgb:00/df/ff to rgb:ff/7f/ff. + * use user-mail-address function in Bcc header (XEmacs only). + * use user-mail-address variable, if bound in, Bcc headers. + * replaced definition of vm-load-init-file in vm-startup.el with + the one from vm-folder.el. + * use vm-mime-default-action-string-alist only if VM knows how to + display the MIME object. Fiddle with the strings in the list. + * support foregroundToolBarColor symbol in the 'small' set of + toolbar pixmaps (XEmacs only). + + + -- Manoj Srivastava <srivasta@debian.org> Mon, 29 Jun 1998 18:10:12 -0500 + +vm (6.51-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * don't call make-face if no face support is compiled into Emacs + (FSF Emacs only). + * enable inline display of text/html again. + * vm-mime-text-type-p: anchor string matches and add a trailing / + to assure matching only the correct types. + * more fiddling with newlines around the Content-Description + header, hopefully getting it right this time. + * correct "Display as Text" MIME menu item. + * vm-mime-charset-internally-displayable-p: check + vm-mime-mule-charset-to-coding-alist if vm-fsfemacs-mule-p is + non-nil. + * vm-rename-current-mail-buffer: changed to recognize new default + composition buffer name introduced in 6.49. + * vm-mime-display-external-generic: append filename when supporting + COMMAND-LINE form. Copy program-list since we may need to modify + it. + * vm-discard-cached-data: set mime layout and mime encoded header + slots to nil in virtual messages. + * vm-session-initialization: initialize gui-button-face if not + already initialized (FSF Emacs only). + * vm-pop-move-mail: check vm-pop-auto-expunge-alist properly; + defaulting did not work as you would expect. + * enable image and multiple font support for Windows (XEmacs only). + * provide Content-Description headers for text surrounding + MIME attachments in compositions. + * vm-forward-message: provide Content-Description header for a + MIME forwarded message. + * use same filename extension as that of the suggested attachment + filename when creating a tempfile for use by an external MIME + viewer. + * New variables: + + vm-infer-mime-types + * vm-pop-check-mail: return nil if UIDL returns an empty list. + * vm-mail-internal: default composition buffer name to "mail to ?" + instead of "*VM-mail*". + * added '$' to regexps in default value of + vm-mime-attachment-auto-type-alist. + * new semantics for vm-mime-external-content-types-alist: %-spec + expansion, shell command line syntax allowed. + * default value of vm-auto-decode-mime-messages changed from nil + to t. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 25 Jun 1998 11:45:44 -0500 + +vm (6.48-1) unstable; urgency=low + + * New upstream version. Excerpted changes: + * New variables: + + vm-spooled-mail-waiting-hook + + vm-mime-uuencode-decoder-program + + vm-mime-uuencode-decoder-switches + * vm-delete-index-file: don't try to delete the file if + vm-index-file-suffix is not a string. + * show completions if completion-auto-help is non-nil. Needed to + replace car with caar in one place in vm-minibuffer-complete-word. + * vm-startup-with-summary: handle 0 case specially so that a + negative number is not passed to nth. + * make vm-mime-preview-composition an alias for + vm-preview-composition, fixing the typo that aliased + vm-preview-mime-composition instead. + * vm-auto-archive-messages: don't archive messages to the same + folder that the user is visiting. + * vm-mime-fsfemacs-encode-composition: encode last MIME part from + point to point-max instead of point-min to point-max. (FSF + Emacs/MULE only.) + * fixed regexp syntax for backslashes in [..] contexts. Need + four backslahses for every one to appear in the regexp. + * vm-discard-cached-data: set the mime-encoded-header-flag to nil. + * vm-mime-burst-message: reverse varref and funcall in `or' expression + to avoid skipping the rest of the vm-mime-burst-layout calls after + the first successful one. + * vm-check-pop-mail: use UIDL data to determine if messages in the + popdrop have been retrieved. + * vm-get-spooled-mail: always set vm-spooled-mail-waiting to nil + after doing a sweep through the spool files, whether mailw as + retrieved or not. Not really correct but it is what the user + expects. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 1 Jun 1998 13:39:24 -0500 + +vm (6.47-2) frozen unstable; urgency=low + + * Fix a typo in the rules that was preventing th eexamples dir from + getting exported. closes: Bug#22407 + + -- Manoj Srivastava <srivasta@debian.org> Wed, 13 May 1998 12:49:18 -0500 + +vm (6.47-1) frozen unstable; urgency=low + + * New upstream BUG FIX version + * Excerpted changes are: + * vm-write-string: bind buffer-read-only to nil before + attempting to modify the buffer. + * vm-auto-select-folder: Do the eval if the cdr of the alist pair + is anything other than a string, instead of it it is anything + other than an atom. + * vm-do-reply: match vm-subject-ignored-prefix against the subject + and don't prepend vm-reply-subject-prefix if there is a prefix + match. + * vm-buffer-to-label: map presentation buffers to the 'message + label. + * vm-scroll-forward: raise and select frame before setting window + configuration. + * vm-frame-totally-visible-p: Consider frame totally visible if + return value of frame-visible-p is not eequal to nil or 'hidden. + * dropped `sender' synonym virtual selectors. + * If prefix arg is given to vm-visit-virtual-folder-* commands, say + "read only" in the prompt string. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 4 May 1998 10:04:15 -0500 + +vm (6.46-4) frozen unstable; urgency=low + + * Added a recommendation for make; and scream loudly if make is not found. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 20 Apr 1998 03:36:12 -0500 + +vm (6.46-3) unstable; urgency=low + + * Fixed broken path in vm-init.el + + -- Manoj Srivastava <srivasta@debian.org> Thu, 16 Apr 1998 01:03:35 -0500 + +vm (6.46-2) frozen unstable; urgency=low + + * Bug fixes in packaging the new emacsen way. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 14 Apr 1998 00:22:25 -0500 + +vm (6.46-1) frozen unstable; urgency=low + + * Now an emacs19 dependent package in the new style + * upstream bug fix release + * Call emacsen install in postinst, and emacsen remove in postrm + * Fixed bad magic numbe in file. closes: Bug#20947 + * Fixed example files. closes: Bug#20946 + * Verified that vm does not unzip files on its own. closes: Bug#20948 + + -- Manoj Srivastava <srivasta@debian.org> Mon, 13 Apr 1998 01:59:43 -0500 + +vm (6.42-1) unstable; urgency=low + + * New upstream version + * New variables: + + vm-pop-expunge-after-retrieving + + vm-pop-auto-expunge-alist + + vm-mime-button-format-alist + * vm-save-message: don't set vm-last-save-folder if it is non-nil + and the user selected folder matches what vm-auto-folder-alist + would have chosen. Tried to do this in 6.41, but broke the + setting of vm-last-save-folder instead. + * vm-expunge-pop-messages: typo prngn -> progn. + * vm-expunge-pop-messages: check whether vm-make-pop-session + returns nil. + * vm-read-attributes: allow header without a label list. The + label part of the data in the header was added later and may + not be in the header of some older folders. + * dropped use of vm-with-virtual-selector-variables in favor of + using an alist. + * only use char-to-int if defined, use identity funciton + otherwise. + + + -- Manoj Srivastava <srivasta@debian.org> Mon, 16 Feb 1998 17:47:07 -0600 + +vm (6.41-1) unstable; urgency=low + + * Modified the copyright statement to include addresses. + * Fixed silly typo in version string + * New upstream version + * New variables: + + vm-index-file-suffix + * New commands: + + vm-expunge-pop-messages + * don't issue DELE commands on POP messages when retrieving. Remember + what messages have been retrieved and avoid retrieving them later. + * vm-save-message: don't set vm-last-save-folder if it is non-nil and + the user selected folder matches what vm-auto-folder-alist would have + chosen. + * vm-show-list: sort list before displaying it. + * vm-show-list: display list ordered top to bottom then left to + right, instead of left to right and then top to bottom. + * bind print-length to nil in some places to avoid truncation of + Lisp Objects in folder headers. + * Added notes all over warning about tm-vm breaking vm, since tm-vm was + written for vm-5.X. It is still possible to use tm for mail + composition. closes: Bug#16862 + + -- Manoj Srivastava <srivasta@debian.org> Fri, 13 Feb 1998 12:55:31 -0600 + +vm (6.40.1) unstable; urgency=low + + * Upgraded to standards version 2.4.0.0 + * Updated FSF address. + * This fixes all Lintian bugs. + * New upstream version. Excerpted changes: + * New variables: + + vm-mime-7bit-composition-charset + * don't grey-out "Decode MIME" toolbar button after a message is + first decoded. Let user use the button to rotate through + decoding states like the 'D' key does. This applies only to + the separate MIME button, not the one that appears as part of + the `helper' button. + * vm-mark-or-unmark-messages-with-selector: removed extra count + argument from `message' call. + * vm-build-virtual-message-list: if dont-finalize is set, don't + set up the location vector or to obarray used to suppress + duplicate messages. In particular the latter causing empty + message lists to be returned since all the messages were + considered duplicates. + * support foregroundToolBarColor symbol in toolbar pixmaps + (XEmacs only). + * vm-rfc1153-or-rfc934-burst-message: Use current buffer as + folder buffer, instead of the buffer of specified message. + * vm-get-new-mail: signal error if we fail to find a folder + buffer through the normal means. + * sleep for 2 seconds instead of 1 second after "consider M-x + revert-buffer" message and after a quit is signaled and caught + in vm-get-spooled-mail. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 9 Feb 1998 16:03:40 -0600 + +vm (6.39-1) unstable; urgency=low + + * New upstream version, with lots of changes + VM 6.39 released (20 January 1998) + * New commands: + + vm-burst-digest-to-temp-folder + + vm-add-existing-message-labels + * vm-vs-header-or-text: vm-header-of -> vm-headers-of. + * fixed reversed fset definition of vm-vs-sender. + * don't grey-out "Decode MIME" menu entry after a message is + first decoded. Let user use menu entry to rotate through + decoding states like the 'D' key does. + * vm-check-emacs-version: Disallow running under Emacs 20. + * vm-mime-display-internal-multipart/digest: genereate summary if + vm-startup-with-summary says so. Did the same for + vm-mime-display-internal-message/partial and + vm-mime-display-internal-message/rfc822. + * default vm-temp-directory to (getenv "TMPDIR") if result is + non-nil. + * vm-undo: signal an error if the current folder is read-only. + * vm-minibuffer-complete-word: set start of word to beginning of + buffers if not doing a multi-word read. + * vm-minibuffer-complete-word: if doing multi-word completion and + the word before point exactly matches something in the completion + list and the word also prefixes something else in the completion + list and last-command eq vm-minibuffer-complete-word, insert + a space, thereby letting the user complete the word. + * vm-mime-display-internal-text/enriched: Don't assume (car + errdata) is a string; it usually isn't. Format error data + properly. + * vm-print-message: write out the tempfile for the non-MIME lobe + of the conditional in the code, since it is needed there also. + * vm-read-virtual-selector: raise the selected frame before + reading from the minibuffer, so the user is less likely to type + into the wrong minibuffer window and hose themselves. + * vm-mime-fsfemacs-encode-composition: set coding-system-for-read + when inserting a file-based attachment to avoid MULE munging. + Protect value of buffer-file-coding-system from possible + changes by insert-file-contents. + VM 6.38 released (15 January 1998) + * add vm-virtual-selector-clause property to new selectors. + * vm-read-virtual-selector: removed hard coded list of selectors + that take an arument. Instead, read arg only for selectors that + have a vm-virtual-selector-arg-type property. + * fixed virtual folder numbering/infloop problem introduced in + 6.37. + * vm-mark-or-unmark-messages-with-virtual-folder: Mark virtual + messages instead of the underlying real messages when current + folder is a virtual folder. + VM 6.37 released (29 December 1997) + * Folders menu code: create directories by default in vm-folder-directory. + * added name parameter to vm-create-virtual-folder for use by + vm-create-virtual-folder-same-author and + vm-create-virtual-folder-same-subject to avoid regexp-quote + goop in the modeline. + * make sure the -should-delete-frame variables in vm-mouse.el are + initialized before use. + * vm-apply-virtual-folder bound to V X. + * added virtual folder selectors for all the attributes that + vm-set-message-attributes accepts. Added un- selectors so that + simple negations can be used with V C. Added header-or-text + selector. Added aliases for some selector names. + * New commands: + + vm-toggle-all-marks (bound to M V). + + vm-mark-matching-messages-with-virtual-folder (bound to M X). + + vm-unmark-matching-messages-with-virtual-folder (bound to M x). + * vm-update-summary-and-mode-line: copy value of default-directory + from folder buffer to the summary and presentation buffers. + * report null results in mark commands as "No message marked" + instead of "0 messages marked". + VM 6.36 released (19 December 1997) + * vm-yank-message: commented out text/html code. + * added toolbar initialization status message (XEmacs only). + * allow integers in the vm-use-toolbar toolbar specification, + which represent blank space in the toolbar. (XEmacs only). + * allow for the possibility that lpr-command and lpr-switches + are unbound. + * restore binding of C-? ; binding the delete keysym doesn't + affect the delete key on a dumb terminal when running FSF + Emacs. + * changed semantics of vm-temp-file-directory. Its value now + must end with the directory separator character used by the + local operating system. + * vm-mime-display-internal-text/enriched: catch errors in + enriched-decode and store it in the MIME layout struct for + future display. + * New commands: + + vm-create-virtual-folder-same-subject (bound to V S) + + vm-create-virtual-folder-same-author (bound to V A) + * vm-write-file: If write-file renames the folder buffer, rename + the summary buffer and presentation buffer to match. + * vm-mime-can-display-internal: don't assume enriched.el is + shipped with Emacs. Assume text/enriched is internally + displayable only if enriched-mode is fbound. + * vm-mime-fragment-composition: supply the "total" parameter in + all message/partial parts instead of just the last one. + * only delete the frame used for completion if VM created it. + * vm-fsfemacs-p: Don't insist on v19. + VM 6.35 released (24 November 1997) + * typo fixes + * Gregory Neil Shapiro's Emacs 20 MULE patches, which inserted + bindings for coding-system-for-read/write in various places. + * renamed vm-fsfemacs-19-p to vm-fsfemacs-p. + * Bound (control /) to vm-undo, bound backspace and delete + keysyms to vm-scroll-backward, dropped binding of "\C-?". + * added ;;;###autoload cookies to all VM entry points. + * vm-session-initialization: require 'vm first to make sure the basic + things are loaded before we try to do anything. + * dropped inline support for text/html. Too much pain right now. + Revisit later. + * recognize po:user type spool file and peaceably hand it off to + movemail. + * vm-mode-internal: install new fucntion vm-unblock-new-mail on + after-save-hook to allow retrieval of mail after a save of an + M-x recover-file'd folder. + * vm-pop-make-session: first argument to buffer-disable-undo is + required under XEmacs 19.14, so provide it. + * Use locate-data-directory if it exists when setting + vm-image-directory. + * vm-mail-internal: insert an extra newline before the inserted signature + so the user doesn't have to type one. (I give.) + * vm-mime-transfer-encode-layout: don't add a + Content-Transfer-Encoding header unless the encoding type of + the layout differs from what we require it to be. + * vm-mime-transfer-encode-region: downcase the return value so + string comparisons don't have to worry about case. QP encode + if armor-dot is set. + * vm-print-message: use a tempfile under Windows 95 or NT. + Apparently the losing print utils there don't understand stdin or + can't read from it. + * vm-mime-text-type-p renamed to vm-mime-text-type-layout-p. + The new version of vm-mime-text-type-p checks the type without a + layout wrapped around it. + * vm-mime-xemacs-encode-composition: For MULE, use binary coding + system when inserting an attached file if the type of the + attachment is not a textual MIME type. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 22 Jan 1998 16:43:30 -0600 + +vm (6.34-2) unstable; urgency=low + + * Make sure the copyright file is not compressed. + closes:Bug#14453,Bug#14468 + + -- Manoj Srivastava <srivasta@debian.org> Wed, 5 Nov 1997 12:05:35 -0600 + +vm (6.34-1) unstable; urgency=low + + * New upstream version. Bug fixes. Changes: + * vm: use other frame if folder is visible there. + * vm-auto-archive-messages: don't silently block archival + attempts to /dev/null; Emacs no longer complains about + writes to /dev/null. + * vm-toolbar-initialize: add line for 'getmail' button support + that got omitted somehow. + * vm-multiple-fonts-possible-p: added win32 as a window system + that supports multiple fonts. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 16 Sep 1997 19:16:23 -0500 + +vm (6.33-2) unstable; urgency=low + + * Mentioned the /usr/doc/vm-vars.el.gz file, since the documentation is + quite outdated. This fixes BUG#11998. + * Got rid of the tar and uuencode directories since now dpkg-source can + handle things correctly. + * Have been using pristine sources, thought this should go on record. + + -- Manoj Srivastava <srivasta@debian.org> Sun, 10 Aug 1997 18:28:08 -0500 + +vm (6.33-1) unstable; urgency=low + + * Chaned post installation script not to redirect input to a scratch + file in /tmp (we use /tmp/emacs/file.new.$$ instead. This fixes + BUG#11787. + * New upstream bug fixing release. Excerpted changes: + * vm-undisplay-buffer: don't delete frames unless both + vm-mutable-windows and pop-up-frames are not non-nil. Loop + over the remaining windows that display the target buffer and + make those windows display some other buffer. + * vm-mime-set-extent-glyph-for-type: use a list of instantiators, + use 'xpm instead of 'autodetect and fallback to [nothing] if + instantiation fails. + * vm-display-face: use the [nothing] instantiator on ttys. XEmcas + only. + * vm-toolbar-install-toolbar: change toolbar size specifier on + frame even if VM did not create the frame. This reverses the + change made in 6.32. + * vm-isearch: call vm-energize-urls to light up the URLs after a + search completes. + * vm-set-window-configuration: return the window configuration we + set. A change in 6.32 caused this not to be done. This confused + vm-display which relied on the return value to determine whether + vm-display-buffer needed to be called. + * don't recognize <URL:...> as an URL if it contains a newline. + * vm-scroll-backwrd: make argument optional. + + -- Manoj Srivastava <srivasta@debian.org> Fri, 1 Aug 1997 16:12:14 -0500 + +vm (6.32-1) unstable; urgency=low + + * This is the first version built with cvs-buildpackage. + * Removed examples subdirectory from the debian directory, instead, the + directory is now tarred, gzipped, and uuencoded, and it is imploded + and exploded on the fly. + * New upstream bug fixing release. Excerpted changes: + * vm-toolbar-install-toolbar: don't change toolbar size specifier + on frame unless VM created the frame. + * vm-mail-send: move attribute change before possible deletion of + the buffer due to vm-keep-sent-messages == nil. + * remove references to vm-record-current-window-configuration + since it is not being used and will never be used. + * vm-mouse-read-file-name-event-handler: don't delete the completion + frame before reading keyboard input. This should avoid making + the user hunt for the frame that contains the correct minibuffer + window to type into. + * default value of vm-mutable-frames changed to t, and the + semantics of this variable have been changed to hopefully be + more like what users expect it to be. + * use cache slot of MIME layout struct as an alist everywhere + to avoid having display functions confuse each other with their + different cache entries. + * vm-mime-display-internal-image-xxxx: use device tag lists to have + a text tag displayed on ttys and the image itself on image-capable + devices. + * added optional `to' argument to vm-mail commands. + * mouse support changed so that it is installed whenever mouse + support may be possible instead of only if it is possible on + the current device.. Significant only under XEmacs currently. + * use multiple frames on ttys, where available. + * vm-scroll-forward: don't scroll if we're auto decoding MIME and + the message needed to be decoded. + * vm-mail-internal: support mail-personal-alias-file, fall back + to ~/.mailrc if it is nil. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 3 Jun 1997 12:41:47 -0500 + +vm (6.31-1) unstable; urgency=low + + * New upstream bug fixing release. Excerpted changes: + * vm-toolbar-support-possible-p: don't check device type, install + toolbar if the 'toolbar feature is present. + * vm-toolbar-initialize: check for device-on-window-system-p + before looking at device-bitplanes, in case the selected device + is a tty. + * use '(win) tag sets on toolbar specifiers to prevent toolbars + from being attached to non-window system frames. + * vm-multiple-fonts-possible-p: conditionalize checks on + XEmacs/Emacs to avoid looking at the window-system variable + under XEmacs where it should not be used. + * set scrollbar height only if (featurep 'scrollbar) and under + XEmacs. Previously we checked if set-specifier was fbound. + * vm-mime-preview-composition: copy value of enriched-mode to + the temp buffer so that the MIME encoding code knows what to do. + * set perms to 600 on MIME tempfiles before writing to them. + There's still a race window where access can be gained to + such files, but it should be very small assuming NFS is not + involved. + * added new 'display-error' slot to the MIME layout struct to + avoid overloading the cache slot... and fixed a bug thereby, due + to vm-mime-display-external-generic trying to use the contents + of the cache slot when there was an error message there. + * vm-mime-display-internal-message/rfc822: bind buffer-read-only + to nil before trying to insert text into the presentation + buffer. + * vm-burst-digest will now descend into nested MIME layouts to find + digests to burst. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 12 May 1997 18:26:44 -0501 + +vm (6.30-3) unstable; urgency=low + + * Added an el package a la Emacs (the elisp files are nearly 1M!), since + I think it is imperative that the uncompiled elisp files be available + for users, but it is not reasonable to unconditionally chew up 1M of + disk space. + * Also install vm-vars.el into the doc (for the old regular package) + directory, since not all customizable variables are documented + elsewhere. + + -- Manoj Srivastava <srivasta@debian.org> Sat, 10 May 1997 22:29:42 -0501 + +vm (6.30-2) unstable; urgency=low + + * Added README.hilit19 + * Added a menu entry for the HTML documentation + + -- Manoj Srivastava <srivasta@debian.org> Thu, 8 May 1997 01:58:21 -0500 + +vm (6.30-1) unstable; urgency=medium + + * New upstream bug fixing release. Excerpted changes: + * vm-mail-send: rename and/or delete the composition buffer + before trying to make the replied/forward/etc. attribute + change, since the user might abort that action. + E.g. "... really edit the buffer?" + * changed code to use XEmacs 20.2 MULE variables and functions + instead of the 20.0 functions. + * treat inlined message/rfc822 like multipart/mixed except we also + insert the forwarded headers message and decode any encoded + words in them. + * support enriched-mode in composition buffers. + * replaced some repeated calls to car with varrefs. + * vm-make-presentation-copy: bind inhibit-read-only to disable + read-only text properties before calling erase-buffer. + * vm-rfc1153-or-rfc934-burst-message: don't insert a traling + message separator if we're bursting the first message. + * rewrote vm-menu-support-possible-p to not factor device type + into it's decision. For a multi-device XEmacs what is not + possible now might be possible later, so let the menus be + instaited even if they aren't necessarily visible on the + currently selected device. + * default value of vm-honor-mime-content-disposition now nil. + * disable the setting of stack-trace-on-error for now. + * fixed a few places where MIME layout vectors were created with + too many slots and one place with too few slots. + * Makefile: doc fixes + * Shapiro typo fixes. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 6 May 1997 16:24:08 -0500 + +vm (6.28-1) frozen unstable; urgency=medium + + * New bugfixing release. Vm has been in feature freeze for a while, + and this release is quite stable (better than the 6.22 release + available before). + Excerpted changes: + * added status messages for vm-mark-all-messages and + vm-clear-all-marks. + * vm-mime-set-extent-glyph-for-type: don't croak on unknown + types. + * vm-thread-mark-for-summary-update: when skipping already marked + messages don't skip the part of the loop that moves the list + pointer forward. :-P + * rerun vm-menu-install-known-virtual-folders-menu after creating + on-the-fly virtual folders because the folder menu gets hosed + by the let-bound value of vm-virtual-folder-alist. + * added hack to vm-mail-send-and-exit to try and imrpvoe window + configuration behvavior under XEmacs when vm-keep-sent-messages + is nil. + * vm-mime-composite-type-p: don't consider message/partial and + message/external-body as a composite types. + * fixed nested MIME encoding to check types recursively all the + way down to make sure the 7bit/8bit rules are followed. + * vm-forward-message: use message/rfc822 instead of multipart/digest. + * vm-send-digest: fixed preamble insert for MIME digests to + insert into the composition buffer instead of directly into the + digest buffer. + * Added to postinst commands to remove obsolete references to vm in + site-start.el files + + -- Manoj Srivastava <srivasta@debian.org> Tue, 22 Apr 1997 01:46:16 -0500 + +vm (6.27-1) unstable; urgency=low + + * New upstream Source + * excerpted changes: + * vm-mime-rewrite-failed-button: add newline to displayed error + string. + * vm-menu-goto-event: use event-closest-point instead of + event-point so that we get locality of point when a click + occurs over a glyph (XEmacs only). + * vm-mime-display-button-xxxx: say "attempt to display" instead of + "display", as the button doesn't know if there is a functional + display function for the type. + * vm-mime-xemacs-encode-composition: dropped calls to + encode-coding-region for now. They were screwing up marker + positions. + * vm-mime-xemacs-encode-composition: protect value of + file-coding-system from changes when inserting attachment file + contents. + * vm-mime-display-internal-text/html: don't call w3-region if it + isn't bound, just set error string and return nil. + * vm-thread-mark-for-summary-update: don't mark if vm-thread-list-of + slot is nil; use nil in this slot to mean we've already marked + this message. + * added missing application/octet-stream button display function. + * Shapiro typo fixes + * copied vm-note-emacs-version to vm-menu.el so that it is + available at load time for use there. + * converted mona stamps to XPMs as XEmacs can't display the GIF versions. + * vm-mime-transfer-encode-layout: mark encoding in transfer + encoded leaves, forgot this previously (oops). + * default value of vm-mime-ignore-mime-version now t. + * restored vm-xemacs-p, vm-xemacs-mule-p and vm-fsfemacs-19-p + function to avoid breaking third party code that rely on them + being present (sigh). + * dropped vm-mime-attach-mime-file from the vm-mail-mode keymap and + menu. + * vm-show-list: binding to button release events in XEmacs didn't + work. Should probably use mouse-track hooks instead of binding + keys but until we do that go back to binding button press events. + * vm-mouse-get-mouse-track-string: check whether we're running + Emacs/XEmacs rather than whether functions are defined to avoid + using the wrong overlay/extent interface. + * initialize mail-default-reply-to from REPLYTO environmental + variable if value is nil (used to be if value is t). + * vm: moved call to vm-preview-current-message after the summary + generatation/display code. The summary might completely + obscure the view of the message buffer, so previewing should + occur after that so that vm-show-current-message knows whether + the message was visible and therefore also knows whether to + mark the message as read. + * vm-keep-mail-buffer: don't kill a buffer if it marked as + modified, even if the number of `kept' messages would be + exceeeded by keeping it. Presumably if a buffer is modified + the user has resumed composing in it and so we should not delete + it. + * added vm-mouse-send-url-to-netscape-new-window and + vm-mouse-send-url-to-mosaic-new-window functions for use as + values of vm-url-browser. + * dropped use of vm-check-for-killed-folder in menubar and + toolbar enabled-p functions. We wrap troublesome calls to + vm-select-folder-buffer in (condition-case ...) now to avoid a + "Folder has been killed" error from hosing the toolbar/mnunebar + and XEmacs permanently. + * don't use application/octet-stream's button function for all + application subtypes. Added a separate function to be used for + subtypes other than octet-stream. + * vm-mime-attach-object: if type is nil, use text/plain as the + type when calling vm-mime-set-extent-glyph-for-type. + * don't fold content-disposition headers if + vm-mime-avoid-folding-content-type is non-nil. + * don't add an extra newline after the unfolded content-type of the + last text subpart. + * vm-mime-preview-composition: remove mail header separator after + the message is encoded since the encoder won't work without it. + * default value of vm-mime-avoid-folding-content-type now t due + to pervasive broken Solaris sendmail installations that mangle + the headers of messages with folded Content- headers. + * vm-mime-make-multipart-boundary: shortened multipart boundaries to + avoid long header lines when vm-mime-avoid-folding-content-type is + t. + * include the missing audio_stamp images in the distribution. + * set version variables at startup and refer to them rather than + calling vm-xemacs-p, etc. repeatedly. + * vm-summary-highlight-region: overlays and extents aren't + interchangable in this context, so behave based on Emacs/XEmacs + version to avoid any overlay/extent emulations, and also to + avoid having make-overlay's sudden appearance give us + heartburn. + * don't fset vm-extent-property, vm-make-extent, etc. unless they + are undefined. This is to avoid changing their definition in + the middle of an Emacs session and thereby mixing usage the + overlay/extent interfaces. + * vm-mime-set-extent-glyph-for-layout: fixed reversed colorfulness + test. + * vm-mime-set-extent-glyph-for-type: mona_stamp is a GIF not an XPM. + * more overlay/extent interface cleanup. + * reenabled internal text/html code. + * vm-yank-message: decode text/html and text/enriched in the + composition buffer. + * attach image glyphs to attachment tags in composition buffers + (XEmacs only). + * print a warning and continue if x-vm- header seems corrupted. + old behavior was to just croak an error and wedge the mailer. + * vm-print-message: default count to 1 if passed no arguments. + * default value of vm-honor-mime-content-disposition now t. + * Makefile: default VM build type is now back to `autoload'. + * vm-rfc1153-or-rfc934-burst-message: use point instead of + (match-end 0) when deleting the message separator. + * vm-rfc1153-or-rfc934-burst-message: trim excessive newlines + only after we know that we are looking at a valid message separator. + * vm-su-message-id: discard chaff preceding message ID. + * vm-mime-fragment-composition: 'send -> '8bit to match + documentation of vm-mime-8bit-text-transfer-encoding. + * vm-mime-fragment-composition: call vm-add-mail-mode-header-separator + at the end so the buffer could be sent again. + * vm-mime-preview-composition: call vm-remove-mail-mode-header-separator. + * avoid starting new timers if old timers are still active (FSF + Emacs only). + * vm-mime-encode-composition: split code into FSF Emacs and + XEmacs functions. This should avoid mixing usage of the extent + and overlay interfaces, which loses with Nuspl's overlay.el + emulation. + * default vm-temp-file-directory to C:\ if /tmp is not a directory + and C:\ is. + * use insert-file-contents instead of insert-file-contents-literally + when inserting MIME attachments into compositions when encoding. + * if vm-auto-displayed-mime-content-types or Content-Disposition + says to display message/rfc822 or message/news inline and + immediately display them as text/plain. If displaying them due + to button activation, use a folder instead. + * use different menu for mailto: URLs since the old one didn't + really do what it advertised, i.e. didn't allow mailto URLs to + be send to other browsers. + * added reduced color MIME art for 8-bit displays that used to only be + used with displays with 16-bit or better displays. + * cache MIME art image glyphs for reuse to save load time. + * wrap calls to timezone-make-date-sortable in (condition-case ...) + to avoid crashing on bad dates. + * gave up on using frame-totally-visible-p since it is still + broken in 19.15. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 17 Apr 1997 20:57:45 -0500 + +vm (6.22-1) unstable; urgency=low + + * New upstream bugfix release + * Excerpted changes : + * vm-save-folder: call clear-visited-file-modtime if folder was deleted + to avoid "File changed on disk" warnings later. + * vm-mime-qp-encode-region: bounds check (1+ inputpos) before using it + to avoid referencing outside a clipping region. + * vm-mime-encode-composition: do the insert/delete dance to avoid text + leaking into overlays in the file insertion case. + * vm-mime-encode-composition: insert-file-contents-literally doesn't + move point. the code assumed it does and corrupted attachments as a + result. + * vm-gobble-crash-box: remove/rename crash box even if it is + zero-length. + + -- Manoj Srivastava <srivasta@debian.org> Mon, 24 Mar 1997 10:21:14 -0600 + +vm (6.20-1) unstable; urgency=low + + * BUG#7775 was already fixed in 6.18-2 + * New upstream version + * Excerpted changes : + * vm-menu-support-possible-p: allow menu code to operate under + NextStep. window-system == ns. + * New variables: + + vm-mosaic-program-switches + + vm-netscape-program-switches + + vm-mime-ignore-mime-version + + vm-presentation-mode-hook (you were right, i was wrong) + * vm-decode-mime-messages: run the highlighting code + * vm-mime-display-internal-multipart/digest: copied folder display + code from the message/rfc822 handler since they should work the + same and message/rfc822 works properly with vm-mutable-windows + == nil. + * make gui-button-face be the unconditional default value for + vm-mime-button-face. + * vm-virtual-quit: make sure vm-message-pointer is non-nil before + trying to run vm-message-id-number-of on it. + * vm-howl-if-eom: don't search other frames for the buffer's + window. Under XEmacs calling select-window on such a window + causes its frame to be selected and it stays selected despite + the call being wrapped in a save-window-excursion. I don't + think we really want to report end of message status in a + window in a non-selected frame anyway. + * removed reference to user-mail-address variable, because it might be + set to nil. + * vm-show-list: bind command to mouse release events instead of + mouse press events in XEmacs. + * vm-preview-current-message: set vm-mime-decoded to nil; it is + not enough to just let vm-make-presentation-copy do this. + * use full contents of References headers to avoid + * insert an X-Mailer in composition buffers. Music! Fun! Horoscopes! + And bug tracking. + * New user data functions: + + vm-user-composition-folder-buffer + + vm-user-composition-real-folder-buffers + * vm-print-message: make printing of MIME message work more like + non-MIME messages; print visible headers, print tags for + non-textual body parts. + * vm-mime-insert-button: don't set keymap parent to be the + current local map unless that map exists (i.e. is non-nil). + * catch errors when decoding encoded words and substitute an error + indicator for the string that we could not parse. + * vm-set-xxxx-flag: don't set attribute flag until after the undo + information is recorded. The buffer modification might be + nixed by the user via the clash detection query, so we need to + be sure we're past that code before committing to the attribute + change. + * vm-set-labels: same as vm-set-xxxx-flag and for same reason. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 18 Mar 1997 15:03:24 -0600 + +vm (6.18-2) unstable; urgency=low + + * New maintainer + + -- Manoj Srivastava <srivasta@debian.org> Fri, 7 Mar 1997 14:55:18 -0600 + +vm (6.18-1) unstable; urgency=low + + * Fixed dww heading + * New version from upstream with lots of changes. + * Excerpted changes : + * New variables: + + vm-mime-composition-armor-from-lines + * use Dispose menu as the mode menu in the presentation buffer. + * vm-mime-encode-composition: do insert/delete dance to avoid + inserting into attachment overlays. + * vm-print-command now decodes the MIME message before printing. + * added 'print' item to mime dispose menu. + * returned to using the day's date as part of the saved crash box + name used when vm-keep-crash-boxes is set. + * added support for message/news type, which is handled mostly + like message/rfc822. + * new mime-dispose menu entries. + * don't check again for new mail if we already know some is waiting. + * add extended status reporting during POP message retrieval. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 4 Mar 1997 10:02:57 -0600 + +vm (6.16-1) unstable; urgency=low + + * New upstream version, with bug fixes. + * The most visible bug-fix is the undefined file-coding-system bug. + + -- Manoj Srivastava <srivasta@debian.org> Tue, 25 Feb 1997 13:56:29 -0600 + +vm (6.15-1) unstable; urgency=low + + * New upstream bugfix release. Changes include: + * move start of attachment tag out of header section. + * vm-mime-preview-composition: don't copy extents under XEmacs. + * use text properties for attachment tags in FSF Emacs. + * vm-mime-attach-file: pass description from interactive spec + into function. + * better handling of M-x vm-mode w.r.t. coding systems under Mule. + * Shapiro typo fixes. + + -- Manoj Srivastava <srivasta@debian.org> Thu, 20 Feb 1997 11:36:39 -0600 + +vm (6.14-1) unstable; urgency=low + + * Made Richard Kettlewell <richard@elmail.co.uk> the maintainer n the control file again + * Added HTML files and an dwww index. + * Since VM stopped supporting older Emacs versions, no longer need to + install itimer. XEmacs ships it by default, and FSF Emacs has an + different timer interface that VM knows how. + * New upstream release. Many changes from previous version. + + -- Manoj Srivastava <srivasta@debian.org> Wed, 19 Feb 1997 13:02:30 -0600 + +vm (6.13-2) unstable; urgency=low + + * Changed priority to optional, as per override file + + -- Manoj Srivastava <srivasta@debian.org> Thu, 13 Feb 1997 14:19:55 -0600 + +vm (6.13-1) unstable; urgency=low + + * Changed postinst and prerm to just install and remove info files, as the + new way of running elisp at startup is the dir /etc/emacs/site-start.d + * Installed vm-init.el in the new /etc/emacs/site-start.d/ directory + * Added error messages to source directory and root checks in debian/rules. + * Give destination directories on command line, rather than edit upstream + Makefile. + * Non-maintainer upgrade to non-beta vm and new packaging conventions. + Now upto Standards-Version: 2.1.2.2 + + -- Manoj Srivastava <srivasta@debian.org> Tue, 11 Feb 1997 14:46:25 -0600 + +Wed Jan 17 00:13:10 1996 Richard Kettlewell <richard@sfere.uk.geeks.org> + + * debian.rules: Cope with deleted package_revision field + + * debian.control: Delete package_revision field; better + description field lifted from info documentation. + +Fri Sep 22 21:30:46 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * debian.control: virtual package support + + * moved to version 5.95beta. This has been unchanged for weeks. + + * debian.rules (version): changed version number + +Sat Aug 12 00:19:23 1995 Richard Kettlewell <richard@elmail.co.uk> + + * debian.site-lisp/vm-init.el: changed the name of this file. + + * debian.site-lisp/vm-init: added mail-mode-smart-tab as posted to + info-vm. + +Wed Aug 9 19:58:31 1995 Richard Kettlewell <richard@elmail.co.uk> + + * debian.{postinst,prerm}: hacked &followlink a bit; better error + handling. + + * download 5.94beta from ftp.uu.net + +Tue Aug 1 22:45:03 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * debian.vm-init: used to be vm-debian, changed it to bring in + line with e.g. the w3-el package. + + * debian.README: fixed version number in pointer to upstream + version. + + * debian.prerm: rewrote in perl, now we follow links properly + + * debian.postinst: rewrote in perl, now we follow links properly + +Fri Jul 28 18:52:35 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * moved ChangeLog to debian.ChangeLog + +Wed Jul 26 18:21:18 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * debian.control (Description): Removed package name from start of + description field. + +Tue Jul 25 10:00:00 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * Released vm-5.92beta-1 (time approximate) + +Sun Jul 23 22:31:12 1995 Richard Kettlewell <richard@sfere.elmail.co.uk> + + * debian.rules: changed version number + + * patched up to 5.92beta + +Wed Jul 19 23:49:25 1995 Richard J Kettlewell <richard@sfere.elmail.co.uk> + + * Makefile: changed directories to point to the right place for + us. + + (clean): clean up things we don't want in the source package diff --git a/debian/clean b/debian/clean new file mode 100644 index 0000000..7b4133c --- /dev/null +++ b/debian/clean @@ -0,0 +1,7 @@ +lisp/vm-autoloads.el +Makefile +config.log +config.status +lisp/vm-cus-load.el +vm-load.el + diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..ec63514 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +9 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..bdd6234 --- /dev/null +++ b/debian/control @@ -0,0 +1,30 @@ +Source: vm +VCS-Git: git://anonscm.debian.org/users/srivasta/debian/vm.git +VCS-Browser: http://git.debian.org/git/?p=users/srivasta/debian/vm.git +Section: mail +Homepage: https://launchpad.net/vm +Priority: optional +Maintainer: Manoj Srivastava <srivasta@debian.org> +Standards-Version: 3.9.5 +Build-Depends-Indep: debhelper (>= 9.0.0), autotools-dev, emacs24, + texinfo, texlive-latex-base, texlive-fonts-recommended + +Package: vm +Architecture: all +Depends: ${misc:Depends}, ucf (>= 0.08), emacs24 | emacsen, make, + dpkg (>= 1.15.4) | install-info +Suggests: exim4 | sendmail | mail-transport-agent, stunnel +Provides: mail-reader +Conflicts: semi, wemi, semi1.12, wemi1.12 +Description: mail user agent for Emacs + VM (View Mail) is an Emacs subsystem that allows UNIX mail to be read + and disposed of within Emacs. Commands exist to do the normal things + expected of a mail user agent, such as generating replies, saving + messages to folders, deleting messages and so on. There are other + more advanced commands that do tasks like bursting and creating + digests, message forwarding, and organizing message presentation + according to various criteria. With smtpmail in modern emacsen, you do + not need an MTA locally in order to use VM. + . + This package does not cater to XEmacs, since vm comes (by default) + bundled in with XEmacs. diff --git a/debian/control.mime-codecs b/debian/control.mime-codecs new file mode 100644 index 0000000..d5f7239 --- /dev/null +++ b/debian/control.mime-codecs @@ -0,0 +1,51 @@ +Source: vm +Section: mail +Priority: optional +Maintainer: Manoj Srivastava <srivasta@debian.org> +Standards-Version: 3.6.2.0 +Build-Depends-Indep: emacs21, texi2html (>= 1.76-1) +Build-Depends: file, emacs21, texi2html (>= 1.76-1) + +Package: vm +Architecture: all +Priority: optional +Section: mail +Depends: ucf (>= 0.08), emacs21 +Recommends: make +Suggests: exim4 | sendmail | mail-transport-agent, mime-codecs +Provides: mail-reader +Conflicts: vm-el, semi, wemi, semi1.12, wemi1.12 +Replaces: vm-el +Description: A mail user agent for Emacs. + VM (View Mail) is an Emacs subsystem that allows UNIX mail to be read + and disposed of within Emacs. Commands exist to do the normal things + expected of a mail user agent, such as generating replies, saving + messages to folders, deleting messages and so on. There are other + more advanced commands that do tasks like bursting and creating + digests, message forwarding, and organizing message presentation + according to various criteria. With smtpmail in modern emacsen, you do + not need an MTA locally in order to use VM. + . + VM 6.x versions have problems with the library tm-vm from the Tiny Mime (TM) + package, since that version was written for VM 5.X. Indeed, the problems + seems to exist with semi as well. + . + This package does not cater to XEmacs, since vm comes (by default) + bundled in with XEmacs. + +Package: mime-codecs +Architecture: any +Section: utils +Priority: optional +Depends: ${shlibs:Depends} +Enhances: vm +Description: Fast Quoted-Printable and BASE64 MIME transport codecs + At its most basic MIME is a set of transfer encodings used to ensure + error free transport, and a set of content types. VM understands the + two standard MIME transport encodings, Quoted-Printable and BASE64, + and will decode messages that use them as necessary. VM has + Emacs-Lisp based Quoted-Printable and BASE64 encoders and decoders, + but you can have VM use external programs to perform these tasks and + the process will almost certainly be faster. This package provides + external executables for Quoted-Printable and BASE64 encoders and + decoders. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..9880f9c --- /dev/null +++ b/debian/copyright @@ -0,0 +1,55 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: vm +Source: <url:https://launchpad.net/vm> +Comment: This package was originally debianized by Richard Kettlewell + <richard@elmail.co.uk>. The current maintainer is Manoj Srivastava + <srivasta@debian.org>. It was originally downloaded from + <url:http://download.savannah.nongnu.org/releases/viewmail/> + + +Files: * +Copyright: Copyright © 1989-2003 Kyle E. Jones + Copyright © 1998-2007 Robert Widhopf-Fenk + Copyright © 1997, 1999-2000 Noah S. Friedman + Copyright © 1999 Rob Hodges + Copyright © 2001-2007 by Ulf Jasper + Copyright © 2004 Kevin Rodgers] + Copyright © 2006 Robert P. Goldman + Manual Copyright © 1989, 1991 Kyle E. Jones +License: GPL-2.0+ + +Files: info/* +Copyright: Copyright © 1989, 1991 Kyle E. Jones +License: GPL-2.0+ +Comment: Permission is granted to make and distribute verbatim copies + of this manual provided the copyright notice and this permission + notice are preserved on all copies. + +Files: src/* +Copyright: no one +License: public-domain + There are fast encoders and decoders for common mime transport + encodings included in this package. These programs are in the public + domain. + + +Files: debian/* +Copyright: 2013 Manoj Srivastava <srivasta@debian.org> +License: GPL-2.0+ + +License: GPL-2.0+ + This package is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + . + This package is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + . + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/> + . + On Debian systems, the complete text of the GNU General + Public License version 2 can be found in "/usr/share/common-licenses/GPL-2". diff --git a/debian/docs b/debian/docs new file mode 100644 index 0000000..5502ed8 --- /dev/null +++ b/debian/docs @@ -0,0 +1,3 @@ +NEWS +README +TODO diff --git a/debian/examples/README b/debian/examples/README new file mode 100644 index 0000000..cd9b914 --- /dev/null +++ b/debian/examples/README @@ -0,0 +1,13 @@ +The files dot.vm, dot.emacs and dot.abbrevs are mine; dot.vm.2 was +contributed by a friend as an alternative example. Edit them to your +personal requirements before trying to use them! + +If there is demand it should be trivial to write a program to +translate between other addressbook formats and the abbrev file +format. (There's no reason you have to use abbrevs for your address +book, but I like it;-) + +README.windows, full_screen and summary_{bottom,right,top} are from +the windows package distributed with the upstream vm source. + +1995-08-19 Richard Kettlewell <richard@elmail.co.uk> diff --git a/debian/examples/README.windows b/debian/examples/README.windows new file mode 100644 index 0000000..989e749 --- /dev/null +++ b/debian/examples/README.windows @@ -0,0 +1,47 @@ +Here are some window configuration files to get your started. +There are comments at the top of each file that describe what +they make VM do. + +Pick one of these files and copy it somewhere, like say +~/.vm.windows. Then put + +(setq vm-window-configuration-file "~/.vm.windows") + +in your .vm file. + +VM's window configuration system works by assigning +configurations to actions. Nearly every VM command can have its +own separate configuration. However, there are also +configurations for classes of actions, like 'startup' and +'composing-message'. These configuration classes cover all the +commands that fit into the class. For example, all the commands +that send out mail fall under the 'composing-message' config. + +If there is no command specific configuration, the class +configuration for that command is used. If there is no class +configuration, then the 'default' configuration is used. If +there is no 'default' configuration, VM does <something> to get +its buffers displayed, and <something> is undefined. If you +don't set up a window configuration VM might start displaying your +folders by skywriting or some such. So, for your privacy's sake, +you should set up window configurations. :) + +To set a configuration, you should use normal Emacs window and +buffer selection and sizing commands to make the screen look like +you want it to look for a particular action. Then run +vm-save-window-configuration. This is bound to W S in vm-mode +buffers, and C-c C-v W S in VM mail-mode and edit-message buffers. +You can of course use M-x vm-save-window-configuration from any +other buffer. You will be asked for a configuration name, and +there is completion for the names. If a configuration for the +name you select already exists, it will be overwritten. + +To delete a configuration, use vm-delete-window-configuration, +bound to W D in vm-mode buffer. The action that you specify will +no longer have a configuration associated with it. + +vm-apply-window-configuration (W W) makes the screen look like a +particular configuration. You might use this as an aid to +setting up configurations based on some common framework. W W is +an easy way to call up a config instead of recreating it each +time. diff --git a/debian/examples/dot.abbrevs b/debian/examples/dot.abbrevs new file mode 100644 index 0000000..1a03373 --- /dev/null +++ b/debian/examples/dot.abbrevs @@ -0,0 +1,16 @@ +;-*-emacs-lisp-*- +; +; Rather than editing abbrevs files directly, it's better to use +; commands like M-X define-mail-abbrev and M-X edit-abbrevs, then save +; them back with M-X write-abbrev-file +; +; (err, this may not be the best way to do it. Watch this space.) +; + +(define-abbrev-table 'mail-abbrevs '( + ("debian-bugs-done" "debian-bugs-done@pixar.com" mail-abbrev-expand-hook 0) + ("debian-announce" "debian-announce@pixar.com" mail-abbrev-expand-hook 0) + ("debian-user" "debian-user@pixar.com" mail-abbrev-expand-hook 0) + ("debian-devel" "debian-devel@pixar.com" mail-abbrev-expand-hook 0) + ("rjk" "Richard Kettlewell <richard@elmail.co.uk>" mail-abbrev-expand-hook 0) + )) diff --git a/debian/examples/dot.emacs b/debian/examples/dot.emacs new file mode 100644 index 0000000..a600d6e --- /dev/null +++ b/debian/examples/dot.emacs @@ -0,0 +1,53 @@ +;-*-emacs-lisp-*- +; +; Various mail-related things I put in my .emacs file +; + +; use abbrevs in (Resent-)?(To|Cc|Bcc): lines + +(add-hook 'mail-setup-hook 'mail-abbrevs-setup) + +; load my address book + +(load-file "~/.abbrevs") + +; set my email address + +(setq user-mail-address "richard@elmail.co.uk") + +; set quoting character for replies + +(setq mail-yank-prefix ">") + +; set default Fcc folder + +(setq mail-archive-file-name "~/mail/sent-mail") + +; see /usr/doc/examples/vm/README.hilit19 for what's going on here + +(cond (window-system + (setq hilit-mode-enable-list '(not text-mode) + hilit-background-mode 'light + hilit-inhibit-hooks nil + hilit-inhibit-rebinding nil) + (require 'hilit19) + (add-hook 'vm-summary-pointer-update-hook 'hilit-rehighlight-buffer) + (add-hook 'vm-select-message-hook 'hilit-rehighlight-buffer) + (hilit-translate comment 'firebrick-bold) + (hilit-set-mode-patterns + 'outline-mode + '(("^\*.*$" nil defun) + )) + )) +;; This will return a list of all the buffers in VM mode: +; (let ((buffers (buffer-list)) +; (vm-buffers '())) +; (while buffers +; (if (eq (save-excursion +; (set-buffer (car buffers)) +; major-mode) +; 'vm-mode) +; (setq vm-buffers +; (cons (car buffers) vm-buffers))) +; (setq buffers (cdr buffers))) +; (nreverse vm-buffers)) diff --git a/debian/examples/dot.vm b/debian/examples/dot.vm new file mode 100644 index 0000000..2385f49 --- /dev/null +++ b/debian/examples/dot.vm @@ -0,0 +1,52 @@ +;-*-emacs-lisp-*- +; +; Example configuration for VM. +; +; Copy this file into ~/.vm and edit to taste; it will be run when vm +; starts up. See the vm manual - under VM in info - for more details. +; +; NOTE to administrators: vm works perfectly OK without this file in +; everyone's home directory. There's no call for it to be copied to +; /etc/skel. +; + +(setq vm-startup-with-summary t) +(setq vm-skip-deleted-messages nil) +(setq vm-circular-folders nil) +(setq vm-preview-lines nil) +(setq vm-highlighted-header-regexp "^From\\|^Subject") +(setq vm-included-text-prefix ">") +(setq vm-reply-subject-prefix "Re: ") +(setq vm-folder-directory "~/mail/") +(setq vm-delete-after-saving t) +(setq vm-move-after-deleting t) +(setq vm-delete-empty-folders) +(setq vm-visible-headers '("Resent-From:" "From:" "Sender:" "To:" "Apparently-To:" "Cc:" "Subject:" "Date:")) + +; A quick tutorial on VM's MIME display variables. + +; vm-display-using-mime controls whether MIME is displayed specially +; at all. Default value is t. + +; vm-auto-decode-mime-messages controls whether a MIME message is +; decoded when the message is selected. Decoding means parsing the +; message to figure out what MIME types are in it. This can be +; slow for large messages, so you might not want it to happen +; automatically. Default value is t. + +; vm-auto-displayed-mime-content-types controls which MIME types +; are displayed immediately after the message is decoded. +; Default value is ("text" "multipart"). + +; vm-auto-displayed-mime-content-type-exceptions lists exceptions +; to the auto-displayed types. So you can specify "text" as an +; auto-displayed type and '("text/html") as the exceptions list to avoid +; immediate display of text/html. Default value is nil. + + + +; For text/html handling you probably want to do this: + +; (add-to-list 'vm-mime-internal-content-type-exceptions "text/html") +; (add-to-list 'vm-mime-external-content-types-alist +; '("text/html" "netscape -remote 'openFILE(%f)' || netscape %f")) diff --git a/debian/examples/dot.vm-auto-spool b/debian/examples/dot.vm-auto-spool new file mode 100644 index 0000000..87b9720 --- /dev/null +++ b/debian/examples/dot.vm-auto-spool @@ -0,0 +1,13 @@ +;; Set vm-spool-files based on all filenames in vm-spool-directory. +;; You probably don't want to do this unless you've set vm-spool-directory +;; to point to a directory used exclusively for your own spool files. + +(cond ((string-equal vm-folder-directory vm-spool-directory) + (error "vm-folder-directory and vm-spool-directory must be different.")) + (t + (setq vm-spool-files + (mapcar '(lambda(spool-name) + (list (concat vm-folder-directory spool-name) + (concat vm-spool-directory spool-name) + (concat vm-folder-directory spool-name ".CRASH"))) + (directory-files vm-spool-directory nil "^[^.]"))))) diff --git a/debian/examples/dot.vm-color b/debian/examples/dot.vm-color new file mode 100644 index 0000000..441f6e4 --- /dev/null +++ b/debian/examples/dot.vm-color @@ -0,0 +1,80 @@ +I find font-locking email very useful for colouring quoted text +differently to the new text. In fact, Gnus manages to colour every +quoted message differently, which is very handy once you get three or +four different people quoting each other. Can you get VM to do this? + +FWIW, here is the relevant bit of my .vm file (i use XEmacs which may +(not) be relevant). Before anyone asks i don't know why i need to use +both vm-mail-mode-hook and mail-setup-hook, but it works for me, and i +can't be bothered to sort it out. + + +(require 'highlight-headers) +;;colours +(set-face-foreground 'message-headers "darkslateblue") +(set-face-foreground 'message-header-contents "brown") +(set-face-foreground 'message-highlighted-header-contents "black") +(set-face-foreground 'message-cited-text "darkgreen") +(make-face-bold 'message-highlighted-header-contents) +(make-face-unitalic 'message-header-contents) + +;;highlighting +(defconst kmc-vm-mail-font-lock-keywords + (purecopy + (list + '("^\\([-a-zA-Z0-9]+:\\)[ ]*\\(.*\\)$" 1 message-headers t) + '("^\\([-a-zA-Z0-9]+:\\)[ ]*\\(.*\\)$" 2 message-header-contents t) + '("Subject[ \t]*:[ ]*\\(.*\\)$" 1 message-highlighted-header-contents t) + (list (concat highlight-headers-citation-regexp + "\\(.*\\)$") 2 'message-cited-text t) + (list (concat "\\(" + highlight-headers-citation-header-regexp + "\\)") 1 'message-headers t) + ))) + +(add-hook 'vm-mail-mode-hook + (lambda () + (setq font-lock-keywords kmc-vm-mail-font-lock-keywords) + )) +(add-hook 'mail-setup-hook + (lambda () + (setq font-lock-keywords kmc-vm-mail-font-lock-keywords) + ) + + +====================================================================== +> I've found it useful when you can display the quoted portion in a +> grey-ish color, rather than my default white on black. It seems to +> make it easier to focus in on the reply parts. Certainly not +> critical, but I'd find it a very nice feature. + + +I had to add a new hook to VM for making that: +vm-presentation-mode-hook. Then, I use the following. It fontifies the +"From" and "Subject" lines, as well as URLs, quoted text and auto-MIME +decode zones. +====================================================================== + +(setq vm-font-lock-words + '(("^Subject: \\(.*\\)$" . font-lock-reference-face) + ("^From: \\(.*\\)" . font-lock-type-face) + ("^[>|}].*" . font-lock-comment-face) + ("^.*\\\[Click .*\\\]$" . font-lock-variable-name-face) + ("\\(file\\|ftp\\|gopher\\|http\\|https\\|news\\|wais\\|www\\)://[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]" . font-lock-string-face) + ) +) + +(defun vm-fontify () + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(vm-font-lock-words t)) + (turn-on-font-lock)) + +(add-hook 'vm-mode-hook + '(lambda () + (local-set-key "r" 'vm-followup) + (vm-fontify))) + +(add-hook 'vm-presentation-mode-hook + '(lambda () + (vm-fontify))) + diff --git a/debian/examples/dot.vm-hide-ref b/debian/examples/dot.vm-hide-ref new file mode 100644 index 0000000..f1863fb --- /dev/null +++ b/debian/examples/dot.vm-hide-ref @@ -0,0 +1,26 @@ +In .emacs + +(defun hide-references-hook () + (save-excursion + (let (lim) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (setq lim (match-beginning 0)) + (goto-char (point-min)) + (cond ((re-search-forward "^References:.*\n\\([ \t].*\n\\)*" lim t) + (let ((o (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put o 'invisible t))))))) + +(defun hide-in-reply-to-hook () + (save-excursion + (let (lim) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (setq lim (match-beginning 0)) + (goto-char (point-min)) + (cond ((re-search-forward "^In-Reply-To:.*\n\\([ \t].*\n\\)*" lim t) + (let ((o (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put o 'invisible t))))))) + +(add-hook 'vm-mail-mode-hook 'hide-references-hook) +(add-hook 'vm-mail-mode-hook 'hide-in-reply-to-hook) diff --git a/debian/examples/dot.vm-hide-ref-2 b/debian/examples/dot.vm-hide-ref-2 new file mode 100644 index 0000000..d38a76d --- /dev/null +++ b/debian/examples/dot.vm-hide-ref-2 @@ -0,0 +1,34 @@ +Here's a hook function that will hide the References header in +VM's mail-mode buffers. This is for Good 'Ol Emacs only; this +won't work under XEmacs. You will notice the cursor behaves as +if the References header is still there... that's because it is +still there. + +(defun hide-references-hook () + (save-excursion + (let (lim) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (setq lim (match-beginning 0)) + (goto-char (point-min)) + (cond ((re-search-forward "^References:.*\n\\([ \t].*\n\\)*" lim t) + (let ((o (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put o 'invisible t))))))) + +(add-hook 'vm-mail-mode-hook 'hide-references-hook) + +Here's the XEmacs version of that function. Required change was +replacing make-overlay with make-extent, and overlay-put with +set-extent-property. + +(defun hide-references-hook () + (save-excursion + (let (lim) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (setq lim (match-beginning 0)) + (goto-char (point-min)) + (cond ((re-search-forward "^References:.*\n\\([ \t].*\n\\)*" lim t) + (let ((o (make-extent (match-beginning 0) (match-end 0)))) + (set-extent-property o 'invisible t))))))) + diff --git a/debian/examples/dot.vm-manoj-current b/debian/examples/dot.vm-manoj-current new file mode 100644 index 0000000..dfd9a88 --- /dev/null +++ b/debian/examples/dot.vm-manoj-current @@ -0,0 +1,653 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; To read mail with VM from an IMAP spool, an entry specifying the ;;; +;;; maildrop is needed in vm-spool-files. This can be configured ;;; +;;; using, for example: ;;; +;;; ;;; +;;; (add-to-list 'vm-spool-files ;;; +;;; '("~/mail/IMAP-INBOX" ;;; +;;; "imap:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD" ;;; +;;; "~/mail/IMAP-INBOX.CRASH")) ;;; +;;; ;;; +;;; where PORT is normally 143. To use IMAP over SSL, use, instead: ;;; +;;; ;;; +;;; (add-to-list 'vm-spool-files ;;; +;;; '("~/mail/IMAP-INBOX" ;;; +;;; "imap-ssl:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD" ;;; +;;; "~/mail/IMAP-INBOX.CRASH")) ;;; +;;; ;;; +;;; where PORT is normally 993. In both cases, if PASSWORD is given ;;; +;;; as *, it will be prompted for the first time that mail is ;;; +;;; retrieved. ;;; +;;; ;;; +;;; By default, messages are removed from the IMAP server after ;;; +;;; retrieving them. This is controlled by the variable ;;; +;;; vm-imap-expunge-after-retrieving, but per-maildrop settings can ;;; +;;; be made in vm-imap-auto-expunge-alist. ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; To read mail with VM from a POP spool, an entry specifying the ;;; +;;; maildrop is needed in vm-spool-files. This can be configured ;;; +;;; using, for example: ;;; +;;; ;;; +;;; (add-to-list 'vm-spool-files ;;; +;;; '("~/mail/POP-INBOX" ;;; +;;; "pop:HOST:PORT:AUTH:USER:PASSWORD" ;;; +;;; "~/mail/POP-INBOX.CRASH")) ;;; +;;; ;;; +;;; where PORT is normally 110. To use POP over SSL, use, instead: ;;; +;;; ;;; +;;; (add-to-list 'vm-spool-files ;;; +;;; '("~/mail/POP-INBOX" ;;; +;;; "pop-ssl:HOST:PORT:AUTH:USER:PASSWORD" ;;; +;;; "~/mail/POP-INBOX.CRASH")) ;;; +;;; ;;; +;;; where PORT is normally 995. In both cases, if PASSWORD is given ;;; +;;; as *, it will be prompted for the first time that mail is ;;; +;;; retrieved. ;;; +;;; ;;; +;;; AUTH will normally be "pass". See the docstring ;;; +;;; of vm-spool-files for the other acceptable values and their ;;; +;;; meanings. ;;; +;;; ;;; +;;; By default, messages are removed from the POP server after ;;; +;;; retrieving them. This is controlled by the variable ;;; +;;; vm-pop-expunge-after-retrieving, but per-maildrop settings can be ;;; +;;; made in vm-pop-auto-expunge-alist. ;;; +;;; ;;; +;;; Other variables controlling POP behaviour include: ;;; +;;; ;;; +;;; vm-pop-bytes-per-session ;;; +;;; vm-pop-max-message-size ;;; +;;; vm-pop-messages-per-session ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'message) +(load-library "vm-autoloads") + +(require 'vm-pine) +(require 'vm-rfaddons) +(require 'vm-thread) +(require 'vm-virtual) +(require 'vm-delete) +(require 'vm-sort) +(require 'bbdb-vm) +(require 'vm-misc) +(require 'vm-mime) +(if window-system + (require 'vm-mouse)) +(bbdb-insinuate-vm) + + +(vm-rfaddons-infect-vm) + +(require 'u-vm-color) +(add-hook 'vm-summary-mode-hook 'u-vm-color-summary-mode) +(add-hook 'vm-select-message-hook 'u-vm-color-fontify-buffer) +(defadvice vm-decode-mime-message (after u-vm-color activate) + (u-vm-color-fontify-buffer-even-more)) +(defadvice vm-fill-paragraphs-containing-long-lines + (after u-vm-color activate) + (u-vm-color-fontify-buffer)) + +(setq-default vm-summary-show-threads t) + +(setq + vm-auto-center-summary 0 + vm-auto-decode-mime-messages t + vm-auto-displayed-mime-content-types + '("text" "multipart" "message/rfc822" "plain text" "mail message" + "text/x-vcard" "text/enriched" ) + + vm-crash-inbox (concat my-mail-dir "/INBOX.CRASH") + vm-delete-after-archiving t + vm-delete-after-bursting t + vm-delete-after-saving t + vm-folder-directory (concat my-mail-dir "/") + vm-follow-summary-cursor t + vm-forwarding-subject-format "Forwarded message from %F, %h %w,%d %m %y" + vm-highlighted-header-regexp (if window-system nil "^From\\|^Subject") + vm-honor-page-delimiters t + vm-honor-mime-content-disposition t + ;; vm-in-reply-to-format "%i:%F's message of %h %w,%d %m %y " + vm-included-text-headers '("\\bFrom\\b" "\\bSubject\\b" "\\bDate\\b") + vm-inhibit-startup-message t + vm-keep-sent-messages 2 + vm-mail-header-from (or user-mail-address (concat (user-login-name) + "@acm.org")) + vm-mime-internal-content-types + '("text" "multipart" "message/rfc822" "plain text" "mail message" + "text/x-vcard" "text/enriched" ) + + vm-mime-8bit-composition-charset "utf-8" + vm-mime-qp-decoder-program "qp-decode" + vm-mime-qp-encoder-program "qp-encode" + vm-mime-base64-decoder-program "base64-decode" + vm-mime-base64-encoder-program "base64-encode" + vm-move-after-deleting t + vm-move-after-killing t + vm-preferences-file "~/etc/vm.preferences" + vm-popup-menu-on-mouse-3 t + vm-preview-read-messages nil + vm-primary-inbox (concat my-mail-dir "/INBOX") + vm-reply-ignored-addresses (list (concat "\\b" (regexp-quote + (user-login-name)) "\\b")) + vm-reply-subject-prefix "Re: " + vm-search-using-regexps t + vm-skip-deleted-messages 0 + vm-skip-read-messages nil + vm-spool-files + (list + (list "INBOX" "~/mbox" "INBOX.CRASH" ) + (list "INBOX" (concat "/var/mail/" (user-login-name)) "INBOX.CRASH" ) + (list "INBOX" (concat "/var/spool/mail/" (user-login-name)) + "INBOX.CRASH" ) + (list "INBOX" (concat "/usr/mail/" (user-login-name)) "INBOX.CRASH" ) + (list "INBOX" (concat "/usr/spool/mail/" (user-login-name)) + "INBOX.CRASH" ) + (list "INBOX" (concat real-home-directory "/var/spool/mail/important") + "INBOX.CRASH" ) + (list "ADMIN" (concat real-home-directory "/var/spool/mail/admin") + "ADMIN.CRASH") + (list "BCAST" (concat real-home-directory "/var/spool/mail/bcast") + "BCAST.CRASH") + (list "CONSULT" (concat real-home-directory "/var/spool/mail/consult") + "CONSULT.CRASH") + (list "DIGITAL" (concat real-home-directory "/var/spool/mail/digital") + "DIGITAL.CRASH") + (list "GCIF" (concat real-home-directory "/var/spool/mail/gcif") + "GCIF.CRASH") + (list "GCIFC" (concat real-home-directory "/var/spool/mail/gcifcases") + "GCIFC.CRASH") + (list "spam" (concat real-home-directory "/var/spool/mail/spam") + "spam.CRASH") + (list "grey" (concat real-home-directory "/var/spool/mail/grey.mbox") + "grey.CRASH") + (list "MISC" (concat real-home-directory "/var/spool/mail/misc") + "MISC.CRASH") + (list "orders" (concat real-home-directory "/var/spool/mail/orders") + "orders.CRASH") + ) + vm-startup-with-summary 1 + vm-strip-reply-headers t + vm-summary-format "%2n%UA%*%a %-17.17UB %-3.3m %2d %4l/%-5c %I\"%s\"\n" + vm-summary-uninteresting-senders (concat "\\b" (regexp-quote + (user-login-name)) "\\b") + vm-summary-uninteresting-senders-arrow "==> " + vm-use-menus t + vm-visit-when-saving 'okay + vm-virtual-folder-alist + '( + ("misc" + (("ADMIN" "BCAST" "MISC" ) ;;;; + (any))) + ) + vm-window-configuration-file "~/etc/vm.windows" +) + +;;; (setq vm-mime-default-face-charsets +;;; '("us-ascii" "iso-8859-1" "iso-8859-2" "iso-8859-3" "iso-8859-4" +;;; "iso-8859-5" "iso-8859-6" "iso-8859-7" "iso-8859-8" "iso-8859-9" +;;; "windows-1251" "windows-1252" "koi8-r" "us-ascii" "X-roman8" +;;; ) +;;; ) +;;; (add-to-list 'vm-mime-default-face-charsets "Windows-1251") +;;; (add-to-list 'vm-mime-default-face-charsets "Windows-1252") +;;; (add-to-list 'vm-mime-default-face-charsets "Windows-1257") + +;; Show all: +(setq vm-mime-default-face-charsets t) + +(setq vm-mime-type-converter-alist + '( + ("text/html" "text/plain" "links -force_html -dump /dev/stdin") + )) + +;;;;(require 'browse-url) +;;;;(defvaralias 'vm-url-browser 'browse-url-browser-function)) + +;;;; Then tell VM that it should not display text/html internally. +;(setq vm-mime-internal-content-type-exceptions '("text/html")) +;(add-to-list 'vm-mime-external-content-types-alist +; '("text/html" "mozilla -remote 'openFILE(%f)' || mozilla %f")) +; setq vm-mime-type-converter-alist +; ;; w3 takes a loong time ... so: +; '( +; ("text/html" "text/plain" "w3m -T \"text/html\" -dump") +; )) + +(setq + vm-netscape-program "firefox" + vm-url-browser 'vm-mouse-send-url-to-netscape + vm-netscape-program-switches nil + ) + + +;(add-to-list 'vm-mime-external-content-types-alist +; '("image/*" "display %f")) + +(defun vm-summary-function-A (m) + (if (string-match "Manoj Srivastava" (vm-su-to m)) "+" " ")) + +;;"%2n %*%a %-17.17F %-3.3m %2d %4l/%-5c \"%s\"\n" +;;"%2n %*%a %-17.17U %-3.3m %2d %4l/%-5c \"%s\"\n" + +(defun my-vm-mode-function () + "Added quitting, no backups, and load a few libs." + (interactive) + (make-local-variable 'version-control) + (setq version-control 'never); keep minimal backups +;; (load-library "jwz-vm-summary") + (require 'sendmail) +;; (load-library "ml-alias") +;; (require 'vm-sort) + (require 'message) + (add-hook 'local-write-file-hooks 'bbdb-offer-save) + ) + +(setq vm-mode-hooks 'my-vm-mode-function) +(add-hook 'vm-quit-hook 'vm-expunge-folder) +(add-hook 'vm-quit-hook 'bbdb-save-db) +;;(bbdb/vm-set-auto-folder-alist) + + +;;; For a while, I used to do a BBDB save only when quitting out of my +;;; primary "in" box. For that, I did this: +;;; (add-hook 'vm-quit-hook +;;; (function +;;; (lambda () +;;; (if (string-equal (buffer-name (current-buffer)) "INBOX") +;;; (progn +;;; (bbdb-save-db)))))) + +(setq mail-yank-ignored-headers + (concat + "^Content-Length:\\|" + "^Content-Type:\\|" + "^Email-Version:\\|" + "^End-of-Header:\\|" + "^End-of-Protocol:\\|" + "^Full-Name:\\|" + "^Message-Version:\\|" + "^Message-Service:\\|" + "^Reply-Path:\\|" + "^Reply-To:\\|" + "^>To:\\|" + "^UA-Content-ID:\\|" + "^UA-Message-ID:\\|" + "^X-at-.*:\\|" + mail-yank-ignored-headers) + ) + + +(defvar vm-ml-ids + '( + "info-vm-request" + "info-mm" + "ange-ftp-lovers" + "info-gnuplot-request" + "lucid-emacs" + "Gutenberg" + "hyperbole" + "auc-tex" + "owner-supercite" + "fsp-discussion" + ) + "*List of strings naming the mailing lists that VM should know + about. VM archives mailing-lists that appear in vm-mailing-lists in + their own folder. See also info on function vm-make-mailinglist-regexp.") + +(defun vm-make-mailing-list-regexp (listname) + "This function is used only to construct the variable + vm-auto-folder-alist. It returns the cons of a regexp and a + foldername. The regexp is supposed to match the To, Cc, or Sender + field in the message. The foldername is the LISTNAME prepended with + \"M-\" and the result is used as the name of the folder to append the + message to." + (cons + (concat + "\\<" listname + "\\|" (upcase listname) + "\\|" listname "-list" + "\\|" (upcase listname) "-LIST" + "\\>") + (concat "M-" listname))) + + +(setq + vm-auto-folder-alist + (list + ;; First we check if this is a mailing-list. The name of the + ;; mailing-list is usually in the To-field, but sometimes in the Cc- + ;; or Sender-field: + + + (cons "To" (mapcar 'vm-make-mailing-list-regexp vm-ml-ids)) + (cons "Cc" (mapcar 'vm-make-mailing-list-regexp vm-ml-ids)) + (cons "Sender" (mapcar 'vm-make-mailing-list-regexp vm-ml-ids)) + ;; if it's not a mailing list, then use sender's name as folder name: + (list "Newsgroups" + (cons "gnu.emacs.sources" "emacs") + ) + (list "Subject" + (cons ".*[oO]pen ?[lL]ook.*" "xnews") + (cons ".*\\(MOTIF\\|X11\\| X \\).*" "x11") + (cons ".*\\(OSF\\).*" "osf1") + (cons ".*[vV][mM].*" "vm") + (cons ".*[cC]\\+\\+.*" "c++") + (cons "Returned mail" "Receipts") + ) + (list "From" + (cons my-login-name-regexp + '(list (list "To" + '( "ART" . "gaylord") + ;; match id with IN% + '( "IN%\"\\([^>@%]+\\)" . + (buffer-substring + (match-beginning 1) (match-end 1))) + ;; match id in <> + '( "<\\([^>@%]+\\)" . + (buffer-substring + (match-beginning 1) (match-end 1))) + ;; match id with @ + '( "\\([^@%:]+\\)[@%]" . + (buffer-substring + (match-beginning 1) (match-end 1))) + ;; match id with :: + '("[^:]+\:\:\\(\\w+\\|\\w+\\W\\w+\\)" . + (buffer-substring + (match-beginning 1) (match-end 1))) + ;; match first word + '("\\(\\w+\\)" . + (buffer-substring + (match-beginning 1) (match-end 1))) + ) + + )) + '("IN%\"\\([^>@%]+\\)" . + (buffer-substring (match-beginning 1) (match-end 1))) + ;; Kyle's catch-all: + '( "ART" . "gaylord") + ;; match id with IN% + '("<\\([^ \t\n\f@%()<>]+\\)[@%]\\([^ \t\n\f<>()]+\\)>" . + (buffer-substring (match-beginning 1) (match-end 1))) + '("<\\([^>]+\\)>" . + (buffer-substring (match-beginning 1) (match-end 1))) +;; '("\\([^ \t\n\f@%()<>]+\\)\\([@%]\\([^ \t\n\f<>()]+\\)\\)?" +;; (buffer-substring (match-beginning 1) (match-end 1))) + ;; match id in <> + '("<\\([^>@%]+\\)" . + (buffer-substring (match-beginning 1) (match-end 1))) + ;; match id with @ + '("\\([^@%:]+\\)[@%]" . + (buffer-substring (match-beginning 1) (match-end 1))) + ;; match id with :: + '("[^:]+\:\:\\(\\w+\\|\\w+\\W\\w+\\)" . + (buffer-substring (match-beginning 1) (match-end 1))) + ;; match first word + '("\\(\\w+\\)" . + (buffer-substring (match-beginning 1) (match-end 1))) + ) + )) + +(if (eq 'x window-system) + (progn + + + (defun vm-highlight-headers (message window) + "Using font-lock; highlight From: and Subject: fields in mail + messages displayed by VM." + (save-excursion + ;; As of v18.52, this call to save-window-excursion is needed! + ;; Somehow window point can get fouled in here, and drag the + ;; buffer point along with it. This problem only manifests + ;; itself when operating VM from the summary buffer, subsequent + ;; to using vm-beginning-of-message or vm-end-of-message. + ;; After running a next or previous message command, point + ;; somehow ends up at the end of the message. + (save-window-excursion + (font-lock-mode 1) + ))) + )) + +(setq tm-vm/automatic-mime-preview nil) + +(defun vm-folder-count () + "Count buffers visiting mail folders." + (save-excursion + (let ((folder-count 0)) + (mapcar (function + (lambda (buf) + (set-buffer buf) + (and (eq major-mode 'vm-mode) + (setq folder-count (+ folder-count 1))))) + (buffer-list)) + folder-count))) + + +(add-hook 'vm-presentation-mode-hook + (lambda () + (or buffer-display-table + ;; Don't let disp-table.el overwrite standard-display-table: + (let ((standard-display-table standard-display-table)) + (setq buffer-display-table (make-display-table)))) + ;; Make A0 (\240) (non-breaking space) display as normal space + (aset buffer-display-table ?\xA0 [\? ]) + (aset buffer-display-table ?\x91 [?\']) + (aset buffer-display-table ?\x92 [?\']) + (aset buffer-display-table ?\x93 [?\"]) + (aset buffer-display-table ?\x94 [?\"]) + (aset buffer-display-table ?\x96 [?\-]) + (aset buffer-display-table ?\x97 [?\-?\-]) + ;; Make ^M invisible: + (aset buffer-display-table ?\x0D []))) + + +(require 'time-date) +(defun my-vm-print-message-with-faces (&optional filename) + "Print the current message to a PostScript printer (or file) with + font information" + (interactive) + (vm-select-folder-buffer) + (let* ((msg (vm-real-message-of (car vm-message-pointer))) + (buffer (set-buffer (if (vm-mime-plain-message-p msg) + (vm-buffer-of msg) + vm-presentation-buffer))) + (subject-line (or (vm-get-header-contents msg "Subject:") + "<No Subject>">)) + (from-line (concat "From: " (or + (vm-get-header-contents msg "From:") + "<No Sender>"))) + (date-line (vm-get-header-contents msg "Date:")) + (time (if date-line (date-to-time date-line) (current-time))) + (dd-mon-yy (format-time-string "%d %b %y" time)) + (hh:mm:ss (format-time-string "%T" time)) + (ps-left-header (list 'subject-line 'from-line)) + (ps-right-header (list "/pagenumberstring load" 'dd-mon-yy 'hh:mm:ss)) + (ps-header-lines 2) + (ps-print-header-frame t)) + (if (null filename) + (ps-print-buffer-with-faces) + (ps-print-buffer-with-faces filename) + ))) + + +(require 'vm-vcard) + +(setq vm-spamassassin-cmd "/usr/bin/spamassassin") + +(defun vm-spamassassin-report-spam () + "Report mail as spam by piping the message to spamassassin in reporting +mode." + (interactive) + (if (y-or-n-p "Are you sure you want to report this message as spam? ") + (vm-pipe-message-to-command + (concat vm-spamassassin-cmd " -r -w " user-mail-address) + nil))) + +(defun vm-spamassassin-add-to-whitelist () + "Add the sender of the message to the spamassassin auto-whitelist, so +that mail from them is not classified as spam again." + (interactive) + (vm-pipe-message-to-command (concat vm-spamassassin-cmd " -W") nil)) + +(require 'vm-menu) +(setq vm-menu-dispose-menu + (append vm-menu-dispose-menu + '( + "---" + ["Add to whitelist" vm-spamassassin-add-to-whitelist vm-message-list ] + ["Report as spam" vm-spamassassin-report-spam vm-message-list ]))) + +;;; ;;; Peronality crisis +;;; (setq rwh-vm-pcrisis-use-vm-mail-wraparound t) +;;; (defadvice mail-text (before call-automorph-with-mail-text activate) +;;; (rwh-vm-pcrisis-automorph) ) +;;; (add-hook 'vm-mail-mode-hook +;;; '(lambda () (local-set-key [f7] 'rwh-vm-pcrisis-automorph))) +;;; +;;; ;;; An action-list can take many forms. The first item in an action-list +;;; ;;; is a string, which may be any of the following: +;;; +;;; ;;; * "pre-function" +;;; ;;; * "reply-buffer-function" +;;; ;;; * "signature" +;;; ;;; * "pre-signature" +;;; ;;; * "set-to-to" +;;; ;;; * If none of the above, a string containing the name of a header to +;;; ;;; add or change in your reply. +;;; +;;;(add-to-list 'rwh-vm-pcrisis-headers-to-save "Original-Sender") +;;; (setq rwh-vm-pcrisis-profiles +;;; '( +;;; ( ;;This first recipe causes the contents of the file ~/.sig +;;; ;; to be inserted as the signature in absolutely all replies. +;;; ("From" ".*") +;;; ("signature" "~/.sig") +;;; ) +;;; ( ;;you DO NOT include a : +;;; ("From" "^president@whitehouse\\.gov$") +;;; ("X-Subliminal-Header-Message" "Please lower my taxes.") +;;; ) +;;; ( ;;the function names should not be placed in quotes. +;;; ("Content-type" "iso-8859-2") ;; Note 3 +;;; ("pre-function" my-vm-variable-changer-8859-2) +;;; ("reply-buffer-function" my-change-kbd-layout-to-polish) +;;; ) +;;; ( ;;To understand this, read *Note pcp Note 4:: +;;; ("Content-type" "html") +;;; ("From" "\"The HTML Police\" <me@my.mail.address>") +;;; ("pre-signature" "~/formletters/why_html_is_bad.txt") +;;; ) +;;; ( +;;; ("Reply-To" "bad_list@some.listserv.com") ;;match-list +;;; ("set-to-to" "Original-Sender")) ;;action-list +;;; ) +;;; ) ) +;;; +;;; +;;; rwh-vm-pcrisis-automorph-profil +;;; +;;; rwh-vm-pcrisis-newmail-profiles +;;; + + + +;;; From: kyle_jones@wonderworks.com (Kyle Jones) + +;;; > Is there anyway I can get a 50/50 split on everything, without having to +;;; > explicitly save to *all* window configurations? + +;;; Yes. You only need to save to the main classes: startup, +;;; reading-message, composing-message, editing-message, and for the +;;; command config for vm-summarize. + +;;; ;;;; +;;; ;;;; Wastebasket support +;;; ;;;; +;;; ;;;; By default, deleted mail goes into the "wastebasket" directory, +;;; ;;;; which is a subdirectory of vm-folder-directory. There is a +;;; ;;;; wastebasket file for each month; the file name format is +;;; ;;;; wastebasket-yymm. +;;; ;;;; + +;;; (require 'cl) + +;;; (defvar *vm-wastebasket-directory* +;;; (concat (file-name-as-directory vm-folder-directory) +;;; (format "wastebasket/wastebasket"))) + +;;; (defvar *vm-wastebasket-months* +;;; '("Jan" "Feb" "Mar" "Apr" "May" "Jun" +;;; "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) + +;;; (defvar *vm-wastebasket-date-regexp* +;;; (concat "\\(" (mapconcat 'identity *vm-wastebasket-months* "\\|") "\\)" +;;; ".*" +;;; "[0-9][0-9]\\([0-9][0-9]\\)")) + +;;; (defun vm-wastebasket () +;;; (format +;;; "%s-%s" +;;; *vm-wastebasket-directory* +;;; (if (fboundp 'time-yymm) ;Use my private hack first +;;; (time-yymm) +;;; (let ((time (current-time-string))) +;;; (string-match *vm-wastebasket-date-regexp* time) +;;; (unless (and (match-beginning 1) (match-beginning 2)) +;;; (error "Unable to extract month and year from current-time-string")) +;;; (let* ((month (substring time (match-beginning 1) (match-end 1))) +;;; (month-number (1+ (position month *vm-wastebasket-months* +;;; :test 'string-equal))) +;;; (year (substring time (match-beginning 2) (match-end 2)))) +;;; (concat year (format "%02d" month-number))))))) + +;;; (defun vm-save-in-wastebasket (&rest ignore) +;;; (interactive) +;;; (vm-save-message (vm-wastebasket))) + +;;; (defun vm-visit-wastebasket (prefix &optional read-only-p) +;;; (interactive "P") +;;; (vm-visit-folder (vm-wastebasket) (or prefix read-only-p))) + +;;; ;;; Move the "d" key to "D", and add "T" to read the wastebasket +;;; (define-key vm-mode-map "D" 'vm-delete-message) +;;; (define-key vm-mode-map "d" 'vm-save-in-wastebasket) +;;; (define-key vm-mode-map "T" 'vm-visit-wastebasket) +(define-key vm-mode-map "#" 'vm-expunge-folder) + + +;; Pop mail service using ssh +;;; # ssh -C -L 4711:mail.server.at.your.domain:110 other.server.at.your.domain + +;;; The above statement will setup a local port (4711) that is +;;; forwarded to the POP port on your mailserver +;;; (mail.server.at.your.domain) via another machine +;;; (other.server.at.your.domain). (The -C flags is not necessary, it +;;; only makes the communication compressed.) + +;;; You can then setup your vm-spool-files to point out this local port like this: + +;;; (setq vm-spool-files +;;; (list (list vm-primary-inbox "localhost:4711:pass:username:*" vm-crash-box))) + + +;;; This will return a list of all the buffers in VM mode: + +;;; (let ((buffers (buffer-list)) +;;; (vm-buffers '())) +;;; (while buffers +;;; (if (eq (save-excursion +;;; (set-buffer (car buffers)) +;;; major-mode) +;;; 'vm-mode) +;;; (setq vm-buffers +;;; (cons (car buffers) vm-buffers))) +;;; (setq buffers (cdr buffers))) +;;; (nreverse vm-buffers)) + +;;; Local Variables: +;;; mode: emacs-lisp +;;; comment-start: ";;; " +;;; End: + diff --git a/debian/examples/dot.vm.2 b/debian/examples/dot.vm.2 new file mode 100644 index 0000000..cd4229d --- /dev/null +++ b/debian/examples/dot.vm.2 @@ -0,0 +1,148 @@ +;-*-emacs-lisp-*- +;From: Ian Jackson <iwj10@cus.cam.ac.uk> +;To: richard@elmail.co.uk (Richard Kettlewell) +;Subject: Re: ~/.vm +;Date: Sat, 12 Aug 95 16:28 BST +; +;Richard Kettlewell writes ("~/.vm"): +;> Do you have a ~/.vm file you would like to contribute to the Debian vm +;> package? +; +;I keep my vm startup stuff in ~/emacs/ian.el. It could probably do +;with a bit of tweaking, but here it is. +; +;Ian. + +; In Emacs 19 only, to override the default mouse bindings (which +; I don't like): +(add-hook 'vm-mode-hook 'unset-down-mouse-3) +(add-hook 'vm-mail-mode-hook 'unset-down-mouse-3) + +; In my term-setup-hook function: +(global-set-key "m" 'vm-mail) +(global-set-key "4m" 'vm-mail-other-window) +(global-set-key "9" 'vm-visit-folder) + +; To purge deleted messages automatically: +(add-hook 'vm-mode-hook + '(lambda () + (local-set-key "Q" 'vm-quit) + (local-set-key "q" "#Q"))) + +; ^X 4 m does the right thing ... +(defun vm-mail-other-window () + "Like `vm-mail' command, but display buffer in another window." + (interactive) + (switch-to-buffer-other-window (current-buffer)) + (vm-mail)) + +; All my general variables +(setq vm-included-text-attribution-format "%F writes (\"%s\"):\n" + vm-reply-subject-prefix "Re: " + vm-folder-directory "~/mail/" + vm-delete-after-saving t + vm-delete-empty-folders t + vm-mutable-windows nil + vm-preview-lines nil + vm-included-text-prefix "> " + vm-confirm-quit 1 + vm-auto-center-summary t + vm-confirm-new-folders t + vm-circular-folders nil + vm-visit-when-saving t + vm-move-after-deleting t + vm-keep-sent-messages t + vm-follow-summary-cursor t + vm-frame-per-composition nil + vm-frame-per-edit nil + vm-frame-per-summary nil + vm-frame-per-folder nil + vm-primary-inbox (concat vm-folder-directory "INBOX") + vm-uninteresting-senders "ian" + vm-spool-files '("~/mbox" "~/mail/Outbound" "~/mail/Record" + "~/mail/Import" "/usr/spool/mail/ian" "~/News/r") + vm-startup-with-summary nil + vm-summary-format "%3n %a %2d %3m %-19.19F %s\n" + mail-archive-file-name "~/mail/Outbound") + + + +; A whole lot of stuff for setting the Precedence header ... +(setq mail-precedence-key-alist + '((?0 . "special-delivery") + (?1 . "air-mail") + (?2 . "first-class") + (?3 . "second-class") + (?5 . "third-class") + (?\ . nil) + (?6 . "bulk") + (?9 . "junk"))) +; +(defun mail-precedence-as-key () + "Set precedence by looking up last command char in mail-precedence-key-alist" + (interactive) + (message "%s" (concat "Precedence [" + (mapconcat '(lambda (c) (char-to-string (car c))) + mail-precedence-key-alist "") + "] ?")) + (let* ((key (read-char)) + (prec (assoc key mail-precedence-key-alist))) + (if prec (mail-precedence (cdr prec)) + (error "mail-precedence-as-key `%s' not found" key)))) +; +(defun mail-precedence-as-key-send-and-exit (arg) + "Set precedence by looking up last command char in mail-precedence-key-alist, +then call send-and-exit." + (interactive "P") + (mail-precedence-as-key) + (execute-kbd-macro "")) +; +(defun mail-precedence (prec) + (save-excursion + (mail-position-on-field "Precedence") + (let ((p (point))) + (beginning-of-line) + (delete-region (point) p) + (if prec + (insert "Precedence: " prec) + (delete-char 1))))) +; +(defun mail-mode-setup-keys () + (local-set-key "" 'mail-precedence-as-key) + (local-set-key "p" 'mail-precedence-as-key-send-and-exit)) +(add-hook 'mail-mode-hook 'mail-mode-setup-keys) +(add-hook 'vm-mail-mode-hook 'mail-mode-setup-keys) +; + + + +; A quick tutorial on VM's MIME display variables. + +; vm-display-using-mime controls whether MIME is displayed specially +; at all. Default value is t. + +; vm-auto-decode-mime-messages controls whether a MIME message is +; decoded when the message is selected. Decoding means parsing the +; message to figure out what MIME types are in it. This can be +; slow for large messages, so you might not want it to happen +; automatically. Default value is t. + +; vm-auto-displayed-mime-content-types controls which MIME types +; are displayed immediately after the message is decoded. +; Default value is ("text" "multipart"). + +; vm-auto-displayed-mime-content-type-exceptions lists exceptions +; to the auto-displayed types. So you can specify "text" as an +; auto-displayed type and '("text/html") as the exceptions list to avoid +; immediate display of text/html. Default value is nil. + + + + + + + + + + + diff --git a/debian/examples/full_screen b/debian/examples/full_screen new file mode 100644 index 0000000..69990ec --- /dev/null +++ b/debian/examples/full_screen @@ -0,0 +1,9 @@ +;-*-emacs-lisp-*- + +;; startup = full screen summary +;; reading-message = full screen folder +;; composing-message = full screen composition +;; editing-message = full screen edit +;; vm-summarize = full screen summary + +((editing-message ((((visibility . t) (top . 80) (left . 200) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil edit)) ((nil nil nil t)))))) (startup ((((visibility . t) (top . 140) (left . 140) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil summary)) ((nil nil nil t)))))) (reading-message ((((visibility . t) (top . 80) (left . 200) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil message)) ((nil nil nil t)))))) (comp diff --git a/debian/examples/summary_bottom b/debian/examples/summary_bottom new file mode 100644 index 0000000..5255262 --- /dev/null +++ b/debian/examples/summary_bottom @@ -0,0 +1,9 @@ +;-*-emacs-lisp-*- + +;; startup = full screen summary +;; reading-message = folder on top, summary on bottom +;; composing-message = composition on top, summary on bottom +;; editing-message = edit on top, summary on bottom +;; vm-summarize = full screen summary + +((editing-message ((((visibility . t) (top . 52) (left . 172) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((- (0 1 80 31) (0 31 80 39)) ((nil edit) (nil summary)) ((nil nil nil t) (nil nil nil nil)))))) (startup ((((visibility . t) (top . 140) (left . 140) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil summary)) ((nil nil nil t)))))) (reading-message ((((visibility . t) (top . 52) (left . 172) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((- (0 diff --git a/debian/examples/summary_right b/debian/examples/summary_right new file mode 100644 index 0000000..5c61771 --- /dev/null +++ b/debian/examples/summary_right @@ -0,0 +1,12 @@ +;-*-emacs-lisp-*- + +;; This is designed for a very wide display. I used a 163 column +;; window under X for this. The screen is split horizontally. + +;; startup = full screen summary +;; reading-message = folder on left, summary on right +;; composing-message = composition on left, folder on right +;; editing-message = edit on left, summary on right +;; vm-summarize = full screen summary + +((editing-message ((((visibility . t) (top . 50) (left . 8) (unsplittable) (minibuffer . t) (modeline . t) (width . 163) (height . 50) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((| (0 1 80 49) (80 1 163 49)) ((nil edit) (nil summary)) ((nil nil nil t) (nil nil nil nil)))))) (startup ((((visibility . t) (top . 140) (left . 140) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil summary)) ((nil nil nil t)))))) (reading-message ((((visibility . t) (top . 50) (left . 8) (unsplittable) (minibuffer . t) (modeline . t) (width . 163) (height . 50) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((| (0 1 diff --git a/debian/examples/summary_top b/debian/examples/summary_top new file mode 100644 index 0000000..2db365c --- /dev/null +++ b/debian/examples/summary_top @@ -0,0 +1,9 @@ +;-*-emacs-lisp-*- + +;; startup = full screen summary +;; reading-message = folder on bottom, summary on top +;; composing-message = composition on bottom, summary on top +;; editing-message = edit on bottom, summary on top +;; vm-summarize = full screen summary + +((editing-message ((((visibility . t) (top . 50) (left . 170) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((- (0 1 80 10) (0 10 80 39)) ((nil summary) (nil edit)) ((nil nil nil nil) (nil nil nil t)))))) (startup ((((visibility . t) (top . 140) (left . 140) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((0 1 80 39) ((nil summary)) ((nil nil nil t)))))) (reading-message ((((visibility . t) (top . 80) (left . 200) (unsplittable) (minibuffer . t) (modeline . t) (width . 80) (height . 40) (menu-bar-lines . 1) (cursor-type . box) (auto-lower) (auto-raise) (icon-type) (vertical-scroll-bars . t) (internal-border-width . 2) (border-width . 2))) (((- (0 diff --git a/debian/patches/0001-debcherry-fixup-patch.patch b/debian/patches/0001-debcherry-fixup-patch.patch new file mode 100644 index 0000000..5b6f399 --- /dev/null +++ b/debian/patches/0001-debcherry-fixup-patch.patch @@ -0,0 +1,2112 @@ +From 2dbc1a70849710bbc17c654dbd7f629ab1a66433 Mon Sep 17 00:00:00 2001 +From: Manoj Srivastava <srivasta@golden-gryphon.com> +Date: Mon, 28 Apr 2014 16:24:32 -0700 +Subject: [PATCH 1/1] debcherry fixup patch + +fc23530 [fix-texinfo-warnings]: More tecinfo warning fixes + - no changes against upstream or conflicts +c4c2399 [fix-texinfo-warnings]: This fixes a FTBS issue + - extra changes or conflicts +6dc310e [topc--base64fix]: base64_decode_multichunk_and_speedup.diff + - no changes against upstream or conflicts +53a7df0 [topic--debian]: Added manual pages for all binaries. + - extra changes or conflicts +2020262 Make sure the autoloads files are generated in the right place + - no changes against upstream or conflicts +7662c40 [topic--debian]: Do not rely on absolute path + - extra changes or conflicts +--- + info/vm-pcrisis.texinfo | 2 +- + info/vm.texinfo | 419 ++++++++++++++++++++++++------------------------ + lisp/Makefile.in | 4 +- + src/Makefile.in | 9 ++ + src/base64-decode.1 | 50 ++++++ + src/base64-decode.c | 105 +++++++----- + src/base64-encode.1 | 51 ++++++ + src/base64-encode.c | 3 +- + src/qp-decode.1 | 51 ++++++ + src/qp-decode.c | 9 +- + src/qp-encode.1 | 51 ++++++ + src/qp-encode.c | 5 +- + 12 files changed, 497 insertions(+), 262 deletions(-) + create mode 100644 src/base64-decode.1 + create mode 100644 src/base64-encode.1 + create mode 100644 src/qp-decode.1 + create mode 100644 src/qp-encode.1 + +diff --git a/info/vm-pcrisis.texinfo b/info/vm-pcrisis.texinfo +index fa2342c..72b8cfa 100755 +--- a/info/vm-pcrisis.texinfo ++++ b/info/vm-pcrisis.texinfo +@@ -1179,7 +1179,7 @@ bear this in mind when you set up the profiles! + + @c *************************************************************************** + +-@unnumberedsubsec vmpc-auto-profiles-file ++@unnumberedsec vmpc-auto-profiles-file + @vindex vmpc-auto-profiles-file + + The variable @code{vmpc-auto-profiles-file} contains the name of the +diff --git a/info/vm.texinfo b/info/vm.texinfo +index 7e06dae..5a03949 100755 +--- a/info/vm.texinfo ++++ b/info/vm.texinfo +@@ -160,7 +160,7 @@ in mail-reading functionality by introducing features like thread + management, virtual folders, automatic archiving of messages and a + full treatment of @acronym{MIME}. VM can interface to other packages + available in Emacs, for remote file access, @acronym{BBDB} address book, +-@acronym{GPG} ++@acronym{GPG} + encryption and Org mode task management etc. It can also invoke + external utilities available on your system such as mail filtering + tools and html rendering tools. +@@ -275,7 +275,7 @@ that the next time the folder is visited VM will know which messages + have been already read, replied to and so on. Typing @kbd{S} + (@code{vm-save-folder}) saves the folder. The default behavior is + that deleted messages are @emph{not} expunged automatically when you +-save a folder. ++save a folder. + The next time you visit the folder any deleted + messages will still be flagged for deletion. @pxref{Deleting Messages}. + +@@ -393,7 +393,7 @@ settings. + @cindex primary inbox + @kbd{M-x vm} causes VM to visit a folder known as your @dfn{primary + inbox}, specified by the variable @code{vm-primary-inbox}. If the +-variable @code{vm-auto-get-new-mail} is set ++variable @code{vm-auto-get-new-mail} is set + non-@code{nil}, VM will gather any new mail that has arrived + and integrate it into your primary inbox. The default setting for your + primary inbox is the local file @file{~/Mail/inbox}, but a variety of +@@ -415,7 +415,7 @@ treats server folders with equal facility. + any local mail folder. The folder name will be + prompted for in the minibuffer. @kbd{M-x vm-visit-pop-folder} and + @kbd{M-x vm-visit-imap-folder} perform similar function for server +-folders. ++folders. + + Once VM has read the folder and assimilated any new mail, the first new or + unread message will be selected, if any. If there is no such message, +@@ -501,7 +501,7 @@ VM transfers the mail from a spool file to a folder via a + temporary file known as the @dfn{crash box}. The variable + @code{vm-crash-box} names the crash box file for the primary inbox. + Or a crash-box name may be created from @code{vm-crash-box-suffix} +-described below. ++described below. + (@pxref{Spool Files}.) + VM first copies the mail to the crash box, truncates the spool file + to zero messages, merges the crash box contents into the +@@ -573,7 +573,7 @@ For example, you can set @code{vm-spool-files} like this + @end example + + @noindent The folder @file{~/INBOX} has two spool files associated +-with it in this ++with it in this + example, @file{/var/spool/mail/kyle} and @file{~/Mailbox}. Another + folder, @file{"~/Mail/bugs"} has one spool file + @file{/var/spool/mail/answerman} associated with it. Note that both of +@@ -597,7 +597,7 @@ to be used to create possible spool file names for folders. Example: + @end example + + @noindent With @code{vm-spool-file-suffixes} set this way, if you +-visit a ++visit a + folder @file{~/mail/beekeeping}, when VM attempts to retrieve new mail for + that folder it will look for mail in @file{~/mail/beekeeping.spool} + and @file{~/mail/beekeeping-} in addition to scanning @code{vm-spool-files} +@@ -648,7 +648,7 @@ mailbox. The retrieved messages can be automatically removed from the + By default VM will retrieve all the messages from a @acronym{POP} mailbox + before returning control of Emacs to you. If the mailbox is + large, the wait could be considerable. If you set +-@code{vm-pop-max-message-size} to a positive numeric value, VM will not ++@code{vm-pop-max-message-size} to a positive numeric value, VM will not + automatically retrieve messages larger than this size. If VM is + retrieving messages because you invoked @code{vm-get-new-mail} + interactively, then VM will ask whether it should retrieve the +@@ -717,7 +717,7 @@ Here is an example: + @cindex @acronym{IMAP} spool files + @cindex maildrop specification + VM can also use @dfn{@acronym{IMAP}} (@dfn{Internet Message Access Protocol}) to +-retrieve mail from a mail server. ++retrieve mail from a mail server. + As with @acronym{POP}, instead of specifying a local file name in the + @code{vm-spool-files} definition, you would give an @acronym{IMAP} maildrop + specification (@ref{maildrop specification}, @ref{@acronym{POP} and @acronym{IMAP} Folders}). +@@ -838,7 +838,7 @@ order to quickly form the summary of the folder. + + @vindex vm-index-file-suffix + To use this feature, set the variable @code{vm-index-file-suffix} to a +-file name extension, e.g., ++file name extension, e.g., + + @example + (setq vm-index-file-suffix "idx") +@@ -914,7 +914,8 @@ following formats: + + @example + ``pop:@var{HOST}:@var{PORT}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' +-``imap:@var{HOST}:@var{PORT}:@var{MAILBOX}:@var{AUTH}:@var{USER}:@var{PASSWORD}''@end example ++``imap:@var{HOST}:@var{PORT}:@var{MAILBOX}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' ++@end example + + @noindent Remote mailboxes accessed by VM in this fashion are referred + to as @dfn{server folders} (and @dfn{@acronym{POP} folders} or @dfn{@acronym{IMAP} +@@ -952,7 +953,7 @@ have VM speak @acronym{POP} over an @acronym{SSL} connection. Use + replace @samp{imap} with @samp{imap-ssl} or @samp{imap-ssh}, as needed. + + @cindex @acronym{SSL} +-@cindex @acronym{TLS} ++@cindex @acronym{TLS} + @dfn{@acronym{SSL}} refers to a protocol called @dfn{secure sockets layer}, + which allows you to securely communicate with a mail server using encryption + technology. A newer version of the same protocol is called +@@ -984,7 +985,7 @@ establish a port-forwarded connection to the mail server. (SSH must be able + to authenticate without a password, which means you must be using .shosts + authentication or RSA.) + +-@var{HOST} is the host name of the mail server. ++@var{HOST} is the host name of the mail server. + + @cindex port, TCP + @var{PORT} is the TCP port number to connect to. The normal port +@@ -1066,7 +1067,7 @@ machine HOST login USER password PASSWORD port PORT + + @noindent where HOST, USER, PASSWORD and PORT are as detailed above. + Ensure that the variable @code{auth-sources} is customized to refer to +-your authinfo file. ++your authinfo file. + @xref{Help for users,, Help for users, auth , Emacs auth-source}. + Then VM will read passwords from the file and you + don't need to type them in when accessing mail servers. +@@ -1168,7 +1169,7 @@ need to specify the password for @acronym{POP} accounts in this definition. + @node @acronym{IMAP} Folders,, @acronym{POP} Folders, @acronym{POP} and @acronym{IMAP} Folders + @unnumberedsubsec @acronym{IMAP} Folders + @cindex @acronym{IMAP} +-@cindex message attributes ++@cindex message attributes + @cindex message labels + + @findex vm-visit-imap-folder +@@ -1184,7 +1185,7 @@ Here, ``account-name'' is the name of an @acronym{IMAP} account declared in + @vindex vm-imap-folder-cache-directory + When you visit an @acronym{IMAP} folder, VM will + download copies of the messages that it finds there for you to read. +-These messages are saved locally in a cache folder on the disk, in the ++These messages are saved locally in a cache folder on the disk, in the + directory specified by @code{vm-imap-folder-cache-directory} (or + @code{vm-folder-directory} if the former is not defined). + @vindex vm-imap-folder-cache-directory +@@ -1207,8 +1208,7 @@ The variable's value should be an associative list of the form: + ((@var{IMAPDROP} @var{NAME}) ...) + @end example + +-@var{IMAPDROP} is an @acronym{IMAP} maildrop specification (@ref{maildrop +- specification}). ++@var{IMAPDROP} is an IMAP maildrop specification (@ref{maildrop specification}). + + @var{NAME} is a string that should give a less cumbersome name that you + will use to refer to this maildrop when using @code{vm-visit-imap-folder}. +@@ -1313,7 +1313,7 @@ them. So, the changes made to the folders will be lost after you quit + VM. If you set it to @code{nil}, then VM refrains from reading and + writing the Thunderbird status flags. In this case, the changes made to + the folders are visible inside VM even after revisiting, but they will have +-no effect for Thunderbird. ++no effect for Thunderbird. + + WARNING: Keep in mind that all this applies to changes to message + attributes only. If you @i{expunge} a folder, then the deleted messages +@@ -1336,7 +1336,7 @@ saving messages will be taken from the variable + directory where Thunderbird stores its folders. The folders visited + using @code{M-x vm-visit-folder} will continue to be found in + @code{vm-folder-directory}, thus allowing you to manage the two spaces +-separately. ++separately. + + If, on the other hand, you want to maintain a single space where VM + and Thunderbird can jointly operate, then you should set the variable +@@ -1427,7 +1427,7 @@ spool, it is possible that the new mail might get retrieved into + another mail client and your ``Mail'' indicator won't reflect the + situation. If you need to be particular about new mail in such a + situation, then you should set the variable +-@code{vm-mail-check-always}. ++@code{vm-mail-check-always}. + + @node Crash Recovery,, Getting New Mail, Starting Up + @section Crash Recovery +@@ -1818,14 +1818,14 @@ faces}.) + @vindex vm-word-wrap-paragraphs + Sometimes you will receive messages that contain lines that are + too long to fit on your screen without wrapping. Setting +-@code{vm-word-wrap-paragraphs} to t will cause VM to use the ++@code{vm-word-wrap-paragraphs} to t will cause VM to use the + @file{longlines.el} library by Grossjohann, Schroeder and Yidong to + carry out word wrapping. You must have this library installed + somewhere on your @code{load-path}. Another way to deal with the + problem is to use the @code{visual-line-mode} in Emacs 23. You can + activate it automatically for viewing messages by adding the function + @code{turn-on-visual-line-mode} to the +-@code{vm-presentation-mode-hook}. ++@code{vm-presentation-mode-hook}. + + If you are unable to use either of these solutions, then you can use + Emacs's paragraph filling facility. If you set +@@ -1932,7 +1932,7 @@ those buttons. + + After decoding you will see either the decoded @acronym{MIME} objects or + button lines that must be activated to attempt display of the +-@acronym{MIME} object. ++@acronym{MIME} object. + + @vindex vm-mime-auto-displayed-content-types + @vindex vm-mime-auto-displayed-content-type-exceptions +@@ -1983,7 +1983,7 @@ used move to particular buttons within the message presentation. + @kindex $ w + @kindex $ p + @kindex $ d +-@kindex $ e ++@kindex $ e + @findex vm-mime-reader-map-pipe-to-command + @findex vm-delete-mime-object + @findex vm-mime-reader-map-display-using-default +@@ -2030,7 +2030,7 @@ directory to save the attachments in. The @acronym{MIME} attachments can also + be deleted directly from the message bodies with @kbd{$ d} + (@code{vm-delete-mime-object}). The variable + @code{vm-mime-confirm-delete} controls whether a confirmation is asked +-for. ++for. + + It is a good idea to use @code{vm-mime-delete-after-saving} to delete + saved attachments instead of deleting them manually, because with the +@@ -2116,7 +2116,7 @@ variable. + + @vindex vm-mime-internal-content-type-exceptions + The variable @code{vm-mime-internal-content-type-exceptions} serves as +-the exception list for @code{vm-mime-internal-content-types}. Its value ++the exception list for @code{vm-mime-internal-content-types}. Its value + should be a list of types that should not be displayed internally. + + @cindex @acronym{HTML} +@@ -2128,15 +2128,15 @@ displayed in Emacs using a variety of packages. VM knows about: + @cindex w3m + @cindex w3 + @multitable @columnfractions .15 .85 +-@item lynx ++@item lynx + @tab The @command{lynx} browser used externally to convert @acronym{HTML} + to plain text +-@item w3m ++@item w3m + @tab The @command{w3m} browser used externally to convert @acronym{HTML} + to plain text +-@item emacs-w3 ++@item emacs-w3 + @tab The @samp{Emacs/W3} browser used internally in Emacs +-@item emacs-w3m ++@item emacs-w3m + @tab The @samp{Emacs/W3M} browser used internally in Emacs + @end multitable + +@@ -2249,12 +2249,12 @@ As with the internal type list, there is an exception list that + you can use to specify types that you do not want displayed + externally. When VM is considering whether it should + automatically launch an external viewer, it will consult the +-variable @code{vm-mime-external-content-type-exceptions}. If the ++variable @code{vm-mime-external-content-type-exceptions}. If the + type to be displayed is listed, VM will not launch a viewer. + This allows you to setup viewers for types that ordinarily you + would not want VM to display or for types that you normally want + to convert to some other type using @code{vm-mime-type-converter-alist}. +-You can still display such a type with an external viewer by using ++You can still display such a type with an external viewer by using + @kbd{$ e}. + + @vindex vm-mime-attachment-auto-suffix-alist +@@ -2293,7 +2293,7 @@ Example: + ) + @end example + +-@noindent VM will search the list for a matching type. The suffix ++@noindent VM will search the list for a matching type. The suffix + associated with the first type that matches will be used for the + temporary filename. + +@@ -2316,13 +2316,13 @@ function @code{image-type-available-p} with an image type such as + @vindex vm-mime-auto-displayed-content-types + Assuming that a particular image type, say @samp{tiff} is available, + you can include its @acronym{MIME} type in +-@code{vm-mime-internal-content-types}, e.g., ++@code{vm-mime-internal-content-types}, e.g., + @example + (add-to-list 'vm-mime-internal-content-types "image/tiff") + @end example + You can also add the @acronym{MIME} type to the variable + @code{vm-mime-auto-displayed-content-types} so that VM will +-automatically display all images of the type. ++automatically display all images of the type. + If the type is not included among the auto-displayed types, then the + image is initially shown as a button with a thumbnail image. Clicking on the + button with the middle mouse button expands the image to its full size. +@@ -2494,22 +2494,22 @@ The first matching list element will be used. Be sure to include the + of causing error messages. + + @vindex vm-mime-charset-font-alist +-The variable @code{vm-mime-charset-font-alist} tells VM what font to use ++The variable @code{vm-mime-charset-font-alist} tells VM what font to use + to display a character set that cannot be displayed using + the default face. The value of this variable should be an + assoc list of character sets and fonts that can be used to display + them. The format of the list is: +- +-( (@var{CHARSET} . @var{FONT}) ...) +- +-@var{CHARSET} is a string naming a @acronym{MIME} registered character set such ++ ++( (@var{CHARSET} . @var{FONT}) ...) ++ ++@var{CHARSET} is a string naming a @acronym{MIME} registered character set such + as @samp{"iso-8859-5"}. +- ++ + @var{FONT} is a string naming a font that can be used to display + @var{CHARSET}. +- +-An example setup might be: +- ++ ++An example setup might be: ++ + @example + (setq vm-mime-charset-font-alist + '( +@@ -2597,19 +2597,19 @@ really have a specific @acronym{MIME} type. For example, a JPEG image + might be sent using @samp{application/octet-stream} type instead + of @samp{image/jpeg}, which would be the correct type. In many + cases the filename sent along with the mistyped file +-(e.g. @file{foo.jpg}) suggests the correct type. ++(e.g. @file{foo.jpg}) suggests the correct type. + + @vindex vm-infer-mime-types + If the variable +-@code{vm-infer-mime-types} is set non-@code{nil}, VM will attempt to use +-the filename sent with a @acronym{MIME} attachment to guess an attachment's ++@code{vm-infer-mime-types} is set non-@code{nil}, VM will attempt to use ++the filename sent with a @acronym{MIME} attachment to guess an attachment's + type if the attachment is of type @samp{application/octet-stream}. + + @vindex vm-infer-mime-types-for-text + If the variable + @code{vm-infer-mime-types-for-text} is set non-@code{nil}, VM will + attempt to use filenames for attachments of type @samp{text/plain} as +-well. ++well. + + @node Sending Messages, Saving Messages, Reading Messages, Top + @chapter Sending Messages +@@ -2638,11 +2638,11 @@ the copy is prepended with the value of the variable + with the text. Point is left before the inserted text, the mark after. + Any hook functions bound to @code{mail-yank-hooks} are run, after inserting + the text and setting point and mark. If a prefix argument is given, +-this tells VM: ignore @code{mail-yank-hooks}, don't set the mark, don't +-prepend the ++this tells VM: ignore @code{mail-yank-hooks}, don't set the mark, don't ++prepend the + value of @code{vm-included-text-prefix} to every yanked line, and don't yank + any headers other than those specified in +-@code{vm-visible-headers} and @code{vm-invisible-headers}. ++@code{vm-visible-headers} and @code{vm-invisible-headers}. + + @item @code{M-x vm-yank-message-other-folder} + This allows one to yank a message from a different folder than the +@@ -2656,19 +2656,19 @@ with C-c C-v. + @vindex vm-send-using-mime + @cindex drag and drop + @item C-c C-a (@code{vm-attach-file}) or drag-and-drop a file +-Attaches a file to the composition. When you send the message, VM ++Attaches a file to the composition. When you send the message, VM + will insert the file and @acronym{MIME} encode it. The variable + @code{vm-send-using-mime} must be set non-@code{nil} for this command to work. +-You will be asked for the file's type, and a brief description of ++You will be asked for the file's type, and a brief description of + the attachment. The description is optional. If the file's type + is a text type, you will also be asked for the character set + in which the text should be displayed. + The new attachment will appear as a highlighted tag in the + composition buffer. You can use mouse button 3 on this tag + to set the default content disposition of the attachment. The +-content disposition gives a hint to the recipient's mailer how to +-treat the attachment. Specifically the disposition will indicate +-whether the attachment should be displayed along with the message ++content disposition gives a hint to the recipient's mailer how to ++treat the attachment. Specifically the disposition will indicate ++whether the attachment should be displayed along with the message + or saved to a file. Any text in the composition that appears + before the tag will appear in a @acronym{MIME} text part before the + attachment when the message is encoded and sent. Similarly, any +@@ -2765,7 +2765,7 @@ header lines that you can fill in. The @code{From} header is usually + standard and contains your email address. You can have VM fill it in + for you + automatically by setting the variable @code{vm-mail-header-from}. (It is +-@code{nil} by default.) ++@code{nil} by default.) + + @vindex vm-mail-use-sender-address + The variable @code{vm-mail-use-sender-address}, if set to @code{t}, asks VM +@@ -2779,7 +2779,7 @@ older message.) + The variable + @code{vm-mail-mode-hidden-headers} can be used to hide some of the + header lines from the mail composition buffer. By default, the +-headers ``References'' and ``X-Mailer'' are hidden. ++headers ``References'' and ``X-Mailer'' are hidden. + + @vindex vm-mail-header-insert-date + @vindex vm-mail-header-insert-message-id +@@ -2814,7 +2814,7 @@ composition and will analyze your message when you send it and + * @acronym{MIME} preview:: Previewing a @acronym{MIME} message before sending. + @end menu + +-@node @acronym{MIME} attachments, @acronym{MIME} characters, Sending @acronym{MIME} Messages, Sending @acronym{MIME} Messages, ++@node @acronym{MIME} attachments, @acronym{MIME} characters, Sending @acronym{MIME} Messages, Sending @acronym{MIME} Messages + @unnumberedsec @acronym{MIME} attachments + + @kindex C-c C-a +@@ -2822,7 +2822,7 @@ composition and will analyze your message when you send it and + To attach a file to your composition, use @kbd{C-c C-a} + (@code{vm-attach-file}). VM will ask you for the name of the + file, its type, a brief description and its character set if it is a +-text attachment. ++text attachment. + + An attachment will be represented in the composition as a tag line + like this +@@ -2853,7 +2853,7 @@ disposition for all @acronym{MIME} types except @samp{application} and + + @kindex C-c C-b + @findex vm-attach-buffer +-To attach a buffer instead of a file, use @kbd{C-c C-b} (normally ++To attach a buffer instead of a file, use @kbd{C-c C-b} (normally + bound to @code{vm-attach-buffer}. You must not kill the + buffer that you attach until after the message has been sent. + +@@ -2868,7 +2868,7 @@ Alternatively, you can mark one or more messages in the parent folder + before invoking this command. All the marked messages will be + attached as a digest in the outgoing message. + +-@unnumberedsubsubsec Point-to-point attachment operations ++@unnumberedsubsec Point-to-point attachment operations + + @cindex point-to-point attachment operations + A number of @dfn{point-to-point operations} allow you to attach objects +@@ -2920,7 +2920,7 @@ set. + + @vindex vm-mime-8bit-composition-charset + If there are character codes in the composition greater than 128, the +-variable @code{vm-mime-8bit-composition-charset} tells VM what character ++variable @code{vm-mime-8bit-composition-charset} tells VM what character + set to assume when encoding the message. The default is + @samp{iso-8859-1}. + +@@ -2958,7 +2958,7 @@ The internet standards specify that the header lines of messages should + always be in 7 bit ASCII, even if the body of a message can use an + 8 bit character set. If you use other non-ASCII characters in typing + the headers then VM encodes their words using the @acronym{MIME} encoded-word +-syntax, which is of the form @code{=?charset?encoding?encoded text?=}. ++syntax, which is of the form @code{=?charset?encoding?encoded text?=}. + + @vindex vm-mime-encode-headers-regexp + @vindex vm-mime-encode-headers-type +@@ -2972,7 +2972,7 @@ encoding by setting the variable @code{vm-mime-encode-headers-type}. + @vindex vm-mime-encode-words.regexp + @vindex vm-mime-encode-headers-words-regexp + The variables @code{vm-mime-encode-words.regexp} and +-@code{vm-mime-encode-headers-words-regexp} control what is ++@code{vm-mime-encode-headers-words-regexp} control what is + meant by a ``word'' for VM for the purpose of encoding. By default, the + words are those containing any 8 bit character and delimited by white + space characters. +@@ -3057,7 +3057,7 @@ negative) @var{n-1} messages as well as the current message. Also, all + the reply commands set the ``replied'' attribute of the messages to + which you are responding, but only when the reply is actually sent. The + reply commands can also be applied to marked messages. (@pxref{Marking +-Messages}.) ++Messages}.) + + @vindex vm-reply-ignored-addresses + If you are one of multiple recipients of a message and you use @kbd{f} +@@ -3120,9 +3120,9 @@ message is sent. The format of the button in this case looks like: + @vindex vm-mime-alternative-yank-method + When citing a @code{multipart/alternative} @acronym{MIME} component, VM chooses the + alternative specified by the variable +-@code{vm-mime-alternative-yank-method}. It can ++@code{vm-mime-alternative-yank-method}. It can + be defined similar to the variable +-@code{vm-mime-alternative-show-method}. (@pxref{multipart/alternative}.) ++@code{vm-mime-alternative-show-method}. (@pxref{multipart/alternative}.) + + @vindex vm-fill-paragraphs-containing-long-lines-in-reply + @vindex vm-fill-long-lines-in-reply-column +@@ -3144,7 +3144,7 @@ Alternatively, you can fill individual paragraphs manually using + The method of @acronym{MIME} decoding for included text is relatively new in VM. + The older methods are the inclusion of plain text, due to Kyle Jones, + and the inclusion of text from the Presentation buffer, due to Robert +-Fenk. ++Fenk. + + @vindex vm-included-mime-types-list + @vindex vm-include-text-basic +@@ -3185,7 +3185,7 @@ the variables @code{vm-included-text-headers} and + @section Forwarding Messages + + VM has four commands to forward messages: @kbd{z} +-(@code{vm-forward-message}), ++(@code{vm-forward-message}), + @kbd{Z} (@code{vm-forward-message-plain}), + @kbd{@@} (@code{vm-send-digest}) and + @kbd{B} (@code{vm-resend-message}). +@@ -3196,12 +3196,12 @@ VM has four commands to forward messages: @kbd{z} + @kindex z + Typing @kbd{z} (@code{vm-forward-message}) puts you into a VM Mail + mode buffer just like @kbd{m}, except that the current message appears +-as the body of the message in the VM Mail mode buffer. ++as the body of the message in the VM Mail mode buffer. + + @vindex vm-forwarding-digest-type + The forwarded message is encapsulated as specified by the variable + @code{vm-forwarding-digest-type}. Recognized values are @code{nil}, "mime", +-"rfc934" and "rfc1153". The default is "mime". ++"rfc934" and "rfc1153". The default is "mime". + + If @code{vm-forwarding-digest-type} is set to @code{nil}, the forwarded + message is not encapsulated. It is included in a plain text form. Any +@@ -3227,7 +3227,7 @@ the variables @code{vm-forwarded-headers} and + they are used differs based on the form of forwarding used. + + @itemize +-@item ++@item + For encapsulated forwarding, the default is to forward all + the headers, but you can limit the forwarded headers by setting + @code{vm-unforwarded-header-regexp} to a regular expression. All the +@@ -3242,13 +3242,13 @@ latter is set to a regular expression, then the headers matching it are + omitted. Otherwise, only the headers listed in + @code{vm-forwarded-headers-plain} are included. The default settings + forward only the headers ``From'', ``To'', ``Cc'', ``Subject'', ``Date'' and +-``In-Reply-To''. ++``In-Reply-To''. + @end itemize + + @findex vm-forward-message-all-headers + The command @code{vm-forward-message-all-headers} forwards the + message with all headers intact, irrespective of the values of these +-variables. ++variables. + + @vindex vm-forwarding-subject-format + If the variable +@@ -3390,7 +3390,7 @@ folders on the @acronym{IMAP} server. + You can override the effect of @code{vm-imap-save-to-server} by using + the specialized commands @code{vm-save-message-to-local-folder} + and @code{vm-save-message-to-imap-folder}, which do what their names +-indicate. ++indicate. + + @vindex vm-confirm-new-folders + If the value of the variable @code{vm-confirm-new-folders} is +@@ -3425,7 +3425,7 @@ command. There is a separate variable + works like @code{vm-delete-after-saving} but applies to the @kbd{A} + (@code{vm-auto-archive-messages}) command (see below). + +-@unnumberedsubsec vm-auto-folder-alist ++@unnumberedsec vm-auto-folder-alist + + @vindex vm-auto-folder-alist + The variable @code{vm-auto-folder-alist} is used to specify +@@ -3441,12 +3441,12 @@ list of the form: + + @noindent where @var{header-name} and @var{regexp} are strings, and + @var{folder-name} is a string or an s-expression that evaluates to a +-string. The value of @var{folder-name} can be ++string. The value of @var{folder-name} can be + + @itemize +-@item ++@item + the absolute path name of a local folder, +-@item ++@item + a relative path name -- relative to @code{vm-folder-directory} or the + @code{default-directory} of the currently visited folder, whichever is + non-nil, or +@@ -3458,7 +3458,7 @@ If any part of the contents of the message header named by + @var{header-name} is matched by the regular expression + @var{regexp}, VM will evaluate the corresponding + @var{folder-name} and use the result as the default when +-prompting for a folder to save the message in. ++prompting for a folder to save the message in. + + When @var{folder-name} is evaluated, the current buffer will contain only + the contents of the header named by @var{header-name}. It is safe to +@@ -3498,7 +3498,7 @@ prefix argument, confirmation will be requested for each save. + Runs a shell command with some or all of the current message as input. + By default, the entire message is used. However, the leading and + trailing message separator lines are not included. When applied to +-multiple messages, the command is invoked on each message individually.@* ++multiple messages, the command is invoked on each message individually.@* + If invoked with one @t{C-u} the text portion of the message is used.@* + If invoked with two @t{C-u}'s the header portion of the message is used.@* + In invoked with three @t{C-u}'s the visible headers and the text +@@ -3520,7 +3520,7 @@ messages in the mbox format. In contrast to + @code{vm-pipe-message-to-command}, the leading and trailing separator + lines are included. This behaviour can be altered using the variables + @code{vm-pipe-messages-to-command-start} and +-@code{vm-pipe-messages-to-command-end}. ++@code{vm-pipe-messages-to-command-end}. + @findex vm-pipe-messages-to-command-discard-output + @kindex |n + @item |n (@code{vm-pipe-messages-to-command-discard-output}) +@@ -3566,7 +3566,7 @@ Flags all messages with the same subject as the current message (ignoring + @kindex K + @item K (@code{vm-kill-thread-subtree}) + Flags all messages in the thread subtree of the current message for +-deletion. ++deletion. + @findex vm-delete-duplicate-messages + @item @code{vm-delete-duplicate-messages} + Flags duplicate messages for deletion. The duplicate messages are +@@ -3607,7 +3607,7 @@ confirmation is asked for. So you should use this setting only if + your normal workflow includes expunging messages as part of save. The + variable @code{vm-expunge-before-quit} can be similarly set to + non-@code{nil} to cause VM to expunge deleted messages whenever you +-quit the folder. ++quit the folder. + + @cindex vm-save-folder-no-expunge + @cindex vm-quit-no-expunge +@@ -3810,7 +3810,7 @@ The message has been replied to. + @end table + + @findex vm-set-message-attributes +-You can set and unset these attributes directly by using ++You can set and unset these attributes directly by using + @code{M-x vm-set-message-attributes}. You will be prompted in the + minibuffer for names of the attributes and you can enter them with + completion. Every attribute has an ``un-'' prefixed name you can use +@@ -4014,7 +4014,7 @@ subject lines. Sorting them by date would sort them chronologically + according to when the threads were initiated. Sorting them by activity + is a variant of the chronological order where the dates of latest + activity are given prominence instead of the dates of the initial +-messages. ++messages. + + @vindex vm-sort-subthreads + Normally, thread-based grouping applies to entire threads as well as +@@ -4143,13 +4143,14 @@ The seventh is `e' or ` ', for messages that have been edited. + @vindex vm-summary-attachment-indicator + @item P + indicator for a message with attachments. +-The variable @code{vm-summary-attachment-indicator} is the inserted +-string, by default a @kbd{$}. +-@vindex vm-summary-postponed-indicator ++The variable ++@vindex vm-summary-attachment-indicator ++@code{vm-summary-attachment-indicator} is the inserted string, by default a @code{$}. + @item p +-indicator for a postponed message. +-The variable @code{vm-summary-postponed-indicator} is the inserted +-string, by default a @kbd{P}. ++indicator for a postponed message. ++The variable ++@vindex vm-summary-postponed-indicator ++@code{vm-summary-postponed-indicator} is the inserted string, by default a @code{P}. + @item c + number of characters in message (ignoring headers) + @item S +@@ -4260,7 +4261,7 @@ again, you can reuse the saved summary format. Set the variable + @vindex vm-summary-thread-indent-level + @vindex vm-summary-maximum-thread-indentation + When message threading is enabled (@pxref{Threading}), +-you will find that the ++you will find that the + Summary buffer has all related messages are grouped together and the + subject titles are indented to show hierarchical relationships. + Parent messages are displayed before their children and children are +@@ -4282,7 +4283,7 @@ non-@code{nil} in your VM init file. Example: + @noindent Do not use @code{setq}, as this will only set the value of + the variable in a single buffer. Once you've started VM you should + not change the value of this variable. Rather you should use +-@kbd{C-t} to control the thread display. @xref{Threading}. ++@kbd{C-t} to control the thread display. @xref{Threading}. + + @unnumberedsubsec Manual control of thread indentation + +@@ -4339,7 +4340,7 @@ collapsed. The command @kbd{T} + (@code{vm-toggle-thread}) allows you to expand a collapsed thread or + collapse an expanded thread. The commands @code{vm-expand-thread} and + @code{vm-collapse-thread} implement the more specific versions of the +-function. ++function. + + @vindex vm-summary-visible + When threads are folded, not all messages in the threads are hidden. +@@ -4411,7 +4412,7 @@ extend to thread operations in this way. They include deleting, + undeleting, marking, unmarking, forwarding, saving/deleting + attachments etc. Replying to messages cannot be invoked as a thread + operation, to prevent the accidental sending of replies to unintended +-recipients. ++recipients. + + The thread operations can give rise to surprising behavior. Even + though it appears that an operation was invoked on a single message, +@@ -4421,7 +4422,7 @@ unconditionally. A safer option is to set + `vm-enable-thread-operations' to `ask'. In that case, VM asks for + confirmation every time an operation is applicable to all the messages + in a collapsed thread. You can override the confirmation dialog by +-giving a prefix argument `C-u' to your operation. ++giving a prefix argument `C-u' to your operation. + + @node Summary Faces,, Thread Operations, Summaries + @section Summary Faces +@@ -4585,10 +4586,10 @@ The command @code{vm-create-search-folder} (bound to @kbd{V C}) lets you + interactively create a virtual folder from the messages of the current + folder, using exactly one selector to choose the messages. If you type + @kbd{V C header @key{RET} greeting}, VM will create a folder containing only +-those ++those + messages that contain the string @samp{greeting} in one of its headers. + @xref{Virtual Selectors}, for virtual selectors you can use for this +-purpose. ++purpose. + + @findex vm-create-virtual-folder-of-threads + @findex vm-create-search-folder-of-threads +@@ -4665,7 +4666,7 @@ text of messages. The key binding @kbd{V t} + (@code{vm-create-text-virtual-folder}) can be used to find all messages with + the string. This is more efficient than the @code{vm-isearch-forward} + command (@pxref{Selecting Messages}) because it only searches in the text part +-of message bodies, not inside @acronym{MIME} attachments. ++of message bodies, not inside @acronym{MIME} attachments. + + @node Defined Folders, Working with Virtual Folders, Search Folders, Virtual Folders + @section Defined Virtual Folders +@@ -4765,7 +4766,7 @@ headers or the text portion of the message; + @var{ARG} should be a regular expression. + @item header-field + matches messages if the header field named @var{ARG1} has text matching +-@var{ARG2}. ++@var{ARG2}. + @end table + + @unnumberedsubsubsec Selectors based on message headers +@@ -4791,7 +4792,7 @@ matches message if its addresses are in the @acronym{BBDB}. With an optional + first argument you can specify the address class (@code{authors} or + @code{recipients}) . With an optional second argument @code{t}, the + selector checks only the first address specified in the message. +-Examples: ++Examples: + + @example + (in-bbdb authors) +@@ -4876,7 +4877,7 @@ matches message if it is not flagged. + matches message if it has been replied to. + @item answered + matches message if it has been replied to. Same as the @code{replied} +-selector. ++selector. + @item unreplied + matches message if it has not been replied to. + @item unanswered +@@ -4987,7 +4988,7 @@ selector. Example: + (thread (less-chars-than 1000)) + @end example + @noindent matches threads if all their messages contain fewer than 1000 +-characters. ++characters. + @end table + + @unnumberedsubsubsec Selectors based on context +@@ -5174,7 +5175,7 @@ the offline operation. Similarly, @emph{all} the messages that may have + been expunged in the cache folder are expunged on the server. + + @anchor{@acronym{UIDVALIDITY}} +-@unnumberedsubsec @acronym{UIDVALIDITY} ++@unnumberedsec @acronym{UIDVALIDITY} + + @cindex @acronym{UIDVALIDITY} + Messages on an @acronym{IMAP} server have unique id numbers called UID's. +@@ -5271,7 +5272,7 @@ Setting @code{vm-frame-per-composition} non-@code{nil} causes VM to create a + new frame for the composition buffer when you run any of VM's + message composition commands. E.g. @code{vm-reply-include-text}, + @code{vm-mail}, @code{vm-forward-message}. When you finish editing the +-composition and send it, or when you kill the composition buffer, ++composition and send it, or when you kill the composition buffer, + the frame will be deleted. + + @vindex vm-frame-per-edit +@@ -5300,7 +5301,7 @@ When VM is deciding whether to create a new frame, it checks + other existing frames to see if a buffer that it wants to display in a + frame is already being displayed somewhere. If so, then VM will + not create a new frame. If you don't want VM to search other +-frames, set the variable @code{vm-search-other-frames} to @code{nil}. VM will ++frames, set the variable @code{vm-search-other-frames} to @code{nil}. VM will + still search the currently selected frame and will not create a + new frame if the buffer that it wants to display is visible there. + +@@ -5371,7 +5372,7 @@ classes are: + searching-message + @end display + +-When a VM command is executed, window configurations are searched ++When a VM command is executed, window configurations are searched + for as follows. First, a command specific configuration is + searched for. If one is found, it is used. Next a class + configuration is searched for. Not all commands are in command +@@ -5437,24 +5438,24 @@ is a match. + @item compose + The Compose button. Clicking on this button runs the command + @code{vm-toolbar-compose-command}. This command is normally just an +-alias for the @code{vm-mail} command. If you want the Compose button to ++alias for the @code{vm-mail} command. If you want the Compose button to + do something else, redefine @code{vm-toolbar-compose-command} using + either @code{fset} or @code{defun}. + @item delete/undelete +-The Delete/Undelete button. If the current message is marked for ++The Delete/Undelete button. If the current message is marked for + deletion, this button displays as an Undelete button. Otherwise + it displays as a Delete button. + @item file + The File button. Clicking on this button runs the command + @code{vm-toolbar-file-command}. This command is normally just an +-alias for the @code{vm-mail} command. If you want the File button to ++alias for the @code{vm-mail} command. If you want the File button to + do something else, redefine @code{vm-toolbar-file-command} using + either @code{fset} or @code{defun}. + @item getmail + The Get Mail button. Clicking on this button runs the command + @code{vm-toolbar-getmail-command}. This command is normally just an + alias for the @code{vm-get-new-mail} command. If you want the +-Get Mail button to ++Get Mail button to + do something else, redefine @code{vm-toolbar-getmail-command} using + either @code{fset} or @code{defun}. + @item help +@@ -5462,10 +5463,10 @@ The Helper button. Clicking on this button runs the command + @code{vm-toolbar-helper-command}. This command normally just runs + @code{vm-help}, but it also does context specific things under certain + conditions. If the current message is a @acronym{MIME} message that needs +-decoding, the Helper button becomes the Decode @acronym{MIME} button. If the +-current folder has an auto-save file that appears to be the result +-of an Emacs or system crash, the Helper button becomes the Recover +-button. Clicking on the Recover button runs @code{vm-recover-folder}, ++decoding, the Helper button becomes the Decode @acronym{MIME} button. If the ++current folder has an auto-save file that appears to be the result ++of an Emacs or system crash, the Helper button becomes the Recover ++button. Clicking on the Recover button runs @code{vm-recover-folder}, + so you can recover your folder from an existing auto-save file. + @item mime + The Decode @acronym{MIME} button. Clicking on this button runs the command +@@ -5474,26 +5475,26 @@ alias for the @code{vm-decode-mime-message} command. + @item next + The Next button. Clicking on this button runs the command + @code{vm-toolbar-next-command}. This command is normally just an +-alias for the @code{vm-next-message} command. If you want the Next button to ++alias for the @code{vm-next-message} command. If you want the Next button to + do something else, redefine @code{vm-toolbar-next-command} using + either @code{fset} or @code{defun}. + @item previous + The Previous button. Clicking on this button runs the command + @code{vm-toolbar-previous-command}. This command is normally just an +-alias for the @code{vm-previous-message} command. If you want the Previous button to ++alias for the @code{vm-previous-message} command. If you want the Previous button to + do something else, redefine @code{vm-toolbar-previous-command} using + either @code{fset} or @code{defun}. + @item print + The Print button. Clicking on this button runs the command + @code{vm-toolbar-print-command}. This command is normally just an + alias for the @code{vm-print-message} command. If you want the +-Print button to ++Print button to + do something else, redefine @code{vm-toolbar-print-command} using + either @code{fset} or @code{defun}. + @item quit + The Quit button. Clicking on this button runs the command + @code{vm-toolbar-quit-command}. This command is normally just an +-alias for the @code{vm-quit} command. If you want the Quit button to ++alias for the @code{vm-quit} command. If you want the Quit button to + do something else, redefine @code{vm-toolbar-quit-command} using + either @code{fset} or @code{defun}. + @item reply +@@ -5506,7 +5507,7 @@ either @code{fset} or @code{defun}. + @item visit + The Visit button. Clicking on this button runs the command + @code{vm-toolbar-visit-command}. This command is normally just an +-alias for the @code{vm-visit-folder} command. If you want the Visit button to ++alias for the @code{vm-visit-folder} command. If you want the Visit button to + do something else, redefine @code{vm-toolbar-visit-command} using + either @code{fset} or @code{defun}. + @item nil +@@ -5522,7 +5523,7 @@ the button that comes before and the button that comes after the + integer. + + @vindex vm-toolbar-orientation +-The variable @code{vm-toolbar-orientation} controls on which side of the ++The variable @code{vm-toolbar-orientation} controls on which side of the + frame the toolbar is displayed. E.g. + + @example +@@ -5587,7 +5588,7 @@ message. E.g. reply, print, save, delete. + This provides a menu button labelled @code{[Emacs]} that causes the + menu bar to change to the global Emacs menu bar. On that menu bar you + will find a @code{[VM]} button that can return you to the VM menu +-bar. ++bar. + @item folder + This is a menu of folder related commands. You can visit a + folder, save a folder, quit a folder and so on. +@@ -5649,7 +5650,7 @@ large message can take a long time. Since @acronym{URL}s often occur near + the beginning and near the end of messages, VM offers a way to + search just those parts of a message for @acronym{URL}s. The variable + @code{vm-url-search-limit} specifies how much of a message to search. +-If @code{vm-url-search-limit} has a positive numeric value @var{N}, VM ++If @code{vm-url-search-limit} has a positive numeric value @var{N}, VM + will search the first @math{@var{N} / 2} characters and the last + @math{@var{N} / 2} characters in the message for @acronym{URL}s. + +@@ -5676,7 +5677,7 @@ highlighted @acronym{URL} in the body of a message, that @acronym{URL} will be s + to the browser specified by @code{vm-url-browser}. + @item button-3 (right button usually) + Context Menu. If the mouse pointer is over the contents of the +-From header, button-3 pops up a menu of actions that can be taken ++From header, button-3 pops up a menu of actions that can be taken + using the author of the message as a parameter. For instance, + you may want to create a virtual folder containing all the + messages in the current folder written by this author. If the +@@ -5721,7 +5722,7 @@ external browsers. + + VM has many hook variables that allow you to run functions when + certain events occur. Here is a list of the hooks and when they +-are run. (If you don't write Emacs-Lisp programs you ++are run. (If you don't write Emacs-Lisp programs you + can skip this chapter.) + + @table @code +@@ -5908,7 +5909,7 @@ List of hook functions to run when you quit VM. + This applies to all VM quit commands, including @code{vm-quit-no-change}. + So you should not include in this hook any functions that alter the folder. + For automatically expunging deleted messages, set the variable +-@code{vm-expunge-before-quit}. ++@code{vm-expunge-before-quit}. + + @item vm-summary-pointer-update-hook + @vindex vm-summary-pointer-update-hook +@@ -5948,7 +5949,7 @@ List of hook functions that are run just after all menus are initialized. + + @item vm-mime-display-function + @vindex vm-mime-display-function +-If non-@code{nil}, this should name a function to be called inside ++If non-@code{nil}, this should name a function to be called inside + @code{vm-decode-mime-message} to do the @acronym{MIME} display of the current + message. The function is called with no arguments, and at the + time of the call the current buffer will be the @dfn{presentation +@@ -6021,7 +6022,7 @@ packages in your environment. + Useful ways to customize VM. + @section Reading messages + +-@unnumberedsubsubsec Shrunken headers ++@unnumberedsubsec Shrunken headers + + @cindex headers, shrunken + @vindex vm-enable-addons +@@ -6069,7 +6070,7 @@ part. You can use the same function to change the method back to + + @section Saving messages and attachments + +-@unnumberedsubsubsec Auto saving attachments ++@unnumberedsubsec Auto saving attachments + + Messages with attachments get bulky and increase the size of VM + folders, slowing down VM. The functions +@@ -6085,7 +6086,7 @@ attachments. It saves the attachments in a subdirectory of + @code{vm-mime-save-attachment-save-directory}, whose name is obtained + by concating the ``from'', ``subject'' and ``date'' headers of the + message. This can be customized via the variable +-@code{vm-mime-auto-save-all-attachments-subdir}. ++@code{vm-mime-auto-save-all-attachments-subdir}. + + You can save the attachments of all new messages automatically by + putting @code{vm-mime-auto-save-all-attachments} in +@@ -6104,14 +6105,14 @@ putting @code{vm-mime-auto-save-all-attachments} in + @cindex postponing message composition + Sometimes, you might want to interrupt the composing of a message and + continue it later. This is called @dfn{postponing}. The add-on called +-@samp{vm-pine} provides this +-functionality. ++@samp{vm-pine} provides this ++functionality. + + @findex vm-postpone-composition + @kindex C-c C-d + @vindex vm-postponed-folder + In a message composition buffer, the command @key{C-c C-d} +-(@code{vm-postpone-composition}) ++(@code{vm-postpone-composition}) + postpones the current composition. The postponed message is stored in the + folder specified in @code{vm-postponed-folder}. (The default is a folder + called ``postponed''). When called with a prefix argument, +@@ -6137,7 +6138,7 @@ encoded. This is a limitation of this package. + @cindex Kyle Jones + VM was developed by Kyle Jones, starting in early 1989. The first + public release of VM was version 4.10, released in June of that year. +-The original development environment was GNU Emacs 18.52. ++The original development environment was GNU Emacs 18.52. + + @cindex Wonderworks + The copyright for the code was retained by Kyle Jones. Hence, the +@@ -6157,12 +6158,12 @@ also acquired a number of add-on's contributed by various developers, + including himself, and included them in his distribution. Kyle Jones + agreed to hand over the maintenance of VM to Robert Fenk in February, + 2007. Further releases were made by Robert Fenk under the @code{8.0.x} +-series. ++series. + + @cindex Savannah + All these releases are available from the new project page of VM hosted + by Savannah, at the @acronym{URL} +-@uref{http://savannah.nongnu.org/projects/viewmail/}. ++@uref{http://savannah.nongnu.org/projects/viewmail/}. + According to the project page, ``this site exists to continue VM development + after version 7.19 as a community project.'' + +@@ -6179,7 +6180,7 @@ The project code base is maintained at the Launchpad web site + @uref{http://launchpad.net/vm}. The ``VM Development Team'' can be + reached here using the email address @email{vm@@lists.launchpad.net}. + +-@unnumberedsubsec Savannah project site ++@unnumberedsec Savannah project site + + The changes made in each of the releases is described in the @samp{NEWS} + file, which can be found in the source code repository. The changes made +@@ -6197,7 +6198,7 @@ the @code{Source Code} menu. The @code{Use Bazaar} entry in the menu + takes you to a page that lists various version of VM source code, and + gives instructions for downloading it via @samp{Bazaar} (@code{bzr}). + +-@unnumberedsubsec Technical support ++@unnumberedsec Technical support + + VM has a dedicated usenet newsgroup @code{gnu.emacs.vm.info} and a + gmane newsgroup @code{gmane.emacs.viewmail}, in which the developers +@@ -6220,13 +6221,13 @@ alternative approaches to narrow down the problem. + + The best way to report bugs is via the Launchpad bug tacker. See below. + +-@unnumberedsubsec Get Involved ++@unnumberedsec Get Involved + + VM is now supported and maintained by the user community. So, as an +-active user, your participation is key to keep the project going. ++active user, your participation is key to keep the project going. + + Consider registering as a user of the Launchpad development site +-@uref{http://launchpad.net/vm}. This ++@uref{http://launchpad.net/vm}. This + allows you to communicate with the developers and other users using a + private Launchpad email address. In particular, you can contribute bug + reports and participate in the bug report discussions. +@@ -6239,7 +6240,7 @@ To download the development version, identify the ``branch'' that you + would like to download, and use Bazaar version control system with an + appropriate Launchpad @acronym{URL}. For example, the command + @command{bzr get lp:vm} can be used to download the main development +-branch. ++branch. + + You can also make change to the branch you have downloaded, and submit + them to the developers for inclusion in the project. The @code{README} +@@ -6249,7 +6250,7 @@ site, and submit your changes to that branch. The developers can review + and merge your branch with the main development when your changes + are ready. + +-@unnumberedsubsec Contributors ++@unnumberedsec Contributors + + Contributions to the code from the following members of the VM community + are gratefully acknowledged: +@@ -6338,20 +6339,20 @@ Here are some of the VM features that its users find most valuable: + VM's reliability and stability. + @item + Integration within Emacs, providing ease of editing and familiar key +-bindings. ++bindings. + @item + Speed of usage facilitated by keyboard commands. + @item + Integration with @acronym{BBDB} for maintaining contacts and email addresses. + @item + VM-Pcrisis for managing multiple mail identities. +-@item ++@item + Integration with emacs-w3m for viewing @acronym{HTML} email. + @item + Comprehensive @acronym{MIME} support. + @item + Ability to operate on all attachments of a message, such as saving or +-deleting. ++deleting. + @item + Interactive virtual folders (created by @code{V C}). + @item +@@ -6368,7 +6369,7 @@ Some of the ideas being worked on for future extensions of VM are the + following: + + @itemize +-@item ++@item + Ability to compose rich text email messages (in 'text/enriched' and + 'text/html' modes). + @item +@@ -6422,7 +6423,7 @@ automatically included in the bug-report. + @chapter VM Internals + + This section gives a sketchy overview of the VM internals for the +-developers/programmers. ++developers/programmers. + + @menu + * Folder Internals:: Structure of the folders +@@ -6474,7 +6475,7 @@ Three variants of the @code{mbox} format are recognized by VM, called + @code{From_}, @code{BellFrom_} and @code{From_with-Content-Length}. + In a @code{From_} type mbox, every message has a leading and trailing + separator line, as indicated above. In a @code{BellFrom_} type mbox, +-the trailing separator line can be missing. (This is so that the ++the trailing separator line can be missing. (This is so that the + mbox's from the old System V format can be handled.) In a + @code{From_with-Content-Length} type mbox, the @code{From} separator + line stores the length of the message. So, no trailing separator line +@@ -6505,7 +6506,7 @@ folder, VM attempts to put the cursor back at this position. + @item + @inindex X-VM-Last-Modified + X-VM-Last-Modified. The date and time at which the folder was last +-modified. ++modified. + @item + @inindex X-VM-Message-order + X-VM-Message-Order. This header lists the order in which the messages +@@ -6513,7 +6514,7 @@ should be listed. + @item + @inindex X-VM-Labels + X-VM-Labels. This header lists the message labels that have been used in +-the folder. ++the folder. + @item + @inindex X-VM-VHeader + X-VM-VHeader. This header lists the values of @code{vm-visible-headers} +@@ -6545,7 +6546,7 @@ server are listed. In the normal cases, the variable is just nil in + @acronym{IMAP} folders.) + @end itemize + +-@unnumberedsubsubsec Folder variables ++@unnumberedsubsec Folder variables + + Internal to Emacs, VM stores the folder as simply a text buffer. However, it + remembers a variety of data about the message contents in the buffer +@@ -6565,7 +6566,7 @@ the messages are stored: one of 'babyl, 'From_, 'BellFrom_, + @inindex vm-folder-access-method + @code{vm-folder-access-method}. The method for accessing the server + message store: 'pop for pop-folders and 'imap for imap-folders, and nil +-for all other folders. ++for all other folders. + @item + @inindex vm-folder-access-data + @code{vm-folder-access-data}. A vector of data for accessing the server +@@ -6644,7 +6645,7 @@ bodies were fetched for viewing or other operations. + @inindex vm-fetched-messages + @code{vm-fetched-message-count}. The number of messages in + @code{vm-fetched-messages}. An attempt is made to keep this below the +-@code{vm-fetched-message-limit}. ++@code{vm-fetched-message-limit}. + @item + @inindex vm-mime-decoded + @inindex @acronym{MIME} +@@ -6653,22 +6654,22 @@ display: @code{undecoded} if the message is shown in undecoded plain + text form, @code{decoded} if the message is shown decoded, and + @code{buttons} if the message is shown as a series of buttons for all + its @acronym{MIME} components. The @kbd{D} command cycles through these +-states. ++states. + @item + @inindex vm-system-state + @code{vm-system-state}. The state of VM in a Folder buffer or +-Presentation buffer: ++Presentation buffer: + + @itemize +-@item ++@item + @inindex previewing + @code{previewing}. + if a message is being previewed. +-@item ++@item + @inindex showing + @code{showing}. + if a full message is being shown. +-@item ++@item + @inindex reading + @code{reading}. + if message reading is in progress. +@@ -6680,15 +6681,15 @@ A message edit buffer is in state @code{editing}. + A message composition buffer may be in one of these states: + + @itemize +-@item ++@item + @inindex forwarding + @code{forwarding}. + if a message is being forwarded. +-@item ++@item + @inindex replying + @code{replying}. + if a message is being replied to. +-@item ++@item + @inindex redistributing + @code{redistributing}. + if a message is being redistributed. +@@ -6726,7 +6727,7 @@ MAILDROP specification of the server folder. + @code{pop-process} or @code{imap-process}. + The Emacs process being used to communicate with the server for this + folder. (Each folder uses a separate process to avoid unwanted +-interference.) ++interference.) + @item + @code{imap-uid-validity}. + The @acronym{UIDVALIDITY} value of the @acronym{IMAP} folder. +@@ -6987,7 +6988,7 @@ edited-flag. Flag to indicate if the message has been edited. + @inindex redistributed-flag + @item + redistributed-flag. Flag to indicate if the message has been +-redistributed. ++redistributed. + @end itemize + + @subsubheading Cached Data +@@ -7017,7 +7018,7 @@ byte-count. The size of the message in bytes. + weekday, monthday, month, year, hour, zone. Data indicating the date of + the message. + @inindex full-name +-@item ++@item + full-name. The full name of the author of the message. This is a + @acronym{MIME}-decoded string with text properties. + @inindex from +@@ -7039,7 +7040,7 @@ string with text properties. + vheaders-regexp. A regular expression that can be used to find the + start of the visible headers. The headers must have been already + ordered so that the visible headers are at the bottom of the headers +-section. ++section. + @inindex to + @item + to. Addresses of the recipients of the message in a comma separated +@@ -7097,7 +7098,7 @@ imap-uid. The @acronym{UID} of the message on the @acronym{IMAP} server. + @inindex imap-uid-validity + @item + imap-uid-validity. The @acronym{UIDVALIDITY} value of the message on the +-@acronym{IMAP} server. ++@acronym{IMAP} server. + @inindex spam-score + @item + spam-score. The spam score of the message. +@@ -7110,13 +7111,13 @@ is non-nil. + + @inindex edit-buffer + @itemize +-@item ++@item + edit-buffer. If the message is being edited, this is the buffer being + used. + @inindex virtual-messages-sym + @item + virtual-messages-sym. List of virtual messages mirroring the current real +-message, represented by an uninterned symbol written as ``<v>''. ++message, represented by an uninterned symbol written as ``<v>''. + @inindex stuff-flag + @item + stuff-flag. Flag to indicates if the attribute changes have been +@@ -7175,7 +7176,7 @@ stripped from attribute values. (An example is @code{(``attachment'', + @inindex qdisposition + @item + @code{qdisposition}. Like disposition, but the quotation marks are not +-stripped. ++stripped. + @inindex header-start + @item + @code{header-start}, @code{header-end}, @code{body-start} and +@@ -7193,7 +7194,7 @@ stored as properties of this symbol: + @item + @code{vm-mime-display-external-generic}. + This property stores the id of the process used to externally display +-the @acronym{MIME} part as well as the name of the temporary file used. ++the @acronym{MIME} part as well as the name of the temporary file used. + @inindex vm-mime-display-internal-image-xxxx + @item + @code{vm-mime-display-internal-image-xxxx}. +@@ -7204,7 +7205,7 @@ a list with a number of other data items. + @item + @code{vm-image-modified}. + This property stores a boolean flag indicating that the image has been +-modified. ++modified. + @inindex vm-mime-display-internal-audio/basic + @item + @code{vm-mime-display-internal-audio/basic}. +@@ -7219,7 +7220,7 @@ clip is stored. + @code{message-symbol}. A reference to the message that contains the @acronym{MIME} + part. Represented as a symbol (that is, an interned key into a hash + table). This is a different symbol from the real-message-sym of the +-message. ++message. + @inindex display-error + @item + @code{display-error}. If the display of a @acronym{MIME} part fails, its error string is +@@ -7239,7 +7240,7 @@ this part, then this holds the original unconverted layout. + @inindex vm-message-list + @inindex vm-message-pointer + Every Folder buffer has a @code{vm-message-list} and a +-@code{vm-message-pointer} list containing message data vectors. ++@code{vm-message-pointer} list containing message data vectors. + + Every Presentation buffer also uses a @code{vm-message-pointer} list + with a single message (the one being presented). The message data +@@ -7256,7 +7257,7 @@ However, they have message descriptors for all the messages in + location data vector, because only one message body can be stored in + the Folder buffer, but have separate Soft data vectors. (This allows, + for instance, virtual folders to have their own threads, which could +-in general be different from the threads in the underlying folders.) ++in general be different from the threads in the underlying folders.) + The other sub-vectors are shared with the underlying real folders. (In + particular, the tokenized summary line is the same in the virual + folders and their underlying folders.) +@@ -7269,7 +7270,7 @@ folders and their underlying folders.) + @inindex summary line, tokenized + @inindex tokenized summary line + Generating a summary is quite a time-consuming operation. VM uses a +-variety of tricks to speed up the generation of summaries. ++variety of tricks to speed up the generation of summaries. + + The format of the summary lines is specified in the variable + @code{vm-summary-line-format}. The information that needs to go into +@@ -7291,18 +7292,18 @@ line for each message and caches it in the cached-data vector. + The following forms of tokens are used in tokenized summary lines: + + @itemize +-@item ++@item + @code{number}. + Stands for the message number in the linear order of the summary. + @item + @code{mark}. + Stands for an indicator of message mark (whether the message is marked + at present). +-@item ++@item + @code{thread-indent}. + Stands for the indentation to be used for the message's summary + depending on its position in the message thread. +-@item ++@item + @code{group-begin}, @code{group-end}. + Brackets used to denote groups of items that might have particular + formatting constraints. +@@ -7370,7 +7371,7 @@ Message threads required for threaded summaries are calculated using + message ID's, which are unique when the message was originally + composed. However, VM may need to deal with multiple copies of the + same message received via possibly different routes. So, message ID's are +-not unique for messages inside VM. ++not unique for messages inside VM. + + Messages composed as replies generally have an ``In-Reply-To'' header. + The message mentioned in this header is referred to as the parent of +@@ -7460,7 +7461,7 @@ The list of all the messages in the folder that have this subject. + @b{Building threads} involves calculating all the data stored with the + @code{vm-thread-obarray} and @code{vm-thread-subject-obarray}. These two + collections of data are calculated in sequence, because the subject +-threads are based on the reference threads. ++threads are based on the reference threads. + + @inindex thread-subtree + @inindex thread-list +@@ -7598,13 +7599,13 @@ well as the buffer in which the command execution was initiated. + The default menu bar of VM contains VM-specific menus, replacing the + standard Emacs menus. This is achieved by setting the buffer-specific + menu bar to one in which the Emacs menus are @code{undefined} (at +-least in Gnu Emacs). ++least in Gnu Emacs). + + VM computes its standard menu bar and stores it internally: + + @itemize +-@item +-In Gnu Emacs, this is stored in the keymap @code{vm-mode-menu-map}. ++@item ++In Gnu Emacs, this is stored in the keymap @code{vm-mode-menu-map}. + @item + In XEmacs ... + @end itemize +@@ -7616,12 +7617,12 @@ standard Emacs menu bar. + The computed menu bar is then installed depending on the setting of + @code{vm-use-menus}. + If the user selects the action to revert to the standard Emacs menu +-bar, the installation is easily reverted. ++bar, the installation is easily reverted. + + @itemize + @item + In Gnu Emacs, the installation involves inserting a key binding for +-@code{menu-bar}. ++@code{menu-bar}. + @item + In XEmacs, ... + @end itemize +@@ -7631,7 +7632,7 @@ In XEmacs, ... + Emacs menu bar, the function @code{vm-menu-toggle-menubar} is invoked, + which installs a fresh menu bar retaining the standard Emacs menus. + The same function is used to reinstall the dedicated VM menu bar when +-needed. ++needed. + + @node Coding Systems, Virtual Folder Internals, User Interaction, Internals + @section Coding Systems +@@ -7711,7 +7712,7 @@ data structure @code{m} and all the arguments for the virtual selector + + For example, the virtual selector @code{author} has a string argument, + representing the author name. The corresponding Lisp function is defined +-as: ++as: + + @example + (defun vm-vs-author (m author-name) +@@ -7727,7 +7728,7 @@ The @code{author} selector is then registered in four places: + + @itemize + @inindex vm-virtual-selector-function-alist +-@item ++@item + The variable @code{vm-virtual-selector-function-alist}, which contains pairs + of the form @samp{(@var{SELECTOR} . @var{FUNCTION})}. For the @code{author} + selector, the pair is @code{(author . vm-vs-author)}. +@@ -7777,13 +7778,13 @@ responsible for traversing the tree structure at each @acronym{MIME} part + and displaying it appropriately. + + The function @code{vm-decode-mime-layout} goes through the following +-sequence of decisions: ++sequence of decisions: + + @enumerate + @item + If the @acronym{MIME} part is a @code{multipart} type, then the subparts are + displayed as needed. If it is a single part, it proceeds as follows. +-@item ++@item + If the @acronym{MIME} part should not be displayed automatically, it is + displayed as a button. (An automatically displayed @acronym{MIME} type is one + listed in @code{vm-mime-auto-displayed-content-types} +@@ -7818,7 +7819,7 @@ which has a number of properties associated with it: + @itemize + @item @code{vm-button}. + Always @code{t}. +-@item @code{vm-mime-layout}. ++@item @code{vm-mime-layout}. + Gives the layout of the @acronym{MIME} part. + @item @code{vm-mime-function}. + The function that carries out the action represented by pressing the +@@ -7864,22 +7865,22 @@ The following properties are defined for attachment buttons: + + @itemize + @item @code{vm-mime-object}. +-The object denoting the @acronym{MIME} attachment. It is either ++The object denoting the @acronym{MIME} attachment. It is either + + @itemize +-@item +-a string denoting a file name, + @item +-a buffer containing the file to be attached, ++a string denoting a file name, ++@item ++a buffer containing the file to be attached, + @item + a list of the form (buffer, start, end, filename) indicating a region in a +-buffer, typically the Folder buffer, or ++buffer, typically the Folder buffer, or + @item + @code{t} indicating that the attachment is another @acronym{MIME} +-object in a VM folder. ++object in a VM folder. + @end itemize + +-@noindent ++@noindent + In the last case, the @code{vm-mime-layout} + property describes the rest of the metadata. + @item @code{vm-mime-type}. +@@ -7903,7 +7904,7 @@ Standard text property. + @item @code{duplicable}. + Set to @code{t} in XEmacs allowing the extent to be + preserved under killing and yanking. +-@item @code{front-nonsticky} and @code{rear-nonsticky}. ++@item @code{front-nonsticky} and @code{rear-nonsticky}. + Standard stickiness of text properties in GNU Emacs. + @end itemize + +@@ -7966,12 +7967,12 @@ GNU Emacs 19 uses two distinct objects, "text properties" and + are a superset of the union of the functionality of the two GNU Emacs + data types. The full GNU Emacs 19 interface to text properties and + overlays is supported in XEmacs (with extents being the underlying +-representation). ++representation). + + Extents can be made to be copied into strings, and then restored, by + kill and yank. Thus, one can specify this behavior on either "extents" + or "text properties", whereas in GNU Emacs 19 text properties always +-have this behavior and overlays never do. ++have this behavior and overlays never do. + @end quotation + + While extents and overlays look similar on the surface, they differ +@@ -7994,7 +7995,7 @@ Another major differences between extents and overlays is that the + beginning and ending of overlays are markers. This has some + advantages. However, if a buffer has many overlays, normal editing + operations must update all the overlay markers, which can be +-time-consuming. ++time-consuming. + + The major applications of extents and overlays in VM are the following: + +@@ -8028,7 +8029,7 @@ three timer tasks that get scheduled to occur at regular intervals: + @item vm-flush-itimer-function + Stores message attributes in the folder so that they will be saved + when an auto-save is done. This is controlled by the variable +-@code{vm-flush-interval}. ++@code{vm-flush-interval}. + @inindex vm-get-mail-itimer-function + @item vm-get-mail-itimer-function + Moves new mail from maildrops into the folder. This is controlled by +@@ -8429,7 +8430,7 @@ when it starts in an interactive mode: + Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author} + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details + type `show w'. This is free software, and you are welcome +-to redistribute it under certain conditions; type `show c' ++to redistribute it under certain conditions; type `show c' + for details. + @end smallexample + +@@ -8447,7 +8448,7 @@ necessary. Here is a sample; alter the names: + @group + Yoyodyne, Inc., hereby disclaims all copyright + interest in the program `Gnomovision' +-(which makes passes at compilers) written ++(which makes passes at compilers) written + by James Hacker. + + @var{signature of Ty Coon}, 1 April 1989 +diff --git a/lisp/Makefile.in b/lisp/Makefile.in +index ea3453d..342f6dd 100755 +--- a/lisp/Makefile.in ++++ b/lisp/Makefile.in +@@ -130,12 +130,14 @@ version.txt: + # under Windows. We remove the CRs. + # Solaris 8's tr -d '\r' removes r's so we use '\015' instead. + # the echo command can also emit CRs. ++# Since Debian compiles the files on the fly on the target machine, ++# Do not depend on the abslute file path of the source directory to exist + vm-autoloads.el: $(SOURCES:%=@srcdir@/%) + -$(RM) -f $@ + echo > $@ + (build_dir="`pwd`"; cd "@srcdir@"; \ + "$(EMACS_PROG)" $(FLAGS) -l autoload \ +- -f vm-built-autoloads "@abs_builddir@/$@" "`pwd`") ++ -f vm-built-autoloads "`pwd`/$@" "`pwd`") + echo "(custom-add-load 'vm 'vm-cus-load)" | tr -d '\015' >> $@ + echo "(setq vm-configure-datadir \"${datadir}/vm\")" | tr -d '\015' >> $@ + echo "(setq vm-configure-pixmapdir \"${pixmapdir}\")" | tr -d '\015' >> $@ +diff --git a/src/Makefile.in b/src/Makefile.in +index 437626f..ef773a6 100755 +--- a/src/Makefile.in ++++ b/src/Makefile.in +@@ -8,6 +8,8 @@ SOURCES = $(wildcard *.c) + + OBJECTS = $(SOURCES:.c=.o) + ++MANS = $(wildcard *.1) ++ + ############################################################################## + # location of required programms + prefix = @prefix@ +@@ -16,11 +18,13 @@ MKDIR = @MKDIR@ + RM = @RM@ + INSTALL = @INSTALL@ + INSTALL_PROGRAM = @INSTALL_PROGRAM@ ++INSTALL_DATA = @INSTALL_DATA@ + + prefix = @prefix@ + top_srcdir = @top_srcdir@ + srcdir = @srcdir@ + bindir= @bindir@ ++mandir= @mandir@ + + ############################################################################## + all: $(SOURCES:.c=) +@@ -31,6 +35,11 @@ install: + echo "Installing $$i in $(DESTDIR)$(bindir)" ; \ + $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(bindir)" ; \ + done ; ++ @test -d $(DESTDIR)$(mandir) || \ ++ mkdir -p -m 0755 "$(DESTDIR)$(mandir)/man1"; \ ++ for i in $(MANS) ; do \ ++ $(INSTALL_DATA) $$i "$(DESTDIR)$(mandir)/man1" ; \ ++ done + @echo VM helper binaries successfully installed\! + + ############################################################################## +diff --git a/src/base64-decode.1 b/src/base64-decode.1 +new file mode 100644 +index 0000000..4ba903c +--- /dev/null ++++ b/src/base64-decode.1 +@@ -0,0 +1,50 @@ ++.\" -*- Mode: Nroff -*- ++.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. ++.\" ++.\" Permission is granted to make and distribute verbatim copies of ++.\" this manual provided the copyright notice and this permission notice ++.\" are preserved on all copies. ++.\" ++.\" Permission is granted to copy and distribute modified versions of this ++.\" manual under the conditions for verbatim copying, provided that the entire ++.\" resulting derived work is distributed under the terms of a permission ++.\" notice identical to this one. ++.\" ++.\" Permission is granted to copy and distribute translations of this manual ++.\" into another language, under the above conditions for modified versions, ++.\" except that this permission notice may be stated in a translation approved ++.\" by the Author. ++.\" ++.\" Author: Manoj Srivastava ++.\" ++.\" arch-tag: e94acb5a-38da-416b-b01d-9196c0836599 ++.\" ++.TH BASE64\-DECODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" ++.SH NAME ++base64\-decode \- Fast BASE64 decoder ++.SH SYNOPSIS ++.B base64\-decode ++< ++.I base64\-encoded data ++> ++.I converted output ++.SH DESCRIPTION ++The ++.B base64\-decode ++utility takes BASE64 data on the standard input and converts ++it to the standard output. ++.PP ++This manual page was written for the Debian GNU/Linux distribution ++because the original program does not have a manual page. ++.SH OPTIONS ++.B base64\-encode ++does not take any arguments or options. ++.SH BUGS ++None known. ++.SH SEE ALSO ++.I base64\-encode (1) ++.SH AUTHORS ++.B base64\-decode ++was written by Kyle Jones. and placed by him into the public domain. ++This manual page was written by Manoj Srivastava <srivasta@debian.org>, ++for the Debian GNU/Linux system. +diff --git a/src/base64-decode.c b/src/base64-decode.c +index d0d3b9a..1b026f7 100755 +--- a/src/base64-decode.c ++++ b/src/base64-decode.c +@@ -4,6 +4,7 @@ + + #include <stdlib.h> + #include <stdio.h> ++#include <stdlib.h> + + #ifdef _WIN32 + #ifndef WIN32 +@@ -19,10 +20,10 @@ + unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + + int +-main() ++main(void) + { +- static char inalphabet[256], decoder[256]; +- int i, bits, c, char_count, errors = 0; ++ static char inalphabet[256], decoder[256]; ++ int i, bits, char_count, errors = 0; + + #ifdef WIN32 + _setmode( _fileno(stdout), _O_BINARY); +@@ -32,46 +33,62 @@ main() + inalphabet[alphabet[i]] = 1; + decoder[alphabet[i]] = i; + } ++#define BUFLEN 72*500 // must be multiple of 4 + +- char_count = 0; +- bits = 0; +- while ((c = getchar()) != EOF) { +- if (c == '=') +- break; +- if (c > 255 || ! inalphabet[c]) +- continue; +- bits += decoder[c]; +- char_count++; +- if (char_count == 4) { +- putchar((bits >> 16)); +- putchar(((bits >> 8) & 0xff)); +- putchar((bits & 0xff)); +- bits = 0; +- char_count = 0; +- } else { +- bits <<= 6; +- } +- } +- if (c == EOF) { +- if (char_count) { +- fprintf(stderr, "base64 encoding incomplete: at least %d bits truncated", +- ((4 - char_count) * 6)); +- errors++; +- } +- } else { /* c == '=' */ +- switch (char_count) { +- case 1: +- fprintf(stderr, "base64 encoding incomplete: at least 2 bits missing"); +- errors++; +- break; +- case 2: +- putchar((bits >> 10)); +- break; +- case 3: +- putchar((bits >> 16)); +- putchar(((bits >> 8) & 0xff)); +- break; +- } +- } +- exit(errors ? 1 : 0); ++ int len; ++ char buf[BUFLEN]; ++ char outbuf[BUFLEN]; ++ ++ while(!feof(stdin)) { ++ unsigned char c; ++ ++ int pos=0; ++ char *out=outbuf; ++ len=fread(buf, sizeof(c), BUFLEN, stdin); ++ if(!len) continue; ++ ++cont_buffer: ++ char_count = 0; ++ bits = 0; ++ while(pos<len) { ++ c=buf[pos++]; ++ if (c == '=') ++ break; ++ if (! inalphabet[c]) ++ continue; ++ bits += decoder[c]; ++ char_count++; ++ if (char_count == 4) { ++ *out++ = ((bits >> 16)); ++ *out++ = (((bits >> 8) & 0xff)); ++ *out++ = ((bits & 0xff)); ++ bits = 0; ++ char_count = 0; ++ } else { ++ bits <<= 6; ++ } ++ } ++ switch (char_count) { ++ case 1: ++ fprintf(stderr, "base64-decode: base64 encoding incomplete: at least 2 bits missing"); ++ errors++; ++ break; ++ case 2: ++ *out++ = ((bits >> 10)); ++ break; ++ case 3: ++ *out++ = ((bits >> 16)); ++ *out++ = (((bits >> 8) & 0xff)); ++ break; ++ case 0: ++ break; ++ default: ++ fprintf(stderr, "base64-decode: base64 encoding incomplete: at least %d bits truncated", ++ ((4 - char_count) * 6)); ++ } ++ if(pos<len) // did not proceed the whole thing, continue ++ goto cont_buffer; ++ fwrite(outbuf, sizeof(char), (out-outbuf), stdout); ++ } ++ exit(errors ? 1 : 0); + } +diff --git a/src/base64-encode.1 b/src/base64-encode.1 +new file mode 100644 +index 0000000..ba0e95a +--- /dev/null ++++ b/src/base64-encode.1 +@@ -0,0 +1,51 @@ ++.\" -*- Mode: Nroff -*- ++.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. ++.\" ++.\" Permission is granted to make and distribute verbatim copies of ++.\" this manual provided the copyright notice and this permission notice ++.\" are preserved on all copies. ++.\" ++.\" Permission is granted to copy and distribute modified versions of this ++.\" manual under the conditions for verbatim copying, provided that the entire ++.\" resulting derived work is distributed under the terms of a permission ++.\" notice identical to this one. ++.\" ++.\" Permission is granted to copy and distribute translations of this manual ++.\" into another language, under the above conditions for modified versions, ++.\" except that this permission notice may be stated in a translation approved ++.\" by the Author. ++.\" ++.\" Author: Manoj Srivastava ++.\" ++.\" arch-tag: 6563f4a9-302a-4d17-986a-42be5fb1d1c9 ++.\" ++.TH BASE64\-ENCODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" ++.SH NAME ++base64\-encode \- Fast Base 64 encoder ++.SH SYNOPSIS ++.B base64\-encode ++< ++.I input ++> ++.I base64\-encoded output ++.SH DESCRIPTION ++The ++.B base64\-encode ++utility takes arbitrary data on the standard input and converts ++it to BASE64 data on standard output. UNIX's newline convention is ++used, i.e. one ASCII control-j (10 decimal). ++.PP ++This manual page was written for the Debian GNU/Linux distribution ++because the original program does not have a manual page. ++.SH OPTIONS ++.B base64\-encode ++does not take any arguments or options. ++.SH BUGS ++None known. ++.SH SEE ALSO ++.I base64\-decode (1) ++.SH AUTHORS ++.B base64\-encode ++was written by Kyle Jones. and placed by him into the public domain. ++This manual page was written by Manoj Srivastava <srivasta@debian.org>, ++for the Debian GNU/Linux system. +diff --git a/src/base64-encode.c b/src/base64-encode.c +index fd146fa..d9c6651 100755 +--- a/src/base64-encode.c ++++ b/src/base64-encode.c +@@ -8,6 +8,7 @@ + + #include <stdlib.h> + #include <stdio.h> ++#include <stdlib.h> + + #ifdef _WIN32 + #ifndef WIN32 +@@ -23,7 +24,7 @@ + unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + + int +-main() ++main(void) + { + int cols, bits, c, char_count; + +diff --git a/src/qp-decode.1 b/src/qp-decode.1 +new file mode 100644 +index 0000000..a9a60d8 +--- /dev/null ++++ b/src/qp-decode.1 +@@ -0,0 +1,51 @@ ++.\" -*- Mode: Nroff -*- ++.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. ++.\" ++.\" Permission is granted to make and distribute verbatim copies of ++.\" this manual provided the copyright notice and this permission notice ++.\" are preserved on all copies. ++.\" ++.\" Permission is granted to copy and distribute modified versions of this ++.\" manual under the conditions for verbatim copying, provided that the entire ++.\" resulting derived work is distributed under the terms of a permission ++.\" notice identical to this one. ++.\" ++.\" Permission is granted to copy and distribute translations of this manual ++.\" into another language, under the above conditions for modified versions, ++.\" except that this permission notice may be stated in a translation approved ++.\" by the Author. ++.\" ++.\" Author: Manoj Srivastava ++.\" ++.\" arch-tag: cfe27e82-b7a5-4171-bef6-f7bc28306374 ++.\" ++.TH QP\-DECODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" ++.SH NAME ++qp\-decode \- Fast Quoted Printable decoder ++.SH SYNOPSIS ++.B qp\-decode ++< ++.I qp\-encoded data ++> ++.I converted output ++.SH DESCRIPTION ++The ++.B qp\-decode ++utility takes Quoted Printable data on the standard input and converts ++it to the standard output. ++.PP ++This manual page was written for the Debian GNU/Linux distribution ++because the original program does not have a manual page. ++.SH OPTIONS ++.B qp\-encode ++does not take any arguments or options. ++.SH BUGS ++None known. ++.SH SEE ALSO ++.I qp\-encode (1) ++.SH AUTHORS ++.B qp\-decode ++was written by Kyle Jones. and placed by him into the public domain. ++This manual page was written by Manoj Srivastava <srivasta@debian.org>, ++for the Debian GNU/Linux system. ++ +diff --git a/src/qp-decode.c b/src/qp-decode.c +index 0d6eaa1..9861f7b 100755 +--- a/src/qp-decode.c ++++ b/src/qp-decode.c +@@ -5,6 +5,7 @@ + #include <stdlib.h> + #include <stdio.h> + #include <string.h> ++#include <stdlib.h> + + #ifdef _WIN32 + #ifndef WIN32 +@@ -17,11 +18,11 @@ + #include <fcntl.h> + #endif + +-char *hexdigits = "0123456789ABCDEF"; +-char *hexdigits2 = "0123456789abcdef"; ++const char *hexdigits = "0123456789ABCDEF"; ++const char *hexdigits2 = "0123456789abcdef"; + + int +-main() ++main(void) + { + char line[2000], *start, *stop, *copy; + char *d1, *d2, c; +@@ -90,7 +91,7 @@ main() + for (stop++; *stop && (*stop == ' ' || *stop == '\t'); stop++) + ; + } else { +- fprintf(stderr, "Error: line %d: '%c' is something other than line break or hex digit after = in quoted-printable encoding\n", lineno, *stop); ++ fprintf(stderr, "Error: qp-decode: line %d: '%c' is something other than line break or hex digit after = in quoted-printable encoding\n", lineno, *stop); + putchar('='); + putchar(*stop); + stop++; +diff --git a/src/qp-encode.1 b/src/qp-encode.1 +new file mode 100644 +index 0000000..c3dc52b +--- /dev/null ++++ b/src/qp-encode.1 +@@ -0,0 +1,51 @@ ++.\" -*- Mode: Nroff -*- ++.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. ++.\" ++.\" Permission is granted to make and distribute verbatim copies of ++.\" this manual provided the copyright notice and this permission notice ++.\" are preserved on all copies. ++.\" ++.\" Permission is granted to copy and distribute modified versions of this ++.\" manual under the conditions for verbatim copying, provided that the entire ++.\" resulting derived work is distributed under the terms of a permission ++.\" notice identical to this one. ++.\" ++.\" Permission is granted to copy and distribute translations of this manual ++.\" into another language, under the above conditions for modified versions, ++.\" except that this permission notice may be stated in a translation approved ++.\" by the Author. ++.\" ++.\" Author: Manoj Srivastava ++.\" ++.\" arch-tag: bc2b7485-8846-4a92-9e54-8fd22a778663 ++.\" ++.TH QP\-ENCODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" ++.SH NAME ++qp\-encode \- Fast Quoted Printable encoder ++.SH SYNOPSIS ++.B qp\-encode ++< ++.I input ++> ++.I qp\-encoded output ++.SH DESCRIPTION ++The ++.B qp\-encode ++utility takes arbitrary data on the standard input and converts ++it to Quoted Printable data on standard output. ++.PP ++This manual page was written for the Debian GNU/Linux distribution ++because the original program does not have a manual page. ++.SH OPTIONS ++.B qp\-encode ++does not take any arguments or options. ++.SH BUGS ++None known. ++.SH SEE ALSO ++.I qp\-decode (1) ++.SH AUTHORS ++.B qp\-encode ++was written by Kyle Jones. and placed by him into the public domain. ++This manual page was written by Manoj Srivastava <srivasta@debian.org>, ++for the Debian GNU/Linux system. ++ +diff --git a/src/qp-encode.c b/src/qp-encode.c +index e5796d0..8014d02 100755 +--- a/src/qp-encode.c ++++ b/src/qp-encode.c +@@ -8,6 +8,7 @@ + + #include <stdlib.h> + #include <stdio.h> ++#include <stdlib.h> + + #ifdef _WIN32 + #ifndef WIN32 +@@ -20,10 +21,10 @@ + #include <fcntl.h> + #endif + +-char *hexdigits = "0123456789ABCDEF"; ++const char *hexdigits = "0123456789ABCDEF"; + + int +-main() ++main(void) + { + int c; + int cols = 0; +-- +2.0.0.rc0 + diff --git a/debian/patches/series b/debian/patches/series new file mode 100644 index 0000000..9eb8f71 --- /dev/null +++ b/debian/patches/series @@ -0,0 +1,2 @@ +# exported from git by git-debcherry +0001-debcherry-fixup-patch.patch diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..7f1f93d --- /dev/null +++ b/debian/rules @@ -0,0 +1,83 @@ +#!/usr/bin/make -f +# -*- makefile -*- +# Sample debian/rules that uses debhelper. +# +# This file was originally written by Joey Hess and Craig Small. +# As a special exception, when this file is copied by dh-make into a +# dh-make output file, you may use that output file without restriction. +# This special exception was added by Craig Small in version 0.37 of dh-make. +# +# Modified to make a template file for a multi-binary package with separated +# build-arch and build-indep targets by Bill Allombert 2001 + +# Uncomment this to turn on verbose mode. +export DH_VERBOSE=1 + +# This has to be exported to make some magic below work. +export DH_OPTIONS + +SRCTOP := $(shell if [ "$$PWD" != "" ]; then echo $$PWD; else pwd; fi) +TMPTOP = $(SRCTOP)/debian/$(package) +package := vm + +INSTALL = install +ifeq (,$(filter nostrip,$(DEB_BUILD_OPTIONS))) + INSTALL_PROGRAM += -s +endif +install_file = $(INSTALL) -p -o root -g root -m 644 +install_program = $(INSTALL) -p -o root -g root -m 755 +install_script = $(INSTALL) -p -o root -g root -m 755 +make_directory = $(INSTALL) -p -d -o root -g root -m 755 + + +PREFIX = /usr +P_MANDIR = $(PREFIX)/share/man +P_BINDIR = $(PREFIX)/bin +P_INFODIR = $(PREFIX)/share/info +P_DOCTOP = $(PREFIX)/share/doc +P_DOCDIR = $(P_DOCTOP)/$(package) +P_LISPDIR = $(PREFIX)/share/emacs/site-lisp/$(package) +P_PIXMAPDIR= $(P_LISPDIR)/pixmaps +DOCDIR = $(TMPTOP)$(P_DOCDIR) + +%: + dh $@ --with autotools-dev + + +override_dh_auto_configure: + dh_auto_configure -- --verbose --sysconfdir=/etc \ + --with-pixmapdir=$(P_PIXMAPDIR) + +override_dh_auto_install: + dh_auto_install + @find $(TMPTOP)$(P_LISPDIR) -type f -name \*.elc -exec rm -f {} \; + (cd $(DOCDIR) && makeinfo --html --ifinfo --split=chapter \ + -o html $(SRCTOP)/info/vm.texinfo) + +override_dh_install: + dh_install +# mime codecs should not get installed + @rm -rf $(TMPTOP)/usr/bin + $(install_file) lisp/Makefile $(TMPTOP)$(P_LISPDIR)/Makefile + $(install_file) lisp/Makefile.in $(TMPTOP)$(P_LISPDIR)/Makefile.in + $(install_file) lisp/vm-build.el $(TMPTOP)$(P_LISPDIR)/ + $(install_file) debian/vm.emacsen-startup \ + $(TMPTOP)$(P_LISPDIR)/vm-init.el + test ! -f $(TMPTOP)$(P_LISPDIR)/vm-autoloads.el || \ + rm -f $(TMPTOP)$(P_LISPDIR)/vm-autoloads.el +override_dh_installchangelogs: + dh_installchangelogs + test ! -d $(TMPTOP)/$(PREFIX)/share/$(package)/pixmaps || \ + mv $(TMPTOP)/$(PREFIX)/share/$(package)/pixmaps \ + $(TMPTOP)$(P_PIXMAPDIR) + test ! -f $(TMPTOP)/usr/share/$(package)/COPYING || rm $(TMPTOP)/usr/share/$(package)/COPYING + test ! -f $(DOCDIR)/CHANGES || rm $(DOCDIR)/CHANGES + test ! -f $(DOCDIR)/COPYING || rm $(DOCDIR)/COPYING + +override_dh_fixperms: + dh_fixperms + @test ! -d debian/vm/usr/share/man || rm -rf debian/vm/usr/share/man + @rm -f $(TMPTOP)/usr/share/emacs/site-lisp/vm/version.txt +#Local variables: +#mode: makefile +#End: diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/debian/vm.doc-base b/debian/vm.doc-base new file mode 100644 index 0000000..9a22258 --- /dev/null +++ b/debian/vm.doc-base @@ -0,0 +1,16 @@ +Document: vm +Title: VM: A mail user agent for Emacs. +Author: Kyle Jones +Abstract: VM (View Mail) is an Emacs subsystem that allows UNIX + mail to be read and disposed of within Emacs. Commands exist to do + the normal things expected of a mail user agent, such as generating + replies, saving messages to folders, deleting messages and so on. + There are other more advanced commands that do tasks like bursting + and creating digests, message forwarding, and organizing message + presentation according to various criteria. + VM comes by default with XEmacs. +Section: Network/Communication + +Format: HTML +Index: /usr/share/doc/vm/html/index.html +Files: /usr/share/doc/vm/html/*.html diff --git a/debian/vm.emacsen-install b/debian/vm.emacsen-install new file mode 100755 index 0000000..94f28d2 --- /dev/null +++ b/debian/vm.emacsen-install @@ -0,0 +1,123 @@ +#!/bin/bash +# -*- Mode: Sh -*- +# emacsen.install --- +# Author : Manoj Srivastava ( srivasta@tiamat.datasync.com ) +# Created On : Fri Apr 3 14:39:59 1998 +# Created On Node : tiamat.datasync.com +# Last Modified By : Manoj Srivastava +# Last Modified On : Fri Feb 8 21:55:35 2008 +# Last Machine Used: anzu.internal.golden-gryphon.com +# Update Count : 48 +# Status : Unknown, Use with caution! +# HISTORY : +# Description : +# +# arch-tag: 8d8ec43a-8bb5-4ecd-bde8-67736b2d04d5 +# + +set -e + +FLAVOUR=$1 +PACKAGE="vm" + +if [ "X$FLAVOUR" = "X" ]; then + echo Need argument to determin FLAVOUR of emacs; + exit 1 +fi + +if [ "X$PACKAGE" = "X" ]; then + echo Internal error: need package name; + exit 1; +fi + + +ELDIR=/usr/share/emacs/site-lisp/$PACKAGE +ELCDIR=/usr/share/$FLAVOUR/site-lisp/$PACKAGE +EFLAGS="-batch -q -l load-path-hack.el -f batch-byte-compile" +STARTDIR=/etc/$FLAVOUR/site-start.d +INFO_FILES="/usr/info/vm.info.gz"; +STARTFILE="$PACKAGE-init.el"; +BYTEOPTS="./vm-byteopts.el"; +PRELOADS=" -l $BYTEOPTS -l ./vm-message.el -l ./vm-misc.el -l ./vm-vars.el -l ./vm-version.el"; +BATCHFLAGS=" -batch -q -no-site-file" +CORE="vm-message.el vm-misc.el vm-byteopts.el" +STAMPFILE=vm-autoload.elc + +case "$FLAVOUR" in + emacs24|emacs23|emacs-snapshot|xemacs21) + echo -n "install/$PACKAGE: Byte-compiling for $FLAVOUR..." + case $FLAVOUR in + emacs*) + EMACS_FLAVOR=emacs + ;; + xemacs*) + EMACS_FLAVOR=xemacs + ;; + esac + + if [ -d $ELCDIR ]; then + if [ -e "${ELCDIR}/${STAMPFILE}" ]; then + echo "${PACKAGE} files already compiled in ${ELCDIR}." + exit 0 + else + test ! -d $ELCDIR/pixmaps || rm -rf $ELCDIR/pixmaps + test ! -f $ELCDIR/Makefile.in || rm -rf $ELCDIR/Makefile.in + test ! -f $ELCDIR/Makefile || rm -rf $ELCDIR/Makefile + test ! -d $ELCDIR || rm -f $ELCDIR/*.elc $ELCDIR/*.el $ELCDIR/install.log $ELCDIR/vm-init.el; + test ! -d $ELCDIR || rm -rf $ELCDIR + fi + fi + if [ ! -d $ELCDIR ]; then + install -m 755 -d $ELCDIR + fi + cd $ELDIR + # if we do not have make, well, we are hosed. + LOG=`tempfile`; + trap "test -f $LOG && mv -f $LOG $ELCDIR/install.log > /dev/null 2>&1" exit + if [ -x /usr/bin/make ]; then + # Save the old autoloads file since we ship it in the .deb + test ! -f vm-autoload.el || cp -a vm-autoload.el vm-autoload.el.precious + make clean > $LOG; + (make prefix=/usr EMACS=$FLAVOUR EMACS_FLAVOR=$EMACS_FLAVOR) >> $LOG 2>&1 ; + echo "tar cf - . | (cd $ELCDIR; tar xpf -)" >> $LOG; + tar cf - . | (cd $ELCDIR; tar xpf -) + make clean >> $LOG; + # Restore the autoloads file + test ! -f vm-autoload.el.precious || mv vm-autoload.el.precious vm-autoload.el + echo "cd $ELCDIR;" >> $LOG; + cd $ELCDIR; + else + echo >&2 "You do not seem to have make." + echo >&2 "This is not good, since I can't byte compile without make" + echo >&2 "I am letting vm remain non-byte compiled, which slows it down." + echo >&2 "Please hit return to continue." + read ans; + echo "You do not seem to have make." > $LOG; + echo "Not byte compiling." >> $LOG; + echo "tar cf - . | (cd $ELCDIR; tar xpf -)" >> $LOG; + tar cf - . | (cd $ELCDIR; tar xpf -) + echo "rm -f *.elc *~" >> $LOG; + rm -f *.elc *~ + echo "cd $ELCDIR;" >> $LOG; + cd $ELCDIR; + fi + + mv $LOG $ELCDIR/install.log; + chmod 644 $ELCDIR/install.log; + sed -e "s|=F|/usr/share/$FLAVOUR/site-lisp/$PACKAGE|" \ + $ELDIR/$STARTFILE > $ELCDIR/$STARTFILE; + ucf $ELCDIR/$STARTFILE $STARTDIR/50$STARTFILE; + + echo " done." + ;; + *) + echo "install/$PACKAGE: Ignoring emacsen flavor $FLAVOUR." + ;; +esac + +exit 0 + + +### Local Variables: +### mode: shell-script +### End: diff --git a/debian/vm.emacsen-remove b/debian/vm.emacsen-remove new file mode 100755 index 0000000..423309e --- /dev/null +++ b/debian/vm.emacsen-remove @@ -0,0 +1,61 @@ +#! /bin/bash +# -*- Mode: Sh -*- +# emacsen.remove --- +# Author : Manoj Srivastava ( srivasta@tiamat.datasync.com ) +# Created On : Mon Apr 13 01:38:03 1998 +# Created On Node : tiamat.datasync.com +# Last Modified By : Manoj Srivastava +# Last Modified On : Fri Feb 8 21:46:54 2008 +# Last Machine Used: anzu.internal.golden-gryphon.com +# Update Count : 9 +# Status : Unknown, Use with caution! +# HISTORY : +# Description : +# +# arch-tag: 7b9e5ffb-d1b2-47cb-86ab-0da24d51ed46 +# + + +set -e + +FLAVOUR=$1 +PACKAGE="vm" + +if [ "X$FLAVOUR" = "X" ]; then + echo Need argument to determin FLAVOUR of emacs; + exit 1 +fi + +if [ "X$PACKAGE" = "X" ]; then + echo Internal error: need package name; + exit 1; +fi + +ELDIR=/usr/share/emacs/site-lisp/$PACKAGE +ELCDIR=/usr/share/$FLAVOUR/site-lisp/$PACKAGE/ +STARTDIR=/etc/$FLAVOUR/site-start.d +STARTFILE="$PACKAGE-init.el"; +EFLAGS="-batch -q -l load-path-hack.el -f batch-byte-compile" +INFO_FILES="/usr/info/vm.info.gz"; + + +case $FLAVOUR in + emacs24|emacs23|emacs-snapshot|xemacs21) + echo -n "remove/$PACKAGE: Removing for $FLAVOUR..." + echo -n "$ELCDIR..." + test ! -d $ELCDIR || rm -rf $ELCDIR + echo -n "$ELDIR..." + test ! -f $ELDIR/vm-cus-load.el || rm -rf $ELDIR/vm-cus-load.el + echo " done." + + ;; + *) + echo "remove/$PACKAGE: Ignoring emacsen flavor $FLAVOUR." + ;; +esac + +exit 0 + +### Local Variables: +### mode: shell-script +### End: diff --git a/debian/vm.emacsen-startup b/debian/vm.emacsen-startup new file mode 100644 index 0000000..9e269c9 --- /dev/null +++ b/debian/vm.emacsen-startup @@ -0,0 +1,47 @@ +;-*-emacs-lisp-*- +; arch-tag: 045640fd-0ff2-45b7-a29f-68e4b8378fbf + +(let ((package-dir (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/vm"))) + ;; If package-dir does not exist, the vm package must have + ;; removed but not purged, and we should skip the setup. + (when (file-directory-p package-dir) + ;;make sure we have a compiled version ... + (if (file-readable-p (concat package-dir "/vm.elc")) + (progn + (provide 'vm-init) + (require 'vm-autoload) + ;; Fixes for Debian + (if (fboundp 'debian-pkg-add-load-path-item) + (setq load-path (debian-pkg-add-load-path-item package-dir)) + (setq load-path (nconc load-path (list package-dir)))) + (eval-after-load 'vm-vars + '(setq + vm-toolbar-pixmap-directory + (if (string-match "'--with-gtk'\\|'--with-x-toolkit=gtk'" + system-configuration-options) + (concat (vm-pixmap-directory) "/gtk") + (vm-pixmap-directory)))) + (autoload (quote vm-decode-postponed-mime-message) "vm-pine" "\ +Replace the mime buttons by attachment buttons. +\(fn)" t nil) + + ;; Uncomment these if you have the package mime-codecs installed + ;; (setq + ;; vm-mime-qp-decoder-program "qp-decode" + ;; vm-mime-qp-encoder-program "qp-encode" + ;; vm-mime-base64-decoder-program "base64-decode" + ;; vm-mime-base64-encoder-program "base64-encode" + ;; ) + + ;; If you have metamail, you would set these instead: + ;; (setq vm-mime-base64-decoder-program "mimencode") + ;; (setq vm-mime-base64-decoder-switches '("-u" "-b" "-p")) + ;; (setq vm-mime-base64-encoder-program "mimencode") + ;; (setq vm-mime-base64-encoder-switches '("-b")) + ;; (setq vm-mime-qp-decoder-program "mimencode") + ;; (setq vm-mime-qp-decoder-switches '("-u" "-q")) + ;; (setq vm-mime-qp-encoder-program "mimencode") + ;; (setq vm-mime-qp-encoder-switches '("-q")) + )))) diff --git a/debian/vm.examples b/debian/vm.examples new file mode 100644 index 0000000..7a5f3b8 --- /dev/null +++ b/debian/vm.examples @@ -0,0 +1,16 @@ +example.vm +debian/examples/dot.vm-auto-spool +debian/examples/dot.vm-hide-ref-2 +debian/examples/dot.vm-manoj-current +debian/examples/summary_bottom +debian/examples/summary_right +debian/examples/summary_top +debian/examples/dot.vm-hide-ref +debian/examples/dot.vm.2 +debian/examples/README.windows +debian/examples/dot.vm +debian/examples/full_screen +debian/examples/dot.emacs +debian/examples/dot.abbrevs +debian/examples/README +debian/examples/dot.vm-color diff --git a/debian/vm.install b/debian/vm.install new file mode 100644 index 0000000..d4f4542 --- /dev/null +++ b/debian/vm.install @@ -0,0 +1 @@ +#DOCS# diff --git a/debian/vm.postinst b/debian/vm.postinst new file mode 100755 index 0000000..7288383 --- /dev/null +++ b/debian/vm.postinst @@ -0,0 +1,279 @@ +#! /bin/sh +# -*- Mode: Sh -*- +# postinst --- +# Author : Manoj Srivastava ( srivasta@glaurung.green-gryphon.com ) +# Created On : Fri Nov 14 11:25:07 2003 +# Created On Node : glaurung.green-gryphon.com +# Last Modified By : Manoj Srivastava +# Last Modified On : Fri Sep 29 14:16:38 2006 +# Last Machine Used: glaurung.internal.golden-gryphon.com +# Update Count : 22 +# Status : Unknown, Use with caution! +# HISTORY : +# Description : +# +# arch-tag: 5401e9ef-39cc-4aee-96a4-61dfb8f32cf7 +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# + +# Abort if any command returns an error value +set -e + +package_name=vm + +if [ -z "$package_name" ]; then + print >&2 "Internal Error. Please report a bug." + exit 1; +fi + +# This script is called as the last step of the installation of the +# package. All the package's files are in place, dpkg has already done +# its automatic conffile handling, and all the packages we depend of +# are already fully installed and configured. +# summary of how this script can be called: +# * <postinst> `configure' <most-recently-configured-version> +# * <old-postinst> `abort-upgrade' <new version> +# * <old-postinst> abort-remove # if prerm fails during removal +# * <conflictor's-postinst> `abort-remove' `in-favour' <package> +# <new-version> +# * <deconfigured's-postinst> `abort-deconfigure' `in-favour' +# <failed-install-package> <version> `removing' +# <conflicting-package> <version> +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package +# +# quoting from the policy: +# Any necessary prompting should almost always be confined to the +# post-installation script, and should be protected with a conditional +# so that unnecessary prompting doesn't happen if a package's +# installation fails and the `postinst' is called with `abort-upgrade', +# `abort-remove' or `abort-deconfigure'. + +# The following idempotent stuff doesn't generally need protecting +# against being run in the abort-* cases. + + +# Create stub directories under /usr/local +##: if test ! -d /usr/local/lib/${package_name}; then +##: if test ! -d /usr/local/lib; then +##: if mkdir /usr/local/lib; then +##: chown root.staff /usr/local/lib || true +##: chmod 2775 /usr/local/lib || true +##: fi +##: fi +##: if mkdir /usr/local/lib/${package_name}; then +##: chown root.staff /usr/local/lib/${package_name} || true +##: chmod 2775 /usr/local/lib/${package_name} || true +##: fi +##: fi + +# Ensure the menu system is updated +# [ ! -x /usr/bin/update-menus ] || /usr/bin/update-menus + +# Arrange for a daemon to be started at system boot time +##: update-rc.d ${package_name} default >/dev/null + +case "$1" in + configure) + # Configure this package. If the package must prompt the user for + # information, do it here. + + # Activate menu-methods script + ##: chmod a+x /etc/menu-methods/${package_name} + + # Update ld.so cache + ##: ldconfig + + # Make our version of a program available + ##: update-alternatives \ + ##: --install /usr/bin/program program /usr/bin/alternative 50 \ + ##: --slave /usr/man/man1/program.1.gz program.1.gz \ + ##: /usr/man/man1/alternative.1.gz + + # Tell ucf that the file in /usr/share/foo is the latest + # maintainer version, and let it handle how to manage the real + # confuguration file in /etc. This is how a static configuration + # file can be handled: + ##:if which ucf >/dev/null 2>&1; then + ##: ucf /usr/share/${package_name}/configuration /etc/${package_name}.conf + ##:fi + + ### We could also do this on the fly. The following is from Tore + ### Anderson: + + #. /usr/share/debconf/confmodule + + ### find out what the user answered. + # db_get foo/run_on_boot + # run_on_boot=$RET + # db_stop + + ### safely create a temporary file to generate our suggested + ### configuration file. + # tempfile=`tempfile` + # cat << _eof > $tempfile + ### Configuration file for Foo. + + ### this was answered by you, the user in a debconf dialogue + # RUNONBOOT=$run_on_boot + + ### this was not, as it has a sane default value. + # COLOUROFSKY=blue + + #_eof + + ### Note that some versions of debconf do not release stdin, so + ### the following invocation of ucf may not work, since the stdin + ### is never coneected to ucfr. + + ### now, invoke ucf, which will take care of the rest, and ask + ### the user if he wants to update his file, if it is modified. + #ucf $tempfile /etc/foo.conf + + ### done! now we'll just clear up our cruft. + #rm -f $tempfile + + + + # There are three sub-cases: + if test "${2+set}" != set; then + # We're being installed by an ancient dpkg which doesn't remember + # which version was most recently configured, or even whether + # there is a most recently configured version. + : + + elif test -z "$2" || test "$2" = "<unknown>"; then + # The package has not ever been configured on this system, or was + # purged since it was last configured. + : + + else + # Version $2 is the most recently configured version of this + # package. + : + # People upgrading from older versions should get byte compiled + if dpkg --compare-versions "7.19-8" gt "$2"; then + if [ -e /usr/share/emacs21/site-lisp/$package_name/vm-autoload.elc ]; then + rm -f /usr/share/emacs21/site-lisp/$package_name/vm-autoload.elc + fi + if [ -e /usr/share/emacs22/site-lisp/$package_name/vm-autoload.elc ]; then + rm -f /usr/share/emacs22/site-lisp/$package_name/vm-autoload.elc + fi + fi + + fi + + # Install emacs lisp files + if [ -x /usr/lib/emacsen-common/emacs-package-install ]; then + /usr/lib/emacsen-common/emacs-package-install $package_name + fi + + if which ucfr >/dev/null; then + for flavour in emacs24 emacs22 emacs23 emacs-snapshot xemacs21; do + STARTDIR=/etc/$flavour/site-start.d; + STARTFILE="${package_name}-init.el"; + if [ -e "$STARTDIR/50$STARTFILE" ]; then + ucfr ${package_name} "$STARTDIR/50$STARTFILE" + fi + done + fi + + # Take care of older vm-init requirements + # These are the potential places we could find things in + SITE_START="/etc/emacs/site-start.el /usr/lib/emacs/site-lisp/site-start.el" + + # The requires line looks like this + REQUIRE='(load "vm-init.el")' + + # Ok, lets see what we have here + for i in $SITE_START ; do + if [ -e $i ]; then + if [ "`grep vm-init $i`" != "" ]; then + SITE_FIX="$SITE_FIX $i" + fi + fi + done + + # See if we may fix things quietly + for i in $SITE_FIX ; do + grep -v "$REQUIRE" $i > /etc/emacs/`basename $i`.new.$$ + mv /etc/emacs/`basename $i`.new.$$ $i || echo Could not edit $i + done + + # These were the problem files + SITE_START="$SITE_FIX" + SITE_FIX="" + + # Any mention of vm-init left? + for i in $SITE_START ; do + if [ -e $i ]; then + if [ "`grep vm-init $i`" != "" ]; then + SITE_FIX="$SITE_FIX $i" + fi + fi + done + + if [ "$SITE_FIX" != "" ]; then + echo "" + echo "The following files mention vm-init, even though they shouldn't:" + echo " $SITE_FIX " + echo "please remove the load or require command from these files." + echo "" + exit 0 + fi + + ;; + abort-upgrade) + # Back out of an attempt to upgrade this package FROM THIS VERSION + # to version $2. Undo the effects of "prerm upgrade $2". + : + + ;; + abort-remove) + if test "$2" != in-favour; then + echo "$0: undocumented call to \`postinst $*'" 1>&2 + exit 0 + fi + # Back out of an attempt to remove this package, which was due to + # a conflict with package $3 (version $4). Undo the effects of + # "prerm remove in-favour $3 $4". + : + + ;; + abort-deconfigure) + if test "$2" != in-favour || test "$5" != removing; then + echo "$0: undocumented call to \`postinst $*'" 1>&2 + exit 0 + fi + # Back out of an attempt to deconfigure this package, which was + # due to package $6 (version $7) which we depend on being removed + # to make way for package $3 (version $4). Undo the effects of + # "prerm deconfigure in-favour $3 $4 removing $6 $7". + : + + ;; + *) echo "$0: didn't understand being called with \`$1'" 1>&2 + exit 0;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + + +exit 0 diff --git a/debian/vm.postrm b/debian/vm.postrm new file mode 100755 index 0000000..23245eb --- /dev/null +++ b/debian/vm.postrm @@ -0,0 +1,217 @@ +#! /bin/sh +# -*- Mode: Sh -*- +# postrm --- +# Author : Manoj Srivastava ( srivasta@glaurung.green-gryphon.com ) +# Created On : Fri Nov 14 12:22:20 2003 +# Created On Node : glaurung.green-gryphon.com +# Last Modified By : Manoj Srivastava +# Last Modified On : Fri Sep 29 14:09:08 2006 +# Last Machine Used: glaurung.internal.golden-gryphon.com +# Update Count : 11 +# Status : Unknown, Use with caution! +# HISTORY : +# Description : +# +# arch-tag: 56802d51-d980-4822-85c0-28fce19ed430 +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# + + +# Abort if any command returns an error value +set -e + +package_name=vm +ELDIR=/usr/share/emacs/site-lisp/$package_name + +if [ -z "$package_name" ]; then + print >&2 "Internal Error. Please report a bug." + exit 1; +fi + +# This script is called twice during the removal of the package; once +# after the removal of the package's files from the system, and as +# the final step in the removal of this package, after the package's +# conffiles have been removed. +# summary of how this script can be called: +# * <postrm> `remove' +# * <postrm> `purge' +# * <old-postrm> `upgrade' <new-version> +# * <new-postrm> `failed-upgrade' <old-version> +# * <new-postrm> `abort-install' +# * <new-postrm> `abort-install' <old-version> +# * <new-postrm> `abort-upgrade' <old-version> +# * <disappearer's-postrm> `disappear' <r>overwrit>r> <new-version> +# for details, see http://www.debian.org/doc/debian-policy/ or +# the debian-policy package + +# Ensure the menu system is updated +#[ ! -x /usr/bin/update-menus ] || /usr/bin/update-menus + +case "$1" in + remove) + # This package is being removed, but its configuration has not yet + # been purged. + : + test ! -d /usr/share/emacs/site-lisp/vm || \ + find /usr/share/emacs/site-lisp/vm -type f \ + \( -name \*.elc -o -name \*.el \) -exec rm {} \; + test ! -d /usr/share/emacs/site-lisp/vm || \ + rmdir --ignore-fail-on-non-empty /usr/share/emacs/site-lisp/vm + # Remove diversion + ##: dpkg-divert --package ${package_name} --remove --rename \ + ##: --divert /usr/bin/other.real /usr/bin/other + + # ldconfig is NOT needed during removal of a library, only during + # installation + + ;; + purge) + # This package has previously been removed and is now having + # its configuration purged from the system. + : + + # we mimic dpkg as closely as possible, so we remove configuration + # files with dpkg backup extensions too: + ### Some of the following is from Tore Anderson: + ##: for ext in '~' '%' .bak .dpkg-tmp .dpkg-new .dpkg-old .dpkg-dist; do + ##: rm -f /etc/${package_name}.conf$ext + ##: done + + # remove the configuration file itself + ##: rm -f /etc/${package_name}.conf + + # and finally clear it out from the ucf database + ##: ucf --purge /etc/${package_name}.conf + + # Remove symlinks from /etc/rc?.d + ##: update-rc.d ${package_name} remove >/dev/null + + ##: if [ -e /usr/share/debconf/confmodule ]; then + ##: # Purge this package's data from the debconf database. + ##: . /usr/share/debconf/confmodule + ##: db_purge + ##: fi + test ! -d /usr/share/emacs/site-lisp/vm || \ + find /usr/share/emacs/site-lisp/vm -type f \ + \( -name \*.elc -o -name \*.el \) -exec rm {} \; + test ! -d /usr/share/emacs/site-lisp/vm || \ + rmdir --ignore-fail-on-non-empty /usr/share/emacs/site-lisp/vm + + if [ -f $ELDIR/vm.el ]; then + rm -f -f $ELDIR/vm.el + fi + if [ -f $ELDIR/vm.elc ]; then + rm -f -f $ELDIR/vm.elc + fi + + for flavour in emacs24 emacs22 emacs23 emacs-snapshot xemacs21; do + ELCDIR=/usr/share/$flavour/site-lisp/$package_name/ + if [ -f /etc/$flavour/site-start.d/50vm-init.el ]; then + rm -f /etc/$flavour/site-start.d/50vm-init.el + fi + if [ -d /usr/share/$flavour/site-lisp/$package_name ]; then + if [ -f /usr/share/$flavour/site-lisp/$package_name/install.log ]; then + rm -f /usr/share/$flavour/site-lisp/$package_name/install.log + fi + if [ -f /usr/share/$flavour/site-lisp/$package_name/vm-init.el ]; then + rm -f /usr/share/$flavour/site-lisp/$package_name/vm-init.el + fi + rm -f /usr/share/$flavour/site-lisp/$package_name/*.elc || true + rmdir /usr/share/$flavour/site-lisp/$package_name || true + fi + done + + # This package has previously been removed and is now having + # its configuration purged from the system. + for flavour in emacs24 emacs22 emacs23 emacs-snapshot xemacs21; do + STARTDIR=/etc/$flavour/site-start.d; + STARTFILE="${package_name}-init.el"; + if which ucf >/dev/null; then + ucf --purge "$STARTDIR/50$STARTFILE"; + fi + if which ucfr >/dev/null; then + ucfr --purge ${package_name} "$STARTDIR/50$STARTFILE" + fi + if [ -e "$STARTDIR/20$STARTFILE" ]; then + rm -f "$STARTDIR/20$STARTFILE" + fi + done + + ;; + disappear) + if test "$2" != overwriter; then + echo "$0: undocumented call to \`postrm $*'" 1>&2 + exit 0 + fi + # This package has been completely overwritten by package $3 + # (version $4). All our files are already gone from the system. + # This is a special case: neither "prerm remove" nor "postrm remove" + # have been called, because dpkg didn't know that this package would + # disappear until this stage. + : + + ;; + upgrade) + # About to upgrade FROM THIS VERSION to version $2 of this package. + # "prerm upgrade" has been called for this version, and "preinst + # upgrade" has been called for the new version. Last chance to + # clean up. + : + + ;; + failed-upgrade) + # About to upgrade from version $2 of this package TO THIS VERSION. + # "prerm upgrade" has been called for the old version, and "preinst + # upgrade" has been called for this version. This is only used if + # the previous version's "postrm upgrade" couldn't handle it and + # returned non-zero. (Fix old postrm bugs here.) + : + + ;; + abort-install) + # Back out of an attempt to install this package. Undo the effects of + # "preinst install...". There are two sub-cases. + : + + if test "${2+set}" = set; then + # When the install was attempted, version $2's configuration + # files were still on the system. Undo the effects of "preinst + # install $2". + : + + else + # We were being installed from scratch. Undo the effects of + # "preinst install". + : + + fi ;; + abort-upgrade) + # Back out of an attempt to upgrade this package from version $2 + # TO THIS VERSION. Undo the effects of "preinst upgrade $2". + : + + ;; + *) echo "$0: didn't understand being called with \`$1'" 1>&2 + exit 0;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + + +exit 0 diff --git a/debian/vm.prerm b/debian/vm.prerm new file mode 100755 index 0000000..5c90f6d --- /dev/null +++ b/debian/vm.prerm @@ -0,0 +1,136 @@ +#! /bin/sh +# -*- Mode: Sh -*- +# prerm --- +# Author : Manoj Srivastava ( srivasta@glaurung.green-gryphon.com ) +# Created On : Fri Nov 14 12:16:39 2003 +# Created On Node : glaurung.green-gryphon.com +# Last Modified By : Manoj Srivastava +# Last Modified On : Sat Dec 3 15:14:38 2005 +# Last Machine Used: glaurung.internal.golden-gryphon.com +# Update Count : 10 +# Status : Unknown, Use with caution! +# HISTORY : +# Description : +# +# arch-tag: a4c1a888-137d-4800-98f8-93d0365422d8 +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# + +# Abort if any command returns an error value +set -e + +package_name=vm + +if [ -z "$package_name" ]; then + print >&2 "Internal Error. Please report a bug." + exit 1; +fi + + +# This script is called as the first step in removing the package from +# the system. This includes cases where the user explicitly asked for +# the package to be removed, upgrade, automatic removal due to conflicts, +# and deconfiguration due to temporary removal of a depended-on package. + +case "$1" in + remove) + # This package about to be removed. + : + + # Remove package-specific directories from /usr/local. Don't try + # to remove standard directories such as /usr/local/lib. + ##: if test -d /usr/local/lib/${package_name}; then + ##: rmdir /usr/local/lib/${package_name} || true + ##: fi + + # Deactivate menu-methods script. + ##: chmod a-x /etc/menu-methods/${package_name} + + # Withdraw our version of a program. + ##: update-alternatives --remove program /usr/bin/alternative + + + # Get rid of the byte compiled files + if [ -x /usr/lib/emacsen-common/emacs-package-remove ]; then + /usr/lib/emacsen-common/emacs-package-remove $package_name + fi + + if [ -L /usr/doc/$package_name ]; then + rm -f /usr/doc/$package_name + fi + + # There are two sub-cases: + if test "${2+set}" = set; then + if test "$2" != in-favour; then + echo "$0: undocumented call to \`prerm $*'" 1>&2 + exit 0 + fi + # We are being removed because of a conflict with package $3 + # (version $4), which is now being installed. + : + + else + # The package is being removed in its own right. + : + + fi ;; + deconfigure) + if test "$2" != in-favour || test "$5" != removing; then + echo "$0: undocumented call to \`prerm $*'" 1>&2 + exit 0 + fi + # Package $6 (version $7) which we depend on is being removed due + # to a conflict with package $3 (version $4), and this package is + # being deconfigured until $6 can be reinstalled. + : + + ;; + upgrade) + # Prepare to upgrade FROM THIS VERSION of this package to version $2. + : + + # Get rid of the byte compiled files + if [ -x /usr/lib/emacsen-common/emacs-package-remove ]; then + /usr/lib/emacsen-common/emacs-package-remove $package_name + fi + if [ -L /usr/doc/$package_name ]; then + rm -f /usr/doc/$package_name + fi + + ;; + failed-upgrade) + # Prepare to upgrade from version $2 of this package TO THIS VERSION. + # This is only used if the old version's prerm couldn't handle it, + # and returned non-zero. (Fix old prerm bugs here.) + : + # Get rid of the byte compiled files + if [ -x /usr/lib/emacsen-common/emacs-package-remove ]; then + /usr/lib/emacsen-common/emacs-package-remove $package_name + fi + + ;; + *) echo "$0: didn't understand being called with \`$1'" 1>&2 + exit 0;; +esac + +# dh_installdeb will replace this with shell code automatically +# generated by other debhelper scripts. + +#DEBHELPER# + + +exit 0 diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..5319811 --- /dev/null +++ b/debian/watch @@ -0,0 +1,15 @@ +# format version number, currently 2; this line is compulsory! +version=3 + +# http://www.seanet.com/~kylemonger/vm/vm-([0-9][0-9\.]*)\.tar\.gz debian + +#opts="uversionmangle=s/\.$//" \ +#http://download.savannah.nongnu.org/releases/viewmail/vm-([0-9][0-9\.]*?[0-9]+)(-\d+)?\.tgz debian + +opts=filenamemangle=s/tgz$/tar.gz/ \ +https://launchpad.net/vm https://launchpad.net/vm/.*/.*/\+download/vm-([\d\.a-z]+).tgz + +# So. If We only want the 8.1.x series, and also the non-emacs-23 versions +# which are source only +#opts=filenamemangle=s/tgz$/tar.gz/ \ +#https://launchpad.net/vm/+download https://launchpad.net/vm/8\.1.*/.*/\+download/vm-([\d\.]+).tgz diff --git a/example.vm b/example.vm new file mode 100755 index 0000000..2ae9db1 --- /dev/null +++ b/example.vm @@ -0,0 +1,295 @@ +;;; .vm --- Example ~/.vm +;;; +;;; -*- emacs-lisp -*- +;;; +;;; Copyright (C) 2007 Robert Widhopf-Fenk +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 1, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; + +;;; You may use this file as a starting point for setting up and customizing +;;; VM to your own needs. + +;;***************************************************************************** +;; Make VM your default mail agent in Emacs +(setq mail-user-agent 'vm-user-agent) + +;;***************************************************************************** + +;; Two ways of using VM: +;; - downloading mail to local folders +;; - reading mail on mail servers from anywhere on the internet + +;; For local folders, set these variables: + +(setq vm-folder-directory "~/mail") + +(setq + ;; vm-primary-inbox is the filesystem path to where VM stores + ;; downloaded messages: + vm-primary-inbox "~/INBOX" + ;; vm-crash-box is where messages are stored temporarily as it is moved into + ;; your primary inbox file (vm-primary-inbox). Here we just tack on a + ;; .crash to name it separately: + vm-crash-box (concat vm-primary-inbox ".crash")) + +;; vm-spool-files is a list of lists, each sublist should be of the form +;; (INBOX SPOOLNAME CRASHBOX) +(setq vm-spool-files + (list + ;; You can drop mail to the same inbox from different spool files. + (list vm-primary-inbox "/var/spool/mail/username1" vm-crash-box) + (list vm-primary-inbox "/var/spool/mail/username2" vm-crash-box) + ;; Another spool file + (list "spam" (expand-file-name "~spam/drop") + (concat vm-folder-directory "spam.crash")) + ;; POP + (list "gmail.pop" + "pop:pop.google.com:110:pass:YourEmailAddress:*" + (concat vm-folder-directory "gmail.pop.crash")) + ;; POP-SSL + (list "gmail.pop" + "pop-ssl:pop.google.com:995:pass:YourEmailAddress:*" + (concat vm-folder-directory "gmail.pop.crash")) + ;; IMAP + (list "gmail.imap" + "imap:imap.google.com:143:inbox:login:YourEmailAddress:*" + (concat vm-folder-directory "gmail.imap.crash")) + )) + +;; For server folders, set these variables: + +(setq vm-primary-inbox + ;; use one of these two + ;; for POP server + "pop:pop.google.com:110:pass:YourEmailAddress:*" + ;; for IMAP server + "imap:imap.google.com:143:inbox:login:YourEmailAddress:*" + ) + +(setq vm-pop-folder-cache-directory "~/mailcache") +(setq vm-imap-folder-cache-directory "~/mailcache") + +(setq vm-pop-folder-alist + ;; for other POP servers + '(("pop:pop3.blueyonder.co.uk:110:pass:YourEmailAddress:*" + "blueyonder") + ("pop:mailhost.cs.bham.ac.uk:110:pass:YourEmailAddress:*" + "bham"))) +(setq vm-imap-account-alist + ;; for other IMAP servers + '(("imap:imap4.blueyonder.co.uk:143:*:login:YourEmailAddress:*" + "blueyonder") + ("imap:mailhost.cs.bham.ac.uk:143:*:login:YourEmailAddress:*" + "bham") + )) + +;;***************************************************************************** +;; Summary + +;; See the recipients for emails you sent instead of yourself. +(setq vm-summary-uninteresting-senders + (regexp-opt '("@robf.de" "Robert Widhopf-Fenk"))) + +;; Change the summary format by setting `vm-summary-format'. +;; Run "M-x vm-fix-my-summary!!! RET" to fix existing summaries. + +;;***************************************************************************** +;; Viewing messages +;; +;; HTML messages can be converted to text or the w3 resp. w3m Emacs viewers +;; can be used for displaying. + +(setq vm-mime-type-converter-alist + '(("text/html" "text/plain" "lynx -force_html -dump /dev/stdin") + ("message/delivery-status" "text/plain") + ("application/zip" "text/plain" "listzip") + ("application/x-zip-compressed" "text/plain" "zipinfo /dev/stdin") + ("application/x-www-form-urlencoded" "text/plain") + ("message/disposition-notification" "text/plain") + ("application/mac-binhex40" "application/octet-stream" "hexbin -s")) + + +;; Set up w3m (you should check if it exists) +(require 'vm-w3m) +(setq vm-included-mime-types-list + '("text/plain" "text/html" "text/enriched" "message/rfc822")) + +;;***************************************************************************** +;; Composing email + +(setq mail-default-headers "From: Robert Widhopf-Fenk <hack@robf.de>\n") + +(vmpc-my-identities "me@company1.nil" "me@home.nil" "me@alterego.nil") +(require 'vm-pcrisis) + +;;***************************************************************************** +;; A hook function to setup mail-composing buffers +(defun robf-vm-mail-mode-hook () + "Robert Widhopf-Fenks `vm-mail-mode-hook'." + (interactive) + + (when (string-match "received" (buffer-name)) + (make-local-variable 'vm-confirm-quit) + (setq vm-confirm-quit t)) + + (setq fill-column 60 + comment-start "> " + indent-line-function 'indent-relative-maybe) + + ;; mark lines longer than `fill-column' chars red + (add-to-list 'mail-font-lock-keywords + (list (concat "^" (make-string fill-column ?.) + "\\(.+$\\)") + '(1 font-lock-warning-face t))) + + (ispell-change-dictionary "deutsch8") + + (font-lock-mode 1) + (turn-on-auto-fill) + (turn-on-filladapt-mode) + (flyspell-mode 1) +; (enriched-mode 1) +; (auto-capitalize-mode) +; (vm-mail-subject-prefix-cleanup) + ) + +(add-hook 'vm-mail-mode-hook 'robf-vm-mail-mode-hook) + +;; Do you like boxquotes? +(require 'boxquote) + +(defun boxquote-region-and-edit-title (s e) + (interactive "r") + (boxquote-region s e) + (call-interactively 'boxquote-title)) + +;;***************************************************************************** +;; Sending email via SMTP. +;; +;; This is not done by VM, but by separate packages. The standard package is +;; smtpmail.el and it should come with your Emacs. If you have more than one +;; email address and have to send them using different SMTP servers, the you +;; might want to take a look at esmtpmail.el a fork from smtpmail.el targeted +;; to deal with personal crisis support. +(require 'esmtpmail) +(setq send-mail-function 'esmtpmail-send-it + esmtpmail-default-smtp-server "smtp.someprovider.com" + ;; trace buffers help debugging problems + esmtpmail-debug-info t) + +;; Select the SMTP server based on the From: header, i.e. the email address of +;; the author. There are also other authentication methods, see the docs. +(setq esmtpmail-send-it-by-alist + (list + '("YourEmaiAddress1" "SMTPSERVER1" + (vm-pop-login "pop:SMTPSERVER1:110:pass:YourEmailAddress:*")) + '("YourEmaiAddress2" "SMTPSERVER2" + (vm-after-pop "pop:SMTPSERVER2:110:pass:YourEmailAddress:*")))) + +;;***************************************************************************** +;; Feed mail to a local queue if you are offline +(require 'feedmail) + +(setq send-mail-function 'vm-mail-send-or-feed-it + feedmail-enable-queue t + feedmail-ask-before-queue nil + feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail + feedmail-queue-directory (expand-file-name "~/Mail/QUEUE")) + +(define-key vm-mode-map "Qr" 'feedmail-run-the-queue) +(define-key vm-mode-map "Qc" 'vm-smtp-server-online-p) +(define-key vm-mode-map "Qw" 'feedmail-queue-reminder-medium) + +(setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist)) + +;; Check the queue on startup +(when (and (> (car (feedmail-look-at-queue-directory + feedmail-queue-directory)) 0)) + (feedmail-queue-reminder-medium) + (sit-for 2) + (if (y-or-n-p "Send messages now? ") + (feedmail-run-the-queue))) + +;;***************************************************************************** +;; BBDB - the address book for Emacs +(require 'bbdb) +(require 'bbdb-autoloads) +(bbdb-initialize 'vm 'sendmail) +(bbdb-insinuate-vm) + +;; create records for people you reply to +(add-hook 'vm-reply-hook 'bbdb-force-record-create) + +;;***************************************************************************** +;; Now change some keyboard bindings +(define-key vm-mode-map [(meta up)] 'vm-previous-unread-message) +(define-key vm-mode-map [(meta down)] 'vm-next-unread-message) +(define-key vm-mode-map "\C- " 'vm-scroll-backward) +(define-key vm-mode-map " " 'vm-scroll-forward) +(define-key vm-mode-map "c" 'vm-continue-what-message-other-frame) +(define-key vm-mode-map "C" 'vm-continue-postponed-message) +(define-key vm-mode-map "R" 'vm-reply-other-frame) +(define-key vm-mode-map "r" 'vm-reply-include-text-other-frame) +(define-key vm-mode-map "\C-R" 'vm-followup-other-frame) +(define-key vm-mode-map "\C-r" 'vm-followup-include-text-other-frame) +(define-key vm-mode-map "f" 'vm-forward-message-other-frame) +(define-key vm-mode-map "m" 'vm-toggle-mark) +(define-key vm-mode-map "d" 'vm-delete-message-action) +(define-key vm-mode-map "s" 'vm-virtual-save-message) +(define-key vm-mode-map "w" 'vm-save-message-preview) +(define-key vm-mode-map "lr" 'vm-delete-message-labels) +(define-key vm-mode-map "li" 'rf-vm-label-toggle-important) +(define-key vm-mode-map "ls" 'rf-vm-label-toggle-spam) +(define-key vm-mode-map "W" 'vm-save-message-sans-headers) +(define-key vm-mode-map "W" (make-sparse-keymap)) +(define-key vm-mode-map "WW" 'vm-apply-window-configuration) +(define-key vm-mode-map "WS" 'vm-save-window-configuration) +(define-key vm-mode-map "WD" 'vm-delete-window-configuration) +(define-key vm-mode-map "W?" 'vm-window-help) +(define-key vm-mode-map "x" 'vm-expunge-folder) +(define-key vm-mode-map "X" 'vm-expunge-pop-messages) +(define-key vm-mode-map "#" nil) +(define-key vm-mode-map "/" 'bbdb) +(define-key vm-mode-map [(control return)] 'vm-edit-init-file) +(define-key vm-mode-map "S" 'vm-save-everything) +(define-key vm-mode-map "\C-a" 'vm-mime-auto-save-all-attachments) +(define-key vm-mode-map "VO" 'vm-virtual-omit-message) +(define-key vm-mode-map "VU" 'vm-virtual-update-folders) +(define-key vm-mode-map [(control s)] 'isearch-forward) +(define-key vm-mode-map "o" 'vm-switch-to-folder) + +(define-key vm-summary-mode-map [(control up)] 'previous-line) +(define-key vm-summary-mode-map [(control down)] 'next-line) +(define-key vm-summary-mode-map [(control s)] 'vm-isearch-forward) + +(define-key vm-mail-mode-map [tab] 'indent-relative) +(define-key vm-mail-mode-map [(control tab)] 'mail-interactive-insert-alias) +(define-key vm-mail-mode-map [return] 'newline-and-indent) +(define-key vm-mail-mode-map "\C-c\C-i" 'vm-serial-yank-mail) +(define-key vm-mail-mode-map "\C-c\C-o" 'vm-serial-expand-tokens) +(define-key vm-mail-mode-map [(control c) (control I)] 'vm-serial-insert-token) +(define-key vm-mail-mode-map [(control meta delete)] 'kill-this-buffer) +(define-key vm-mail-mode-map "\C-c\C-c" 'vm-mail-mode-comment-region) +(define-key vm-mail-mode-map "\C-c\C-d" 'vm-mail-mode-elide-reply-region) +(define-key vm-mail-mode-map "\C-c\C-k" 'vm-mail-mode-citation-clean-up) +(define-key vm-mail-mode-map "\C-c\C-a" 'vm-mime-attach-file) +(define-key vm-mail-mode-map "\C-c\C-b" 'boxquote-region-and-edit-title) + +;;; Local Variables: *** +;;; mode:emacs-lisp *** +;;; End: *** + +;;; .vm ends here diff --git a/info/Makefile.in b/info/Makefile.in new file mode 100755 index 0000000..4828856 --- /dev/null +++ b/info/Makefile.in @@ -0,0 +1,83 @@ +@SET_MAKE@ + +# no csh please +SHELL = /bin/sh + +# the version of this package +PACKAGE_VERSION = @PACKAGE_VERSION@ + +############################################################################## +# location of required programms +prefix = @prefix@ +MKDIR = @MKDIR@ +RM = @RM@ +LS = @LS@ +XARGS = @XARGS@ +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +top_srcdir = @top_srcdir@ +srcdir = @srcdir@ +datadir= @datadir@ +datarootdir= @datarootdir@ +info_dir = @info_dir@ + +EMACS_PROG = @EMACS_PROG@ +EMACS_FLAVOR = @EMACS_FLAVOR@ + +FLAGS = @FLAGS@ + +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +############################################################################## + +all: info + +version.texinfo: + echo @set VERSION $(PACKAGE_VERSION) > $@ + +vm.info:: version.texinfo + +vm-pcrisis.info:: version.texinfo + +info: vm.info vm-pcrisis.info + +Makefile: @srcdir@/Makefile.in + cd @srcdir@/..; ./config.status + +install: install-pkg + +install-pkg: uninstall-pkg info + @mkdir -p -m 0755 "$(DESTDIR)$(info_dir)"; \ + if test "x$(SYMLINKS)" = "xno" ; then \ + for i in `${LS} *.info* ` ; do \ + echo "Installing $$i in $(DESTDIR)$(info_dir)" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(info_dir)" ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + for i in `${LS} *.info* ` ; do \ + echo "Linking $$i in $(DESTDIR)$(info_dir)" ; \ + $(LN_S) "`pwd`/$$i" "$(DESTDIR)$(info_dir)/$$i" ; \ + done ; \ + else \ + for i in `${LS} *.info* ` ; do \ + echo "Linking $(LINKPATH)/texinfo/$$i in $(DESTDIR)$(info_dir)" ; \ + $(LN_S) "$(LINKPATH)/texinfo/$$i" "$(DESTDIR)$(info_dir)/$$i" ; \ + done ; \ + fi ; \ + fi + @echo VM INFO files successfully installed\! + +uninstall-pkg: + -$(RM) "$(DESTDIR)$(info_dir)"/vm*.info* + +############################################################################## +clean: + -$(RM) -f version.texinfo *.info *.info-[0-9] + +distclean: clean + -$(RM) -f Makefile diff --git a/info/vm-pcrisis.texinfo b/info/vm-pcrisis.texinfo new file mode 100755 index 0000000..72b8cfa --- /dev/null +++ b/info/vm-pcrisis.texinfo @@ -0,0 +1,1459 @@ +\input texinfo +@setfilename vm-pcrisis.info +@settitle Personality Crisis for VM +@dircategory Emacs +@direntry +* VM-pcrisis: (vm-pcrisis). Personality profiles control for VM +@end direntry + +@iftex +@finalout +@end iftex +@c @setchapternewpage odd % For book style double sided manual. +@c @smallbook +@tex +\overfullrule=0pt +%\global\baselineskip 30pt % For printing in double spaces +@end tex +@ifinfo +This is the documentation for Personality Crisis, an add-on for the +mail reader VM which allows you to manage personality profiles +automatically when you compose new mail messages or replies. + +@table @asis +@item Copyright (C) 1999 Rob Hodges +@item Copyright (C) 2006-2008 Robert Widhopf-Fenk +@item Copyright (C) 2011 Uday S. Reddy +@end table + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@ignore +Permission is granted to process this file through TeX and print the +results, provided the printed document carries copying permission +notice identical to this one except for the removal of this paragraph +(this paragraph not being relevant to the printed manual). + +@end ignore +@end ifinfo +@c +@include version.texinfo +@titlepage +@sp 6 +@center @titlefont{Personality Crisis for VM} +@sp 4 +@center VM Version @value{VERSION} +@sp 5 +@page +@vskip 0pt plus 1filll +Copyright @copyright{} 1999 Rob Hodges +Copyright @copyright{} 2006-2008 Robert Widhopf-Fenk +Copyright @copyright{} 2011 Uday S. Reddy + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@end titlepage +@page +@ifnottex +@node Top, Introduction, , (DIR) + +This is the documentation for VM Personality Crisis, an add-on for the VM +mail reader allowing you to control personality profiles used in composing +messages. + +It was originally written by Rob Hodges. + +This manual corresponds to VM version @value{VERSION}. + +@menu +* Introduction:: +* Setting Up:: +* Miscellaneous Variables:: +* Debugging:: +* Version History:: +* Variable Index:: +* Function Index:: +@end menu +@end ifnottex + +The incompete list of Roberts who have been involved in vm-pcrisis: + +@itemize @bullet +@item Rob Hodges +@item Robert Widhopf-Fenk +@item Robert P. Goldman +@item Robert Marshall +@end itemize + +@node Introduction, Setting Up, Top, Top +@chapter Introduction + +The @strong{Personality Crisis} package is designed to manage multiple +``profiles'' (mail identities or mail accounts) during mail-sending. +It is based on a programmable system of condition-action rules, which is in +fact a lot more general than the management of profiles. Other +applications of this technology may be developed in future. + +Personality Crisis can look at the headers of a message you are replying to +or forwarding, or a message you are composing, and use that information to +customize the message composition. Common customizations include inserting +particular ``From:'' or ``Reply-To:'' headers, inserting signatures or +boilerplate text in the message composition and choosing a MIME character +set for the outgoing message. See @ref{Common Uses} below for further +ideas. + +The Personality Crisis package is not automatically loaded as part of VM. +To use it, place the following line in your @code{vm-init-file}. + +@lisp +(require 'vm-pcrisis) +@end lisp + +As a quick start, you can also add a line similar to the following: + +@lisp +(vmpc-my-identities "me@@company1.nil" "me@@home.nil" "me@@alterego.nil") +@end lisp + +with your own email addresses. VM-Pcrisis will set up each email address +with a standard action for using it as the ``From'' header. +Every time you write message to an unknown recipient, it will prompt you +for the action to use, which is nothing but the ``From'' address to use. + +This is a completely manual method of choosing mail profiles. +You obtain automation by using the customization features described in the +rest of the manual. + +@menu +* Description:: +@end menu + + +@node Description, , Introduction , Introduction +@section Description + +Personality Crisis can look at the headers of a message you are replying +to or forwarding, or a message you are composing, and use that information +to customize the message composition. You can also use it to +explicitly choose a profile when composing new messages. + +@c *************************************************************************** + +@c @node Functionality, Common Uses, Description, Introduction +@unnumberedsubsec Functionality +@anchor{Functionality} + +Based on the headers of a message you are replying to, you can get +vm-pcrisis to perform these actions: + +@itemize @bullet +@item +Change or insert any headers you like in your reply. +@item +Change or insert a signature in your reply. +@item +Insert some text in the body of your reply. +@item +Change any header in your reply to the value of some +header in the message you are replying to. +@item +Call a specified lisp function before VM creates the reply. +@item +Call a specified lisp function in the reply buffer. +@item +Prompt you for a personality profile to use, and optionally, +remember to use that profile when sending messages to the same recipient +in the future. +@end itemize + +Similar functionality is available when forwarding messages. + +Based on the headers of a message you are composing, it can perform these +actions: + +@itemize @bullet +@item +Change or insert any headers of your choice. +@item +Change or insert a signature. +@item +Insert specified text in the message body. +@item +Call some functions in the message buffer. +@item +Prompt you for a personality profile to use, and optionally, +remember to use that profile when sending messages to the same recipient +in the future. +@end itemize + +If you wish, you can also have vm-pcrisis prompt you for a profile +when composing new mail, which is useful if you need to set up VM +variables for the composition. + +If you wish to write your own functions to perform actions beyond the +built-in functionality, vm-pcrisis provides primitive functions for +accessing the contents of headers in the message you are +replying to as well as the message you are composing. + +@c *************************************************************************** + +@c @node Common Uses, Overview, Specific Abilities, Introduction +@unnumberedsubsec Common Uses +@anchor{Common Uses} + +Here are some of the common uses of vm-pcrisis. + +@itemize @bullet +@item +People with multiple e-mail addresses can automatically set up +headers such as ``From:'' and ``Reply-To:'', so that, for example, their +work email keeps going to their work account, and their private email to +their private account. + +@item +People who like to have different nicknames and signatures for +different lists can do so. (Well, uh, that's why it is called +Personality Crisis...) You can select your +personality for new mail messages as well as replies. + +@item +When people send you html-formatted email, you can have your reply +automatically include a form letter explaining why they shouldn't, and +how to turn it off. (Such a letter is not included with this package; +you'll have to write it yourself.) + +@item +People who email in multiple languages can set up the encoding for the +reply, along with the keymap, ispell dictionary, attribution line for +citations, etc, in the reply buffer. + +@item +When you get email from a mailing list that has the ``Reply-To:'' +header set for the whole list, automatically change the ``To:'' header in +your reply to point to the original sender instead. (You can do the +reverse as well.) VM allows you to do +this, but only if the correct reply address is in the "From" field. + +@item +Automatically change the signature and various headers, etc, in a +new mail message after typing in the ``To:'' address. + +@item +Automatically remember which personality to use when sending to a +particular address. + +@item +If you put your imagination to work while reading through this +manual, you'll probably think of other ways that vm-pcrisis can help +you. Have fun! + +@end itemize + +@c *************************************************************************** + +@node Setting Up, Miscellaneous Variables, Introduction, Top +@chapter Setting Up + +When setting up variables for Personality Crisis, you begin by thinking +about what you want it to do when a certain condition occurs, either +when you are replying to or forwarding a message, or in the midst of +writing a message. + +You define the condition in @code{vmpc-conditions}, and the action you +want vm-pcrisis to take in @code{vmpc-actions}, giving a name to each. +You then associate the condition with the action in +@code{vmpc-reply-alist} if it's one that relies on the headers of a +message you are replying to, @code{vmpc-forward-alist} if it's a message +you are forwarding, or @code{vmpc-automorph-alist} if it's based on the +headers of your own message. You may also use +@code{vmpc-newmail-alist} to associate conditions with actions for new +messages, and @code{vmpc-resend-alist} for resending +(bounced) messages. + +If you want to use the @code{vmpc-automorph} function, which takes +actions based on the headers of a message you are composing, +@ref{Automorph} to decide where you want to hook it in. + +The remainder of this manual will provide more information about how to +do all of these things. + +@menu +* Conditions:: Defining conditions that fire actions +* Actions:: Defining actions to be run +* Rules:: Associating conditions with actions +* Automorph:: Running automatic actions for new mail +@end menu + + +@node Conditions, Actions, Setting Up, Setting Up +@c node-name, next, previous, up +@section Conditions + +@c @menu +@c * The vmpc-conditions variable:: +@c * vmpc-conditions examples:: +@c @end menu + +@c @node The vmpc-conditions variable, vmpc-conditions examples, vmpc-conditions, vmpc-conditions +@unnumberedsubsec The vmpc-conditions variable +@anchor{vmpc-conditions} + +The @code{vmpc-conditions} variable is a list of conditions, each of which +can cause Personality Crisis to take a different action. You give each +condition a unique, descriptive name. The format of the list is +something like this: + +@lisp +'( ("condition name" + (lisp-expression-1) ) + ("another condition name" + (lisp-expression-2) ) ) +@end lisp + +The condition names are descriptive names for conditions that you define. +We use strings as names in this manual, but you can also use lisp symbols. + +The lisp-expression can be any expression in lisp that will evaluate to +nil if the condition is to be considered false, and non-nil if true. +(Don't be afraid, non-lispers, examples are coming...) Personality +Crisis provides some functions which can be used there, in combination +with @code{and}, @code{or}, and @code{vmpc-xor} to produce a +fine-grained control over when your actions will trigger. + +@itemize @bullet + +@findex vmpc-folder-match +@item @code{vmpc-folder-match} +When doing replies, forwards and resends, this matches against the name of +the folder where the original message is located. + +@findex vmpc-folder-account-match +@item @code{vmpc-folder-account-match} +When doing replies, forwards and resends, this matches against POP/IMAP +account name of the folder where the original message is located. (These +are the account names defined via the variables @code{vm-pop-folder-alist} +and @code{vm-imap-account-alist}.) + +@findex vmpc-header-match +@item @code{vmpc-header-match} +When doing replies, forwards and resends, this matches against the contents +of a header in the original message; when using the +@code{vmpc-automorph} function, it matches against a header in the message +you are composing. + +@findex vmpc-only-from-match +@item @code{vmpc-only-from-match} +When doing replies, forwards and resends, this matches against the contents +of the given headers in the original message; it is true only when @emph{all} +email adresses match the given regexp. + + +@findex vmpc-body-match +@item @code{vmpc-body-match} +is just like @code{vmpc-header-match} but +allows you to match against the text in the body of the message. + +@findex vmpc-hceck-virtual-selector +@item @code{vmpc-check-virtual-selector}. +If you are using @code{vm-avirtual.el} you can also use this +to check a virtual folder selector. + +@findex vmpc-other-cond +@item @code{vmpc-other-cond} returns true when a specified condition earlier +in the list has been found true. It's essentially a shortcut for +building more complex conditions from basic ones. + +@findex vmpc-none-true-yet +@item @code{vmpc-none-true-yet} returns true if none of the conditions that +come before it in @code{vmpc-conditions} have returned true. You can +optionally specify exceptions, so that it can act as a +"none-true-yet-except..." condition. This is a very useful shortcut to +place last in the list, in order to trigger an action prompting you for +a profile to use. +@end itemize + +You can also use @code{y-or-n-p} for interactive querying, if you always +want to have a choice in what to do when a certain condition occurs. + +We will cover all of these in the examples that follow. + + +@c *************************************************************************** + +@c @node vmpc-conditions examples, , The vmpc-conditions variable, vmpc-conditions +@c node-name, next, previous, up +@subsection vmpc-conditions examples +@anchor{vmpc-conditions examples} + +Suppose you wanted to set up a condition that triggered when you replied +to messages that came from a particular mailing list. Looking at the +headers of these messages, (exposing all of them with @code{t} in VM), you +see that they always have a header like this: + +Resent-Sender: foo-list-maintainer@@bar.baz.com + +Then, in your ~/.vm file, you would have something like this: + +@lisp +(setq vmpc-conditions '( + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + "foo-list-maintainer@@bar.baz.com")) +)) +@end lisp + +This gives you a condition called "foo-list messages" which returns true +when the contents of the "Resent-Sender" header include a match for the +regular expression "foo-list-maintainer@@bar.baz.com". + +----------------------------------------------------------------- + +@subheading Regexp Aside #1: +Usually this will be perfectly adequate. Of course, since the second +string is a regexp, this will also match +"foo-list-maintainer@@barybaz.com", but the odds that you'll come across +that are pretty low. However, if the header contents had included +another regexp special character, it might not match at all. The +easiest way to deal with both these problems is to wrap the string up in +a call to @code{regexp-quote}. Like this: + +@lisp +(setq vmpc-conditions '( + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + (regexp-quote "foo-list-maintainer@@bar.baz.com"))) +)) +@end lisp + +@subheading Regexp Aside #2: +The @code{regexp-opt} function provides a convenient way of producing a +regexp to match against any number of strings. Suppose the +"Resent-Sender" field could contain either +"foo-list-maintainer@@bar.baz.com" or "foo-list-bot@@bar.baz.com". Then +you could use @code{regexp-opt} like this: + +@lisp +(setq vmpc-conditions '( + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + (regexp-opt '("foo-list-maintainer@@bar.baz.com" + "foo-list-bot@@bar.baz.com")))) +)) +@end lisp + +@subheading Regexp Aside #3: +If you write your own regular expressions instead of using +@code{regexp-quote} and @code{regexp-opt}, you should keep in mind that +they must be in lisp syntax. In short, this means that you should use +two backslashes wherever you would usually use one, and if you use a +double-quote (") it should be escaped with a backslash to avoid +prematurely ending the string. You can learn more about regexps from +your Emacs documentation. + +@subheading Regexp Aside #4: +The behaviour of vmpc-header-match is to return true if a match for the +regular expression occurs anywhere in the contents of the header. If +you want your regexp to only match the entire header contents, it should +begin with a caret (^) and end with a dollar sign ($). + +----------------------------------------------------------------- + +Alright, enough about regexps! Let's get on with the example. + +Suppose the next thing you want to do is set up a condition that +triggers when somebody sends you one of those blasted HTML emails. +(When we look at @code{vmpc-actions} you'll see how you can automatically +include a form letter asking them not to do this in your reply.) Your +setup might now expand to this: + +@lisp +(setq vmpc-conditions '( + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + (regexp-quote "foo-list-maintainer@@bar.baz.com"))) + ("html messages" + (vmpc-header-match "Content-type" + "multipart/alternative\\|html")) +)) +@end lisp + +Let's further suppose that foo-list is set up so that replies go to the +entire list, and that you haven't over-ridden this with +@code{vm-reply-ignored-reply-tos} because it's usually what you want. +But when somebody sends an html message to the list, you now have a +setup which results in your anti-html form letter being included in a +message to the whole list. You'd rather it went to them personally. +Okay, let's set up some more refined conditions: + +@lisp +(setq vmpc-conditions '( + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + (regexp-quote "foo-list-maintainer@@bar.baz.com"))) + ("html messages" + (vmpc-header-match "Content-type" + "multipart/alternative\\|html")) + ("plaintext messages from foo-list" + (and (vmpc-other-cond "foo-list messages") + (not (vmpc-other-cond "html messages")))) + ("html messages from foo-list" + (and (vmpc-other-cond "foo-list-messages") + (vmpc-other-cond "html messages"))) + ("html messages not from foo-list" + (and (vmpc-other-cond "html messages") + (not (vmpc-other-cond "foo-list messages")))) +)) +@end lisp + +All of a sudden you have five conditions, but you'll only associate +the last three of them with actions. The first two are just building +blocks for the others. So now you can associate different actions with +each condition: For html messages from foo-list, you can change the To: +address in your reply to point to the original sender, as well as +including your anti-html form letter; for html messages not from +foo-list, just include the form letter; and for plaintext messages from +foo-list, set up your desired personality for a normal reply to the +list. + +What if you want a condition that always returns true, so you can +associate it with an action that you want performed every time? It +would look like this: + +@lisp + ("condition that's always true" + 't) +@end lisp + +----------------------------------------------------------------- + +@subheading Aside: +If you want one that always triggers for replies, but not when using +@code{vmpc-automorph}, it would look like this: + +@lisp + ("condition that's always true for replies" + (eq vmpc-current-state 'reply)) +@end lisp + +Similarly, for one that always triggers with automorph, but not for +replies, you'd have: + +@lisp + ("condition that's always true for automorph" + (eq vmpc-current-state 'automorph)) +@end lisp + +----------------------------------------------------------------- + +If you add that condition, and more to deal with other mailing lists and +situations, you might want to be prompted about what action to take when +none of the conditions match (except, of course, the one that's always +true). This simplest way to produce such a condition (which you can +then associate with a prompting action) is to use +@code{vmpc-none-true-yet}. So you'd end up with something like: + +@lisp +(setq vmpc-conditions '( + ("condition that's always true" + 't) + ("foo-list messages" + (vmpc-header-match "Resent-Sender" + (regexp-quote "foo-list-maintainer@@bar.baz.com"))) + ("html messages" + (vmpc-header-match "Content-type" + "multipart/alternative\\|html")) + ("plaintext messages from foo-list" + (and (vmpc-other-cond "foo-list messages") + (not (vmpc-other-cond "html messages")))) + ("html messages from foo-list" + (and (vmpc-other-cond "foo-list-messages") + (vmpc-other-cond "html messages"))) + ("html messages not from foo-list" + (and (vmpc-other-cond "html messages") + (not (vmpc-other-cond "foo-list messages")))) + + ;; any number of other conditions could go here + + ("unknown sender" + (vmpc-none-true-yet "condition that's always true")) +)) +@end lisp + +It's also possible to match against the text in the body of a message +you are replying to, forwarding or composing. If you wanted to check +whether the phrase "make money fast" appeared in a message, you'd have +a condition like this: + +@lisp +("message from an idiot" + (vmpc-body-match "make[\n ]+money[\n ]+fast")) +@end lisp + +Note how the regexp is constructed in order to take account of the +fact that the phrase may be split over more than one line. + +Both @code{vmpc-header-match} and @code{vmpc-body-match} are affected +by your default value of @code{case-fold-search}. If you wanted to +force a case-sensitive search in the previous example, you'd re-write +it like this: + +@lisp +("message from an idiot using all-caps" + (let ((case-fold-search nil)) + (vmpc-body-match "MAKE[\n ]+MONEY[\n ]+FAST"))) +@end lisp + +Similarly, if you wanted to force it to be case-insensitive, you'd do +this: + +@lisp +("message from an idiot using any case" + (let ((case-fold-search t)) + (vmpc-body-match "make[\n ]+money[\n ]+fast"))) +@end lisp + + +You can use @code{vmpc-header-match} to test if a regexp appears in any +header field matching another regexp. For example, to find out if the +regexp "fire\\|water" appears in any header, you would use something +like +@lisp +(vmpc-header-match "[^ \t\n:]+:" "fire\\|water" ", ") +@end lisp + +Essentially what this does is to take the contents of every header in +the message, put them all together in a gigantic string -- separated +from each other by a comma and a space -- and run +@lisp +(string-match "fire\\|water" gigantic-string-of-all-headers) +@end lisp + +In the event that you want to look for a regexp that includes ", " you +can use a different string as the separator to ensure that a match +doesn't span the contents of different headers. + +The above header field regexp checks every single header -- even the +X-VM-v5-Data header. You could use a more restrictive regular +expression for the header name if you prefer. For example, to check +only the From: and Apparently-To: headers, you could use +@lisp +(vmpc-header-match "From:\\|Apparently-To:" "fire\\|water" ", ") +@end lisp + + +What if you have an action that you only want to perform if the message +is from foo-list and doesn't have "bar" in the subject, or the message +is not from foo-list and does have "bar" in the subject, or if the +message has "quux" in the subject, regardless of whether it's from +foo-list or not? And what if, even then, you only want the action +performed if you answer yes to a prompt? Here's what the condition +would look like: + +@lisp +("a complex condition" + (and + (or (vmpc-xor (vmpc-other-cond "foo-list-messages") + (vmpc-header-match "bar")) + (vmpc-header-match "quux")) + (y-or-n-p "Perform action for complex condition? "))) +@end lisp + +It will only prompt you if the @code{or} part is true, because that's how the +@code{and} form works in elisp --- it stops evaluating its arguments after the +first false one it finds. + +Okay, I believe I've gone into much more depth here than the average +user will ever need; the point is that with a little lisp knowledge you +can have as fine a control over the automated actions of vm-pcrisis as you +need. Even without real lisp knowledge, I hope that you can figure out +enough from these examples to achieve such control. + +@c *************************************************************************** + +@node Actions, Rules, Conditions, Setting Up +@c node-name, next, previous, up +@section Actions + +@c @menu +@c * The vmpc-actions variable:: +@c * vmpc-actions examples:: +@c @end menu + +@c @node The vmpc-actions variable, vmpc-actions examples, vmpc-actions, vmpc-actions +@unnumberedsubsec The vmpc-actions variable +@anchor{vmpc-actions} + +The @code{vmpc-actions} variable is a list of actions, which can equally +be referred to as "profiles". You will set up some of them for replies, +some for @code{vmpc-automorph} (if you use it), and some for when you are +prompted for a profile (if you have an action that uses +@code{vmpc-prompt-for-profile}). Many will be equally applicable in all +three cases, which is why they are all kept in the same place. + +Each action is given a unique, descriptive name, and consists of one or +more function calls, so that the format of the list looks something like +this: + +@lisp +'( ("foo" + (function-1 arg1 arg2) + (function-2) + (function-3 arg1)) + ("bar" + (function-4)) ) +@end lisp + +This will start making sense with the real examples in the next section. +But first, we'll look at what functions are available here: + +@itemize @bullet + +@findex vmpc-signature +@item (vmpc-signature "signature-file") will replace the signature in +your message with the contents of the specified file, if it exists; +otherwise the string itself will be used as the signature. + +@findex vmpc-pre-signature +@item (vmpc-pre-signature "pre-signature-file") works in the same way, +but specifies a "pre-signature" --- text that is inserted in your message +above the signature. + +@findex vmpc-substitute-header +@item (vmpc-substitute-header "Header-Field" "new header contents") will +replace the contents of the specified header-field in your message with +the new contents, creating the header field if necessary. + +@findex vmpc-substitute-replied-header +@item (vmpc-substitute-replied-header "Dest-Header" "Src-Header") takes +the contents of the Src-Header field in the message you are replying to, +and inserts them as the contents of the Dest-Header field in your +reply, creating the Dest-Header field if necessary. (If it's contained +in an action which is called when you are not replying to a message, it +does nothing. The same is true of all of these functions: when they are +called in an inappropriate context, they only do as much as they can.) + +@findex vmpc-pre-function +@item (vmpc-pre-function (foo-function args)) evaluates the lisp +expression +@lisp +(foo-function args) +@end lisp +before VM creates a mail composition buffer. (This is useful for setting +VM variables which need to be set at this stage, such as the message +encoding.) It therefore does nothing in automorph mode. + +@findex vmpc-composition-buffer +@item (vmpc-composition-buffer (foo-function args)) does the +same, but in the composition buffer. + +@findex vmpc-prompt-for-profile +@item (vmpc-prompt-for-profile arg) prompts the user for a profile +(action) to run. (The user would be well advised not to choose one +which itself contains this function!) If ARG is present, it should be +set to 'prompt or t. The presence of ARG indicates that you want +it to check who your message is destined for, and remember to apply the +profile you choose now to messages sent to that person in the future, +instead of prompting you for a profile the next time. If set to +'prompt, it will ask whether it should remember; if set to t, it +will always remember. If ARG is not present, it does not remember. + +@end itemize + +Do not include your own functions in actions directly; call them with +@code{vmpc-pre-function} or @code{vmpc-composition-buffer} +instead -- otherwise they will be called twice, both before and after the +composition buffer is created. + +@c *************************************************************************** + +@c @node vmpc-actions examples, , The vmpc-actions variable, vmpc-actions +@c node-name, next, previous, up +@unnumberedsubsec vmpc-actions examples +@anchor{vmpc-actions examples} + + +In your ~/.vm you'll have something like this: + +@lisp +(setq vmpc-actions '( + ;; actions go here +)) +@end lisp + +Okay, here come some example actions which you can adapt and place, one +after the other, in the place of the comment above. + +Say you wanted two personality profiles from which you could choose when +prompted, and to automatically apply when certain conditions were met +with replies or in automorph mode. One thing to bear in mind is that +when you are prompted, there will be auto-completion available --- you'll +only need to type enough to uniquely identify a profile (you won't even +need to hit TAB). Also, the first profile in @code{vmpc-actions} will +be the default at the prompt, so you can just hit RET to use it. +Therefore, the first profile you place in @code{vmpc-actions} should be +the one you expect to use most often, and you should choose names for +profiles which uniquely distinguish themselves at the first or second +character. + +Okay, here are a couple of profiles which show how to insert signatures +and change the contents of a header field. + +@lisp +("foo on the hill" + (vmpc-substitute-header "From" + "\"The Foo On The Hill\" <foo@@hill.com>") + (vmpc-signature "~/.foo-sig")) +("david" + (vmpc-substitute-header "From" + "\"David Foo\" <foo@@hill.com>") + (vmpc-signature "")) +@end lisp + +When an empty string is given as the signature, as in the second +profile, vm-pcrisis will actually remove any signature that has been +placed there by other actions. + +Also note that by including a From: header, we override the values of +@code{user-full-name} and @code{user-mail-address}. + +We could equally well have chosen to override those values directly +using composition-buffer-functions, like this: + +@lisp +("foo on the hill" + (vmpc-composition-buffer + (setq user-full-name "The Foo On The Hill") + (setq user-mail-address "foo@@hill.com")) + (vmpc-signature "~/.foo-sig")) +("david" + (vmpc-composition-buffer + (setq user-full-name "David Foo")) + (setq user-mail-address "foo@@hill.com")) + (vmpc-signature "")) +@end lisp + +If we had two different mailboxes and wanted to direct replies back into +the right one, we would want to also set @code{mail-default-reply-to}, +or use @code{vmpc-substitute-header} to insert a Reply-To: header. + +----------------------------------------------------------------- + +@subheading Aside: +Why did we use @code{vmpc-composition-buffer} rather than +@code{vmpc-pre-function} to set those variables? Well, their values are +only examined when you actually send your message, so you could equally +well set them with either, but the @code{vmpc-automorph} function does +not run pre-functions, so if we want these profiles to work properly for +automorph, we need to use composition-buffer-functions. + +In other cases, such as setting VM's charset variables, you have no +option but to use pre-functions, because they have to be set to +appropriate values before the composition buffer is created. If anyone +finds a workaround for this, please let me know so I can include it +here. + +----------------------------------------------------------------- + +Pre-signatures can be specified in the same way as signatures: + +@lisp +("insert anti-html form letter" + (vmpc-pre-signature "~/stuff/formletters/why_html_is_bad.txt")) +@end lisp + +Alright, suppose that messages from foo-list have their Reply-To: header +set to point back to the list, with the address of the real sender in +the From: field. We could override it with +@code{vm-reply-ignored-reply-tos}, but usually we prefer this behaviour. +Only under certain conditions do we want to set our To: field to the +contents of the From: field in the replied message. The action to do +this would look like this: + +@lisp +("set To to From" + (vmpc-substitute-replied-header "To" "From")) +@end lisp + +Let's say we also want an action that can prompt us for a profile, so +we can associate it with an "unknown sender" condition. Here we go: + +@lisp +("prompt for a profile" + (vmpc-prompt-for-profile)) +@end lisp + +If we want vm-pcrisis to figure out who our message is destined for and to +remember to use the profile we choose the next time we send to that +address instead of prompting, we would do it like this: + +@lisp +("prompt for a profile, and remember it automatically" + (vmpc-prompt-for-profile t)) +@end lisp + +The associations between addresses and profiles will be stored in the +file named by @code{vmpc-auto-profiles-file} --- by default, this is +"~/.vmpc-auto-profiles". If your OS has a shonky filesystem that can +not deal with filenames like that, you might have to change this value. + +Keep in mind that the associations stored in this file are only used by +@code{vmpc-prompt-for-profile}. They do not have the effect of adding +new associations between addresses and profiles in the general operation +of vm-pcrisis; they are simply used by @code{vmpc-prompt-for-profile} +instead of prompting you in the future. + +IMPORTANT: When vm-pcrisis decides who your message is destined for, it +does so on the basis of the Reply-To: or From: field of the message +being replied (or in the case of automorph, the To: field of your +message). This takes account of @code{vm-reply-ignored-reply-tos}, but +DOES NOT take account of any other actions which might change the To: +address in your message. There is, therefore, a possibility that when +using this feature in both automorph and reply mode, an association made +in one mode may not be properly suited to the other. The best way to +avoid this problem is to set up your conditions so that the above action +is not run in conjunction with other actions that change the To: field. +This is not really limiting, because the situations in which you are +changing the To: field will generally be ones in which you know which +profile you want to use anyway. + +You can also set it up so that after prompting you for a profile, it +will tell you which address it has decided your message is going to, and +prompt you whether to save an association between that profile and that +address. Like this: + +@lisp +("prompt for a profile, and remember it if I say so" + (vmpc-prompt-for-profile 'prompt)) +@end lisp + +@c *************************************************************************** + +@node Rules, Automorph, Actions, Setting Up +@section Associating Conditions with Actions + +@c @menu +@c * vmpc-action-alist:: +@c * vmpc-reply-alist:: +@c * vmpc-automorph-alist:: +@c * vmpc-forward-alist:: +@c * vmpc-resend-alist:: +@c * vmpc-newmail-alist:: +@c @end menu + +@c *************************************************************************** + +@unnumberedsubsec vmpc-action-alist +@vindex vmpc-action-alist + +The @code{vmpc-action-alist} variable controls which actions are +performed if various conditions are met when creating a reply. Its +format is something like this: + +@lisp +'( ("condition 1" "action 1" "action 2") + ("condition 2" "action 3") + ... ) +@end lisp + +If you do not want to set all the other alists then sent this one as it +will be used as a fall back. + +@c *************************************************************************** + +@unnumberedsubsec vmpc-reply-alist +@vindex vmpc-reply-alist +@anchor{vmpc-reply-alist} + +The @code{vmpc-reply-alist} variable controls which actions are +performed if various conditions are met when creating a reply. Its +format is something like this: + +@lisp +'( ("condition 1" "action 1" "action 2") + ("condition 2" "action 3") + ... ) +@end lisp + +If we follow on from our examples in the previous sections, we might +have this in our ~/.vm file: + +@lisp +(setq vmpc-reply-alist '( + ("condition that's always true" "david") + ("plaintext messages from foo-list" "foo on the hill") + ("html messages from foo-list" "set To to From" + "insert anti-html form letter") + ("html messages not from foo-list" "insert anti-html form letter") + ("unknown sender" "prompt for a profile, and remember it if I say so") +)) +@end lisp + +@c *************************************************************************** + +@unnumberedsubsec vmpc-automorph-alist +@vindex vmpc-automorph-alist +@anchor{vmpc-automorph-alist} + +The @code{vmpc-automorph-alist} variable has the same syntax as +@code{vmpc-reply-alist} and follows the same principles. (See +@ref{vmpc-reply-alist}.) The only difference is that it controls +which actions are associated with which conditions when the +@code{vmpc-automorph} function is called. + +@c *************************************************************************** +@unnumberedsubsec vmpc-forward-alist +@vindex vmpc-forward-alist + +The @code{vmpc-forward-alist} variable has the same syntax as +@code{vmpc-reply-alist} and follows the same principles. (See +@ref{vmpc-reply-alist}.) The only difference is that it controls +which actions are associated with which conditions when forwarding +messages. + +@c *************************************************************************** +@unnumberedsubsec vmpc-resend-alist +@vindex vmpc-resend-alist + +The @code{vmpc-resend-alist} variable has the same syntax as +@code{vmpc-reply-alist} and follows the same principles. (See +@ref{vmpc-reply-alist}.) The only difference is that it controls +which actions are associated with which conditions when resending +messages with @code{vm-resend-message}. + + +@c *************************************************************************** + +@unnumberedsubsec vmpc-newmail-alist +@vindex vmpc-newmail-alist +@anchor{vmpc-newmail-alist} + +The @code{vmpc-newmail-alist} variable has the same syntax as +@code{vmpc-reply-alist} and follows the same principles. (See +@ref{vmpc-reply-alist}.) The only difference is that it controls +which actions are associated with which conditions when creating new +messages with vm-mail. + +One strategy for this is to have conditions based on the folder from +which you are sending mail. You might like to set things this up for +some folders, and have vm-pcrisis prompt you for an action in the other +folders. Here's how you might do that... + +In @code{vmpc-conditions}, you'd have a couple of conditions like this: + +@lisp +("mail to foo-list" + (string-match "^foo" (buffer-name (current-buffer)))) +("no cond" + (vmpc-none-true-yet)) +@end lisp + +Then in @code{vmpc-actions}, you'd set up an action for your mail to +foo-list, and another one to prompt you for a profile: + +@lisp +("foo profile" + (vmpc-substitute-header "From" + "\"The Foo King\" <david@@bar.com>") + (vmpc-signature "~/.foo-sig")) +("prompt" + (vmpc-prompt-for-profile)) +@end lisp + +Finally, you'd set up @code{vmpc-newmail-alist} like this: + +@lisp +(setq vmpc-newmail-alist + '( + ("mail to foo-list" "foo profile") + ("no cond" "prompt") + )) +@end lisp + +@c *************************************************************************** + +@node Automorph, , Rules, Setting Up +@section Calling Automorph + +The @code{vmpc-automorph} function automatically sets various things in +a mail message based on what's already present in its headers. +Obviously, you'll need to have entered those headers before it is +called. + +You'll have to set up what this function does --- for which, see +@ref{vmpc-conditions}, @ref{vmpc-actions} and +@ref{vmpc-automorph-alist} +--- but you'll also have to consider when you want it called. + +Most people would prefer never to have to call it explicitly; it's +generally nicer to just have it called automatically when you do one +of the other things that you have to do in the course of composing a +message. Here are a couple of ideas: + +@itemize @bullet +@item Hitching a ride on the mail-text function: automorph with C-c C-t.@* +A very good idea if you are in the habit of using this to move from +your headers to the body of your message. + +@item Let vm-pcrisis help you: tab between headers.@* +See below for more about this. + +@item Pre-empting vm-mail-send-and-exit: automorph with C-c C-c.@* +A rather foolish idea, in my opinion. You'll never get to see the +results of what automorph does. If there should happen to be a bug in +Personality Crisis that fails to take into account, say, multi-line +headers, you might end up sending a mail to your boss with an +inappropriate signature that, say, mentions his wife in an +unflattering way, and find yourself all-too-suddenly unemployed. How +likely is this? Well, in a previous version, such a bug existed. I +fixed it, but there could be more like it; I wouldn't risk it. + +@item Calling it explicitly with some key combo.@* +Boring but easy. +@end itemize + +The last of these is the easiest --- just bind it to a key in mail +mode. For example, to bind it to the F7 key, you might put this in +your ~/.vm file: + +@lisp +(define-key vm-mail-mode-map [f7] 'vmpc-automorph) +@end lisp + +Attaching to other functions is also fairly straightforward. Just use a +wrapper function. For example: + +@lisp +(defun mail-text-and-automorph () + (interactive) + (mail-text) + (vmpc-automorph)) +@end lisp + +Then bind this function to C-c C-t (or whatever keystroke you like to +use). + +But what's this thing about tabbing between headers? Well, if you just +want to hit TAB to go from the To: field to the Subject: field, and TAB +again to then go to the start of the message body, calling +@code{vmpc-automorph} along the way, you can add this in your ~/.vm +file: + +@lisp +(define-key vm-mail-mode-map [tab] 'vmpc-tab-header-or-tab-stop) +@end lisp + +If you also want shift-tab to take you back to the previous header, you +should check what keysym is produced by shift-tab on your system, by +doing @code{Ctrl-h k Shift-TAB} -- for me, it produces +@code{iso-left-tab}. So I add this to my ~/.vm: + +@lisp +(define-key vm-mail-mode-map [iso-left-tab] 'vmpc-backward-tab-header-or-tab-stop) +@end lisp + +You can use any one or more of these ideas, calling the automorph +function as often as you like. Because its actions depend on the +headers, and those actions can include the changing of headers, calling +it twice may not have the same effect as calling it once. It may pay to +bear this in mind when you set up the profiles! + +@c *************************************************************************** + +@node Miscellaneous Variables, Debugging, Setting Up, Top +@c node-name, next, previous, up +@chapter Miscellaneous Variables + +@c @menu +@c * vmpc-auto-profiles-file:: +@c * vmpc-auto-profiles-expunge-days:: +@c * vmpc-sig-face:: +@c * vmpc-pre-sig-face:: +@c * vmpc-intangible-sig:: +@c * vmpc-intangible-pre-sig:: +@c * vmpc-expect-default-signature:: +@c @end menu + +@c *************************************************************************** + +@unnumberedsec vmpc-auto-profiles-file +@vindex vmpc-auto-profiles-file + +The variable @code{vmpc-auto-profiles-file} contains the name of the +file used for saving profiles when @code{vmpc-prompt-for-profile} is +used with a non-nil argument (see @ref{vmpc-actions} and @ref{vmpc-actions +examples}). + +By default it is set to "~/.vmpc-auto-profiles". + +@c *************************************************************************** + +@unnumberedsubsec vmpc-auto-profiles-expunge-days +@vindex vmpc-auto-profiles-expunge-days + +In order to keep vmpc-auto-profiles-file from becoming massive, +Personality Crisis will check the age of profile associations in that +file each time it adds a new one. Associations that have not been used +in the last number of days given by +@code{vmpc-auto-profiles-expunge-days} will be removed. This variable +is set to 100 by default. + +@c *************************************************************************** + +@unnumberedsubsec vmpc-sig-face +@vindex vmpc-sig-face + +This is the face used to highlight the signature. You can use +@code{set-face-foreground}, @code{set-face-background} and +@code{set-face-font} to change the colours and font. + +@c *************************************************************************** + +@unnumberedsubsec vmpc-pre-sig-face +@vindex vmpc-pre-sig-face + +This is the face used to highlight the pre-signature. You can use +@code{set-face-foreground}, @code{set-face-background} and +@code{set-face-font} to change the colours and font. + +@c *************************************************************************** + +@unnumberedsubsec vmpc-intangible-sig +@vindex vmpc-intangible-sig +@anchor{vmpc-intangible-sig} + +If @code{vmpc-intangible-sig} is non-nil, movement and mouse commands +will cause your cursor to slide to one side or the other of the +signature, preventing you from actually writing text inside the area +that Personality Crisis calls the signature. + +This is somewhat useful because if automorph replaces the signature, you +probably won't want any text you added to be replaced along with it. To +activate this feature, just add the following to your ~/.vm file: + +@lisp +(setq vmpc-intangible-sig t) +@end lisp + +@c *************************************************************************** + +@unnumberedsubsec vmpc-intangible-pre-sig +@vindex vmpc-intangible-pre-sig + +The @code{vmpc-intangible-pre-sig} variable works just like +@code{vmpc-intangible-sig}, but affects the pre-signature. See +@ref{vmpc-intangible-sig}. + +@c *************************************************************************** + +@unnumberedsubsec vmpc-expect-default-signature +@vindex vmpc-expect-default-signature + +Traditionally, signatures are added to new mail messages using a +signature-insertion function bound to @code{mail-mode-hook} or similar, +so that every message you wrote started off containing a signature. If +you use the vm-pcrisis signature functions in addition to such a setup, +you should add the following to your ~/.vm file: + +(setq vmpc-expect-default-signature t) + +This will allow Personality Crisis to properly take account of your +setup, provided that your signature-insertion function uses the standard +@samp{\n-- \n} signature delimiter. + +@c *************************************************************************** + +@node Debugging, Version History, Miscellaneous Variables, Top +@c node-name, next, previous, up +@chapter Debugging + +With a complex setup it can be come hard to understand why vm-pcrisis +is doing a specific thing. In order to understand what is going on you +should check the value of the following variables: + +@itemize @bullet + +@item @code{vmpc-true-conditions} is the list of true conditions. + +@item @code{vmpc-actions-to-run} is the list of actions to run, +i.e. those actions mapped by a @code{vmpc-*-alist}. + +@item @code{vmpc-saved-headers-alist} the value of headers saved for +substitution. + +@end itemize + +If you want to check new contions you can run +@code{vmpc-build-true-conditions-list} interactively. + +If you want to check which true conditions are mapped to actions you can +run @code{vmpc-build-actions-to-run-list} interactively. True +conditions which are not mapped to an action are silently ignored. + +If you want to run new actions you can run @code{vmpc-read-actions} and +@code{vmpc-run-actions} interactively. + +@c *************************************************************************** + + +@node Version History, Variable Index , Debugging, Top +@c node-name, next, previous, up +@chapter Version History + +Version 0.11: + +@itemize @bullet + +@item Profiles can now be stored in the BBDB instead of the file +@code{vmpc-auto-profiles-file}. To enable this and migrate your old +profiles you should call @code{vmpc-migrate-profiles-to-BBDB} once. A +backup of your BBDB will be created first as +@file{~/.bbdb-vmpc-profile-migration-backup} and your old profiles-file +will be moved to @file{~/.vmpc-auto-profiles-migrated-to-BBDB}. + +@item Added @code{vmpc-add-header} which allows to create a header +multiple times. This is useful when having more than one FCC header. + +@item @code{vmpc-prompt-for-profile} finds now all profiles, i.e. before +it stopped at the first match, now it will check all email addresses. + +@end itemize + +Version 0.10: + +@itemize @bullet + +@item Added support for a list of actions in @code{vmpc-prompt-for-profile}. +Before it was only possible to specify a single action. + +@end itemize + +Version 0.9: + +@itemize @bullet + +@item The new maintainer is: Robert Widhopf-Fenk <hack@@robf.de> + +@item All variables of pcrisis can be customized now. + +@item Added new function @code{vmpc-toggle-no-automorph} to disable automorph +for the current buffer. + +@item @code{vmpc-prompt-for-profile} checks all relevant headers +now and will only prompt for a profile if no matches were found. It +also can be called interactively to correct a existing profile +association. + +@item Renamed @code{vmpc-composition-buffer-function} to @code{vmpc-composition-buffer}. + +@item @code{vmpc-pre-function} and @code{vmpc-composition-buffer} handle forms +now, not only a single function which must be quoted. + +@item Renamed @code{vmpc-replies-alist} to @code{vmpc-reply-alist} and +@code{vmpc-forwards-alist} to @code{vmpc-forward-alist} for consistency. + +@item New function @code{vmpc-true-conditions} to test conditions without actually +running some actions. + +@item New function @code{vmpc-read-actions} to set actions by hand. + +@item @code{vmpc-build-actions-to-run-list} and @code{vmpc-run-actions} are interactive +now. + +@item @code{vmpc-prompt-for-profile} will search all headers for a +recipient with an associated profile before prompting for one. + +@item When calling @code{vmpc-prompt-for-profile} interactively form a +composition buffer one will get prompted again for a profile. This +allows to easily fix a bad association. + +@item The state variables become buffer-local now, which should prevent some +bugs, i.e. for saved headers. + +@item Rewrite of unlispish code. + +@item @code{M-x checkdoc RET} + +@item Several bug fixes and enhancements from Robert P. Goldman. + +@item Fixes and updates of the info file. + +@end itemize + +Version 0.85: + +@itemize @bullet + +@item This version adds @code{vmpc-resend-alist}, which should be +especially useful for mailing list maintainers who receive bounced +non-member posts, and anyone else who frequently uses +@code{vm-resend-message}. + +@end itemize + +Version 0.84: + +@itemize @bullet + +@item There is now a @code{vmpc-newmail-alist} in recognition of the fact that +you @strong{can} actually test for useful criteria (such as what folder +you are in when you invoke vm-mail) when creating a brand new message. + +@item Due to the above, the @code{vmpc-newmail-prompt-for-profile} +variable is now obsoleted. Its effect can be duplicated easily enough; +see @ref{vmpc-newmail-alist} for details. + +@end itemize + +Older versions: + +@itemize @bullet + +@item Pre-signatures and signatures are now dealt with in a more +sensible manner. You might not notice the difference, except that you +can now have them highlighted in @code{vmpc-pre-sig-face} and +@code{vmpc-sig-face}, and you can set up either so that your cursor +skips across them with @code{vmpc-intangible-pre-sig} and +@code{vmpc-intangible-sig}. However, if you use another signature +package to insert a signature in every mail buffer, you should look at +setting @code{vmpc-expect-default-signature}. + +@item You can now use vm-pcrisis in conjunction with the forwarding +functions of VM. Just set up @code{vmpc-forwards-alist}, which has an +identical format to @code{vmpc-replies-alist}. + +@item There is now a @code{vmpc-body-match} function which matches +text in the body of a message you are composing, replying to or +forwarding. See @ref{vmpc-conditions examples} for more about that. + +@item You can now use @code{vmpc-header-match} to test if a regexp appears in +any header field matching another regexp. For example, to find out if +the regexp "fire\\|water" appears in any header, you would use +something like +@lisp +(vmpc-header-match "[^ \t\n:]+:" "fire\\|water" ", ") +@end lisp +For further details, again see @ref{vmpc-conditions examples}. + +@item @code{vmpc-auto-profiles-expunge-days} can now be set to nil if +you want to never expunge old profile associations. Associations are +now "touched" each time they are used, so that as long as they are used +more often than @code{vmpc-auto-profiles-expunge-days} they will never +be expunged. + +@end itemize + +@node Variable Index, Function Index, Version History, Top +@unnumbered Variable Index +@printindex vr + +@node Function Index, , Variable Index, Top +@unnumbered Function Index +@printindex fn + + + +@bye diff --git a/info/vm.texinfo b/info/vm.texinfo new file mode 100755 index 0000000..5a03949 --- /dev/null +++ b/info/vm.texinfo @@ -0,0 +1,8467 @@ +\input texinfo +@setfilename vm.info +@settitle VM User's Manual +@dircategory Emacs +@direntry +* VM: (vm). A mail reader. +@end direntry +@defindex in + +@iftex +@finalout +@end iftex +@c @setchapternewpage odd % For book style double sided manual. +@c @smallbook +@tex +\overfullrule=0pt +%\global\baselineskip 30pt % For printing in double spaces +@end tex +@ifinfo +This file documents the VM mail reader. +@table @asis +@item Copyright (C) 1989, 1991, 1999 Kyle E. Jones +@item Copyright (C) 2003 - 2008 Robert Widhopf-Fenk +@item Copyright (C) 2008 - 2012 Uday S. Reddy +@end table + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@ignore +Permission is granted to process this file through TeX and print the +results, provided the printed document carries copying permission +notice identical to this one except for the removal of this paragraph +(this paragraph not being relevant to the printed manual). + +@end ignore +@end ifinfo +@c +@include version.texinfo +@titlepage +@sp 6 +@center @titlefont{VM User's Manual} +@sp 4 +@center VM Version @value{VERSION} +@sp 5 +@page +@vskip 0pt plus 1filll +Copyright @copyright{} 1989, 1991, 1999, 2002, 2003 Kyle E. Jones +Copyright @copyright{} 2003 - 2008 Robert Widhopf-Fenk +Copyright @copyright{} 2008 - 2009 Uday S. Reddy + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@end titlepage +@page +@ifnottex +@node Top, Preface,, (DIR) + +This manual documents the VM mail reader, a Lisp program which runs as a +subsystem under Emacs. The manual is divided into the following +chapters. + +This manual corresponds to VM version @value{VERSION}. + +@menu +* Preface:: What is VM? +* Introduction:: Overview of the VM interface. +* Starting Up:: What happens when you start VM. +* Selecting Messages:: How to select messages for reading. +* Reading Messages:: Previewing and paging through a message. +* Sending Messages:: How to send messages from within VM. +* Saving Messages:: How to save messages. +* Deleting Messages:: How to delete, undelete and expunge messages. +* Editing Messages:: How to alter the text and headers of a message. +* Marking Messages:: Running VM commands on arbitrary sets of messages. +* Message Attributes:: How to change and undo changes to message attributes. +* Sorting Messages:: How to make VM present similar messages together. +* Digests:: How to read digests under VM. +* Summaries:: How to view and customize the summary of a folder. +* Virtual Folders:: Blurring the boundaries of different physical folders. +* @acronym{IMAP} Server Folders:: Working with IMAP server folders. +* Frames and Windows:: How to customize VM's use of windows and frames. +* Toolbar:: How to configure VM's toolbar. +* Menus:: How to configure VM's menus. +* Faces:: How to configure VM's use of faces. +* Using the Mouse:: Understanding the VM mouse interface. +* Hooks:: How you can make VM run your code at certain times. + +Add-ons and Customizations: + +* Preface to Add-ons:: What are these? +* Customizations:: Making VM behave the way you might want. +* Add-ons:: Contributed packages adding functionality to VM. + +About VM: + +* History and Administration:: Information about VM +* Highlights:: Most valuable features of VM, as per the users. +* Future Plans:: Planned extensions of VM for the future +* Bugs:: How to report VM bugs + +For developers: + +* Internals:: Information on VM internals for developers + +Indices: + +* Concept Index:: Menus of key concepts +* Key Index:: Menus of command keys and their references. +* Command Index:: Menus of commands and their references. +* Variable Index:: Menus of variables and their references. +* Internals Index:: Menus of concepts in VM Internals + +Rights: +* License:: Copying and distribution terms for VM. + + +@end menu +@end ifnottex + +@node Preface, Introduction, Top, Top +@unnumbered What is VM? + +@cindex Rmail +@cindex Gnus +@cindex Gnu Emacs +@cindex XEmacs +@cindex Emacs +VM, short for ``View Mail,'' is a mail reader that runs within the +Emacs editor. If you are already an Emacs-user, you will be working +in a familiar environment. You might have even used other Emacs-based +mail readers such as Rmail and Gnus. If you are new to Emacs, you can +start using VM via the menubar and toolbar until you become familiar +with it. Then you can move on to keyboard shortcuts and advanced +features. You should be aware that there are two major strands of +Emacs versions, called ``Gnu Emacs'' and ``XEmacs.'' VM works in both +of them. XEmacs might be a bit easier for new users due to its +advanced support for menus and other interactive features. Please be +sure to try both of them before deciding on your choice. + +Emacs provides a powerful text-based user interface for VM users, with +facilities for quick navigation, incremental searching , sophisticated +customization and powerful add-on functions. You also have all the +editing features of Emacs available for composing mail, without having +to switch environments. + +@cindex virtual folders +@cindex archiving +@cindex address book +@cindex @acronym{MIME} +@cindex encryption +@cindex @acronym{BBDB} +@cindex Org mode +@cindex @acronym{GPG} +VM was developed by Kyle Jones starting in 1989. It was a leader +in mail-reading functionality by introducing features like thread +management, virtual folders, automatic archiving of messages and a +full treatment of @acronym{MIME}. VM can interface to other packages +available in Emacs, for remote file access, @acronym{BBDB} address book, +@acronym{GPG} +encryption and Org mode task management etc. It can also invoke +external utilities available on your system such as mail filtering +tools and html rendering tools. + +@cindex @acronym{POP} +@cindex @acronym{IMAP} +@cindex mail servers +@cindex mbox +@cindex Thunderbird +VM can read and store mail on your file system (both local and +remote). It can also handle mail stored in remote file servers +running @acronym{POP} and @acronym{IMAP} protocols. The local folders are stored in a +Unix-standard @code{mbox} format, which is also used by most other +mail readers including Thunderbird. In fact, VM can seamlessly +operate on Thunderbird folders and, if you use a remote mail server, +you can view the same folders in VM and Thunderbird concurrently. In +addition, VM can also store mail in the @code{Babyl} format used by +Emacs Rmail. So, it is also possible to inter-operate with Rmail if +you have archived mail in that format. + +@cindex maildir +@cindex newsgroups +@cindex @acronym{RSS} feeds +@cindex @acronym{S/MIME} +There are also a few things that VM cannot (yet) do. It does not have the +ability to deal with maildir folders. It cannot be used to read newsgroups +and @acronym{RSS} feeds. It does not have its own mail filtering tools. It +does not have support for the Secure @acronym{MIME} (@acronym{S/MIME}) +protocol. However, active development of VM is continuing. It may acquire +some of these features before long. + +VM has been found most useful by professional users who must deal with +large quantities of email in the course of their work, and deal with +it efficiently and reliably. We enjoy using VM and find that it is +better than any other mail tool in its flexibility and efficiency. We +hope you will too! + +-- VM Development Team + + +@node Introduction, Starting Up, Preface, Top +@unnumbered Overview + +VM (View Mail) is an Emacs subsystem that allows UNIX mail to be read +and disposed of within Emacs. Commands exist to do the normal things +expected of a mail user agent, such as generating replies, saving +messages to folders, deleting messages and so on. There are other more +advanced commands that do tasks like bursting and creating digests, +message forwarding, and organizing message presentation according to +various criteria. + +You can make VM your default mail user agent by setting @code{mail-user-agent} +to @code{vm-user-agent}, e.g. by @kbd{M-x} @code{customize-variable} @key{RET} +@code{mail-user-agent} @key{RET}. + +To invoke VM, type @kbd{M-x vm}. VM gathers any mail that has +arrived in your system mailbox and appends it to a mail folder known as your +@dfn{primary inbox}, and visits that folder for reading. @xref{Starting Up}. +Depending on how you have configured VM, the primary inbox might be a +file on your file system (in a format understood by VM) or it could be +a folder on a remote mail server. + +If you type @kbd{?} in a VM folder buffer you will get some help, i.e. +@code{vm-help} is called. + +@findex vm-scroll-forward +@findex vm-scroll-backward +@kindex SPC +@kindex DEL +If there are any messages in the primary inbox, VM selects the first new +or unread message, and previews it. @dfn{Previewing} is VM's way of +showing you part of a message and allowing you to decide whether you want +to read it. @xref{Previewing}. By default VM shows you the message's +sender, recipient, subject and date headers. Typing @key{SPC} +(@code{vm-scroll-forward}) exposes the body of the message and flags the +message as read. Subsequent @key{SPC}'s scroll forward through the +message, @key{DEL} scrolls backward. When you reach the end +of a message, typing @key{SPC} or @kbd{n} moves you forward to preview +the next message. @xref{Paging}. + +If you do not want to read a message that's being previewed, type +@kbd{n} and VM will move to the next message (if there is one). +@xref{Selecting Messages}. + +To save a message to a mail folder use @kbd{s} (@code{vm-save-message}). +VM will prompt you for the folder name in the minibuffer. +@xref{Saving Messages}. + +Messages are deleted by typing @kbd{d} (@code{vm-delete-message}) while +previewing or reading them. The message is not removed right away; VM +makes a note that you want the message to be removed later. If you +change your mind about deleting a message, select it and type @kbd{u} +(@code{vm-undelete-message}), and the message will be undeleted. +@xref{Deleting Messages}. The actual removal of deleted messages from +the current folder is called @dfn{expunging} and it is accomplished by +typing @kbd{###} (@code{vm-expunge-folder}). The message is still present +in the on-disk version of the folder until the folder is saved. + +Typing @kbd{h} (@code{vm-summarize}) causes VM to display a window +containing a summary of the contents of the current folder. The summary is +presented one line per message, by message number, listing each message's +author, date sent, line and byte count, and subject. Also, various +letters appear beside the message number to indicate that a message is +new, unread, flagged for deletion, etc. An arrow @samp{->} appears to +the left of the line summarizing the current message. The summary +format is user configurable, @pxref{Summaries}. + +@findex vm-save-folder +@kindex S +When you are finished reading mail the current folder must be saved, so +that the next time the folder is visited VM will know which messages +have been already read, replied to and so on. Typing @kbd{S} +(@code{vm-save-folder}) saves the folder. The default behavior is +that deleted messages are @emph{not} expunged automatically when you +save a folder. +The next time you visit the folder any deleted +messages will still be flagged for deletion. @pxref{Deleting Messages}. + +@vindex vm-folder-file-precious-flag +When a folder is first visited, the value of the variable +@code{vm-folder-file-precious-flag} is used to initialize a +buffer-local instance of @code{file-precious-flag}, which +determines how folders are saved. A non-nil value causes +folders to be saved by writing to a temporary file and then +replacing the folder with that file. A nil value causes +folders to be saved by writing directly to the folder without +the use of a temporary file. + +@vindex vm-delete-empty-folders +If the folder is empty at the time you save it and the variable +@code{vm-delete-empty-folders} is non-@code{nil}, VM will remove +the zero length folder after saving it. + +@findex vm-quit +@findex vm-quit-no-change +@kindex q +@kindex x +To quit visiting a folder you can type @kbd{q} (@code{vm-quit}) or +@kbd{x} (@code{vm-quit-no-change}). Typing @kbd{q} saves the current +folder before quitting. Also, any messages flagged new are changed to +be flagged as old and unread, before saving. The @kbd{x} command quits +a folder without changing the status of new messages, saving or +otherwise modifying the current folder. + +@vindex vm-confirm-quit +If the variable @code{vm-confirm-quit} is set to @code{t} +VM will always ask for confirmation before ending a VM +visit of a folder. A @code{nil} value means VM will ask only +when messages will be lost unwittingly by quitting, i.e. not +removed by intentional delete and expunge. A value that is +neither @code{nil} nor @code{t} causes VM to ask only when +there are unsaved changes to message attributes or when messages +will be lost. + +@findex vm-quit-just-bury +@findex vm-switch-to-folder +You do not have to quit a folder to continue using Emacs for other +purposes. @code{M-x vm-quit-just-bury} buries the buffers associated with +the current folder deep in Emacs' stack of buffers, but otherwise leaves +the folder visited so that you can resume reading messages quickly. +You can return to the folder using @code{M-x vm-switch-to-folder}. +Or, you can locate the folder's buffers again by using @code{list-buffers}, +which is normally bound to @kbd{C-x C-b}. + +@findex vm-quit-just-iconify +Another command you can use if you are using a window system like X +Windows is @code{vm-quit-just-iconify}. This command buries the +folder's buffers like @code{vm-quit-just-bury} and also iconifies the +current frame. + +@findex vm-get-new-mail +@kindex g +At any time while reading mail in any folder you can type @kbd{g} +(@code{vm-get-new-mail}) to check to see if new mail for that folder has +arrived. If new mail has arrived it will be moved from the spool files +or maildrops associated with the current folder and merged into the +folder. If you are not in the middle of another message, VM will also +move to the first new or unread message. + +If @code{vm-get-new-mail} is given a prefix argument, it will prompt for +another file from which to gather messages instead of the usual spool +files. In this case the source folder is copied but no messages are +deleted from it as they would be for a spool file. + +By default your primary inbox has your system mailbox associated with +it, e.g. @file{/var/spool/mail/kyle}, and so typing @kbd{g} will retrieve +mail from this file. Your system mailbox is one example of a @dfn{spool +file}, a file that the mail transport system delivers messages into. +You can associate other spool files with your primary inbox and spool +files with other folders by setting the variable +@code{vm-spool-files}. @xref{Spool Files}. + +@node Starting Up, Selecting Messages, Introduction, Top +@chapter Starting Up + +@findex vm-load-init-file +@vindex vm-init-file +@cindex .vm +The first time VM is started in an Emacs session, it attempts to load +the file specified by the variable @code{vm-init-file}, normally +@file{~/.vm}. If present this file should contain Lisp code, much +like the @file{.emacs} file. It should contain the ``configuration +settings'' for VM, i.e., variables that define where the mail folders +are stored, where the incoming mail is to be found, the various +directories that VM needs to use for its operation and the external +applications that VM can invoke. You can reload this file by typing +@code{M-x vm-load-init-file} from within VM. + +@vindex vm-preferences-file +@cindex .vm.preferences +In addition, VM also attempts to load a file specified by the variable +@code{vm-preferences-file}, normally @file{~/.vm.preferences}. This +file should contain your preferential settings for various VM +variables affecting how VM works. Since VM has well over one +hundred configuration variables, use of the @file{~/.vm.preferences} +can considerably reduce clutter in the @file{.vm} file. + +Invoking @code{vm-load-init-file} with a prefix argument (e.g., +@kbd{C-u}) causes the @code{vm-init-file} to be loaded without the +@code{vm-preferences-file}. VM will work with all its default +settings for the variables. This is similar to invoking emacs via +@code{emacs -Q}. If you ever find a problem with VM's behavior, it is +a good idea to run it without the @code{vm-preferences-file} in order +to check if the problem might have been caused by the preferences +settings. + +@findex vm +@vindex vm-primary-inbox +@vindex vm-auto-get-new-mail +@cindex primary inbox +@kbd{M-x vm} causes VM to visit a folder known as your @dfn{primary +inbox}, specified by the variable @code{vm-primary-inbox}. If the +variable @code{vm-auto-get-new-mail} is set +non-@code{nil}, VM will gather any new mail that has arrived +and integrate it into your primary inbox. The default setting for your +primary inbox is the local file @file{~/Mail/inbox}, but a variety of +other options are available. + +VM can work with mail folders saved on the local file system. +@xref{Local Folders}. It can also work with mail folders stored on +remote mail servers, such as @acronym{POP} and @acronym{IMAP} servers. @xref{@acronym{POP} and @acronym{IMAP} +Folders}. Server folders have the advantage that they can be accessed +from multiple locations on the internet. VM might appear to have a +bias towards local folders due to its history of development. But it +treats server folders with equal facility. + +@findex vm-visit-folder +@findex vm-visit-pop-folder +@findex vm-visit-imap-folder +@kindex v +@kbd{M-x vm-visit-folder} (@kbd{v} from within VM) allows you to visit +any local mail folder. The folder name will be +prompted for in the minibuffer. @kbd{M-x vm-visit-pop-folder} and +@kbd{M-x vm-visit-imap-folder} perform similar function for server +folders. + +Once VM has read the folder and assimilated any new mail, the first new or +unread message will be selected, if any. If there is no such message, +VM will select whatever the selected message was when this folder was last +saved. If this folder has never been visited and saved by VM, then the +first message in the folder is selected. + +@findex vm-mode +@kbd{M-x vm-mode} can be used on a buffer already loaded into Emacs +to put it into the VM major mode so that VM commands can be executed +on it. This command is suitable for use in Lisp programs, and for +inclusion in @code{auto-mode-alist} to automatically start VM on a +file based on a particular filename suffix. @code{vm-mode} skips +some of VM's start-up procedures (e.g. starting up a summary) to make +non-interactive use easier. + +@vindex vm-startup-with-summary +The variable @code{vm-startup-with-summary} controls whether VM +automatically displays a summary of the folder's contents at startup. A +value of @code{nil} gives no summary; a value of @code{t} always gives a +summary. A value that is a positive integer @var{n} means that VM +should generate a summary if there are @var{n} or more messages in +the folder. A negative value @var{-n} means generate a summary only if +there are @var{n} or fewer messages. The default value of +@code{vm-startup-with-summary} is @code{t}. + +@menu +* Local Folders:: Working with folders on the local file system +* @acronym{POP} and @acronym{IMAP} Folders:: Working with folders on mail servers +* Thunderbird Folders:: Working with folders managed by Thunderbird +* External Messages:: Working with messages stored externally. +* Getting New Mail:: Retrieving mail from spool files. +* Crash Recovery:: Recovering changes after Emacs or your system dies. +@end menu + +@node Local Folders, @acronym{POP} and @acronym{IMAP} Folders, Starting Up, Starting Up +@section Local Folders + +@cindex mbox +@cindex Babyl +@cindex Rmail +@vindex vm-default-folder-type +A local mail folder is simply a file that can be stored on the local +file system. VM works with the Unix @dfn{mbox} format to store +messages in folders. It can also work with the @dfn{Babyl} format +used by the Emacs Rmail package. The subtypes of mboxes handled by VM +are listed under @b{Folder types} below. + +@vindex vm-folder-directory +It is a good idea to create directory, e.g., @code{~/Mail}, where all +of VM's local folders will be kept. If you create such a directory, +you should set the variable @code{vm-folder-directory} to point to it. + +@cindex spool file +@vindex vm-spool-files +@cindex file locking +A @dfn{spool file} is a file where the mail transport system delivers +messages intended for you. On Unix systems, a program called +@file{/bin/mail} or @file{/bin/mail.local} does this delivery. +It is also possible for agents such as @file{procmail}, @file{filter} and +@file{slocal} to be invoked from a user's @file{~/.forward} or +@file{~/.qmail} files, sorting the incoming mail into separate spool +files. On other systems, incoming mail may be +delivered to mailboxes on remote mail servers, from where it can be +retrieved through protocols like @acronym{POP} and @acronym{IMAP}. No matter what the +delivery agent, what all spool files have in common is that mail is +delivered into them by one or more entities apart from VM and that all +access to spool files must therefore be accompanied by the use of some +file locking protocol. + +@vindex vm-movemail-program +@vindex vm-movemail-program-switches +When spool files are on the local file system, VM uses the program +@file{movemail}, a program distributed with Emacs to extract mail from +a spool file. The variable @code{vm-movemail-program} specifies the +name of the movemail program and defaults to @samp{"movemail"}. The +variable @code{vm-movemail-program-switches} lets you specify some +initial command line argument to pass to the movemail program. + +@cindex crash box +@vindex vm-crash-box +VM transfers the mail from a spool file to a folder via a +temporary file known as the @dfn{crash box}. The variable +@code{vm-crash-box} names the crash box file for the primary inbox. +Or a crash-box name may be created from @code{vm-crash-box-suffix} +described below. +(@pxref{Spool Files}.) +VM first copies the mail to the crash box, truncates the spool file +to zero messages, merges the crash box contents into the +primary inbox, and then deletes the crash box. If the system or Emacs +should crash in the midst of this activity, any message not present in +the primary inbox will be either in the spool file or the crash +box. Some messages may be duplicated but no mail will be lost. + +If the file named by @code{vm-crash-box} already exists when VM is +started up, VM will merge that file with the primary inbox before +retrieving any new messages from the system mailbox. + +@menu +* Spool Files:: Specifying where mail comes from +* @acronym{POP} Spool Files:: How to use a @acronym{POP} mailbox as a spool file +* @acronym{IMAP} Spool Files:: How to use an @acronym{IMAP} mailbox as a spool file +* Index Files:: Using an index to speed up VM starting +* Folder types:: About the mail folder formats handled by VM +@end menu + +@node Spool Files, @acronym{POP} Spool Files, Local Folders, Local Folders +@unnumberedsubsec Spool Files + +Every folder, including the primary inbox, can have one or more spool +files associated with it. You make these associations known to VM by +setting the variable @code{vm-spool-files}. + +If you only want to associate spool files with your primary inbox, you +can set @code{vm-spool-files} to a list of strings. By default, the location +of your system mailbox (the spool file that is associated with your +primary inbox) is determined heuristically based on what type of system +you're using. VM can be told explicitly where the system mailbox is by +setting @code{vm-spool-files} like this: + +@example +(setq vm-spool-files '("/var/spool/mail/kyle" "~/Mailbox")) +@end example + +@noindent With this setting, VM will retrieve mail for the primary +inbox from first @file{/var/spool/mail/kyle} and then @file{~/Mailbox}. + +If the value of @code{vm-spool-files} is @code{nil}, a default value for +@code{vm-spool-files} will be inherited from the shell environmental +variables MAILPATH or MAIL if either of these variables are defined. +This inheritance happens before your init file is loaded, so setting +@code{vm-spool-files} in your init file will override any environmental +variables. + +If you want to associate spool files with folders other than or in +addition to the primary inbox, the value of @code{vm-spool-files} must be a +list of lists. Each sublist specifies three entities, a folder, a spool +file and a crash box. When retrieving mail for a particular folder, VM +will scan @code{vm-spool-files} for folder names that match the current +folder's name. The spool file and crash box found in any matching +entries will be used to gather mail for that folder. + +For example, you can set @code{vm-spool-files} like this + +@example +@group +(setq vm-spool-files + '( + ("~/INBOX" "/var/spool/mail/kyle" "~/INBOX.CRASH") + ("~/INBOX" "~/Mailbox" "~/INBOX.CRASH") + ("~/Mail/bugs" "/var/spool/mail/answerman" "~/Mail/bugs.crash") + ) +) +@end group +@end example + +@noindent The folder @file{~/INBOX} has two spool files associated +with it in this +example, @file{/var/spool/mail/kyle} and @file{~/Mailbox}. Another +folder, @file{"~/Mail/bugs"} has one spool file +@file{/var/spool/mail/answerman} associated with it. Note that both of +the @file{~/INBOX} entries used the same crash box. The crash box can be +the same if the folder name is the same. Different folders should use +different crashboxes. + +@vindex vm-crash-box-suffix +@vindex vm-spool-file-suffixes +An alternate way of specifying folder/spool file associations +is to use the variables @code{vm-spool-file-suffixes} and +@code{vm-crash-box-suffix}. + +The value of @code{vm-spool-file-suffixes} should be a list of string suffixes +to be used to create possible spool file names for folders. Example: + +@example +@group +(setq vm-spool-file-suffixes '(".spool" "-")) +@end group +@end example + +@noindent With @code{vm-spool-file-suffixes} set this way, if you +visit a +folder @file{~/mail/beekeeping}, when VM attempts to retrieve new mail for +that folder it will look for mail in @file{~/mail/beekeeping.spool} +and @file{~/mail/beekeeping-} in addition to scanning @code{vm-spool-files} +for matches. The value of @code{vm-spool-files-suffixes} will not be used +unless @code{vm-crash-box-suffix} is also defined, since a crash box is +required for all mail retrieval from spool files. + +The value of @code{vm-crash-box-suffix} should be a string suffix used to +create possible crash box file names for folders. When VM uses +@code{vm-spool-file-suffixes} to create a spool file name, it will append +the value of @code{vm-crash-box-suffix} to the folder's file name to +create a crash box name. If the value of @code{vm-spool-files-suffixes} +is @code{nil}, then the value of @code{vm-crash-box-suffix} is not used +by VM. + +@vindex vm-make-crash-box-name +@vindex vm-make-spool-file-name +The idea behind @code{vm-spool-file-suffixes} and +@code{vm-crash-box-suffix} is to give you a way to have many +folders with individual spool files associated with them, without +having to list them all in @code{vm-spool-files}. If you need +even more control of spool file and crash box names, use +@code{vm-make-spool-file-name} and @code{vm-make-crash-box-name}. +The value of both of these should be a function or the name of a +function. When VM visits a folder, it will call the function +with the name of the folder as an argument, and the function +should return the spool file name or crash box name to be used +for that folder. + +If your spool file is on another host, VM supports accessing +spool files on remote hosts using the @acronym{POP} and @acronym{IMAP} protocols. + +@node @acronym{POP} Spool Files,@acronym{IMAP} Spool Files,Spool Files,Local Folders +@unnumberedsubsec @acronym{POP} Spool Files + +@cindex @acronym{POP} spool files +VM can access spool files on mail servers via the @dfn{Post Office Protocol} +(@dfn{@acronym{POP}}). To use a @acronym{POP} mailbox as a spool file, you need to use a @acronym{POP} +maildrop specification (@ref{maildrop specification}, +@ref{@acronym{POP} and @acronym{IMAP} Folders}). Once this is done, VM will retrieve new mail +from the @acronym{POP} mailbox in the same way as it retrieves it from system +mailbox. The retrieved messages can be automatically removed from the +@acronym{POP} mailbox or retained until a later expunge operation. + +@vindex vm-pop-max-message-size +@findex vm-get-new-mail +@vindex vm-auto-get-new-mail +By default VM will retrieve all the messages from a @acronym{POP} mailbox +before returning control of Emacs to you. If the mailbox is +large, the wait could be considerable. If you set +@code{vm-pop-max-message-size} to a positive numeric value, VM will not +automatically retrieve messages larger than this size. If VM is +retrieving messages because you invoked @code{vm-get-new-mail} +interactively, then VM will ask whether it should retrieve the +large message. If VM is retrieving messages automatically +(e.g. @code{vm-auto-get-new-mail} is set non-@code{nil}) then VM will skip the +large message and you can retrieve it later. + +@vindex vm-pop-bytes-per-session +@vindex vm-pop-messages-per-session +The variable @code{vm-pop-messages-per-session} controls how many messages +VM will retrieve from a @acronym{POP} mailbox before returning control to +you. Similarly, the variable @code{vm-pop-bytes-per-session} limits the +number of bytes VM will retrieve from a @acronym{POP} mailbox before returning +control to you. By default, the value of both variables is nil, which +tells VM to retrieve all the messages in the @acronym{POP} mailbox regardless +of how many messages there are and how large the mailbox is. + +@findex vm-expunge-pop-messages +After VM retrieves messages from the mailbox, the default action is to +leave the original messages on the server unchanged. They can be +expunged from the server by running @code{vm-expunge-pop-messages}; +only those messages that VM has retrieved into the current folder will +be expunged. + +@vindex vm-pop-expunge-after-retrieving +@vindex vm-pop-auto-expunge-alist +If you want VM to expunge the messages automatically after retrieving +them, you can set @code{vm-pop-expunge-after-retrieving} to @code{t}. +But a better method is to set the variable +@code{vm-pop-auto-expunge-alist}, which gives you a way to specify, on +a per-mailbox basis, which @acronym{POP} mailboxes should have messages automatically +removed after retrieving and which ones should leave the messages on the @acronym{POP} +server. The value of @code{vm-pop-auto-expunge-alist} should be a +list of @acronym{POP} mailboxes and values specifying whether messages should +be automatically deleted from the mailbox after retrieval. The format +of the list is: + +@example +((@var{MAILDROP} . @var{VAL}) (@var{MAILDROP} . @var{VAL}) ...) +@end example + +@var{MAILDROP} should be a @acronym{POP} mailbox specification as described +in the documentation for the variable @code{vm-spool-files}. If +you have the @acronym{POP} password specified in the @code{vm-spool-files} +entry, you do not have to specify it here as well. Use @samp{*} +instead; VM will still understand that this mailbox is the same as +the one in @code{vm-spool-files} that contains the password. + +@var{VAL} should be @code{nil} if retrieved messages should be left in the +corresponding @acronym{POP} mailbox, @code{t} if retrieved messages should be +removed from the mailbox immediately after retrieval. + +Here is an example: + +@example +(setq vm-pop-auto-expunge-alist + '( + ("odin.croc.net:110:pass:kyle:*" . nil) ;; leave message on the server + ("hilo.harkie.org:110:pass:kyle:*" . t) ;; expunge immediately + ) +) +@end example + +@node @acronym{IMAP} Spool Files, Index Files, @acronym{POP} Spool Files, Local Folders +@unnumberedsubsec @acronym{IMAP} Spool Files +@cindex @acronym{IMAP} spool files +@cindex maildrop specification +VM can also use @dfn{@acronym{IMAP}} (@dfn{Internet Message Access Protocol}) to +retrieve mail from a mail server. +As with @acronym{POP}, instead of specifying a local file name in the +@code{vm-spool-files} definition, you would give an @acronym{IMAP} maildrop +specification (@ref{maildrop specification}, @ref{@acronym{POP} and @acronym{IMAP} Folders}). +Once this is done, VM will retrieve new mail from the @acronym{IMAP} mailbox in +the same way as it retrieves it from system mailbox. The retrieved +messages can be automatically removed from the @acronym{IMAP} mailbox or +retained until a later expunge operation. + +@vindex vm-imap-bytes-per-session +@vindex vm-imap-messages-per-session +The variable @code{vm-imap-messages-per-session} controls how many messages +VM will retrieve from an @acronym{IMAP} mailbox before returning control to +you. Similarly, the variable @code{vm-imap-bytes-per-session} limits the +number of bytes VM will retrieve from an @acronym{IMAP} mailbox before returning +control to you. By default, the value of both variables is nil, which +tells VM to retrieve all the messages in the @acronym{IMAP} mailbox regardless +of how many messages there are and how large the mailbox is. + +@cindex expunging, @acronym{IMAP} messages +@findex vm-expunge-imap-messages +After VM retrieves messages from the mailbox, the default action is to +leave the original messages on the server unchanged. They can be +@dfn{expunged} from the server by running @code{vm-expunge-imap-messages}; +only those messages that VM has retrieved into the current folder will +be expunged. + +@vindex vm-imap-expunge-after-retrieving +@vindex vm-imap-auto-expunge-alist +If you want VM to expunge the messages automatically after retrieving them, +you can set @code{vm-imap-expunge-after-retrieving} to @code{t}. But a +better method is to set the variable @code{vm-imap-auto-expunge-alist}, +which gives you a way to specify, on a per-mailbox basis, which +@acronym{IMAP} mailboxes should have messages automatically removed after +retrieving and which ones should leave the messages on the @acronym{IMAP} +server. The value of @code{vm-imap-auto-expunge-alist} should be a list of +@acronym{IMAP} mailboxes and values specifying whether messages should be +automatically deleted from the mailbox after retrieval. The format of the +list is: + +@example +((@var{MAILDROP} . @var{VAL}) (@var{MAILDROP} . @var{VAL}) ...) +@end example + +@var{MAILDROP} should be an @acronym{IMAP} maildrop specification as described +in the documentation for the variable @code{vm-spool-files}. If +you have the @acronym{IMAP} password specified in the @code{vm-spool-files} +entry, you do not have to specify it here as well. Use @samp{*} +instead; VM will still understand that this mailbox is the same as +the one in @code{vm-spool-files} that contains the password. + +@var{VAL} should be @code{nil} if retrieved messages should be left in the +corresponding @acronym{IMAP} mailbox, @code{t} if retrieved messages should be +removed from the mailbox immediately after retrieval. + +Here is an example: + +@example +(setq vm-imap-auto-expunge-alist + '( + ;; leave message on the server + ("imap:odin.croc.net:143:inbox:login:kyle:*" . nil) + ;; expunge immediately + ("imap:hilo.harkie.org:143:inbox:login:kyle:*" . t) + ) +) +@end example + +@unnumberedsubsubsec Multiple access to @acronym{IMAP} spool files + +A principal idea behind the @acronym{IMAP} protocol is that messages can be +retained on the server so that you can read them from multiple +locations, e.g., from office and home, or from other places on the +Internet while you travel. If you access your @acronym{IMAP} mailbox from +multiple locations then you would need to plan your strategy for +expunging messages carefully. For instance, if you access your work +mailbox from home, and both your office machine and home machine +expunge messages after retrieving them, then some of your mail will +end up on your office machine and some on your home machine. That is +unlikely to be a successful strategy. + +The best way to access @acronym{IMAP} mailboxes from multiple locations is +to use the facility of @acronym{IMAP} folders. (@xref{@acronym{POP} and +@acronym{IMAP} Folders}.) However, if you prefer to download all mail to +local folders, then your best bet is to designate one of your machines as +the principal location for downloading mail and treat the other machines as +temporary mail reading sites. In that case, you should set the principal +downloading location to expunge messages on the server and set the other +reading sites to leave the messages on the server intact. You can also +manually run @code{vm-expunge-imap-messages} if you are careful to remember +which site should expunge messages and which site should retain them. + +@cindex X-VM-@acronym{IMAP}-Retrieved header +VM remembers the messages you have downloaded from an @acronym{IMAP} spool +file so that it can avoid downloading them again on your next visit. The +list of these messages is written into a special mail header titled +@code{X-VM-@acronym{IMAP}-Retrieved} in your mail folder. When you expunge +@acronym{IMAP} messages, their entries are deleted from the list. However, +when you designate one of your machines as a reading site and never expunge +messages from there, then the @code{X-VM-IMAP-Retrieved} header on +that machine will only grow over time. When the list gets excessively long, +it will slow down the saving of folders. + +@findex vm-prune-imap-retrieved-list +To avoid the problem, you should prediodically run the command +@code{vm-prune-imap-retrieved-list}. It will examine the @acronym{IMAP} server +to see which messages still exist and retain only their information in +the @code{X-VM-IMAP-Retrieved} header. + + +@node Index Files, Folder types,@acronym{IMAP} Spool Files, Local Folders +@unnumberedsubsec Index Files +@cindex index file + +VM can create an @dfn{index} file, which describes the messages contained in +a folder. If such an index file exists and is up to date, then VM +will read the contents of the index file first while starting up in +order to quickly form the summary of the folder. + +@vindex vm-index-file-suffix +To use this feature, set the variable @code{vm-index-file-suffix} to a +file name extension, e.g., + +@example +(setq vm-index-file-suffix "idx") +@end example + + +@node Folder types,,Index Files, Local Folders +@unnumberedsubsec Folder types +@cindex folder types + +@vindex vm-default-folder-type +VM can handle a variety of formats for mail folders, which differ in +details. The variable @code{vm-default-folder-type} can be used to +set the default format that is suitable for your environment. This +setting is used when VM creates new folders. + +When VM reads a folder from the file system, it examines contents of the +folder to determine what format it is stored in and decodes it +appropriately. (However, such inference is not fully automatic. See +below.) + +@findex vm-change-folder-type +After a folder is loaded into VM, you can convert it to a different +format using the command @code{vm-change-folder-type}. It is a good +idea to keep all your mail folders in a single format in order to avoid +incompatibilities. + +The system default format is referred to as @code{From_}. It is the +Unix mbox format described RFC 4155. In this format, a leading +separator line and a trailing separator line are added to each message. +The leading separator line starts with the string ``From ''. The +trailing separator line is a blank line. VM actually adds two blank lines at +the end for clarity. + +A variant of this format is referred to as @code{BellFrom_}. It has a +leading separator line that starts with the string ``From ''. However, +it does not have a trailing blank line. + +Since VM cannot reliably infer whether a mail folder is of type +@code{From_} or @code{BellFrom_}, you must tell VM which one your system +uses by setting the variable @code{vm-default-From_-folder-type}. Some +of the old folders created by VM prior to 2000 were in the +@code{BellFrom_} format. If you will be using both @code{From_} and +@code{BellFrom_} style folders, it is not possible to choose an +appropriate setting for this variable. It is recommended that you +convert all the old @code{BellFrom_} folders to the @code{From_} format using +the command @code{vm-change-folder-type}. + +Solaris, System V and AIX operating systems use another variant of the +mbox format where the content-length is specified in the ``From '' line. +VM refers to this format as @code{From_-with-Content-Length}. Since the +content lengths may be unreliable, you must also set the variable +@code{vm-trust-From_-with-Content-Length} to a non-Nil value in order to +convince VM that you really want to use this format. + +Two additional formats are @code{mmdf} used by @acronym{MMDF} systems and +@code{babyl} used by the Emacs Rmail mode. These formats are recognized +automatically when read from the file system. + + +@node @acronym{POP} and @acronym{IMAP} Folders, Thunderbird Folders, Local Folders, Starting Up +@section @acronym{POP} and @acronym{IMAP} Folders + +@cindex primary inbox +@cindex maildrop specification +@vindex vm-primary-inbox +VM supports accessing remote mailboxes on mail servers via the Post +Office Protocol (@acronym{POP}) and the Internet Message Access Protocol (@acronym{IMAP}). +Instead of a local file name, you can set the @code{vm-primary-inbox} to +a string that tells VM how to access a server mailbox. Called a +@dfn{maildrop specification}, the string is of one of the +following formats: + +@example +``pop:@var{HOST}:@var{PORT}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' +``imap:@var{HOST}:@var{PORT}:@var{MAILBOX}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' +@end example + +@noindent Remote mailboxes accessed by VM in this fashion are referred +to as @dfn{server folders} (and @dfn{@acronym{POP} folders} or @dfn{@acronym{IMAP} +folders}, more specifically). + +@cindex cache folders +VM retrieves mail from the server folders into internal Emacs buffers +for its normal operation. It also saves copies of the folders on the +local file system for speed of operation. These are referred to as +@dfn{cache folders}. However, the @emph{only} +permanent copies of the folders are on the mail server. This should +be contrasted with using server mailboxes as spool files (@pxref{@acronym{POP} +Spool Files} and @pxref{@acronym{IMAP} Spool Files}), where the permanent +folders are on the @emph{local} file system and only the incoming mail +is held on the servers. + +Server folders have the advantage that they can be transparently +accessed from multiple locations on the internet. However, you must +ensure that you have access to enough storage on the mail server to +store all your email. + +@anchor{maildrop specification} +@unnumberedsubsec Maildrop specification +The format of a @acronym{POP} or @acronym{IMAP} maildrop specification is as +follows: + +@example +``pop:@var{HOST}:@var{PORT}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' +``imap:@var{HOST}:@var{PORT}:@var{MAILBOX}:@var{AUTH}:@var{USER}:@var{PASSWORD}'' +@end example + +@noindent Replace @samp{pop} in the example with @samp{pop-ssl} to +have VM speak @acronym{POP} over an @acronym{SSL} connection. Use +@samp{pop-ssh} to use @acronym{POP} over an SSH connection. Similarly, +replace @samp{imap} with @samp{imap-ssl} or @samp{imap-ssh}, as needed. + +@cindex @acronym{SSL} +@cindex @acronym{TLS} +@dfn{@acronym{SSL}} refers to a protocol called @dfn{secure sockets layer}, +which allows you to securely communicate with a mail server using encryption +technology. A newer version of the same protocol is called +@dfn{@acronym{TLS}} (@dfn{transport layer security}). We refer to both of +them as ``@acronym{SSL}'' in this manual. + +@cindex stunnel +@vindex vm-stunnel-program +For @acronym{SSL}, you must either be using a version of Emacs that has +@acronym{SSL} capability or have the @command{stunnel} program installed and +the variable @code{vm-stunnel-program} naming it. The default value of this +variable, @samp{"stunnel"}, should be sufficient if the program is installed +in your normal command search path. In order to use the built-in +@acronym{SSL} capability of your Emacs version, set +@code{vm-stunnel-program} to @code{nil}. + +@cindex SSH +@vindex vm-ssh-program +@vindex vm-ssh-remote-command +For SSH, you must have the @command{ssh} program installed and the variable +@code{vm-ssh-program} must name it in order for @acronym{POP}/@acronym{IMAP} +over SSH to work. When VM makes the SSH connection it must run a command on +the remote server so that the SSH session is maintained long enough for the +@acronym{POP}/@acronym{IMAP} connection to be established. By default that +command is @samp{"echo ready; sleep 10"}, but you can specify another +command by setting @code{vm-ssh-remote-command}. Whatever command you use +must produce some output and hold the connection open long enough for VM to +establish a port-forwarded connection to the mail server. (SSH must be able +to authenticate without a password, which means you must be using .shosts +authentication or RSA.) + +@var{HOST} is the host name of the mail server. + +@cindex port, TCP +@var{PORT} is the TCP port number to connect to. The normal port +numbers are: +@multitable @columnfractions 0.20 0.80 +@item 110 @tab for @acronym{POP} +@item 995 @tab for @acronym{POP} over @acronym{SSL} +@item 143 @tab for @acronym{IMAP} +@item 993 @tab for @acronym{IMAP} over @acronym{SSL} +@end multitable + +@var{MAILBOX} is the name of the mailbox on the @acronym{IMAP} server. This +should be @samp{"inbox"}, to access your default @acronym{IMAP} mailbox on +the server. No @var{MAILBOX} component is needed for @acronym{POP} +maildrops because @acronym{POP} does not support multiple mailboxes. + +@vindex vm-pop-md5-program +@var{AUTH} is the authentication method used to convince the +server you should have access to the mailbox. Acceptable +values for @acronym{POP} are @samp{pass}, @samp{rpop} and @samp{apop}. For +@samp{pass}, the @var{PASSWORD} is sent to the server with +the @acronym{POP} PASS command. For @samp{rpop}, the @var{PASSWORD} +should be the string to be sent to the server via the @acronym{RPOP} +command. In this case the string is not really a secret; +authentication is done by other means. For @samp{apop}, an +MD5 digest of the @var{PASSWORD} appended to the server +time-stamp will be sent to the server with the @acronym{APOP} command. +If Emacs does not have built in MD5 support, you will have +to set the value of @code{vm-pop-md5-program} appropriately +to point at the program that will generate the MD5 digest +that VM needs. + +@cindex CRAM-MD5 +@vindex vm-imap-session-preauth-hook +Acceptable values of @var{AUTH} for @acronym{IMAP} +are @samp{"preauth"}, @samp{"cram-md5"}, and @samp{"login"}. +@samp{"preauth"} causes VM to skip the authentication stage of +the protocol with the assumption that the session was +authenticated in some way external to VM. The hook +@code{vm-imap-session-preauth-hook} is run, and it is expected to +return a process connected to an authenticated @acronym{IMAP} session. +@samp{"cram-md5} tells VM to use the CRAM-MD5 authentication +method as specified in RFC 2195. The advantage of this method +over the @samp{"login"} method is that it avoids sending your +password over the net unencrypted. Not all @acronym{IMAP} servers support +@samp{"cram-md5"}; if you're not sure, ask your mail +administrator or just try it. The other value, @samp{"login"}, +tells VM to use the @acronym{IMAP} LOGIN command for authentication, which +sends your user name and password in clear text to the server. + +@var{USER} is the user name used in authentication methods that +require such an identifier. @samp{"login"} and @samp{"cram-md5"} +use it currently. + +@var{PASSWORD} is the +secret shared by you and the server for authentication purposes. How +it is used depends on the value of the @var{AUTH} parameter. If the +@var{PASSWORD} is @samp{*}, VM will prompt you for the password the +first time you try to retrieve mail from the mailbox. If the password +is valid, VM will not ask you for the password again during this Emacs +session. + +@cindex EasyPG +@cindex epa-file library +@cindex auth-source library +@cindex authinfo +@cindex passwords, storing +If your environment has the @dfn{EasyPG} utility and your version of Emacs +supports it, i.e., has the @samp{epa-file} and @samp{auth-source} libraries, +then you can store password information in a file such as +@file{.authinfo.gpg}. The @samp{EasyPG} protocol allows you to store +this information in an encrypted form so that it cannot be read by third +parties. Each line in the @file{.authinfo.gpg} file should be of the +form + +@example +machine HOST login USER password PASSWORD port PORT +@end example + +@noindent where HOST, USER, PASSWORD and PORT are as detailed above. +Ensure that the variable @code{auth-sources} is customized to refer to +your authinfo file. +@xref{Help for users,, Help for users, auth , Emacs auth-source}. +Then VM will read passwords from the file and you +don't need to type them in when accessing mail servers. + +If you have multiple login accounts on the same HOST then VM will only +use the first login listed in the authinfo file. To allow for multiple +logins, the HOST entry in the authinfo line can be replaced by an +account name as defined internally in VM. These account names are +defined via the variables @code{vm-pop-folder-alist} and +@code{vm-imap-account-alist}, described below. + +@anchor{troubleshooting mail servers} +@unnumberedsubsec Troubleshooting mail servers + +Since a number of components have to be brought together to establish +connections to mail servers, it is not uncommon for problems to arise. + +@cindex stunnel +To find out what could be going wrong, you can look at the Emacs buffer that +store a trace of the session with mail server. Such buffers have names +beginning with ``trace of @acronym{POP} session'' or ``trace of +@acronym{IMAP} session''. There could be multiple buffers of this kind for +different servers and multiple sessions. In the trace buffer, you will find +the commands that VM sent to the server and the responses it has received. +Typical problems are protocol mismatches between VM and the mail server, or +malfunctions in other components such as the @code{stunnel} program. + +@vindex vm-pop-keep-trace-buffer +@vindex vm-imap-keep-trace-buffer +The variables @code{vm-pop-keep-trace-buffer} and +@code{vm-imap-keep-trace-buffer} specify how many trace buffers to keep for +such server sessions. The default is 1. Setting these variables to nil +will have the effect that no trace buffers are kept. + +@menu +* @acronym{POP} Folders:: How to use mailboxes on @acronym{POP} servers +* @acronym{IMAP} Folders:: How to use mail folders on @acronym{IMAP} servers +@end menu + +@node @acronym{POP} Folders, @acronym{IMAP} Folders, @acronym{POP} and @acronym{IMAP} Folders, @acronym{POP} and @acronym{IMAP} Folders +@unnumberedsubsec @acronym{POP} Folders +@cindex @acronym{POP} +@cindex message attributes + + +@findex vm-visit-pop-folder +@findex vm-save-folder +@vindex vm-folder-directory +@vindex vm-pop-folder-cache-directory +The command @code{vm-visit-pop-folder} allows you to visit a @acronym{POP} +mailbox as a folder. When you visit a @acronym{POP} folder, VM will download +copies of the messages that it finds there for you to read. These +messages are saved locally in cache folders, in the directory +specified by @code{vm-pop-folder-cache-directory} (or +@code{vm-folder-directory} if the former is not defined). +@vindex vm-pop-folder-cache-directory +If you delete and expunge messages in the folder, the +corresponding messages on the @acronym{POP} server will be removed when you +save the changes with @code{vm-save-folder}. + +@dfn{Message attributes} (new, replied, filed, etc.) and labels cannot be +stored on the @acronym{POP} server but they will be maintained in the cache +folder. This means that if you access the same @acronym{POP} mailbox from +multiple locations on the internet, you will see different attributes at +different locations. To be able to store message attributes and labels on +the server, you should use @acronym{IMAP} folders (@ref{@acronym{IMAP} +Folders}) resident on an @acronym{IMAP} server. + +@vindex vm-pop-folder-alist +In order for VM to know about @acronym{POP} folders that you can access, you +must declare them by setting the variable @code{vm-pop-folder-alist}. +The variable's value should be an associative list of the form: + +@example + ((@var{POPDROP} @var{NAME}) ...) +@end example + +@var{POPDROP} is a @acronym{POP} maildrop specification (@ref{maildrop +specification}). + +@var{NAME} is a string that should give a less cumbersome name that you +will use to refer to this maildrop when using @code{vm-visit-pop-folder}. + +For example: + +@example +(setq vm-pop-folder-alist + '( + ("pop:pop.mail.yahoo.com:110:pass:someuser:*" "Yahoo! mail") + ("pop:localhost:110:pass:someuser:*" "local mail") + ) +) +@end example + +@samp{Yahoo! mail} and @samp{local mail} are what you would type +when @code{vm-visit-pop-folder} asks for a folder name. There is no +need to specify the password for @acronym{POP} accounts in this definition. + +@node @acronym{IMAP} Folders,, @acronym{POP} Folders, @acronym{POP} and @acronym{IMAP} Folders +@unnumberedsubsec @acronym{IMAP} Folders +@cindex @acronym{IMAP} +@cindex message attributes +@cindex message labels + +@findex vm-visit-imap-folder +The command @code{vm-visit-imap-folder} allows you to visit an +@acronym{IMAP} mailbox as a folder. The name of the @acronym{IMAP} mailbox +should be input via the minibuffer in the format account-name:folder-name. +Here, ``account-name'' is the name of an @acronym{IMAP} account declared in +@code{vm-imap-account-alist} and ``folder-name'' is the name of an +@acronym{IMAP} mailbox in this account. + +@findex vm-save-folder +@vindex vm-folder-directory +@vindex vm-imap-folder-cache-directory +When you visit an @acronym{IMAP} folder, VM will +download copies of the messages that it finds there for you to read. +These messages are saved locally in a cache folder on the disk, in the +directory specified by @code{vm-imap-folder-cache-directory} (or +@code{vm-folder-directory} if the former is not defined). +@vindex vm-imap-folder-cache-directory +If you delete and expunge messages, these changes are made to both the +cache folder and the folder on the @acronym{IMAP} server when saved +with @code{vm-save-folder}. + +Message attributes (new, replied, filed, etc.) are stored on the @acronym{IMAP} +server and are also cached locally. Message labels are also stored on +the @acronym{IMAP} server as user-defined permanent flags. (This assumes that +the @acronym{IMAP} server has the ability to store user-defined permanent +flags.) + +@vindex vm-imap-account-alist +In order for VM to know about @acronym{IMAP} accounts that you can access, you +must declare them by setting the variable @code{vm-imap-account-alist}. +The variable's value should be an associative list of the form: + +@example + ((@var{IMAPDROP} @var{NAME}) ...) +@end example + +@var{IMAPDROP} is an IMAP maildrop specification (@ref{maildrop specification}). + +@var{NAME} is a string that should give a less cumbersome name that you +will use to refer to this maildrop when using @code{vm-visit-imap-folder}. +For example: + +@example +(setq vm-imap-account-alist + '( + ("imap-ssl:mail.foocorp.com:993:*:login:becky:*" "becky") + ("imap:crickle.lex.ky.us:143:*:login:becky:*" "crickle") + ) +) +@end example + +@noindent The mailbox and password fields (@samp{*} in the example) are +ignored. When @code{vm-visit-imap-folder} asks for a folder name, you +enter an account name followed by ``:'' and a folder name. Any folder +that is accessible to you on the @acronym{IMAP} server can be specified. For +example, @code{becky:inbox} or @code{crickle:drafts}. + +@vindex vm-imap-refer-to-inbox-by-account-name +When you visit an @acronym{IMAP} folder inside VM, the folder is referred to +by its folder name as it exists on the server. For example, visiting +@code{becky:INBOX} creates a folder called @code{INBOX} inside VM. If you +visit multiple @acronym{IMAP} accounts within a VM session, then you would +end up with multiple folder buffers all named @code{INBOX}. To avoid this +problem, you can set the variable +@code{vm-imap-refer-to-inbox-by-account-name} to t, which causes the +@code{INBOX} folder buffers to be named by their @acronym{IMAP} account +names instead. For example, visiting @code{becky:INBOX} would create a VM +folder named @code{becky} and visiting @code{crickle:INBOX} would create a +VM folder named @code{crickle}. + +@vindex vm-imap-server-list +The customization variable @code{vm-imap-server-list}, used in older +versions of VM, is deprecated. Please use @code{vm-imap-account-alist} +instead. + +@anchor{@acronym{IMAP} Synchronization} +@unnumberedsubsec @acronym{IMAP} Synchronization +@vindex vm-get-new-mail +The cache folder and the folder on the @acronym{IMAP} server are partially +synchronized every time @code{vm-get-new-mail} is invoked. This involves +(i) writing the changed attributes and labels to the server, (ii) updating +the attributes and labels in the cache folder based on the server data, +(iii) expunging messages in the cache folder that have been expunged on the +server, and finally, (iv) retrieving any new messages on the server. +@vindex vm-imap-sync-on-get +The variable @code{vm-imap-sync-on-get} specifies whether +such synchronization should be done as part of @code{vm-get-new-mail}. +If the variable is set to nil then @code{vm-get-new-mail} simply +retrieves any new messages. + +@findex vm-save-folder +The cache folder and the folder on the @acronym{IMAP} server are also +synchronized every time @code{vm-save-folder} is invoked. This involves (i) +writing the changed attributes and labels to the server, (ii) updating the +attributes and labels in the cache folder based on the server data, (iii) +expunging messages in the cache folder that have been expunged on the +server, (iv) deleting and expunging the locally expunged messages on the +server folder, and finally, (v) saving a copy of the folder on the file +system. + +@findex vm-imap-synchronize +The command @code{vm-imap-synchronize} can always be used to perform +full synchronization with the server. + + + + +@node Thunderbird Folders, External Messages, @acronym{POP} and @acronym{IMAP} Folders, Starting Up +@section Thunderbird Folders + +@cindex Thunderbird +VM can work with local folders managed by Mozilla Thunderbird. You can +find the location of Thunderbird's folders by examining the Account +Settings for ``Local Folders'' inside Thunderbird. + +Thunderbird stores the folders in the @samp{From_} folder type. +@xref{Folder types}. Within such folders, Thunderbird stores the +message status flags (message attributes such as whether a message is +read, replied to, deleted etc.) under special header fields called +@code{X-Mozilla-Status} and @code{X-Mozilla-Status2}. In addition to +these headers, Thunderbird also stores a quick copy of the message +status flags in a separate file with the extension @code{.msf}. + +When you visit a Thunderbird folder, VM reads the status flags stored in +the special headers and uses them for processing. As you make changes +to the folder by reading messages, replying to them or deleting them, +the changes are propagated to the Thunderbird status flags and written +to the disk when saved. VM also deletes the @code{.msf} file maintained +by Thunderbird so that Thunderbird will recompute the status information +from the headers. Thus, the changes made to the Thunderbird folders +will be visible inside Thunderbird. + +@vindex vm-sync-thunderbird-status +The variable @code{vm-sync-thunderbird-status} controls how VM deals +with Thunderbird folders. The default value @code{t} gives the behavior +described above. You can also set it to @code{'read-only}, in which +case VM reads the Thunderbird status flags, but makes no changes to +them. So, the changes made to the folders will be lost after you quit +VM. If you set it to @code{nil}, then VM refrains from reading and +writing the Thunderbird status flags. In this case, the changes made to +the folders are visible inside VM even after revisiting, but they will have +no effect for Thunderbird. + +WARNING: Keep in mind that all this applies to changes to message +attributes only. If you @i{expunge} a folder, then the deleted messages +are physically purged from the folder. They will be lost both inside VM +as well as Thunderbird. + +The variable @code{vm-sync-thunderbird-status} is a buffer-local +variable. You may set its default value in your @code{.vm} file. To +change it in a running Emacs session, you must use @code{setq-default}. +@xref{Locals,, Local Variables, emacs, Gnu Emacs manual}. + +@findex vm-visit-thunderbird-folder +@vindex vm-thunderbird-folder-directory +A new experimental feature allows you to visit Thunderbird's local +folders using the command @code{M-x vm-visit-thunderbird-folder}. +This works the same way as @code{vm-visit-folder} except for the +difference that the default directory for visiting folders as well as +saving messages will be taken from the variable +@code{vm-thunderbird-folder-directory}. You should set this variable to the +directory where Thunderbird stores its folders. The folders visited +using @code{M-x vm-visit-folder} will continue to be found in +@code{vm-folder-directory}, thus allowing you to manage the two spaces +separately. + +If, on the other hand, you want to maintain a single space where VM +and Thunderbird can jointly operate, then you should set the variable +@code{vm-folder-directory} to point to that place and leave +@code{vm-thunderbird-folder-directory} with its default value of +@code{nil}. + +@node External Messages, Getting New Mail, Thunderbird Folders, Starting Up +@section External Messages + +Under certain circumstances, it is possible to maintain VM folders in which +only the headers of messages are loaded into the Folder buffer. The message +bodies are retained in external sources (file system or remote servers) and +fetched on demand when the messages are viewed or other operations are +performed on them. Using external messages results in a smaller folder size +and allows a faster operation on machines with limited resources. However, +the fetching of message bodies on demand can introduce short delays when +messages are viewed. It is also not possible to search in the message +bodies of external messages. + +@vindex vm-enable-external-messages +To enable external messages, set the variable +@code{vm-enable-external-messages} to a list of contexts in which external +messages may be maintained by VM. + +@vindex vm-imap-max-message-size +As of version 8.2.0, the only context in which external messages are +implemented is that of @acronym{IMAP} folders. Setting +@code{vm-enable-external-messages} to @code{(imap)} enables @acronym{IMAP} +messages to be maintained externally. When new messages are retrieved, this +causes all messages with size below @code{vm-imap-max-message-size} to be +loaded immediately, and larger messages will be left on the server to be +fetched on demand. To treat all messages as external messages, you can set +@code{vm-imap-max-message-size} to 0. + +@vindex vm-fetched-message-limit +After fetching the bodies of external messages, VM stores them in the Folder +buffer temporarily, so that repeated fetching is avoided. The variable +@code{vm-fetched-message-limit} controls how many message bodies are stored +in this way. You can set it to an integer (10 is the default), or to +@code{nil}, signifying that there is no limit. All the fetched message +bodies are flushed before folders are saved to disk. + +@findex vm-load-message +@findex vm-unload-message +@findex vm-refresh-message +@kindex o +@kindex O +You can manually load message bodies into the Folder using the command +@kbd{o} (@code{vm-load-message}). The command @kbd{O} +(@code{vm-unload-message}) unloads a previously loaded message body. Both +the commands can take numerical prefix arguments or operate on marked +messages. Note that ``loading'' a message body is different from on demand +``fetching''. Loaded messages are permanently stored in the Folder buffer +and written to disk when the folder is saved. In contrast, fetched message +bodies are always discarded before writing to disk. The command +@code{vm-refresh-message} reloads an already loaded message with a fresh +copy retrieved from the server. + +@node Getting New Mail, Crash Recovery, External Messages, Starting Up +@section Getting New Mail + +@findex vm-get-new-mail +@kindex g +Pressing @kbd{g} runs @code{vm-get-new-mail}, which will retrieve mail from +all the spool files associated with the current folder. @xref{Local +Folders}. For @acronym{POP} and @acronym{IMAP} folders, any newly arrived +messages at the mail server will be incorporated into the local copy of the +folders. + +@vindex vm-auto-get-new-mail +If the value of the variable @code{vm-auto-get-new-mail} is non-@code{nil} VM +will retrieve mail for a folder whenever the folder is visited. If the +value is a positive integer @var{n}, VM will also check for new mail +every @var{n} seconds for all folders currently being visited. If new +mail is present, VM will retrieve it. + +@vindex vm-mail-check-interval +@vindex vm-mail-check-always +If the value of the variable @code{vm-mail-check-interval} is a +positive integer @var{n}, VM will check for new mail every @var{n} +seconds, but instead of retrieving mail, the word ``Mail'' will appear +on the Emacs mode line of folders that have mail waiting. Normally, +once VM finds new mail, it will turn on the ``Mail'' indicator and +refrain from checking again until you retrieve the new mail. However, +if multiple mail clients are trying to retrieve mail from the same +spool, it is possible that the new mail might get retrieved into +another mail client and your ``Mail'' indicator won't reflect the +situation. If you need to be particular about new mail in such a +situation, then you should set the variable +@code{vm-mail-check-always}. + +@node Crash Recovery,, Getting New Mail, Starting Up +@section Crash Recovery +@cindex crash reovery +@cindex message attributes +@cindex message labels +@cindex auto-save + +When Emacs crashes, its last action before dying is to try to +write out an @dfn{auto-save} file that contains changes to files that +you were editing. VM folders are file buffers inside Emacs, so +folders are auto-saved also. For VM folders, @dfn{changes} +means attribute changes, label additions and deletions, message +edits, and expunges. VM keeps track of whether a message is new +or old, whether it has been replied to, whether it is flagged +for deletion and so on, by writing special headers into the +folder buffer. These headers are saved to disk when you save +the folder. If Emacs crashes before the folder has been saved, +VM may forget some attribute changes unless they were written to +the auto-save file. + +Note that when VM retrieves mail from spool files it @emph{always} +writes them to disk immediately and at least one copy of the message is +on disk at all times. So while you can lose attribute changes from +crashes, you should not lose messages unless the disk itself is +compromised. + +@unnumberedsubsec Recovering Folders + +When you visit a folder, VM checks for the existence of an +auto-save file that has been modified more recently than the +folder file. If such an auto-save file exists, there is a good +chance that Emacs or your operating system crashed while VM +was visiting a folder. VM will then write a message to the echo +area informing you of the existence of the auto-save file and +visit the folder in @emph{read-only} mode. Visiting the folder in +read-only mode prevents you from modifying the folder, which +in turn prevents Emacs from wanting to write new changes to +the auto-save file. VM will not retrieve new mail for a folder +that is in read-only mode. VM also skips summary +generation and @acronym{MIME} decoding to help catch your attention. + +@findex vm-recover-folder +@findex recover-file +If you want to recover the lost changes, run @kbd{M-x +vm-recover-folder} or use the Recover Folder entry in Folder menu. At +the @samp{Recover File:} prompt press @key{RET}. Emacs's built-in +@kbd{recover-file} command is @emph{not recommended} for this purpose because +VM is unable to obtain reliable data regarding mail folders from +Emacs. + +In response to @code{vm-recover-folder}, Emacs will display a detailed +directory listing showing the folder file and the auto-save file and ask you +whether you want to recover from the auto-save file. A good rule of thumb is +to answer ``yes'' if the auto-save file is larger than the folder file. If +the auto-save file is significantly smaller, Emacs might not have completed +writing the auto-save file during the previous crash. Or it could be that +the smaller auto-save file reflects the results of an expunge that you had +not yet committed to disk before the crash. If so, answering ``no'' means +you might have to do that expunge again, but this is better than not knowing +whether the auto-save file was truncated. + +Assuming you answered ``yes'', the folder buffer's contents will be +replaced by the contents of the auto-save file and VM will re-parse the +folder. At this point the contents of the folder buffer and the disk +copy of the folder are different. Therefore VM will not get new mail +for this folder until the two copies of the folder are synchronized. +When you are satisfied that the recovered folder is whole and intact, +type @kbd{S} to save it to disk. After you do this, VM will allow you +to use @kbd{g} to retrieve any new mail that has arrived in the spool +files for the folder. + +Assuming you answered ``no'' to the recovery question, you should type +@kbd{C-x C-q}, which is bound to @code{vm-toggle-read-only} in VM folder +buffers. The folder will be taken out of read-only mode and you can +read and retrieve your mail normally, ignoring the auto-save file that is +still on disk. + +If you are visiting a @acronym{POP} or @acronym{IMAP} folder (rather than a +local folder) that was modified during a previous crash, the process of +recovery is similar. However, there will be less useful information in the +auto-save file in this case. When you synchronize an @acronym{IMAP} folder +with the server, only the changes made during the current VM session are +saved to the server. Changes stored in the auto-save file were made in a +previous session of VM and, so, cannot be saved to the server. So, saying +``no'' to the recovery question and toggling the read-only status (@kbd{C-x +C-q}) is a better option in the case of server folders. + +@unnumberedsubsec Recovering Message Compositions + +@vindex vm-mail-auto-save-directory +@findex vm-postpone-message +Any messages you were in the midst of composing when Emacs crashed, would +also have auto-save files in the disk. They would be saved in the +@code{vm-mail-auto-save-directory}, if you have set that variable, or +@code{vm-folder-directory}, or the directory that was current when you +started composing the message. You can visit the auto-save file, which +would get loaded as a text file by default, and then run @kbd{M-x +mail-mode}. VM's mail-mode command keys are not available in this mode. +The best option is to run @kbd{M-x vm-postpone-message} to save the +unfinished message composition and then continue it using +@code{vm-continue-postponed-message}. @xref{Add-ons, Postponing message composition}. + +@unnumberedsubsec Recovering Sessions + +Emacs also provides a way to recover the entire Emacs session after a crash. +@xref{Recover,,, emacs, the GNU Emacs Manual}. However, the Emacs +@code{recover-session} command will recover VM folders as if they were +ordinary files. As mentioned above, this is not a good method of recovering +VM folders. You should use @code{vm-recover-folder} command instead. So, +when Emacs @code{recover-session} command asks you whether to recover a VM +folder, the best option is to answer ``no''. Then you should recover the +folders separately, using the @code{vm-recover-folder} command. + +If you do answer ``yes'', then Emacs loads the auto-save file into a buffer. +The auto-save file still exists on the disk, but it will get deleted when +you save the buffer. So, you should examine the folder before you save it. +Run @kbd{M-x vm-mode} in the buffer corresponding to the VM folder, make +sure that it is not damaged, and then save the folder. If you do not +believe that the auto-saved version is good, you can kill the buffer. At +this point, VM asks you for confirmation whether you really want to kill the +buffer and, secondly, whether you want to delete the auto-save file. If you +answer ``yes'' to the last question, then the auto-saved folder will be +gone for ever. + + + +@unnumberedsubsec Reverting a Folder + +@findex vm-revert-folder +@findex revert-file +If you have made changes to a mail folder which you would like to +cancel and go back to the version currently on the disk, you can use +the function @kbd{vm-revert-folder} or the ``Revert Folder'' entry in the +Folder menu. (Emacs's built-in @kbd{revert-file} is not recommended.) + +@node Selecting Messages, Reading Messages, Starting Up, Top +@chapter Selecting Messages + +@findex vm-next-message +@findex vm-previous-message +@kindex n +@kindex p +@vindex vm-skip-deleted-messages +@vindex vm-skip-read-messages +In order to read, delete, or do anything to a message, you need to +select it. In other words, make the message the @dfn{current message}. + +The primary commands for selecting messages in VM are @kbd{n} +(@code{vm-next-message}) and @kbd{p} +(@code{vm-previous-message}). These commands move forward and +backward through the current folder. By default, these commands +skip messages flagged for deletion. This behavior can be +disabled by setting the value of the variable +@code{vm-skip-deleted-messages} to @code{nil}. These commands +can also be made to skip messages that have been read; set +@code{vm-skip-read-messages} to @code{t} to do this. + +@cindex prefix argument +The commands @kbd{n} and @kbd{p} also take prefix arguments that +specify the number of messages to move forward or backward. If +the magnitude of the prefix argument is greater than 1, no +message skipping will be done regardless of the settings of the +skip variables. + +@vindex vm-circular-folders +The variable @code{vm-circular-folders} determines whether VM folders +will be considered circular by various commands. @dfn{Circular} means VM +will wrap from the end of the folder to the start and vice versa when +moving the message pointer, deleting, undeleting or saving messages +before or after the current message. + +A value of @code{t} causes all VM commands to consider folders circular. +A value of @code{nil} causes all VM commands to signal an error if +the start or end of the folder would have to be passed to complete the +command. For movement commands, this occurs after the message pointer +has been moved as far as it can go. For other commands the error occurs +before any part of the command has been executed, i.e. no deletions, saves, +etc. will be done unless they can be done in their entirety. A value +other than @code{nil} or @code{t} causes only VM's movement +commands to consider folders circular. Saves, deletes and undeletes +will behave as if the value is @code{nil}. The default value of +@code{vm-circular-folders} is @code{nil}. + +@vindex vm-follow-summary-cursor +You can also select messages by using the summary window. +@xref{Summaries}. Move the cursor to the summary line for the message +you want to select and press @key{RET}. VM will select this message. +Instead of pressing @key{RET} you could run some other VM command that +operates based on the notion of a `current message'. VM will select the +message under the cursor in the summary window before executing such +commands. Example, if you type @kbd{d}, VM will select the message +under the cursor and then delete it. Note that this occurs @emph{only} +when you execute a command when the cursor is in the summary buffer +window and only if the variable @code{vm-follow-summary-cursor} is +non-@code{nil}. + +@vindex vm-jump-to-unread-messages +@vindex vm-jump-to-new-messages +When a folder is visited or when you type @kbd{g} and VM retrieves some +mail, the default action is to move to the first new or unread message +in the folder. New messages are favored over old but unread messages. +If you set @code{vm-jump-to-new-messages} to @code{nil}, VM will favor old, +unread messages over new messages if the old, unread message appears +earlier in the folder. If you set @code{vm-jump-to-unread-messages} to +@code{nil} also, VM will not search for new or unread messages. + +@cindex searching +Other commands to select messages: + +@table @kbd +@findex vm-goto-message +@kindex RET +@item @key{RET} (@code{vm-goto-message}) +Go to message number @var{n}. @var{n} is the prefix argument, if +provided, otherwise it is prompted for in the minibuffer. +@findex vm-goto-message-last-seen +@kindex TAB +@item TAB (@code{vm-goto-message-last-seen}) +Go to message last previewed or read. +@findex vm-next-message-no-skip +@findex vm-previous-message-no-skip +@kindex N +@kindex P +@item N (@code{vm-next-message-no-skip}) +@itemx P (@code{vm-previous-message-no-skip}) +Go to the next (previous) message, ignoring the settings of the skip +control variables. +@findex vm-next-unread-message +@findex vm-previous-unread-message +@kindex M-n +@kindex M-p +@item M-n (@code{vm-next-unread-message}) +@itemx M-p (@code{vm-previous-unread-message}) +Move forward (backward) to the nearest new or unread message. +@findex vm-isearch-forward +@findex vm-isearch-backward +@kindex M-s +@comment @kindex M-r +@vindex vm-search-using-regexps +@item M-s (@code{vm-isearch-forward}) +@item M-x vm-isearch-backward +These work just like Emacs' normal forward and backward incremental +search commands, except that when the search ends, VM selects the +message containing point. If the value of the variable +@code{vm-search-using-regexps} is non-@code{nil}, a regular expression +may be used instead of a fixed string for the search pattern; VM +defaults to the fixed string search. If a prefix argument is given, +the value of @code{vm-search-using-regexps} is temporarily reversed for +the search. +@xref{Incremental Search,,,emacs, the GNU Emacs Manual}. +@end table + +@node Reading Messages, Sending Messages, Selecting Messages, Top +@chapter Reading Messages + +Once a message has been selected, VM will show it to you. By default, +presentation is done in two stages: @dfn{previewing} and @dfn{paging}. + +@menu +* Previewing:: Customizing message previews. +* Paging:: Viewing the current message. +* @acronym{MIME} Messages:: Using VM's @acronym{MIME} display features. +@end menu + +@node Previewing, Paging, Reading Messages, Reading Messages +@section Previewing + +@dfn{Previewing} means showing you a small portion of a message +and allowing you to decide whether you want to read it. Typing +@key{SPC} exposes the body of the message, and from there you can +repeatedly type @key{SPC} to page through the message. + +By default, the sender, recipient, subject and date headers are shown +when previewing; the rest of the message is hidden. This behavior may +be altered by changing the settings of three variables: +@code{vm-visible-headers}, @code{vm-invisible-header-regexp} and +@code{vm-preview-lines}. + +@vindex vm-preview-lines +If the value of @code{vm-preview-lines} is a number, it tells VM how +many lines of the text of the message should be visible. The default +value of this variable is 0. If @code{vm-preview-lines} is @code{nil}, +then previewing is not done at all; when a message is first presented it +is immediately exposed in its entirety and is flagged as read. If +@code{vm-preview-lines} is @code{t}, the message body is displayed fully +but the message is not flagged as read until you type @key{SPC}. + +@vindex vm-visible-headers +The value of @code{vm-visible-headers} should be a list of regular +expressions matching the beginnings of headers that should be made +visible when a message is presented. The regexps should be listed in +the preferred presentation order of the headers they match. + +@vindex vm-invisible-header-regexp +If non-@code{nil}, the variable @code{vm-invisible-header-regexp} +specifies what headers should @emph{not} be displayed. Its value should +be a string containing a regular expression that matches all headers you +do not want to see. Setting this variable non-@code{nil} implies that +you want to see all headers not matched by it; therefore the value of +@code{vm-visible-headers} is only used to determine the order of the +visible headers in this case. Headers not matched by +@code{vm-invisible-header-regexp} or @code{vm-visible-headers} are +displayed last. + +If you change the value of either @code{vm-visible-headers} or +@code{vm-invisible-header-regexp} in the middle of a VM session the +effects will not be immediate. You will need to use the command +@code{vm-discard-cached-data} on each message (bound to @kbd{j} by +default) to force VM to rearrange the message headers. A good way to do +this is to mark all the messages in the folder and apply +@code{vm-discard-cached-data} to the marked messages +@xref{Marking Messages}. + +@vindex vm-highlighted-header-regexp +@vindex vm-highlighted-header-face +Another variable of interest is @code{vm-highlighted-header-regexp}. +The value of this variable should be a single regular expression that +matches the beginnings of any header that should be presented in inverse +video when previewing. For example, a value of +@samp{"^From\\|^Subject"} causes the From and Subject headers to be +highlighted. Highlighted headers will be displayed using the face +specified by @code{vm-highlighted-header-face}, which defaults to +'bold. + +@vindex vm-preview-read-messages +By default, VM will not preview messages that are flagged as read. To +have VM preview all messages, set the value of +@code{vm-preview-read-messages} to @code{t}. + +@findex vm-expose-hidden-headers +@kindex t +Typing @kbd{t} (@code{vm-expose-hidden-headers}) makes VM toggle +between exposing and hiding headers that would ordinarily be hidden. + +@node Paging, @acronym{MIME} Messages, Previewing, Reading Messages +@section Paging + +@kindex SPC +@kindex DEL +@vindex vm-auto-next-message +Typing @key{SPC} during a message preview exposes the body of the +message. If the message was new or previously unread, it will be +flagged ``read''. At this point you can use @key{SPC} to scroll +forward, and @key{DEL} to scroll backward a windowful of +text at a time. A prefix argument @var{n} applied to these commands +causes VM to scroll forward or backward @var{n} lines. Typing space +at the end of a message moves you to the next message. If the value +of @code{vm-auto-next-message} is @code{nil}, @key{SPC} will not +move to the next message; you must type @kbd{n} explicitly. + +If the value of @code{vm-honor-page-delimiters} is non-@code{nil}, VM +will recognize and honor page delimiters. This means that when you +scroll through a document, VM will display text only up to the next page +delimiter. Text after the delimiter will be hidden until you type +another @key{SPC}, at which point the text preceding the delimiter will +become hidden. The Emacs variable @code{page-delimiter} determines what +VM will consider to be a page delimiter. + +@findex vm-unread-message +@findex vm-mark-message-read +@findex vm-mark-message-unread +@kindex U +@kindex . +You can ``unread'' a message (so to speak) by typing @kbd{U} +(@code{vm-unread-message}, also called @code{vm-mark-message-unread}). +The current message will be marked unread. Conversely, you can mark +an unread message as read by typing @kbd{.} +(@code{vm-mark-message-read}). + +@findex vm-toggle-flag-message +@kindex ! +As you read messages, you might want to flag important messages so +that you can come back to them later. You can do so by typing +@code{!} (@code{vm-toggle-flag-message}). You can also turn off the +flag on a flagged message by typing @code{!} again. In the Summary +display, the flagged messages are highlighted using the +@code{vm-summary-high-priority-face}. (@xref{predefined summary +faces}.) + + +@cindex longlines.el +@cindex filling paragraphs +@cindex word wrapping +@cindex visual line mode +@vindex vm-paragraph-fill-column +@vindex vm-fill-paragraphs-containing-long-lines +@vindex vm-word-wrap-paragraphs +Sometimes you will receive messages that contain lines that are +too long to fit on your screen without wrapping. Setting +@code{vm-word-wrap-paragraphs} to t will cause VM to use the +@file{longlines.el} library by Grossjohann, Schroeder and Yidong to +carry out word wrapping. You must have this library installed +somewhere on your @code{load-path}. Another way to deal with the +problem is to use the @code{visual-line-mode} in Emacs 23. You can +activate it automatically for viewing messages by adding the function +@code{turn-on-visual-line-mode} to the +@code{vm-presentation-mode-hook}. + +If you are unable to use either of these solutions, then you can use +Emacs's paragraph filling facility. If you set +@code{vm-fill-paragraphs-containing-long-lines} to a positive numeric +value @var{N}, VM will call @code{fill-paragraph} on all paragraphs that +contain lines spanning @var{N} columns or more. You can also set this +variable to the symbol @code{window-width}, in which case the width of +the current window is used the limiting width beyond which paragraph +filling is invoked. As with other things that VM does for presentation +purposes, this does not change the message contents. VM copies the +message contents to a ``presentation'' buffer before altering them. The +fill column that VM uses is controlled by +@code{vm-paragraph-fill-column}. Unlike the Emacs variable +@code{fill-column}, this variable is not buffer-local by default. + + +@node @acronym{MIME} Messages,, Paging, Reading Messages +@section Reading @acronym{MIME} Messages + +@cindex @acronym{MIME} +@vindex vm-display-using-mime +@dfn{@acronym{MIME}} is a set of extensions to the standard Internet message +format that allows reliable transmission of arbitrary data including images, +audio and video, as well as ordinary text in different languages. By +default, VM will recognize @acronym{MIME} encoded messages and display them +as specified by the various @acronym{MIME} standards specifications. This +can be turned off by setting the variable @code{vm-display-using-mime} to +@code{nil} and VM will then display @acronym{MIME} messages as plain text +messages. + +@vindex vm-mime-base64-decoder-program +@vindex vm-mime-base64-encoder-program +@vindex vm-mime-base64-decoder-switches +@vindex vm-mime-base64-encoder-switches +@vindex vm-mime-qp-decoder-program +@vindex vm-mime-qp-decoder-switches +@vindex vm-mime-qp-encoder-program +@vindex vm-mime-qp-encoder-switches +@vindex vm-mime-uuencode-decoder-program +@vindex vm-mime-uuencode-decoder-switches +At its most basic @acronym{MIME} is a set of transfer encodings used to +ensure error free transport, and a set of content types. VM understands the +two standard @acronym{MIME} transport encodings, Quoted-Printable and +BASE64, and will decode messages that use them as necessary. VM also will +try to recognize and decode messages using the UNIX ``uuencode'' encoding +system. While this is not an official @acronym{MIME} transfer encoding and +never will be, enough old mailers still use it that it is worthwhile to +attempt to decode it. VM has Emacs-Lisp based Quoted-Printable and BASE64 +encoders and decoders, but you can have VM use external programs to perform +these tasks and the process will almost certainly be faster. The variables +@code{vm-mime-qp-decoder-program}, @code{vm-mime-qp-decoder-switches}, +@code{vm-mime-qp-encoder-program}, @code{vm-mime-qp-encoder-switches}, +@code{vm-mime-base64-decoder-switches}, +@code{vm-mime-base64-encoder-switches}, +@code{vm-mime-base64-decoder-program}, +@code{vm-mime-base64-encoder-program}, tell VM which programs to use and +what command line switches to pass to them. There are C programs at VM's +distribution sites on the Internet to handle BASE64 and Quoted-Printable. +VM does not have a built-in ``uuencode'' decoder, so +@code{vm-mime-uuencode-decoder-program} must be set non-@code{nil} for VM to +decode uuencoded @acronym{MIME} objects. + +@menu +* Viewing @acronym{MIME}:: Decoding @acronym{MIME} for viewing +* Attachments:: Operating on @acronym{MIME} attachments +* Internal display:: Viewing attachments internally in Emacs +* External display:: Viewing attachments with external viewers +* Displaying images:: Using Emacs facilities for images +* @acronym{MIME} type conversion:: Converting external attachments to internal +* Character sets:: @acronym{MIME} character sets +* multipart/alternative:: @acronym{MIME} content in alternative formats +* Inferring @acronym{MIME} types:: Inferring types from attachment file names +@end menu + + +@node Viewing @acronym{MIME}, Attachments,, @acronym{MIME} Messages +@unnumberedsubsec Viewing @acronym{MIME} messages +By default VM will display as many content types as possible +within Emacs. Images and audio are also supported if +support for images and audio has been compiled in. Types that +cannot be displayed internally within Emacs can be converted to a +type that can, or be displayed using an external viewer. + +@vindex vm-auto-decode-mime-messages +@vindex vm-mime-decode-for-preview +@kindex D +The first step in displaying a @acronym{MIME} message is decoding it to +determine what object types it contains. The variable +@code{vm-auto-decode-mime-messages} controls when this happens. +A value of @code{t} means VM should decode the message as soon as +the message body is exposed, or during previewing if +@code{vm-mime-decode-for-preview} is also set non-@code{nil}. A +@code{nil} value means wait until decoding is explicitly +requested. Type @kbd{D} (@code{vm-decode-mime-message}) to +manually initiate @acronym{MIME} decoding. + +@vindex vm-mime-button-format-alist +@cindex @acronym{MIME} button +When VM does not display a @acronym{MIME} object immediately, it displays a +@b{@acronym{MIME} button} or tag line in its place that describes the object +and what you have to do to display it. The value of +@code{vm-mime-button-format-alist} determines the format of the text in +those buttons. + +After decoding you will see either the decoded @acronym{MIME} objects or +button lines that must be activated to attempt display of the +@acronym{MIME} object. + +@vindex vm-mime-auto-displayed-content-types +@vindex vm-mime-auto-displayed-content-type-exceptions +The variable @code{vm-mime-auto-displayed-content-types} specifies the types +that are displayed immediately. Its value should be a list of +@acronym{MIME} content types that should be displayed immediately after +decoding. Other types will be displayed as a button that you must activate +to display the object. The variable +@code{vm-mime-auto-displayed-content-type-exceptions} can be used to specify +any exceptions to the types listed in +@code{vm-mime-auto-displayed-content-types}. + +@cindex Content-Disposition +@vindex vm-mime-honor-content-disposition +@cindex attachments +The @acronym{MIME} objects in messages come with a header called +@dfn{Content-Disposition}, which specifies whether the @acronym{MIME} object +should be displayed as part of the message display (the ``inline'' +disposition) or whether it should be displayed as a button that should be +invoked to view the object (the @dfn{attachment} disposition). However, not +all mail clients do a good job of adding this header. It is not uncommon to +find mail clients that declare all @acronym{MIME} objects to be ``inline'' +and others that declare all @acronym{MIME} objects to be ``attachment''. +The variable @code{vm-mime-honor-content-disposition} can be customized to +tell VM whether it should follow the suggestions in the Content-Disposition +headers. A value of @code{t} means that they should be always honored and a +value of @code{nil} means that they should be ignored. It can also be set +to the symbol @code{internal-only}, which means that the Content-Disposition +suggestions should be honored for only the internally displayable types. +(@xref{Internal display of @acronym{MIME} attachments}.) + +@findex vm-next-button +@findex vm-previous-button +@kindex [ +@kindex ] +The commands @kbd{[} and @kbd{]} (@code{vm-previous-button}) and +@code{vm-next-button}, respectively) can be +used move to particular buttons within the message presentation. + +@node Attachments, Internal display, Viewing @acronym{MIME}, @acronym{MIME} Messages +@unnumberedsubsec Operating on @acronym{MIME} attachments +@anchor{Operating on @acronym{MIME} attachments} +@cindex attachments +@kindex $ | +@kindex $ d +@kindex $ RET +@kindex $ s +@kindex $ w +@kindex $ p +@kindex $ d +@kindex $ e +@findex vm-mime-reader-map-pipe-to-command +@findex vm-delete-mime-object +@findex vm-mime-reader-map-display-using-default +@findex vm-mime-reader-map-display-object-as-type +@findex vm-mime-reader-map-save-message +@findex vm-mime-reader-map-save-file +@findex vm-mime-reader-map-pipe-to-printer +@findex vm-delete-mime-object +@findex vm-mime-reader-map-display-using-external-viewer +@findex vm-mime-reader-map-attach-to-composition +To activate a button, either click the middle mouse button over it, or move +the cursor to the line and press @key{RET}. If you are running under a +window system, you can use the right mouse button over a @acronym{MIME} +button to display a menu of actions you can take on the @acronym{MIME} +object. If you prefer using keyboard commands, you can save the +@acronym{MIME} object with @kbd{$ w}, print it with @kbd{$ p}, or pipe it to +a shell command with @kbd{$ |}. Use @kbd{$ s} to append an encapsulated +message or USENET news article to a folder. If you want to display the +object with its characters displayed using Emacs' default face, use @kbd{$ +@key{RET}}. To display the object using an external viewer, type @kbd{$ e}. + +@multitable @columnfractions .20 .80 +@item $ w @tab @code{vm-mime-reader-map-save-file} +@item $ s @tab @code{vm-mime-reader-map-save-message} +@item $ p @tab @code{vm-mime-reader-map-pipe-to-printer} +@item $ | @tab @code{vm-mime-reader-map-pipe-to-command} +@item $ @key{RET} @tab @code{vm-mime-reader-map-display-using-default} +@item $ e @tab @code{vm-mime-reader-map-display-using-external-viewer} +@item $ v @tab @code{vm-mime-reader-map-display-object-as-type} +@item $ d @tab @code{vm-delete-mime-object} +@item $ a @tab @code{vm-mime-reader-map-attach-to-composition} +@end multitable + +@vindex vm-mime-delete-after-saving +@vindex vm-mime-attachment-save-directory +@vindex vm-mime-confirm-delete +The @acronym{MIME} attachments can be saved to disk with @kbd{$ w} +(@code{vm-mime-reader-map-save-file}). They can be deleted at the +same time by setting the variable @code{vm-mime-delete-after-saving}. +In this case, the attachment is deleted and replaced by a @acronym{MIME} part +that refers to the saved copy. The variable +@code{vm-mime-attachment-save-directory} specifies the default +directory to save the attachments in. The @acronym{MIME} attachments can also +be deleted directly from the message bodies with @kbd{$ d} +(@code{vm-delete-mime-object}). The variable +@code{vm-mime-confirm-delete} controls whether a confirmation is asked +for. + +It is a good idea to use @code{vm-mime-delete-after-saving} to delete +saved attachments instead of deleting them manually, because with the +former approach the message will have a handle to the saved copy, +which can be retrieved when desired. + +Saving attachments to the file system and deleting them from message +bodies has the beneficial effect of reducing the size of VM folders. +That leads to a better utilization of the computer resources and +usually a faster operation of VM. + +@findex vm-save-all-attachments +@findex vm-delete-all-attachments +@vindex vm-mime-deletable-types +@vindex vm-mime-deletable-type-exceptions +@vindex vm-mime-savable-types +@vindex vm-mime-savable-type-exceptions +The commands @code{vm-save-all-attachments} and +@code{vm-delete-all-attachments} can be used to save or delete +@i{all} the attachments in a message. An "attachment" in this context +is any @acronym{MIME} part that has "attachment" as its content-disposition or +simply has a file name. In addition, all @acronym{MIME} parts that have types +matching @code{vm-mime-savable-types} or @code{vm-mime-deletable-types} +(but not the corresponding @code{-exceptions}) are included. + +@node Internal display, External display, Attachments, @acronym{MIME} Messages +@unnumberedsubsec Internal display of @acronym{MIME} attachments +@anchor{Internal display of @acronym{MIME} attachments} + +@vindex vm-mime-auto-displayed-content-types +A value of t for @code{vm-mime-auto-displayed-content-types} means that +all types should be displayed immediately. A nil value means +never display @acronym{MIME} objects immediately; only use buttons. If +the value of @code{vm-mime-auto-displayed-content-types} is a list, it +should be a list of strings, which should all be @acronym{MIME} types or +type/subtype pairs. Example: + +@example +(setq vm-mime-auto-displayed-content-types '("text" "image/jpeg")) +@end example + +@noindent If a top-level type is listed without a subtype then all +subtypes of that type are assumed to be included. The example above +says that all text types should be displayed immediately, but only +JPEG images should be displayed this way. + +@vindex vm-mime-auto-displayed-content-type-exceptions +The variable @code{vm-mime-auto-displayed-content-type-exceptions} +should be a list of @acronym{MIME} content types that should not be +displayed immediately after decoding. This variable acts as +an exception list for @code{vm-mime-auto-displayed-content-types}; +all types listed there will be auto-displayed except those in +the exception list. + +@example +(setq vm-mime-auto-displayed-content-type-exceptions '("text/html")) +@end example + +@noindent If ``code'' has been included in +@code{vm-mime-auto-displayed-content-types} then the effect of this +setting is to allow the auto-display of all text types @i{except} for +html. + +@vindex vm-mime-internal-content-types +The variable @code{vm-mime-internal-content-types} specifies which +types should be displayed internally within Emacs. Like +@code{vm-mime-auto-displayed-content-types} its value should be a list +of @acronym{MIME} content types. A value of t means that VM should always +display an object internally if possible. VM knows which object types +can be displayed internally, so you can specify the types you want +without worrying about potential errors. If the value is a list, it +should be a list of strings. Example: + +@example +(setq vm-mime-internal-content-types '("text" "message" "image/jpeg")) +@end example + +@cindex multipart types +@noindent If a top-level type is listed without a subtype then all +subtypes of that type are assumed to be included. Note that multipart +types are always handled internally regardless of the setting of this +variable. + +@vindex vm-mime-internal-content-type-exceptions +The variable @code{vm-mime-internal-content-type-exceptions} serves as +the exception list for @code{vm-mime-internal-content-types}. Its value +should be a list of types that should not be displayed internally. + +@cindex @acronym{HTML} +@vindex vm-mime-text/html-handler +The @acronym{HTML} content in text/html @acronym{MIME} parts can be +displayed in Emacs using a variety of packages. VM knows about: + +@cindex lynx +@cindex w3m +@cindex w3 +@multitable @columnfractions .15 .85 +@item lynx + @tab The @command{lynx} browser used externally to convert @acronym{HTML} + to plain text +@item w3m + @tab The @command{w3m} browser used externally to convert @acronym{HTML} + to plain text +@item emacs-w3 + @tab The @samp{Emacs/W3} browser used internally in Emacs +@item emacs-w3m + @tab The @samp{Emacs/W3M} browser used internally in Emacs +@end multitable + +You can set the variable @code{vm-mime-text/html-handler} to one of +these values to use the appropriate package. A value of +@code{auto-select} causes VM to select the best package available. A +value of @code{nil} asks VM not to display @acronym{HTML} content internally. +The default value is @code{auto-select}, allowing VM to give you the +best display possible in your environment. If you do not like the +results, you may set the variable to a different value or +@code{nil}. + + +@node External display, Displaying images, Internal display, @acronym{MIME} Messages +@unnumberedsubsec External display of @acronym{MIME} attachments + +@vindex vm-mime-external-content-types-alist +For types that you want displayed externally, set the value +of @code{vm-mime-external-content-types-alist} to specify external +viewers for the types. The value of this variable should be an +associative list of @acronym{MIME} content types and the external programs +used to display them. If VM cannot display a type internally or +a type is not listed in @code{vm-mime-internal-content-types} VM will +try to launch an external program to display that type. + +The alist format is a list of lists, each sublist having the form + +@example +(@var{TYPE} @var{FUNCTION} @var{ARG} @var{ARG} ... ) +@end example + +@noindent or + +@example +(@var{TYPE} @var{PROGRAM} @var{ARG} @var{ARG} ... ) +@end example + +@noindent or + +@example +(@var{TYPE} @var{COMMAND-LINE}) +@end example + +@noindent @var{TYPE} is a string specifying a @acronym{MIME} type or +type/subtype pair. For example ``text'' or ``image/jpeg''. If a +top-level type is listed without a subtype, all subtypes of that type +are assumed to be included. + +In the first form, @var{FUNCTION} is a lisp function that is responsible +for displaying the attachment in an external application. Any +@var{ARG}s will be passed to the function as arguments. The octets that +compose the object will be written into a temporary file and the name of +the file is passed as an additional argument. + +In the second form, @var{PROGRAM} is a string naming a program to +run to display an object. Any @var{ARG}s will be passed to the +program as arguments. The octets that compose the object will be +written into a temporary file and the name of the file can be +inserted into an @var{ARG} string by writing @samp{%f} in the +@var{ARG} string. In earlier versions of VM the filename was +always added as the last argument; as of VM 6.49 this is only done +if @samp{%f} does not appear in any of the @var{ARG} strings. + +If the @var{COMMAND-LINE} form is used, the program and its +arguments are specified as a single string and that string is +passed to the shell ("sh -c" typically) for execution. Since +the command line will be passed to the shell, you can use shell +variables and input/output redirection if needed. As with the +@var{PROGRAM/ARGS} form, the name of the temporary file that +contains the @acronym{MIME} object will be appended to the command line if +@samp{%f} does not appear in the command line string. + +In either the @var{PROGRAM/ARG} or @var{COMMAND-LINE} forms, all the +program and argument strings will have any %-specifiers in +them expanded as described in the documentation for the +variable @code{vm-mime-button-format-alist}. The only difference +is that @samp{%f} refers to the temporary file VM creates to store +the object to be displayed, not the filename that the sender +may have associated with the attachment. + +Example: + +@example +(setq vm-mime-external-content-types-alist + '( + ("text/html" browse-url-of-file) + ("image/gif" "xv") + ("image/jpeg" "xv") + ("video/mpeg" "mpeg_play") + ("video" w32-shell-execute "open") + ) +) +@end example + +The first matching list element will be used. + +No multipart message will ever be sent to an external viewer. + +External viewer processes are normally killed when you select +a new message in the current folder. If you want viewer +processes to not be killed, set +@code{vm-mime-delete-viewer-processes} to a @code{nil} value. + +Any type that cannot be displayed internally or externally or +converted to a type that can be displayed, will be displayed as a +button that allows you to save the body to a file. + +@vindex vm-mime-external-content-type-exceptions +As with the internal type list, there is an exception list that +you can use to specify types that you do not want displayed +externally. When VM is considering whether it should +automatically launch an external viewer, it will consult the +variable @code{vm-mime-external-content-type-exceptions}. If the +type to be displayed is listed, VM will not launch a viewer. +This allows you to setup viewers for types that ordinarily you +would not want VM to display or for types that you normally want +to convert to some other type using @code{vm-mime-type-converter-alist}. +You can still display such a type with an external viewer by using +@kbd{$ e}. + +@vindex vm-mime-attachment-auto-suffix-alist + +When a @acronym{MIME} object is displayed using an external viewer VM must +first write the object to a temporary file. The external viewer +then opens and displays that file. Some viewers will not open a +file unless the filename ends with some extension that it +recognizes such as @samp{.html} or @samp{.jpg}. You can use the +variable @code{vm-mime-attachment-auto-suffix-alist} to map @acronym{MIME} +types to extensions that your external viewers will recognize. +The value of this variable should be a list of type and suffix +pairs. The list format is: + +@example +((@var{TYPE} . @var{SUFFIX}) ...) +@end example + +@var{TYPE} is a string specifying a @acronym{MIME} top-level type or a type/subtype pair. +If a top-level type is listed without a subtype, all subtypes of +that type are matched. + +@var{SUFFIX} is a string specifying the suffix that should be used for +the accompanying type. + +Example: + +@example +(setq vm-mime-attachment-auto-suffix-alist + '( + ("image/jpeg" . ".jpg") + ("image/gif" . ".gif") + ("image/png" . ".png") + ("text" . ".txt") + ) +) +@end example + +@noindent VM will search the list for a matching type. The suffix +associated with the first type that matches will be used for the +temporary filename. + +@node Displaying images, @acronym{MIME} type conversion, External display, @acronym{MIME} Messages +@unnumberedsubsec Displaying inline images in messages + +@cindex images +Most versions of Emacs can display images when used on graphical +screens. You can verify if the Emacs version is able to do so by +calling the function @code{display-images-p}. However, Emacs relies +on external libraries to create graphical images, which are specified +through the variable @code{image-library-alist}. Even if Emacs has +the ability to display some image type, it cannot display such images +unless appropriate libraries are installed and specified to Emacs. You +can verify which image types are really available by calling the +function @code{image-type-available-p} with an image type such as +@samp{tiff} or @samp{gif} as the argument. + +@vindex vm-mime-internal-content-types +@vindex vm-mime-auto-displayed-content-types +Assuming that a particular image type, say @samp{tiff} is available, +you can include its @acronym{MIME} type in +@code{vm-mime-internal-content-types}, e.g., +@example +(add-to-list 'vm-mime-internal-content-types "image/tiff") +@end example +You can also add the @acronym{MIME} type to the variable +@code{vm-mime-auto-displayed-content-types} so that VM will +automatically display all images of the type. +If the type is not included among the auto-displayed types, then the +image is initially shown as a button with a thumbnail image. Clicking on the +button with the middle mouse button expands the image to its full size. + +@cindex ImageMagick +@vindex vm-imagemagick-identify-program +@vindex vm-imagemagick-convert-program +Once an image is displayed, you can use the right mouse button to do +various image manipulations on it, such as enlarging/reducing it, +rotating it etc. To do such operations, VM uses the @samp{ImageMagick} +graphics manipulation software. You can install ImageMagick on your +system and specify the location of its @command{identify} and +@command{convert} programs to VM via the variables +@code{vm-imagemagick-identify-program} and +@code{vm-imagemagick-convert-program}. + +@vindex vm-mime-use-image-strips +By default, VM displays images by slicing them into contiguous +horizontal strips and displaying the strips in order. This +facilitates vertical scrolling within an image. The variable +@code{vm-mime-use-image-strips} controls whether VM uses strips for +image display. It is @samp{t} by default. + +VM also uses the ImageMagick's @code{convert} program to convert +between image formats, so that an image that is not displayable in +Emacs is converted to another format that is displayable. You can +turn off such conversion by setting the variable +@code{vm-imagemagick-convert-program} to @samp{nil}. + + +@node @acronym{MIME} type conversion, Character sets, Displaying images, @acronym{MIME} Messages +@unnumberedsubsec @acronym{MIME} type conversion + +@vindex vm-mime-type-converter-alist +Types that cannot be displayed internally or externally are +checked against an associative list of types that can be converted to other +types. If an object can be converted to a type that VM can +display, then the conversion is done and the new object is +subject to the auto-display rules which determine whether the +object is displayed immediately or a button is displayed in its +place. The conversion list is stored in the variable +@code{vm-mime-type-converter-alist}. + +The alist format is + +@example +( (START-TYPE END-TYPE COMMAND-LINE ) ... ) +@end example + +@var{START-TYPE} is a string specifying a @acronym{MIME} type or type/subtype pair. +Example @samp{"text"} or @samp{"image/jpeg"}. If a top-level type is +listed without a subtype, all subtypes of that type are assumed +to be included. + +@var{END-TYPE} must be an exact type/subtype pair. This is the type +to which @var{START-TYPE} will be converted. + +@var{COMMAND-LINE} is a string giving a command line to be passed to +the shell. The octets that compose the object will be written to +the standard input of the shell command. + +Example: + +@example +(setq vm-mime-type-converter-alist + '( + ("image/jpeg" "image/gif" "jpeg2gif") + ("text/html" "text/plain" "striptags") + ) +) +@end example + +@noindent The first matching list element will be used. + +@node Character sets, multipart/alternative, @acronym{MIME} type conversion, @acronym{MIME} Messages +@unnumberedsubsec @acronym{MIME} character sets + +For text type messages, @acronym{MIME} also requires that a character set +be specified, so that the recipient's mail reader knows what +character glyphs to use to display each character code. To +display a message properly VM needs to know how to choose a font +for a given character set. + +@vindex vm-mime-default-face-charsets +@cindex character sets +@cindex Windows-1252 +@cindex CP1252 +@cindex GB2312 +@cindex ISO-8859-1 +@cindex US-ASCII +The variable @code{vm-mime-default-face-charsets} tells VM what character +sets your default face can display. For most American and European +users using X Windows, Emacs' default face displays the ISO-8859-1 +and US-ASCII characters, US-ASCII being a subset of ISO-8859-1. +Additional character sets can be included if you think that the +messages only contain characters that your system can display. For +example, messages sent by a Chinese sender might declare the character +set to be GB2312 but the message might contain only English characters +that you might be able to display and read. Messages sent by Microsoft +Windows users might declare the character set to be Windows-1252 or +CP1252, but the majority of the characters might be in ISO-8859-1. By +including such character sets in @code{vm-mime-default-face-charsets}, +you might be able to view the majority of the characters even if your +system cannot fully handle the character set. + +The value of @code{vm-mime-default-face-charsets} must be a list of +strings specifying the character sets that your default face can +display. Example: + +@example +(add-to-list 'vm-mime-default-face-charsets "Windows-1251") +(add-to-list 'vm-mime-default-face-charsets "Windows-1252") +(add-to-list 'vm-mime-default-face-charsets "Windows-1257") +@end example + +Note that for character sets listed in this variable, VM's @acronym{MIME} +decoding is bypassed. So you should not add charsets like "UTF-8" +that require additional decoding. + +@vindex vm-mime-charset-converter-alist +@cindex UTF-8 +@cindex ISO-2022-JP +Sometimes a charset that VM cannot display can be converted to a +one that VM can display. An example would be a message encoded +using UTF-8 but in fact only contains Japanese characters. In +that case the message text could probably be converted to +iso-2022-jp which VM running on a MULE-enabled Emacs could +display. + +VM offers a way to do such conversions. The variable +@code{vm-mime-charset-converter-alist} is an associative list of @acronym{MIME} +charsets and programs that can convert between them. If VM +cannot display a particular character set, it will scan this list +to see if the charset can be converted into a charset that it can +display. + +The alist format is: + +@example + ( ( START-CHARSET END-CHARSET COMMAND-LINE ) ... ) +@end example + +@var{START-CHARSET} is a string specifying a @acronym{MIME} charset. +Example @samp{"iso-8859-1"} or @samp{"utf-8"}. + +@var{END-CHARSET} is a string specifying the charset to which +@var{START-CHARSET} will be converted. + +@var{COMMAND-LINE} is a string giving a command line to be passed to +the shell. The characters in @var{START-CHARSET} will be written to the +standard input of the shell command and VM expects characters +encoded in @var{END-CHARSET} to appear at the standard output of the +@var{COMMAND-LINE}. @var{COMMAND-LINE} is passed to the shell, so you can +use pipelines, shell variables and redirections. + +@cindex iconv +Example: + +@example +(setq vm-mime-charset-converter-alist + '( + ("utf-8" "iso-2022-jp" "iconv -f utf-8 -t iso-2022-jp -c") + ) +) +@end example + +The first matching list element will be used. Be sure to include the +@code{-c} option so that nonconvertible characters are ignored instead +of causing error messages. + +@vindex vm-mime-charset-font-alist +The variable @code{vm-mime-charset-font-alist} tells VM what font to use +to display a character set that cannot be displayed using +the default face. The value of this variable should be an +assoc list of character sets and fonts that can be used to display +them. The format of the list is: + +( (@var{CHARSET} . @var{FONT}) ...) + +@var{CHARSET} is a string naming a @acronym{MIME} registered character set such +as @samp{"iso-8859-5"}. + +@var{FONT} is a string naming a font that can be used to display +@var{CHARSET}. + +An example setup might be: + +@example +(setq vm-mime-charset-font-alist + '( + ("iso-8859-5" . "-*-*-medium-r-normal-*-16-160-72-72-c-80-iso8859-5") + ) +) +@end example + +@noindent This variable is only useful for character sets whose +characters can all be encoded in single 8-bit bytes. Also multiple +fonts can only be displayed if you're running under a window system +e.g. X Windows. So this variable will have no effect if you're +running Emacs on a tty. + +Note that under FSF Emacs 19 any fonts you use must be the +same height as your default font. XEmacs and Emacs 21 do not +have this limitation. Under Emacs 20 and beyond, and under +any XEmacs version compiled with MULE support, the value of +@code{vm-mime-charset-font-alist} has no effect. This is +because all characters are displayed using fonts discovered by +MULE and VM has no control over them. + +@node multipart/alternative, Inferring @acronym{MIME} types, Character sets, @acronym{MIME} Messages +@unnumberedsubsec @acronym{MIME} multipart/alternative + +@cindex @acronym{MIME} alternatives +@acronym{MIME} allows a message to be sent with its content encoded in multiple +formats, simultaneously, in the same message. Such messages have a +content type of @dfn{multipart/alternative}. The idea is that the sender +might have different @acronym{MIME} decoding or display capabilities than some +of his recipients. For instance, the sender may be able to compose a +message using fancy text formatting constructs like tables, italics +and equations but some of the recipients may only be able to display +plain text. The @samp{multipart/alternative} type message is the solution +to this dilemma. Such a message would contain at least two text +subparts, one in plain text and the other in the full featured text +formatting language that the sender used. + +@vindex vm-mime-alternative-show-method +@cindex @acronym{MIME} alternative, best +@cindex @acronym{MIME} alternative, best-internal +To control how VM displays @samp{multipart/alternative} messages, you must +set the variable @code{vm-mime-alternative-show-method}. Its value must be +a symbol. A value of @code{best} tells VM to display the message +using the subpart closest in appearance to what the sender used to +compose the message. In the example above this would mean displaying +the fully featured text subpart, if VM knows how to display that type. +VM will display the type either internally or externally. A +value of @code{best-internal} tells VM to use the closest subpart that +it can display internally. External viewers won't be used in this +case. A value of @code{all} asks VM to display all the alternatives. + +@cindex @acronym{MIME} alternative, favorite +@cindex @acronym{MIME} alternative, favorite-internal +The value can also be a list of the form + +@example + (favorite @var{TYPE} ...) +@end example + +@noindent with the first element of the list being the symbol @code{favorite}. +The remaining elements of the list are strings specifying @acronym{MIME} types. +VM will look for each TYPE in turn in the list of alternatives and +choose the first matching alternative found that can be displayed. If +instead of the symbol @code{favorite}, @code{favorite-internal} is +used then the first @var{TYPE} that matches an alternative that can be +displayed internally will be chosen. + +@findex vm-nuke-alternative-text/html +Messages with multiple alternatives use up extra file space and slow +down the operation of vm. If you would like keep the text/plain +alternatives but erase the text/html alternatives, you can use the +@code{vm-nuke-alternative-text/html} command. This operation may not +always be safe because the @code{text/html} alternative is often the +most faithful representation of the sender's message and it may +include attachments that are not replicated in the other +alternatives. Please use caution. + +@node Inferring @acronym{MIME} types, , multipart/alternative, @acronym{MIME} Messages +@unnumberedsubsec Inferring @acronym{MIME} types + +Some mailers incorrectly use the generic +@samp{application/octet-stream} type when sending files that +really have a specific @acronym{MIME} type. For example, a JPEG image +might be sent using @samp{application/octet-stream} type instead +of @samp{image/jpeg}, which would be the correct type. In many +cases the filename sent along with the mistyped file +(e.g. @file{foo.jpg}) suggests the correct type. + +@vindex vm-infer-mime-types +If the variable +@code{vm-infer-mime-types} is set non-@code{nil}, VM will attempt to use +the filename sent with a @acronym{MIME} attachment to guess an attachment's +type if the attachment is of type @samp{application/octet-stream}. + +@vindex vm-infer-mime-types-for-text +If the variable +@code{vm-infer-mime-types-for-text} is set non-@code{nil}, VM will +attempt to use filenames for attachments of type @samp{text/plain} as +well. + +@node Sending Messages, Saving Messages, Reading Messages, Top +@chapter Sending Messages + +When sending messages from within VM, you will be using the standard +mail sending facility provided with Emacs, plus some extensions added +by VM. @xref{Sending Mail,,,emacs, the GNU Emacs Manual}. Emacs +comes with two versions of mail sending packages, called ``mail mode'' +and ``message mode''. VM currently uses the ``mail mode'' package, +which is not too dissimilar to the ``message mode'' package. + +Even though VM's mail composition buffers will be in ``mail mode'', +they have some extra command keys. + +@table @kbd + +@findex vm-yank-message +@findex vm-yank-message-other-folder +@kindex C-c C-y +@item C-c C-y (@code{vm-yank-message}) +Copies a message from the folder that is the parent of this +composition into the mail composition buffer. +The message number is read from the minibuffer. By default, each line of +the copy is prepended with the value of the variable +@code{vm-included-text-prefix}. All message headers are yanked along +with the text. Point is left before the inserted text, the mark after. +Any hook functions bound to @code{mail-yank-hooks} are run, after inserting +the text and setting point and mark. If a prefix argument is given, +this tells VM: ignore @code{mail-yank-hooks}, don't set the mark, don't +prepend the +value of @code{vm-included-text-prefix} to every yanked line, and don't yank +any headers other than those specified in +@code{vm-visible-headers} and @code{vm-invisible-headers}. + +@item @code{M-x vm-yank-message-other-folder} +This allows one to yank a message from a different folder than the +parent of this composition. + +@kindex C-c C-v +@item C-c C-v <Any VM command key> +All VM commands may be accessed in a VM Mail mode buffer by prefixing them +with C-c C-v. +@kindex C-c C-a +@vindex vm-send-using-mime +@cindex drag and drop +@item C-c C-a (@code{vm-attach-file}) or drag-and-drop a file +Attaches a file to the composition. When you send the message, VM +will insert the file and @acronym{MIME} encode it. The variable +@code{vm-send-using-mime} must be set non-@code{nil} for this command to work. +You will be asked for the file's type, and a brief description of +the attachment. The description is optional. If the file's type +is a text type, you will also be asked for the character set +in which the text should be displayed. +The new attachment will appear as a highlighted tag in the +composition buffer. You can use mouse button 3 on this tag +to set the default content disposition of the attachment. The +content disposition gives a hint to the recipient's mailer how to +treat the attachment. Specifically the disposition will indicate +whether the attachment should be displayed along with the message +or saved to a file. Any text in the composition that appears +before the tag will appear in a @acronym{MIME} text part before the +attachment when the message is encoded and sent. Similarly, any +text after the tag will appear after the attachment in the +encoded message. If you change your mind about using the +attachment, you can remove it from the composition with @key{C-k}. +If you want to move the attachment to some other part of the message, +you can kill it @key{C-k} and yank it back with @key{C-y}. + +@kindex C-c C-m +@item C-c C-m (@code{vm-attach-message}) +Attaches a mail message to the composition. If invoked with a +prefix argument, the name of a folder is read from the minibuffer and +the message or messages to be attached are copied from that +folder. You will be prompted for the message number of the +message to be attached. If you invoke the command on marked +messages by running +@code{vm-next-command-uses-marks} first, the marked messages in +the selected folder will be attached as a @acronym{MIME} digest. +@kindex C-c C-b +@item C-c C-b (@code{vm-attach-buffer}) +Attaches an Emacs buffer to the composition. + +@findex vm-mime-encode-composition +@kindex C-c C-e +@kindex C-c C-c +@item C-c C-e (@code{vm-mime-encode-composition}) +Encodes the composition using @acronym{MIME}, but does not send it. This +is useful if you want to use PGP to sign a message before sending +it. After signing the message, you would use @kbd{C-c C-c} as usual to +send the message. Emacs' @code{undo} command can be used to undo +the encoding, so that you can continue composing the unencoded +message. + +@findex vm-preview-composition +@kindex C-c C-p +@item C-c C-p (@code{vm-preview-composition}) +Previews the current composition. The message is copied into a +temporary folder and you can read the message and interact with +it using normal VM mode commands to see how it might look to a +recipient. Type @key{q} to quit the temporary folder and resume +composing your message. + +@end table + +@findex vm-mail +@kindex m +The simplest command is @kbd{m} (@code{vm-mail}) which sends a mail +message much as @kbd{M-x mail} does but allows the added commands +described above. + +@code{vm-mail} can be invoked outside of VM by typing @kbd{M-x vm-mail}. +However, only (@code{vm-yank-message-other-folder}) will work; all the +other commands require a parent folder. + +If you send a message and it is returned by the mail system +because it was undeliverable, you can resend the message by +typing @kbd{M-r} (@code{vm-resend-bounced-message}). VM will +extract the old message and its pertinent headers from the +returned message, and place you in a VM Mail mode buffer. A +Resent-To header will be added, which you can fill in with +the corrected addresses of the recipients that bounced. You +can also added a Resent-Cc header, which has the same meaning +as a Cc header in a normal message. Mail will only be sent to +the addresses in the Resent-To and Resent-Cc headers unless +you delete both of those headers. In that case the To and Cc +headers will be used. + +@menu +* Sending Options:: Variables that control mail sending. +* Sending @acronym{MIME} Messages:: Sending a message using @acronym{MIME} attachments. +* Replying:: Describes the various ways to reply to a message. +* Forwarding Messages:: How to forward a message to a third party. +* Saving copies:: Saving copies of sent mail. +@end menu + +@node Sending Options, Sending @acronym{MIME} Messages, Sending Messages, Sending Messages +@section Mail Sending Options + +As already mentioned, VM uses Emacs @ref{Mail Mode,,,emacs, the Gnu +Emacs Manual} for sending email. Therefore, Mail Mode options +should be set to configure the mail sending. The extra options +provided by VM are described below. + +@vindex vm-mail-auto-save-directory +The variable @code{vm-mail-auto-save-directory} can be used to specify the +directory in which the message composition buffers should be auto-saved. If +it is nil, the @code{vm-folder-directory} is used for auto-saving. + +@vindex vm-mail-header-from +@vindex vm-mail-mode-hidden-headers +When a mail composition buffer is created, VM initializes it with +header lines that you can fill in. The @code{From} header is usually +standard and contains your email address. You can have VM fill it in +for you +automatically by setting the variable @code{vm-mail-header-from}. (It is +@code{nil} by default.) + +@vindex vm-mail-use-sender-address +The variable @code{vm-mail-use-sender-address}, if set to @code{t}, asks VM +to fill in the @code{To} header from the sender's name and address of the +current message. This has effect only when @code{vm-mail} is invoked from a +VM folder. When it is invoked from other buffers, the @code{To} headers is +unfilled. (Some people tend to use @code{vm-reply} to get this effect, but +that is a bad practice because it also tags the new message as a reply to an +older message.) + +The variable +@code{vm-mail-mode-hidden-headers} can be used to hide some of the +header lines from the mail composition buffer. By default, the +headers ``References'' and ``X-Mailer'' are hidden. + +@vindex vm-mail-header-insert-date +@vindex vm-mail-header-insert-message-id +@vindex vm-mail-reorder-message-headers +@vindex vm-mail-header-order +Additional header lines are created by VM before the composed message +is sent. The variable @code{vm-mail-header-insert-date} can be set to +@code{t} (which is the default value) asking VM to insert a Date +header into a message before it is sent. You should set it to +@code{nil} if you would like to insert a Date header yourself. The +variable @code{vm-mail-header-insert-message-id} asks VM to insert a +Message-ID header before sending the message. The variable +@code{vm-mail-reorder-message-headers} asks VM to reorder the message +headers into a particular order before sending. The order is +determined by the variable @code{vm-mail-header-order}. + + +@node Sending @acronym{MIME} Messages, Replying, Sending Options, Sending Messages +@section Sending @acronym{MIME} Messages + +@vindex vm-send-using-mime +To use VM's @acronym{MIME} composition features, you must have +@code{vm-send-using-mime} set to a non-@code{nil} value. With @acronym{MIME} composition +enabled, VM will allow you to add file attachments to your +composition and will analyze your message when you send it and +@acronym{MIME} encode it as necessary. + +@menu +* @acronym{MIME} attachments:: Sending a message using @acronym{MIME} attachments. +* @acronym{MIME} characters:: Sending a message with @acronym{MIME}-encoded characters. +* @acronym{MIME} headers:: Sending a message with @acronym{MIME}-encoded headers. +* @acronym{MIME} preview:: Previewing a @acronym{MIME} message before sending. +@end menu + +@node @acronym{MIME} attachments, @acronym{MIME} characters, Sending @acronym{MIME} Messages, Sending @acronym{MIME} Messages +@unnumberedsec @acronym{MIME} attachments + +@kindex C-c C-a +@findex vm-attach-file +To attach a file to your composition, use @kbd{C-c C-a} +(@code{vm-attach-file}). VM will ask you for the name of the +file, its type, a brief description and its character set if it is a +text attachment. + +An attachment will be represented in the composition as a tag line +like this + + [ATTACHMENT ~/sounds/chronophasia_scream.au, audio/basic] + +@noindent You can type text before and after this tag and it will appear +before or after the text in the final @acronym{MIME} message when VM encodes +it. You can kill the tag with @kbd{C-k} and yank it back with +@kbd{C-y} to move it to another place in the message. You can +yank back the tag multiple times to duplicate the attachment in +the message. Or you can leave the tag killed and the attachment +won't appear in the message when it is sent. + +@cindex Content-Disposition +If you click the right mouse button on the attachment tag, a menu +will appear that allows you to change the content disposition of +the attachment. The @dfn{Content-Disposition} of a @acronym{MIME} object +gives a mail reader a hint as to whether the object should be +displayed inline or as an inert tag or button that you must +activate in some fashion. @dfn{Inline} display usually means +that the object will be displayed within or alongside the message +text, if that is possible. @dfn{Attachment}, when used as a +content disposition, means that the object will likely be +displayed as a tag. By default, VM specifies an inline +disposition for all @acronym{MIME} types except @samp{application} and +@samp{model} types. + +@kindex C-c C-b +@findex vm-attach-buffer +To attach a buffer instead of a file, use @kbd{C-c C-b} (normally +bound to @code{vm-attach-buffer}. You must not kill the +buffer that you attach until after the message has been sent. + +@kindex C-c C-m +@findex vm-attach-message +You can attach a message from another folder by using @kbd{C-c C-m} +(@code{vm-attach-message}). By default, the folder is the parent +folder of the message composition. If there is no parent folder, then +a folder name will be read from the minibuffer. The message number of +the message to be attached is also read from the minibuffer. +Alternatively, you can mark one or more messages in the parent folder +before invoking this command. All the marked messages will be +attached as a digest in the outgoing message. + +@unnumberedsubsec Point-to-point attachment operations + +@cindex point-to-point attachment operations +A number of @dfn{point-to-point operations} allow you to attach objects +from other editing contexts to a message you are composing. + +@findex vm-dired-attach-file +@findex vm-dired-do-attach-files +You can visit a directory in Emacs (@pxref{Dired,,,emacs, the GNU +Emacs Manual}), and run @code{vm-dired-attach-file} on any file. The +file be attached to your message composition. You can also mark a set +of files in Dired and run @code{vm-dired-do-attach-files} to attach +all of them. + +@findex vm-dnd-attach-file +@cindex drag and drop +You can use your Window system to drag and drop a file into a +composition buffer (@code{vm-dnd-attach-file}). + +@kindex $ a +@findex vm-mime-reader-map-attach-to-composition +@findex vm-attach-message-to-composition +When you visit a folder in VM, you can attach a message from the +folder by running @code{vm-attach-message-to-composition}. When +viewing a message that has @acronym{MIME} attachments, you can attach any of +those attachments to your message composition by using the @kbd{$ a} +(@code{vm-reader-map-attach-to-composition}) function. +(@xref{Operating on @acronym{MIME} attachments}.) This operation is also +available on the pop-menu for attachments. + +In all these cases, you will be prompted for the message composition +buffer to which you would like to attach the objects. The default is +the latest message you have been composing, as indicated by the Emacs +buffer ring. + + + +@node @acronym{MIME} characters, @acronym{MIME} headers, @acronym{MIME} attachments, Sending @acronym{MIME} Messages +@unnumberedsec @acronym{MIME} characters + +@vindex vm-mime-7bit-composition-charset +By default, when you type text into a composition buffer VM +assumes that if all the character codes are less than 128, you +are using the US-ASCII character set and that is the character +set declared in the encoding of the message when it is sent. If +you are using some other character set, you must specify it by +setting the variable @code{vm-mime-7bit-composition-charset}. The +value of this variable should be a string specifying the character +set. + +@vindex vm-mime-8bit-composition-charset +If there are character codes in the composition greater than 128, the +variable @code{vm-mime-8bit-composition-charset} tells VM what character +set to assume when encoding the message. The default is +@samp{iso-8859-1}. + +Character codes greater than 128 may not be transported reliably +across the Internet in mail messages. Some machines will refuse +to accept messages containing such characters and some will accept +them but zero the eighth bit, garbling the message. To avoid +these problems, VM transfer encodes 8-bit text by default. + +@acronym{MIME} has two transfer encodings that convert 8-bit data to 7-bit data +for safe transport. @dfn{Quoted-printable} leaves the text mostly +readable even if the recipient does not have a @acronym{MIME}-capable mail +reader. @dfn{BASE64} is unreadable without a @acronym{MIME}-capable mail +reader. + +@vindex vm-mime-8bit-text-transfer-encoding +VM's text transfer encoding behavior is controlled by the +variable @code{vm-mime-8bit-text-transfer-encoding}. Its value should +be a symbol that specifies what kind of transfer encoding to do +for 8-bit text. A value of @samp{quoted-printable}, means to use +quoted-printable encoding. A value of @samp{base64} means to use +BASE64 encoding. A value of @samp{8bit} means to send the message as +is. Note that this variable usually only applies to textual @acronym{MIME} +content types. Images, audio, video, etc. typically will have +some attribute that makes VM consider them to be ``binary'', +which moves them outside the scope of this variable. For +example, messages with line lengths of 1000 characters or more +are considered binary, as are messages that contain carriage +returns (ASCII code 13) or NULs (ASCII code 0). + +@node @acronym{MIME} headers, @acronym{MIME} preview, @acronym{MIME} characters, Sending @acronym{MIME} Messages +@unnumberedsec @acronym{MIME} headers + +The internet standards specify that the header lines of messages should +always be in 7 bit ASCII, even if the body of a message can use an +8 bit character set. If you use other non-ASCII characters in typing +the headers then VM encodes their words using the @acronym{MIME} encoded-word +syntax, which is of the form @code{=?charset?encoding?encoded text?=}. + +@vindex vm-mime-encode-headers-regexp +@vindex vm-mime-encode-headers-type +The variable @code{vm-mime-encode-headers-regexp} specifies which +headers should be encoded in this way. By default, @samp{Subject}, +@samp{Organization}, @samp{From}, @samp{To}, @samp{CC}, @samp{Bcc} and +@samp{Resent-} header lines encoded. The words are encoded using +quoted-printable encoding (@kbd{Q}). You can ask VM to use the base64 +encoding by setting the variable @code{vm-mime-encode-headers-type}. + +@vindex vm-mime-encode-words.regexp +@vindex vm-mime-encode-headers-words-regexp +The variables @code{vm-mime-encode-words.regexp} and +@code{vm-mime-encode-headers-words-regexp} control what is +meant by a ``word'' for VM for the purpose of encoding. By default, the +words are those containing any 8 bit character and delimited by white +space characters. + +@node @acronym{MIME} preview, , @acronym{MIME} headers, Sending @acronym{MIME} Messages +@unnumberedsec @acronym{MIME} preview + +@kindex C-c C-p +To preview what a @acronym{MIME} message will look like to a recipient, +use @kbd{C-c C-p} (@code{vm-mime-preview-composition}). VM +will encode a copy of the message and present it to you in a +temporary mail folder. You can scroll through the message +using normal VM mail reading commands. Typing @kbd{q} in this +folder will return you to your composition where you can make +further changes. + +@kindex C-c C-e +@kindex C-c C-c +To encode a @acronym{MIME} message without sending it, use @kbd{C-c C-e} +(@code{vm-mime-encode-composition}). This is useful if you use +PGP and want to sign a message before sending it. VM will encode +the message for transport, inserting all necessary headers and +boundary markers. You can then sign the message and send it with +C-c C-c and be confident that VM won't invalidate the signature +by making further modifications to the message. Or if you want +to resume editing the message you can run the Emacs @code{undo} +(normally bound to @kbd{C-x u}) command which will revert the +encoded @acronym{MIME} bodies back to tags and you can continue entering +your composition. + + +@node Replying, Forwarding Messages, Sending @acronym{MIME} Messages, Sending Messages +@section Replying + +@vindex vm-reply-subject-prefix +VM has special commands that make it easy to reply to a message. When a +reply command is invoked, VM fills in the subject and recipient headers +for you, since it is apparent whom the message should be sent to and +what the subject should be. There is an old convention of prepending +the string @samp{Re: } to the subject of replies if the string isn't +present already. You can customize the string to be prepended in this +way by setting the variable @code{vm-reply-subject-prefix}. Its value +should be a string to prepend to the subject of replies, if the string +isn't present already. A @code{nil} value means don't prepend anything +to the subject (this is the default). In any case you can edit any of +the message headers manually, if you wish. + +@vindex vm-included-text-prefix +VM also helps you cite material from the message to which you are +replying, by providing @dfn{included text} as a feature of some of the +commands. @dfn{Included text} is a copy of the message being replied to +with some prefix to each line so that the included text +can be distinguished from the text of the reply. By default, the +prefix string is @samp{> }. This can be customized via the variable +@code{vm-included-text-prefix}. + +The reply commands are: + +@table @kbd +@findex vm-reply +@kindex r +@item r (@code{vm-reply}) +Replies to the author of the current message. +@findex vm-reply-include-text +@kindex R +@item R (@code{vm-reply-include-text}) +Replies to the author of the current message and provides included text. +@findex vm-followup +@kindex f +@item f (@code{vm-followup}) +Replies to the all recipients of the current message. +@findex vm-followup-include-text +@kindex F +@item F (@code{vm-followup-include-text}) +Replies to the all recipients of the current message and provides +included text. +@end table + +These commands all accept a numeric prefix argument @var{n}, which if +present, causes VM to reply to the next (or previous if the argument is +negative) @var{n-1} messages as well as the current message. Also, all +the reply commands set the ``replied'' attribute of the messages to +which you are responding, but only when the reply is actually sent. The +reply commands can also be applied to marked messages. (@pxref{Marking +Messages}.) + +@vindex vm-reply-ignored-addresses +If you are one of multiple recipients of a message and you use @kbd{f} +and @kbd{F}, your address will be included in the recipients of the +reply. You can avoid this by judicious use of the variable +@code{vm-reply-ignored-addresses}. Its value should be a list of +regular expressions that match addresses that VM should automatically +remove from the recipient headers of replies. The default value is +@code{nil}, which means that no addresses are removed. + +@vindex vm-in-reply-to-format +The variable @code{vm-in-reply-to-format} specifies the format of the +In-Reply-To header that is inserted into the header section of the reply +buffer. Like @code{vm-included-text-attribution-format}, +@code{vm-in-reply-to-format} should be a string similar to that of +@code{vm-summary-format}. A @code{nil} value causes the In-Reply-To +header to be omitted. If the format includes elements that can contain +non-ASCII characters, then @samp{In-Reply-To} should be added to +@code{vm-mime-encode-headers-regexp}. + +@vindex vm-strip-reply-headers +The recipient headers generated for reply messages are created by +copying the appropriate headers from the message to which you are +replying. This includes any full name information, comments, etc. in +these headers. If the variable @code{vm-strip-reply-headers} is +non-@code{nil}, the recipient headers will be stripped of all information +except the actual addresses. + +@unnumberedsubsec Included text + +As mentioned above, the commands @code{vm-reply-include-text} and +@code{vm-followup-include-text} provide ``included text'' from the +original message in your reply. In addition, you can use @kbd{C-c C-y} +(@code{vm-yank-message}) inside a mail buffer to include text from any +desired mail message. This is a more general mechanism for citing +message text in the composed message. (The composed message does not +have to be a reply. Neither do the cited messages have to be the +messages you are replying to.) + +@cindex attachment button +Citing message text is a tricky business because the original message +could be a @acronym{MIME} message with encoded text or formatted text along with +embedded images and attachments. By default, VM uses its @acronym{MIME} +displaying mechanism to extract the included text to be cited in +replies. The quoted text is then similar to what appears in the +message Presentation buffer. However, the @acronym{MIME} attachments are not +included by default. They are shown in the message composition buffer +with @b{attachment buttons} labelled similar to: +@example +[DELETED ATTACHMENT mary.jpg, image/jpeg] +@end example +@noindent If you set the variable @code{vm-include-mime-attachments} then +the attachment buttons are converted to actual attachments before the +message is sent. The format of the button in this case looks like: +@example +[ATTACHMENT mary.jpg, image/jpeg] +@end example + +@cindex @acronym{MIME} alternatives +@vindex vm-mime-alternative-yank-method +When citing a @code{multipart/alternative} @acronym{MIME} component, VM chooses the +alternative specified by the variable +@code{vm-mime-alternative-yank-method}. It can +be defined similar to the variable +@code{vm-mime-alternative-show-method}. (@pxref{multipart/alternative}.) + +@vindex vm-fill-paragraphs-containing-long-lines-in-reply +@vindex vm-fill-long-lines-in-reply-column +If the included text contains long lines, i.e., lines longer than the +normal window width, you might want to fill paragraphs. You can invoke +automatic filling of paragraphs by setting the variable +@code{vm-fill-paragraphs-containing-long-lines-in-reply}. Like its +namesake used in message presentation (@pxref{Paging}), it should be +set to a positive numerical value N or the symbol @code{window-width}. +Setting it to @code{nil} disables paragraph filling. If filling is +used, the fill column is controlled by the variable +@code{vm-fill-long-lines-in-reply-column}. + +Alternatively, you can fill individual paragraphs manually using +@kbd{C-c C-q} (@code{mail-fill-yanked-message}). + +@unnumberedsubsec Alternative methods to include text + +The method of @acronym{MIME} decoding for included text is relatively new in VM. +The older methods are the inclusion of plain text, due to Kyle Jones, +and the inclusion of text from the Presentation buffer, due to Robert +Fenk. + +@vindex vm-included-mime-types-list +@vindex vm-include-text-basic +The Kyle Jones method of plain text inclusion is enabled by setting +the variable @code{vm-include-text-basic} to @code{t}. Setting the +variable to nil returns you to the default behaviour. You can set the +variable @code{vm-included-mime-types-list} to additional @acronym{MIME} +type/subtype pairs that should be included in cited text. But it may +not produce good results because the handling of @acronym{MIME} types is not +available in the basic text inclusion method. + +@vindex vm-include-text-from-presentation +The Robert Fenk method of text inclusion from the Presentation buffer is +enabled by setting the variable @code{vm-include-text-from-presentation} +to t. In this case, the text display from the Presentation buffer is +copied verbatim as the quoted text. + +@unnumberedsubsec Options + +@vindex vm-included-text-attribution-format +The variable @code{vm-included-text-attribution-format} specifies the +format for the attribution of the included text. The @dfn{attribution} is a +line of text that tells who wrote the text that is to be included; it +will be inserted before the included text. If non-@code{nil}, the value +of @code{vm-included-text-attribution-format} should be a string format +specification similar to @code{vm-summary-format}. @xref{Summaries}. A +@code{nil} value causes the attribution to be omitted. + +@vindex vm-included-text-headers +@vindex vm-included-text-discard-header-regexp +VM normally includes only the body text from the cited messages. If you +wish, you can include also the message headers by customizing +the variables @code{vm-included-text-headers} and +@code{vm-included-text-discard-header-regexp}. + +@node Forwarding Messages, Saving copies, Replying, Sending Messages + +@section Forwarding Messages + +VM has four commands to forward messages: @kbd{z} +(@code{vm-forward-message}), +@kbd{Z} (@code{vm-forward-message-plain}), +@kbd{@@} (@code{vm-send-digest}) and +@kbd{B} (@code{vm-resend-message}). + +@unnumberedsubsec Forwarding + +@findex vm-forward-message +@kindex z +Typing @kbd{z} (@code{vm-forward-message}) puts you into a VM Mail +mode buffer just like @kbd{m}, except that the current message appears +as the body of the message in the VM Mail mode buffer. + +@vindex vm-forwarding-digest-type +The forwarded message is encapsulated as specified by the variable +@code{vm-forwarding-digest-type}. Recognized values are @code{nil}, "mime", +"rfc934" and "rfc1153". The default is "mime". + +If @code{vm-forwarding-digest-type} is set to @code{nil}, the forwarded +message is not encapsulated. It is included in a plain text form. Any +attachments of the original message appear as attachment buttons in the +composition. They will be replaced by actual attachments when the message +is sent. + +@findex vm-forward-message-plain +@kindex Z +The key @kbd{Z} (@code{vm-forward-message-plain}) allows you to use +plain-text forwarding directly, without needing to alter +@code{vm-forwarding-digest-type}. + +@vindex vm-forwarded-headers +@vindex vm-unforwarded-header-regexp +@vindex vm-forwarded-headers-plain +@vindex vm-unforwarded-header-regexp-plain +You can control which header lines are included in forwarded messages via +the variables @code{vm-forwarded-headers} and +@code{vm-unforwarded-header-regexp} (and their counterparts +@code{vm-forwarded-headers-plain} and +@code{vm-unforwarded-header-regexp-plain} for plain-text forwarding). How +they are used differs based on the form of forwarding used. + +@itemize +@item +For encapsulated forwarding, the default is to forward all +the headers, but you can limit the forwarded headers by setting +@code{vm-unforwarded-header-regexp} to a regular expression. All the +headers matching the regular expression will be omitted. If this variable +is set to @code{nil}, then its value is ignored and only the headers listed +in @code{vm-forwarded-headers} are forwarded. +@item +For plain-text forwarding, done by the @kbd{Z} command, the variables +@code{vm-forwarded-headers-plain} and +@code{vm-unforwarded-header-regexp-plain} are used in a similar way. If the +latter is set to a regular expression, then the headers matching it are +omitted. Otherwise, only the headers listed in +@code{vm-forwarded-headers-plain} are included. The default settings +forward only the headers ``From'', ``To'', ``Cc'', ``Subject'', ``Date'' and +``In-Reply-To''. +@end itemize + +@findex vm-forward-message-all-headers +The command @code{vm-forward-message-all-headers} forwards the +message with all headers intact, irrespective of the values of these +variables. + +@vindex vm-forwarding-subject-format +If the variable +@code{vm-forwarding-subject-format} is non-@code{nil} it should specify +the format of the Subject header of the forwarded message. A @code{nil} +value causes the Subject header to be left blank. The forwarded message +is flagged ``forwarded'' when the message is sent. + +@unnumberedsubsec Digests + +@findex vm-send-digest +@vindex vm-digest-send-type +@kindex @@ +The command @kbd{@@} (@code{vm-send-digest}) works like @kbd{z} except +that a digest of all the messages in the current folder is made and +inserted into the VM Mail mode buffer. Also, @code{vm-send-digest} can +be applied to just marked messages. @xref{Marking Messages}. When applied +to marked messages, @code{vm-send-digest} will only bundle marked +messages, as opposed to the usual bundling of all messages in the +current folder. The message encapsulation method is specified by the +variable @code{vm-digest-send-type}, which accepts the same values as +@code{vm-forwarding-digest-type}. All the messages included in the digest will +be flagged ``forwarded'' when the digest message is sent. + +@vindex vm-digest-preamble-format +@vindex vm-digest-center-preamble +If you give @code{vm-send-digest} a prefix argument, VM will insert a +list of preamble lines at the beginning of the digest, one line per +digestified message. The variable @code{vm-digest-preamble-format} +determines the format of the preamble lines. If the value of +@code{vm-digest-center-preamble} is non-@code{nil}, the preamble lines +will be centered. + +@unnumberedsubsec Resending + +@findex vm-resend-message +@kindex B +@cindex resending messages +@cindex Resent-To header +You can forward a message ``as is'', without appearing to +intervene, by @dfn{resending} it. +Use the @kbd{B} (@code{vm-resend-message}) command. VM will +resend the same original message and with its original headers and add +a @samp{Resent-To} header that you should fill in with the new +recipients. Use @kbd{C-c C-c} as usual to send the message. The +resent message will be flagged as ``redistributed''. Note that a +re-sent message will appear to the recipients as if it came from the +original sender. They will notice that you have re-sent the message +only if they are careful to look for the @code{Resent-To} header. If +they reply to the message, the reply will go to the original sender. +This behavior can be confusing to many users and, so, should be used +with caution. + +@node Saving copies,, Forwarding Messages, Sending Messages +@section Saving copies of sent mail + +@cindex FCC +@cindex file CC +@findex vm-imap-save-composition +You can save copies of outgoing mail messages in 'sent' folders by +adding an @samp{FCC:} header line to the composed message. The value +of the header should be either the full path name of a mail folder on +the file system or the maildrop specification of a folder on an @acronym{IMAP} +server. If you use @acronym{IMAP} folders for saving sent mail, you should also +add the function @code{vm-imap-save-composition} to the mail-mode's +@code{mail-send-hook} variable. + +@cindex @acronym{IMAP}-FCC +@vindex vm-imap-default-account +If you have multiple @acronym{IMAP} accounts, you might wish to save copies of +your replies separately in each @acronym{IMAP} account. This can be done by +adding an @samp{@acronym{IMAP}-FCC:} header line. The value of the header field +should be a plain folder name on the ``current'' @acronym{IMAP} account, e.g., +`Sent'. The ``current'' @acronym{IMAP} account will be determined by the @acronym{IMAP} +folder from which you start composing the new message (which is called +the ``parent folder'' for you composition). If the parent folder is +not an @acronym{IMAP} folder or if there is no parent folder, then the message +copy will be saved in a folder on @code{vm-imap-default-account}. + +@vindex vm-do-fcc-before-mime-encode +The variable @code{vm-do-fcc-before-mime-encode} allows you save the fcc +copy to the sent folder @i{before} mime-encoding the message. This is +useful if you want to save an unencrypted version of the message or +avoid saving attachments. However, the character coding of the sent +folder should be chosen carefully to allow proper storage of the +messages. + +@node Saving Messages, Deleting Messages, Sending Messages, Top +@chapter Saving Messages + +@cindex file locking +Mail messages are normally saved to files that contain only mail +messages. Such files are called @dfn{folders}. Folders are +distinguished from spool files in that VM does not expect other +programs to modify them while VM is visiting them. This is +important to remember. VM does no locking of folders when +visiting them. If the disk copy of a folder is modified behind +VM's back, Emacs will complain with the dreaded ``File changed +on disk'' message when you try to save the folder. + +@findex vm-save-message +@kindex s +The VM command to save a message to a folder is @kbd{s} +(@code{vm-save-message}); invoking this command causes the current +message to be saved to a folder whose name you specify in the +minibuffer. It can be given a prefix argument @var{n} to indicate how +many messages should be saved. Messages saved with +@code{vm-save-message} are flagged ``filed''. + +@vindex vm-folder-directory +@vindex vm-thunderbird-folder-directory +Messages can be saved to folders on the local file system or to +folders on an @acronym{IMAP} server. +If @code{vm-folder-directory} is set, @code{vm-save-message} will +insert this directory name into the minibuffer before prompting you +for a folder name; this will save you some typing. If +@code{vm-thunderbird-folder-directory} is set and you enter a Thunderbird +folder using @code{vm-visit-thunderbird-folder}, then that directory +will be the default place for saving messages. + +@vindex vm-auto-folder-alist +Another aid to selecting folders in which to save mail is the variable +@code{vm-auto-folder-alist}, described in detail below. Using the data +given in this alist, VM can examine the headers of the message and +automatically suggest an appropriate save folder where the message +should be saved. + +@vindex vm-imap-save-to-server +@cindex @acronym{IMAP} +If you use an @acronym{IMAP} server and prefer to save messages on other folders +on the same @acronym{IMAP} server, you can set the variable +@code{vm-imap-save-to-server} to t. You will be prompted for the name +of the @acronym{IMAP} folder in which to save the message. The variable +@code{vm-auto-folder-alist} can also be used to suggest appropriate save +folders on the @acronym{IMAP} server. + +@findex vm-save-message-to-local-folder +@findex vm-save-message-to-imap-folder +You can override the effect of @code{vm-imap-save-to-server} by using +the specialized commands @code{vm-save-message-to-local-folder} +and @code{vm-save-message-to-imap-folder}, which do what their names +indicate. + +@vindex vm-confirm-new-folders +If the value of the variable @code{vm-confirm-new-folders} is +non-@code{nil}, VM will ask for confirmation before creating a new +folder on interactive saves. + + +@vindex vm-visit-when-saving +VM can save messages to a folder in two distinct ways. The message can be +appended directly to the folder on disk, or the folder can be visited as +Emacs would visit any other file and the message appended to that +buffer. In the latter method you must save the buffer yourself to change +the on-disk copy of the folder. The variable @code{vm-visit-when-saving} +controls which method is used. A value of @code{t} causes VM to always +visit a folder before saving message to it. A @code{nil} value causes VM +to always append directly to the folder file. In this case VM will not +save messages to the disk copy of a folder that is being visited. This +restriction is necessary to insure that the buffer and on-disk copies of +the folder are consistent. If the value of @code{vm-visit-when-saving} is +not @code{nil} and not @code{t} (e.g. 0, the default), VM will append to +the folder's buffer if the buffer is currently being visited, otherwise VM +will append to the file itself. + +@vindex vm-delete-after-saving +@vindex vm-delete-after-archiving +After a message is saved to a folder, the usual thing to do next is to +delete it. If the variable @code{vm-delete-after-saving} is +non-@code{nil}, VM will flag messages for deletion automatically after +saving them. This applies only to saves to folders, not for the @kbd{w} +command. There is a separate variable +@code{vm-delete-after-archiving}, which +works like @code{vm-delete-after-saving} but applies to the @kbd{A} +(@code{vm-auto-archive-messages}) command (see below). + +@unnumberedsec vm-auto-folder-alist + +@vindex vm-auto-folder-alist +The variable @code{vm-auto-folder-alist} is used to specify +pattern-matching rules by which VM can determine an appropriate folder +in which to save a message. The value of this variable should be a +list of the form: + +@display +((@var{header-name} + (@var{regexp} . @var{folder-name}) ...) + ...) +@end display + +@noindent where @var{header-name} and @var{regexp} are strings, and +@var{folder-name} is a string or an s-expression that evaluates to a +string. The value of @var{folder-name} can be + +@itemize +@item +the absolute path name of a local folder, +@item +a relative path name -- relative to @code{vm-folder-directory} or the +@code{default-directory} of the currently visited folder, whichever is +non-nil, or +@item +the maildrop specification of an @acronym{IMAP} folder. +@end itemize + +If any part of the contents of the message header named by +@var{header-name} is matched by the regular expression +@var{regexp}, VM will evaluate the corresponding +@var{folder-name} and use the result as the default when +prompting for a folder to save the message in. + +When @var{folder-name} is evaluated, the current buffer will contain only +the contents of the header named by @var{header-name}. It is safe to +modify this buffer. You can use the match data from any @samp{\( @dots{} +\)} grouping constructs in @var{regexp} along with the function +@code{buffer-substring} to build a folder name based on the header information. +If the result of evaluating @var{folder-name} is a list, then the list will +be treated as another auto-folder-alist and will be descended +recursively. + +@vindex vm-auto-folder-case-fold-search +Whether matching is case-sensitive depends on the value of the variable +@code{vm-auto-folder-case-fold-search}. A non-@code{nil} value makes +matching case-insensitive. The default value is @code{t}, which means +matching is case-insensitive. Note that the matching of header names is +always case-insensitive because the Internet message standard RFC 822 +specifies that header names are case indistinct. + +@unnumberedsubsec Other commands + +@table @kbd +@findex vm-save-message-sans-headers +@item M-x vm-save-message-sans-headers +Saves a message or messages to a file without their headers. This +command responds to a prefix argument exactly as @code{vm-save-message} +does. Messages saved this way are flagged ``written''. +@findex vm-auto-archive-messages +@kindex A +@item A (@code{vm-auto-archive-messages}) +Save all unfiled messages that auto-match a folder via +@code{vm-auto-folder-alist} to their appropriate folders. Messages that +are flagged for deletion are not saved by this command. If invoked with a +prefix argument, confirmation will be requested for each save. +@findex vm-pipe-message-to-command +@kindex || +@item || (@code{vm-pipe-message-to-command}) +Runs a shell command with some or all of the current message as input. +By default, the entire message is used. However, the leading and +trailing message separator lines are not included. When applied to +multiple messages, the command is invoked on each message individually.@* +If invoked with one @t{C-u} the text portion of the message is used.@* +If invoked with two @t{C-u}'s the header portion of the message is used.@* +In invoked with three @t{C-u}'s the visible headers and the text +portions of the message are used.@* +If the shell command generates any output, it is displayed in a +@samp{*Shell Command Output*} buffer. The message itself is not altered. +@findex vm-pipe-message-to-command-discard-output +@kindex |d +@item |d (@code{vm-pipe-message-to-command-discard-output}) +Runs a shell command with some or all of the current message as input, +like the above, but will not display the output. +@findex vm-pipe-messages-to-command +@vindex vm-pipe-messages-to-command-start +@vindex vm-pipe-messages-to-command-end +@kindex |s +@item |s (@code{vm-pipe-messages-to-command}) +Runs a shell command using as input the current message or marked +messages in the mbox format. In contrast to +@code{vm-pipe-message-to-command}, the leading and trailing separator +lines are included. This behaviour can be altered using the variables +@code{vm-pipe-messages-to-command-start} and +@code{vm-pipe-messages-to-command-end}. +@findex vm-pipe-messages-to-command-discard-output +@kindex |n +@item |n (@code{vm-pipe-messages-to-command-discard-output}) +Runs a shell command using as input the current message or marked +messages in the mbox format, but will not display the output. +@end table + +@vindex vm-berkeley-mail-compatibility +A non-@code{nil} value of @code{vm-berkeley-mail-compatibility} +means to read and write BSD @i{Mail(1)} style Status: headers. +This makes sense if you plan to use VM to read mail archives +created by @i{Mail}. + + +@node Deleting Messages, Editing Messages, Saving Messages, Top +@chapter Deleting Messages + +In VM, messages are flagged for deletion, and then are subsequently +@dfn{expunged} or removed from the folder. The messages are not removed +from the on-disk copy of the folder until the folder is saved. + +@table @kbd +@findex vm-delete-message +@kindex d +@item d (@code{vm-delete-message}) +Flags the current message for deletion. A prefix argument @var{n} +causes the current message and the next @var{n-1} messages to be flagged. +A negative @var{n} causes the current message and the previous @var{n-1} +messages to be flagged. +@findex vm-undelete-message +@kindex u +@item u (@code{vm-undelete-message}) +Removes the deletion flag from the current message. A prefix argument @var{n} +causes the current message and the next @var{n-1} messages to be undeleted. +A negative @var{n} causes the current message and the previous @var{n-1} +messages to be undeleted. +@findex vm-kill-subject +@kindex k +@item k (@code{vm-kill-subject}) +Flags all messages with the same subject as the current message (ignoring +``Re:'') for deletion. +@findex vm-kill-thread-subtree +@kindex K +@item K (@code{vm-kill-thread-subtree}) +Flags all messages in the thread subtree of the current message for +deletion. +@findex vm-delete-duplicate-messages +@item @code{vm-delete-duplicate-messages} +Flags duplicate messages for deletion. The duplicate messages are +detected by comparing message ID's. +@findex vm-delete-duplicate-messages-by-body +@item @code{vm-delete-duplicate-messages-by-body} +Flags duplicate messages for deletion. The duplicate messages are +detected by comparing message bodies. +@findex vm-expunge-folder +@kindex ### +@item ### (@code{vm-expunge-folder}) +Does the actual removal of messages flagged for deletion in the current +folder. +@end table + +@vindex vm-move-after-deleting +@vindex vm-move-after-killing +@vindex vm-move-after-undeleting +Setting the variable @code{vm-move-after-deleting} non-@code{nil} causes +VM to move past the messages after flagging them for deletion. Setting +@code{vm-move-after-undeleting} non-@code{nil} causes similar movement +after undeletes. Setting @code{vm-move-after-killing} non-@code{nil} +causes VM to move after killing messages with @code{vm-kill-subject}. +Note that the movement is done by calling @code{vm-next-message} which +means that the value of @code{vm-circular-folders} applies to the +post-command motion as for a motion command, not as for a non-motion +command. + +@vindex vm-expunge-before-save +@vindex vm-expunge-before-quit +Normally, deleted messages are preserved in folders until an explicit +@code{vm-expunge-folder} operation is done. This default behavior can +be altered by setting the variables @code{vm-expunge-before-save} and +@code{vm-expunge-before-quit}. If @code{vm-expunge-before-save} is +set to non-@code{nil}, then deleted messages are expunged whenever a +folder is saved. This is not an undo-able operation and no +confirmation is asked for. So you should use this setting only if +your normal workflow includes expunging messages as part of save. The +variable @code{vm-expunge-before-quit} can be similarly set to +non-@code{nil} to cause VM to expunge deleted messages whenever you +quit the folder. + +@cindex vm-save-folder-no-expunge +@cindex vm-quit-no-expunge +The commands @code{vm-save-folder-no-expunge} and +@code{vm-quit-no-expunge} can be used to preserve deleted messages in +the saved folders, irrespective of the settings of the above +variables. Giving a prefix argument to the @code{vm-quit} command has +the same effect as @code{vm-quit-no-expunge}. + +@findex vm-delete-duplicate-messages +The function @code{vm-delete-duplicate-messages} can be used to delete +duplicate copies of messages that arrive through various means. For +instance, if you are a member of a mailing list, every time somebody +responds to one of your messages, they might send the response to you +as well as the mailing list. You then receive two copies of the +response. If you get a lot of such duplicate copies, you might +consider invoking @code{vm-delete-duplicate-messages} automatically. +For instance, the customization in your VM init file can have: + +@example +(add-hook 'vm-arrived-messages-hook 'vm-delete-duplicate-messages) +@end example + +@noindent This causes the duplicate-deletion function +to be invoked every time new messages arrive so that you don't have to +worry about the duplicate copies any further. (@xref{Hooks}.) + + +@node Editing Messages, Marking Messages, Deleting Messages, Top +@chapter Editing Messages + +@kindex C-c C-e +@findex vm-edit-message +To edit a message, type @kbd{C-c C-e} (@code{vm-edit-message}). The +current message is copied into a temporary buffer, and this buffer is +selected for editing. The major mode of this buffer is controlled by the +variable @code{vm-edit-message-mode}. The default is Text mode. + +@kindex C-c ESC +@findex vm-edit-message-end +@kindex C-c C-] +@findex vm-edit-message-abort +Use @kbd{C-c ESC} (@code{vm-edit-message-end}) when you have finished +editing the message. The message will be inserted into its folder, +replacing the old version of the message. If you want to quit the edit +without your edited version replacing the original, use @kbd{C-c C-]} +(@code{vm-edit-message-abort}), or you can just kill the edit buffer +with @kbd{C-x k} (@code{kill-buffer}). + +If you give a prefix argument to @code{vm-edit-message}, then the +current message will be flagged unedited. + +As with VM Mail mode buffers, all VM commands can be accessed from +the edit buffer through the command prefix @kbd{C-c C-v}. + +@node Marking Messages, Message Attributes, Editing Messages, Top +@chapter Marking Messages + +@cindex marking +@cindex searching +@cindex virtual folders +VM provides a way to @dfn{mark} selected messages so that subsequent +operations can be applied to them. This is similar to marking in other +parts of Emacs, e.g., @xref{Marks vs Flags, Dired Marks, Dired Marks, +emacs}, but arguably more powerful. For example, one can mark all +messages from a particular sender and save them to a folder, or mark all +messages with a particular subject and print them. One can also mark +messages by searching for particular strings in their text. + +@kindex M M +To mark the current message, type @kbd{M M} +(@code{vm-mark-message}). If you give a numeric prefix argument +@var{n}, the next @var{n-1} messages will be marked as well. A negative +prefix argument means mark the previous @var{n-1}. An asterisk +(@samp{*}) will appear to the right of the message numbers of all marked +messages in the summary window. + +@kindex M U +To remove a mark from the current message, use @kbd{M U} +(@code{vm-unmark-message}). Prefix arguments work as with +@code{vm-mark-message}. + +@kindex M m +@kindex M u +Use @kbd{M m} to mark all messages in the current folder; @kbd{M u} +removes marks from all messages. + +Other marking commands: + +@table @kbd +@findex vm-mark-matching-messages +@kindex M C +@item M C (@code{vm-mark-matching-messages}) +Mark all messages matched by a virtual folder selector. +@xref{Virtual Folders}. +@findex vm-unmark-matching-messages +@kindex M c +@item M c (@code{vm-unmark-matching-messages}) +Unmark all messages matched by a virtual folder selector. +@findex vm-mark-thread-subtree +@kindex M T +@item M T (@code{vm-mark-thread-subtree}) +Mark all messages in the thread tree rooted at current message. +@xref{Threading}. +@findex vm-unmark-thread-subtree +@kindex M t +@item M t (@code{vm-unmark-thread-subtree}) +Unmark all messages in the thread tree rooted at current message. +@findex vm-mark-messages-same-subject +@kindex M S +@item M S (@code{vm-mark-same-subject}) +Mark messages with the same subject as the current message. +@findex vm-unmark-messages-same-subject +@kindex M s +@item M s (@code{vm-unmark-same-subject}) +Unmark messages with the same subject as the current message. +@findex vm-mark-messages-same-author +@kindex M A +@item M A (@code{vm-mark-same-author}) +Mark messages with the same author as the current message. +@findex vm-unmark-messages-same-author +@kindex M a +@item M a (@code{vm-unmark-same-author}) +Unmark messages with the same author as the current message. +@end table + +While the above commands can be used in any VM buffer, the following +commands can be used in a Summary buffer to mark or unmark a region of +message summary lines. + +@table @kbd +@findex vm-mark-summary-region +@kindex M R +@item M R (@code{vm-mark-summary-region}) +Mark all messages in the current region in a Summary buffer +@findex vm-unmark-summary-region +@kindex M r +@item M r (@code{vm-unmark-summary-region}) +Unmark all messages in the current region in a Summary buffer +@end table + +To apply a VM command to all marked messages you must prefix it with the +key sequence @kbd{M N} (@code{vm-next-command-uses-marks}). The next VM +command will apply to all marked messages, provided the command can be +applied to such messages in a meaningful and useful way. Unfortunately, +as of this writing, this mechanism works only if the next command +invoked is a keyboard command. Commands invoked by @kbd{M-x} are +unable to access the marked messages. So, to invoke a complex command, +you might temporarily bind it to an unused key, e.g., + +@example +M-x local-set-key C vm-forward-message-all-headers +M N C +@end example + +@noindent forwards marked messages with all headers included. + +It is possible to use marking to execute operations on message +threads. For example, the sequence of key strokes: + +@example +MuMTMNsMu +@end example + +@noindent saves a thread of messages. However, there are faster methods to +operate on message threads. @xref{Thread Operations}. + +@node Message Attributes, Sorting Messages, Marking Messages, Top +@chapter Message Attributes +@cindex message attributes + +Each message in a folder has a set of attributes that VM will remember +from session to session. Various VM commands set and unset these +attributes. Here are the attributes maintained by VM. + +@table @code +@item new +The message was retrieved from a spool file during this +visit of the current folder. +@item unread +The message was retrieved from a spool file during some +past visit of the folder but is still unread. +@item filed +The message has been saved to some folder. +@item written +The body of the message has been saved to a file. +@item edited +The message has been altered (with @code{vm-edit-message}) since it arrived. +@item deleted +The message is deleted and will be removed from the folder +at the next expunge. +@item forwarded +The message has been forwarded with either +@code{vm-forward-message}, @code{vm-send-digest} or one of their variants. +@item redistributed +The message has been forwarded with the +@code{vm-resend-message} command. +@item replied +The message has been replied to. +@end table + +@findex vm-set-message-attributes +You can set and unset these attributes directly by using +@code{M-x vm-set-message-attributes}. You will be prompted in the +minibuffer for names of the attributes and you can enter them with +completion. Every attribute has an ``un-'' prefixed name you can use +to unset the attribute, excepting ``new'' and ``unread'', which are both +negated by ``read''. You can use a prefix argument with this command to +affect multiple messages, and you can apply this command to marked +messages with @kbd{M N}. + +@findex vm-undo +@kindex C-x u +@kindex C-_ +@cindex undo +VM provides a special form of undo which allows changes to message +attributes to be undone. Typing @kbd{C-x u} or @key{C-_} +(@code{vm-undo}) undoes the last attribute change. Consecutive +@code{vm-undo}'s undo further and further back. Any intervening command +breaks the undo chain, after which the undo's themselves become undoable +by subsequent invocations of @code{vm-undo}. + +Note that expunges, saves and message edits are @emph{not} undoable. + +@findex vm-add-message-labels +@findex vm-delete-message-labels +@kindex l a +@kindex l d +@cindex message labels +@dfn{Labels} are user-defined message attributes. They can have any +name and be assigned any meaning by you. Labels are added with +@kbd{l a} (@code{vm-add-message-labels} and @kbd{l e} +(@code{vm-add-existing-message-labels}, and are removed by @kbd{l d} +(@code{vm-delete-message-labels}). BABYL format folders use labels to +store basic attributed like ``deleted'' and ``unread''. When visiting a +BABYL folder VM uses these labels also in order to be compatible with +other BABYL mailers. The labels used are ``recent'', ``unseen'', +``deleted'', ``answered'', ``forwarded'', ``redistributed'', ``filed'', +``edited'' and ``written''. If (and only if) you are using BABYL format +folders, you should not use these label names for your own purposes. + +@vindex vm-flush-interval +@cindex auto-save +All message attributes are stored in the folder. In order for +attribute changes to be saved to disk, they must be written to +the folder's buffer prior to the buffer being saved. The +variable @code{vm-flush-interval} controls how often that is done. A +value of @code{t} means write the new attributes to the folder +buffer whenever a change occurs. A value of @code{nil} means +wait until just before the folder is saved before writing out the +attributes. VM will work faster with this setting, but if Emacs +or your system crashes, the auto-save file will contain no useful +data pertaining to message attribute changes. The auto-save file +will still reflect message edits and expunges. @xref{Crash +Recovery}. A positive integer value @var{n} instructs VM to write +out attribute changes every @var{n} seconds. The default value +of this variable is @code{t}. + +@node Sorting Messages, Digests, Message Attributes, Top +@chapter Sorting Messages + +@cindex sorting +@findex vm-sort-messages +@vindex vm-move-messages-physically +@kindex G +In order to make numerous related messages easier to cope with, VM +provides the command @kbd{G} (@code{vm-sort-messages}), which sorts +all messages in a folder using one or more sort keys. +By default the actual order of the messages in the folder is not +altered; that is, if you looked at the folder file outside of VM the +message order would be unchanged. VM numbers and presents the messages +in a different order internally. If you want the message order to be +changed in the folder so that other programs can see the change, you +can either invoke @code{vm-sort-messages} with a prefix argument, or +you can set @code{vm-move-messages-physically} non-@code{nil} before +sorting. Either way, VM will shift the actual messages around in the +folder buffer, and when you save the folder, the order change will be +visible to other programs. + +@cindex spam +Valid sort keys are: +@multitable @columnfractions 0.35 0.60 +@item date @tab reversed-date +@item activity @tab reversed-activity +@item author @tab reversed-author +@item subject @tab reversed-subject +@item recipients @tab reversed-recipients +@item line-count @tab reversed-line-count +@item byte-count @tab reversed-byte-count +@item physical-order @tab reversed-physical-order +@item spam-score @tab reversed-spam-score +@end multitable + +@cindex delivery date +@vindex vm-sort-messages-by-delivery-date +The sort key @code{date} represents the date and time of the message. +Normally, this is the date when the message was sent by the sender. Note +that the message could have been ``queued'' after it was sent, either on the +sender's machine, on some server on the network, or in a mailing list +moderator's tray. It is not uncommon for messages to arrive much later than +their sent date. Setting the variable +@code{vm-sort-messages-by-delivery-date} to @code{t} causes VM to use the +delivery dates of messages rather than sent dates for sorting purposes. +(This assumes that your own mail server records the delivery date in a +@samp{Delivery-Date} header. If no such header is present, then VM uses the +sent date.) + +The sort key @code{activity} represents the date of the most recent +activity. This is the default sort order used with threads. +@xref{Threading}. It allows even old threads that have recent messages to +be brought to the front. + +@vindex vm-subject-ignored-prefix +@vindex vm-subject-ignored-suffix +When sorting by subject (or threading using subjects, or killing +messages by subject) the subject of the message is +@dfn{normalized} before comparisons are done. A @dfn{normalized} +subject has uninteresting prefixes and suffixes stripped off, and +multiple consecutive white space characters are collapsed to a single +space. The variable @code{vm-subject-ignored-prefix} should be +a regular expression that matches all strings at the beginning of +a subject that you do not want to be considered when message +subjects are compared. A @code{nil} value means VM should not ignore +any prefixes. The analogous variable for subject suffixes is +@code{vm-subject-ignored-suffix}. + +@vindex vm-subject-significant-chars +Once the subject has been normalized, the variable +@code{vm-subject-significant-chars} controls how much of what +remains is considered significant for matching purposes. The +first @code{vm-subject-significant-chars} will be considered +significant. Characters beyond this point in the subject string +will be ignored. A @code{nil} value for this variable means all +characters in the subject are significant. + +@vindex vm-spam-score-headers +@cindex spam +The sorting by @code{spam-score} is done by extracting spam scores +listed in the headers of the message, which are usually placed there by +external spam scoring programs such as SpamAssassin. Spam scores are +expected to be numbers, either integers or real numbers. The headers +that should be used for extracting spam scores are listed in the variable +@code{vm-spam-score-headers}. The variable is a list of triples, where each +triples contains a regular expression identifying the name of the header, a +regular expression matching the spam-score string on that header and a +function that VM can invoke to convert the spam-score string to a number. +Here is an example triple: + +@example +("X-Spam-Status:" "[-+]?[0-9]*\\.?[0-9]+" string-to-number) +@end example + +@noindent This triple causes VM to extract a spam-score from +@code{X-Spam-Status} headers. The first string on the header line that +matches the second regular expression is extracted and converted to a number +using the @code{string-to-number} function. The order in which the headers +are listed in @code{vm-spam-score-headers} is significant. The first header +that is found in the message is used as the spam score. + +If you want to move messages around by hand, use @kbd{C-M-n} +(@code{vm-move-message-forward}) and @kbd{C-M-p} +(@code{vm-move-message-backward}). The default is to move the current +message forward or backward by one message in the message list. A +prefix argument @var{n} can specify a longer move. The value of +@code{vm-move-messages-physically} applies to these commands. + +@menu +* Threading:: Using subjects and message IDs to group messages. +@end menu + +@node Threading,, Sorting Messages, Sorting Messages +@section Threading +@cindex threading +A @dfn{thread} is a group of messages that are either related by subject +or that have a common ancestor. @dfn{Threading} is the process of +determining the relationship between such messages and displaying them so +that those relationships are evident. + +@findex vm-toggle-threads-display +@vindex vm-summary-thread-indent-level +@vindex vm-summary-maximum-thread-indentation +To enable and disable threading, type @kbd{C-t} +(@code{vm-toggle-threads-display}). You will find that, in the +summary buffer, all related messages are grouped together and the +subject titles are indented to show hierarchical relationships. + +@vindex vm-thread-using-subject +@cindex header: References +@cindex header: In-Reply-To +@cindex header: Subject +Message relationships are discovered by examining the +@code{References}, @code{In-Reply-To}, and @code{Subject} headers. +The first two headers are more reliable sources of information but not +all mailers provide them. Therefore, all messages with similar +@code{Subject} headers are also grouped into threads. If you don't +want VM to use Subject headers for threading, set the variable +@code{vm-thread-using-subject} to @code{nil}. + +Unlike in previous versions of VM, threading is not a form of sorting. +You can sort threads by the usual sort keys and the sort order will +apply to at least the root messages of threads. Sorting threads by +subject, for instance, can be a quick way to find threads with similar +subject lines. Sorting them by date would sort them chronologically +according to when the threads were initiated. Sorting them by activity +is a variant of the chronological order where the dates of latest +activity are given prominence instead of the dates of the initial +messages. + +@vindex vm-sort-subthreads +Normally, thread-based grouping applies to entire threads as well as +all their subthreads. You can block subthread grouping by +setting the variable @code{vm-sort-subthreads} to @code{nil}. In that +case, all the internal messages of the threads are sorted by the +chosen sort order, e.g., by date, author etc. instead of being grouped +into subthreads. + +The value of the variable @code{vm-move-messages-physically} applies +to threading just as it applies to sorting. + +@node Digests, Summaries, Sorting Messages, Top +@chapter Digests + +A @dfn{digest} is one or more mail messages encapsulated within another +message. + +VM supports digests by providing a command to ``burst'' them into their +individual messages. These messages can then be handled like any other +messages under VM. + +@findex vm-burst-digest +The command (@code{vm-burst-digest}) bursts a digest into its +individual messages and appends them to the current folder. These +messages are then assimilated into the current folder as new messages. +The original digest message is not altered, and the messages extracted +from it are not part of the on-disk copy of the folder until a save is +done. You will be prompted for the type of digest to burst. VM +understands three formats, ``rfc934'', ``rfc1154'' and ``mime''. If you +don't know what kind of digest you've received, type ``guess'' and VM +will try to figure out the digest type on its own. VM is pretty smart +about digests and will usually make the correct choice if the digest is +properly formatted. + +@node Summaries, Virtual Folders, Digests, Top +@chapter Summaries + +@findex vm-summarize +@vindex vm-auto-center-summary +@vindex vm-summary-arrow +@kindex h +Typing @kbd{h} (@code{vm-summarize}) causes VM to display a summary of +contents of the current folder. The information in the summary is +automatically updated as changes are made to the current folder. An +arrow @samp{->} appears to the left of the line summarizing the current +message. The variable @code{vm-auto-center-summary} controls whether VM +will keep the summary arrow vertically centered within the summary +window. A value of @code{t} causes VM to always keep the arrow +centered. A value of @code{nil} (the default) means VM will never +bother centering the arrow. A value that is not @code{nil} and not +@code{t} causes VM to center the arrow only if the summary window is not +the only existing window. You can change what the summary arrow looks +like by setting @code{vm-summary-arrow} to a string depicting the new arrow. +You should set this variable before VM creates the summary buffer. + + +You can have a summary generated automatically at VM startup +by setting the variable @code{vm-startup-with-summary} non-nil. +@xref{Starting Up}. + +@vindex vm-follow-summary-cursor +All VM commands are available in the summary buffer just as they are in +the folder buffer itself. If you set @code{vm-follow-summary-cursor} +non-@code{nil}, VM will select the message under the cursor in the +summary window before executing commands that operate on the current +message. Note that this occurs @emph{only} when executing a command +from the summary buffer window. + +@vindex vm-gargle-uucp +A non-@code{nil} value of @code{vm-gargle-uucp} means to use a crufty +regular expression that does surprisingly well at beautifying UUCP +addresses that are substituted for @samp{%f} and @samp{%t} as part +of summary and attribution formats. + +@menu +* Summary Format:: Customizing the summary format +* Threaded Summaries:: How threading affects summaries +* Thread Folding:: Collapsing message threads in the summary +* Thread Operations:: Running bulk operations on message threads +* Summary Faces:: Decorating summary with fonts and colors +@end menu + +@node Summary Format, Threaded Summaries, Summaries, Summaries +@section Summary Format + +@vindex vm-summary-format +The variable @code{vm-summary-format} controls the format of each +message's summary. Its value should be a string. This string should +contain printf-like ``%'' conversion specifiers which substitute +information about the message into the final summary. + +Recognized specifiers are: +@table @code +@item a +attribute indicators (always four characters wide) +@* +The first char is `D', `N', `U' or ` ' for deleted, new, unread +and read messages respectively. +@* +The second char is `F', `W' or ` ' for filed (saved) or written +messages. +@* +The third char is `R', `Z' or ` ' for messages replied to, +and forwarded messages. +@* +The fourth char is `E' if the message has been edited, ` ' otherwise. +@item A +longer version of attributes indicators (seven characters +wide).@* +@* +The first char is `D', `N', `U' or ` ' for deleted, new, unread +and read messages respectively. +@* +The second is `r' or ` ', for message replied to. +@* +The third is `z' or ` ', for messages forwarded. +@* +The fourth is `b' or ` ', for messages redistributed. +@* +The fifth is `f' or ` ', for messages filed. +@* +The sixth is `w' or ` ', for messages written. +@* +The seventh is `e' or ` ', for messages that have been edited. +@vindex vm-summary-attachment-indicator +@item P +indicator for a message with attachments. +The variable +@vindex vm-summary-attachment-indicator +@code{vm-summary-attachment-indicator} is the inserted string, by default a @code{$}. +@item p +indicator for a postponed message. +The variable +@vindex vm-summary-postponed-indicator +@code{vm-summary-postponed-indicator} is the inserted string, by default a @code{P}. +@item c +number of characters in message (ignoring headers) +@item S +human readable size of the message +@item d +numeric day of month message sent +@item f +author's address +@item F +author's full name (same as f if full name not found) +@item h +hour:min:sec message sent +@item H +hour:min message sent +@item i +message ID +@item I +thread indentation +@item l +number of lines in message (ignoring headers) +@item L +labels (as a comma list) +@item m +month message sent +@item M +numeric month message sent (January = 1) +@item n +message number +@item s +message subject +@item t +addresses of the recipients of the message, in a comma-separated list +@item T +full names of the recipients of the message, in a comma-separated list +If a full name cannot be found, the corresponding address is used +instead. +@item U +user defined specifier. The next character in the format +string should be a letter. VM will call the function +vm-summary-function-<letter> (e.g. vm-summary-function-A for +``%UA'') in the folder buffer with the message being summarized +bracketed by (point-min) and (point-max). The function +will be passed a message struct as an argument. +The function should return a string, which VM will insert into +the summary as it would for information from any other summary +specifier. +@item w +day of the week message sent +@item y +year message sent +@item z +timezone of date when the message was sent +@item * +`*' if the message is marked, ` ' otherwise +@item ( +starts a group, terminated by %). Useful for specifying +the field width and precision for the concatenation of +group of format specifiers. Example: \"%.35(%I%s%)\" +specifies a maximum display width of 35 characters for the +concatenation of the thread indentation and the subject. +@item ) +ends a group. +@end table + +Use ``%%'' to get a single ``%''. + +A numeric field width may be specified between the ``%'' and the +specifier; this causes right justification of the substituted string. A +negative field width causes left justification. The field width may be +followed by a ``.'' and a number specifying the maximum allowed length +of the substituted string. If the string is longer than this value, it +is truncated. + +@vindex vm-summary-uninteresting-senders +@vindex vm-summary-uninteresting-senders-arrow +If you save copies of all your outbound messages in a folder and +later visit that folder, the @samp{%F} format specifier will normally +display your own name. If you would rather see the recipient +addresses in this case, set the variable +@code{vm-summary-uninteresting-senders}. This variable's value, +if non-@code{nil}, should be a regular expression that matches +addresses that you don't consider interesting enough to appear in +the summary. When such senders would be displayed by the @samp{%F} or +@samp{%f} summary format specifiers VM will substitute the value of +@code{vm-summary-uninteresting-senders-arrow} (default "To: ") +followed by what would be shown by the @samp{%T} and @samp{%t} specifiers +respectively. + +The summary format need not be one line per message but it must end with +a newline, otherwise the message pointer will not be displayed correctly +in the summary window. + +@findex vm-fix-my-summary +Summary lines are precomputed and cached in the folder buffer. If you +change the @code{vm-summary-format}, you need to force the cache to be +updated. You can do this by the command@code{vm-fix-my-summary}. + +@vindex vm-restore-saved-summary-format +Every folder can have its own summary format. The format is written +into the folder and saved on the disk. When you visit the folder +again, you can reuse the saved summary format. Set the variable +@code{vm-restore-saved-summary-format} to t to achieve this effect. + +@node Threaded Summaries, Thread Folding, Summary Format, Summaries +@section Threaded Summaries + +@findex vm-toggle-threads-display +@vindex vm-summary-thread-indent-level +@vindex vm-summary-maximum-thread-indentation +When message threading is enabled (@pxref{Threading}), +you will find that the +Summary buffer has all related messages are grouped together and the +subject titles are indented to show hierarchical relationships. +Parent messages are displayed before their children and children are +indented by a default two spaces to the right. The amount of +indentation per level is controlled by the variable +@code{vm-summary-thread-indent-level}. The default is two spaces. +The variable @code{vm-summary-maximum-thread-indentation} says how +many levels should be displayed via indentation. The default is 20. + +@vindex vm-summary-show-threads +If you want VM to always display summaries using threads, you should +set the default value of the variable @code{vm-summary-show-threads} +non-@code{nil} in your VM init file. Example: + +@example +(setq-default vm-summary-show-threads t) +@end example + +@noindent Do not use @code{setq}, as this will only set the value of +the variable in a single buffer. Once you've started VM you should +not change the value of this variable. Rather you should use +@kbd{C-t} to control the thread display. @xref{Threading}. + +@unnumberedsubsec Manual control of thread indentation + +When you deal with long discussions in mailing lists or newsgroups, +you would find that threads get very deep and their indentation in the +Summary window is not entirely helpful. You can temporarily promote +the subthreads to higher level so that you can view the threading +relationships more clearly. + +@kindex < +@findex vm-promote-subthread +The command @kbd{<} (@code{vm-promote-subthread}) temporarily +decreases the indentation of the current message and its subthread by +one step. You can give the command a numeric prefix argument N asking +it to decreasing indentation by N steps. Giving 0 as the prefix +argument has a special meaning. It says that the current message +should not be indented at all, effectively making it appear as the +root message of a thread. + +@kindex > +@findex vm-demote-subthread +The command @kbd{>} (@code{M-x vm-demote-subthread}) does the +opposite. It increases the indentation of the current message and its +subthread. You can specify the level of increased indentation as the +prefix argument. Giving 0 as the prefix argument has the special +meaning of asking VM to return the message to its standard indentation +as determined by its thread level. + +Both of these commands alter the thread indentation for the current +session only. The next time you visit the folder, the threads will be +displayed using the standard indentation. + + +@node Thread Folding, Thread Operations, Threaded Summaries, Summaries +@section Thread Folding + +A new feature in VM version 8.2 is that of ``folding'' message threads +in the summary window. This feature allows you to collapse all the +messages in a thread into a single line of the summary window, so that +you can see a more compact summary of the folder. + +@vindex vm-summary-enable-thread-folding +@findex vm-toggle-thread +@findex vm-expand-thread +@findex vm-collapse-thread +@findex vm-collapse-all-threads +@findex vm-expand-all-threads +@kindex T +Thread folding is enabled by setting the variable +@code{vm-summary-enable-thread-folding} to a non-nil value. The summary +window then has a folding indicator in the first column: with @code{-} +for threads that are expanded and @code{+} for threads that are +collapsed. The command @kbd{T} +(@code{vm-toggle-thread}) allows you to expand a collapsed thread or +collapse an expanded thread. The commands @code{vm-expand-thread} and +@code{vm-collapse-thread} implement the more specific versions of the +function. + +@vindex vm-summary-visible +When threads are folded, not all messages in the threads are hidden. +New messages that are yet unread continue to be visible. Which +messages remain visible in folded threads is controlled by the +variable @code{vm-summary-visible}, whose value must be a list of VM +selectors in the same format as those in +@code{vm-virtual-folder-alist}. @xref{Virtual Folders}. + +@vindex vm-summary-thread-folding-on-motion +The variable @code{vm-summary-thread-folding-on-motion} allows a more +automatic expansion/collapsing of threads. If the variable is set to +a non-nil value, then the usual motion commands @kbd{N} and @kbd{P} +(@code{vm-next-message-no-skip} and +@code{vm-previous-message-no-skip}) cause the threads to be expanded +or collapsed as needed when you move into or out of threads. + +@vindex vm-summary-show-thread-count +The variable @code{vm-summary-show-thread-count} allows a more +elaborate display of the thread information in the summary window. If +it is set to non-nil then the message number field of the summary line +includes a count of the messages in its thread, in the format +@code{N+C} where @code{N} is the message number and @code{C} is the +message count in the thread. This takes up 3 extra columns in the +summary lines. Set the variable to nil to obtain the more standard +format of the summary. + +@findex vm-expand-all-threads +@findex vm-collapse-all-threads +@kindex E +@kindex C +When thread folding is enabled, the Summary window starts out with all +the threads folded. You can expand all the threads in the folder +using the command @kbd{E} (@code{vm-expand-all-threads}). The command +@kbd{C} (@code{vm-collapse-all-threads}) does the reverse. + + +@node Thread Operations, Summary Faces, Thread Folding, Summaries +@section Thread Operations + +@vindex vm-enable-thread-operations +@findex vm-toggle-thread-operations +When you have thread-folding enabled, you can execute VM operations +such as saving and deleting messages on entire threads. To obtain +this functionality, set the variable +@code{vm-enable-thread-operations} to a non-@code{nil} value in your +vm-init-file. Setting it to `t' enables thread operations +unconditionally. Setting it to the symbol `ask' allows a confirmation +dialog before a thread operation is invoked. You can use the +command @code{vm-toggle-thread-operations} in a running VM session to +enable or disable thread operations. + +As an example, doing an @kbd{s} (@code{vm-save-message}) operation on +an ordinary message saves just the single message. However, if thread +operations are enabled and you invoke @kbd{s} on the +root message of a collapsed thread, then the entire thread is saved. +The same effect can be obtained using message marking. @xref{Marking +Messages}. The following sequence of key strokes can achieve the +effect of saving an entire thread: + +@example +MuMTMNsMu +@end example + +@noindent However, the thread-operation is simpler and more convenient. + +All operations that can be sensibly invoked on multiple messages +extend to thread operations in this way. They include deleting, +undeleting, marking, unmarking, forwarding, saving/deleting +attachments etc. Replying to messages cannot be invoked as a thread +operation, to prevent the accidental sending of replies to unintended +recipients. + +The thread operations can give rise to surprising behavior. Even +though it appears that an operation was invoked on a single message, +it actually applies to all the messages in a thread. So, care and +practice are warranted before you enable thread operations +unconditionally. A safer option is to set +`vm-enable-thread-operations' to `ask'. In that case, VM asks for +confirmation every time an operation is applicable to all the messages +in a collapsed thread. You can override the confirmation dialog by +giving a prefix argument `C-u' to your operation. + +@node Summary Faces,, Thread Operations, Summaries +@section Summary Faces + +@cindex faces +@cindex summary faces +By default, the summary of a folder is shown in a black-and-white +window with plain text. This is suitable for terminal mode Emacs +users. The variable @code{vm-summary-highlight-face}, which is set to +the standard Emacs @code{bold} face by default, is used to highlight +the currently selected message. You can set the variable to any other +face, or to nil if you wan to turn off highlighting. + +@findex vm-summary-faces-mode +@vindex vm-summary-enable-faces +You can turn on more elaborate faces support, suitable for color +graphics terminals, by setting the variable +@code{vm-summary-enable-faces} to t in your vm-init-file. You can +also run @code{M-x vm-summary-faces-mode} in the middle of a VM +session to turn on summary faces. Then VM decorates the summary lines +with different faces based on the attributes of the message. +@xref{Faces,,,emacs, the GNU Emacs Manual}, for basic information on +faces. The predefined faces used to highlight the summary window are +listed below. It is possible for you to change the definitions of +these faces in your vm-init-file as well as to define new faces of +your own. + +@vindex vm-summary-faces-alist +The variable @code{vm-summary-faces-alist} defines a list of +condition-action pairs for decorating the summary with faces. +It has the following form: + +@example +( ((@var{SELECTOR} [@var{ARG} ...]) @var{vm-summary-FACE}) + ... ) +@end example + +The first element of each pair is a VM selector in the same +format as used for @code{vm-virtual-folder-alist}. @xref{Virtual +Folders}. The second element is a face name of the form +@code{vm-summary-FACE} where @code{FACE} is one of the face types +listed below. The first condition +satisfied by the message wins, and the face listed there is used to +decorate its summary line. + +The faces @code{vm-summary-selected}, @code{vm-summary-collapsed} and +@code{vm-summary-expanded} are special. They are @i{added} to the face +specified by @code{vm-summary-faces-alist} instead of replacing it. +This allows VM to add highlighting for the selected message and the +collapsed/expanded thread roots, without scrubbing the natural face +determined by the message attributes. + +@vindex vm-mouse-track-summary +The variable @code{vm-mouse-track-summary} controls whether summary +entries are highlighted when the mouse pointer passes over +them. The highlighting is done using the standard Emacs +@code{highlight} face. + +@subsubheading Hiding summary lines +@cindex hiding summary lines +@cindex vm-summary-faces-hide +The command @code{vm-summary-faces-hide} allows you to hide the +summary lines of messages with a particular face type. By default, it +hides messages with the @code{deleted} face type. By invoking it with +a prefix argument, you can specify other face types that you might +like to hide. (Note that @code{deleted} face type does not necessarily +mean deleted messages. Whatever messages satisfy the condition +associated with the @code{vm-summary-deleted-face} in +@code{vm-summary-faces-alist} will be hidden.) + +@subsubheading Predefined summary faces +@cindex predefined summary faces +@anchor{predefined summary faces} +@itemize +@item vm-summary-high-priority: +Messages that are flagged or have other priority headers. +@item vm-summary-low-priority: +Messages that might be of low priority, by user-defined criteria. +@item vm-summary-deleted: +Deleted messages. +@item vm-summary-new: +New messages that have arrived during the session. +@item vm-summary-unread: +Messages that have not been read. +@item vm-summary-marked: +Messages currently marked. +@item vm-summary-replied: +Messages for which a reply has been sent. +@item vm-summary-saved: +Messages saved to a folder on disk. (Subsumes the earlier categories +filed and written.) +@item vm-summary-forwarded: +Messages forwarded to other recipients. (Subsumes the earlier +category redistributed.) +@item vm-summary-edited: +Messages edited after receipt. +@item vm-summary-outgoing: +Messages sent by you. +@item vm-summary-default: +Messages not matching any of the above criteria. +@item vm-summary-collapsed: +Root messages of threads that are collapsed. +@item vm-summary-expanded: +Root messages of threads that are expanded. +@item vm-summary-selected: +Message that is currently selected. +@end itemize + + +@node Virtual Folders, @acronym{IMAP} Server Folders, Summaries, Top +@chapter Virtual Folders + +@cindex searching +@cindex virtual folders + +A @dfn{virtual folder} is a mapping of messages from one or more +real folders into a container that in most ways acts like a +real folder but has no real existence outside of VM. You can have a +virtual folder that contains a subset of messages in a real folder +or several real folders. A virtual folder can also contain a +subset of messages from another virtual folder. + +@cindex search folders +@cindex interactive virtual folders +There are two ways of working with virtual folders. When you are +visiting a folder, you can use one or more selectors or search keys to +interactively create a virtual folder. We call such folders @dfn{search +folders}. You can browse through the +messages in the search folder and carry out actions on them which +will be reflected back to the original folder. When you are done, you +can quit the search folder and return to the original folder. + +@cindex defined virtual folders +@vindex vm-virtual-folder-alist +@kindex V V +@findex vm-visit-virtual-folder +A second way of using virtual folders is to define them through the +variable @code{vm-virtual-folder-alist}. You can visit such virtual +folders by typing @kbd{V V} (@code{vm-visit-virtual-folder}). Any +actions carried out on the virtual folder messages will be reflected +back to the underlying real folders. When you quit a virtual folder, all +its underlying real folders will also be quit, unless they were previously +visited in the Emacs session. We call such virtual folders +@dfn{defined virtual folders}. + +@menu +* Search Folders:: Virtual folders created interactively +* Defined Folders:: Virtual folders defined in advance +* Virtual Selectors:: Selectors used for creating virtual folders +* Working with Virtual Folders:: What you can do in a virtual folder +* vm-avirtual:: Automatic operations using virtual selectors +@end menu + +@node Search Folders, Defined Folders, Virtual Folders, Virtual Folders +@section Search Folders + +@findex vm-create-virtual-folder +@findex vm-create-search-folder +@kindex V C +The command @code{vm-create-search-folder} (bound to @kbd{V C}) lets you +interactively create a virtual folder from the messages of the current +folder, using exactly one selector to choose the messages. If you type +@kbd{V C header @key{RET} greeting}, VM will create a folder containing only +those +messages that contain the string @samp{greeting} in one of its headers. +@xref{Virtual Selectors}, for virtual selectors you can use for this +purpose. + +@findex vm-create-virtual-folder-of-threads +@findex vm-create-search-folder-of-threads +@kindex V T +The command @code{vm-create-search-folder-of-threads} (bound to @kbd{V T}) +lets you create a virtual folder in the same way, but consisting of entire +message threads. If a message thread contains any message matching the +given selector then it is included in the virtual folder. For instance, if +you type @kbd{V T author @key{RET} Peter} then all threads containing a message +authored by @samp{Peter} will be included in the virtual folder. + +@findex vm-apply-virtual-folder +@kindex V X +The command @code{vm-apply-virtual-folder} (bound to @kbd{V X}) tries +the selectors of a defined virtual folder against the messages of +the current folder and creates a virtual folder containing the +matching messages. + +@kindex V S +@kindex V A +@findex vm-create-virtual-folder-same-subject +@findex vm-create-virtual-folder-same-author +The commands @code{vm-create-virtual-folder-same-subject} (bound to @kbd{V +S} in version 7.19) and @code{vm-create-virtual-folder-same-author} (bound +to @kbd{V A} in version 7.19) create virtual folders containing all the +messages in the current folder with the same subject or author as the +current message. There are also short-cut key bindings for a number of +frequently used selectors: + +@kindex V a +@kindex V r +@kindex V s +@kindex V t +@kindex V d +@kindex V l +@kindex V ! +@kindex V n +@kindex V u +@findex vm-create-author-virtual-folder +@findex vm-create-author-or-recipient-virtual-folder +@findex vm-create-subject-virtual-folder +@findex vm-create-text-virtual-folder +@findex vm-create-date-virtual-folder +@findex vm-create-label-virtual-folder +@findex vm-create-flagged-virtual-folder +@findex vm-create-new-virtual-folder +@findex vm-create-unseen-virtual-folder +@table @kbd +@item V a (@code{vm-create-author-virtual-folder}) +@item V r (@code{vm-create-author-or-recipient-virtual-folder}) +@item V s (@code{vm-create-subject-virtual-folder}) +@item V t (@code{vm-create-text-virtual-folder}) +@item V d (@code{vm-create-date-virtual-folder}) +@item V l (@code{vm-create-label-virtual-folder}) +@item V ! (@code{vm-create-flagged-virtual-folder}) +@item V n (@code{vm-create-new-virtual-folder}) +@item V u (@code{vm-create-unseen-virtual-folder}) +@end table + + +@cindex searching +When you quit a search folder, the currently selected message +in the virtual folder becomes the current message in the underlying folder. +So, you can use the search folder facility to search for particular +messages. For example, if you knew that one of the messages with the +subject @samp{greeting} had a hotel offer and you wanted to find it, you can +first create a search folder of messages with subject @samp{greeting}, +browse through them to find the message that had the hotel offer, and then +quit the virtual folder. VM will return you to the copy of the same message +in the original folder. + +Search folders also form an efficient way to search for some string in the +text of messages. The key binding @kbd{V t} +(@code{vm-create-text-virtual-folder}) can be used to find all messages with +the string. This is more efficient than the @code{vm-isearch-forward} +command (@pxref{Selecting Messages}) because it only searches in the text part +of message bodies, not inside @acronym{MIME} attachments. + +@node Defined Folders, Working with Virtual Folders, Search Folders, Virtual Folders +@section Defined Virtual Folders + +@vindex vm-virtual-folder-alist +@findex vm-visit-virtual-folder +@kindex V V +A defined virtual folder is defined by its name, the folders that it +contains and its selectors. The variable +@code{vm-virtual-folder-alist} is a list of the definitions of all +such virtual folders. You can visit a virtual folder listed in +@code{vm-virtual-folder-alist} with the +@code{vm-visit-virtual-folder} (@kbd{V V}) command. + +Each virtual folder definition should have the following form: + +@example +(@var{VIRTUAL-FOLDER-NAME} + ( (@var{FOLDER} ...) + (@var{SELECTOR} [@var{ARG} ...]) ... ) + ... ) +@end example + +@var{VIRTUAL-FOLDER-NAME} is the name of the virtual folder being defined. +This is the name by which you and VM will refer to this folder. + +@var{FOLDER} should be the specification of a real folder: a file path for a +local folder or a maildrop specification for a @acronym{POP}/@acronym{IMAP} +folder. There may be more than one @var{FOLDER} listed, the @var{SELECTOR}s +within that sublist will apply to them all. If @var{FOLDER} is a directory, +VM will assume this to mean that all the folders in that directory should be +searched. + +The @var{SELECTOR} is a Lisp symbol that tells VM how to +decide whether a message should be included in the virtual +folder. (See below for a complete list of the possible selectors.) +Some @var{SELECTOR}s require an argument @var{ARG}; +unless otherwise noted, @var{ARG} may be omitted. When several +selectors are listed, messages matching any one of them are included. + +@cindex searching +@findex vm-isearch-forward +@findex vm-isearch-backward +The @code{text} selector provides a particularly effective way to search +for strings in messages. It is better than the +@code{vm-isearch-forward/backward} functions because it avoids searching +inside encoded attachments, hence faster. + +Here is an example that you may find useful as a template for +creating virtual folder definitions. + +@example +(setq vm-virtual-folder-alist + '( + ;; start virtual folder definition + ("virtual-folder-name" + (("/path/to/folder" "/path/to/folder2") + (header "foo") + (header "bar") + ) + (("/path/to/folder3" "/path/to/folder4") + (and (header "baz") (header "woof")) + ) + ) + ;; end of virtual folder definition + ) +) +@end example + +When you visit a defined virtual folder, all the underlying folders +that it depends on will be visited automatically. Likewise, when you +quit the virtual folder, all the underlying folders that were +purposely visited as part of the virtual folder will be closed +automatically. But any other underlying folders that you might have +previously visited for independent reasons will remain open. + +@subsection Virtual Selectors +@anchor{Virtual Selectors} + +@unnumberedsubsubsec Generic selectors + +@cindex @acronym{BBDB} +@table @code +@item any +matches any message. +@item header +matches message if @var{ARG} matches any part of the header +portion of the message; @var{ARG} should be a +regular expression. +@item text +matches message if @var{ARG} matches any part of the text +portion of the message; @var{ARG} should be a +regular expression. +@item header-or-text +matches message if @var{ARG} matches any part of the +headers or the text portion of the message; +@var{ARG} should be a regular expression. +@item header-field +matches messages if the header field named @var{ARG1} has text matching +@var{ARG2}. +@end table + +@unnumberedsubsubsec Selectors based on message headers + +@table @code +@item author +matches message if @var{ARG} matches the author; @var{ARG} should be a +regular expression. +@item author-or-recipient +matches message if @var{ARG} matches the author of +the message or any of its recipients; @var{ARG} +should be a regular expression. +@item recipient +matches message if @var{ARG} matches any part of the recipient +list of the message. @var{ARG} should be a regular expression. +@vindex vm-summary-uninteresting-senders +@item outgoing +matches message if your are the author of it, i.e. if the author matches +@code{vm-summary-uninteresting-senders}. +@cindex @acronym{BBDB} +@item in-bbdb +matches message if its addresses are in the @acronym{BBDB}. With an optional +first argument you can specify the address class (@code{authors} or +@code{recipients}) . With an optional second argument @code{t}, the +selector checks only the first address specified in the message. +Examples: + +@example +(in-bbdb authors) +@end example +@example +(in-bbdb recipients t) +@end example +@item subject +matches message if @var{ARG} matches any part of the message's +subject; @var{ARG} should be a regular expression. +@item sent-after +matches message if it was sent after the date @var{ARG}. +A fully specified date looks like this: +@example +``31 Dec 1999 23:59:59 GMT'' +@end example +@noindent although the parts can appear in any order. +You can leave out any part and it will +default to the current date's value for that +part, with the exception of the @samp{hh:mm:ss} +part which defaults to midnight. +@item sent-before +matches message if it was sent before the date @var{ARG}. +A fully specified date looks like this: +@example +``31 Dec 1999 23:59:59 GMT'' +@end example +@noindent although the parts can appear in any order. +You can leave out any part and it will +default to the current date's value for that +part, with the exception of the hh:mm:ss +part which defaults to midnight. +@item older-than +matches message if it is more than @var{ARG} days old +@item newer-than +matches message if it is at most @var{ARG} days old +@item message-id +matches message if its Message ID is @var{ARG} +@item uid +matches message if its IMAP UID is @var{ARG} (for IMAP folders) +@item uidl +matches message if its POP UIDL is @var{ARG} (for POP folders) +@item spam-score +matches message if its spam score is at least @var{ARG}. See +@code{vm-spam-score-headers} for configuration. +@end table + +@unnumberedsubsubsec Selectors based on message attributes + +@table @code +@item deleted +matches message if it is flagged for deletion. +@item undeleted +matches message if it has not been deleted. +@item edited +matches message if it has been edited. +@item unedited +matches message if it has not been edited. +@item filed +matches message if it has been saved with its headers. +@item unfiled +matches message if it has not been saved with its +headers. +@item written +matches message if it has been saved without its headers. +@item new +matches message if it is new. +@item recent +matches message if it is new. Same as the @code{new} selector. +@item read +matches message if it is neither new nor unread. +@item unread +matches message if it is not new and hasn't been read. +@item unseen +matches message if it is not new and hasn't been read. +Same as the @code{unread} selector. +@item flagged +matches message if it is flagged. +@item unflagged +matches message if it is not flagged. +@item replied +matches message if it has been replied to. +@item answered +matches message if it has been replied to. Same as the @code{replied} +selector. +@item unreplied +matches message if it has not been replied to. +@item unanswered +matches message if it has not been replied to. +Same as the @code{unreplied} selector. +@item forwarded +matches message if it has been forwarded using +a variant of @code{vm-forward-message}, @code{vm-send-digest} or one +of their variants. +@item unforwarded +matches message if it has not been forwarded using +@code{vm-forward-message}, @code{vm-send-digest} or one +of their variants. +@item redistributed +matches message if it has been redistributed using +@code{vm-resend-message}. +@item unredistributed +matches message if it has not been redistributed using +@code{vm-resend-message}. +@item marked +matches message if it is marked, as with +@code{vm-mark-message}. +@end table + +@unnumberedsubsubsec Selectors based on analysing the text + +@table @code +@vindex vm-vs-attachment-regexp +@item attachment +matches if a message contains an attachment, i.e., its text matches +@code{vm-vs-attachment-regexp}. +@item less-chars-than +matches message if message has less than @var{ARG} +characters. @var{ARG} should be a number. +@item less-lines-than +matches message if message has less than @var{ARG} +lines. @var{ARG} should be a number. +@item more-chars-than +matches message if message has more than @var{ARG} +characters. @var{ARG} should be a number. +@item more-lines-than +matches message if message has more than @var{ARG} +lines. @var{ARG} should be a number. +@end table + +@unnumberedsubsubsec Complex selector operations + +@table @code +@item sexp +matches message if the argument ``s-expression'' yields @code{t}. For +example, to find all the messages from @samp{Jenny} with attachments, you +can type @kbd{V C sexp @key{RET} (and (author "Jenny") attachment) @key{RET}}. + +(This selector is available for creating interactive virtual folders. The +argument ``s-expression'' can involve selectors combined using the logical +connectives listed below. There would be no need to use the @code{sexp} +selector in defining predefined virtual folders because those definitions +can directly use ``s-expressions''.) + +@item eval +matches message if evaluating the Lisp expression @var{ARG} yields @code{t}. +The Lisp expression can refer to the message by the name +@code{vm-virtual-message}. This is more flexible than the @code{sexp} +selector because it allows arbitrary Lisp expressions, not only the built-in +selectors. However, you would need some knowledge of the Lisp functions +that manipulate VM messages to use this selector. + +@item and +matches the message if all its argument +selectors match the message. Example: +@example +(and (author "Derek McGinty") (new)) +@end example +@noindent matches all new messages from Derek McGinty. +@code{and} takes any number of arguments. + +@item not +matches message only if its selector argument +does NOT match the message. Example: +@example +(not (deleted)) +@end example +@noindent matches messages that are not deleted. + +@item or +matches the message if any of its argument +selectors match the message. Example: +@example +(or (author "Dave Weckl") (subject "drum")) +@end example +@noindent matches messages from Dave Weckl or messages +with the string ``drum'' in their Subject header. +@code{or} takes any number of arguments. + +@item thread +matches a message thread if any message in the thread matches the argument +selector. Example: +@example +(thread (outgoing)) +@end example +@noindent matches all threads that have an outgoing message, i.e., a message +authored by you. + +@item thread-all +matches a message thread if all messages in the thread match the argument +selector. Example: +@example +(thread (less-chars-than 1000)) +@end example +@noindent matches threads if all their messages contain fewer than 1000 +characters. +@end table + +@unnumberedsubsubsec Selectors based on context + +@table @code +@item folder-name +matches message if it is from a folder matching @code{ARG} +@item virtual-folder-member +matches message if the message is already a +member of some virtual folder currently +being visited. +@item vm-mode +matches the message if the current-buffer is in vm-mode and one of its +argument selectors matches the message. +@item mail-mode +matches the message if the current-buffer is in mail-mode and one of +its argument selectors matches the message. +@end table + +@node Working with Virtual Folders, vm-avirtual, Defined Folders,Virtual Folders +@section Working with Virtual Folders + +@findex vm-get-new-mail +@findex vm-save-folder +Once you've +visited a virtual folder most VM commands work as they do in a +normal folder. There are exceptions. If you use @kbd{S} +(@code{vm-save-folder}), the folder save command will be invoked +on each real folder in turn. Similarly if you use @kbd{g} +(@code{vm-get-new-mail}) in a virtual folder, mail is retrieved +from the spool files associated with each of the real folders. +If any of the retrieved messages are matched by the virtual +folder's selectors, they will be added to the virtual folder. + +These commands will signal an error when invoked in a virtual folder: + +@display + vm-save-buffer + vm-write-file + vm-change-folder-type + vm-expunge-imap-messages + vm-expunge-pop-messages +@end display + +Normally messages in a virtual folder share attributes with the +underlying real messages. For example, if you delete a message +in a virtual folder, it is also flagged as deleted in the real +folder. If you then run @code{vm-expunge-folder} in the virtual folder, +the deleted message is expunged from the virtual folder as well as +the real folder. Labels are shared between virtual and real +messages. However virtual folders have their own set of message +marks. + +To make virtual folders not share message attributes with real +folders by default, set the variable @code{vm-virtual-mirror} to nil. +This should be done in your VM init file and you should use +@code{setq-default}, as this variable is automatically local to all +buffers. + +@example +(setq-default vm-virtual-mirror nil) +@end example + +@findex vm-toggle-virtual-mirror +@kindex V M +@noindent If you want to change virtual mirror status of a particular +virtual folder, use the command @code{vm-toggle-virtual-mirror} (bound +to @kbd{V M}). If the virtual folder is currently sharing attributes +with real folders, it will no longer be. If it is not sharing +attributes with the underlying folders then it will be. + +@node vm-avirtual,, Working with Virtual Folders, Virtual Folders +@section vm-avirtual Package + +@cindex vm-avirtual +The @samp{vm-avirtual} add-on package created by Robert Widhopf-Fenk provides +various automatic operations based on virtual selectors. These +facilities are only partially documented. + +@kindex V O +@findex vm-virtual-omit-message +@kindex V U +@findex vm-virtual-update-folders +The command @code{M-x vm-virtual-omit-message} (bound to @kbd{V O} in +version 8) will omit a message from a virtual folder, irrespective of +whether it satisfies the definition of the virtual folder. The command +@code{M-x vm-virtual-update-folders} (bound to @kbd{V U} in version 8) will +force an update of all the visited virtual folders to reflect the changes in +their underlying folders. + +@findex vm-virtual-check-selector-interactive +The command @kbd{M-x vm-virtual-check-selector-interactive} (bound to @kbd{V +T} in version 8) allows you to test a selector, i.e., a virtual folder +definition, interactively by applying it to the current message. With a +prefix argument, it will print diagnostic information in a separate buffer. +This feature is useful because virtual folder selectors can get quite +complicated and it is important to make sure that they work correctly. + +The vm-avirtual packages allows you to use virtual selectors to carry out +automatic deletion of messages (e.g., for spam) and for automatic saving of +messages to folders. + +@unnumberedsubsec Automatic deletion + +@findex vm-virtual-auto-delete-message +@vindex vm-virtual-auto-delete-message-selector +Automatic deletion of messages based on the virtual folder facility can be +achieved with the command @code{vm-virtual-auto-delete-message} (bound to +@kbd{V D} in version 8). First, set the variable +@code{vm-virtual-auto-delete-message-selector} to the name of a virtual +folder whose members should be normally deleted. Then invoking the command +on the current message (or a COUNT number of messages with a prefix +argument) deletes all those messages among them that belong to the virtual +folder @code{vm-virtual-auto-delete-message-selector}. There is no need to +separately view the virtual folder before deleting such messages. + +@findex vm-virtual-auto-delete-messages +@vindex vm-arrived-messages-hook +The function @code{vm-virtual-auto-delete-messages} can be added to the VM +hook @code{vm-arrived-messages-hook}. This causes all the messages matching +the @code{vm-virtual-auto-delete-message-selector} in the incoming mail +to be automatically deleted before you view them. + +@unnumberedsubsec Automatic saving + +@findex vm-virtual-save-message +@findex vm-virtual-auto-archive-messages +@vindex vm-virtual-auto-folder-alist +The commands @kbd{M-x vm-virtual-save-message} and +@kbd{M-x vm-virtual-auto-archive-messages} provide variants of +@code{vm-save-message} and @code{vm-auto-archive-messages} based on the +virtual folder facility. To use them, you must first set the variable +@code{vm-virtual-auto-folder-alist} to an association-list of the form + +@example +((@var{VIRTUAL-FOLDER-NAME} . @var{FOLDER}) + ... ) +@end example + +@noindent where @var{VIRTUAL-FOLDER-NAME} is a string and @var{FOLDER} is +either a string or an expression that evaluates to a string. If the message +being saved is a member of @var{VIRTUAL-FOLDER-NAME}, as per its definition +in @code{vm-virtual-folder-alist}, then @var{FOLDER} is regarded as the +place where it should be saved. The command @code{vm-virtual-save-message} +suggests this folder as the default location for saving. The command +@code{vm-virtual-auto-archive-messages} archives all matching messages in +the corresponding @var{FOLDER}s, as suggested by +@code{vm-virtual-auto-folder-alist}. + +@node @acronym{IMAP} Server Folders, Frames and Windows, Virtual Folders, Top +@chapter @acronym{IMAP} Server Folders + +This chapter covers the additional features of @acronym{IMAP} server +folders, i.e., folders on an @acronym{IMAP} server that you access using VM. +@xref{@acronym{IMAP} Folders}. Do not use these features if you just +download mail from IMAP mail boxes into local folders. + +@findex vm-imap-synchronize +The command @code{vm-imap-synchronize} can be used to perform full +synchronization between a VM folder and the corresponding folder on the IMAP +server. (Recall that @code{vm-get-new-mail} and @code{vm-save-folder} do +half-synchronization in one direction each.) + +@vindex vm-imap-connection-mode +The variable @code{vm-imap-connection-mode} allows you to work while +disconnected from the network. If it is set to @code{online}, which is the +default, VM communicates with the server during @code{vm-get-new-mail}, +@code{vm-save-folder} and @code{vm-imap-synchronize} operations. In order +to work while disconnected from the network, set the variable to +@code{offline}. In this mode, @code{vm-save-folder} writes any changes +made to the folder to the local copy on disk (the ``cache'' folder); +@code{vm-visit-imap-folder} likewise visits the cache folder. + +You can set @code{vm-imap-connection-mode} to @code{autoconnect} if you have +intermittent problems with the network. In this mode, doing +@code{vm-get-new-mail} attempts to connect to the network. If it succeeds +then @code{vm-imap-connection-mode} turns into @code{online}. + +When the @acronym{IMAP} server is connected again, you should run @kbd{C-u +M-x vm-imap-synchronize}, i.e., call it with a @emph{prefix argument}. This +causes @emph{all} the message attributes and labels to be written to the +server, since it may not be known which of them have actually changed during +the offline operation. Similarly, @emph{all} the messages that may have +been expunged in the cache folder are expunged on the server. + +@anchor{@acronym{UIDVALIDITY}} +@unnumberedsec @acronym{UIDVALIDITY} + +@cindex @acronym{UIDVALIDITY} +Messages on an @acronym{IMAP} server have unique id numbers called UID's. +In addition, a second id number called @dfn{@acronym{UIDVALIDITY}} allows +the server to renumber messages when the id numbers within a particular +@acronym{UIDVALIDITY} are exhausted. All the messages on the server at any +given time have the same @acronym{UIDVALIDITY} value. When the server needs +to renumber the messages, it changes the @acronym{UIDVALIDITY} value and +issues new @acronym{UID} numbers for all the messages with new +@acronym{UIDVALIDITY}. This happens but rarely because there are over two +billion UID's within each @acronym{UIDVALIDITY}. + +When the @acronym{UIDVALIDITY} changes on the @acronym{IMAP} server, VM has +no easy way to identify the new UID's for the messages in its cache. So, it +marks all the messages in the cache as invalid and refreshes the cache with +new copies of messages from the server. This is a time-consuming operation +but it happens only rarely. VM warns you before it refreshes the cache and +asks for confirmation. You can abort the operation if you cannot spare the +time, but note that it is not possible to perform any changes to the +@acronym{IMAP} folder until the cache is refreshed. You might consider +setting the @code{vm-enable-external-messages} flag to @code{(imap)} before +you refresh the cache so that it will be quicker. @pxref{External Messages}. + +@unnumberedsubsec Operations for the IMAP server + +@cindex vm-list-imap-folders +The command @code{vm-list-imap-folders} lists the folders available on the +@acronym{IMAP} server, along with the total number of messages and recent +(new) messages in each of them. If you run it with a prefix argument, it +lists only those folders that have new messages. + +@cindex vm-create-imap-folder +@cindex vm-delete-imap-folder +@cindex vm-rename-imap-folder +Use the command @code{vm-create-imap-folder} for creating a new folder on +the @acronym{IMAP} server and @code{vm-delete-imap-folder} for deleting an +existing folder. You can rename a folder using +@code{vm-rename-imap-folder}. + +@node Frames and Windows, Toolbar, @acronym{IMAP} Server Folders, Top +@chapter Frames and Windows + +VM uses Emacs frames and windows to display messages and summaries +and to provide a place for you to compose messages. Using VM's +frame configuration facilities you can control when VM creates new +frames and the size and attributes associated with new frames. +Inside each frame you can associate different window setups with +commands and classes of commands by using VM's window configuration +facilities. + +@vindex vm-mutable-frame-configuration +@vindex vm-mutable-frames +To use VM's frame configuration features, the variable +@code{vm-mutable-frame-configuration} must be set non-@code{nil}. This is +the default. If @code{vm-mutable-frame-configuration} is set to @code{nil} +VM will only use the current frame, and VM will not create, delete or resize +frames. (This variable was called @code{vm-mutable-frames} in versions +prior to 8.2.) + +@vindex vm-mutable-window-configuration +@vindex vm-mutable-windows +To use window configurations, the variable +@code{vm-mutable-window-configuration} must be set non-@code{nil}. If +@code{vm-mutable-window-configuration} is set to @code{nil}, VM will only +use the selected window, and will not create, delete or resize windows. +(This variable was called @code{vm-mutable-windows} in versions +prior to 8.2.) + +@menu +* Frame Configuration:: How to configure frame use and appearance. +* Window Configuration:: How to configure window use and appearance. +@end menu + +@node Frame Configuration, Window Configuration, Frames and Windows, Frames and Windows +@section Frame Configuration + +VM has a set of variables that let you specify when VM creates +frames and what attributes the new frames will have. + +@vindex vm-frame-per-folder +If @code{vm-frame-per-folder} is set non-@code{nil}, when you visit a folder, +VM will create a new frame and display that folder in the new +frame. When you quit the folder, VM will delete the frame. + +@vindex vm-frame-per-summary +If @code{vm-frame-per-summary} is set non-@code{nil}, the @code{vm-summarize} +command will create a new frame in which to display a folder's summary +buffer. This works best if a full-screen window configuration has +been assigned to the @code{vm-summarize} command. When you quit the folder +or kill the summary, VM will delete the frame. + +@vindex vm-frame-per-composition +Setting @code{vm-frame-per-composition} non-@code{nil} causes VM to create a +new frame for the composition buffer when you run any of VM's +message composition commands. E.g. @code{vm-reply-include-text}, +@code{vm-mail}, @code{vm-forward-message}. When you finish editing the +composition and send it, or when you kill the composition buffer, +the frame will be deleted. + +@vindex vm-frame-per-edit +The variable @code{vm-frame-per-edit}, if non-@code{nil}, tells VM to create a +new frame when the vm-edit-message command is run. When you +finish editing the message, or abort the edit, the frame will be +deleted. + +@vindex vm-frame-per-help +If @code{vm-frame-per-help} is set non-@code{nil}, VM will create a new frame +to display any help buffer produced by the vm-help command. + +@vindex vm-frame-per-completion +If @code{vm-frame-per-completion} is set non-@code{nil}, VM will create a new +frame on mouse initiated completing reads. A mouse initiated +completing read occurs when you invoke a VM command using the +mouse, either with a menu or a toolbar button. That command +must then prompt you for information, and there must be a +limited set of valid responses. If these conditions are met +and @code{vm-frame-per-completion}'s value is non-@code{nil}, VM will +create a new frame containing a list of responses that you can +select with the mouse. + +@vindex vm-search-other-frames +When VM is deciding whether to create a new frame, it checks +other existing frames to see if a buffer that it wants to display in a +frame is already being displayed somewhere. If so, then VM will +not create a new frame. If you don't want VM to search other +frames, set the variable @code{vm-search-other-frames} to @code{nil}. VM will +still search the currently selected frame and will not create a +new frame if the buffer that it wants to display is visible there. + +@vindex vm-frame-parameter-alist +The variable @code{vm-frame-parameter-alist} allows you to specify the +frame parameters for newly created frames. + +The value of @code{vm-frame-parameter-alist} should be of this form + +@example +((@var{SYMBOL} @var{PARAMLIST}) (@var{SYMBOL2} @var{PARAMLIST2}) ...) +@end example + +@var{SYMBOL} must be one of ``completion'', ``composition'', ``edit'', +``folder'', ``primary-folder'' or ``summary''. It specifies the type +of frame that the following @var{PARAMLIST} applies to. + +@table @code +@item completion +specifies parameters for frames that display lists of +choices generated by a mouse-initiated completing read. +(See @code{vm-frame-per-completion}.) +@item composition +specifies parameters for mail composition frames. +@item edit +specifies parameters for message edit frames +(e.g. created by @code{vm-edit-message-other-frame}) +@item folder +specifies parameters for frames created by `vm' and the +@code{vm-visit-} commands. +@item primary-folder +specifies parameters for the frame created by running +@code{vm} without any arguments. +@item summary +specifies parameters for frames that display a summary buffer +(e.g. created by @code{vm-summarize-other-frame}) +@end table +@var{PARAMLIST} is a list of pairs as described in the documentation for +the function @code{make-frame}. + +@node Window Configuration,, Frame Configuration, Frames and Windows +@section Window Configuration + +@findex vm-save-window-configuration +@kindex W S +Window configurations allow you to specify how the windows within +a frame should look for a particular command or class of +commands. Each command can have a configuration associated with +it and you can also associate a configuration with command +classes like ``reading-message'' or ``composing-message''. To +setup a window configuration, first use Emacs' window management +commands (@code{split-window}, @code{enlarge-window}, etc.) to make the +windows in the frame look the way you want. Then use the +switch-to-buffer command to put the buffers you want to see into +the windows. Next type @kbd{W S}, which invokes the +@code{vm-save-window-configuration} command. Type the name of the +command or class of commands to which you want the configuration +to apply. Nearly all VM commands can be entered here. Valid +classes are: + +@display + default + startup + quitting + reading-message + composing-message + marking-message + searching-message +@end display + +When a VM command is executed, window configurations are searched +for as follows. First, a command specific configuration is +searched for. If one is found, it is used. Next a class +configuration is searched for. Not all commands are in command +classes. Message composition commands are in the +``composing-message'' class. All the @code{vm-quit*} commands are in the +``quitting'' class. All the VM commands that set and clear +message marks are in the ``marking-message'' class, and so on. +If such a class configuration is found it is used. If no +matching class configuration is found, the ``default'' class +configuration is used, if it is defined. + +Note that when a window configuration is saved the selected +window at that time will be the selected window when that window +configuration is used. So if you prefer for the cursor to be in +a particular window, make sure you invoke +@code{vm-save-window-configuration} window from that window. Remember +that you can invoke the command with @kbd{M-x} if VM's normal +key map is not in effect. + +@kindex W D +@findex vm-delete-window-configuration +To delete a window configuration, use @kbd{W D} which is bound to +@code{vm-delete-window-configuration}. You will be prompted for the +name of the configuration to delete. + +@kindex W W +@findex vm-apply-window-configuration +To see what an existing configuration looks like, type @kbd{W W} +which invokes @code{vm-apply-window-configuration}. + +@vindex vm-window-configuration-file +@cindex .vm.windows +VM saves information about your window configurations in the file +named by the variable @code{vm-window-configuration-file}. The default +location of the configuration file is @file{"~/.vm.windows"}. +Do not make @code{vm-window-configuration-file} point to the same +location as @code{vm-init-file}, as the window configuration save +commands will then overwrite the content of your init file. + +@node Toolbar, Menus, Frames and Windows, Top +@chapter Toolbar + +VM can display a toolbar that allows you to run VM commands with +a single mouse click. By default the toolbar is displayed on the +left of the Emacs frame and is only visible if you're running +under a window system like X Windows or Microsoft Windows. + +@vindex vm-use-toolbar +To make VM not display the toolbar, set @code{vm-use-toolbar} to nil. +To configure what buttons are displayed on the toolbar, you must +change the value of @code{vm-use-toolbar}. If non-@code{nil}, the value of +@code{vm-use-toolbar} should be a list of symbols and integers, which +specify which buttons appear on the toolbar and the layout of the +buttons. These are the allowed symbols along with the buttons +they represent. + +@table @code +@item autofile +The AutoFile button. Clicking on this button runs the command +@code{vm-toolbar-autofile-message}. This command will save the current +message into the folder matched by @code{vm-auto-folder-alist}, if there +is a match. +@item compose +The Compose button. Clicking on this button runs the command +@code{vm-toolbar-compose-command}. This command is normally just an +alias for the @code{vm-mail} command. If you want the Compose button to +do something else, redefine @code{vm-toolbar-compose-command} using +either @code{fset} or @code{defun}. +@item delete/undelete +The Delete/Undelete button. If the current message is marked for +deletion, this button displays as an Undelete button. Otherwise +it displays as a Delete button. +@item file +The File button. Clicking on this button runs the command +@code{vm-toolbar-file-command}. This command is normally just an +alias for the @code{vm-mail} command. If you want the File button to +do something else, redefine @code{vm-toolbar-file-command} using +either @code{fset} or @code{defun}. +@item getmail +The Get Mail button. Clicking on this button runs the command +@code{vm-toolbar-getmail-command}. This command is normally just an +alias for the @code{vm-get-new-mail} command. If you want the +Get Mail button to +do something else, redefine @code{vm-toolbar-getmail-command} using +either @code{fset} or @code{defun}. +@item help +The Helper button. Clicking on this button runs the command +@code{vm-toolbar-helper-command}. This command normally just runs +@code{vm-help}, but it also does context specific things under certain +conditions. If the current message is a @acronym{MIME} message that needs +decoding, the Helper button becomes the Decode @acronym{MIME} button. If the +current folder has an auto-save file that appears to be the result +of an Emacs or system crash, the Helper button becomes the Recover +button. Clicking on the Recover button runs @code{vm-recover-folder}, +so you can recover your folder from an existing auto-save file. +@item mime +The Decode @acronym{MIME} button. Clicking on this button runs the command +@code{vm-toolbar-mime-command}. This command is normally just an +alias for the @code{vm-decode-mime-message} command. +@item next +The Next button. Clicking on this button runs the command +@code{vm-toolbar-next-command}. This command is normally just an +alias for the @code{vm-next-message} command. If you want the Next button to +do something else, redefine @code{vm-toolbar-next-command} using +either @code{fset} or @code{defun}. +@item previous +The Previous button. Clicking on this button runs the command +@code{vm-toolbar-previous-command}. This command is normally just an +alias for the @code{vm-previous-message} command. If you want the Previous button to +do something else, redefine @code{vm-toolbar-previous-command} using +either @code{fset} or @code{defun}. +@item print +The Print button. Clicking on this button runs the command +@code{vm-toolbar-print-command}. This command is normally just an +alias for the @code{vm-print-message} command. If you want the +Print button to +do something else, redefine @code{vm-toolbar-print-command} using +either @code{fset} or @code{defun}. +@item quit +The Quit button. Clicking on this button runs the command +@code{vm-toolbar-quit-command}. This command is normally just an +alias for the @code{vm-quit} command. If you want the Quit button to +do something else, redefine @code{vm-toolbar-quit-command} using +either @code{fset} or @code{defun}. +@item reply +The Reply button. Clicking on this button runs the command +@code{vm-toolbar-reply-command}. This command is normally just an +alias for the @code{vm-reply-include-text} command. If you want +the Reply button to +do something else, redefine @code{vm-toolbar-reply-command} using +either @code{fset} or @code{defun}. +@item visit +The Visit button. Clicking on this button runs the command +@code{vm-toolbar-visit-command}. This command is normally just an +alias for the @code{vm-visit-folder} command. If you want the Visit button to +do something else, redefine @code{vm-toolbar-visit-command} using +either @code{fset} or @code{defun}. +@item nil +If nil appears in the list, it must appear exactly once. The +buttons associated with symbols that appear after nil in the +list will be display flushright for top and bottom toolbars, and +flushbottom for left and right toolbars. +@end table + +If an positive integer appears in the the @code{vm-use-toolbar} list, it +specifies the number of pixels of blank space to display between +the button that comes before and the button that comes after the +integer. + +@vindex vm-toolbar-orientation +The variable @code{vm-toolbar-orientation} controls on which side of the +frame the toolbar is displayed. E.g. + +@example +(setq vm-toolbar-orientation 'top) +@end example + +@noindent causes the toolbar to be displayed at the top of the frame. The +@code{top} in the example can be replaced with @code{bottom}, +@code{right} and @code{left} to make the toolbar appear in those +places instead. + +@vindex vm-toolbar-pixmap-directory +VM finds the images for the toolbar in the directory specified by +@code{vm-toolbar-pixmap-directory}. This variable should already be set +properly by whoever installed VM on your system, so you should +not need to set it. + +@node Menus, Faces, Toolbar, Top +@chapter Menus + +@vindex vm-popup-menu-on-mouse-3 +@cindex menu bar +@cindex menus, pop-up +VM uses Emacs' menu bar and pop-up menus whenever they are available +using which you can readily access VM's commands. By default, VM puts +a context-sensitive pop-up menu on mouse button 3 (usually the +rightmost mouse button). If you don't want this menu, set the +variable @code{vm-popup-menu-on-mouse-3} to nil. + +@vindex vm-use-menus +If you set @code{vm-use-menus} to nil, VM will not generate a menu bar +for VM folder buffers and VM won't use pop-up menus either. If you +set @code{vm-use-menus} to @samp{1}, VM will add a single @samp{VM} +menu to the existing menu bar and provide various submenus under it +for the VM operations. + +By default, @code{vm-use-menus} is set to a list of symbols indicating +which menus should appear in the menu bar. These menus will replace +the standard Emacs menus whenever VM folder are being viewed. You can +switch to the Emacs menu bar when necessary by clicking on the menu +labelled @code{[Emacs]} (on some systems, thre will be a drop-down +menu labelled @code{Emacs}). From the Emacs menu bar, you can return +to the VM menu bar by clicking on the menu labelled @code{[VM]} (or +under the drop-down menu labelled @code{VM}). + +@cindex graphics toolkit +On some graphics toolkits, menu bar cannot have ``buttons'' that +invoke immediate actions (such as @code{[Emacs]}). VM knows about +some of those toolkits and automatically uses drop-down menus instead +of buttons. If your system shows buttons but they are not +operational, then you should set @code{vm-use-menubar-buttons} to nil +in your init file. That will cause VM use to drop-down menus instead +of buttons on the menu bar. + +The available menus for the VM menubar are the following: + +@table @code +@item dispose +This is menu of commands that are commonly used to dispose of a +message. E.g. reply, print, save, delete. +@item emacs +This provides a menu button labelled @code{[Emacs]} that causes the +menu bar to change to the global Emacs menu bar. On that menu bar you +will find a @code{[VM]} button that can return you to the VM menu +bar. +@item folder +This is a menu of folder related commands. You can visit a +folder, save a folder, quit a folder and so on. +@item help +This is a menu of commands that provide information for you if +you don't know what to do next. +@item label +This is a menu of commands that let you add and remove message +labels from messages. +@item mark +This is a menu of commands that you can use to mark and unmark +messages based on various criteria. @xref{Marking Messages}. +@item motion +This is a menu of commands to move around inside messages and +inside folders. +@item send +This is a menu of commands you use to compose and send messages. +@item sort +This is a menu of commands to sort a folder by various criteria. +@item undo +This provides a menu button that invokes the @code{vm-undo} command. +@item virtual +This is a menu of commands that let you visit and create virtual +folders. +@item nil +If nil appears in the list, it should appear exactly once. All +menus after nil in the list will be displayed flushright in +the menu bar. +@end table + +@node Faces, Using the Mouse, Menus, Top +@chapter Faces +VM uses Emacs faces to emphasize text in the folder and summary +buffers. In addition to using the predefined faces of Emacs, VM also +defines several faces of its own. You can do @code{M-x list-faces} +inside Emacs to see what faces have been defined. You can also define +your own faces using Emacs primitives for doing so. +@xref{Faces,,,emacs, the GNU Emacs Manual}. + +@vindex vm-highlighted-header-regexp +@vindex vm-highlighted-header-face +In the folder or presentation buffer, the header contents of headers +matched by the @code{vm-highlighted-header-regexp} variable are +displayed using the face named by @code{vm-highlighted-header-face}. +This variable is ignored under XEmacs if +@code{vm-use-lucid-highlighting} is non-@code{nil}. The XEmacs +@code{highlight-headers} package is used instead. See the +documentation for the function @code{highlight-headers} to find out +how to customize header highlighting using this package. + +@cindex @acronym{URL} +@vindex vm-highlight-url-face +@vindex vm-url-search-limit +URL's that occur in message bodies are displayed using the face +named by @code{vm-highlight-url-face}. Typing Return on such URL's or +clicking button-2 has the effect of sending the @acronym{URL} to an external web +browser. @xref{Using the Mouse}. Searching for @acronym{URL}s in a +large message can take a long time. Since @acronym{URL}s often occur near +the beginning and near the end of messages, VM offers a way to +search just those parts of a message for @acronym{URL}s. The variable +@code{vm-url-search-limit} specifies how much of a message to search. +If @code{vm-url-search-limit} has a positive numeric value @var{N}, VM +will search the first @math{@var{N} / 2} characters and the last +@math{@var{N} / 2} characters in the message for @acronym{URL}s. + +@vindex vm-mime-button-face +The face named by @code{vm-mime-button-face} is used to display the +textual buttons that trigger the display of @acronym{MIME} objects. + +@xref{Summary Faces}, for the faces support in the Summary buffer. + +@node Using the Mouse, Hooks, Faces, Top +@chapter Using the Mouse + +VM uses the following layout for the mouse buttons in the folder +and summary buffers. + +@table @asis +@item button-1 (left button usually) +Unchanged. +@cindex @acronym{URL} +@item button-2 (middle button usually) +Activate. If you click on a summary entry, that message will be +selected and become the current message. If you click on a +highlighted @acronym{URL} in the body of a message, that @acronym{URL} will be sent +to the browser specified by @code{vm-url-browser}. +@item button-3 (right button usually) +Context Menu. If the mouse pointer is over the contents of the +From header, button-3 pops up a menu of actions that can be taken +using the author of the message as a parameter. For instance, +you may want to create a virtual folder containing all the +messages in the current folder written by this author. If the +mouse pointer is over the contents of the Subject header, a menu +of actions to be performed on the current message's subject is +produced. If button-3 is clicked over a highlighted @acronym{URL}, a menu +of Web browsers is produced. Otherwise the normal VM mode +specific menu is produced. +@end table + +@cindex w3m +@cindex @acronym{HTML} +These button assignments work only in plain text messages. For @acronym{HTML} +messages, you might use an internal web browser such as w3m to display +the content, which will have its own button assignments. For instance, +w3m binds button-2 to the browser function specified by the variable +@code{w3m-goto-article-function}. You will need to set that variable to +the desired browser function to get button-2 to work in @acronym{HTML} messages. + +In mail composition buffers only mouse button-3 is affected. +Context sensitive menus are produced when that button is clicked. + +@findex vm-mouse-send-url-to-netscape +@findex vm-mouse-send-url-to-xxx +@findex vm-mouse-send-url-to-xxx-new-window +@findex browse-url +@cindex browse-url +@cindex web browser +VM provides a number of browser functions that you can set as the value +of @code{vm-url-browser}. An example is the function +@code{vm-mouse-send-url-to-netscape}, which sends the @acronym{URL} at mouse to the +Netscape browser. Other browsers supported in this way include +@code{mosaic}, @code{mmosaic}, @code{opera}, @code{mozilla}, +@code{firefox}, and @code{konqueror}, all of which have functions of the +form @code{vm-mouse-send-url-to-xxx} and @code{vm-mouse-send-url-to-xxx-new-window}. You can also set +@code{vm-url-browser} to the Emacs function @code{browse-url}, and use +the facilities defined in the @samp{browse-url} library to send URL's to +external browsers. + +@node Hooks, Preface to Add-ons, Using the Mouse, Top +@chapter Hooks + +VM has many hook variables that allow you to run functions when +certain events occur. Here is a list of the hooks and when they +are run. (If you don't write Emacs-Lisp programs you +can skip this chapter.) + +@table @code +@vindex vm-select-new-message-hook +@item vm-select-new-message-hook +List of hook functions called every time a message with the ``new'' +attribute is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max). + +@item vm-select-unread-message-hook +@vindex vm-select-unread-message-hook +List of hook functions called every time a message with the ``unread'' +attribute is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max). + +@item vm-select-message-hook +@vindex vm-select-message-hook +List of hook functions called every time a message +is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max). + +@item vm-save-message-hook +@vindex vm-save-message-hook +List of hook fucntions called every time a message is saved to a folder. +When the hooks are called, the current buffer will be the folder containing +the message and the start and end of the message will be bracketed by +(point-min) and (point-max). The hooks are calle with one argument, a +string denoting the folder where the message was saved. The folder could be +a file name or the maildrop specification of an @acronym{IMAP} mailbox. + +@item vm-arrived-message-hook +@vindex vm-arrived-message-hook +List of hook functions called once for each message gathered from the +system mail spool, or from another folder with @code{vm-get-new-mail}, +or from a digest with @code{vm-burst-digest}. When the hooks are run, +the current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max). + +@item vm-spooled-mail-waiting-hook +@vindex vm-spooled-mail-waiting-hook +List of functions called when VM first notices mail is spooled +for a folder. The folder buffer will be current when the hooks are +run. + +@item vm-arrived-messages-hook +@findex vm-get-new-mail +@vindex vm-arrived-messages-hook +List of hook functions called after VM has gathered a group +of messages from the system mail spool, or from another +folder with @code{vm-get-new-mail}, or from a digest with +@code{vm-burst-digest}. When the hooks are run, the new +messages will have already been added to the message list +but may not yet appear in the summary. When the hooks are +run the current buffer will be the folder containing the +messages. + +@item vm-reply-hook +@vindex vm-reply-hook +List of hook functions to be run after a Mail mode composition +buffer has been created for a reply. VM runs this hook and then +runs @code{vm-mail-mode-hook} before leaving you in the Mail +mode buffer. + +@item vm-forward-message-hook +@vindex vm-forward-message-hook +List of hook functions to be run after a Mail mode +composition buffer has been created to forward a message. VM +runs this hook and then runs @code{vm-mail-mode-hook} before leaving the +user in the Mail mode buffer. + +@item vm-resend-bounced-message-hook +@vindex vm-resend-bounced-message-hook +List of hook functions to be run after a Mail mode +composition buffer has been created to resend a bounced message. +VM runs this hook and then runs @code{vm-mail-mode-hook} before leaving +you in the Mail mode buffer. + +@item vm-resend-message-hook +@vindex vm-resend-message-hook +List of hook functions to be run after a Mail mode composition +buffer has been created to resend a message. VM runs this hook +and then runs @code{vm-mail-mode-hook} before leaving you in +the Mail mode buffer. + +@item vm-send-digest-hook +@vindex vm-send-digest-hook +List of hook functions to be run after a Mail mode composition +buffer has been created to send a digest. VM runs this hook and +then runs @code{m-mail-mode-hook} before leaving you in the Mail +mode buffer. + +@item vm-mail-hook +@vindex vm-mail-hook +List of hook functions to be run after a Mail mode +composition buffer has been created to send a non specialized +message, i.e. a message that is not a reply, forward, digest, +etc. VM runs this hook and then runs @code{vm-mail-mode-hook} before +leaving you in the Mail mode buffer. + +@item vm-summary-update-hook +@vindex vm-summary-update-hook +List of hook functions called just after VM updates an existing +entry in a folder summary buffer. + +@item vm-summary-redo-hook +@vindex vm-summary-redo-hook +List of hook functions called just after VM adds or deletes +entries from a folder summary buffer. + +@item vm-visit-folder-hook +@vindex vm-visit-folder-hook +List of hook functions called just after VM visits a folder. +It doesn't matter if the folder buffer already exists, this hook +is run each time @code{vm} or @code{vm-visit-folder} is called interactively. +It is @emph{not} run after @code{vm-mode} is called. + +@item vm-retrieved-spooled-mail-hook +@vindex vm-retrieved-spooled-mail-hook +List of hook functions called just after VM has retrieved +a group of messages from your system mailbox(es). When these +hooks are run, the messages have been added to the folder buffer +but not the message list or summary. When the hooks are run, the +current buffer will be the folder where the messages were +incorporated. + +@item vm-edit-message-hook +@vindex vm-edit-message-hook +List of hook functions to be run just before a message is edited. +This is the last thing @code{vm-edit-message} does before leaving you +in the edit buffer. + +@item vm-mail-mode-hook +@vindex vm-mail-mode-hook +List of hook functions to be run after a Mail mode +composition buffer has been created. This is the last thing VM +does before leaving you in the Mail mode buffer. + +@item vm-mode-hook +@vindex vm-mode-hook +List of hook functions to run when a buffer enters @code{vm-mode}. +These hook functions should generally be used to set key bindings +and local variables. + +@item vm-mode-hooks +@vindex vm-mode-hooks +Old name for @code{vm-mode-hook}. +Supported for backward compatibility. +You should use the new name. + +@item vm-summary-mode-hook +@vindex vm-summary-mode-hook +List of hook functions to run when a VM summary buffer is created. +The current buffer will be that buffer when the hooks are run. + +@item vm-summary-mode-hooks +@vindex vm-summary-mode-hooks +Old name for @code{vm-summary-mode-hook}. +Supported for backward compatibility. +You should use the new name. + +@item vm-virtual-mode-hook +@vindex vm-virtual-mode-hook +List of hook functions to run when a VM virtual folder buffer is created. +The current buffer will be that buffer when the hooks are run. + +@item vm-presentation-mode-hook +@vindex vm-presentation-mode-hook +List of hook functions to run when a VM presentation buffer is +created. The current buffer will be the new presentation buffer +when the hooks are run. Presentation buffers are used to display +messages when some type of decoding must be done to the message +to make it presentable. E.g. @acronym{MIME} decoding. + +@item vm-quit-hook +@vindex vm-quit-hook +List of hook functions to run when you quit VM. +This applies to all VM quit commands, including @code{vm-quit-no-change}. +So you should not include in this hook any functions that alter the folder. +For automatically expunging deleted messages, set the variable +@code{vm-expunge-before-quit}. + +@item vm-summary-pointer-update-hook +@vindex vm-summary-pointer-update-hook +List of hook functions to run when the VM summary pointer is updated. +When the hooks are run, the current buffer will be the summary buffer. + +@item vm-display-buffer-hook +@vindex vm-display-buffer-hook +List of hook functions that are run every time VM wants to +display a buffer. When the hooks are run, the current buffer will +be the buffer that VM wants to display. The hooks are expected +to select a window and VM will display the buffer in that +window. + +If you use display hooks, you should not use VM's built-in window +configuration system as the result is likely to be confusing. + +@item vm-undisplay-buffer-hook +@vindex vm-undisplay-buffer-hook +List of hook functions that are run every time VM wants to +remove a buffer from the display. When the hooks are run, the +current buffer will be the buffer that VM wants to disappear. +The hooks are expected to do the work of removing the buffer from +the display. The hook functions should not kill the buffer. + +If you use undisplay hooks, you should not use VM's built-in +window configuration system as the result is likely to be +confusing. + +@item vm-iconify-frame-hook +@vindex vm-iconify-frame-hook +List of hook functions that are run whenever VM iconifies a frame. + +@item vm-menu-setup-hook +@vindex vm-menu-setup-hook +List of hook functions that are run just after all menus are initialized. + +@item vm-mime-display-function +@vindex vm-mime-display-function +If non-@code{nil}, this should name a function to be called inside +@code{vm-decode-mime-message} to do the @acronym{MIME} display of the current +message. The function is called with no arguments, and at the +time of the call the current buffer will be the @dfn{presentation +buffer} for the folder, which is a temporary buffer that VM uses +for the display of @acronym{MIME} messages. A copy of the current message +will be in the presentation buffer at that time. The normal work +that @code{vm-decode-mime-message} would do is not done, because this +function is expected to subsume all of it. + +@item vm-mail-send-hook +@vindex vm-mail-send-hook +List of hook functions to call just before sending a message. +The hooks are run after confirming that you want to send the +message (see @code{vm-confirm-mail-send} but before @acronym{MIME} encoding +and FCC processing. + +@item mail-yank-hooks +@vindex mail-yank-hooks +Hooks called after a message is yanked into a mail composition buffer. + +(This hook is deprecated, you should use mail-citation-hook instead.) + +The value of this hook is a list of functions to be run. Each +hook function can find the newly yanked message between point +and mark. Each hook function should return with point and mark +around the yanked message. + +See the documentation for @code{vm-yank-message} to see when VM will run +these hooks. + +@item mail-citation-hook +@vindex mail-citation-hook +Hook for modifying a citation just inserted in the mail buffer. +Each hook function can find the citation between (point) and (mark t). +And each hook function should leave point and mark around the citation +text as modified. + +If this hook is entirely empty, i.e. @code{nil}, a default action is taken +instead of no action. +@end table + +@node Preface to Add-ons, Customizations, Hooks, Top +@unnumbered What are Add-ons? + +Over the years, a number of users have contributed various functions +and packages adding features and customizations to VM. Many of them +have been collected and included in the standard VM distribution. +Some of the packages have their own manuals. For example, the ``VM +Personality Crisis'' package has a manual, @xref{top,,,VM-Pcrisis, +Personality Crisis for VM}. Most others have never been documented. + +This part of the manual is an effort to provide some rudimentary +documentation for these add-ons. + +The add-ons are classified into: + +@itemize +@item Customizations. +Small functions or settings that can be tagged on top of VM to make it +easier to use, either in general or in particular environments. +@item Add-ons. +More elaborate features. +@item Packages. +Full-blown packages that add new functionality or interface to other +packages in your environment. +@end itemize + +@node Customizations, Add-ons, Preface to Add-ons, Top +@chapter Customizations +Useful ways to customize VM. +@section Reading messages + +@unnumberedsubsec Shrunken headers + +@cindex headers, shrunken +@vindex vm-enable-addons +Some messages come with huge lists of recipients and one has to page +through them before getting to the actual content of the message. The +@dfn{shrunken headers} feature, included in @code{vm-rfaddons}, +addresses this problem. To use the feature, you must add +@code{shrunken-headers} to the variable @code{vm-enable-addons} in +your VM init file: + +@example +(setq vm-enable-addons (cons 'shrunken-headers vm-enable-addons)) +@end example + +@noindent The add-on abbreviates all the message headers to +single lines, and adds a button at the end. You can click +the button to expand the header to its full length. The function +@code{vm-shrunken-headers-toggle} can be used to expand or collapse +all the headers of a message. You might bind this to a key, if you +use it often. + +(This add-on was provided by Robert Fenk.) + +@unnumberedsubsubsec @acronym{MIME} alternatives +@cindex @acronym{MIME} alternatives +The default setting of VM for handling @acronym{MIME} alternatives is +@code{best-internal}, which means the best alternative that can be +displayed internally in VM is chosen. Many users have environments +where only @code{text/plain} parts can be displayed internally. +However, some messages come with @code{text/html} parts that are +expected to be more faithful to the sender's composition. On +occasion, you might wish to see the @code{text/html} part even if it +has to be viewed externally. + +@cindex @acronym{MIME} alternative, best +@cindex @acronym{MIME} alternative, best-internal +@findex vm-toggle-best-mime +The function @code{vm-toggle-best-mime} function, included in +@code{vm-rfaddons}, allows you to change VM's selection method to +@code{best} temporarily so that you can view the @code{text/html} +part. You can use the same function to change the method back to +@code{best-internal}. + +(Thanks to Alley Stoughton for this contribution.) + +@section Saving messages and attachments + +@unnumberedsubsec Auto saving attachments + +Messages with attachments get bulky and increase the size of VM +folders, slowing down VM. The functions +@code{vm-save-all-attachments} and @code{vm-save-attachments} provide +ways to save attachments of messages on the file system and deleting +them from the mail folders. + +@findex vm-mime-auto-save-all-attachments +@vindex vm-mime-auto-save-all-attachments-subdir +The function @code{vm-mime-auto-save-all-attachments}, included in +@code{vm-rfaddons}, provides enhanced functionality for saving +attachments. It saves the attachments in a subdirectory of +@code{vm-mime-save-attachment-save-directory}, whose name is obtained +by concating the ``from'', ``subject'' and ``date'' headers of the +message. This can be customized via the variable +@code{vm-mime-auto-save-all-attachments-subdir}. + +You can save the attachments of all new messages automatically by +putting @code{vm-mime-auto-save-all-attachments} in +@code{vm-select-new-message-hook}. + +(This add-on was provided by Robert Fenk.) + +@section Printing messages + + + +@node Add-ons, History and Administration, Customizations, Top +@chapter Add-ons +@section Postponing message composition +@cindex vm-pine +@cindex postponing message composition +Sometimes, you might want to interrupt the composing of a message and +continue it later. This is called @dfn{postponing}. The add-on called +@samp{vm-pine} provides this +functionality. + +@findex vm-postpone-composition +@kindex C-c C-d +@vindex vm-postponed-folder +In a message composition buffer, the command @key{C-c C-d} +(@code{vm-postpone-composition}) +postpones the current composition. The postponed message is stored in the +folder specified in @code{vm-postponed-folder}. (The default is a folder +called ``postponed''). When called with a prefix argument, +@code{vm-postpone-composition} will ask you for the folder to save the draft +to. You might also save it to your inbox in this way. + +@findex vm-continue-postponed-message +You can continue composing the postponed messages by visiting +@code{vm-postponed-folder}, selecting a message and running @kbd{M-x +vm-continue-postponed-message}. This constructs a new message composition +buffer by copying the text from the VM Presentation buffer. It also +converts any @acronym{MIME} buttons into attachment buttons, which will be encoded as +valid @acronym{MIME} attachments when the message is sent. Unfortunately, any +attachments that are displayed inline in the Presentation buffer will not be +encoded. This is a limitation of this package. + +(This add-on was provided by Robert Fenk.) + + +@node History and Administration, Highlights, Add-ons, Top +@chapter History and Administration + +@cindex Kyle Jones +VM was developed by Kyle Jones, starting in early 1989. The first +public release of VM was version 4.10, released in June of that year. +The original development environment was GNU Emacs 18.52. + +@cindex Wonderworks +The copyright for the code was retained by Kyle Jones. Hence, the +package was never included in GNU releases, which only contain code +copyrighted by the Free Software Foundation. However, Lucid/XEmacs +shipped VM starting with version 19.9. The other users obtained VM from +the Wonderworks web site, which hosted Kyle Jones's work. The home page +of VM at this site is @uref{http://www.wonderworks.com/vm}. + +The last version released by Kyle Jones was 7.19, in September 2004, +which can be found on the Wonderworks web site and its mirror sites. + +@cindex Robert Widhopf-Fenk +After this release, Robert Widhopf-Fenk picked up the maintenance of +VM, by releasing a series of patches under a separate distribution. He +also acquired a number of add-on's contributed by various developers, +including himself, and included them in his distribution. Kyle Jones +agreed to hand over the maintenance of VM to Robert Fenk in February, +2007. Further releases were made by Robert Fenk under the @code{8.0.x} +series. + +@cindex Savannah +All these releases are available from the new project page of VM hosted +by Savannah, at the @acronym{URL} +@uref{http://savannah.nongnu.org/projects/viewmail/}. +According to the project page, ``this site exists to continue VM development +after version 7.19 as a community project.'' + +@cindex Ulrich Müller +@cindex Uday S Reddy +Currently, VM is maintained by a ``VM Development Team,'' consisting of +Robert Widhopf-Fenk, Ulrich Müller and Uday S Reddy. Other potential members +are warmly welcomed. Robert Fenk has been inactive since November, 2008 +but he continues to be an official member of the team. The new +releases made by the team are numbered @code{8.1.0} and up. + +@cindex Launchpad +The project code base is maintained at the Launchpad web site +@uref{http://launchpad.net/vm}. The ``VM Development Team'' can be +reached here using the email address @email{vm@@lists.launchpad.net}. + +@unnumberedsec Savannah project site + +The changes made in each of the releases is described in the @samp{NEWS} +file, which can be found in the source code repository. The changes made +in versions up to 7.19 are described in the @samp{CHANGES} file. + +The @code{Download} link on the Savannah project page, takes you to the +downloads area where all the recent releases are available. Under the +@code{Source Code} menu, the @code{Browse Sources Repository} takes you +to the source files, which include, among others, the @samp{NEWS} and +@samp{CHANGES} files mentioned above. + +If you have obtained VM through a secondary distribution that does not +include all the sources, you can browse and download the sources from +the @code{Source Code} menu. The @code{Use Bazaar} entry in the menu +takes you to a page that lists various version of VM source code, and +gives instructions for downloading it via @samp{Bazaar} (@code{bzr}). + +@unnumberedsec Technical support + +VM has a dedicated usenet newsgroup @code{gnu.emacs.vm.info} and a +gmane newsgroup @code{gmane.emacs.viewmail}, in which the developers +and the active users participate. This is the first port of call for +getting help with VM. The archives of the newsgroup dating back to +the very beginning can be found at the Google Groups site +@uref{http://groups.google.com/group/gnu.emacs.vm.info/topics}. The +discussions can also be accessed by email via a mailing list +@uref{viewmail-info}. Please go to the Savannah home page to +subscribe to it. + +The easiest way to report bugs that need fixing is to use the command +@code{M-x vm-submit-bug-report} within VM. This prepares an email +message by including a state of your VM program which will allow the +developers to reproduce your problem. (Potentially sensitive information +such as passwords are not included in this state.) Please include a +detailed description of the problem and how it arose. The developers +may need to ask you for further information or ask you to try +alternative approaches to narrow down the problem. + +The best way to report bugs is via the Launchpad bug tacker. See below. + +@unnumberedsec Get Involved + +VM is now supported and maintained by the user community. So, as an +active user, your participation is key to keep the project going. + +Consider registering as a user of the Launchpad development site +@uref{http://launchpad.net/vm}. This +allows you to communicate with the developers and other users using a +private Launchpad email address. In particular, you can contribute bug +reports and participate in the bug report discussions. + +You can download the development versions of VM and act as an ``alpha'' +tester. This will allow you to shape the new developments and features +and make suggestions that will be valuable to the developers. + +To download the development version, identify the ``branch'' that you +would like to download, and use Bazaar version control system with an +appropriate Launchpad @acronym{URL}. For example, the command +@command{bzr get lp:vm} can be used to download the main development +branch. + +You can also make change to the branch you have downloaded, and submit +them to the developers for inclusion in the project. The @code{README} +file in the distribution explains how to do this. Alternatively, you +can create a separate branch in your own space on the Launchpad web +site, and submit your changes to that branch. The developers can review +and merge your branch with the main development when your changes +are ready. + +@unnumberedsec Contributors + +Contributions to the code from the following members of the VM community +are gratefully acknowledged: + +@itemize +@item Aidan Kehoe +@item Glenn <unknown last name> +@item Jens Gustedt +@item John J Foerch +@item Kevin Rogers +@item Kyle Jones +@item Rob Hodges +@item Robert Marshall +@item Robert P. Goldman +@item Katsumi Yamaoka +@item Julian Bradfield +@item Samuel Bronson +@item Brent Goodrick +@item Tim Cross +@item Arik Mitschang +@item Anthony Mallet +@item Noah Friedman +@end itemize + +Please let us know if any other contributors have been missed out. + +@unnumberedsubsec Selected Releases of Kyle Jones +@itemize +@item Version 4.10, released in 1989. +@item Version 5.00, released in 1990. +@item Version 6.00, released 6 January, 1997. +@item Version 7.00, released 2 December, 2001. +@item Version 7.10, released 5 March, 2003. +@item Version 7.15, released 3 May, 2003. +@item Version 7.16, released 26 May, 2003. +@item Version 7.17, released 6 July, 2003. +@item Version 7.18, released 2 November, 2003. +@item Version 7.19, released 29 September, 2004. +@end itemize + + +@unnumberedsubsec Releases of Robert Widhopf-Fenk +@itemize +@item Version 8.0.0, released 31 May, 2007. +@item Version 8.0.1, released 29 June, 2007. +@item Version 8.0.2, released 25 July, 2007. +@item Version 8.0.3, released 15 August, 2007. +@item Version 8.0.4, released 2 November, 2007. +@item Version 8.0.5, released 3 November, 2007. +@item Version 8.0.6, released 2 January, 2008. +@item Version 8.0.7, released 5 January, 2008. +@item Version 8.0.8, released 11 February, 2008. +@item Version 8.0.9, released 20 February, 2008. +@item Version 8.0.10, released 22 June, 2008. +@item Version 8.0.11, released 11 August, 2008. +@item Version 8.0.12, released 5 November, 2008. +@item Version 8.0.13, released 29 November, 2009. +@item Version 8.0.14, released 16 December, 2009. +@end itemize + + +@unnumberedsubsec Releases of VM development team +@itemize +@item Version 8.1.0, released 21 March, 2010. +@item Version 8.1.1, released 25 April, 2010. +@item Version 8.1.2, planned for release in July/August, 2010. +@item Version 8.2.0, planned for release in August/September, 2010. +@end itemize + + + + + +@node Highlights, Future Plans, History and Administration, Top +@chapter Highlights + +Here are some of the VM features that its users find most valuable: + +@cindex @acronym{BBDB} +@cindex @acronym{IMAP} +@cindex @acronym{HTML} +@cindex @acronym{MIME} +@cindex virtual folders +@itemize +@item +VM's reliability and stability. +@item +Integration within Emacs, providing ease of editing and familiar key +bindings. +@item +Speed of usage facilitated by keyboard commands. +@item +Integration with @acronym{BBDB} for maintaining contacts and email addresses. +@item +VM-Pcrisis for managing multiple mail identities. +@item +Integration with emacs-w3m for viewing @acronym{HTML} email. +@item +Comprehensive @acronym{MIME} support. +@item +Ability to operate on all attachments of a message, such as saving or +deleting. +@item +Interactive virtual folders (created by @code{V C}). +@item +Support for @acronym{IMAP} folders. +@item +Ability to delete duplicate copies of messages. +@end itemize + + +@node Future Plans, Bugs, Highlights, Top +@chapter Future Plans + +Some of the ideas being worked on for future extensions of VM are the +following: + +@itemize +@item +Ability to compose rich text email messages (in 'text/enriched' and +'text/html' modes). +@item +Incremental search in virtual folders. +@item +Thread-level operations such as killing an entire thread. +@item +Headers-only downloading of @acronym{IMAP} folders. +@item +Downloading @acronym{IMAP} messages without attachments. +@item +Support for maildir folders. +@item +A message migration/expiration facility. +@end itemize + + +@node Bugs, Internals, Future Plans, Top +@chapter Reporting Bugs +@cindex bug reports + +VM has a sophisticated bug reporting system in order to provide the +VM maintainers with adequate information about the state of VM when the +error situation occurred. However, it is still important for the +users to give as full an explanation of the problem as possible. +@xref{Bugs,,,emacs, the GNU Emacs Manual}. + + +@findex vm-submit-bug-report +The command @code{M-x vm-submit-bug-report} should be invoked from the +VM folder buffer in which a problem is encountered. This creates a +mail buffer with information about the state of VM pre-filled. Insert +suitable text to explain the problem and send the bug-report message. + +@findex vm-pop-start-bug-report +@findex vm-pop-submit-bug-report +@findex vm-imap-start-bug-report +@findex vm-imap-submit-bug-report +For mail server-associated problems dealing with @acronym{POP}/@acronym{IMAP} spool files +or @acronym{POP}/@acronym{IMAP} folders, the cause of the problem might be in the +interaction with the mail server. To identify the cause, it may be +necessary for the VM maintainer to look at the server interactions +during the problem occurrence. To capture the server interactions, +run @code{vm-pop-start-bug-report}/@code{vm-imap-start-bug-report} +before the problem occurrence and @code{vm-pop-submit-bug-report} +/@code{vm-imap-submit-bug-report} after the problem occurrence. All +the server interactions during the interval are captured and +automatically included in the bug-report. + +@node Internals, Concept Index, Bugs, Top +@chapter VM Internals + +This section gives a sketchy overview of the VM internals for the +developers/programmers. + +@menu +* Folder Internals:: Structure of the folders +* Message Internals:: Structure of the message data structure +* Summary Internals:: Details of summary generation +* Threading Internals:: Details of message threads handling +* Sorting Internals:: Details of how messages are sorted +* User Interaction:: Handling of the user interaction +* Coding Systems:: How VM handles character coding +* @acronym{MIME} Display:: How VM displays @acronym{MIME} messages +* @acronym{MIME} Composition:: How @acronym{MIME} messages are composed +* Virtual Folder Internals:: Details of virtual folders and selectors +* Extents and Overlays:: How VM deals with XEmacs and GNU Emacs differences +* Timers and Concurrency:: How VM runs asynchronous timers +@end menu + +@node Folder Internals, Message Internals , , Internals +@section Folder Internals + +@cindex mbox +@inindex mbox +VM stores mail folders in the Unix @samp{mbox} format (in all its variants). +Internal to Emacs, the mbox is loaded into a text buffer (the @dfn{Folder} +buffer) and individual messages are identified by remembering markers into +the text buffer. @xref{Message Internals}. + +The Unix @dfn{mbox} format is described in the RFC 4155 specification of the +Internet Engineering Task Force. The mail folder is a text file consisting +of a sequence of messages, with each message consisting of a series of +headers followed by a message body. The beginning of each message is +delineated by a separator line starting with the string ``From '' and the +end of the message by a blank line. The leading separator line in VM folder +is of the form ``From VM ...'' where the ``...'' records the time at which +VM first saw the message. The format of the individual messages is as per +the RFC 2822 specification, except that Line-Feed characters may be used to +delineate the end of lines in the "Unix" format. + +@vindex vm-folder-type +@cindex From_ folder type +@cindex BellFrom_ folder type +@cindex From_with-Content-Length folder type +@cindex System V +@inindex vm-folder-type +@inindex From_ folder type +@inindex BellFrom_ folder type +@inindex From_with-Content-Length folder type +@inindex System V +Three variants of the @code{mbox} format are recognized by VM, called +@code{From_}, @code{BellFrom_} and @code{From_with-Content-Length}. +In a @code{From_} type mbox, every message has a leading and trailing +separator line, as indicated above. In a @code{BellFrom_} type mbox, +the trailing separator line can be missing. (This is so that the +mbox's from the old System V format can be handled.) In a +@code{From_with-Content-Length} type mbox, the @code{From} separator +line stores the length of the message. So, no trailing separator line +is required. + +@cindex @acronym{MMDF} format +@cindex Babyl format +@inindex @acronym{MMDF} format +@inindex Babyl format +In addition to these mbox formats, VM also handles the @acronym{MMDF} format and +the Emacs Rmail's Babyl format. The variable @code{vm-folder-type} +stores the type of the folder being used. + +@inindex X-VM-v5-Data header +To every message, VM adds a header with the field name +``X-VM-v5-Data:'' and stores in it the information about the message it +wishes to remember between sessions. + +The first message of the VM folder file contains additional headers used +by VM for remembering information between sessions. + +@itemize +@inindex X-VM-Bookmark +@item +X-VM-Bookmark. This header stores the position of the cursor, as a +message number, in effect when VM saved the folder. Upon revisiting the +folder, VM attempts to put the cursor back at this position. +@item +@inindex X-VM-Last-Modified +X-VM-Last-Modified. The date and time at which the folder was last +modified. +@item +@inindex X-VM-Message-order +X-VM-Message-Order. This header lists the order in which the messages +should be listed. +@item +@inindex X-VM-Labels +X-VM-Labels. This header lists the message labels that have been used in +the folder. +@item +@inindex X-VM-VHeader +X-VM-VHeader. This header lists the values of @code{vm-visible-headers} +and @code{vm-invisible-header-regexp} that were in effect when the +folder was saved. The messages in the folder would have their headers +arranged according to these variables. +@item +@inindex X-VM-Summary-Format +X-VM-Summary-Format. This header stores the format string for the +summary lines. +@item +@inindex X-VM-@acronym{POP}-Retrieved +X-VM-@acronym{POP}-Retrieved. This header lists all the messages that have +been retrieved from @acronym{POP} servers together with the identifying +information for the @acronym{POP} servers. VM refrains from retrieving these +messages again in future in order to avoid duplication. +@item +@inindex X-VM-@acronym{IMAP}-Retrieved +X-VM-@acronym{IMAP}-Retrieved. This header lists messages that have been +retrieved from @acronym{IMAP} servers together with their identifying +information on the @acronym{IMAP} servers (@acronym{UID} and +@acronym{UIDVALIDITY}). VM refrains from retrieving these messages again in +future in order to avoid duplication. (For local folders, this lists all +the retrieved messages except those known to be expunged on the server. For +@acronym{IMAP} folders, it does not list all the retrieved messages because +they are normally the same as those on the server. Only the messages +locally expunged in the cache folder but not known to be expunged on the +server are listed. In the normal cases, the variable is just nil in +@acronym{IMAP} folders.) +@end itemize + +@unnumberedsubsec Folder variables + +Internal to Emacs, VM stores the folder as simply a text buffer. However, it +remembers a variety of data about the message contents in the buffer +through internal variables. + +@itemize +@item +@inindex vm-message-list +@code{vm-message-list}. A list of message data structures for all the +messages in the buffer. +@item +@inindex vm-folder-type +@code{vm-folder-type}. The type of the current folder indicating how +the messages are stored: one of 'babyl, 'From_, 'BellFrom_, +'From_-with-Content-Length and 'mmdf. +@item +@inindex vm-folder-access-method +@code{vm-folder-access-method}. The method for accessing the server +message store: 'pop for pop-folders and 'imap for imap-folders, and nil +for all other folders. +@item +@inindex vm-folder-access-data +@code{vm-folder-access-data}. A vector of data for accessing the server +message store. The first two elements of the vector are the maildrop +specification for the mail server and a reference to the process +connecting to the mail server. For the 'pop access method, that is all +there is. But, for the 'imap access method, the vector has 9 other +entries detailing various pieces of data about the @acronym{IMAP} server. +@item +@inindex vm-folder-read-only +@code{vm-folder-read-only}. A boolean flag indicating whether the +folder is read-only. If so, no modifications are allowed, including +attribute changes. However, messages can be fetched from external +storage for viewing. +@item +@inindex vm-virtual-folder-definition +@code{vm-virtual-folder-definition}. If the current folder is virtual, +then this variable holds the data constituting its definition. +@item +@inindex vm-real-buffers +@code{vm-real-buffers}. If the current folder is virtual, then this +variable is a list of all the real folder buffers involved in +constructing it. +@item +@inindex vm-virtual-buffers +@code{vm-virtual-buffers}. A list of all the virtual folder buffers +that the current buffer is involved in. +@item +@inindex vm-component-buffers +@code{vm-component-buffers}. An a-list containing all the folder +buffers (real or virtual) that make up the components of the current +virtual folder, and a flag indicating whether those folders were +visited as part of visiting the virtual folder. When the virtual +folder is closed, all the folders purposely visited will also be closed.. +@item +@inindex vm-summary-buffer +@code{vm-summary-buffer}. The Summary buffer of the folder. (If the +Summary buffer gets killed for any reason, the value of this variable +becomes <killed buffer>, which is unfortunate. Therefore, most +interactive commands of VM check for killed Summary buffer and reset +this variable to nil in such a case. So, in the middle of code, this +variable can be regarded as a valid buffer pointer.) +@item +@inindex vm-presentation-buffer-handle +@code{vm-presentation-buffer-handle}. The message Presentation buffer of the +folder. (Same proviso applies as for @code{vm-summary-buffer}.) +@item +@inindex vm-presentation-buffer +@code{vm-presentation-buffer}. This seems to be a copy of the +@code{vm-presentation-buffer-handle}. Its purpose is unknown. +@end itemize + +The running state of the folder buffer is represented in a number of +buffer-local variables: + +@itemize +@item +@inindex vm-message-pointer +@code{vm-message-pointer}. A sublist of vm-message-list starting from +the current message that the cursor is on. So, the first element of +vm-message-pointer is the current message. +@item +@inindex vm-last-message-pointer +@code{vm-last-message-pointer}. Whenever the cursor is moved, the +previous value of vm-message-pointer is remembered in this variable. +@item +@inindex vm-summary-pointer +@code{vm-summary-pointer}. The message struct of the message which +has the summary pointer in the Summary buffer. +@item +@inindex vm-fetched-messages +@code{vm-fetched-messages}. List of external messages whose +bodies were fetched for viewing or other operations. +@item +@inindex vm-fetched-message-count +@inindex vm-fetched-messages +@code{vm-fetched-message-count}. The number of messages in +@code{vm-fetched-messages}. An attempt is made to keep this below the +@code{vm-fetched-message-limit}. +@item +@inindex vm-mime-decoded +@inindex @acronym{MIME} +@code{vm-mime-decoded}. The @acronym{MIME} decoding state of the current message +display: @code{undecoded} if the message is shown in undecoded plain +text form, @code{decoded} if the message is shown decoded, and +@code{buttons} if the message is shown as a series of buttons for all +its @acronym{MIME} components. The @kbd{D} command cycles through these +states. +@item +@inindex vm-system-state +@code{vm-system-state}. The state of VM in a Folder buffer or +Presentation buffer: + +@itemize +@item +@inindex previewing +@code{previewing}. +if a message is being previewed. +@item +@inindex showing +@code{showing}. +if a full message is being shown. +@item +@inindex reading +@code{reading}. +if message reading is in progress. +@end itemize + +@inindex editing +A message edit buffer is in state @code{editing}. + +A message composition buffer may be in one of these states: + +@itemize +@item +@inindex forwarding +@code{forwarding}. +if a message is being forwarded. +@item +@inindex replying +@code{replying}. +if a message is being replied to. +@item +@inindex redistributing +@code{redistributing}. +if a message is being redistributed. +@end itemize + +@item +@inindex vm-spooled-mail-waiting +@code{vm-spooled-mail-waiting}. VM periodically checks if there is new +mail in the spool files of the current folder and set this flag to t if +there is new mail. +@item +@inindex vm-undo-record-list +@code{vm-undo-record-list}. A list of undo records describing the +actions to be performed if an undo operation is invoked. Each undo +record has an action, the message, if any, to which the action +applies, and any arguments needed for the action. +@item +@inindex vm-undo-record-pointer +@code{vm-undo-record-pointer}. A pointer into the +@code{vm-undo-record-list} indicating the current position of the +undoing cycle. +@end itemize + +@unnumberedsubsubsec vm-folder-access-data + +The variable @code{vm-folder-access-data} is a vector storing data about the +state of the mail server (for @acronym{POP} and @acronym{IMAP} servers). It contains the +following items: + +@itemize +@item +@code{pop-maildrop-spec} or @code{imap-maildrop-spec}. +MAILDROP specification of the server folder. +@item +@code{pop-process} or @code{imap-process}. +The Emacs process being used to communicate with the server for this +folder. (Each folder uses a separate process to avoid unwanted +interference.) +@item +@code{imap-uid-validity}. +The @acronym{UIDVALIDITY} value of the @acronym{IMAP} folder. +@item +@code{imap-read-write}. +A boolean flag indicating whether the folder is writable. +@item +@code{imap-can-delete}. +A boolean flag indicating whether the folder allows deletions. +@item +@code{imap-body-peek}. +A boolean flag indicating whether the folder allows the @code{BODYPEEK} +command of @acronym{IMAP}. +@item +@code{imap-permanent-flags}. +The list of permananet flags that have been stored in the folder. +@item +@code{imap-mailbox-count}. +The number of messages in the folder. +@item +@code{imap-recent-count}. +The number of messages in the folder that are considered ``recent'' by the +server. +@item +@code{imap-retrieved-count}. +The number of messages present in the folder when messages were last +retrieved. This would have been the value of @code{imap-mailbox-count} at +that time. +@item +@code{imap-uid-list}. +The list of UID's and flags of the messages in the folder, +using cons cells of the form (msg-num . uid . size . flags list). The cons +cells (size . flags list) are shared with @code{imap-flags-obarray} below. +@item +@code{imap-uid-obarray}. +An obarray that binds all the UIDs of messages in the folder to their +message sequence numbers. +@item +@code{imap-flags-obarray}. An obarray that binds all the UIDs of messages +in the folder to cons cells of the form (size . flags list). These cons +cells are the same as those occurring in the @code{imap-uid-list} field. +So, any updates will be shared through both the views. The two obarrays, +@code{imap-uid-obarray} and @code{imap-flags-obarray}, bind exactly the same +set of UIDs. Jointly, they are referred to as @code{uid-and-flags-data}. +The reason for their separation is historical. +@end itemize + +@node Message Internals, Summary Internals, Folder Internals, Internals +@section Message Internals + +The message data structure is a vector containing various pieces of +data about the message, some of which is permanent and some that is +calculated during a VM session. The data is organized into four +sub-vectors: + +@itemize +@item +Location data. This data about the location of the various parts of the +message in the Folder buffer is calculated after a folder is loaded and +parsed. +@item +Soft data. This vector contains other calculated data about the +message that is specific to a VM session. +@item +Attributes. All the hard-wired message attributes are stored in this +vector. +@item +Cached Data. Calculated data that is cached for each message. +@item +Mirror Data. Extra data shared by virtual messages if vm-virtual-mirror +is non-nil. +@end itemize + +@inindex X-VM-v5-Data +The attributes vector and cached data vector are stored in the +folder on disk as the @code{X-VM-v5-Data} header of the first message. + +@subsubheading Location data +@anchor{Location data vector} + +This vector holds the data about the location of the various parts of +the message in the folder buffer. Every folder buffer or folder-like +buffer (such as a Presentation buffer) has variables that contain +message data structures. The location data is normally expected to +refer to locations in that very buffer. However, this condition is +not actually required. (See below.) + +@inindex start +@itemize +@item +@code{start}. Marker for the starting position of the message, at which a +leading separator line begins. +@inindex headers +@item +@code{headers}. Marker for the position in the buffer where the headers +of the message start. +@inindex vheaders +@item +@code{vheaders}. Marker for the position in the buffer where the +visible headers of the message start. (The headers are rearranged in +such a way that all the visible headers are towards the end of the +headers region.) +@inindex text +@item +@code{text}. Marker for the position in the buffer where the text of the +message starts. +@inindex text-end +@item +@code{text-end}. Marker for the position in the buffer where the text of +the message ends. +@inindex end +@item +@code{end}. Marker for the position in the buffer where the message +ends. +@end itemize + +Unfortunately, in the current versions of VM, the folder buffer to +which the location data point is not itself part of this vector. This +information is inferred from the context (which makes the code +brittle). The Folder buffer of the message can be obtained from the +soft data vector but the location data could also point to a +Presentation buffer. + + +@subsubheading Soft data +@anchor{Soft data vector} +This vector contains other calculated data about the message that is +specific to a VM session. + +@inindex number +@itemize +@item +@code{number}. The message number as an integer. +@inindex padded-number +@item +@code{padded-number}. The message number as a padded string. +@inindex mark +@item +@code{mark}. Flag that indicates if the message has been marked (via +@code{vm-mark-message}). +@inindex su-start +@item +@code{su-start}. The position in the Summary buffer where the summary line of +the message starts. +@inindex su-end +@item +@code{su-end}. The position in the Summary buffer where the summary line of +the message ends. +@inindex real-message-sym +@item +@code{real-message-sym}. If the message is in a virtual folder, then its +corresponding ``real message'' is the underlying message in another +folder which is described by a message data structure similar to the +current one. The real message data structures are represented by +uninterned symbols written as ``<<>>''. This field stores the symbol +representing the real message of the current message. If the current +message is a real message then this field contains its own symbol. +The use of symbols for this purpose avoids the possibility of circular +data structures. +@inindex mirrored-message-sym +@item +@code{mirrored-message-sym}. This is similar to the +@code{real-message-sym}, except that it points to the message directly +mirrored by the current virtual folder message. +@inindex reverse-link-sym +@item +@code{reverse-link-sym}. Reference to the previous message in the message list, +also represented by an uninterned symbol written as ``<--''. +@inindex message-type +@item +@code{message-type}. A symbol indicating the type of the message according to +its folder type, one of @code{BellFrom_}, @code{From_} and +@code{From_-with-Content-Length}. +@inindex message-id-number +@item +@code{message-id-number}. A number that uniquely identifies the message +within a VM session. +@inindex buffer +@item +@code{buffer}. The Folder buffer of the message. (Messages in Presentation +buffers also have this field set to the corresponding Folder buffer.) +@inindex thread-indentation +@item +@code{thread-indentation}. Indentation level of the message in its message +thread. +@inindex thread-list +@item +@code{thread-list}. List of symbols from @code{vm-thread-obarray} that give +this message's lineage. +@inindex thread-subtree +@item +@code{thread-subtree}. List of messages that form the subtree under +this message in a threaded summary display. +@inindex babyl-frob-flag +@item +@code{babyl-frob-flag}. +@inindex saved-virtual-attributes +@item +saved-virtual-attributes. Saved attributes if the message switched from +unmirrored to mirrored. +@inindex saved-virtual-mirror-data +@item +@code{saved-virtual-mirror-data}. Saved mirror data, if the message was +switched from unmirrored to mirrored. +@inindex virtual-summary +@item +@code{virtual-summary}. Summary for unmirrored virtual message. +@inindex mime-layout +@item +@code{mime-layout}. @acronym{MIME} layout information; types, ids, positions, etc of +all @acronym{MIME} entities. (See below.) +@inindex mime-encoded-header-flag +@item +@code{mime-encoded-header-flag}. Flag that indicates if the headers of the +message are @acronym{MIME} encoded. +@inindex su-summary-mouse-track-overlay +@item +@code{su-summary-mouse-track-overlay}. The overlay on the summary of this +message used for selection by mouse. +@inindex message-access-method +@item +@code{message-access-method}. The access-method to be used for the message, +inherited from its real folder. +@end itemize + + +@subsubheading Attributes +@anchor{Attributes vector} +All the hard-wired message attributes are stored in this +vector. They also get saved as part of the @code{X-VM-v5-Data} header +field when the folder is saved to disk. + +@inindex new-flag +@itemize +@item +new-flag. Flag to indicate if the message is ``new''. +@inindex unread-flag +@item +unread-flag. Flag to indicate if the message is unread. +@inindex deleted-flag +@item +deleted-flag. Flag to indicate if the message has been deleted. +@inindex filed-flag +@item +filed-flag. Flag to indicate if the message has been filed. +@inindex replied-flag +@item +replied-flag. Flag to indicate if the message has been replied to. +@inindex written-flag +@item +written-flag. Flag to indicate if the message has been saved. +@inindex forwarded-flag +@item +forwarded-flag. Flag to indicate if the message has been forwarded. +@inindex edited-flag +@item +edited-flag. Flag to indicate if the message has been edited. +@inindex redistributed-flag +@item +redistributed-flag. Flag to indicate if the message has been +redistributed. +@end itemize + +@subsubheading Cached Data +@anchor{Cached data vector} + +@cindex cached data +@inindex X-VM-v5-Data header +The data that is cached for the message and stored on the disk as part +of the @code{X-VM-v5-Data} header field. Even though this vector is +only supposed to have data that can be calculated from the message +itself, the fields pop-uidl, imap-uid and imap-uid-validity form an +exception. They are really hard data that cannot be calculated from +anything else. + +Some of the data deals with information from message headers. The +header fields can have @acronym{MIME}-encoded words in them. The strings stored +in the cached-data vector, however, are @acronym{MIME}-decoded versions of the +header fields, but they also have text properties that store the names +of the original character sets used in the header fields. This allows +the strings to be quickly re-encoded for storage on disk. + +@inindex byte-count +@itemize +@item +byte-count. The size of the message in bytes. +@item +weekday, monthday, month, year, hour, zone. Data indicating the date of +the message. +@inindex full-name +@item +full-name. The full name of the author of the message. This is a +@acronym{MIME}-decoded string with text properties. +@inindex from +@item +from. The email address of the author of the message. This is a +@acronym{MIME}-decoded string with text properties. +@inindex message-id +@item +message-id. The unique id of the message. +@inindex line-count +@item +line-count. The number of lines in the message. +@inindex subject +@item +subject. The subject string of the message. This is a @acronym{MIME}-decoded +string with text properties. +@inindex vheaders-regexp +@item +vheaders-regexp. A regular expression that can be used to find the +start of the visible headers. The headers must have been already +ordered so that the visible headers are at the bottom of the headers +section. +@inindex to +@item +to. Addresses of the recipients of the message in a comma separated +string. This is a @acronym{MIME}-decoded string with text properties. +@inindex to-names +@item +to-names. The full names of the recipients in a comma separated +string. Addresses are used if full names are not available. This is +a @acronym{MIME}-decoded string with text properties. +@inindex month-number +@item +month-number. Numeric month of the sent date. +@inindex sortable-datestring +@item +sortable-datestring. Date string of the sent date for sorting purposes (or +delivery date if @code{vm-sort-messages-by-delivery-date} is set to t). +@inindex sortable-subject +@item +sortable-subject. The subject string for sorting purposes. (Prefixes +such as ``re:'' are removed.) This is a @acronym{MIME}-decoded string with text +properties. +@inindex summary +@item +summary. A tokenized summary for the message, from which the actual +summary line can be quickly calculated. This is a list containing +tokens, such as @code{number} and @code{thread-indent}, as well as +@acronym{MIME}-decoded strings with text properties. +@inindex parent +@item +parent. The message ID of the parent of the message in its +thread. +@inindex references +@item +references. Message IDs listed in the References header of the message. +@c @inindex headers-to-be-retrieved +@c @item +@c headers-to-be-retrieved. Flag that indicates whether the headers of the +@c message have not been retrieved from the mail server (for @acronym{POP} or @acronym{IMAP} +@c folders). +@inindex body-to-be-discarded +@item +body-to-be-discarded. Flag that indicates whether they body of the +message should be discarded before the folder is saved. (This is used +in conjunction with the @code{body-to-be-retrieved} below. +@inindex body-to-be-retrieved +@item +body-to-be-retrieved. Flag that indicates whether the body of the +message has not been retrieved from the mail server. +@inindex pop-uidl +@item +pop-uidl. The @acronym{UIDL} id of the message on the @acronym{POP} server. +@inindex imap-uid +@item +imap-uid. The @acronym{UID} of the message on the @acronym{IMAP} server. +@inindex imap-uid-validity +@item +imap-uid-validity. The @acronym{UIDVALIDITY} value of the message on the +@acronym{IMAP} server. +@inindex spam-score +@item +spam-score. The spam score of the message. +@end itemize + +@subsubheading Mirror Data +@anchor{Mirror data vector} +Extra data shared by virtual messages if vm-virtual-mirror +is non-nil. + +@inindex edit-buffer +@itemize +@item +edit-buffer. If the message is being edited, this is the buffer being +used. +@inindex virtual-messages-sym +@item +virtual-messages-sym. List of virtual messages mirroring the current real +message, represented by an uninterned symbol written as ``<v>''. +@inindex stuff-flag +@item +stuff-flag. Flag to indicates if the attribute changes have been +``stuffed'' into the folder buffer. +@inindex labels +@item +labels. List of labels attached to the message. +@inindex label-string +@item +label-string. The string of labels attached to the message. +@inindex attribute-modflag +@item +attribute-modflag. Flag to indicate if the attributes of the message +have been modified since the last save. +@end itemize + +@unnumberedsubsec @acronym{MIME} layout +@anchor{@acronym{MIME} layout} +The @acronym{MIME} layout of a message, stored in the soft data of the message, +is in turn a vector containing various pieces of data. Such a vector +is used not only for the overall message, but for all its @acronym{MIME} parts +and subparts as well. + +@inindex type +@inindex Content-Type +@itemize +@item @code{type}. +A list of strings consisting of the @acronym{MIME} type of the part along +with its attributes. This comes from ``Content-Type'' header. The type +could be of the form `type/subtype'. Quotation marks are stripped from +attribute values. An example is @code{("multipart/mixed" "boundary=----_=_NextPart_001_01AFE588.63E23840")}. +@inindex qtype +@item +@code{qtype}. Like type, but the quotation marks are not stripped. +@inindex encoding +@inindex Content-Transfer-Encoding +@item +@code{encoding}. The @acronym{MIME} encoding used for the part. It comes from the +``Content-Transfer-Encoding'' header. +@inindex id +@inindex Content-ID +@item +@code{id}. The id obtained from the ``Content-ID'' header of the part. +@inindex description +@inindex Content-Description +@item +@code{description}. A description string obtained from the +``Content-Description'' header of the part. +@inindex disposition +@inindex Content-Disposition +@item +@code{disposition}. A list of strings obtained from the +``Content-Disposition'' header of the part. Quotation marks are +stripped from attribute values. (An example is @code{(``attachment'', +``filename=mydocument.doc'')}.) +@inindex qdisposition +@item +@code{qdisposition}. Like disposition, but the quotation marks are not +stripped. +@inindex header-start +@item +@code{header-start}, @code{header-end}, @code{body-start} and +@code{body-end}. Markers into the content buffer delineating the +headers/body of the @acronym{MIME} part. +@inindex parts +@item +@code{parts}. A list of @acronym{MIME} layouts for the individual subparts of this part. +@inindex cache +@item +@code{cache}. A symbol that is unique to this @acronym{MIME} part. Other data is +stored as properties of this symbol: +@itemize +@inindex vm-mime-display-external-generic +@item +@code{vm-mime-display-external-generic}. +This property stores the id of the process used to externally display +the @acronym{MIME} part as well as the name of the temporary file used. +@inindex vm-mime-display-internal-image-xxxx +@item +@code{vm-mime-display-internal-image-xxxx}. +This property stores the name of the temporary file where the image is +stored. For an image represented as image strips, it actually stores +a list with a number of other data items. +@inindex vm-image-modified +@item +@code{vm-image-modified}. +This property stores a boolean flag indicating that the image has been +modified. +@inindex vm-mime-display-internal-audio/basic +@item +@code{vm-mime-display-internal-audio/basic}. +This property stores the name of the temporary file where the audio +clip is stored. +@inindex vm-message-garbage +@item +@code{vm-message-garbage}. +@end itemize +@inindex message-symbol +@item +@code{message-symbol}. A reference to the message that contains the @acronym{MIME} +part. Represented as a symbol (that is, an interned key into a hash +table). This is a different symbol from the real-message-sym of the +message. +@inindex display-error +@item +@code{display-error}. If the display of a @acronym{MIME} part fails, its error string is +stored here. +@inindex layout-is-converted +@item +@code{layout-is-converted}. Flag indicating that @acronym{MIME} type conversion has been +performed on this part. @pxref{@acronym{MIME} type conversion}. +@inindex unconverted-layout +@item +@code{unconverted-layout}. If the @acronym{MIME} type conversion has been performed on +this part, then this holds the original unconverted layout. +@end itemize + +@unnumberedsubsec Cross-buffer sharing of data + +@inindex vm-message-list +@inindex vm-message-pointer +Every Folder buffer has a @code{vm-message-list} and a +@code{vm-message-pointer} list containing message data vectors. + +Every Presentation buffer also uses a @code{vm-message-pointer} list +with a single message (the one being presented). The message data +vector in the Presentation buffer has its own location data, but +@i{shares} all other components with the message in the Folder buffer. +This allows the Presentation buffer to, for example, change the +attributes of the message without having to switch context to the +Folder buffer. + +Virtual folders, which contain only references to messages in other +folders, store just a single message body in the Folder buffer. +However, they have message descriptors for all the messages in +@code{vm-message-list}. All the message descriptors use the same +location data vector, because only one message body can be stored in +the Folder buffer, but have separate Soft data vectors. (This allows, +for instance, virtual folders to have their own threads, which could +in general be different from the threads in the underlying folders.) +The other sub-vectors are shared with the underlying real folders. (In +particular, the tokenized summary line is the same in the virual +folders and their underlying folders.) + + +@node Summary Internals, Threading Internals, Message Internals, Internals +@section Summary Internals + +@inindex vm-summary-line-format +@inindex summary line, tokenized +@inindex tokenized summary line +Generating a summary is quite a time-consuming operation. VM uses a +variety of tricks to speed up the generation of summaries. + +The format of the summary lines is specified in the variable +@code{vm-summary-line-format}. The information that needs to go into +the summary lines is divided into two classes: + +@itemize +@item +Information that is fixed for each message. Examples include the +subject, author and other header information. +@item +Information that is variable during a VM session. Examples include +the message number and thread indentation. +@end itemize + +A @emph{tokenized summary line} is a list whose elements can be +strings, representing fixed information in a message, and tokens, +representing variable information. VM calculates a tokenized summary +line for each message and caches it in the cached-data vector. +The following forms of tokens are used in tokenized summary lines: + +@itemize +@item +@code{number}. +Stands for the message number in the linear order of the summary. +@item +@code{mark}. +Stands for an indicator of message mark (whether the message is marked +at present). +@item +@code{thread-indent}. +Stands for the indentation to be used for the message's summary +depending on its position in the message thread. +@item +@code{group-begin}, @code{group-end}. +Brackets used to denote groups of items that might have particular +formatting constraints. +@end itemize + +The function @code{vm-tokenized-summary-insert} converts a tokenized +summary line into a string and inserts it in the summary buffer. The +minibuffer message ``Generating summary...'' is used to show the +progress of generating summary lines from tokenized summaries. + +Buffer local variables in each Folder buffer responsible for +maintaining summary information: + +@itemize +@item +@inindex vm-summary-pointer +@code{vm-summary-pointer}. The message selected by the cursor in the +Summary window. +@item +@inindex vm-summary-redo-start-point +@code{vm-summary-redo-start-point}. A pointer into the +@inindex vm-message-list +@code{vm-message-list} indicating the first message for which the +summary line must be redisplayed. All the messages from here on are +assumed to require a summary redisplay. The assumption is usually valid +because the message numbers of all the succeeding messages might have +changed. But, if message numbers are not included in the summary lines, +then this results in unnecessary work. +@item +@inindex vm-messages-needing-summary-update +@code{vm-messages-needing-summary-update}. The list of messages for +which summary lines must be redisplayed. Messages are included in this +list by calling the function @code{vm-mark-for-summary-update}. +@item +@inindex vm-numbering-redo-start-point +@code{vm-numbering-redo-start-point}. A pointer into +@inindex vm-message-list +@code{vm-message-list} indicating the first message whose message number +needs to be recalculated. +@inindex vm-numbering-redo-end-point +@code{vm-numbering-redo-end-point}. A pointer into +@code{vm-message-list} indicating the last message whose message number +needs to be recalculated. +@end itemize + +The beginning and the ending positions of each message summary line are +stored in the message's soft data vector. @pxref{Message Internals}. +The positions within the summary line have text-properties set, which +give the data about the message: + +@itemize +@item +@inindex vm-message +@code{vm-message}. The message struct for which this line is a summary. +@end itemize + +@node Threading Internals, Sorting Internals, Summary Internals, Internals +@section Threading Internals + +@inindex vm-thread-obarray +@inindex vm-thread-subject-obarray +@inindex In-Reply-To header +@inindex References header +Message threads required for threaded summaries are calculated using +message ID's, which are unique when the message was originally +composed. However, VM may need to deal with multiple copies of the +same message received via possibly different routes. So, message ID's are +not unique for messages inside VM. + +Messages composed as replies generally have an ``In-Reply-To'' header. +The message mentioned in this header is referred to as the parent of +the message. In addition, messages also arrive with a ``References'' +header which lists all the ancestors of the message, with the oldest +message being listed first. The last message listed in the +``References'' header is the direct parent of message. It is +important to keep in mind that all the messages listed in the +``References'' header may not be present in the VM folder. + +Thread trees are constructed using the ``In-Reply-To'' headers and +``References'' headers. Jamie Zawinski has done a good analysis of +the information contained in these headers which can be found on the +web. VM's threading algorithm is currently based on these ideas. +These trees are called reference-based threads. + +@inindex vm-thread-using-subject +In addition, VM also allows threads to be built using the subject +headers via the option @code{vm-thread-using-subject}. Subject-based +threading is used in addition to reference-based threading. So, in a +subject-based thread, the root message would be the oldest message +with that subject and, below it, would be reference-based threads all +of which share the same subject. The roots of these reference-based +threads are referred to as the ``members'' of the subject thread. +Subject threading is only one level deep, whereas reference threading +can be arbitrarily deep. + +Threads are built using two hash tables @code{vm-thread-obarray} and +@code{vm-thread-subject-obarray}. The former keeps track of the thread +obtained by following parent and reference chains. The latter keeps track +of messages with the ``same subject''. To prevent messages from jumping +from one thread to another within the same VM session, the subject used is +not the message's own subject, but rather the subject of the oldest message +in the thread. This subject is retained even if the oldest message is +expunged. + +The message ID's are interned in @code{vm-thread-obarray} and the +following information is stored for each message ID: + +@itemize +@item messages: +The list of messages that carry this message ID in the folder. There +could be none, if we only know this message from its appearance in +other ``References'' headers. +@item message: +The ``canonical'' message with this message ID. It is typically the +first message encountered by VM with this message ID. If there are no +messages with this ID, then the field is @code{nil}. +@item date: +The date of the message. +@item parent: +The interned message ID of the parent of this message. (The folder +may or may not contain a message with this ID.) If there is no +parent, then this is @code{nil} +@item children: +The interned message ID's of all the children of this message. (The +folder may or may not contain messages with these ID's.) +@item youngest-date: +The date of the youngest message in the thread, among all the messages +present in the folder. +@item oldest-date: +The date of the oldest message in the thread, among the messages +present in the folder. +@item oldest-subject: +The subject of the oldest message in the thread, among the messages present +in the folder. +@end itemize + +The @code{vm-thread-subject-obarray} interns each subject string found +in the folder and maps it to a vector containing the following elements: + +@itemize +@item id-sym: +The interned message ID of what is likely to be the root of the +thread, which is, at any rate, the oldest message with this subject. +@item date: +The date of the root message. +@item members: +A list of interned message ID's for the ``members'' of the subject +thread, which are messages without any reference-based ancestors. The +root message represented by @code{id-sym} is not included as a member. +@item messages: +The list of all the messages in the folder that have this subject. +@end itemize + +@inindex threads, building +@b{Building threads} involves calculating all the data stored with the +@code{vm-thread-obarray} and @code{vm-thread-subject-obarray}. These two +collections of data are calculated in sequence, because the subject +threads are based on the reference threads. + +@inindex thread-subtree +@inindex thread-list +@inindex thread-indentation +After the threads are built, the @code{thread-list}, +@code{thread-indentation} and the @code{thread-subtree} fields of the +Soft data vector are calculated as needed on demand and cached. +(@xref{Soft data vector}.) These fields cannot be calculated without +building threads first. + +When new messages are assimilated, they are added to the threads that +might have been already built, and the thread-related fields in the +Soft data vector are erased so that they will be recalculated. The +@code{thread-subtree} field is erased for all the ancestors of the +assimilated message. The @code{thread-list} and +@code{thread-indentation} fields are erased for all the descendants of +the assimilated message. + +@inindex unthread +Before messages in the folder are expunged, they are @b{unthreaded}. +This involves removing them from their respective thread trees. It +also involves the erasure of the @code{thread-subtree} field of all +their ancestors and the @code{thread-list} and +@code{thread-indentation} fields of the descendants. + +@unnumberedsubsec Error handling + +The code for threading has to be robust in the presence of erroneous +information in the message headers. We have no control over the mail +clients that produce those messages and faulty information should not +lead to VM hanging or producing errors. It should just do the best +job it can in the presence of imperfect information. + +It is possible that the information in the headers give rise to cycles +in the thread trees. Kyle Jones's original implementation allowed +these cycles to exist, but all functions that traversed the thread +trees were protected to detect cycles. However, since thread trees +are updated when new messages are received or existing messages are +expunged, this led to unstable results. + +Following Jamie Zawinski's recommendation, VM now avoids cycles in +thread trees. Loop detection is still carried out during traversal as +a double safeguard. + +VM gives priority to the parent information contained in the +``In-Reply-To'' headers in preference to the information in the +``References'' headers. However, if an ``In-Reply-To'' header gives +rise to a cycle, it is ignored, and then ``References'' headers might +be used to fill in the missing information. + + + + +@node Sorting Internals, User Interaction, Threading Internals, Internals +@section Sorting Internals + +@inindex vm-key-functions +Sorting of messages in VM is carried out using the Emacs built-in +sorting function, which is generic in the comparison +operation to be used for sorting. The required comparison operation +is expressed as a sequence of basic comparison operations such as +comparison by date, by author, by subject etc. The dynamic +variable @code{vm-key-functions} is bound to a list of comparison +functions before calling the Emacs sort function. + +@inindex vm-sort-compare-xxxxxx +The function @code{vm-sort-compare-xxxxxx} uses the functions listed +in @code{vm-key-functions} to do the overall comparison. It compares +the given messages using the key functions in sequence. If the first +key function decides one of the messages to precede the other, then +the comparison is over. If the messages are found to be equivalent +according to the first key function then the second key function is +tried and, if they are still equivalent, then the next key +function is tried and so on. This is called the lexicographic +combination of the given key functions. + +@inindex vm-sort-compare-thread +Sorting by threads is special. When messages are to be sorted by +threads, all the messages belonging to a thread should appear +together. The required effect is achieved by using +@code{vm-sort-compare-thread} as the first key function in the +sequence. This function checks to see if the two messages belonging +to the same thread. If they do then the farthest ancestors of the two +messages that share the same parent are returned so that the remaining +comparison operations can be applied to these ancestors. The +rationale is that these ancestors are the roots of the thread subtrees +that the two messages belong to. So, the relative ordering of the +messages should be the same as the relative ordering of these +ancestors. If the two messages belong to different threads then the +thread roots of the two messages are returned, again with the same +rationale. + +Threaded summaries can be sorted by any key, e.g., by author +(full-name). It is most common to sort them by ``activity,'' i.e., +the order of the most recent message in the thread or subthread. +Sorting them by ``date'' means using the date of the root message of +the thread or subthread. + +@node User Interaction, Coding Systems, Sorting Internals, Internals +@section User Interaction + +@inindex vm-mail-buffer +@inindex vm-select-folder-buffer-and-validate +@inindex vm-user-interaction-buffer +For each mail folder, VM creates three kinds of buffers in Emacs: the +Folder buffer, the Presentation buffer and the Summary buffer. All +three types of buffers have the same user interface as far as +possible: the same key bindings, menu bars, tool bars and also the +same @i{commands}. The functions implementing the commands must +therefore work irrespective which of the three buffers they are +invoked in. This makes VM quite different from most Emacs modes. + +@inindex vm-mail-buffer +@inindex vm-summary-buffer +@inindex vm-presentation-buffer +VM stores the identity of the Folder buffer in a buffer-local variable +@code{vm-mail-buffer} in each of the other types of buffers. +Conversely, each Folder buffer uses buffer-local variables +@code{vm-summary-buffer} and @code{vm-presentation-buffer} to store +the identity of the other buffers. + +@inindex vm-user-interaction-buffer +@inindex vm-select-folder-buffer-and-validate +Whenever a VM command is invoked by the user, VM calls a function +called @code{vm-select-folder-buffer-and-validate}, which sets the +current-buffer to the Folder buffer. It also stores the identity of +the buffer with the user's focus in a global variable called +@code{vm-user-interaction-buffer}. Thus, at every point during the +command execution, VM has knowledge of all the buffers involved as +well as the buffer in which the command execution was initiated. + +[More to be filled in on @code{vm-display} etc.] + +@inindex vm-mode-menu-map +The default menu bar of VM contains VM-specific menus, replacing the +standard Emacs menus. This is achieved by setting the buffer-specific +menu bar to one in which the Emacs menus are @code{undefined} (at +least in Gnu Emacs). + +VM computes its standard menu bar and stores it internally: + +@itemize +@item +In Gnu Emacs, this is stored in the keymap @code{vm-mode-menu-map}. +@item +In XEmacs ... +@end itemize + +@noindent +The menu bar also has a menu, or a menu item, to switch back to the +standard Emacs menu bar. +@inindex vm-use-menus +The computed menu bar is then installed depending on the setting of +@code{vm-use-menus}. +If the user selects the action to revert to the standard Emacs menu +bar, the installation is easily reverted. + +@itemize +@item +In Gnu Emacs, the installation involves inserting a key binding for +@code{menu-bar}. +@item +In XEmacs, ... +@end itemize + +@inindex vm-menu-toggle-menubar +@noindent When the user picks a menu item to revert to the +Emacs menu bar, the function @code{vm-menu-toggle-menubar} is invoked, +which installs a fresh menu bar retaining the standard Emacs menus. +The same function is used to reinstall the dedicated VM menu bar when +needed. + +@node Coding Systems, Virtual Folder Internals, User Interaction, Internals +@section Coding Systems + +@inindex coding system +A Coding System is a way of encoding characters as bit patterns. +@pxref{Coding System Basics,, Coding System Basics, elisp, Emacs Lisp +manual}. US-ASCII is a coding system for English. Other coding +systems are used to encode the various languages of the world, e.g., +@code{iso-latin-1} for Western European languages, and +@code{hebrew-iso-8bit} for Hebrew. Emacs also uses its own internal +coding system for characters, which can encode all character sets +currently in existence. But the internal coding system can vary between +different versions of Emacs. + +@inindex mime-charset +@inindex coding-system-get +@inindex charset +@inindex vm-mime-mule-coding-to-charset-alist +@inindex vm-mime-mule-charset-to-coding-alist +Emacs defines a property called @code{mime-charset} for each +implemented coding system, which is the official preferred name of the +@acronym{MIME} character set that it corresponds to. For example, +@code{iso-latin-1} corresponds to the @acronym{MIME} charset @code{iso-8859-1}, +and @code{hebrew-iso-8bit} corresponds to the @acronym{MIME} charset +@code{iso-8859-8}. The Emacs function @code{coding-system-get} can be +used to extract the @code{mime-charset} property of a coding system. +VM stores all the known coding systems and the corresponding @acronym{MIME} +charsets in its internal variables +@code{vm-mime-mule-coding-to-charset-alist} and +@code{vm-mime-mule-charset-to-coding-alist}. + +@inindex Content-Type +@inindex decode-coding-region +@inindex encode-coding-region +@acronym{MIME} messages specify the character set that their content is in, +in the Content-Type header. VM uses this information to decode the content +to the Emacs internal coding system. This is done using the function +@code{decode-coding-region}. Conversely, VM encodes the outgoing messages +into the default or chosen @acronym{MIME} character set using the function +@code{encode-coding-region}. + +@inindex decode-coding-string +@inindex encode-coding-string +@inindex base 64 +@inindex quoted printable +The headers of email messages can only be in US-ASCII. So header fields +in other character sets are encoded using either base-64 or +quoted-printable encoding (which give ASCII strings) and annotated +with the name of the original character set. Such annotations look +like @code{=?charset?B?}. They can apply +to individual words or sequences of words appearing the in the +headers. Note that the annotation @code{?B?} signifies base-64 +encoding of the byte stream. Similarly the annotation @code{?Q?} might +be used to denote the quoted-printable encoding. +VM decodes such strings using the function @code{decode-coding-string}. +Conversely, the headers of outgoing messages are encoded using +@code{encode-coding-string} + +@node Virtual Folder Internals, @acronym{MIME} Display, Coding Systems, Internals +@section Virtual Folder Internals + +@inindex virtual-folder-definition +@inindex vm-virtual-folder-alist +A virtual folder is characterized by its definition, which is stored in the +buffer-local variable @code{virtual-folder-definition}. The form of the +definition is as given in @code{vm-virtual-folder-alist}. @xref{Defined +Folders, vm-virtual-folder-alist}. It is a collection of clauses, with each +clause listing a collection of folders and a collection of virtual +selectors. + +Each virtual selector @var{X} has a corresponding Lisp function +@samp{vm-vs-@var{X}}, whose purpose is to check whether a given message +matches the selector. The arguments for @samp{vm-vs-@var{X}} are a message +data structure @code{m} and all the arguments for the virtual selector +@var{X}. + +For example, the virtual selector @code{author} has a string argument, +representing the author name. The corresponding Lisp function is defined +as: + +@example +(defun vm-vs-author (m author-name) + (or (string-match author-name (vm-su-full-name m)) + (string-match author-name (vm-su-from m)))) +@end example + +@noindent The definition checks to see if the given @code{author-name} +pattern occurs in the full name of the author (@code{vm-su-full-name}) or +the email address of the author (@code{vm-su-from}). + +The @code{author} selector is then registered in four places: + +@itemize +@inindex vm-virtual-selector-function-alist +@item +The variable @code{vm-virtual-selector-function-alist}, which contains pairs +of the form @samp{(@var{SELECTOR} . @var{FUNCTION})}. For the @code{author} +selector, the pair is @code{(author . vm-vs-author)}. + +@inindex vm-virtual-selector-arg-type +@item +The selector symbol @code{author} is given a property +@code{vm-virtual-selector-arg-type} indicating the type of argument it +requies: + +@example +(put 'author 'vm-virtual-selector-arg-type 'string) +@end example + +@inindex vm-supported-interactive-virtual-selectors +@item +The variable @code{vm-supported-interactive-virtual-selectors}, which +contains lists of strings, each string being the name of a virtual +selector. For the @code{author} selector, the list is @code{("author")}. +Including the selector in this variable allows it to be used in creating +interactive virtual folders (search folders). + +@inindex vm-virtual-selector-clause +@item +The selector symbol @code{author} is given a property +@code{vm-virtual-selector-clause} indicating the prompt string for +interactive use: + +@example +(put 'author 'vm-virtual-selector-clause "with author matching") +@end example +@end itemize + +@noindent Evidently, the last two registrations are only needed for interactive +selectors that can be used with the @kbd{V C} command. + + +@node @acronym{MIME} Display, @acronym{MIME} Composition, Virtual Folder Internals, Internals +@section @acronym{MIME} Display + +@inindex vm-decode-mime-layout +The @acronym{MIME} layout of a message is stored in the @code{mime-layout} +field of the Soft data vector of the message. (@xref{@acronym{MIME} +layout}.) The @acronym{MIME} layout is in general a tree structure of +``@acronym{MIME} parts''. The function @code{vm-decode-mime-layout} is +responsible for traversing the tree structure at each @acronym{MIME} part +and displaying it appropriately. + +The function @code{vm-decode-mime-layout} goes through the following +sequence of decisions: + +@enumerate +@item +If the @acronym{MIME} part is a @code{multipart} type, then the subparts are +displayed as needed. If it is a single part, it proceeds as follows. +@item +If the @acronym{MIME} part should not be displayed automatically, it is +displayed as a button. (An automatically displayed @acronym{MIME} type is one +listed in @code{vm-mime-auto-displayed-content-types} +but not listed in the corresponding exceptions.) +@item +If the @acronym{MIME} part should be displayed internally and VM is able to do +so, then it is displayed internally. (An internally displayed @acronym{MIME} +type is one listed in @code{vm-mime-internal-content-types} but not +listed in the corresponding exceptions.) +@item +Otherwise, the @acronym{MIME} part is displayed externally. An external viewer +is found from +@code{vm-mime-external-content-types-alist} and it is invoked to +display the @acronym{MIME} part. +@end enumerate + +@inindex message/external-body +@acronym{MIME} parts of type @samp{message/external-body} need special +treatment. If they are not asked to be auto-displayed, then they are +displayed as buttons, but the button caption may use information from the +child part (the actual object that is in the external-body) such as its type +and description. If a @code{message/external-body} part is asked to be +auto-displayed, then the child part is fetched from the external source and +stored in an internal buffer. It may be auto-displayed if it is appropriate +to do so, or shown in turn as a button. + +@inindex @acronym{MIME} button +@acronym{MIME} buttons are displayed as regions of text displaying button +labels. In addition, they have an overlay/extent placed on them, +which has a number of properties associated with it: + +@itemize +@item @code{vm-button}. +Always @code{t}. +@item @code{vm-mime-layout}. +Gives the layout of the @acronym{MIME} part. +@item @code{vm-mime-function}. +The function that carries out the action represented by pressing the +button. +@item @code{vm-mime-disposable}. +Set to true if the button should be removed when it is replaced by the +@acronym{MIME} object. +@inindex vm-mime-button-face +@item @code{face}. +Set to the value of @code{vm-mime-button-face}. +@item @code{local-map} (FSF Emacs) or @code{keymap} (XEmacs). +Set to a keymap that includes @code{vm-mime-reader-map}, binding the +@kbd{$} keys. +@end itemize + + +@node @acronym{MIME} Composition, Extents and Overlays, @acronym{MIME} Display, Internals +@section @acronym{MIME} Composition + +@inindex attachment button +A @acronym{MIME} message is composed just like a normal message. When objects +are attached using commands like @code{vm-attach-file}, +@b{attachment buttons} are created in the message composition buffer. An +attachment button is a region of text that looks like: + +@example +[Attachment mary.jpeg, image/jpeg] +@end example + +@noindent Various text properties are associated with an attachment +button, allowing it to be turned into an actual attachment when the +message is sent. + +The representation of the attachment buttons differs in GNU Emacs and +XEmacs. In GNU Emacs, the region of text is given @i{text properties} +that represent the metadata about the object. In XEmacs, the region +of text is given an @i{extent}, which is then given properties +representing the metadata. The reason for the different +representations is that in GNU Emacs, only text properties are +preserved under killing and yanking. + +The following properties are defined for attachment buttons: + +@itemize +@item @code{vm-mime-object}. +The object denoting the @acronym{MIME} attachment. It is either + +@itemize +@item +a string denoting a file name, +@item +a buffer containing the file to be attached, +@item +a list of the form (buffer, start, end, filename) indicating a region in a +buffer, typically the Folder buffer, or +@item +@code{t} indicating that the attachment is another @acronym{MIME} +object in a VM folder. +@end itemize + +@noindent +In the last case, the @code{vm-mime-layout} +property describes the rest of the metadata. +@item @code{vm-mime-type}. +A string denoting the @acronym{MIME} type of the object. (Note that it is a +single string, unlike the @code{type} component of a @acronym{MIME} layout.) +@item @code{vm-mime-parameters}. +A list of strings denoting the parameters of the @acronym{MIME} type. +@item @code{vm-mime-description}. +A string for the @acronym{MIME} description of the object. +@item @code{vm-mime-disposition}. +A list describing the @acronym{MIME} disposition. +@item @code{vm-mime-encoded}. +A boolean indicating whether the object has @acronym{MIME} headers. +@item @code{vm-mime-encoding}. +The @acronym{MIME} encoding used, if it is already encoded. +@item @code{vm-mime-forward-local-refs}. +Whether or not references to local external-body objects should be +forwarded as is. +@item @code{fontified}. +Standard text property. +@item @code{duplicable}. +Set to @code{t} in XEmacs allowing the extent to be +preserved under killing and yanking. +@item @code{front-nonsticky} and @code{rear-nonsticky}. +Standard stickiness of text properties in GNU Emacs. +@end itemize + +@inindex vm-mime-fake-attachment-overlays +When a composed message is sent, the attachment buttons are replaced +by actual attachment objects. In FSF Emacs, the attachment buttons +are first converted into ``fake'' overlays before @acronym{MIME} encoding, in a +function called @code{vm-mime-fake-attachment-overlays}. This allows +the next stage to treat both FSF Emacs and XEmacs using the same +logic. + +The function @code{vm-mime-encode-composition} then encodes the composition +buffer, by selecting each attachment button and replacing it with the +corresponding object. The bodies of @samp{external-body} objects are also +retrieved at this stage. Unless the objects were already +@acronym{MIME}-encoded, they are @acronym{MIME}-encoded and made into +@acronym{MIME} parts by adding suitable headers. The message itself is +given @acronym{MIME} headers describing its content and then handed to Emacs +message-sending functions. + +@unnumberedsubsec Yanking or Forwarding @acronym{MIME} Messages +@inindex yank +@inindex include +@inindex vm-include-mime-attachments +When another message is yanked or ``included'' in a message composition, +the handling of attachments depends on the variable +@code{vm-include-mime-attachments}. If the variable is @code{nil}, then +the attachments are displayed as token buttons in @i{plain text} that +appear similar to: + +@example +[DELETED ATTACHMENT mary.jpg, image/jpeg] +@end example + +@noindent The function @code{vm-decode-mime-layout} is employed to +generate the yanked text along with such token buttons. + +If @code{vm-include-mime-attachments} is @code{t}, then first the +@code{vm-decode-mime-layout} function is employed to generate proper +@acronym{MIME} buttons for all the attachments. In a second step, the +@acronym{MIME} buttons are replaced by attachment buttons using a function +called @code{vm-mime-convert-to-attachment-buttons}. These attachment +buttons are then handled as described above. + + + +@node Extents and Overlays, Timers and Concurrency, @acronym{MIME} Composition, Internals +@section Extents and Overlays + +@inindex extents +@inindex overlays +XEmacs and GNU Emacs differ in how they represent non-textual +properties in buffers. The web page on ``XEmacs vs GNU Emacs'' +describes the situation as follows: + +@quotation +XEmacs uses "extents" to represent all non-textual aspects of buffers; +GNU Emacs 19 uses two distinct objects, "text properties" and +"overlays", which divide up the functionality between them. Extents +are a superset of the union of the functionality of the two GNU Emacs +data types. The full GNU Emacs 19 interface to text properties and +overlays is supported in XEmacs (with extents being the underlying +representation). + +Extents can be made to be copied into strings, and then restored, by +kill and yank. Thus, one can specify this behavior on either "extents" +or "text properties", whereas in GNU Emacs 19 text properties always +have this behavior and overlays never do. +@end quotation + +While extents and overlays look similar on the surface, they differ +fundamentally in that extents are attached to text and, so, can be +killed and yanked, whereas overlays are not attached to text. XEmacs +has implemented GNU-like text properties on top of extents. So, text +properties may work more uniformly in both the Emacsen, but VM was +developed in the early days of the forking and does not use these +common features. + +The file @code{vm-misc.el} contains definitions whereby both extents +and overlays can be treated as a single type of ``VM extents''. +Wherever such VM extents can be used, there is some uniformity in the +code but, in other places, there is not. (Independently, the XEmacs +team has developed the @code{fsf-compat} package by which FSF-style +overlays are implemented on top of extents. This package is not +compatible with the way VM deals with the two types.) + +Another major differences between extents and overlays is that the +beginning and ending of overlays are markers. This has some +advantages. However, if a buffer has many overlays, normal editing +operations must update all the overlay markers, which can be +time-consuming. + +The major applications of extents and overlays in VM are the following: + +@enumerate +@item +Summary buffers use extents/overlays for each summary line. These are +implemented uniformly but, to avoid the performance problem in GNU +Emacs, all the markers are reset to nil before a summary is +regenerated and then set to their correct positions afterwards. Not +doing this correctly can seriously degrade the performance of summary +generation. +@item +Presentation buffers use extents/overlays for @acronym{MIME} buttons. These +are implemented uniformly. +@item +The message composition buffers have attachment buttons. These are +implemented using text properties in GNU Emacs and extents in +overlays. The difference is necessary because VM allows the +attachment buttons to be killed and yanked. It is not possible to +implement this functionality using overlays. +@end enumerate + +@node Timers and Concurrency,, Extents and Overlays, Internals +@section Timers and Concurrency + +VM has been designed as mainly a sequential program. However, there +three timer tasks that get scheduled to occur at regular intervals: + +@table @code +@inindex vm-flush-itimer-function +@item vm-flush-itimer-function +Stores message attributes in the folder so that they will be saved +when an auto-save is done. This is controlled by the variable +@code{vm-flush-interval}. +@inindex vm-get-mail-itimer-function +@item vm-get-mail-itimer-function +Moves new mail from maildrops into the folder. This is controlled by +the variable @code{vm-auto-get-new-mail}. +@inindex vm-check-mail-itimer-function +@item vm-check-mail-itimer-function +Checks the maildrops for any new mail. This is controlled by the +variable @code{vm-mail-check-interval}. +@end table + +@noindent These timer tasks are scheduled using the @code{itimer} package in +XEmacs and the @code{timer} package in Gnu Emacs. + + + + +@node Concept Index, Key Index, Internals, Top +@unnumbered Concept Index +@printindex cp + +@node Key Index, Command Index, Concept Index, Top +@unnumbered Key Index +@printindex ky + +@node Command Index, Variable Index, Key Index, Top +@unnumbered Command Index +@printindex fn + +@node Variable Index, Internals Index, Command Index, Top +@unnumbered Variable Index +@printindex vr + +@node Internals Index, License, Variable Index, Top +@unnumbered Internals Index +@printindex in + +@node License,, Internals Index, Top +@unnumbered GNU GENERAL PUBLIC LICENSE +@center Version 2, June 1991 + +@display +Copyright @copyright{} 1989, 1991 Free Software Foundation, Inc. +675 Mass Ave, Cambridge, MA 02139, USA + +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. +@end display + +@unnumberedsec Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software---to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + +@iftex +@unnumberedsec TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION +@end iftex +@ifnottex +@center TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION +@end ifnottex + +@enumerate 0 +@item +This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The ``Program'', below, +refers to any such program or work, and a ``work based on the Program'' +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term ``modification''.) Each licensee is addressed as ``you''. + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + +@item +You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + +@item +You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + +@enumerate a +@item +You must cause the modified files to carry prominent notices +stating that you changed the files and the date of any change. + +@item +You must cause any work that you distribute or publish, that in +whole or in part contains or is derived from the Program or any +part thereof, to be licensed as a whole at no charge to all third +parties under the terms of this License. + +@item +If the modified program normally reads commands interactively +when run, you must cause it, when started running for such +interactive use in the most ordinary way, to print or display an +announcement including an appropriate copyright notice and a +notice that there is no warranty (or else, saying that you provide +a warranty) and that users may redistribute the program under +these conditions, and telling the user how to view a copy of this +License. (Exception: if the Program itself is interactive but +does not normally print such an announcement, your work based on +the Program is not required to print an announcement.) +@end enumerate + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + +@item +You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + +@enumerate a +@item +Accompany it with the complete corresponding machine-readable +source code, which must be distributed under the terms of Sections +1 and 2 above on a medium customarily used for software interchange; or, + +@item +Accompany it with a written offer, valid for at least three +years, to give any third party, for a charge no more than your +cost of physically performing source distribution, a complete +machine-readable copy of the corresponding source code, to be +distributed under the terms of Sections 1 and 2 above on a medium +customarily used for software interchange; or, + +@item +Accompany it with the information you received as to the offer +to distribute corresponding source code. (This alternative is +allowed only for noncommercial distribution and only if you +received the program in object code or executable form with such +an offer, in accord with Subsection b above.) +@end enumerate + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + +@item +You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + +@item +You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + +@item +Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + +@item +If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + +@item +If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + +@item +The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and ``any +later version'', you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + +@item +If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + +@iftex +@heading NO WARRANTY +@end iftex +@ifnottex +@center NO WARRANTY +@end ifnottex + +@item +BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW@. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE@. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU@. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + +@item +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. +@end enumerate + +@iftex +@heading END OF TERMS AND CONDITIONS +@end iftex +@ifnottex +@center END OF TERMS AND CONDITIONS +@end ifnottex + +@page +@unnumberedsec How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the ``copyright'' line and a pointer to where the full notice is found. + +@smallexample +@var{one line to give the program's name and an idea of what it does.} +Copyright (C) 19@var{yy} @var{name of author} + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE@. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +@end smallexample + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + +@smallexample +Gnomovision version 69, Copyright (C) 19@var{yy} @var{name of author} +Gnomovision comes with ABSOLUTELY NO WARRANTY; for details +type `show w'. This is free software, and you are welcome +to redistribute it under certain conditions; type `show c' +for details. +@end smallexample + +The hypothetical commands @samp{show w} and @samp{show c} should show +the appropriate parts of the General Public License. Of course, the +commands you use may be called something other than @samp{show w} and +@samp{show c}; they could even be mouse-clicks or menu items---whatever +suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a ``copyright disclaimer'' for the program, if +necessary. Here is a sample; alter the names: + +@smallexample +@group +Yoyodyne, Inc., hereby disclaims all copyright +interest in the program `Gnomovision' +(which makes passes at compilers) written +by James Hacker. + +@var{signature of Ty Coon}, 1 April 1989 +Ty Coon, President of Vice +@end group +@end smallexample + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. + +@summarycontents +@contents +@bye diff --git a/install-sh b/install-sh new file mode 100755 index 0000000..e9de238 --- /dev/null +++ b/install-sh @@ -0,0 +1,251 @@ +#!/bin/sh +# +# install - install a program, script, or datafile +# This comes from X11R5 (mit/util/scripts/install.sh). +# +# Copyright 1991 by the Massachusetts Institute of Technology +# +# Permission to use, copy, modify, distribute, and sell this software and its +# documentation for any purpose is hereby granted without fee, provided that +# the above copyright notice appear in all copies and that both that +# copyright notice and this permission notice appear in supporting +# documentation, and that the name of M.I.T. not be used in advertising or +# publicity pertaining to distribution of the software without specific, +# written prior permission. M.I.T. makes no representations about the +# suitability of this software for any purpose. It is provided "as is" +# without express or implied warranty. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. It can only install one file at a time, a restriction +# shared with many OS's install programs. + + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit="${DOITPROG-}" + + +# put in absolute paths if you don't have them in your path; or use env. vars. + +mvprog="${MVPROG-mv}" +cpprog="${CPPROG-cp}" +chmodprog="${CHMODPROG-chmod}" +chownprog="${CHOWNPROG-chown}" +chgrpprog="${CHGRPPROG-chgrp}" +stripprog="${STRIPPROG-strip}" +rmprog="${RMPROG-rm}" +mkdirprog="${MKDIRPROG-mkdir}" + +transformbasename="" +transform_arg="" +instcmd="$mvprog" +chmodcmd="$chmodprog 0755" +chowncmd="" +chgrpcmd="" +stripcmd="" +rmcmd="$rmprog -f" +mvcmd="$mvprog" +src="" +dst="" +dir_arg="" + +while [ x"$1" != x ]; do + case $1 in + -c) instcmd="$cpprog" + shift + continue;; + + -d) dir_arg=true + shift + continue;; + + -m) chmodcmd="$chmodprog $2" + shift + shift + continue;; + + -o) chowncmd="$chownprog $2" + shift + shift + continue;; + + -g) chgrpcmd="$chgrpprog $2" + shift + shift + continue;; + + -s) stripcmd="$stripprog" + shift + continue;; + + -t=*) transformarg=`echo $1 | sed 's/-t=//'` + shift + continue;; + + -b=*) transformbasename=`echo $1 | sed 's/-b=//'` + shift + continue;; + + *) if [ x"$src" = x ] + then + src=$1 + else + # this colon is to work around a 386BSD /bin/sh bug + : + dst=$1 + fi + shift + continue;; + esac +done + +if [ x"$src" = x ] +then + echo "install: no input file specified" + exit 1 +else + true +fi + +if [ x"$dir_arg" != x ]; then + dst=$src + src="" + + if [ -d $dst ]; then + instcmd=: + chmodcmd="" + else + instcmd=mkdir + fi +else + +# Waiting for this to be detected by the "$instcmd $src $dsttmp" command +# might cause directories to be created, which would be especially bad +# if $src (and thus $dsttmp) contains '*'. + + if [ -f $src -o -d $src ] + then + true + else + echo "install: $src does not exist" + exit 1 + fi + + if [ x"$dst" = x ] + then + echo "install: no destination specified" + exit 1 + else + true + fi + +# If destination is a directory, append the input filename; if your system +# does not like double slashes in filenames, you may need to add some logic + + if [ -d $dst ] + then + dst="$dst"/`basename $src` + else + true + fi +fi + +## this sed command emulates the dirname command +dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` + +# Make sure that the destination directory exists. +# this part is taken from Noah Friedman's mkinstalldirs script + +# Skip lots of stat calls in the usual case. +if [ ! -d "$dstdir" ]; then +defaultIFS=' +' +IFS="${IFS-${defaultIFS}}" + +oIFS="${IFS}" +# Some sh's can't handle IFS=/ for some reason. +IFS='%' +set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` +IFS="${oIFS}" + +pathcomp='' + +while [ $# -ne 0 ] ; do + pathcomp="${pathcomp}${1}" + shift + + if [ ! -d "${pathcomp}" ] ; + then + $mkdirprog "${pathcomp}" + else + true + fi + + pathcomp="${pathcomp}/" +done +fi + +if [ x"$dir_arg" != x ] +then + $doit $instcmd $dst && + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi +else + +# If we're going to rename the final executable, determine the name now. + + if [ x"$transformarg" = x ] + then + dstfile=`basename $dst` + else + dstfile=`basename $dst $transformbasename | + sed $transformarg`$transformbasename + fi + +# don't allow the sed command to completely eliminate the filename + + if [ x"$dstfile" = x ] + then + dstfile=`basename $dst` + else + true + fi + +# Make a temp file name in the proper directory. + + dsttmp=$dstdir/#inst.$$# + +# Move or copy the file name to the temp name + + $doit $instcmd $src $dsttmp && + + trap "rm -f ${dsttmp}" 0 && + +# and set any options; do chmod last to preserve setuid bits + +# If any of these fail, we abort the whole thing. If we want to +# ignore errors from any of these, just make sure not to ignore +# errors from the above "$doit $instcmd $src $dsttmp" command. + + if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && + if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && + if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && + if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && + +# Now rename the file to the real destination. + + $doit $rmcmd -f $dstdir/$dstfile && + $doit $mvcmd $dsttmp $dstdir/$dstfile + +fi && + + +exit 0 diff --git a/lisp/Makefile.in b/lisp/Makefile.in new file mode 100755 index 0000000..342f6dd --- /dev/null +++ b/lisp/Makefile.in @@ -0,0 +1,247 @@ +@SET_MAKE@ + +############################################################################## +# no csh please +SHELL = /bin/sh + +# the version of this package +PACKAGE_VERSION = @PACKAGE_VERSION@ + +# the list of source files +SOURCES = vm.el +SOURCES += vm-autoload.el +SOURCES += vm-avirtual.el +SOURCES += vm-biff.el +SOURCES += vm-crypto.el +SOURCES += vm-delete.el +SOURCES += vm-digest.el +SOURCES += vm-edit.el +SOURCES += vm-folder.el +SOURCES += vm-grepmail.el +SOURCES += vm-imap.el +SOURCES += vm-license.el +SOURCES += vm-macro.el +SOURCES += vm-mark.el +SOURCES += vm-menu.el +SOURCES += vm-message.el +SOURCES += vm-message-history.el +SOURCES += vm-mime.el +SOURCES += vm-minibuf.el +SOURCES += vm-misc.el +SOURCES += vm-motion.el +SOURCES += vm-mouse.el +SOURCES += vm-page.el +SOURCES += vm-pcrisis.el +SOURCES += vm-pgg.el +SOURCES += vm-pine.el +SOURCES += vm-pop.el +SOURCES += vm-ps-print.el +SOURCES += vm-reply.el +SOURCES += vm-dired.el +SOURCES += vm-rfaddons.el +SOURCES += vm-save.el +SOURCES += vm-search.el +SOURCES += vm-serial.el +SOURCES += vm-sort.el +SOURCES += vm-startup.el +SOURCES += vm-summary.el +SOURCES += vm-summary-faces.el +SOURCES += vm-thread.el +SOURCES += vm-toolbar.el +SOURCES += vm-undo.el +SOURCES += vm-user.el +SOURCES += vm-vars.el +SOURCES += vm-vcard.el +SOURCES += vm-version.el +SOURCES += vm-virtual.el +SOURCES += vm-window.el +SOURCES += vm-w3m.el +SOURCES += vm-w3.el + +SOURCES += vcard.el +SOURCES += tapestry.el +SOURCES += u-vm-color.el + +# to list of object files +ifeq (@EMACS_FLAVOR@,emacs) +OBJECTS = vm-autoloads.elc vm-cus-load.elc +else +OBJECTS = auto-autoloads.elc custom-load.elc +endif + +OBJECTS += $(SOURCES:.el=.elc) + +AUX_FILES = version.txt + +INSTALL_FILES += $(OBJECTS:.elc=.el) $(OBJECTS) +INSTALL_FILES += $(AUX_FILES) + +# for autoload generation +AUTOLOAD_PACKAGE_NAME = (setq autoload-package-name \"vm\") +AUTOLOAD_FILE = (setq generated-autoload-file \"./auto-autoloads.el\") + +############################################################################## +# location of required programms +RM = @RM@ +LS = @LS@ +XARGS = @XARGS@ +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_DATA = @INSTALL_DATA@ + +prefix = @prefix@ +top_srcdir = @top_srcdir@ +srcdir = @srcdir@ +datadir= @datadir@ +datarootdir= @datarootdir@ +lispdir = @lispdir@ +pixmapdir= @pixmapdir@ + +EMACS_PROG = @EMACS_PROG@ +EMACS_FLAVOR = @EMACS_FLAVOR@ + +FLAGS = @FLAGS@ + +EMACS_COMP = lispdir="$(lispdir)" srcdir="$(srcdir)" "$(EMACS_PROG)" $(FLAGS) + +export OTHERDIRS = @OTHERDIRS@ + +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +.el.elc: + "$(EMACS_PROG)" $(FLAGS) -f batch-byte-compile $< + +############################################################################## +all: $(OBJECTS) + +install: install-el install-elc install-aux + +############################################################################## +vm-version.elc: vm-version.el version.txt + +version.txt: + echo "\"$(PACKAGE_VERSION)\"" > $@ + +############################################################################## +# GNU Emacs's vm-autoload file +# We use tr -d because Emacs under Cygwin apparently outputs CRLF +# under Windows. We remove the CRs. +# Solaris 8's tr -d '\r' removes r's so we use '\015' instead. +# the echo command can also emit CRs. +# Since Debian compiles the files on the fly on the target machine, +# Do not depend on the abslute file path of the source directory to exist +vm-autoloads.el: $(SOURCES:%=@srcdir@/%) + -$(RM) -f $@ + echo > $@ + (build_dir="`pwd`"; cd "@srcdir@"; \ + "$(EMACS_PROG)" $(FLAGS) -l autoload \ + -f vm-built-autoloads "`pwd`/$@" "`pwd`") + echo "(custom-add-load 'vm 'vm-cus-load)" | tr -d '\015' >> $@ + echo "(setq vm-configure-datadir \"${datadir}/vm\")" | tr -d '\015' >> $@ + echo "(setq vm-configure-pixmapdir \"${pixmapdir}\")" | tr -d '\015' >> $@ + echo "(setq vm-configure-docdir \"${docdir}\")" | tr -d '\015' >> $@ + echo "(setq vm-configure-infodir \"${infodir}\")" | tr -d '\015' >> $@ + echo "(require 'vm-vars)" | tr -d '\015' >> $@ + echo "(provide 'vm-autoloads)" | tr -d '\015' >> $@ + +vm-cus-load.el: $(SOURCES:%=@srcdir@/%) + "$(EMACS_PROG)" $(FLAGS) -f vm-custom-make-dependencies . +ifeq (@EMACS_VERSION@,21) + sed -e "s/provide 'cus-load/provide 'vm-cus-load/" cus-load.el > $@ + $(RM) cus-load.el +endif + +############################################################################## +# XEmacs#s auto-autoloads and custom-load file +auto-autoloads.el: $(SOURCES:%=@srcdir@/%) + -$(RM) -f $@ +# (build_dir=`pwd`; cd "@srcdir@"; \ +# $(EMACS_PROG) $(FLAGS) -l autoload \ +# -f vm-built-autoloads "@abs_builddir@/$@" "`pwd`") + "$(EMACS_PROG)" $(FLAGS) \ + -eval "$(AUTOLOAD_PACKAGE_NAME)" \ + -eval "$(AUTOLOAD_FILE)" \ + -l autoload -f batch-update-autoloads $^ +# avoid getting an error about an already loaded vm-autoloads + mv $@ $@.tmp + echo "(setq features (delete 'vm-autoloads features))" > $@ + cat $@.tmp >> $@ + echo "(setq features (delete 'vm-autoloads features))" >> $@ + echo "(require 'vm-vars)" >> $@ + echo "(setq vm-configure-datadir \"${datadir}\")" >> $@ + echo "(setq vm-configure-pixmapdir \"${pixmapdir}\")" >> $@ + $(RM) $@.tmp + + +custom-load.el: $(SOURCES:%=@srcdir@/%) + "$(EMACS_PROG)" $(FLAGS) -f vm-custom-make-dependencies . + +############################################################################## +install-pkg: all $(INSTALL_FILES) + @if test "x$(SYMLINKS)" = "xno" ; then \ + mkdir -p -m 0755 $(DESTDIR)$(PACKAGEDIR); \ + for i in $(SOURCES:%=@srcdir@/%) $(INSTALL_FILES) ; do \ + echo "Installing $$i in $(DESTDIR)$(PACKAGEDIR)" ; \ + $(INSTALL_DATA) $$i $(DESTDIR)$(PACKAGEDIR) ; \ + done ; \ + else \ + if test "x$(LINKPATH)" = "x" ; then \ + $(LN_S) "`pwd`" $(DESTDIR)$(PACKAGEDIR) ; \ + else \ + $(LN_S) $(LINKPATH)/lisp $(DESTDIR)$(PACKAGEDIR) ; \ + fi ; \ + fi + @echo VM ELISP files successfully installed\! + +# This entry will never install .el files if there are no .elc files. +install-el: all $(INSTALL_FILES) + $(INSTALL) -d -m 0755 "$(DESTDIR)$(lispdir)/" + for elc in *.elc; do \ + el=`basename $$elc c`; \ + if test -f "$(srcdir)/$$el"; then \ + echo "Install $$el in $(DESTDIR)$(lispdir)/"; \ + $(INSTALL_DATA) "${srcdir}/$$el" "$(DESTDIR)$(lispdir)/"; \ + fi; \ + done; + if $(LS) $(contrib)/*.elc > /dev/null 2>&1; then \ + for elc in $(contribdir)/*.elc; do \ + el=`basename $$elc c`; \ + if test -f "${srcdir}/$(contribdir)/$$el"; then \ + echo "Install $(contribdir)/$$el in $(DESTDIR)$(lispdir)/"; \ + $(INSTALL_DATA) "${srcdir}/$(contribdir)/$$el" "$(DESTDIR)$(lispdir)/"; \ + fi; \ + done; \ + fi; + +install-elc: all $(INSTALL_FILES) + $(INSTALL) -d -m 0755 "$(DESTDIR)$(lispdir)/" + for elc in *.elc; do \ + echo "Install $$elc in $(DESTDIR)$(lispdir)/"; \ + $(INSTALL_DATA) $$elc "$(DESTDIR)$(lispdir)/"; \ + done; + if $(LS) $(contribdir)/*.elc > /dev/null 2>&1; then \ + for elc in $(contribdir)/*.elc; do \ + echo "Install $$elc in $(DESTDIR)$(lispdir)"; \ + $(INSTALL_DATA) $$elc "$(DESTDIR)$(lispdir)"; \ + done; \ + fi; + +install-aux: $(AUX_FILES) + $(INSTALL) -d -m 0755 "$(DESTDIR)$(lispdir)/" + for i in $(AUX_FILES); do \ + echo "Install $$i in $(DESTDIR)$(lispdir)/"; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(lispdir)/"; \ + done; + +############################################################################## +Makefile: @srcdir@/Makefile.in + cd .. ; ./config.status + +############################################################################## +clean: + -$(RM) -f version.txt *.elc vm-autoloads.el auto-autoloads.el custom-load.el + +distclean: clean + -$(RM) -f Makefile diff --git a/lisp/autoloads.py b/lisp/autoloads.py new file mode 100755 index 0000000..b7ebec2 --- /dev/null +++ b/lisp/autoloads.py @@ -0,0 +1,126 @@ +#!/usr/bin/python +# -*- python -*- + +import sys + +def identifier_start(string, startpos=0): + #print string, startpos + while (startpos < len(string) and + ("() \t\r\n.,".find(string[startpos]) != -1)): + startpos = startpos + 1 + return startpos + +def identifier_end(string, startpos=0): + #print string, startpos + while (startpos < len(string) and + ("() \t\r\n.,".find(string[startpos]) == -1)): + startpos = startpos + 1 + return startpos + +class Def: + def __init__(self, filename, lineno, autoload, symbol): + self.filename = filename + self.lineno = lineno + self.autoload = autoload + self.symbol = symbol + def __str__(self): + return ("%s:%d %s %s" % (self.filename, + self.lineno, + self.symbol, + self.autoload)) + +def find_defs(filename, pattern="(defun", pos=0): + """Find definitions of pattern in the given file. + Returns defined symbols.""" + symbols = [] + + fd = open(filename) + lineno = 0 + autoload = False + for l in fd: + lineno = lineno + 1 + if l.startswith(";;;###autoload"): + autoload = True + continue + s = l.find(pattern) + if s == -1 or s != pos: + continue + s = identifier_start(l, s + len(pattern)) + while "() \t\r\n.,".find(l[s]) != -1: + s = s + 1 + e = identifier_end(l, s) + if s == e: + raise "Could not find identifier end in " + repr(l) + continue + #print s, e + #print l[s : e] + symbols.append(Def(filename, lineno, autoload, l[s : e])) + autoload = False + fd.close() + return symbols + +preloaded = ["vm-version.el", "vm-misc.el", "vm-macro.el", "vm-folder.el", + "vm-summary.el", "vm-minibuf.el", "vm-motion.el", "vm-page.el", + "vm-mouse.el", "vm-window.el", "vm-menu.el", "vm-message.el", + "vm-toolbar.el", "vm.el", "vm-undo.el", "vm-mime.el", + "vm-vars.el"] + +def check_calls(filename, funs, missing): + #print "-" * 50 + #print filename + fd = open(filename) + required = [] + for l in fd: + s = l.find("(require") + if s != -1: + s = identifier_start(l, s + len("(require '" )) + e = identifier_end(l, s) + #print l[s:e], "*" * 50 + required.append(l[s:e] + ".el") + #print required + continue + + # check for calls to external function without autoloads or require + for c in l.split("("): + s = identifier_start(c, 0) + e = identifier_end(c, s) + + #print repr(c) + s = identifier_start(c, 0) + e = identifier_end(c, s) + f = c[s:e] + if f not in funs: + continue + d = funs[f] + if ((d.filename != filename) and (not d.autoload) and + (d.filename not in preloaded) and + (d.filename not in required)): + #print preloaded + #print "'%s' : '%s' => '%s' %s" % (filename, f, d.filename, + #d.filename in preloaded) + #print preloaded + if not missing.has_key(d.filename): + missing[d.filename] = [] + if f not in missing[d.filename]: + missing[d.filename].append(f) + fd.close() + + +# emit cross references with missing autoloads +if __name__ == '__main__': + funs = {} + for filename in sys.argv[3:]: + for d in find_defs(filename): + if funs.has_key(d.symbol): + print "Duplicate %s <> %s" % (d, funs[d.symbol]) + else: + funs[d.symbol] = d + missing = {} + for filename in sys.argv[3:]: + check_calls(filename, funs, missing) + for f in missing.keys(): + print f + for m in missing[f]: + print "\t", m + + diff --git a/lisp/tapestry.el b/lisp/tapestry.el new file mode 100755 index 0000000..561ec7a --- /dev/null +++ b/lisp/tapestry.el @@ -0,0 +1,619 @@ +;;; tapestry.el --- Tools to configure your GNU Emacs windows +;; +;; This file is part of VM +;; +;; Copyright (C) 1991, 1993, 1994, 1995, 1997 Kyle E. Jones +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'tapestry) + +(defvar tapestry-version "1.09") + +;; Pass state information between the tapestry-set-window-map +;; and tapestry-set-buffer-map stages. UGH. The reason for this +;; is explained in tapestry-set-buffer-map. +(defvar tapestry-windows-changed nil) + +;;;###autoload +(defun tapestry (&optional frame-list) +"Returns a list containing complete information about the current +configuration of Emacs frames, windows, buffers and cursor +positions. Call the function set-tapestry with the list that this function +returns to restore the configuration. + +Optional first arg FRAME-LIST should be a list of frames; only +configuration information about these frames will be returned. + +The configuration information is returned in a form that can be saved and +restored across multiple Emacs sessions." + (let ((frames (or frame-list (tapestry-frame-list))) + (frame-map (tapestry-frame-map)) + (sf (tapestry-selected-frame)) + (other-maps nil)) + (unwind-protect + (while frames + (tapestry-select-frame (car frames)) + (setq other-maps (cons (list (tapestry-window-map) + (tapestry-buffer-map) + (tapestry-position-map)) + other-maps) + frames (cdr frames))) + (tapestry-select-frame sf)) + (list frame-map other-maps))) + + +;;;###autoload +(defun set-tapestry (map &optional n root-window-edges) + "Restore the frame/window/buffer configuration described by MAP, +which should be a list previously returned by a call to +tapestry. + +Optional second arg N causes frame reconfiguration to be skipped +and the windows of the current frame will configured according to +the window map of the Nth frame in MAP. + +Optional third arg ROOT-WINDOW-EDGES non-nil should be a list +containing the edges of a window in the current frame. This list +should be in the same form as returned by the `window-edges' +function. The window configuration from MAP will be restored in +this window. If no window with these exact edges exists, a +window that lies entirely within the edge coordinates will be +expanded until the edge coordinates match or the window bounded by +ROOT-WINDOW-EDGES is entirely contained within the expanded +window. If no window entirely within the ROOT-WINDOW-EDGES edge +coordinates can be found, the window with the greatest overlap of +ROOT-WINDOW-EDGES will be used." + (let ((sf (tapestry-selected-frame)) + (tapestry-windows-changed nil) + frame-list frame-map other-maps other-map) + (setq frame-map (nth 0 map) + other-maps (nth 1 map)) + (if (and root-window-edges (null n)) + (setq n 1)) + (if n + (let (first-window) + (setq other-map (nth (1- n) other-maps)) + (if (null other-map) + (error "No such map, %d" n)) + (setq first-window + (tapestry-set-window-map (nth 0 other-map) root-window-edges)) + (tapestry-set-buffer-map (nth 1 other-map) first-window) + (tapestry-set-position-map (nth 2 other-map) first-window)) + (tapestry-set-frame-map frame-map) + ;; frame list is reversed relative to the map order because + ;; created frames are added to the head of the list instead + ;; of the tail. + (setq frame-list (nreverse (tapestry-frame-list))) + (unwind-protect + (while other-maps + (tapestry-select-frame (car frame-list)) + (tapestry-set-window-map (nth 0 (car other-maps))) + (tapestry-set-buffer-map (nth 1 (car other-maps))) + (tapestry-set-position-map (nth 2 (car other-maps))) + (setq other-maps (cdr other-maps) + frame-list (cdr frame-list))) + (and (tapestry-frame-live-p sf) (tapestry-select-frame sf)))))) + +(defun tapestry-frame-map () + (let ((map (mapcar 'tapestry-frame-parameters (tapestry-frame-list))) + list cell frame-list) + (setq list map + frame-list (tapestry-frame-list)) + (while list + (setq cell (assq 'minibuffer (car list))) + (if (and cell (windowp (cdr cell))) + (if (eq (tapestry-window-frame (cdr cell)) (car frame-list)) + (setcdr cell t) + (setcdr cell 'none))) + (setq list (cdr list) + frame-list (cdr frame-list))) + map )) + +(defun tapestry-set-frame-map (map) + ;; some parameters can only be set only at frame creation time. + ;; so all existing frames must die. + (let ((doomed-frames (tapestry-frame-list))) + (while map + (tapestry-make-frame (car map)) + (setq map (cdr map))) + (while doomed-frames + (tapestry-delete-frame (car doomed-frames)) + (setq doomed-frames (cdr doomed-frames))))) + +(defun tapestry-window-map () + (let (maps map0 map1 map0-edges map1-edges x-unchanged y-unchanged) + (setq maps (mapcar 'tapestry-window-edges (tapestry-window-list))) + (while (cdr maps) + (setq map0 maps) + (while (cdr map0) + (setq map1 (cdr map0) + map0-edges (tapestry-find-window-map-edges (car map0)) + map1-edges (tapestry-find-window-map-edges (car map1)) + x-unchanged (and (= (car map0-edges) (car map1-edges)) + (= (nth 2 map0-edges) (nth 2 map1-edges))) + y-unchanged (and (= (nth 1 map0-edges) (nth 1 map1-edges)) + (= (nth 3 map0-edges) (nth 3 map1-edges)))) + (cond ((and (not x-unchanged) (not y-unchanged)) + (setq map0 (cdr map0))) + ((or (and x-unchanged (eq (car (car map0)) '-)) + (and y-unchanged (eq (car (car map0)) '|))) + (nconc (car map0) (list (car map1))) + (setcdr map0 (cdr map1))) + (t + (setcar map0 (list (if x-unchanged '- '|) + (car map0) + (car map1))) + (setcdr map0 (cdr map1)))))) + (car maps))) + +(defun tapestry-set-window-map (map &optional root-window-edges) + (let ((map-width (tapestry-compute-map-width map)) + (map-height (tapestry-compute-map-height map)) + (root-window nil)) + (if root-window-edges + (let (w-list w-edges w-area + exact-w inside-w overlap-w max-overlap overlap) + (while (null root-window) + (setq exact-w nil + inside-w nil + overlap-w nil + max-overlap -1 + w-list (tapestry-window-list)) + (while w-list + (setq w-edges (tapestry-window-edges (car w-list)) + w-area (tapestry-window-area w-edges)) + (if (equal w-edges root-window-edges) + (setq exact-w (car w-list) + w-list nil) + (setq overlap (tapestry-window-overlap w-edges + root-window-edges) + overlap (if overlap (tapestry-window-area overlap) 0) + w-area (tapestry-window-area w-edges)) + (if (< max-overlap overlap) + (setq max-overlap overlap + overlap-w (car w-list))) + ;; set inside-w each time we find a window inside + ;; the root window edges. FSF Emacs gives space + ;; to the window above or to the left if there is + ;; such a window. therefore we want to find the + ;; inside window that is bottom-most or right-most so that + ;; when we delete it, its space will be given to + ;; what will be the root window. + (if (= w-area overlap) + (setq inside-w (car w-list))) + (setq w-list (cdr w-list)))) + (cond (exact-w (setq root-window exact-w)) + (inside-w + ;; how could a window be inside the root window + ;; edges and there only be one window? a + ;; multi-line minibuffer, that's how! + (if (not (one-window-p t)) + (delete-window inside-w))) + (t (setq root-window overlap-w)))) + (tapestry-apply-window-map map map-width map-height root-window) + (setq tapestry-windows-changed t) + root-window ) + (if (tapestry-windows-match-map map map-width map-height) + (tapestry-first-window) + (delete-other-windows) + (setq root-window (selected-window)) + (tapestry-apply-window-map map map-width map-height root-window) + (setq tapestry-windows-changed t) + root-window )))) + +(defun tapestry-buffer-map () + (let ((w-list (tapestry-window-list)) + b list) + (while w-list + (setq b (window-buffer (car w-list)) + list (cons (list (buffer-file-name b) + (buffer-name b)) + list) + w-list (cdr w-list))) + (nreverse list))) + +;; This version of tapestry-set-buffer-map unconditionally set +;; the window buffer. This confused XEmacs 19.14's scroll-up +;; function when scrolling VM presentation buffers. +;; end-of-buffer was never signaled after a scroll. You can +;; duplicate this by creating a buffer that can be displayed +;; fully in the current window and then run +;; +;; (progn +;; (set-window-buffer (selected-window) (current-buffer)) +;; (scroll-up nil)) +;;;;;;;;;;; +;;(defun tapestry-set-buffer-map (buffer-map &optional first-window) +;; (let ((w-list (tapestry-window-list first-window)) wb) +;; (while (and w-list buffer-map) +;; (setq wb (car buffer-map)) +;; (set-window-buffer +;; (car w-list) +;; (if (car wb) +;; (or (get-file-buffer (car wb)) +;; (find-file-noselect (car wb))) +;; (get-buffer-create (nth 1 wb)))) +;; (setq w-list (cdr w-list) +;; buffer-map (cdr buffer-map))))) + +(defun tapestry-set-buffer-map (buffer-map &optional first-window) + (let ((w-list (tapestry-window-list first-window)) + current-wb proposed-wb cell) + (while (and w-list buffer-map) + (setq cell (car buffer-map) + proposed-wb (if (car cell) + (or (get-file-buffer (car cell)) + (find-file-noselect (car cell))) + (get-buffer-create (nth 1 cell))) + current-wb (window-buffer (car w-list))) + ;; Setting the window buffer to the same value it already + ;; has seems to confuse XEmacs' scroll-up function. But + ;; _not_ setting it after windows torn down seem to cause + ;; window point to sometimes drift away from point at + ;; redisplay time. The solution (hopefully!) is to track + ;; when windows have been rearranged and unconditionally do + ;; the set-window-buffer, otherwise do it only if the + ;; window buffer and the proposed window buffer differ. + (if (or tapestry-windows-changed (not (eq proposed-wb current-wb))) + (set-window-buffer (car w-list) proposed-wb)) + (setq w-list (cdr w-list) + buffer-map (cdr buffer-map))))) + +(defun tapestry-position-map () + (let ((sw (selected-window)) + (w-list (tapestry-window-list)) + list) + (while w-list + (setq list (cons (list (window-start (car w-list)) + (window-point (car w-list)) + (window-hscroll (car w-list)) + (eq (car w-list) sw)) + list) + w-list (cdr w-list))) + (nreverse list))) + +(defun tapestry-set-position-map (position-map &optional first-window) + (let ((w-list (tapestry-window-list first-window)) + (osw (selected-window)) + sw p) + (while (and w-list position-map) + (setq p (car position-map)) + (and (car p) (set-window-start (car w-list) (car p))) + (and (nth 1 p) (set-window-point (car w-list) (nth 1 p))) + (and (nth 2 p) (set-window-hscroll (car w-list) (nth 2 p))) + (and (nth 3 p) (setq sw (car w-list))) + ;; move this buffer up in the buffer-list + (select-window (car w-list)) + (setq w-list (cdr w-list) + position-map (cdr position-map))) + (select-window (or sw osw)))) + +(defun tapestry-apply-window-map (map map-width map-height current-window + &optional + root-window-width + root-window-height) + (let ((window-min-height 1) + (window-min-width 1) + horizontal) + (if (null root-window-width) + (setq root-window-height (window-height current-window) + root-window-width (window-width current-window))) + (while map + (cond + ((numberp (car map)) (setq map nil)) + ((eq (car map) '-) (setq horizontal nil)) + ((eq (car map) '|) (setq horizontal t)) + (t + (if (cdr map) + (split-window + current-window + (if horizontal + (/ (* (tapestry-compute-map-width (car map)) + root-window-width) + map-width) + (/ (* (tapestry-compute-map-height (car map)) + root-window-height) + map-height)) + horizontal)) + (if (not (numberp (car (car map)))) + (setq current-window + (tapestry-apply-window-map (car map) + map-width map-height + current-window + root-window-width + root-window-height))) + (and (cdr map) (setq current-window (next-window current-window 0))))) + (setq map (cdr map))) + current-window )) + +(defun tapestry-windows-match-map (map + &optional + map-width map-height + window-map + window-map-width + window-map-height) + (or map-width + (setq map-width (tapestry-compute-map-width map) + map-height (tapestry-compute-map-height map))) + (or window-map + (setq window-map (tapestry-window-map) + window-map-height (tapestry-compute-map-height window-map) + window-map-width (tapestry-compute-map-width window-map))) + (let ((result t)) + (cond ((numberp (car map)) + (and (numberp (car window-map)) + (= (/ (* (nth 0 map) window-map-width) + map-width) + (nth 0 window-map)) + (= (/ (* (nth 1 map) window-map-height) + map-height) + (nth 1 window-map)) + (= (/ (* (nth 2 map) window-map-width) + map-width) + (nth 2 window-map)) + (= (/ (* (nth 3 map) window-map-height) + map-height) + (nth 3 window-map)))) + ((eq (car map) '-) + (if (not (eq (car window-map) '-)) + nil + (setq map (cdr map) + window-map (cdr window-map)) + (while (and result map window-map) + (setq result (tapestry-windows-match-map (car map) + map-width + map-height + (car window-map) + window-map-width + window-map-height) + map (cdr map) + window-map (cdr window-map))) + (and result (null map) (null window-map)))) + ((eq (car map) '|) + (if (not (eq (car window-map) '|)) + nil + (setq map (cdr map) + window-map (cdr window-map)) + (while (and result map window-map) + (setq result (tapestry-windows-match-map (car map) + map-width + map-height + (car window-map) + window-map-width + window-map-height) + map (cdr map) + window-map (cdr window-map))) + (and result (null map) (null window-map))))))) + +(defun tapestry-find-window-map-edges (map) + (let (nw-edges se-edges) + (setq nw-edges map) + (while (and (consp nw-edges) (not (numberp (car nw-edges)))) + (setq nw-edges (car (cdr nw-edges)))) + (setq se-edges map) + (while (and (consp se-edges) (not (numberp (car se-edges)))) + (while (cdr se-edges) + (setq se-edges (cdr se-edges))) + (setq se-edges (car se-edges))) + (if (eq nw-edges se-edges) + nw-edges + (setq nw-edges (copy-sequence nw-edges)) + (setcdr (nthcdr 1 nw-edges) (nthcdr 2 se-edges)) + nw-edges ))) + +(defun tapestry-compute-map-width (map) + (let ((edges (tapestry-find-window-map-edges map))) + (- (nth 2 edges) (car edges)))) + +(defun tapestry-compute-map-height (map) + (let ((edges (tapestry-find-window-map-edges map))) + (- (nth 3 edges) (nth 1 edges)))) + +;; delq is to memq as delassq is to assq +(defun tapestry-delassq (elt list) + (let ((prev nil) + (curr list)) + (while curr + (if (eq elt (car (car curr))) + (if (null prev) + (setq list (cdr list) curr list) + (setcdr prev (cdr curr)) + (setq curr (cdr curr))) + (setq prev curr curr (cdr curr)))) + list )) + +;;;###autoload +(defun tapestry-remove-frame-parameters (map params) + (let (frame-map) + (while params + (setq frame-map (nth 0 map)) + (while frame-map + (setcar frame-map (tapestry-delassq (car params) (car frame-map))) + (setq frame-map (cdr frame-map))) + (setq params (cdr params))))) + +;;;###autoload +(defun tapestry-nullify-tapestry-elements (map &optional buf-file-name buf-name + window-start window-point + window-hscroll selected-window) + (let (p) + (setq map (nth 1 map)) + (while map + (setq p (nth 1 (car map))) + (while p + (and buf-file-name (setcar (car p) nil)) + (and buf-name (setcar (cdr (car p)) nil)) + (setq p (cdr p))) + (setq p (nth 2 (car map))) + (while p + (and window-start (setcar (car p) nil)) + (and window-point (setcar (cdr (car p)) nil)) + (and window-hscroll (setcar (nthcdr 2 (car p)) nil)) + (and selected-window (setcar (nthcdr 3 (car p)) nil)) + (setq p (cdr p))) + (setq map (cdr map))))) + +;;;###autoload +(defun tapestry-replace-tapestry-element (map what function) + (let (mapi mapj p old new) + (cond ((eq what 'buffer-file-name) + (setq mapi 1 mapj 0)) + ((eq what 'buffer-name) + (setq mapi 1 mapj 1)) + ((eq what 'window-start) + (setq mapi 2 mapj 0)) + ((eq what 'window-point) + (setq mapi 2 mapj 1)) + ((eq what 'window-hscroll) + (setq mapi 2 mapj 2)) + ((eq what 'selected-window) + (setq mapi 2 mapj 3))) + (setq map (nth 1 map)) + (while map + (setq p (nth mapi (car map))) + (while p + (setq old (nth mapj (car p)) + new (funcall function old)) + (if (not (equal old new)) + (setcar (nthcdr mapj (car p)) new)) + (setq p (cdr p))) + (setq map (cdr map))))) + +(defun tapestry-window-list (&optional first-window) + (let* ((first-window (or first-window (tapestry-first-window))) + (windows (cons first-window nil)) + (current-cons windows) + (w (next-window first-window 'nomini))) + (while (not (eq w first-window)) + (setq current-cons (setcdr current-cons (cons w nil))) + (setq w (next-window w 'nomini))) + windows )) + +(defun tapestry-first-window () + (if (eq (tapestry-selected-frame) + (tapestry-window-frame (minibuffer-window))) + (next-window (minibuffer-window)) + (let ((w (selected-window)) + (top (or (cdr (assq 'menu-bar-lines (tapestry-frame-parameters))) 0)) + edges) + (while (or (not (= 0 (car (setq edges (tapestry-window-edges w))))) + ;; >= instead of = because in FSF Emacs 19.2x + ;; (whenever the Lucid menubar code was added) the + ;; menu-bar-lines frame parameter == 1 when the + ;; Lucid menubar is enabled even though the + ;; menubar doesn't steal the first line from the + ;; window. + (not (>= top (nth 1 edges)))) + (setq w (next-window w 'nomini))) + w ))) + +(defun tapestry-window-area (edges) + (* (- (nth 3 edges) (nth 1 edges)) + (- (nth 2 edges) (nth 0 edges)))) + +(defun tapestry-window-overlap (e0 e1) + (let (top left bottom right) + (cond ((and (<= (nth 0 e0) (nth 0 e1)) (< (nth 0 e1) (nth 2 e0))) + (setq left (nth 0 e1))) + ((and (<= (nth 0 e1) (nth 0 e0)) (< (nth 0 e0) (nth 2 e1))) + (setq left (nth 0 e0)))) + (cond ((and (< (nth 0 e0) (nth 2 e1)) (<= (nth 2 e1) (nth 2 e0))) + (setq right (nth 2 e1))) + ((and (< (nth 0 e1) (nth 2 e0)) (<= (nth 2 e0) (nth 2 e1))) + (setq right (nth 2 e0)))) + (cond ((and (<= (nth 1 e0) (nth 1 e1)) (< (nth 1 e1) (nth 3 e0))) + (setq top (nth 1 e1))) + ((and (<= (nth 1 e1) (nth 1 e0)) (< (nth 1 e0) (nth 3 e1))) + (setq top (nth 1 e0)))) + (cond ((and (< (nth 1 e0) (nth 3 e1)) (<= (nth 3 e1) (nth 3 e0))) + (setq bottom (nth 3 e1))) + ((and (< (nth 1 e1) (nth 3 e0)) (<= (nth 3 e0) (nth 3 e1))) + (setq bottom (nth 3 e0)))) + (and left top right bottom (list left top right bottom)))) + +(defun tapestry-window-edges (&optional window) + (if (and (fboundp 'window-pixel-edges) + (fboundp 'face-width) + (fboundp 'face-height)) + (let ((edges (window-pixel-edges window)) + tmp) + (setq tmp edges) + (setcar tmp (/ (car tmp) (face-width 'default))) + (setq tmp (cdr tmp)) + (setcar tmp (/ (car tmp) (face-height 'default))) + (setq tmp (cdr tmp)) + (setcar tmp (/ (car tmp) (face-width 'default))) + (setq tmp (cdr tmp)) + (setcar tmp (/ (car tmp) (face-height 'default))) + edges ) + (window-edges window))) + +;; We call these functions instead of calling the Emacs 19 frame +;; functions directly to let this package work with v18 Emacs. + +(defun tapestry-frame-list () + (if (fboundp 'frame-list) + (frame-list) + (list nil))) + +(defun tapestry-frame-parameters (&optional f) + (if (fboundp 'frame-parameters) + (frame-parameters f) + nil )) + +(defun tapestry-window-frame (w) + (if (fboundp 'window-frame) + (window-frame w) + nil )) + +(defun tapestry-modify-frame-parameters (f alist) + (if (fboundp 'modify-frame-parameters) + (modify-frame-parameters f alist) + nil )) + +(defun tapestry-select-frame (f) + (if (fboundp 'select-frame) + (select-frame f) + nil )) + +(defun tapestry-selected-frame () + (if (fboundp 'selected-frame) + (selected-frame) + nil )) + +(defun tapestry-next-frame (&optional f all) + (if (fboundp 'next-frame) + (next-frame f all) + nil )) + +(defun tapestry-make-frame (&optional alist) + (if (fboundp 'make-frame) + (make-frame alist) + nil )) + +(defun tapestry-delete-frame (&optional f) + (if (fboundp 'delete-frame) + (delete-frame f) + nil )) + +(defun tapestry-frame-live-p (f) + (if (fboundp 'frame-live-p) + (frame-live-p f) + t )) + +;;; tapestry.el ends here diff --git a/lisp/u-vm-color.el b/lisp/u-vm-color.el new file mode 100755 index 0000000..70b38a3 --- /dev/null +++ b/lisp/u-vm-color.el @@ -0,0 +1,758 @@ +;;; u-vm-color.el --- Font-lock support for VM. +;; +;; This file is an add-on for VM + +;; Copyright (C) 2001-2007 by Ulf Jasper + +;; Emacs Lisp Archive Entry +;; Author: Ulf Jasper <ulf.jasper@web.de> +;; Filename: u-vm-color.el +;; Created: January 19 2001 +;; Keywords: VM, Customization +;; Time-stamp: "23. Februar 2008, 21:28:20 (ulf)" +;; CVS-Version: $Id: u-vm-color.el,v 2.19 2008-02-23 20:28:57 ulf Exp $ + +;;; Code + +(provide 'u-vm-color) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder)) + +(defconst u-vm-color-version "2.10" "Version number of u-vm-color.") + +;; This program is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by the +;; Free Software Foundation; either version 2 of the License, or (at your +;; option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;; ====================================================================== +;;; Commentary: + +;; This package provides a simple way for configuring faces for VM. +;; All faces are customizable. + +;; For the VM summary buffer this is done using `font-lock', for the +;; message buffer by a "proprietary" fontifier. + +;; For vm-summary-mode font-lock-keywords are created from the value of +;; `vm-summary-format'. All vm format-specifiers are understood (as of VM +;; 6.88), as well as the user-defined specifier `%UB', provided by BBDB. + +;; To install and use place this file somewhere in your load-path and put +;; the following in your VM startup file (~/.emacs or ~/.vm) + +;; (require 'u-vm-color) +;; (add-hook 'vm-select-message-hook 'u-vm-color-fontify-buffer) + +;; It may be necessary to add the following, which probably comes from +;; a bug in my code... +;; (defadvice vm-show-current-message (after u-vm-color activate) +;; (u-vm-color-fontify-buffer-even-more)) +;; You might also add this advice, which causes some slow down: +;; (defadvice vm-decode-mime-message (after u-vm-color activate) +;; (u-vm-color-fontify-buffer-even-more)) +;; + +;; If you are using auto-fill, ie when the variables +;; `vm-word-wrap-paragraphs' or +;; `vm-fill-paragraphs-containing-long-lines' is not nil, you should +;; also add this: +;; (defadvice vm-fill-paragraphs-containing-long-lines +;; (after u-vm-color activate) +;; (u-vm-color-fontify-buffer)) + +;; It will make sure that buffers/messages, which have been re-filled +;; are fontified properly. + +;; It is possible to use the face definitions from Gnus by adding +;; (setq u-vm-color-use-gnus-faces t) +;; However, this is irreversible. At least for that Emacs session. + +;; All faces are customizable: Just say +;; M-x customize-group <ret> u-vm-color + +;; In order to prevent Emacs from locking I strongly recommend to use +;; lazy-lock or jit-mode. + +;; Disclaimer: `u-vm-color' may show unexpected results, or even fail, if +;; vm-summary-format is sufficiently complex=strange. + +;; XEmacs users might want to turn off `vm-use-lucid-highlighting', if +;; this package works... + +;; ====================================================================== +;;; History: + +;; (2011-02-17) +;; Removed instructions for fontifying summary buffers because +;; vm-summary-faces is now built into VM. Uday S. Reddy +;; 2.10: (2008-02-23) +;; Bugfixes -- thanks to Martin Schwenke +;; 2.9: (2007-12-19) +;; Handle PGP signatures -- thanks to Frederik Axelsson. +;; Other minor changes. +;; 2.8.1: (2005-10-22) +;; Added autoload cookies. +;; Silence compiler warnings. +;; 2.8: (2005-04-05) +;; Fixed problems with non-graphical chars in summary buffers. +;; Fixed font-lock-problems with "older" Emacsen which were +;; introduced with version 2.7. +;; 2.7: (2005-02-26) +;; Fixed font-lock-problems with recent CVS Emacs. +;; 2.6: Fixed problems with summary mode in recent CVS Emacs. +;; Added u-vm-color-spamassassin. +;; 2.5: Bugfix(?): require gnus-cite for gnus-faces. Thanks to +;; Richard Walker for pointing out. +;; Tested with Emacs 21.2.2/VM 7.08 +;; 2.4: Bugfix: re-activated font-lock-keywords-only. If this is not set, +;; font-lock tries to fontify strings and will screw up the +;; summary buffer if it finds double-quotes. +;; Thanks to Stefan Kamphausen for testing. +;; Recognize lengths of *strings* in the vm-summary-format, like in +;; "%-10.10F %s". In this case sender/recipient and subject will +;; always be correctly fontified. (The font-lock regexp will now be +;; ".......... .*" instead of ".* .*".) Note that it is still not +;; possible to distinguish two arbitrary-length adjacent strings, +;; like in "%F %s". + +;; Tested with Emacs 21.2.2 +;; 2.3: Bugfix: Removed (setq font-lock-keywords-only t) in +;; u-vm-color-summary-mode, which confused font-lock in XEmacs +;; 21.4 when vm-use-toolbar was non-nil -- ???! +;; Tested with Emacs 21.2.1/VM 7.07 and XEmacs 21.4.6/VM 7.03. +;; 2.2: Bugfixes: Recipient- and author face were interchanged in message. +;; Now setting buffer-modified-p to its original value after +;; fontifying message buffer. +;; 2.0: Fontification in message buffers now done "by hand" -- no +;; font-lock here any more. Apparently font-lock removes all +;; face-properties when it is started. So, inlined html messages and +;; such looked quite boring. + +;; No limitation on header lengths anymore. Doesn't remove faces for +;; inlined html messages and such. + +;; Tested with emacs 21.1. +;; 1.11: Added faces for dark backgrounds. +;; Introduced u-vm-color-use-gnus-faces. +;; 1.9 Colons belong to header-keywords. +;; 1.7 Forgot VM's B attribute. +;; 1.6: Limited headers and signatures to 5 lines to avoid regexp stack +;; overflow. +;; Citations now supercite-compliant. +;; 1.5: Minor bug fixes. +;; 1.1: Introduced minor modes. +;; Should work for xemacs as well. +;; 1.0: Initial version. + +;; ====================================================================== +;;; Code: +(require 'font-lock) + +;; Silence compiler warnings +(defvar vm-summary-format) + +(defgroup u-vm-color nil + "Font-lock support for vm." + :group 'vm-ext) + +(defcustom u-vm-color-use-gnus-faces nil + "Use corresponding face definitions from Gnus." + :type 'boolean + :group 'u-vm-color) + +(defface u-vm-color-signature-face + '((((class color) (background dark)) + (:bold nil :italic t :foreground "misty rose")) + (((class color) (background light)) + (:bold nil :italic t :foreground "Sienna"))) + "Face for Signatures." + :group 'u-vm-color) + +(defface u-vm-color-header-face + '((((class color) (background dark)) + (:bold t :italic nil :foreground "white")) + (((class color) (background light)) + (:bold t :italic nil :foreground "black"))) + "General Face for header keywords." + :group 'u-vm-color) + +(defface u-vm-color-author-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "cornflower blue")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "midnight blue"))) + "Face for sender names." + :group 'u-vm-color) + +(defface u-vm-color-recipient-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "green")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "DarkGreen"))) + "Face for recipient names." + :group 'u-vm-color) + +(defface u-vm-color-subject-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "sky blue")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "medium blue"))) + "Face for subjects." + :group 'u-vm-color) + +(defface u-vm-color-default-face + '((t (:italic t))) + "Default face." + :group 'u-vm-color) + +(defface u-vm-color-time-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "pink")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "maroon"))) + "Face for message time." + :group 'u-vm-color) + +(defface u-vm-color-attribute-face + '((((class color) (background dark)) + (:bold t :italic nil :foreground "orange red")) + (((class color) (background light)) + (:bold t :italic nil :foreground "red"))) + "Face for vm attributes." + :group 'u-vm-color) + +(defface u-vm-color-date-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "pink")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "maroon"))) + "Face for message date." + :group 'u-vm-color) + +(defface u-vm-color-id-face + '((t (:bold nil :italic t))) + "Face for message id." + :group 'u-vm-color) + +(defface u-vm-color-label-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "orange red")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "red"))) + "Face for vm labels." + :group 'u-vm-color) + +(defface u-vm-color-length-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "white")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "black"))) + "Face for message length." + :group 'u-vm-color) + +(defface u-vm-color-number-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "white")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "black"))) + "Face for message number." + :group 'u-vm-color) + +(defface u-vm-color-user-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "light sea green")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "forest green"))) + "Face for user defined summary elements." + :group 'u-vm-color) + +(defface u-vm-color-citation-1-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "orange red")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "orange red"))) + "Face for citations." + :group 'u-vm-color) + +(defface u-vm-color-citation-2-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "SkyBlue1")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "SlateBlue"))) + "Face for citation." + :group 'u-vm-color) + +(defface u-vm-color-citation-3-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "cyan")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "DarkGreen"))) + "Face for citation." + :group 'u-vm-color) + +(defface u-vm-color-citation-4-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "magenta")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "BlueViolet"))) + "Face for citation." + :group 'u-vm-color) + +(defface u-vm-color-citation-5-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "firebrick1")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "Firebrick"))) + "Face for citation." + :group 'u-vm-color) + +(defface u-vm-color-spamassassin-face + '((((class color) (background dark)) + (:bold nil :italic nil :foreground "firebrick1")) + (((class color) (background light)) + (:bold nil :italic nil :foreground "Firebrick"))) + "Face for spamassassin preview block." + :group 'u-vm-color) + +(defface u-vm-color-pgp-inline-signature-face + '((((class color) (background dark)) + (:bold nil :italic t :foreground "blue")) + (((class color) (background light)) + (:bold nil :italic t :foreground "blue"))) + "Face for pgp inline signatures." + :group 'u-vm-color) + +(defun u-vm-color-copy-gnus-faces () + "Set up u-vm-color faces by copying from corresponding Gnus faces." + ;; make sure we have the Gnus faces + (require 'gnus-art) + (require 'gnus-cite) + (require 'message) + ;; + (message "u-vm-color: copying Gnus faces...") + (when (facep 'gnus-signature-face) + (copy-face 'gnus-signature-face 'u-vm-color-signature-face)) + (when (facep 'gnus-header-from-face) + (copy-face 'gnus-header-from-face 'u-vm-color-author-face)) + (when (facep 'gnus-header-subject-face) + (copy-face 'gnus-header-subject-face 'u-vm-color-subject-face)) + (when (facep 'gnus-header-content-face) + (copy-face 'gnus-header-content-face 'u-vm-color-default-face)) + (when (facep 'gnus-header-name-face) + (copy-face 'gnus-header-name-face 'u-vm-color-header-face)) + (when (facep 'gnus-cite-face-1) + (copy-face 'gnus-cite-face-1 'u-vm-color-citation-1-face)) + (when (facep 'gnus-cite-face-2) + (copy-face 'gnus-cite-face-2 'u-vm-color-citation-2-face)) + (when (facep 'gnus-cite-face-3) + (copy-face 'gnus-cite-face-3 'u-vm-color-citation-3-face)) + (when (facep 'gnus-cite-face-4) + (copy-face 'gnus-cite-face-4 'u-vm-color-citation-4-face)) + (when (facep 'gnus-cite-face-5) + (copy-face 'gnus-cite-face-5 'u-vm-color-citation-5-face)) + (message "u-vm-color: copying Gnus faces... done")) + +(defun u-vm-color-make-specific-length-regexp (regexp m-length length + &optional prefix) + "Create a regular expression. +Argument REGEXP a regexp . +Argument M-LENGTH the minimal LENGTH. +Optional argument PREFIX the maximal length." +(let ((i 0) + (result "\\(")) + (if prefix + (setq result (concat result prefix))) + ;;(message "input: %s %d %d" regexp m-length length) + (cond ((and length (> length 0)) + (when m-length + (while (and (< i m-length) (< i length)) + (setq result (concat result regexp)) + (setq i (1+ i)))) + (while (< i length) + (setq result (concat result regexp "?")) + (setq i (1+ i)))) + (t + (setq result (concat result regexp "*")))) + ;;(message "result: --%s--" result) + (concat result "\\)"))) + + +(defun u-vm-color-make-summary-keywords () + "Parse `vm-summary-format' and return a font-lock keyword list. +List consists of one big regexp and lots of face instructions for +subexpressions." + (let ((search-start 0) + (length 0) ; (maximum) length + (m-length 0) ; minimum length + (rest "") + (f-element "") + (m-element "") + (value "") + (u-format "^..") + (u-match nil) + (count 1) + (t-vm-summary-format vm-summary-format) + (u-vm-color-xemacs-workaround + (string-match "XEmacs\\|Lucid" emacs-version))) + ;; pick up all elements in the vm-summary-format + (while (string-match + (concat "%-?\\([0-9]+\\.\\)?-?\\([0-9]+\\)?" + "\\([aAcdfFhHiIlLmMnstTwyz*]\\|U.\\)\\([^%\n]*\\)") + t-vm-summary-format search-start) + (setq search-start (match-end 0)) + (if (match-beginning 1) + (setq m-length (string-to-number + (substring t-vm-summary-format (match-beginning 1) + (1- (match-end 1))))) + (setq m-length 0)) + (if (match-beginning 2) + (setq length (string-to-number + (substring t-vm-summary-format (match-beginning 2) + (match-end 2)))) + (setq length 0)) + (if (match-beginning 3) + (setq value (substring t-vm-summary-format (match-beginning 3) + (match-end 3))) + (setq value "")) + (if (match-beginning 4) + (setq rest (substring t-vm-summary-format (match-beginning 4) + (match-end 4))) + (setq rest "")) + (setq rest (regexp-quote rest)) + + ;;(message "--> %s, %s, %s" length m-length value) + ;; Should use the length and m-length values for things like %5d + ;; instead of doing [0-9 ]+ for numerics... + ;; No! + (cond ((string-equal value "a") ;; attributes -- make sure that all + ;; possible letters are given! + (setq f-element "\\([DNU ][FW ][RZB ][E ]\\)") + (setq m-element (list count (quote 'u-vm-color-attribute-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "A") ;; attributes -- long + (setq f-element "\\([DNU ][r ][z ][b ][f ][w ][e ]\\)") + (setq m-element (list count (quote 'u-vm-color-attribute-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "c") ;; number of characters + (setq f-element "\\( *[0-9]+ *\\)") + (setq m-element (list count (quote 'u-vm-color-length-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "d") ;; day -- numeric + (setq f-element "\\( *[0-9]+ *\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "f") ;; authors / recipients address + ;;(setq f-element "\\(To: [^ \n]+\\)?\\([^ \n]+\\)?") + (setq f-element (concat + "\\(" + (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." (- m-length 4) (- length 4) "To: ") + "\\|" + (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." m-length length) + "\\)")) + (setq count (+ 1 count)) + (setq m-element (list count + (quote 'u-vm-color-recipient-face) t t)) + (setq count (+ 1 count)) + (setq u-match (append u-match (list m-element))) + (setq m-element (list count (quote 'u-vm-color-author-face) t t))) + ((or (string-equal value "F") + (string-equal value "UA") ;; IS THIS CORRECT!???????? + (string-equal value "UB")) ;; authors / recipients full names + ;;(setq f-element "\\(To:.+\\)?\\([^:\n]+\\)?") + (setq f-element (concat + "\\(" + (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." (- m-length 4) (- length 4) "To: ") + "\\|" + (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." m-length length) + "\\)")) + (setq count (+ 1 count)) + (setq m-element (list count + (quote 'u-vm-color-recipient-face) t t)) + (setq count (+ 1 count)) + (setq u-match (append u-match (list m-element))) + (setq m-element (list count (quote 'u-vm-color-author-face) t t))) + ((string-equal value "h") ;; time + (setq f-element "\\([0-9][0-9]:[0-9][0-9]:[0-9][0-9]\\)") + (setq m-element (list count (quote 'u-vm-color-time-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "H") ;; time -- short + (setq f-element "\\([0-9][0-9]:[0-9][0-9]\\)") + (setq m-element (list count (quote 'u-vm-color-time-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "i") ;; id + (setq f-element "\\(<[^ \n]+>\\)") + (setq m-element (list count (quote 'u-vm-color-id-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "I") ;; indentation + (setq f-element " *") + (setq m-element nil)) + ((string-equal value "l") ;; number of lines + (setq f-element "\\( *[0-9]+ *\\)") + (setq m-element (list count (quote 'u-vm-color-length-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "L") ;; label + (setq f-element (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." m-length length)) + (setq m-element (list count (quote 'u-vm-color-label-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "m") ;; month + (setq f-element "\\([A-Za-z]+\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "M") ;; month -- numeric + (setq f-element "\\( *[0-9]+ *\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "n") ;; message number + (setq f-element "\\( *[0-9]+ *\\)") + (setq m-element (list count (quote 'u-vm-color-number-face)))) + ((string-equal value "s") ;; subject + (setq f-element (u-vm-color-make-specific-length-regexp + ;;"[ [:graph:]]" + "." m-length length)) + (setq m-element (list count (quote 'u-vm-color-subject-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "t") ;; recipient addresses + (setq f-element "\\([^ \n]+\\)") + (setq m-element (list count (quote 'u-vm-color-recipient-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "T") ;; recipient full names + (setq f-element "\\(.+\\)") + (setq m-element (list count (quote 'u-vm-color-recipient-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "w") ;; week day (is missing in some mails!) + (setq f-element "\\([A-Za-z ]+\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "y") ;; year + (setq f-element "\\([0-9]+\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "z") ;; timezone + (setq f-element "\\(.+\\)") + (setq m-element (list count (quote 'u-vm-color-date-face) + nil u-vm-color-xemacs-workaround))) + ((string-equal value "*") ;; mark-marker + (setq f-element "\\(\\*\\| \\)") + (setq m-element (list count (quote 'u-vm-color-attribute-face) + nil u-vm-color-xemacs-workaround))) + (t ;; user defined and everything else + (setq f-element ".*") + (setq m-element nil))) + (setq u-format (concat u-format f-element rest)) + (if m-element + (progn + (setq count (+ 1 count)) + (setq u-match (append u-match (list m-element)))))) + (setq u-format (concat u-format "$")) + (append (list u-format) u-match))) + +(defvar u-vm-color-summary-mode nil) +(make-variable-buffer-local 'u-vm-color-summary-mode) +(add-to-list 'minor-mode-alist '(u-vm-color-summary-mode nil)) + +(defvar u-vm-color-summary-keywords nil) + +;; FIXME: u-vm-color-summary-mode cannot be turned off +;;;###autoload +(defun u-vm-color-summary-mode (&optional arg) + "Configure `font-lock-keywords' and add some hooks for vm-buffers. + (Optional argument ARG is not used.)" + (interactive "P") + (setq u-vm-color-summary-mode + (not (or (and (null arg) u-vm-color-summary-mode) + (<= (prefix-numeric-value arg) 0)))) + + (if u-vm-color-use-gnus-faces (u-vm-color-copy-gnus-faces)) + + ;; apparently emacs expects this statement here... + (font-lock-mode 1) + (cond ((string-match "XEmacs\\|Lucid" emacs-version) + ;; XEmacs + (setq u-vm-color-summary-keywords + (list (u-vm-color-make-summary-keywords))) + (put 'vm-summary-mode 'font-lock-defaults + '( + 'u-vm-color-summary-keywords + t ; keywords-only + t ; case-fold + nil ; syntax-alist + nil ; syntax-begin + )) + (setq font-lock-keywords (list (u-vm-color-make-summary-keywords))) + (font-lock-fontify-buffer)) + (t + ;; GNU Emacs + (setq u-vm-color-summary-keywords + (list (u-vm-color-make-summary-keywords))) + (set (make-local-variable 'font-lock-defaults) + (list 'u-vm-color-summary-keywords ;; keywords + t ;; keywords-only + t ;; case-fold + nil ;; syntax-alist + nil)) ;; syntax-begin + + ;; With the CVS version of GNU Emacs as of Feb. 2005 one must + ;; not set font-lock-keywords explicitly as a global variable. + ;; It is sufficient to set font-lock-defaults. + ;; For older GNU Emacs versions up to 21.3 it is necessary to + ;; set font-lock-keywords. + ;; Setting font-lock-keywords as a local variable works with all + ;; GNU Emacs versions. + ;; 2005-04-05 + (set (make-local-variable 'font-lock-keywords) + u-vm-color-summary-keywords) + (set (make-local-variable 'font-lock-keywords-only) t) + (font-lock-mode 1)))) +(make-obsolete 'u-vm-color-summary-mode + 'vm-summary-enable-faces "8.2.0") + +(defun u-vm-color-fontify-regexp (start end regexp how) + "Search the buffer for an expression and fontify it. +Search starts at START and ends at END. If REGEXP is found, it +is fontified according to the argument HOW, which is a list of +the form '((index face)...)." +;;(message "Searching from %d to %d for %s" start end regexp) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char start) + (while (and start (< start end)) + (setq start (re-search-forward regexp end t)) + (when start + ;;(message "match found!") + (mapc (lambda (what) + (let ((index (nth 0 what)) (face (nth 1 what))) + (when (match-beginning index) + ;;(message "Adding face %s for match %d" face index) + (put-text-property (match-beginning index) + (match-end index) + 'face face)))) + how)))))) + +(defun u-vm-color-fontify-signature (start end) + "Search and fontify the signature. +Search is restricted to the region between START and END." +(let ((inhibit-read-only t)) + (save-excursion + (goto-char end) + (setq start (re-search-backward "^\\(- \\)?-- ?$" start t)) + (when start + (put-text-property start end 'face 'u-vm-color-signature-face))))) + +(defun u-vm-color-fontify-pgp-signature (start end) + "Search and fontify inline PGP signatures." + (let ((inhibit-read-only t) + (pgp-end-regex "-----END PGP SIGNATURE-----") + (pgp-start-regex "-----BEGIN PGP SIGNATURE-----") + (pgp-sign-regex "-----BEGIN PGP SIGNED MESSAGE-----") + (pgp-hash-regex "^Hash: .*") + re-end-pos) + (save-excursion + (goto-char end) + (when (re-search-backward pgp-end-regex start t) + (setq re-end-pos (match-end 0)) + (when (re-search-backward pgp-start-regex start t) + (put-text-property (point) re-end-pos + 'face 'u-vm-color-pgp-inline-signature-face))) + (when (re-search-backward pgp-hash-regex start t) + (setq re-end-pos (match-end 0)) + (when (re-search-backward pgp-sign-regex start t) + (put-text-property (point) re-end-pos + 'face ' 'u-vm-color-pgp-inline-signature-face))) + ))) + +;;;###autoload +(defun u-vm-color-fontify-buffer () + "Fontifies mail-buffers." + (interactive) + ;;(message "u-vm-color-fontify-buffer") + (let ((continued-header-contents "\\(.*\\(\n[ \t]+.*\\)*\\)") + (pmin (point-min)) + (buffer-modified (buffer-modified-p)) + (header-end (or + (save-excursion + (goto-char (point-min)) + (re-search-forward "^[ \t]*$" (point-max) t)) + (point-min)))) + (u-vm-color-fontify-regexp pmin header-end + (concat "^\\([A-Z][-A-Za-z0-9]+:\\) " + continued-header-contents) + '((1 u-vm-color-header-face) + (2 u-vm-color-default-face))) + (u-vm-color-fontify-regexp pmin header-end + (concat "^Date: " continued-header-contents) + '((1 u-vm-color-date-face))) + (u-vm-color-fontify-regexp pmin header-end + (concat "^Subject: " + continued-header-contents) + '((1 u-vm-color-subject-face))) + (u-vm-color-fontify-regexp pmin header-end + (concat "^\\(From\\|Sender\\): " + continued-header-contents) + '((2 u-vm-color-author-face))) + (u-vm-color-fontify-regexp pmin header-end + (concat "^\\(To\\|Cc\\|Bcc\\|Fcc\\): " + continued-header-contents) + '((2 u-vm-color-recipient-face))) + ;; signature + (u-vm-color-fontify-signature header-end (point-max)) + ;; PGP-signatures + (u-vm-color-fontify-pgp-signature header-end (point-max)) + ;; citations + (u-vm-color-fontify-regexp header-end (point-max) + "^ *[-A-Za-z0-9]*> *.*$" + '((0 u-vm-color-citation-1-face))) + (u-vm-color-fontify-regexp header-end (point-max) + "^ *[-A-Za-z0-9]*> *\\([-A-Za-z0-9]*> *.*\\)$" + '((1 u-vm-color-citation-2-face))) + (u-vm-color-fontify-regexp header-end (point-max) + (concat "^ *[-A-Za-z0-9]*> *[-A-Za-z0-9]*> *" + "\\([-A-Za-z0-9]*> *.*\\)$") + '((1 u-vm-color-citation-3-face))) + (u-vm-color-fontify-regexp header-end (point-max) + (concat "^ *[-A-Za-z0-9]*> *[-A-Za-z0-9]*> *" + "[-A-Za-z0-9]*> *\\([-A-Za-z0-9]*> *" + ".*\\)$") + '((1 u-vm-color-citation-4-face))) + (u-vm-color-fontify-regexp header-end (point-max) + (concat "^ *[-A-Za-z0-9]*> *[-A-Za-z0-9]*> *" + "[-A-Za-z0-9]*> *[-A-Za-z0-9]*> *" + "\\([-A-Za-z0-9]*> *.*\\)$") + '((1 u-vm-color-citation-5-face))) + ;; Spamassassin preview block + (u-vm-color-fontify-regexp header-end (point-max) + (concat "^Content preview:" + "\\([^\n]*\n\\( +[^\n]*\n\\)*\\)") + '((1 u-vm-color-spamassassin-face))) + (vm-restore-buffer-modified-p buffer-modified (current-buffer)))) + +;;;###autoload +(defun u-vm-color-fontify-buffer-even-more () + "Temporarily widen buffer and call `u-vm-color-fontify-buffer'." +(save-restriction + (widen) + ;;(message "u-vm-color-fontify-even-more: %d %d" (point-min) (point-max)) + (u-vm-color-fontify-buffer))) + +;;; u-vm-color.el ends here diff --git a/lisp/vcard.el b/lisp/vcard.el new file mode 100755 index 0000000..fe58cf1 --- /dev/null +++ b/lisp/vcard.el @@ -0,0 +1,707 @@ +;;; vcard.el --- vcard parsing and display routines +;; +;; This file is not part of VM; it is a utility used there. +;; +;; Copyright (C) 1997, 1999, 2000 Noah S. Friedman + +;; Author: Noah Friedman <friedman@splode.com> +;; Maintainer: friedman@splode.com +;; Keywords: vcard, mail, news +;; Created: 1997-09-27 + +;; $Id: vcard.el,v 1.11 2000/06/29 17:07:55 friedman Exp $ + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: + +;; Unformatted vcards are just plain ugly. But if you live in the MIME +;; world, they are a better way of exchanging contact information than +;; freeform signatures since the former can be automatically parsed and +;; stored in a searchable index. +;; +;; This library of routines provides the back end necessary for parsing +;; vcards so that they can eventually go into an address book like BBDB +;; (although this library does not implement that itself). Also included +;; is a sample pretty-printer which MUAs can use which do not provide their +;; own vcard formatters. + +;; This library does not interface directly with any mail user agents. For +;; an example of bindings for the VM MUA, see vm-vcard.el available from +;; +;; http://www.splode.com/~friedman/software/emacs-lisp/index.html#mail +;; +;; Updates to vcard.el should be available there too. + +;; The main entry point to this package is `vcard-pretty-print' although +;; any documented variable or function is considered part of the API for +;; operating on vcard data. + +;; The vcard 2.1 format is defined by the versit consortium. +;; See http://www.imc.org/pdi/vcard-21.ps +;; +;; RFC 2426 defines the vcard 3.0 format. +;; See ftp://ftp.rfc-editor.org/in-notes/rfc2426.txt + +;; A parsed vcard is a list of attributes of the form +;; +;; (proplist value1 value2 ...) +;; +;; Where proplist is a list of property names and parameters, e.g. +;; +;; (property1 (property2 . parameter2) ...) +;; +;; Each property has an associated implicit or explicit parameter value +;; (not to be confused with attribute values; in general this API uses +;; `parameter' to refer to property values and `value' to refer to attribute +;; values to avoid confusion). If a property has no explicit parameter value, +;; the parameter value is considered to be `t'. Any property which does not +;; exist for an attribute is considered to have a nil parameter. + +;; TODO: +;; * Finish supporting the 3.0 extensions. +;; Currently, only the 2.1 standard is supported. +;; * Handle nested vcards and grouped attributes? +;; (I've never actually seen one of these in use.) +;; * Handle multibyte charsets. +;; * Inverse of vcard-parse-string: write .VCF files from alist +;; * Implement a vcard address book? Or is using BBDB preferable? +;; * Improve the sample formatter. + +;;; Code: + +(defgroup vcard nil + "Support for the vCard electronic business card format." + :group 'vcard + :group 'mail + :group 'news) + +;;;###autoload +(defcustom vcard-pretty-print-function 'vcard-format-sample-box + "*Formatting function used by `vcard-pretty-print'." + :type 'function + :group 'vcard) + +;;;###autoload +(defcustom vcard-standard-filters + '(vcard-filter-html + vcard-filter-adr-newlines + vcard-filter-tel-normalize + vcard-filter-textprop-cr) + "*Standard list of filters to apply to parsed vcard data. +These filters are applied sequentially to vcard attributes when +the function `vcard-standard-filter' is supplied as the second argument to +`vcard-parse'." + :type 'hook + :group 'vcard) + + +;;; No user-settable options below. + +;; XEmacs 21 ints and chars are disjoint types. +;; For all else, treat them as the same. +(defalias 'vcard-char-to-int + (if (fboundp 'char-to-int) 'char-to-int 'identity)) + +;; This is just the version number for this package; it does not refer to +;; the vcard format specification. Currently, this package does not yet +;; support the full vcard 3.0 specification. +;; +;; Whenever any part of the API defined in this package change in a way +;; that is not backward-compatible, the major version number here should be +;; incremented. Backward-compatible additions to the API should be +;; indicated by increasing the minor version number. +(defconst vcard-api-version "2.0") + +;; The vcard standards allow specifying the encoding for an attribute using +;; these values as immediate property names, rather than parameters of the +;; `encoding' property. If these are encountered while parsing, associate +;; them as parameters of the `encoding' property in the returned structure. +(defvar vcard-encoding-tags + '("quoted-printable" "base64" "8bit" "7bit")) + +;; The vcard parser will auto-decode these encodings when they are +;; encountered. These methods are invoked via vcard-parse-region-value. +(defvar vcard-region-decoder-methods + '(("quoted-printable" . vcard-region-decode-quoted-printable) + ("base64" . vcard-region-decode-base64))) + +;; This is used by vcard-region-decode-base64 +(defvar vcard-region-decode-base64-table + (let* ((a "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + (len (length a)) + (tbl (make-vector 123 nil)) + (i 0)) + (while (< i len) + (aset tbl (vcard-char-to-int (aref a i)) i) + (setq i (1+ i))) + tbl)) + + +;;; This function can be used generically by applications to obtain +;;; a printable representation of a vcard. + +;;;###autoload +(defun vcard-pretty-print (vcard) + "Format VCARD into a string suitable for display to user. +VCARD can be an unparsed string containing raw VCF vcard data +or a parsed vcard alist as returned by `vcard-parse-string'. + +The result is a string with formatted vcard information suitable for +insertion into a mime presentation buffer. + +The function specified by the variable `vcard-pretty-print-function' +actually performs the formatting. That function will always receive a +parsed vcard alist." + (and (stringp vcard) + (setq vcard (vcard-parse-string vcard))) + (funcall vcard-pretty-print-function vcard)) + + +;;; Parsing routines + +;;;###autoload +(defun vcard-parse-string (raw &optional filter) + "Parse RAW vcard data as a string, and return an alist representing data. + +If the optional function FILTER is specified, apply that filter to each +attribute. If no filter is specified, `vcard-standard-filter' is used. + +Filters should accept two arguments: the property list and the value list. +Modifying in place the property or value list will affect the resulting +attribute in the vcard alist. + +Vcard data is normally in the form + + begin: vcard + prop1a: value1a + prop2a;prop2b;prop2c=param2c: value2a + prop3a;prop3b: value3a;value3b;value3c + end: vcard + +\(Whitespace around the `:' separating properties and values is optional.\) +If supplied to this function an alist of the form + + \(\(\(\"prop1a\"\) \"value1a\"\) + \(\(\"prop2a\" \"prop2b\" \(\"prop2c\" . \"param2c\"\)\) \"value2a\"\) + \(\(\"prop3a\" \"prop3b\"\) \"value3a\" \"value3b\" \"value3c\"\)\) + +would be returned." + (let ((vcard nil) + (buf (generate-new-buffer " *vcard parser work*"))) + (unwind-protect + (save-excursion + (set-buffer buf) + ;; Make sure last line is newline-terminated. + ;; An extra trailing newline is harmless. + (insert raw "\n") + (setq vcard (vcard-parse-region (point-min) (point-max) filter))) + (kill-buffer buf)) + vcard)) + +;;;###autoload +(defun vcard-parse-region (beg end &optional filter) + "Parse the raw vcard data in region, and return an alist representing data. +This function is just like `vcard-parse-string' except that it operates on +a region of the current buffer rather than taking a string as an argument. + +Note: this function modifies the buffer!" + (or filter + (setq filter 'vcard-standard-filter)) + (let ((case-fold-search t) + (vcard-data nil) + (pos (make-marker)) + (newpos (make-marker)) + properties value) + (save-restriction + (narrow-to-region beg end) + (save-match-data + ;; Unfold folded lines and delete naked carriage returns + (goto-char (point-min)) + (while (re-search-forward "\r$\\|\n[ \t]" nil t) + (goto-char (match-beginning 0)) + (delete-char 1)) + + (goto-char (point-min)) + (re-search-forward "^begin:[ \t]*vcard[ \t]*\n") + (set-marker pos (point)) + (while (and (not (looking-at "^end[ \t]*:[ \t]*vcard[ \t]*$")) + (re-search-forward ":[ \t]*" nil t)) + (set-marker newpos (match-end 0)) + (setq properties + (vcard-parse-region-properties pos (match-beginning 0))) + (set-marker pos (marker-position newpos)) + (re-search-forward "[ \t]*\n") + (set-marker newpos (match-end 0)) + (setq value + (vcard-parse-region-value properties pos (match-beginning 0))) + (set-marker pos (marker-position newpos)) + (goto-char pos) + (funcall filter properties value) + (setq vcard-data (cons (cons properties value) vcard-data))))) + (nreverse vcard-data))) + +(defun vcard-parse-region-properties (beg end) + (downcase-region beg end) + (let* ((proplist (vcard-split-string (buffer-substring beg end) ";")) + (props proplist) + split) + (save-match-data + (while props + (cond ((string-match "=" (car props)) + (setq split (vcard-split-string (car props) "=" 2)) + (setcar props (cons (car split) (car (cdr split))))) + ((member (car props) vcard-encoding-tags) + (setcar props (cons "encoding" (car props))))) + (setq props (cdr props)))) + proplist)) + +(defun vcard-parse-region-value (proplist beg end) + (let* ((encoding (vcard-get-property proplist "encoding")) + (decoder (cdr (assoc encoding vcard-region-decoder-methods))) + result pos match-beg match-end) + (save-restriction + (narrow-to-region beg end) + (cond (decoder + ;; Each `;'-separated field needs to be decoded and saved + ;; separately; if the entire region were decoded at once, we + ;; would not be able to distinguish between the original `;' + ;; chars and those which were encoded in order to quote them + ;; against being treated as field separators. + (goto-char beg) + (setq pos (set-marker (make-marker) (point))) + (setq match-beg (make-marker)) + (setq match-end (make-marker)) + (save-match-data + (while (< pos (point-max)) + (cond ((search-forward ";" nil t) + (set-marker match-beg (match-beginning 0)) + (set-marker match-end (match-end 0))) + (t + (set-marker match-beg (point-max)) + (set-marker match-end (point-max)))) + (funcall decoder pos match-beg) + (setq result (cons (buffer-substring pos match-beg) result)) + (if (= match-beg match-end) + (setq pos (point-max)) + (set-marker pos (marker-position match-end))))) + (setq result (nreverse result)) + (vcard-set-property proplist "encoding" nil)) + (t + (setq result (vcard-split-string (buffer-string) ";"))))) + (goto-char (point-max)) + result)) + + +;;; Functions for retrieving property or value information from parsed +;;; vcard attributes. + +(defun vcard-values (vcard have-props &optional non-props limit) + "Return the values in VCARD. +This function is like `vcard-ref' and takes the same arguments, but return +only the values, not the associated property lists." + (mapcar 'cdr (vcard-ref vcard have-props non-props limit))) + +(defun vcard-ref (vcard have-props &optional non-props limit) + "Return the attributes in VCARD with HAVE-PROPS properties. +Optional arg NON-PROPS is a list of properties which candidate attributes +must not have. +Optional arg LIMIT means return no more than that many attributes. + +The attributes in VCARD which have all properties specified by HAVE-PROPS +but not having any specified by NON-PROPS are returned. The first element +of each attribute is the actual property list; the remaining elements are +the values. + +If a specific property has an associated parameter \(e.g. an encoding\), +use the syntax \(\"property\" . \"parameter\"\) to specify it. If property +parameter is not important or it has no specific parameter, just specify +the property name as a string." + (let ((attrs vcard) + (result nil) + (count 0)) + (while (and attrs (or (null limit) (< count limit))) + (and (vcard-proplist-all-properties (car (car attrs)) have-props) + (not (vcard-proplist-any-properties (car (car attrs)) non-props)) + (setq result (cons (car attrs) result) + count (1+ count))) + (setq attrs (cdr attrs))) + (nreverse result))) + +(defun vcard-proplist-all-properties (proplist props) + "Returns nil unless PROPLIST contains all properties specified in PROPS." + (let ((result t)) + (while (and result props) + (or (vcard-get-property proplist (car props)) + (setq result nil)) + (setq props (cdr props))) + result)) + +(defun vcard-proplist-any-properties (proplist props) + "Returns `t' if PROPLIST contains any of the properties specified in PROPS." + (let ((result nil)) + (while (and (not result) props) + (and (vcard-get-property proplist (car props)) + (setq result t)) + (setq props (cdr props))) + result)) + +(defun vcard-get-property (proplist property) + "Return the value from PROPLIST of PROPERTY. +PROPLIST is a vcard attribute property list, which is normally the first +element of each attribute entry in a vcard." + (or (and (member property proplist) t) + (cdr (assoc property proplist)))) + +(defun vcard-set-property (proplist property value) + "In PROPLIST, set PROPERTY to VALUE. +PROPLIST is a vcard attribute property list. +If VALUE is nil, PROPERTY is deleted." + (let (elt) + (cond ((null value) + (vcard-delete-property proplist property)) + ((setq elt (member property proplist)) + (and value (not (eq value t)) + (setcar elt (cons property value)))) + ((setq elt (assoc property proplist)) + (cond ((eq value t) + (setq elt (memq elt proplist)) + (setcar elt property)) + (t + (setcdr elt value)))) + ((eq value t) + (nconc proplist (cons property nil))) + (t + (nconc proplist (cons (cons property value) nil)))))) + +(defun vcard-delete-property (proplist property) + "Delete from PROPLIST the specified property PROPERTY. +This will not succeed in deleting the first member of the proplist, but +that element should never be deleted since it is the primary key." + (let (elt) + (cond ((setq elt (member property proplist)) + (delq (car elt) proplist)) + ((setq elt (assoc property proplist)) + (delq (car (memq elt proplist)) proplist))))) + + +;;; Vcard data filters. +;; +;;; Filters receive both the property list and value list and may modify +;;; either in-place. The return value from the filters are ignored. +;; +;;; These filters can be used for purposes such as removing HTML tags or +;;; normalizing phone numbers into a standard form. + +(defun vcard-standard-filter (proplist values) + "Apply filters in `vcard-standard-filters' to attributes." + (vcard-filter-apply-filter-list vcard-standard-filters proplist values)) + +;; This function could be used to dispatch other filter lists. +(defun vcard-filter-apply-filter-list (filter-list proplist values) + (while filter-list + (funcall (car filter-list) proplist values) + (setq filter-list (cdr filter-list)))) + +;; Some lusers put HTML (or even javascript!) in their vcards under the +;; misguided notion that it's a standard feature of vcards just because +;; Netscape supports this feature. That is wrong; the vcard specification +;; does not define any html content semantics and most MUAs cannot do +;; anything with html text except display them unparsed, which is ugly. +;; +;; Thank Netscape for abusing the standard and damned near rendering it +;; useless for interoperability between MUAs. +;; +;; This filter does a very rudimentary job. +(defun vcard-filter-html (proplist values) + "Remove HTML tags from attribute values." + (save-match-data + (while values + (while (string-match "<[^<>\n]+>" (car values)) + (setcar values (replace-match "" t t (car values)))) + (setq values (cdr values))))) + +(defun vcard-filter-adr-newlines (proplist values) + "Replace newlines with \"; \" in `adr' values." + (and (vcard-get-property proplist "adr") + (save-match-data + (while values + (while (string-match "[\r\n]+" (car values)) + (setcar values (replace-match "; " t t (car values)))) + (setq values (cdr values)))))) + +(defun vcard-filter-tel-normalize (proplist values) + "Normalize telephone numbers in `tel' values. +Spaces and hyphens are replaced with `.'. +US domestic telephone numbers are replaced with international format." + (and (vcard-get-property proplist "tel") + (save-match-data + (while values + (while (string-match "[\t._-]+" (car values)) + (setcar values (replace-match " " t t (car values)))) + (and (string-match "^(?\\(\\S-\\S-\\S-\\))? ?\ +\\(\\S-\\S-\\S- \\S-\\S-\\S-\\S-\\)" + (car values)) + (setcar values + (replace-match "+1 \\1 \\2" t nil (car values)))) + (setq values (cdr values)))))) + +(defun vcard-filter-textprop-cr (proplist values) + "Strip carriage returns from text values." + (and (vcard-proplist-any-properties + proplist '("adr" "email" "fn" "label" "n" "org" "tel" "title" "url")) + (save-match-data + (while values + (while (string-match "\r+" (car values)) + (setcar values (replace-match "" t t (car values)))) + (setq values (cdr values)))))) + + +;;; Decoding methods. + +(defmacro vcard-hexstring-to-ascii (s) + (if (string-lessp emacs-version "20") + `(format "%c" (car (read-from-string (format "?\\x%s" ,s)))) + `(format "%c" (string-to-number ,s 16)))) + +(defun vcard-region-decode-quoted-printable (&optional beg end) + (save-excursion + (save-restriction + (save-match-data + (narrow-to-region (or beg (point-min)) (or end (point-max))) + (goto-char (point-min)) + (while (re-search-forward "=\n" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + (while (re-search-forward "=[0-9A-Za-z][0-9A-Za-z]" nil t) + (let ((s (buffer-substring (1+ (match-beginning 0)) (match-end 0)))) + (replace-match (vcard-hexstring-to-ascii s) t t))))))) + +(defun vcard-region-decode-base64 (&optional beg end) + (save-restriction + (narrow-to-region (or beg (point-min)) (or end (point-max))) + (save-match-data + (goto-char (point-min)) + (while (re-search-forward "[ \t\r\n]+" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-min)) + (let ((count 0) + (n 0) + (c nil)) + (while (not (eobp)) + (setq c (char-after (point))) + (delete-char 1) + (cond ((char-equal c ?=) + (if (= count 2) + (insert (lsh n -10)) + ;; count must be 3 + (insert (lsh n -16) (logand 255 (lsh n -8)))) + (delete-region (point) (point-max))) + (t + (setq n (+ n (aref vcard-region-decode-base64-table + (vcard-char-to-int c)))) + (setq count (1+ count)) + (cond ((= count 4) + (insert (logand 255 (lsh n -16)) + (logand 255 (lsh n -8)) + (logand 255 n)) + (setq n 0 count 0)) + (t + (setq n (lsh n 6)))))))))) + + +(defun vcard-split-string (string &optional separator limit) + "Split STRING at occurences of SEPARATOR. Return a list of substrings. +Optional argument SEPARATOR can be any regexp, but anything matching the + separator will never appear in any of the returned substrings. + If not specified, SEPARATOR defaults to \"[ \\f\\t\\n\\r\\v]+\". +If optional arg LIMIT is specified, split into no more than that many + fields \(though it may split into fewer\)." + (or separator (setq separator "[ \f\t\n\r\v]+")) + (let ((string-list nil) + (len (length string)) + (pos 0) + (splits 0) + str) + (save-match-data + (while (<= pos len) + (setq splits (1+ splits)) + (cond ((and limit + (>= splits limit)) + (setq str (substring string pos)) + (setq pos (1+ len))) + ((string-match separator string pos) + (setq str (substring string pos (match-beginning 0))) + (setq pos (match-end 0))) + (t + (setq str (substring string pos)) + (setq pos (1+ len)))) + (setq string-list (cons str string-list)))) + (nreverse string-list))) + +(defun vcard-copy-tree (tree) + "Make a deep copy of nested conses." + (cond + ((consp tree) + (cons (vcard-copy-tree (car tree)) + (vcard-copy-tree (cdr tree)))) + (t tree))) + +(defun vcard-flatten (l) + (if (consp l) + (apply 'nconc (mapcar 'vcard-flatten l)) + (list l))) + + +;;; Sample formatting routines. + +(defun vcard-format-sample-box (vcard) + "Like `vcard-format-sample-string', but put an ascii box around text." + (let* ((lines (vcard-format-sample-lines vcard)) + (len (vcard-format-sample-max-length lines)) + (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n")) + (line-fmt (format "| %%-%ds |" len)) + (formatted-lines + (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n"))) + (if (string= formatted-lines "") + formatted-lines + (concat edge formatted-lines edge)))) + +(defun vcard-format-sample-string (vcard) + "Format VCARD into a string suitable for display to user. +VCARD should be a parsed vcard alist. The result is a string +with formatted vcard information which can be inserted into a mime +presentation buffer." + (mapconcat 'identity (vcard-format-sample-lines vcard) "\n")) + +(defun vcard-format-sample-lines (vcard) + (let* ((name (vcard-format-sample-get-name vcard)) + (title (vcard-format-sample-values-concat vcard '("title") 1 "; ")) + (org (vcard-format-sample-values-concat vcard '("org") 1 "; ")) + (addr (vcard-format-sample-get-address vcard)) + (tel (vcard-format-sample-get-telephone vcard)) + (lines (delete nil (vcard-flatten (list name title org addr)))) + (col-template (format "%%-%ds%%s" + (vcard-format-sample-offset lines tel))) + (l lines)) + (while tel + (setcar l (format col-template (car l) (car tel))) + ;; If we stripped away too many nil slots from l, add empty strings + ;; back in so setcar above will work on next iteration. + (and (cdr tel) + (null (cdr l)) + (setcdr l (cons "" nil))) + (setq l (cdr l)) + (setq tel (cdr tel))) + lines)) + +(defun vcard-format-sample-get-name (vcard) + (let ((name (car (car (vcard-values vcard '("fn") nil 1)))) + (email (car (vcard-format-sample-values + vcard '((("email" "pref")) + (("email" "internet")) + (("email"))) 1)))) + (cond ((and name email) + (format "%s <%s>" name email)) + (email) + (name) + ("")))) + +(defun vcard-format-sample-get-telephone (vcard) + (let ((fields '(("Work: " + (("tel" "work" "pref") . ("fax" "pager" "cell")) + (("tel" "work" "voice") . ("fax" "pager" "cell")) + (("tel" "work") . ("fax" "pager" "cell"))) + ("Home: " + (("tel" "home" "pref") . ("fax" "pager" "cell")) + (("tel" "home" "voice") . ("fax" "pager" "cell")) + (("tel" "home") . ("fax" "pager" "cell")) + (("tel") . ("fax" "pager" "cell" "work"))) + ("Cell: " + (("tel" "cell" "pref")) + (("tel" "cell"))) + ("Fax: " + (("tel" "pref" "fax")) + (("tel" "work" "fax")) + (("tel" "home" "fax")) + (("tel" "fax"))))) + (phones nil) + result) + (while fields + (setq result (vcard-format-sample-values vcard (cdr (car fields)))) + (while result + (setq phones + (cons (concat (car (car fields)) (car (car result))) phones)) + (setq result (cdr result))) + (setq fields (cdr fields))) + (nreverse phones))) + +(defun vcard-format-sample-get-address (vcard) + (let* ((addr (vcard-format-sample-values vcard '((("adr" "pref" "work")) + (("adr" "pref")) + (("adr" "work")) + (("adr"))) 1)) + (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr)))) + (city-list (delete "" (nthcdr 3 addr))) + (city (cond ((null (car city-list)) nil) + ((cdr city-list) + (format "%s, %s" + (car city-list) + (mapconcat 'identity (cdr city-list) " "))) + (t (car city-list))))) + (delete nil (if city + (append street (list city)) + street)))) + +(defun vcard-format-sample-values-concat (vcard have-props limit sep) + (let ((l (car (vcard-values vcard have-props nil limit)))) + (and l (mapconcat 'identity (delete "" (vcard-copy-tree l)) sep)))) + +(defun vcard-format-sample-values (vcard proplists &optional limit) + (let ((result (vcard-format-sample-ref vcard proplists limit))) + (if (equal limit 1) + (cdr result) + (mapcar 'cdr result)))) + +(defun vcard-format-sample-ref (vcard proplists &optional limit) + (let ((result nil)) + (while (and (null result) proplists) + (setq result (vcard-ref vcard + (car (car proplists)) + (cdr (car proplists)) + limit)) + (setq proplists (cdr proplists))) + (if (equal limit 1) + (vcard-copy-tree (car result)) + (vcard-copy-tree result)))) + +(defun vcard-format-sample-offset (row1 row2 &optional maxwidth) + (or maxwidth (setq maxwidth (frame-width))) + (let ((max1 (vcard-format-sample-max-length row1)) + (max2 (vcard-format-sample-max-length row2))) + (if (zerop max1) + 0 + (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2)))))))) + +(defun vcard-format-sample-max-length (strings) + (let ((maxlen 0)) + (while strings + (setq maxlen (max maxlen (length (car strings)))) + (setq strings (cdr strings))) + maxlen)) + +(provide 'vcard) + +;;; vcard.el ends here. diff --git a/lisp/vm-autoload.el b/lisp/vm-autoload.el new file mode 100755 index 0000000..9ed5715 --- /dev/null +++ b/lisp/vm-autoload.el @@ -0,0 +1,6 @@ +;; only for compatibility with older BBDB and others + +(if (not (featurep 'xemacs)) + (require 'vm-autoloads)) + +(provide 'vm-autoload) diff --git a/lisp/vm-avirtual.el b/lisp/vm-avirtual.el new file mode 100755 index 0000000..6db41a6 --- /dev/null +++ b/lisp/vm-avirtual.el @@ -0,0 +1,1198 @@ +;;; vm-avirtual.el --- additional functions for virtual folder selectors +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 2000-2006 Robert Widhopf-Fenk +;; +;; Author: Robert Widhopf-Fenk +;; Status: Tested with XEmacs 21.4.19 & VM 7.19 +;; Keywords: VM, virtual folders +;; X-URL: http://www.robf.de/Hacking/elisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: +;; +;; Virtual folders are one of the greatest features offered by VM, however +;; sometimes I do not want to visit a virtual folder in order to do something +;; on messages. E.g. I have a virtual folder selector for spam messages and I +;; want VM to mark those messages matching the selector for deletion when +;; retrieving new messages. This can be done with a trick described in +;; the VM-FAQ, however this created two new buffers polluting my buffer space. +;; So this package provides a function `vm-auto-delete-messages' for this +;; purpose without drawbacks. +;; +;; Then after I realized I was maintaining three different variables for +;; actually the same things. They were `vm-auto-folder-alist' for automatic +;; selection of folders when saving messages, `vm-virtual-folder-alist' for my +;; loved virtual folders and `vmpc-conditions' in order to solve the handling +;; of my different email-addresses. +;; +;; This was kind of annoying, since virtual folder selectors offer the +;; best way of specifying conditions, but they only work on messages +;; within folders and not on messages which are currently being +;; composed. So I decided to extend virtual folder selectors also to +;; message composing, although not all of the selectors are meaningful +;; for `mail-mode'. +;; +;; I wrote functions which can replace (*) the existing ones and others that +;; add new (+) functionality. Finally I came up with the following ones: +;; * vm-virtual-auto-archive-messages +;; * vm-virtual-save-message +;; * vmpc-check-virtual-selector +;; + vm-virtual-auto-delete-messages +;; + vm-virtual-auto-delete-message +;; + vm-virtual-omit-message +;; + vm-virtual-update-folders +;; + vm-virtual-apply-function +;; and the following variables +;; vm-virtual-check-case-fold-search +;; vm-virtual-auto-delete-message-selector +;; vm-virtual-auto-folder-alist +;; vm-virtual-message +;; and a couple of new selectors +;; mail-mode if in mail-mode evals its `argument' else `nil' +;; vm-mode if in vm-mode evals its `arg' else `nil' +;; eval evaluates its `arg' (write own complex selectors) +;; +;; So by using theses new features I can maintain just one selector for +;; e.g. my private email-address and get the right folder for saving messages, +;; visiting the corresponding virtual folders, auto archiving, setting the FCC +;; header and setting up `vmpc-conditions'. Do you know a mailer than can +;; beat this? +;; +;; My default selector for spam messages: +;; +;; ("spam" ("received") +;; (vm-mode +;; (and (new) (undeleted) +;; (or +;; ;; kill all those where all authors/recipients +;; ;; are unknown to my BBDB, i.e. messages from +;; ;; strangers who are not recognized by me. +;; ;; (c't 12/2001) +;; (not (in-bbdb)) +;; ;; authors that I do not know +;; (and (not (in-bbdb authors)) +;; (or +;; ;; with bad content +;; (spam-word) +;; ;; they hide ID codes by long subjects +;; (subject " ") +;; ;; HTML only messages +;; (header "^Content-Type: text/html") +;; ;; for 8bit encoding "chinese" spam +;; (header "[¡-ÿ][¡-ÿ][¡-ÿ][¡-ÿ]") +;; ;; for qp-encoding "chinese" spam +;; (header "=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]=[A-F][0-9A-F]") +;; )))))) +;; +;;; Feel free to send me any comments or bug reports. +;; +;;; Code: + +(provide 'vm-avirtual) + +(require 'vm-virtual) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-save) + (require 'vm-reply) + (require 'vm-sort) + (require 'vm-thread) +) + +(declare-function vm-get-folder-buffer "vm" (folder)) +;; The following function is erroneously called for fsfemacs as well +(declare-function key-or-menu-binding "vm-xemacs" (key &optional menu-flag)) +(declare-function bbdb-get-addresses "ext:bbdb-com" + (only-first-address + uninteresting-senders + get-header-content-function + &rest get-header-content-function-args)) +(declare-function bbdb-search-simple "ext:bbdb" (name net)) + +; group already defined in vm-vars +;(defgroup vm nil +; "VM" +; :group 'mail) + +(defgroup vm-avirtual nil + "VM additional virtual folder selectors and functions." + :group 'vm-ext) + +;;---------------------------------------------------------------------------- +(eval-when-compile + (require 'cl)) + +(eval-and-compile + (require 'advice) + (require 'regexp-opt) + (require 'time-date) + + (let ((feature-list '(bbdb bbdb-autoloads bbdb-com))) + (while feature-list + (condition-case nil + (require (car feature-list)) + (error + (if (load (format "%s\n" (car feature-list)) t) + (message "Library %s loaded!" (car feature-list)) + (message "Could not load feature %S. Related functions may not work correctly!" (car feature-list)) + (beep 1)))) + (setq feature-list (cdr feature-list))))) + +(defvar bbdb-get-addresses-headers) ; dummy declaration + +;;---------------------------------------------------------------------------- +(defvar vm-mail-virtual-selector-function-alist + '(;; standard selectors + (and . vm-mail-vs-and) + (or . vm-mail-vs-or) + (not . vm-mail-vs-not) + (any . vm-mail-vs-any) + (header . vm-mail-vs-header) + (text . vm-mail-vs-text) + (header-or-text . vm-mail-vs-header-or-text) + (recipient . vm-mail-vs-recipient) + (author . vm-mail-vs-author) + (author-or-recipient . vm-mail-vs-author-or-recipient) + (subject . vm-mail-vs-subject) + (sortable-subject . vm-mail-vs-sortable-subject) + (more-chars-than . vm-mail-vs-more-chars-than) + (less-chars-than . vm-mail-vs-less-chars-than) + (more-lines-than . vm-mail-vs-more-lines-than) + (less-lines-than . vm-mail-vs-less-lines-than) + (replied . vm-mail-vs-replied) + (answered . vm-mail-vs-answered) + (forwarded . vm-mail-vs-forwarded) + (redistributed . vm-mail-vs-redistributed) + (unreplied . vm-mail-vs-unreplied) + (unanswered . vm-mail-vs-unanswered) + (unforwarded . vm-mail-vs-unforwarded) + (unredistributed . vm-mail-vs-unredistributed) + + ;; unknown selectors which return always nil + (new . vm-mail-vs-unknown) + (unread . vm-mail-vs-unknown) + (read . vm-mail-vs-unknown) + (unseen . vm-mail-vs-unknown) + (recent . vm-mail-vs-unknown) + (deleted . vm-mail-vs-unknown) + (filed . vm-mail-vs-unknown) + (written . vm-mail-vs-unknown) + (edited . vm-mail-vs-unknown) + (marked . vm-mail-vs-unknown) + (undeleted . vm-mail-vs-unknown) + (unfiled . vm-mail-vs-unknown) + (unwritten . vm-mail-vs-unknown) + (unedited . vm-mail-vs-unknown) + (unmarked . vm-mail-vs-unknown) + (expanded . vm-mail-vs-unknown) + (collapsed . vm-mail-vs-unknown) + (virtual-folder-member . vm-mail-vs-unknown) + (label . vm-mail-vs-unknown) + (sent-before . vm-mail-vs-unknown) + (sent-after . vm-mail-vs-unknown) + + + ;; new selectors + (mail-mode . vm-mail-vs-mail-mode) + (vm-mode . vm-vs-vm-mode) + (eval . vm-mail-vs-eval) + (older-than . vm-mail-vs-older-than) + (newer-than . vm-mail-vs-newer-than) + (in-bbdb . vm-mail-vs-in-bbdb) + )) + +;;----------------------------------------------------------------------------- +(defun vm-avirtual-add-selectors (selectors) + (let ((alist 'vm-virtual-selector-function-alist) + (sup-alist 'vm-supported-interactive-virtual-selectors) + sel) + + (while selectors + (setq sel (car selectors)) + (add-to-list alist (cons sel (intern (format "vm-vs-%s" sel)))) + (add-to-list sup-alist (list (format "%s" sel))) + (setq selectors (cdr selectors))))) + +(vm-avirtual-add-selectors + '(mail-mode + vm-mode + eval + selected + in-bbdb + folder-name + )) + +;;----------------------------------------------------------------------------- +;; we redefine the basic selectors for some extra features ... + +(defcustom vm-virtual-check-case-fold-search t + "Wheater to use case-fold-search or not when applying virtual selectors. +I was really missing this!" + :type 'boolean + :group 'vm-avirtual) + +(defcustom vm-virtual-check-diagnostics nil + "When set to nil we will display messages on matching selectors." + :type 'boolean + :group 'vm-avirtual) + +(defvar vm-virtual-check-level 0) + +(defun vm-vs-or (m &rest selectors) + (let ((case-fold-search vm-virtual-check-case-fold-search) + (vm-virtual-check-level (+ 2 vm-virtual-check-level)) + (result nil) selector arglist function) + (while selectors + (setq selector (car (car selectors)) + function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (setq arglist (cdr (car selectors)) + arglist (cdr (car selectors)) + result (apply function m arglist) + selectors (if result nil (cdr selectors))) + (if vm-virtual-check-diagnostics + (princ (format "%sor: %s (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) ""))))) + result)) + +(defun vm-vs-and (m &rest selectors) + (let ((vm-virtual-check-level (+ 2 vm-virtual-check-level)) + (result t) selector arglist function) + (while selectors + (setq selector (car (car selectors)) + function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (setq arglist (cdr (car selectors)) + result (apply function m arglist) + selectors (if (null result) nil (cdr selectors))) + (if vm-virtual-check-diagnostics + (princ (format "%sand: %s (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) ""))))) + result)) + +(defun vm-vs-not (m arg) + (let ((vm-virtual-check-level (+ 2 vm-virtual-check-level)) + (selector (car arg)) + (arglist (cdr arg)) + result function) + (setq function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (setq result (apply function m arglist)) + (if vm-virtual-check-diagnostics + (princ (format "%snot: %s for (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) "")))) + (not result))) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defun vm-avirtual-check-for-missing-selectors (&optional arg) + "Check if there are selectors missing for either vm-mode or mail-mode." + (interactive "P") + (let ((a (if arg vm-mail-virtual-selector-function-alist + vm-virtual-selector-function-alist)) + (b (mapcar (lambda (s) (car s)) + (if arg vm-virtual-selector-function-alist + vm-mail-virtual-selector-function-alist))) + l) + (while a + (if (not (memq (caar a) b)) + (setq l (concat (format "%s" (caar a)) ", " l))) + (setq a (cdr a))) + (if l + (message "Selectors %s are missing" l) + (message "No selectors are missing")))) + +;;--------------------------------------------------------------------------- +;; new virtual folder selectors +(defvar vm-virtual-message nil + "Set to the VM message vector when doing a `vm-vs-eval'.") + +(defun vm-vs-folder-name (m regexp) + (setq m (vm-real-message-of m)) + (string-match regexp (buffer-name (marker-buffer (vm-start-of m))))) + +(defun vm-vs-eval (&rest selectors) + (let ((vm-virtual-message (car selectors))) + (eval (cadr selectors)))) + +(defun vm-vs-vm-mode (&rest selectors) + (if (not (equal major-mode 'mail-mode)) + (apply 'vm-vs-or selectors) + nil)) + +(defun vm-vs-selected (m) + (save-excursion + (vm-select-folder-buffer) + (eq m (car vm-message-pointer)))) + +(defun vm-vs-in-bbdb (m &optional address-class only-first) + "check if one of the email addresses from the mail is known." + (let (bbdb-user-mail-names) + (let* ((bbdb-get-only-first-address-p only-first) + (bbdb-user-mail-names nil) + (bbdb-get-addresses-headers + (if address-class + (or (list (assoc address-class bbdb-get-addresses-headers)) + (error "no such address class")) + bbdb-get-addresses-headers)) + (addresses (bbdb-get-addresses nil nil + 'bbdb/vm-get-header-content + (vm-real-message-of m))) + (done nil) + addr) + (while (and (not done) addresses) + (setq addr (caddar addresses) + addresses (cdr addresses)) + (let ((name (car addr)) + (net (cadr addr))) + (setq done (or (bbdb-search-simple nil net) + (bbdb-search-simple name nil))))) + done))) + +(defun vm-mail-vs-in-bbdb (&optional address-class only-first) + "check if one of the email addresses from the mail is known." + (let (bbdb-user-mail-names) + (let* ((bbdb-get-only-first-address-p only-first) + (bbdb-user-mail-names nil) + (bbdb-get-addresses-headers + (if address-class + (or (list (assoc address-class bbdb-get-addresses-headers)) + (error "no such address class")) + bbdb-get-addresses-headers)) + (addresses (bbdb-get-addresses nil nil + 'vm-mail-mode-get-header-contents)) + (done nil) + addr) + (while (and (not done) addresses) + (setq addr (caddar addresses) + addresses (cdr addresses)) + (let ((name (car addr)) + (net (cadr addr))) + (setq done (or (bbdb-search-simple nil net) + (bbdb-search-simple name nil))))) + done))) + +;;;###autoload +(defun vm-add-spam-word (word) + "Add a new word to the list of spam words." + (interactive (list (if (region-active-p) + (buffer-substring (point) (mark)) + (read-string "Spam word: ")))) + (save-excursion + (when (not (member word vm-spam-words)) + (if (get-file-buffer vm-spam-words-file) + (set-buffer (get-file-buffer vm-spam-words-file)) + (set-buffer (find-file-noselect vm-spam-words-file))) + (goto-char (point-max)) + ;; if the last character is no newline, then append one! + (if (and (not (= (point) (point-min))) + (save-excursion + (backward-char 1) + (not (looking-at "\n")))) + (insert "\n")) + (insert word) + (save-buffer) + (setq vm-spam-words (cons word vm-spam-words)) + (setq vm-spam-words-regexp (regexp-opt vm-spam-words))))) + +;;;###autoload +(defun vm-spam-words-rebuild () + "Discharge the internal cached data about spam words." + (interactive) + (setq vm-spam-words nil + vm-spam-words-regexp nil) + (if (get-file-buffer vm-spam-words-file) + (kill-buffer (get-file-buffer vm-spam-words-file))) + (vm-vs-spam-word nil) + (vm-inform 5 "%d spam words are installed" (length vm-spam-words))) + +;;--------------------------------------------------------------------------- +;; new mail virtual folder selectors + +(defun vm-mail-vs-eval (&rest selectors) + (eval (cadr selectors))) + +(defun vm-mail-vs-mail-mode (&rest selectors) + (if (equal major-mode 'mail-mode) + (apply 'vm-mail-vs-or selectors) + nil)) + +(defalias 'vm-vs-mail-mode 'vm-mail-vs-mail-mode) + +(defun vm-mail-vs-or (&rest selectors) + (let ((result nil) selector arglist + (case-fold-search vm-virtual-check-case-fold-search)) + (while selectors + (setq selector (car (car selectors)) + arglist (cdr (car selectors)) + result (apply (cdr (assq selector + vm-mail-virtual-selector-function-alist)) + arglist) + selectors (if result nil (cdr selectors))) + (if vm-virtual-check-diagnostics + (princ (format "%sor: %s (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) ""))))) + result)) + +(defun vm-mail-vs-and (&rest selectors) + (let ((result t) selector arglist) + (while selectors + (setq selector (car (car selectors)) + arglist (cdr (car selectors)) + result (apply (cdr (assq selector + vm-mail-virtual-selector-function-alist)) + arglist) + selectors (if (null result) nil (cdr selectors))) + (if vm-virtual-check-diagnostics + (princ (format "%sand: %s (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) ""))))) + result)) + +(defun vm-mail-vs-not (arg) + (let ((selector (car arg)) + (arglist (cdr arg)) + result) + (setq result + (apply + (cdr (assq selector vm-mail-virtual-selector-function-alist)) + arglist)) + (if vm-virtual-check-diagnostics + (princ (format "%snot: %s for (%S%s)\n" + (make-string vm-virtual-check-level ? ) + (if result t nil) selector + (if arglist (format " %S" arglist) "")))) + (not result))) + +;; return just nil for those selectors not known for mail-mode +(defun vm-mail-vs-unknown (&optional arg) + nil) + +(defun vm-mail-vs-any () + t) + +(defun vm-mail-vs-author (arg) + (let ((val (vm-mail-mode-get-header-contents "Sender\\|From:"))) + (and val (string-match arg val)))) + +(defun vm-mail-vs-recipient (arg) + (let (val) + (or + (and (setq val (vm-mail-mode-get-header-contents "\\(Resent-\\)?To:")) + (string-match arg val)) + (and (setq val (vm-mail-mode-get-header-contents "\\(Resent-\\)?CC:")) + (string-match arg val)) + (and (setq val (vm-mail-mode-get-header-contents "\\(Resent-\\)?BCC:")) + (string-match arg val))))) + +(defun vm-mail-vs-author-or-recipient (arg) + (or (vm-mail-vs-author arg) + (vm-mail-vs-recipient arg))) + +(defun vm-mail-vs-subject (arg) + (let ((val (vm-mail-mode-get-header-contents "Subject:"))) + (and val (string-match arg val)))) + +(defun vm-mail-vs-sortable-subject (arg) + (let ((case-fold-search t) + (subject (vm-mail-mode-get-header-contents "Subject:"))) + (when subject + (if (and vm-subject-ignored-prefix + (string-match vm-subject-ignored-prefix subject) + (zerop (match-beginning 0))) + (setq subject (substring subject (match-end 0)))) + (if (and vm-subject-ignored-suffix + (string-match vm-subject-ignored-suffix subject) + (= (match-end 0) (length subject))) + (setq subject (substring subject 0 (match-beginning 0)))) + (setq subject (vm-with-string-as-temp-buffer + subject + (function vm-collapse-whitespace))) + (if (and vm-subject-significant-chars + (natnump vm-subject-significant-chars) + (< vm-subject-significant-chars (length subject))) + (setq subject + (substring subject 0 vm-subject-significant-chars))) + (string-match arg subject)))) + +(defun vm-mail-vs-header (arg) + (save-excursion + (let ((start (point-min)) end) + (goto-char start) + (search-forward (concat "\n" mail-header-separator "\n")) + (setq end (match-beginning 0)) + (goto-char start) + (re-search-forward arg end t)))) + +(defun vm-mail-vs-text (arg) + (save-excursion + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (re-search-forward arg (point-max) t))) + +(defun vm-mail-vs-header-or-text (arg) + (save-excursion + (goto-char (point-min)) + (re-search-forward arg (point-max) t))) + +(defun vm-mail-vs-more-chars-than (arg) + (> (- (point-max) (point-min) (length mail-header-separator) 2) arg)) + +(defun vm-mail-vs-less-chars-than (arg) + (< (- (point-max) (point-min) (length mail-header-separator) 2) arg)) + +(defun vm-mail-vs-more-lines-than (arg) + (> (- (count-lines (point-min) (point-max)) 1) arg)) + +(defun vm-mail-vs-less-lines-than (arg) + (< (- (count-lines (point-min) (point-max)) 1) arg)) + +(defun vm-mail-vs-replied () + vm-reply-list) +(fset 'vm-mail-vs-answered 'vm-mail-vs-replied) + +(defun vm-mail-vs-forwarded () + vm-forward-list) + +(defun vm-mail-vs-redistributed () + (vm-mail-mode-get-header-contents "Resent-[^:]+:")) + +(defun vm-mail-vs-unreplied () + (not (vm-mail-vs-forwarded ))) +(fset 'vm-mail-vs-unanswered 'vm-mail-vs-unreplied) + +(defun vm-mail-vs-unforwarded () + (not (vm-mail-vs-forwarded ))) + +(defun vm-mail-vs-unredistributed () + (not (vm-mail-vs-redistributed ))) + +(defun vm-mail-vs-older-than (arg) + (let* ((date (vm-mail-mode-get-header-contents "Date:")) + (days (and date (days-between (current-time-string) date)))) + (and days (> days arg)))) + +(defun vm-mail-vs-newer-than (arg) + (let* ((date (vm-mail-mode-get-header-contents "Date:")) + (days (and date (days-between (current-time-string) date)))) + (and days (<= days arg)))) + +;;---------------------------------------------------------------------------- + +(defun vm-virtual-folder-member-p (name folder-list) + "Checks if the VM folder with NAME, currently loaded, is among +the folders listed in FOLDER-LIST." + (let (buffer) + (catch 'found + (while folder-list + (setq buffer (vm-get-folder-buffer (car folder-list))) + (when (and buffer (buffer-name buffer) + (string-match name (buffer-name buffer))) + (throw 'found t)) + (setq folder-list (cdr folder-list))) + nil))) + +;;;###autoload +(defun vm-virtual-get-selector (vfolder &optional valid-folder-list) + "Return the selector of virtual folder VFOLDER for VALID-FOLDER-LIST." + (interactive + (list (vm-read-string "Virtual folder: " vm-virtual-folder-alist) + (if (equal major-mode 'mail-mode) + nil + (save-excursion + (vm-select-folder-buffer) + (list (buffer-name)))))) + + (let ((clauses (cadr (assoc vfolder vm-virtual-folder-alist))) + (selector nil) + (folders valid-folder-list)) + (when clauses + (if (null folders) + (setq selector (append (cdr clauses) selector)) + (while folders + (when (vm-virtual-folder-member-p (car folders) (car clauses)) + (setq selector (append (cdr clauses) selector))) + (setq folders (cdr folders))))) + + selector)) + +;;----------------------------------------------------------------------------- + +;;;###autoload +(defun vm-virtual-check-selector (selector &optional msg virtual) + "Return t if SELECTOR matches the message MSG. +If VIRTUAL is true we check the current message and not the real one." + (if msg + (if virtual + (apply 'vm-vs-or msg selector) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of msg))) + (apply 'vm-vs-or msg selector))) + (if (eq major-mode 'mail-mode) + (apply 'vm-mail-vs-or selector)))) + +;;;###autoload +(defun vm-virtual-check-selector-interactive (selector &optional diagnostics) + "Return t if SELECTOR matches the current message. +Called with an prefix argument we display more diagnostics about the selector +evaluation. Information is displayed in the order of evaluation and indented +according to the level of recursion. The displayed information is has the +format: + FATHER-SELECTOR: RESULT CHILD-SELECTOR" + (interactive + (list (vm-read-string "Virtual folder: " vm-virtual-folder-alist) + current-prefix-arg)) + (save-excursion + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-follow-summary-cursor) + (let ((msg (car vm-message-pointer)) + (virtual (eq major-mode 'vm-virtual-mode)) + (vm-virtual-check-diagnostics (or vm-virtual-check-diagnostics + diagnostics))) + (with-output-to-temp-buffer "*VM virtual-folder-check*" + (save-excursion + (set-buffer "*VM virtual-folder-check*") + (toggle-truncate-lines t)) + (princ (format "Checking %S on <%s> from %s\n\n" selector + (vm-su-subject msg) (vm-su-from msg))) + (princ (format "\nThe virtual folder selector `%s' is %s\n" + selector + (if (vm-virtual-check-selector + (vm-virtual-get-selector selector) + msg virtual) + "true" + "false"))))))) + +;;---------------------------------------------------------------------------- +(defvar vmpc-current-state nil) +;;;###autoload +(defun vmpc-virtual-check-selector (selector &optional folder-list) + "Checks SELECTOR based on the state of vmpc on the original or current." + (setq selector (vm-virtual-get-selector selector folder-list)) + (if (null selector) + (error "no virtual folder %s!" selector)) + (cond ((or (eq vmpc-current-state 'reply) + (eq vmpc-current-state 'forward) + (eq vmpc-current-state 'resend)) + (vm-virtual-check-selector selector (car vm-message-pointer))) + ((eq vmpc-current-state 'automorph) + (vm-virtual-check-selector selector)))) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-apply-function (count &optional selector function) + "Apply a FUNCTION to the next COUNT messages matching SELECTOR." + (interactive "p") + (when (vm-interactive-p) + (vm-follow-summary-cursor) + (setq selector (vm-virtual-get-selector + (vm-read-string "Virtual folder: " + vm-virtual-folder-alist))) + (if vm-xemacs-p + (setq function + (key-or-menu-binding (read-key-sequence "VM command: "))) + (setq function + (key-binding (read-key-sequence "VM command: "))))) + + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + + (let ((mlist (vm-select-operable-messages + (or count 1) (vm-interactive-p)"Apply to")) + (count 0)) + + (while mlist + (if (vm-virtual-check-selector selector (car mlist)) + (progn (funcall function (car mlist)) + (vm-increment count))) + (setq mlist (cdr mlist))) + + count)) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-update-folders (&optional count message-list) + "Updates all virtual folders. +E.g. when creating a folder of all marked messages one can call this +function in order to add newly marked messages to the virtual folder +without recreating it." + (interactive "p") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + + (let ((new-messages (or message-list + (vm-select-operable-messages + count (vm-interactive-p) "Update"))) + b-list) + (setq new-messages (copy-sequence new-messages)) + (if (and new-messages vm-virtual-buffers) + (save-excursion + (setq b-list vm-virtual-buffers) + (while b-list + ;; buffer might be dead + (if (buffer-name (car b-list)) + (let (tail-cons) + (set-buffer (car b-list)) + (setq tail-cons (vm-last vm-message-list)) + (vm-build-virtual-message-list new-messages) + (if (or (null tail-cons) (cdr tail-cons)) + (progn + (setq vm-ml-sort-keys nil) + (if vm-thread-obarray + (vm-build-threads (cdr tail-cons))) + (vm-set-summary-redo-start-point + (or (cdr tail-cons) vm-message-list)) + (vm-set-numbering-redo-start-point + (or (cdr tail-cons) vm-message-list)) + (if (null vm-message-pointer) + (progn (setq vm-message-pointer vm-message-list + vm-need-summary-pointer-update t) + (if vm-message-pointer + (vm-present-current-message)))) + (setq vm-messages-needing-summary-update new-messages + vm-need-summary-pointer-update t) + (vm-update-summary-and-mode-line) + (if vm-summary-show-threads + (vm-sort-messages (or vm-ml-sort-keys "activity"))))))) + (setq b-list (cdr b-list))))) + new-messages)) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-omit-message (&optional count message-list) + "Omits a meassage from a virtual folder. +IMHO allowing it for real folders makes no sense. One rather should create a +virtual folder of all messages." + (interactive "p") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + + (if (not (eq major-mode 'vm-virtual-mode)) + (error "This is no virtual folder.")) + + (let ((old-messages (or message-list + (vm-select-operable-messages + count (vm-interactive-p) "Omit"))) + prev curr + (mp vm-message-list)) + + (while mp + (if (not (member (car mp) old-messages)) + nil + (setq prev (vm-reverse-link-of (car mp)) + curr (or (cdr prev) vm-message-list)) + (vm-set-numbering-redo-start-point (or prev t)) + (vm-set-summary-redo-start-point (or prev t)) + (if (eq vm-message-pointer curr) + (setq vm-system-state nil + vm-message-pointer (or prev (cdr curr)))) + (if (eq vm-last-message-pointer curr) + (setq vm-last-message-pointer nil)) + (if (null prev) + (progn + (setq vm-message-list (cdr vm-message-list)) + (and (cdr curr) + (vm-set-reverse-link-of (car (cdr curr)) nil))) + (setcdr prev (cdr curr)) + (and (cdr curr) + (vm-set-reverse-link-of (car (cdr curr)) prev)))) + (setq mp (cdr mp))) + + (vm-update-summary-and-mode-line) + (if vm-summary-show-threads + (vm-sort-messages (or vm-ml-sort-keys "activity"))) + old-messages)) + +;;---------------------------------------------------------------------------- + +(defcustom vm-virtual-auto-delete-message-selector "spam" + "*Name of virtual folder selector used for automatically deleting a message. +Actually they are only marked for deletion." + :group 'vm-avirtual + :type 'string) + +(defcustom vm-virtual-auto-delete-message-folder nil + "*When set to a folder name we save affected messages there." + :group 'vm-avirtual + :type '(choice (file :tag "VM folder" "spam") + (const :tag "Disabled" nil))) + +(defcustom vm-virtual-auto-delete-message-expunge nil + "*When true we expunge the affected right after marking and saving them." + :group 'vm-avirtual + :type 'boolean) + +;;;###autoload +(defun vm-virtual-auto-delete-message (&optional count selector) + "*Mark messages matching a virtual folder selector for deletion. +The virtual folder selector can be configured by the variable +`vm-virtual-auto-delete-message-selector'. + +This function does not visit the virtual folder, but checks only the current +message, therefore it is much faster and not so disturbing like the method +described in the VM-FAQ. + +In order to automatically mark spam for deletion use the function +`vm-virtual-auto-delete-messages'. See its documentation on how to hook it +into VM!" + (interactive "p") + + (setq selector (or selector + (vm-virtual-get-selector + vm-virtual-auto-delete-message-selector))) + + (let (spammlist) + (setq count (vm-virtual-apply-function + count + selector + (lambda (msg) + (setq spammlist (cons msg spammlist)) + (vm-set-labels + msg (list vm-virtual-auto-delete-message-selector)) + (vm-set-deleted-flag msg t) + (vm-mark-for-summary-update msg t)))) + + (when spammlist + (setq spammlist (reverse spammlist)) + ;; save them + (if vm-virtual-auto-delete-message-folder + (let ((vm-arrived-messages-hook nil) + (vm-arrived-message-hook nil) + (mlist spammlist)) + (while mlist + (let ((vm-message-pointer mlist)) + (vm-save-message vm-virtual-auto-delete-message-folder)) + (setq mlist (cdr mlist))))) + ;; expunge them + (if vm-virtual-auto-delete-message-expunge + (vm-expunge-folder :quiet t :just-these-messages spammlist))) + + (vm-display nil nil '(vm-delete-message vm-delete-message-backward) + (list this-command)) + + (vm-update-summary-and-mode-line) + + (message "%s message%s %s" + (if (> count 0) count "No") + (if (= 1 count) "" "s") + (concat + (if vm-virtual-auto-delete-message-folder + (format "saved to %s and " + vm-virtual-auto-delete-message-folder) + "") + (if vm-virtual-auto-delete-message-expunge + "expunged right away" + "marked for deletion"))))) + +;;;###autoload +(defun vm-virtual-auto-delete-messages () + "*Mark all messages from the current upto the last for (spam-)deletion. +Add this to `vm-arrived-messages-hook'. + +See the function `vm-virtual-auto-delete-message' for details. + + (add-hook 'vm-arrived-messages-hook 'vm-virtual-auto-delete-messages) +" + (interactive) + + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-virtual-auto-delete-message (length vm-message-pointer))) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defcustom vm-virtual-auto-folder-alist nil + "*Non-nil value should be an alist that VM will use to choose a default +folder name when messages are saved. The alist should be of the form + ((VIRTUAL-FOLDER-NAME . FOLDER-NAME) + ...) +where VIRTUAL-FOLDER-NAME is a string, and FOLDER-NAME +is a string or an s-expression that evaluates to a string. + +This allows you to extend `vm-virtual-auto-select-folder' to generate +a folder name. Your function may use `folder' to get the currently choosen +folder name and `mp' (a vm-message-pointer) to access the message. + +Example: + (setq vm-virtual-auto-folder-alist + '((\"spam\" (concat folder \"-\" + (format-time-string \"%y%m\" (current-time)))))) + +This will return \"spam-0008\" as a folder name for messages matching the +virtual folder selector of the virtual folder \"spam\" during August in year +2000." + :type 'sexp + :group 'vm-avirtual) + +;;;###autoload +(defun vm-virtual-auto-select-folder (&optional m avfolder-alist + valid-folder-list + not-to-history) + "Return the first matching virtual folder. +This is a more powerful replacement of `vm-auto-select-folder'. +It is used by `vm-virtual-save-message' for finding the folder to +save the current message. It may also be used for finding the +right FCC for outgoing messages." + (when (not m) + (setq m (car vm-message-pointer)) + (setq avfolder-alist vm-virtual-folder-alist) + (setq valid-folder-list + (cond ((eq major-mode 'mail-mode) + nil) + ((eq major-mode 'vm-mode) + (save-excursion + (vm-select-folder-buffer) + (list (buffer-name)))) + ((eq major-mode 'vm-virtual-mode) + (list (buffer-name + (vm-buffer-of + (vm-real-message-of m)))))))) + + (let ((vfolders avfolder-alist) + selector folder-list) + + (when t;(and m (aref m 0) (aref (aref m 0) 0) + ; (marker-buffer (aref (aref m 0) 0))) + (while vfolders + (setq selector (vm-virtual-get-selector + (caar vfolders) valid-folder-list)) + (when (and selector (vm-virtual-check-selector selector m)) + (setq folder-list (append (list (caar vfolders)) folder-list)) + (if not-to-history + (setq vfolders nil))) + (setq vfolders (cdr vfolders))) + + (setq folder-list (reverse folder-list)) + + (setq folder-list + (mapcar (lambda (f) + (let ((rf (assoc f vm-virtual-auto-folder-alist))) + (if rf (eval (cadr rf)) f))) + folder-list)) + + (when (and (not not-to-history) folder-list) + (let ((fl (cdr folder-list)) f) + (while fl + (setq f (vm-abbreviate-file-name + (expand-file-name (car fl) vm-folder-directory)) + vm-folder-history (delete f vm-folder-history) + vm-folder-history (nconc (list f) vm-folder-history) + fl (cdr fl))))) + (car folder-list)))) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defvar vm-sort-compare-auto-folder-cache nil) +(add-to-list 'vm-supported-sort-keys "auto-folder") + +(defun vm-sort-compare-auto-folder (m1 m2) + (let* ((folder-list (list (buffer-name))) + s1 s2) + (if (setq s1 (assoc m1 vm-sort-compare-auto-folder-cache)) + (setq s1 (cdr s1)) + (setq s1 (vm-virtual-auto-select-folder + m1 vm-virtual-folder-alist folder-list)) + (add-to-list 'vm-sort-compare-auto-folder-cache (cons m1 s1))) + (if (setq s2 (assoc m2 vm-sort-compare-auto-folder-cache)) + (setq s2 (cdr s2)) + (setq s2 (vm-virtual-auto-select-folder + m2 vm-virtual-folder-alist folder-list)) + (add-to-list 'vm-sort-compare-auto-folder-cache (cons m2 s2))) + (cond ((or (and (null s1) s2) + (and s1 s2 (string-lessp s1 s2))) + t) + ((or (and (null s1) (null s2)) + (and s1 s2 (string-equal s1 s2))) + '=) + (t nil)))) + +;;;###autoload +(defun vm-sort-insert-auto-folder-names () + (interactive) + (if (vm-interactive-p) + (vm-sort-messages "auto-folder")) + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + ;; remove old descriptions + (save-excursion + (set-buffer vm-summary-buffer) + (goto-char (point-min)) + (let ((buffer-read-only nil) + (s (point-min)) + (p (point-min))) + (while (setq p (next-single-property-change p 'vm-auto-folder)) + (if (get-text-property (1+ p) 'vm-auto-folder) + (setq s p) + (delete-region s p)) + (setq p (1+ p))))) + ;; add new descriptions + (let ((ml vm-message-list) + (oldf "") + m f) + (while ml + (setq m (car ml) + f (cdr (assoc m vm-sort-compare-auto-folder-cache))) + (when (not (equal oldf f)) + (setq m (vm-su-start-of m)) + (save-excursion + (set-buffer (marker-buffer m)) + (let ((buffer-read-only nil)) + (goto-char m) + (insert (format "%s\n" (or f "no default folder"))) + (put-text-property m (point) 'vm-auto-folder t) + (put-text-property m (point) 'face 'blue) + ;; fix messages summary mark + (set-marker m (point)))) + (setq oldf f)) + (setq ml (cdr ml)))))) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-save-message (&optional folder count) + "Save the current message to a mail folder. +Like `vm-save-message' but the default folder is guessed by +`vm-virtual-auto-select-folder'." + (interactive + (list + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (vm-follow-summary-cursor) + (let ((default (save-current-buffer + (vm-select-folder-buffer) + (or (vm-virtual-auto-select-folder) + vm-last-save-folder))) + (dir (or vm-folder-directory default-directory))) + (cond ((and default + (let ((default-directory dir)) + (file-directory-p default))) + (vm-read-file-name "Save in folder: " + dir nil nil default 'vm-folder-history)) + (default + (vm-read-file-name + (format "Save in folder: (default %s) " default) + dir default nil nil 'vm-folder-history)) + (t + (vm-read-file-name "Save in folder: " dir nil))))) + (prefix-numeric-value current-prefix-arg))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-save-message folder count)) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-auto-archive-messages (&optional prompt) + "With a prefix ARG ask user before saving." + (interactive "P") + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + + (let ((auto-folder) + (folder-list (list (buffer-name))) + (archived 0)) + (unwind-protect + ;; Need separate (let ...) so vm-message-pointer can + ;; revert back in time for + ;; (vm-update-summary-and-mode-line). + ;; vm-last-save-folder is tucked away here since archives + ;; shouldn't affect its value. + (let ((vm-message-pointer + (if (eq last-command 'vm-next-command-uses-marks) + (vm-select-operable-messages + 0 (vm-interactive-p) "Archive"))) + (done nil) + stop-point + (vm-last-save-folder vm-last-save-folder) + (vm-move-after-deleting nil)) + ;; Double check if the user really wants to archive + (unless (or prompt vm-message-pointer + (y-or-n-p "Auto archive the entire folder? ")) + (error "Aborted")) + (setq vm-message-pointer (or vm-message-pointer vm-message-list)) + (vm-inform 5 "Archiving...") + ;; mark the place where we should stop. otherwise if any + ;; messages in this folder are archived to this folder + ;; we would file messages into this folder forever. + (setq stop-point (vm-last vm-message-pointer)) + (while (not done) + (and (not (vm-filed-flag (car vm-message-pointer))) + ;; don't archive deleted messages + (not (vm-deleted-flag (car vm-message-pointer))) + (setq auto-folder + (vm-virtual-auto-select-folder (car vm-message-pointer) + vm-virtual-folder-alist + folder-list)) + ;; Don't let user archive into the same folder + ;; that they are visiting. + (not (eq (vm-get-file-buffer auto-folder) + (current-buffer))) + (or (null prompt) + (y-or-n-p + (format "Save message %s in folder %s? " + (vm-number-of (car vm-message-pointer)) + auto-folder))) + (let ((vm-delete-after-saving vm-delete-after-archiving)) + (vm-save-message auto-folder) + (vm-increment archived) + (vm-inform 6 "%d archived, still working..." archived))) + (setq done (eq vm-message-pointer stop-point) + vm-message-pointer (cdr vm-message-pointer)))) + ;; fix mode line + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line)) + (if (zerop archived) + (vm-inform 5 "No messages were archived") + (vm-inform 5 "%d message%s archived" + archived (if (= 1 archived) "" "s"))))) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defun vm-virtual-make-folder-persistent () + "Save all messages of current virtual folder in the real folder +with the same name." + (interactive) + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (eq major-mode 'vm-virtual-mode) + (let ((file (substring (buffer-name) 1 -1))) + (vm-goto-message 0) + (vm-save-message file (length vm-message-list)) + (vm-inform 5 "Saved virtual folder in file \"%s\"" file)) + (error "This is not a virtual folder")))) + +;;---------------------------------------------------------------------------- + +;;; vm-avirtual.el ends here diff --git a/lisp/vm-biff.el b/lisp/vm-biff.el new file mode 100755 index 0000000..fb40f55 --- /dev/null +++ b/lisp/vm-biff.el @@ -0,0 +1,523 @@ +;;; vm-biff.el --- a xlbiff like tool for VM +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 2001 Robert Fenk +;; +;; Author: Robert Fenk +;; Status: Tested with XEmacs 21.4.15 & VM 7.18 +;; Keywords: VM helpers +;; X-URL: http://www.robf.de/Hacking/elisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: +;; +;; Put this file into your load path and add the following line to your .vm +;; file +;; +;; (require 'vm-biff) +;; +;; Try: M-x customize-group vm-biff RET +;; +;; You should set `vm-auto-get-newmail', since otherwise this package +;; does not make any sense! If getting mail is slow, use fetchmail to +;; retrieve it to a local file and uses that file as VM spool file! +;; +;;; Code: + +(provide 'vm-biff) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-summary) +) + +;; vm-xemacs.el is a fake file to fool the Emacs 23 compiler +(declare-function get-itimer "vm-xemacs.el" (name)) +(declare-function start-itimer "vm-xemacs.el" + (name function value &optional restart is-idle with-args + &rest function-arguments)) +(declare-function set-itimer-restart "vm-xemacs.el" (itimer restart)) +(declare-function delete-itimer "vm-xemacs" (itimer)) +(declare-function set-specifier "vm-xemacs" + (specifier value &optional locale tag-set how-to-add)) +(declare-function console-type "vm-xemacs" (&optional console)) +(declare-function frame-device "vm-xemacs" (&optional frame)) +(declare-function window-displayed-height "vm-xemacs" (&optional window)) +(defvar current-itimer) + +(declare-function vm-decode-mime-encoded-words-in-string "vm-mime" (string)) +(declare-function vm-goto-message "vm-motion" (n)) +(declare-function vm-mouse-set-mouse-track-highlight "vm-mouse" + (start end &optional overlay)) +(declare-function vm-summary-faces-add "vm-summary-faces" (message)) + +(when vm-xemacs-p + (require 'overlay)) + +(when vm-fsfemacs-p + (defvar horizontal-scrollbar-visible-p nil)) + +; group already defined in vm-vars.el +;(defgroup vm nil +; "VM" +; :group 'mail) + +(defgroup vm-biff nil + "The VM biff lib" + :group 'vm-ext) + +(defcustom vm-biff-position 'center + "*Position of the popup-frame." + :group 'vm-biff + :type '(choice (const :tag "center the popup frame" center) + (list :tag "Position of the top-left corner." + :value (1 1) + (integer :tag "X") + (integer :tag "Y")))) + + +(defcustom vm-biff-width 120 + "*Width of the popup-frame." + :group 'vm-biff + :type 'integer) + +(defcustom vm-biff-max-height 10 + "*Maximum hight of the popup window." + :group 'vm-biff + :type 'integer) + +(defcustom vm-biff-body-peek 50 + "*Maximum number of chractes to peek into the body of a message." + :group 'vm-biff + :type 'integer) + + +(defcustom vm-biff-focus-popup nil + "*t if popup window should get the focus after an update." + :group 'vm-biff + :type 'boolean) + +(defcustom vm-biff-auto-remove nil + "*Number of seconds after the popup window is automatically removed." + :group 'vm-biff + :type '(choice (integer :tag "Number of seconds" 10) + (const :tag "Disable remove" nil))) + +(defcustom vm-biff-summary-format nil + "*Like `vm-summary-format' but for popup buffers." + :group 'vm-biff + :type '(choice (string :tag "Summary format") + (const :tag "Disable own format" nil))) + +(defcustom vm-biff-selector '(and (new) + (not (deleted)) + (not (outgoing))) + "*virtual folder selector matching messages to display in the pop-up." + :group 'vm-biff + :type 'sexp) + +(defcustom vm-biff-place-frame-function 'vm-biff-place-frame + "*Function that sets the popup frame position and size." + :group 'vm-biff + :type 'function) + +(defcustom vm-biff-select-hook nil + "*List of hook functions to be run when selection a message." + :group 'vm-biff + :type '(repeat (function))) + +(defcustom vm-biff-select-frame-hook nil + "*List of hook functions to be run when selection a message. +You may want to add `vm-biff-fvwm-focus-vm-folder-frame'. +" + :group 'vm-biff + :type '(repeat (function))) + +(defcustom vm-biff-folder-list nil + "*List of folders to generate a popup for. +The default is all spool files listed in `vm-spool-files'. +Testing is done by string-matching it against the current buffer-file-name. + +Another form is an alist of elements (FODERNAME SELECTOR), +where SELECTOR is a virtual folder selector matching the +messges which should be displayed. See `vm-biff-selector' +for an example and `vm-virtual-folder-alist' on how virtual +folder selectors work." + :group 'vm-biff + :type '(repeat (string))) + +(defvar vm-biff-keymap nil + "Keymap for vm-biff popup buffers.") + +(when (not vm-biff-keymap) + (setq vm-biff-keymap (make-sparse-keymap "VM Biff")) + (define-key vm-biff-keymap "q" 'vm-biff-delete-popup) + (define-key vm-biff-keymap " " 'vm-biff-delete-popup) + (define-key vm-biff-keymap [(space)] 'vm-biff-delete-popup) + (define-key vm-biff-keymap [(button1)] 'vm-biff-delete-popup) + (define-key vm-biff-keymap [(mouse-1)] 'vm-biff-delete-popup) + (define-key vm-biff-keymap [(return)] 'vm-biff-select-message) + (define-key vm-biff-keymap [(button2)] 'vm-biff-select-message-mouse) + (define-key vm-biff-keymap [(mouse-2)] 'vm-biff-select-message-mouse)) + +(defun vm-summary-function-V (msg) + (let ((body-start (vm-text-of msg)) + (body-end (vm-end-of msg)) + peek) + (if (< vm-biff-body-peek (- body-end body-start)) + (setq body-end (+ vm-biff-body-peek body-start))) + (save-excursion + (save-restriction + (set-buffer (vm-buffer-of msg)) + (widen) + (goto-char body-end) + (re-search-forward "$" (point-max) t) + (setq peek (vm-decode-mime-encoded-words-in-string + (buffer-substring body-start (point)))) + (let ((pos 0)) + (if (string-match "^\n+" peek pos) + (setq peek (replace-match "" t t peek))) + (while (setq pos (string-match "\n\n+" peek pos)) + (setq peek (replace-match "\n" t t peek))) + (setq pos 0) + (while (setq pos (string-match "\n" peek pos)) + (setq peek (replace-match "\n\t" t t peek) + pos (+ 2 pos)))) + (setq peek (concat "\t" peek)) + (put-text-property 0 (length peek) 'face 'bold peek) + peek)))) + +(defun vm-biff-place-frame (&optional f) + "Centers the frame and limits it to `vm-biff-max-height' lines." + (let ((f (or f (selected-frame))) + (height (1+ (count-lines (point-min) (point-max))))) + (if (> height vm-biff-max-height) + (setq height vm-biff-max-height)) + (set-frame-size f vm-biff-width height) + + (if (eq 'center vm-biff-position) + (set-frame-position + f + (/ (- (x-display-pixel-width) (frame-pixel-width f)) 2) + (/ (- (x-display-pixel-height) (frame-pixel-height f)) 2)) + (apply 'set-frame-position f vm-biff-position)))) + +(defconst vm-biff-frame-properties + '(;; common properties + (name . "New Mail") + (unsplittable . t) + (minibuffer . nil) + (user-position . t) + (menubar-visible-p . nil) + (default-toolbar-visible-p . nil) +; (has-modeline-p . nil) + (top . 1) + (left . 1) + ;; Xemacs properties + (initially-unmapped . t) + (modeline-shadow-thickness . 0) + (vertical-scrollbar . nil) + ;; GNU Emacs properties + (vertical-scroll-bars . nil) + (menu-bar-lines . 0) + (tool-bar-lines . 0) + (visibility . nil) + ) + "Default properties for popup frame.") + +(defvar vm-biff-message-pointer nil) +(defvar vm-biff-folder-buffer nil) +(defvar vm-biff-message-number nil) +(defvar vm-biff-folder-frame nil) +(defvar vm-biff--folder-window nil) + +(defun vm-biff-x-p () + (if vm-xemacs-p + (memq (console-type) '(x mswindows)) + t)) + +(defun vm-biff-get-buffer-window (buf) + (if vm-xemacs-p + (vm-get-buffer-window buf (vm-biff-x-p) (frame-device)) + (vm-get-buffer-window buf (vm-biff-x-p)))) + +(defun vm-biff-find-folder-window (msg) + (let ((buf (vm-buffer-of msg))) + (save-excursion + (set-buffer buf) + (or (vm-biff-get-buffer-window buf) + (and vm-presentation-buffer + (vm-biff-get-buffer-window vm-presentation-buffer)) + (and vm-summary-buffer + (vm-biff-get-buffer-window vm-summary-buffer)))))) + +(defun vm-biff-find-folder-frame (msg) + (let ((ff (vm-biff-find-folder-window msg))) + (if ff (window-frame ff)))) + +;;;###autoload +(defun vm-biff-select-message () + "Put focus on the folder frame and select the appropiate message." + (interactive) + (let* ((vm-biff-message-pointer + (or (get-text-property (point) 'vm-message-pointer) + vm-biff-message-pointer)) + (msg (car vm-biff-message-pointer)) + (vm-biff-message-number (vm-number-of msg)) + (vm-biff-folder-buffer (vm-buffer-of msg)) + (vm-biff-folder-window (vm-biff-find-folder-window msg)) + vm-biff-folder-frame) + + (if vm-biff-folder-window + (setq vm-biff-folder-frame (window-frame vm-biff-folder-window))) + + (setq vm-biff-message-pointer nil) + (vm-biff-delete-popup) + + (cond ((and vm-biff-folder-frame (vm-biff-x-p)) + (vm-select-frame-set-input-focus vm-biff-folder-frame) + (run-hooks 'vm-biff-select-frame-hook) + (select-window vm-biff-folder-window)) + (vm-biff-folder-window + (select-window vm-biff-folder-window)) + (t + (bury-buffer) + (switch-to-buffer vm-biff-folder-buffer))) + + (sit-for 0) + + (if vm-biff-message-number + (vm-goto-message (string-to-number (vm-number-of msg)))) + + (run-hooks 'vm-biff-select-hook))) + +;;;###autoload +(defun vm-biff-select-message-mouse (event) + (interactive "e") + (mouse-set-point event) + (vm-biff-select-message)) + +(defcustom vm-biff-FvwmCommand-path "/usr/bin/FvwmCommand" + "Full qualified path to FvwmCommand." + :group 'vm-biff + :type 'file) + +;;;###autoload +(defun vm-biff-fvwm-focus-vm-folder-frame () + "Jumps to the frame containing the folder for the selected message. + +1) Your Emacs frame needs to have the folder name in its title, see the + variable `frame-title-format' on how to set this up. + +2) You need to define the FVWM2 function SelectWindow and start the + FvwmCommandS module. Therefore, you will need the following lines + in your .fvwm2rc file. + +AddToFunc InitFunction ++ I Module FvwmCommandS + +AddToFunc RestartFunction ++ I Module FvwmCommandS + +AddToFunc SelectWindow ++ I Next ($0) Iconify false ++ I Next ($0) Raise ++ I Next ($0) WarpToWindow 10p 10p +" + (interactive) + (let ((p (start-process "FvwmCommand" + " *FvwmCommand*" + vm-biff-FvwmCommand-path + "-c"))) + (process-send-string p (concat "SelectWindow *" + (buffer-name vm-biff-folder-buffer) + "*\n")) + (process-send-eof p))) + +;;;###autoload +(defun vm-biff-delete-popup (&optional wf) + (interactive) + (if (vm-biff-x-p) + (delete-frame wf) + (if (not (one-window-p)) + (delete-window wf))) + (sit-for 0)) + +(defun vm-biff-timer-delete-popup (wf) + (if (featurep 'itimer) + (delete-itimer current-itimer)) + (vm-biff-delete-popup wf)) + +(defvar vm-biff-message-pointer nil) +(make-variable-buffer-local 'vm-biff-message-pointer) + +(defvar horizontal-scrollbar-visible-p) ; defined for XEmacs only + +;;;###autoload +(defun vm-biff-popup (&optional force) + "Scan the current VM folder for new messages and popup a summary frame." + (interactive (list current-prefix-arg)) + + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + + (when (not vm-biff-folder-list) + (setq vm-biff-folder-list + (if (stringp (car vm-spool-files)) + (list (expand-file-name + vm-primary-inbox + vm-folder-directory)) + (mapcar (lambda (f) + (expand-file-name + (car f) + vm-folder-directory)) + vm-spool-files)))) + + (let* ((mp vm-message-pointer) + (folder (buffer-name)) + (do-mouse-track + (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces)) + (buf (get-buffer-create + (concat " *new messages in VM folder: " folder "*"))) + selector msg new-messages wf) + + (let ((fl vm-biff-folder-list)) + (while fl + (if (stringp (car fl)) + (if (string-match (car fl) (or (buffer-file-name) + (buffer-name))) + (setq selector (list vm-biff-selector) fl nil)) + (if (string-match (caar fl) (or (buffer-file-name) + (buffer-name))) + (setq selector (cdar fl) fl nil))) + (setq fl (cdr fl)))) + + (when selector + ;; collect the new messages + (set-buffer buf) + (setq buffer-read-only nil) + (erase-buffer) + + (let (start) + (while mp + (setq msg (car mp)) + (when (apply 'vm-vs-or msg selector) + (setq start (point)) + (vm-tokenized-summary-insert msg + (vm-summary-sprintf + (or vm-biff-summary-format + vm-summary-format) + msg t)) + (put-text-property start (point) 'vm-message-pointer mp) + + + (when do-mouse-track + (vm-mouse-set-mouse-track-highlight + start (point))) + + (if vm-summary-enable-faces + (vm-summary-faces-add msg) + (vm-summary-highlight-region start (point) + vm-summary-highlight-face)) + + (if (not new-messages) (setq new-messages mp))) + (setq mp (cdr mp)))) + + (when (and new-messages + (or force + (not (equal new-messages vm-biff-message-pointer)))) + (setq msg (car new-messages)) + (backward-delete-char 1) + (goto-char (point-min)) + + (setq truncate-lines t + buffer-read-only t) + (use-local-map vm-biff-keymap) + (setq vm-biff-message-pointer new-messages) + + ;; if in the minibuffer then seletc a different window + (if (active-minibuffer-window) + (other-window 1)) + + ;; generate a own window/frame showing the messages + (if (vm-biff-x-p) + ;; X Window System or MS Windows + (let* ((sf (selected-frame)) + (ff (vm-biff-find-folder-frame msg)) + (props (if ff + (cons (cons 'popup ff) + vm-biff-frame-properties) + vm-biff-frame-properties)) + (mf (or (and (if vm-xemacs-p + (vm-get-buffer-window buf t + (frame-device)) + (vm-get-buffer-window buf t)) + (window-frame + (vm-biff-get-buffer-window buf))) + (make-frame props)))) + + (select-frame mf) + (switch-to-buffer buf) + (if vm-xemacs-p + (set-specifier horizontal-scrollbar-visible-p nil)) + + (if (functionp vm-biff-place-frame-function) + (funcall vm-biff-place-frame-function)) + + (make-frame-visible mf) + (setq wf mf) + + (if vm-biff-focus-popup + (vm-select-frame-set-input-focus mf) + (select-frame sf))) + + ;; Terminal + (let ((w (vm-get-buffer-window buf)) + (window-min-height 2) + (h (count-lines (point-min) (point-max)))) + (if w + (if vm-biff-focus-popup (select-window w)) + (setq wf (split-window (selected-window)))) + (sit-for 0) + (switch-to-buffer buf) + (if (> h vm-biff-max-height) + (setq h vm-biff-max-height)) + (if vm-xemacs-p + (setq h (- (window-displayed-height) h)) + (setq h (- (window-height) h))) + (if (not (one-window-p)) + (shrink-window h))))) + + (if vm-biff-auto-remove + (cond + ((condition-case nil + (progn (require 'itimer) t) + (error nil)) + (start-itimer (buffer-name) + 'vm-biff-timer-delete-popup + vm-biff-auto-remove + nil t t wf)) + ((condition-case nil + (progn (require 'timer) t) + (error nil)) + (run-at-time vm-biff-auto-remove nil + 'vm-biff-timer-delete-popup wf)))))))) + +(add-hook 'vm-arrived-messages-hook 'vm-biff-popup t) + diff --git a/lisp/vm-build.el b/lisp/vm-build.el new file mode 100755 index 0000000..a4db45c --- /dev/null +++ b/lisp/vm-build.el @@ -0,0 +1,112 @@ +;; Add the current dir to the load-path +(setq load-path (cons default-directory load-path)) +;(setq debug-on-error t) +;(setq debug-ignored-errors nil) +;(message "load-path: %S" load-path) + +(defun vm-fix-cygwin-path (path) + "If PATH does not exist, try the DOS path instead. + This handles EmacsW32 path problems when building on cygwin." + (if (file-exists-p path) + path + (let ((dos-path (cond ((functionp 'mswindows-cygwin-to-win32-path) + (mswindows-cygwin-to-win32-path path)) + ((and (locate-library "cygwin-mount") + (require 'cygwin-mount)) + (cygwin-mount-activate) + (cygwin-mount-convert-file-name path)) + ((string-match "^/cygdrive/\\([a-z]\\)" path) + (replace-match (format "%s:" + (match-string 1 path)) + t t path))))) + (if (and dos-path (file-exists-p dos-path)) + dos-path + path)))) + +;; Add additional dirs to the load-path +(condition-case err + (when (getenv "OTHERDIRS") + (let ((otherdirs (read (format "%s" (getenv "OTHERDIRS")))) + dir) + (while otherdirs + (setq dir (car otherdirs)) + (if (not (file-exists-p dir)) + (error "Extra `load-path' directory %S does not exist!" dir)) + ;; (print (format "Adding %S" dir)) + (setq load-path (cons dir load-path) + otherdirs (cdr otherdirs))))) + + ((end-of-file) nil) + ((invalid-read-syntax) + (message "OTHERDIRS=%S rejected by `read': %s" + (getenv "OTHERDIRS") + ;(error-message-string err) + err + ))) + +;; Load byte compile +(require 'bytecomp) +;; Current public setting +;; Check for undefined functions, ignore save-excursion problems +(setq byte-compile-warnings '(not suspicious)) +;; Old permissive setting +;; (setq byte-compile-warnings '(free-vars)) +(put 'inhibit-local-variables 'byte-obsolete-variable nil) + +;; Preload these to get macros right +(require 'cl) +(require 'sendmail) + +;; now add VM source dirs to load-path and preload some +(setq load-path (append '("." "./lisp") load-path)) +(require 'vm-macro) +(require 'vm-version) +(require 'vm-message) +(require 'vm-vars) + + +(defun vm-custom-make-dependencies () + (if (load-library "cus-dep") + (if (functionp 'Custom-make-dependencies) + (Custom-make-dependencies) + (let ((generated-custom-dependencies-file "vm-cus-load.el")) + (custom-make-dependencies))) + (error "Failed to load 'cus-dep'"))) + +(defun vm-built-autoloads (&optional autoloads-file source-dir) + (let ((autoloads-file (or autoloads-file + (vm-fix-cygwin-path (car command-line-args-left)))) + (source-dir (or source-dir + (vm-fix-cygwin-path (car (cdr command-line-args-left))))) + (debug-on-error t) + (enable-local-eval nil)) + (if (not (file-exists-p source-dir)) + (error "Built directory %S does not exist!" source-dir)) + (message "Building autoloads file %S\nin directory %S." autoloads-file source-dir) + (load-library "autoload") + (set-buffer (find-file-noselect autoloads-file)) + (erase-buffer) + (setq generated-autoload-file autoloads-file) + (setq autoload-package-name "vm") + (setq make-backup-files nil) + (if (featurep 'xemacs) + (progn + (update-autoloads-from-directory source-dir) + (fixup-autoload-buffer (concat (if autoload-package-name + autoload-package-name + (file-name-nondirectory defdir)) + "-autoloads")) + (save-some-buffers t)) + ;; GNU Emacs 21 wants some content, but 22 does not like it ... + (insert ";;; vm-autoloads.el --- automatically extracted autoloads\n") + (insert ";;\n") + (insert ";;; Code:\n") + (cond + ((>= emacs-major-version 22) + (update-directory-autoloads source-dir)) + ((>= emacs-major-version 21) + (update-autoloads-from-directories source-dir)) + (t + (error "Do not know how to generate autoloads")))))) + +(provide 'vm-build) diff --git a/lisp/vm-crypto.el b/lisp/vm-crypto.el new file mode 100755 index 0000000..2213c3a --- /dev/null +++ b/lisp/vm-crypto.el @@ -0,0 +1,230 @@ +;;; vm-crypto.el --- Encryption and related functions for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-crypto) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + ) + +;; compatibility +(fset 'vm-pop-md5 'vm-md5-string) + +;;;###autoload +(defun vm-md5-region (start end) + (if (fboundp 'md5) + (md5 (current-buffer) start end) + (let ((buffer nil) + (retval nil) + (curbuf (current-buffer))) + (unwind-protect + (save-excursion + (setq buffer (vm-make-work-buffer)) + (set-buffer buffer) + (insert-buffer-substring curbuf start end) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (setq retval + (call-process-region (point-min) (point-max) + vm-pop-md5-program + t buffer nil)) + (if (not (equal retval 0)) + (progn + (error "%s failed: exited with code %s" + vm-pop-md5-program retval))) + ;; md5sum generates extra output even when summing stdin. + (goto-char (point-min)) + (if (re-search-forward " [ *]?-\n" nil t) + (replace-match "")) + + (goto-char (point-min)) + (if (or (re-search-forward "[^0-9a-f\n]" nil t) + (< (point-max) 32)) + (error "%s produced bogus MD5 digest '%s'" + vm-pop-md5-program + (vm-buffer-substring-no-properties (point-min) + (point-max)))) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32))) + (and buffer (kill-buffer buffer)))))) + +;; output is in hex +;;;###autoload +(defun vm-md5-string (string) + (if (fboundp 'md5) + (md5 string) + (vm-with-string-as-temp-buffer + string (function + (lambda () + (goto-char (point-min)) + (insert (vm-md5-region (point-min) (point-max))) + (delete-region (point) (point-max))))))) + +;; output is the raw digest bits, not hex +;;;###autoload +(defun vm-md5-raw-string (s) + (setq s (vm-md5-string s)) + (let ((raw (make-string 16 0)) + (i 0) n + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15) + ;; some mailer uses lower-case hex + ;; digits despite this being forbidden + ;; by the MIME spec. + (?a . 10) (?b . 11) (?c . 12) (?d . 13) + (?e . 14) (?f . 15)))) + (while (< i 32) + (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16) + (cdr (assoc (aref s (1+ i)) hex-digit-alist)))) + (aset raw (/ i 2) n) + (setq i (+ i 2))) + raw )) + +;;;###autoload +(defun vm-xor-string (s1 s2) + (let ((len (length s1)) + result (i 0)) + (if (/= len (length s2)) + (error "strings not of equal length")) + (setq result (make-string len 0)) + (while (< i len) + (aset result i (logxor (aref s1 i) (aref s2 i))) + (setq i (1+ i))) + result )) + +;;;###autoload +(defun vm-setup-ssh-tunnel (host port) + (let (local-port process done) + (while (not done) + (setq local-port (+ 1025 (random (- 65536 1025))) + process nil) + (condition-case nil + (progn + (setq process + (open-network-stream "TEST-CONNECTION" nil + "127.0.0.1" local-port)) + (vm-process-kill-without-query process)) + (error nil)) + (cond ((null process) + (setq process + (apply 'start-process + (format "SSH tunnel to %s:%s" host port) + (vm-make-work-buffer) + vm-ssh-program + (nconc + (list "-L" + (format "%d:%s:%s" local-port host port)) + (copy-sequence vm-ssh-program-switches) + (list host vm-ssh-remote-command))) + done t) + (vm-process-kill-without-query process) + (set-process-sentinel process 'vm-process-sentinel-kill-buffer)) + (t + (delete-process process)))) + + ;; wait for some output from vm-ssh-remote-command. this + ;; ensures that when we return the ssh connection is ready to + ;; do port-forwarding. + (accept-process-output process) + + local-port )) + +(defun vm-generate-random-data-file (n-octets) + (let ((file (vm-make-tempfile)) + work-buffer (i n-octets)) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (while (> i 0) + (insert-char (random 256) 1) + (setq i (1- i))) + (write-region (point-min) (point-max) file nil 0)) + (and work-buffer (kill-buffer work-buffer))) + file )) + +;;;###autoload +(defun vm-setup-stunnel-random-data-if-needed () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (if (and (stringp vm-stunnel-random-data-file) + (file-readable-p vm-stunnel-random-data-file)) + nil + (setq vm-stunnel-random-data-file + (vm-generate-random-data-file (* 4 1024))))))) + +;;;###autoload +(defun vm-tear-down-stunnel-random-data () + (if (stringp vm-stunnel-random-data-file) + (vm-error-free-call 'delete-file vm-stunnel-random-data-file)) + (setq vm-stunnel-random-data-file nil)) + +(defun vm-stunnel-random-data-args () + (cond ((null vm-stunnel-random-data-method) nil) + ((eq vm-stunnel-random-data-method 'generate) + (list "-R" vm-stunnel-random-data-file)) + (t nil))) + +;;;###autoload +(defun vm-stunnel-configuration-args (host port) + (if (eq vm-stunnel-wants-configuration-file 'unknown) + (setq vm-stunnel-wants-configuration-file + (not (eq (call-process vm-stunnel-program nil nil nil "-h") 0)))) + (if (not vm-stunnel-wants-configuration-file) + (nconc (vm-stunnel-random-data-args) + (list "-W" "-c" "-r" + (format "%s:%s" host port))) + (let ((work-buffer nil) + (workfile (vm-stunnel-configuration-file))) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (if (and vm-stunnel-program-additional-configuration-file + (stringp vm-stunnel-program-additional-configuration-file) + (file-readable-p + vm-stunnel-program-additional-configuration-file)) + (insert-file-contents + vm-stunnel-program-additional-configuration-file)) + (insert "client = yes\n") + (insert "RNDfile = " vm-stunnel-random-data-file "\n") + (insert "RNDoverwrite = no\n") + (insert "connect = " (format "%s:%s" host port) "\n") + (write-region (point-min) (point-max) workfile nil 0)) + (and work-buffer (kill-buffer work-buffer))) + (list workfile) ))) + +(defun vm-stunnel-configuration-file () + (if vm-stunnel-configuration-file + vm-stunnel-configuration-file + (setq vm-stunnel-configuration-file (vm-make-tempfile)) + (vm-register-global-garbage-files (list vm-stunnel-configuration-file)) + vm-stunnel-configuration-file)) + +;;; vm-crypto.el ends here diff --git a/lisp/vm-delete.el b/lisp/vm-delete.el new file mode 100755 index 0000000..1b49477 --- /dev/null +++ b/lisp/vm-delete.el @@ -0,0 +1,581 @@ +;;; vm-delete.el --- Delete and expunge commands for VM. +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-delete) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-crypto) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-sort) + (require 'vm-thread) + (require 'vm-pop) + (require 'vm-imap) +) + + +;;;###autoload +(defun vm-delete-message (count &optional mlist) + "Add the `deleted' attribute to the current message. + +The message will be physically deleted from the current folder the next +time the current folder is expunged. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are deleted. A negative argument means +the current message and the previous |COUNT| - 1 messages are +deleted. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are deleted, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are deleted." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (del-count 0)) + (unless mlist + (setq mlist (vm-select-operable-messages + count (vm-interactive-p) "Delete"))) + (while mlist + (unless (vm-deleted-flag (car mlist)) + (when (vm-set-deleted-flag (car mlist) t) + (vm-increment del-count) + ;; The following is a temporary fix. To be absorted into + ;; vm-update-summary-and-mode-line eventually. + (when (and vm-summary-enable-thread-folding + vm-summary-show-threads + ;; (not (and vm-enable-thread-operations + ;; (eq count 1))) + (> (vm-thread-count (car mlist)) 1)) + (with-current-buffer vm-summary-buffer + (vm-expand-thread (vm-thread-root (car mlist))))))) + (setq mlist (cdr mlist))) + (vm-display nil nil '(vm-delete-message vm-delete-message-backward) + (list this-command)) + (when (vm-interactive-p) + (if (zerop del-count) + (vm-inform 5 "No messages deleted") + (vm-inform 5 "%d message%s deleted" + del-count + (if (= 1 del-count) "" "s")))) + (vm-update-summary-and-mode-line) + (if (and vm-move-after-deleting (not used-marks)) + (let ((vm-circular-folders (and vm-circular-folders + (eq vm-move-after-deleting t)))) + (vm-next-message count t executing-kbd-macro))))) + +;;;###autoload +(defun vm-delete-message-backward (count) + "Like vm-delete-message, except the deletion direction is reversed." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-delete-message (- count))) + +;;;###autoload +(defun vm-undelete-message (count) + "Remove the `deleted' attribute from the current message. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are undeleted. A negative argument means +the current message and the previous |COUNT| - 1 messages are +deleted. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are undeleted, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are undeleted." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (mlist (vm-select-operable-messages + count (vm-interactive-p) "Undelete")) + (undel-count 0)) + (while mlist + (if (vm-deleted-flag (car mlist)) + (if (vm-set-deleted-flag (car mlist) nil) + (vm-increment undel-count))) + (setq mlist (cdr mlist))) + (if (and used-marks (vm-interactive-p)) + (if (zerop undel-count) + (vm-inform 5 "No messages undeleted") + (vm-inform 5 "%d message%s undeleted" + undel-count + (if (= 1 undel-count) + "" "s")))) + (vm-display nil nil '(vm-undelete-message) '(vm-undelete-message)) + (vm-update-summary-and-mode-line) + (if (and vm-move-after-undeleting (not used-marks)) + (let ((vm-circular-folders (and vm-circular-folders + (eq vm-move-after-undeleting t)))) + (vm-next-message count t executing-kbd-macro))))) + +;;;###autoload +(defun vm-toggle-flag-message (count &optional mlist) + "Toggle the `flagged' attribute to the current message, i.e., if it +has not been flagged then it will be flagged and, if it is already +flagged, then it will be unflagged. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are flagged/unflagged. A negative argument means +the current message and the previous |COUNT| - 1 messages are +flagged/unflagged. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are flagged/unflagged, other messages are +ignored. If applied to collapsed threads in summary and thread +operations are enabled via `vm-enable-thread-operations' then all +messages in the thread are flagged/unflagged." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (flagged-count 0) + (new-flagged nil)) + (unless mlist + (setq mlist (vm-select-operable-messages + count (vm-interactive-p) "Flag/unflag"))) + (when mlist + (setq new-flagged (not (vm-flagged-flag (car mlist))))) + (while mlist + (when (vm-set-flagged-flag (car mlist) new-flagged) + (vm-increment flagged-count) + ;; The following is a temporary fix. To be absorted into + ;; vm-update-summary-and-mode-line eventually. + (when (and vm-summary-enable-thread-folding + vm-summary-show-threads + ;; (not (and vm-enable-thread-operations + ;; (eq count 1))) + (> (vm-thread-count (car mlist)) 1)) + (with-current-buffer vm-summary-buffer + (vm-expand-thread (vm-thread-root (car mlist)))))) + (setq mlist (cdr mlist))) + (vm-display nil nil '(vm-toggle-flag-message) + (list this-command)) + (if (and used-marks (vm-interactive-p)) + (if (zerop flagged-count) + (vm-inform 5 "No messages flagged/unflagged") + (vm-inform 5 "%d message%s %sflagged" + flagged-count + (if (= 1 flagged-count) "" "s") + (if new-flagged "" "un")))) + (vm-update-summary-and-mode-line))) + + +;;;###autoload +(defun vm-kill-subject (&optional arg) +"Delete all messages with the same subject as the current message. +Message subjects are compared after ignoring parts matched by +the variables vm-subject-ignored-prefix and vm-subject-ignored-suffix. + +The optional prefix argument ARG specifies the direction to move +if vm-move-after-killing is non-nil. The default direction is +forward. A positive prefix argument means move forward, a +negative arugment means move backward, a zero argument means +don't move at all." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((subject (vm-so-sortable-subject (car vm-message-pointer))) + (mp vm-message-list) + (n 0) + (case-fold-search t)) + (while mp + (if (and (not (vm-deleted-flag (car mp))) + (string-equal subject (vm-so-sortable-subject (car mp)))) + (if (vm-set-deleted-flag (car mp) t) + (vm-increment n))) + (setq mp (cdr mp))) + (and (vm-interactive-p) + (if (zerop n) + (vm-inform 5 "No messages deleted.") + (vm-inform 5 "%d message%s deleted" n (if (= n 1) "" "s"))))) + (vm-display nil nil '(vm-kill-subject) '(vm-kill-subject)) + (vm-update-summary-and-mode-line) + (cond ((or (not (numberp arg)) (> arg 0)) + (setq arg 1)) + ((< arg 0) + (setq arg -1)) + (t (setq arg 0))) + (if vm-move-after-killing + (let ((vm-circular-folders (and vm-circular-folders + (eq vm-move-after-killing t)))) + (vm-next-message arg t executing-kbd-macro)))) + +;;;###autoload +(defun vm-kill-thread-subtree (&optional arg) + "Delete all messages in the thread tree rooted at the current message. + +The optional prefix argument ARG specifies the direction to move +if vm-move-after-killing is non-nil. The default direction is +forward. A positive prefix argument means move forward, a +negative arugment means move backward, a zero argument means +don't move at all." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (vm-build-threads-if-unbuilt) + (let ((list (vm-thread-subtree + (vm-thread-symbol (car vm-message-pointer)))) + (n 0)) + (while list + (unless (vm-deleted-flag (car list)) + (if (vm-set-deleted-flag (car list) t) + (vm-increment n))) + (setq list (cdr list))) + (when (vm-interactive-p) + (if (zerop n) + (vm-inform 5 "No messages deleted.") + (vm-inform 5 "%d message%s deleted" n (if (= n 1) "" "s"))))) + (vm-display nil nil '(vm-kill-thread-subtree) '(vm-kill-thread-subtree)) + (vm-update-summary-and-mode-line) + (cond ((or (not (numberp arg)) (> arg 0)) + (setq arg 1)) + ((< arg 0) + (setq arg -1)) + (t (setq arg 0))) + (if vm-move-after-killing + (let ((vm-circular-folders (and vm-circular-folders + (eq vm-move-after-killing t)))) + (vm-next-message arg t executing-kbd-macro)))) + +;;;###autoload +(defun vm-delete-duplicate-messages () +"Delete duplicate messages in the current folder. +This command works by comparing the message ID's. Messages that +already deleted are not considered, so VM will never delete the last +copy of a message in a folder. 'Deleting' means flagging for +deletion; you will have to expunge the messages with +`vm-expunge-folder' to really get rid of them, as usual. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only duplicate messages among the marked messages are deleted; +unmarked messages are not considerd for deletion." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (table (make-vector 103 0)) + (mp vm-message-list) + (n 0) + (case-fold-search t) + mid) + (if used-marks + (let ((vm-enable-thread-operations nil)) + (setq mp (vm-select-operable-messages 0)))) + (while mp + (cond ((vm-deleted-flag (car mp))) + (t + (setq mid (vm-su-message-id (car mp))) + (when mid + ;; (or mid (debug (car mp))) + (when (intern-soft mid table) + (if (vm-set-deleted-flag (car mp) t) + (setq n (1+ n)))) + (intern mid table)))) + (setq mp (cdr mp))) + (when (vm-interactive-p) + (if (zerop n) + (vm-inform 5 "No messages deleted") + (vm-inform 5 "%d message%s deleted" n (if (= 1 n) "" "s")))) + (vm-update-summary-and-mode-line) + n)) + +;;;###autoload +(defun vm-delete-duplicate-messages-by-body () +"Delete duplicate messages in the current folder. +This command works by computing an MD5 hash for the body of each +non-deleted message in the folder and deleting messages that have +a hash that has already been seen. Messages that are already deleted +are never hashed, so VM will never delete the last copy of a +message in a folder. 'Deleting' means flagging for deletion; you +will have to expunge the messages with `vm-expunge-folder' to +really get rid of them, as usual. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only duplicate messages among the marked messages are deleted, +unmarked messages are not hashed or considerd for deletion." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (mlist vm-message-list) + (table (make-vector 61 0)) + hash m + (del-count 0)) + (when used-marks + (let ((vm-enable-thread-operations nil)) + (setq mlist (vm-select-operable-messages 0)))) + (save-excursion + (save-restriction + (widen) + (while mlist + (if (vm-deleted-flag (car mlist)) + nil + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + (setq hash (vm-md5-region (vm-text-of m) (vm-text-end-of m))) + (if (intern-soft hash table) + (if (vm-set-deleted-flag (car mlist) t) + (vm-increment del-count)) + (intern hash table))) + (setq mlist (cdr mlist))))) + (vm-display nil nil '(vm-delete-duplicate-messages) + (list this-command)) + (when (vm-interactive-p) + (if (zerop del-count) + (vm-inform 5 "No messages deleted") + (vm-inform 5 "%d message%s deleted" + del-count (if (= 1 del-count) "" "s")))) + (vm-update-summary-and-mode-line) + del-count)) + +;;;###autoload +(defun* vm-expunge-folder (&key (quiet nil) + ((:just-these-messages message-list) + nil ; default value + just-these-messages)) + "Expunge messages with the `deleted' attribute. +For normal folders this means that the deleted messages are +removed from the message list and the message contents are +removed from the folder buffer. + +For virtual folders, messages are removed from the virtual +message list. If virtual mirroring is in effect for the virtual +folder, the corresponding real messages are also removed from real +message lists and the message contents are removed from real folders. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only messages both marked and deleted are expunged, other messages are +ignored." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-folder-read-only) + ;; do this so we have a clean slate. code below depends on the + ;; fact that the numbering redo start point begins as nil in + ;; all folder buffers. + (vm-update-summary-and-mode-line) + (unless quiet + (vm-inform 5 "Expunging...")) + (let ((use-marks (and (eq last-command 'vm-next-command-uses-marks) + (null just-these-messages))) + (mp vm-message-list) + (virtual (eq major-mode 'vm-virtual-mode)) + (buffers-altered (make-vector 29 0)) + prev virtual-messages) + (while mp + (cond + ((if just-these-messages + (memq (car mp) message-list) + (and (vm-deleted-flag (car mp)) + (or (not use-marks) + (vm-mark-of (car mp))))) + ;; remove the message from the thread tree. + (if (vectorp vm-thread-obarray) + (vm-unthread-message-and-mirrors + (vm-real-message-of (car mp)) :message-changing nil)) + ;; expunge from the virtual side first, removing all + ;; references to this message before actually removing + ;; the message itself. + (cond + ((setq virtual-messages (vm-virtual-messages-of (car mp))) + (let (vms prev curr) + (if virtual + (setq vms (cons (vm-real-message-of (car mp)) + (vm-virtual-messages-of (car mp)))) + (setq vms (vm-virtual-messages-of (car mp)))) + (while vms + (save-excursion + (set-buffer (vm-buffer-of (car vms))) + (vm-unregister-fetched-message (car vms)) + (setq prev (vm-reverse-link-of (car vms)) + curr (or (cdr prev) vm-message-list)) + (intern (buffer-name) buffers-altered) + (vm-set-numbering-redo-start-point (or prev t)) + (vm-set-summary-redo-start-point (or prev t)) + (if (eq vm-message-pointer curr) + (setq vm-system-state nil + vm-message-pointer (or prev (cdr curr)))) + (if (eq vm-last-message-pointer curr) + (setq vm-last-message-pointer nil)) + ;; lock out interrupts to preserve message-list integrity + (let ((inhibit-quit t)) + ;; vm-clear-expunge-invalidated-undos uses + ;; this to recognize expunged messages. + ;; If this stuff is mirrored we'll be + ;; setting this value multiple times if there + ;; are multiple virtual messages referencing + ;; the underlying real message. Harmless. + (vm-set-deleted-flag-of (car curr) 'expunged) + ;; disable any summary update that may have + ;; already been scheduled. + (vm-set-su-start-of (car curr) nil) + (vm-increment vm-modification-counter) + (if (null prev) + (progn + (setq vm-message-list (cdr vm-message-list)) + (and (cdr curr) + (vm-set-reverse-link-of (car (cdr curr)) nil))) + (setcdr prev (cdr curr)) + (and (cdr curr) + (vm-set-reverse-link-of (car (cdr curr)) prev))) + (vm-set-virtual-messages-of (car mp) (cdr vms)) + (vm-mark-folder-modified-p (vm-buffer-of (car vms))))) + (setq vms (cdr vms)))))) + (cond + ((or (not virtual-messages) + (not virtual)) + (when (and (not virtual-messages) virtual) + (vm-set-virtual-messages-of + (vm-real-message-of (car mp)) + (delq (car mp) (vm-virtual-messages-of + (vm-real-message-of (car mp)))))) + (if (eq vm-message-pointer mp) + (setq vm-system-state nil + vm-message-pointer (or prev (cdr mp)))) + (if (eq vm-last-message-pointer mp) + (setq vm-last-message-pointer nil)) + (intern (buffer-name) buffers-altered) + (if (null vm-numbering-redo-start-point) + (progn + (vm-set-numbering-redo-start-point (or prev t)) + (vm-set-summary-redo-start-point (or prev t)))) + ;; lock out interrupt to preserve message list integrity + (let ((inhibit-quit t)) + (if (null prev) + (progn (setq vm-message-list (cdr vm-message-list)) + (and (cdr mp) + (vm-set-reverse-link-of (car (cdr mp)) nil))) + (setcdr prev (cdr mp)) + (and (cdr mp) (vm-set-reverse-link-of (car (cdr mp)) prev))) + ;; vm-clear-expunge-invalidated-undos uses this to recognize + ;; expunged messages. + (vm-set-deleted-flag-of (car mp) 'expunged) + ;; disable any summary update that may have + ;; already been scheduled. + (vm-set-su-start-of (car mp) nil) + (vm-mark-folder-modified-p (current-buffer)) + (vm-increment vm-modification-counter)))) + (if (eq (vm-attributes-of (car mp)) + (vm-attributes-of (vm-real-message-of (car mp)))) + (let ((real-m (vm-real-message-of (car mp)))) + (save-excursion + (set-buffer (vm-buffer-of real-m)) + (cond ((eq vm-folder-access-method 'pop) + (setq vm-pop-messages-to-expunge + (cons (vm-pop-uidl-of real-m) + vm-pop-messages-to-expunge) + ;; Set this so that if Emacs crashes or + ;; the user quits without saving, we + ;; have a record of messages that were + ;; retrieved and expunged locally. + ;; When the user does M-x recover-file + ;; we won't re-retrieve messages the + ;; user has already dealt with. + vm-pop-retrieved-messages + (cons (list (vm-pop-uidl-of real-m) + (vm-folder-pop-maildrop-spec) + 'uidl) + vm-pop-retrieved-messages))) + ((eq vm-folder-access-method 'imap) + (setq vm-imap-messages-to-expunge + (cons (cons + (vm-imap-uid-of real-m) + (vm-imap-uid-validity-of real-m)) + vm-imap-messages-to-expunge)) + ;; Set this so that if Emacs crashes or + ;; the user quits without saving, we + ;; have a record of messages that were + ;; retrieved and expunged locally. + ;; When the user does M-x recover-file + ;; we won't re-retrieve messages the + ;; user has already dealt with. + (when (and (vm-imap-uid-of real-m) + (vm-imap-uid-validity-of real-m)) + (setq vm-imap-retrieved-messages + (cons (list (vm-imap-uid-of real-m) + (vm-imap-uid-validity-of real-m) + (vm-folder-imap-maildrop-spec) + 'uid) + vm-imap-retrieved-messages))))) + (vm-increment vm-modification-counter) + (vm-save-restriction + (widen) + (let ((buffer-read-only nil)) + (delete-region (vm-start-of real-m) + (vm-end-of real-m)))))))) + (t (setq prev mp))) + (setq mp (cdr mp))) + (vm-display nil nil '(vm-expunge-folder) '(vm-expunge-folder)) + (cond + (buffers-altered + (save-excursion + (mapatoms + (function + (lambda (buffer) + (set-buffer (symbol-name buffer)) + ;; FIXME The update summary here is a heavy duty + ;; operation. Can we be more clever about it, for + ;; instance avoid doing it before quitting a folder? + (if (null vm-system-state) + (progn + (vm-garbage-collect-message) + (if (null vm-message-pointer) + ;; folder is now empty + (progn (setq vm-folder-type nil) + (vm-update-summary-and-mode-line)) + (vm-present-current-message))) + (vm-update-summary-and-mode-line)) + (if (not (eq major-mode 'vm-virtual-mode)) + (setq vm-message-order-changed + (or vm-message-order-changed + vm-message-order-header-present))) + (vm-clear-expunge-invalidated-undos))) + buffers-altered)) + (if vm-ml-sort-keys + (vm-sort-messages vm-ml-sort-keys)) + (unless quiet + (vm-inform 5 "Deleted messages expunged."))) + (t (vm-inform 5 "No messages are flagged for deletion.")))) + (when vm-debug + (vm-check-thread-integrity))) + +;;; vm-delete.el ends here diff --git a/lisp/vm-digest.el b/lisp/vm-digest.el new file mode 100755 index 0000000..2b72bd4 --- /dev/null +++ b/lisp/vm-digest.el @@ -0,0 +1,847 @@ +;;; vm-digest.el --- Message encapsulation +;; +;; This file is part of VM +;; +;; Copyright (C) 1989, 1990, 1993, 1994, 1997, 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-digest) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-mime) + (require 'vm-undo) + (require 'vm-delete) +) + +(declare-function vm-mode "vm-mode" (&optional read-only)) +(declare-function vm-yank-message "vm-reply" (message)) + +;;;###autoload +(defun vm-no-frills-encapsulate-message (m keep-list discard-regexp) + "Encapsulate a message M for forwarding, simply. +No message encapsulation standard is used. The message is +inserted at point in the current buffer, surrounded by two dashed +start/end separator lines. Point is not moved. + +M should be a message struct for a real message, not a virtual message. +This is the message that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used." + (let ((target-buffer (current-buffer)) + source-buffer) + (save-restriction + ;; narrow to a zero length region to avoid interacting + ;; with anything that might have already been inserted + ;; into the buffer. + (narrow-to-region (point) (point)) + (insert "------- start of forwarded message -------\n") + (setq source-buffer (vm-buffer-of m)) + (save-excursion + (set-buffer source-buffer) + (save-restriction + (widen) + (save-excursion + (set-buffer target-buffer) + (let ((beg (point))) + ;; (insert-buffer-substring + ;; source-buffer (vm-headers-of m) (vm-text-end-of m)) + (let ((vm-include-mime-attachments t) ; override the defaults + (vm-include-text-basic nil) + (vm-include-text-from-presentation nil) + (mail-citation-hook (list 'vm-cite-forwarded-message))) + (vm-yank-message m)) + (goto-char beg) + ;; (vm-reorder-message-headers + ;; nil :keep-list nil + ;; :discard-regexp vm-internal-unforwarded-header-regexp) + ;; (vm-reorder-message-headers + ;; nil :keep-list keep-list :discard-regexp discard-regexp) + (vm-decode-mime-message-headers) + )))) + (goto-char (point-max)) + (insert "------- end of forwarded message -------\n")))) + +(defun vm-cite-forwarded-message () + "The message citation handler for a forwarded message." + (save-excursion + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp vm-internal-unforwarded-header-regexp) + (vm-reorder-message-headers + nil :keep-list vm-forwarded-headers + :discard-regexp vm-unforwarded-header-regexp) + )) + +;;;###autoload +(defun* vm-mime-encapsulate-messages (message-list &key + (keep-list nil) + (discard-regexp "none") + (always-use-digest nil)) + "Encapsulate the messages in MESSAGE-LIST as per the MIME spec. +The resulting digest is inserted at point in the current buffer. +Point is not moved. + +MESSAGE-LIST should be a list of message structs (real or virtual). +These are the messages that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used. + +If ALWAYS-USE-DIGEST is non-nil, always encapsulate for a multipart/digest. +Otherwise if there is only one message to be encapsulated +leave off the multipart boundary strings. The caller is assumed to +be using message/rfc822 or message/news encoding instead. + +If multipart/digest encapsulation is done, the function returns +the multipart boundary parameter (string) that should be used in +the Content-Type header. Otherwise nil is returned." + (if message-list + (let ((target-buffer (current-buffer)) + (boundary-positions nil) + (mlist message-list) + (boundary nil) + source-buffer m start n beg) + (save-restriction + ;; narrow to a zero length region to avoid interacting + ;; with anything that might have already been inserted + ;; into the buffer. + (narrow-to-region (point) (point)) + (setq start (point)) + (while mlist + (setq boundary-positions (cons (point-marker) boundary-positions)) + (setq m (vm-real-message-of (car mlist)) + source-buffer (vm-buffer-of m)) + (setq beg (point)) + (vm-insert-region-from-buffer source-buffer (vm-headers-of m) + (vm-text-end-of m)) + (goto-char beg) + ;; remove the Berkeley and VM status headers and sort + ;; the MIME headers to the top of the message. + (vm-reorder-message-headers + nil :keep-list vm-mime-header-list + :discard-regexp vm-internal-unforwarded-header-regexp) + ;; skip past the MIME headers so that when the + ;; user's header filters are applied they won't + ;; remove the MIME headers. + (while (and (vm-match-header) (looking-at vm-mime-header-regexp)) + (goto-char (vm-matched-header-end))) + ;; apply the user's header filters. + (vm-reorder-message-headers + nil :keep-list keep-list :discard-regexp discard-regexp) + (goto-char (point-max)) + (setq mlist (cdr mlist))) + (if (and (< (length message-list) 2) (not always-use-digest)) + nil + (goto-char start) + (setq boundary (vm-mime-make-multipart-boundary)) + (while (re-search-forward (concat "^--" + (regexp-quote boundary) + "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (goto-char start)) + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n") + (insert "Content-Type: message/rfc822\n\n") + (setq boundary-positions (cdr boundary-positions))) + (goto-char start) + (setq n (length message-list)) + (insert + (format "This is a digest, %d message%s, MIME encapsulation.\n" + n (if (= n 1) "" "s")))) + (goto-char start)) + boundary ))) + +(defun vm-mime-burst-message (m) + "Burst messages from the digest message M. +M should be a message struct for a real message. +MIME encoding is expected. Somewhere within the MIME layout +there must be at least one part of type message/news, message/rfc822 or +multipart/digest. If there are multiple parts matching those types, +all of them will be burst." + (let ((ident-header nil) + (did-burst nil) + (list (vm-mime-find-digests-in-layout (vm-mm-layout m)))) + (if vm-digest-identifier-header-format + (setq ident-header (vm-summary-sprintf + vm-digest-identifier-header-format m))) + (while list + (setq did-burst (or (vm-mime-burst-layout (car list) ident-header) + did-burst)) + (setq list (cdr list))) + did-burst)) + +;;;###autoload +(defun vm-mime-burst-layout (layout ident-header) + (let ((work-buffer nil) + (folder-buffer (current-buffer)) + start part-list + (folder-type vm-folder-type)) + (unwind-protect + (vm-save-restriction + (save-excursion + (widen) + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (cond ((not (vectorp layout)) + (error "Not a MIME message")) + ((vm-mime-types-match "message" + (car (vm-mm-layout-type layout))) + (insert (vm-leading-message-separator folder-type)) + (and ident-header (insert ident-header)) + (setq start (point)) + (vm-mime-insert-mime-body layout) + (vm-munge-message-separators folder-type start (point)) + ;; remove any leading newlines as they will + ;; make vm-reorder-message-headers think the + ;; header section has ended. + (save-excursion + (goto-char start) + (while (= (following-char) ?\n) + (delete-char 1))) + (insert ?\n) + (insert (vm-trailing-message-separator folder-type))) + ((vm-mime-types-match "multipart/digest" + (car (vm-mm-layout-type layout))) + (setq part-list (vm-mm-layout-parts layout)) + (while part-list + ;; Maybe we should verify that each part is + ;; of type message/rfc822 or message/news in + ;; here. But it seems more useful to just + ;; copy whatever the contents are and let the + ;; user see the goop, whatever type it really + ;; is. + (insert (vm-leading-message-separator folder-type)) + (and ident-header (insert ident-header)) + (setq start (point)) + (vm-mime-insert-mime-body (car part-list)) + (vm-munge-message-separators folder-type start (point)) + ;; remove any leading newlines as they will + ;; make vm-reorder-message-headers think the + ;; header section has ended. + (save-excursion + (goto-char start) + (while (= (following-char) ?\n) + (delete-char 1))) + (insert ?\n) + (insert (vm-trailing-message-separator folder-type)) + (setq part-list (cdr part-list)))) + (t (error + "MIME type is not multipart/digest or message/rfc822 or message/news"))) + ;; do header conversions. + (let ((vm-folder-type folder-type)) + (goto-char (point-min)) + (while (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (vm-convert-folder-type-headers folder-type folder-type) + (vm-find-trailing-message-separator) + (vm-skip-past-trailing-message-separator))) + ;; now insert the messages into the folder buffer + (cond ((not (zerop (buffer-size))) + (set-buffer folder-buffer) + (let ((old-buffer-modified-p (buffer-modified-p)) + (buffer-read-only nil) + (inhibit-quit t)) + (goto-char (point-max)) + (insert-buffer-substring work-buffer) + (vm-restore-buffer-modified-p + old-buffer-modified-p folder-buffer) + ;; return non-nil so caller knows we found some messages + t )) + ;; return nil so the caller knows we didn't find anything + (t nil)))) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-rfc934-char-stuff-region (start end) + "Quote RFC 934 message separators between START and END. +START and END are buffer positions in the current buffer. +Lines beginning with `-' in the region have `- ' prepended to them." + (setq end (vm-marker end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) (re-search-forward "^-" end t)) + (replace-match "- -" t t))) + (set-marker end nil)) + +(defun vm-rfc934-char-unstuff-region (start end) + "Unquote lines in between START and END as per RFC 934. +START and END are buffer positions in the current buffer. +Lines beginning with `- ' in the region have that string stripped +from them." + (setq end (vm-marker end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) (re-search-forward "^- " end t)) + (replace-match "" t t) + (forward-char))) + (set-marker end nil)) + +;;;###autoload +(defun vm-rfc934-encapsulate-messages (message-list keep-list discard-regexp) + "Encapsulate the messages in MESSAGE-LIST as per RFC 934. +The resulting digest is inserted at point in the current buffer. +Point is not moved. + +MESSAGE-LIST should be a list of message structs (real or virtual). +These are the messages that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used." + (if message-list + (let ((target-buffer (current-buffer)) + (mlist message-list) + source-buffer m start n) + (save-restriction + ;; narrow to a zero length region to avoid interacting + ;; with anything that might have already been inserted + ;; into the buffer. + (narrow-to-region (point) (point)) + (setq start (point)) + (while mlist + (insert "---------------\n") + (setq m (vm-real-message-of (car mlist)) + source-buffer (vm-buffer-of m)) + (save-excursion + (set-buffer source-buffer) + (save-restriction + (widen) + (save-excursion + (set-buffer target-buffer) + (let ((beg (point))) + (insert-buffer-substring source-buffer (vm-headers-of m) + (vm-text-end-of m)) + (goto-char beg) + ;; remove the Berkeley and VM status headers and sort + ;; the MIME headers to the top of the message. + (vm-reorder-message-headers + nil :keep-list vm-mime-header-list + :discard-regexp vm-internal-unforwarded-header-regexp) + ;; skip past the MIME headers so that when the + ;; user's header filters are applied they won't + ;; remove the MIME headers. + (while (and (vm-match-header) + (looking-at vm-mime-header-regexp)) + (goto-char (vm-matched-header-end))) + ;; apply the user's header filters. + (vm-reorder-message-headers + nil :keep-list keep-list :discard-regexp discard-regexp) + (vm-rfc934-char-stuff-region beg (point-max)))))) + (goto-char (point-max)) + (insert "---------------") + (setq mlist (cdr mlist))) + (delete-region (point) (progn (beginning-of-line) (point))) + (insert "------- end -------\n") + (goto-char start) + (delete-region (point) (progn (forward-line 1) (point))) + (setq n (length message-list)) + (insert (format "------- start of %s%s(RFC 934 encapsulation) -------\n" + (if (cdr message-list) + "digest " + "forwarded message ") + (if (cdr message-list) + (format "(%d messages) " n) + ""))) + (goto-char start))))) + +(defun vm-rfc1153-char-stuff-region (start end) + "Quote RFC 1153 message separators between START and END. +START and END are buffer positions in the current buffer. +Lines consisting only of 30 hyphens have the first hyphen +converted to a space." + (setq end (vm-marker end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward "^------------------------------$" end t)) + (replace-match " -----------------------------" t t))) + (set-marker end nil)) + +(defun vm-rfc1153-char-unstuff-region (start end) + "Unquote lines in between START and END as per RFC 1153. +START and END are buffer positions in the current buffer. +Lines consisting only of a space following by 29 hyphens have the space +converted to a hyphen." + (setq end (vm-marker end)) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward "^ -----------------------------$" end t)) + (replace-match "------------------------------" t t))) + (set-marker end nil)) + +;;;###autoload +(defun vm-rfc1153-encapsulate-messages (message-list keep-list discard-regexp) + "Encapsulate the messages in MESSAGE-LIST as per RFC 1153. +The resulting digest is inserted at point in the current buffer. +Point is not moved. + +MESSAGE-LIST should be a list of message structs (real or virtual). +These are the messages that will be encapsulated. +KEEP-LIST should be a list of regexps matching headers to keep. +DISCARD-REGEXP should be a regexp that matches headers to be discarded. +KEEP-LIST and DISCARD-REGEXP are used to order and trim the headers +to be forwarded. See the docs for vm-reorder-message-headers +to find out how KEEP-LIST and DISCARD-REGEXP are used." + (if message-list + (let ((target-buffer (current-buffer)) + (mlist message-list) + source-buffer m start) + (save-restriction + ;; narrow to a zero length region to avoid interacting + ;; with anything that might have already been inserted + ;; into the buffer. + (narrow-to-region (point) (point)) + (setq start (point)) + (while mlist + (insert "---------------\n\n") + (setq m (vm-real-message-of (car mlist)) + source-buffer (vm-buffer-of m)) + (save-excursion + (set-buffer source-buffer) + (save-restriction + (widen) + (save-excursion + (set-buffer target-buffer) + (let ((beg (point))) + (insert-buffer-substring source-buffer (vm-headers-of m) + (vm-text-end-of m)) + (goto-char beg) + ;; remove the Berkeley and VM status headers and sort + ;; the MIME headers to the top of the message. + (vm-reorder-message-headers + nil :keep-list vm-mime-header-list + :discard-regexp vm-internal-unforwarded-header-regexp) + ;; skip past the MIME headers so that when the + ;; user's header filters are applied they won't + ;; remove the MIME headers. + (while (and (vm-match-header) + (looking-at vm-mime-header-regexp)) + (goto-char (vm-matched-header-end))) + ;; apply the user's header filters. + (vm-reorder-message-headers + nil :keep-list keep-list :discard-regexp discard-regexp) + (vm-rfc1153-char-stuff-region beg (point-max)))))) + (goto-char (point-max)) + (insert "\n---------------") + (setq mlist (cdr mlist))) + (insert "---------------\n\nEnd of this Digest\n******************\n") + (goto-char start) + (delete-region (point) (progn (forward-line 1) (point))) + (insert (format "This is an RFC 1153 digest.\n(%d message%s)\n----------------------------------------------------------------------\n" (length message-list) (if (cdr message-list) "s" ""))) + (goto-char start))))) + +(defun vm-rfc1153-or-rfc934-burst-message (m rfc1153) + "Burst messages from the digest message M. +M should be a message struct for a real message. +If RFC1153 is non-nil, assume the digest is of the form specified by +RFC 1153. Otherwise assume RFC 934 digests." + (let ((work-buffer nil) + (match t) + (prev-sep nil) + (ident-header nil) + after-prev-sep prologue-separator-regexp separator-regexp + temp-marker + (folder-buffer (current-buffer)) + (folder-type vm-folder-type)) + (if vm-digest-identifier-header-format + (setq ident-header (vm-summary-sprintf + vm-digest-identifier-header-format m))) + (if rfc1153 + (setq prologue-separator-regexp "^----------------------------------------------------------------------\n" + separator-regexp "^------------------------------\n") + (setq prologue-separator-regexp "\\(^-[^ ].*\n+\\)+" + separator-regexp "\\(^-[^ ].*\n+\\)+")) + (vm-save-restriction + (save-excursion + (widen) + (unwind-protect + (catch 'done + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (setq temp-marker (vm-marker (point))) + (vm-insert-region-from-buffer (vm-buffer-of m) + (vm-text-of m) + (vm-text-end-of m)) + (goto-char (point-min)) + (if (not (re-search-forward prologue-separator-regexp nil t)) + (throw 'done nil)) + ;; think of this as a do-while loop. + (while match + (cond ((null prev-sep) + ;; from (point-min) to end of match + ;; is the digest prologue, devour it and + ;; carry on. + (delete-region (point-min) (match-end 0))) + (t + ;; save value as mark so that it will move + ;; with the text. + (set-marker temp-marker (match-beginning 0)) + (let ((md (match-data))) + (unwind-protect + (progn + ;; Undo the quoting of the embedded message + ;; separators. + (if rfc1153 + (vm-rfc1153-char-unstuff-region + after-prev-sep + temp-marker) + (vm-rfc934-char-unstuff-region after-prev-sep + temp-marker)) + ;; munge previous messages' message separators + (vm-munge-message-separators + folder-type + after-prev-sep + temp-marker)) + (store-match-data md))))) + ;; there should be at least one valid header at + ;; the beginning of an encapsulated message. If + ;; there isn't a valid header, then assume that + ;; the digest was packed improperly and that this + ;; isn't a real boundary. + (if (not + (save-excursion + (save-match-data + ;; People who roll digests often think + ;; any old format will do. Adding blank + ;; lines after the message separator is + ;; common. Spaces in such lines are an + ;; added delight. + (skip-chars-forward " \n") + (or (and (vm-match-header) + (vm-digest-get-header-contents "From")) + (not (re-search-forward separator-regexp + nil t)))))) + (setq prev-sep (point) + after-prev-sep (point)) + ;; if this isn't the first message, delete the + ;; digest separator goop and insert a trailing message + ;; separator of the proper type. + (if prev-sep + (progn + ;; eat preceding newlines + (while (= (preceding-char) ?\n) + (delete-char -1)) + ;; put one back + (insert ?\n) + ;; delete the digest separator + (delete-region (match-beginning 0) (point)) + ;; insert a trailing message separator + (insert (vm-trailing-message-separator folder-type)))) + (setq prev-sep (point)) + ;; insert the leading separator + (insert (vm-leading-message-separator folder-type)) + (setq after-prev-sep (point)) + ;; eat trailing newlines + (while (= (following-char) ?\n) + (delete-char 1)) + (insert ident-header)) + ;; try to match message separator and repeat. + (setq match (re-search-forward separator-regexp nil t))) + ;; from the last separator to eof is the digest epilogue. + ;; discard it. + (delete-region (or prev-sep (point-min)) (point-max)) + ;; do header conversions. + (let ((vm-folder-type folder-type)) + (goto-char (point-min)) + (while (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (vm-convert-folder-type-headers folder-type folder-type) + (vm-find-trailing-message-separator) + (vm-skip-past-trailing-message-separator))) + ;; now insert the messages into the folder buffer + (cond ((not (zerop (buffer-size))) + (set-buffer folder-buffer) + (let ((old-buffer-modified-p (buffer-modified-p)) + (buffer-read-only nil) + (inhibit-quit t)) + (goto-char (point-max)) + (insert-buffer-substring work-buffer) + (vm-restore-buffer-modified-p + old-buffer-modified-p folder-buffer) + ;; return non-nil so caller knows we found some messages + t )) + ;; return nil so the caller knows we didn't find anything + (t nil))) + (when work-buffer (kill-buffer work-buffer))))))) + +(defun vm-rfc934-burst-message (m) + "Burst messages from the RFC 934 digest message M. +M should be a message struct for a real message." + (vm-rfc1153-or-rfc934-burst-message m nil)) + +(defun vm-rfc1153-burst-message (m) + "Burst messages from the RFC 1153 digest message M. +M should be a message struct for a real message." + (vm-rfc1153-or-rfc934-burst-message m t)) + +;;;###autoload +(defun vm-burst-digest (&optional digest-type) + "Burst the current message (a digest) into its individual messages. +The digest's messages are assimilated into the folder as new mail +would be. + +Optional argument DIGEST-TYPE is a string that tells VM what kind +of digest the current message is. If it is not given the value +defaults to the value of vm-digest-burst-type. When called +interactively DIGEST-TYPE will be read from the minibuffer. + +If invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages will be burst. If applied to collapsed +threads in summary and thread operations are enabled via +`vm-enable-thread-operations' then all messages in the thread are +burst." + (interactive + (list + (let ((type nil) + (this-command this-command) + (last-command last-command)) + (setq type (completing-read (format "Digest type: (default %s) " + vm-digest-burst-type) + (append vm-digest-type-alist + (list '("guess"))) + 'identity nil)) + (if (string= type "") + vm-digest-burst-type + type )))) + (or digest-type (setq digest-type vm-digest-burst-type)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((start-buffer (current-buffer)) m totals-blurb + (mlist (vm-select-operable-messages + 1 (vm-interactive-p) "Burst digest of"))) + (vm-retrieve-operable-messages 1 mlist) + (while mlist + (if (vm-virtual-message-p (car mlist)) + (progn + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m))) + (setq m (car mlist))) + (vm-error-if-folder-read-only) + (if (equal digest-type "guess") + (progn + (setq digest-type (vm-guess-digest-type m)) + (if (null digest-type) + (error "Couldn't guess digest type.")))) + (vm-inform 5 "Bursting %s digest..." digest-type) + (cond + ((cond ((equal digest-type "mime") + (vm-mime-burst-message m)) + ((equal digest-type "rfc934") + (vm-rfc934-burst-message m)) + ((equal digest-type "rfc1153") + (vm-rfc1153-burst-message m)) + (t (error "Unknown digest type: %s" digest-type))) + (vm-inform 5 "Bursting %s digest... done" digest-type) + (vm-clear-modification-flag-undos) + (vm-mark-folder-modified-p (current-buffer)) + (vm-increment vm-modification-counter) + (when vm-delete-after-bursting + ;; if start folder was virtual, we're now in the wrong + ;; buffer. switch back. + (save-excursion + (set-buffer start-buffer) + ;; don't move message pointer when deleting the message + (let ((vm-move-after-deleting nil)) + (vm-delete-message 1)))) + (vm-assimilate-new-messages :read-attributes nil + :labels (vm-labels-of (car mlist))) + ;; do this now so if we error later in another iteration + ;; of the loop the summary and mode line will be correct. + (vm-update-summary-and-mode-line))) + (setq mlist (cdr mlist))) + ;; collect this data NOW, before the non-previewers read a + ;; message, alter the new message count and confuse + ;; themselves. + (setq totals-blurb (vm-emit-totals-blurb)) + (vm-display nil nil '(vm-burst-digest + vm-burst-mime-digest + vm-burst-rfc934-digest + vm-burst-rfc1153-digest) + (list this-command)) + (if (vm-thoughtfully-select-message) + (vm-present-current-message) + (vm-update-summary-and-mode-line)) + (vm-inform 5 totals-blurb))) + +;;;###autoload +(defun vm-burst-rfc934-digest () + "Burst an RFC 934 style digest" + (interactive) + (vm-burst-digest "rfc934")) + +;;;###autoload +(defun vm-burst-rfc1153-digest () + "Burst an RFC 1153 style digest" + (interactive) + (vm-burst-digest "rfc1153")) + +;;;###autoload +(defun vm-burst-mime-digest () + "Burst a MIME digest" + (interactive) + (vm-burst-digest "mime")) + +;;;###autoload +(defun vm-burst-digest-to-temp-folder (&optional digest-type) + "Burst the current message (a digest) into a temporary folder. +The digest's messages are copied to a buffer and vm-mode is +invoked on the buffer. There is no file associated with this +buffer. You can use `vm-write-file' to save the buffer, or +`vm-save-message' to save individual messages to a real folder. + +Optional argument DIGEST-TYPE is a string that tells VM what kind +of digest the current message is. If it is not given the value +defaults to the value of vm-digest-burst-type. When called +interactively DIGEST-TYPE will be read from the minibuffer. + +If invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages will be burst. If applied to collapsed +threads in summary and thread operations are enabled via +`vm-enable-thread-operations' then all messages in the thread are +burst." + (interactive + (list + (let ((type nil) + (this-command this-command) + (last-command last-command)) + (setq type (completing-read (format "Digest type: (default %s) " + vm-digest-burst-type) + (append vm-digest-type-alist + (list '("guess"))) + 'identity nil)) + (if (string= type "") + vm-digest-burst-type + type )))) + (or digest-type (setq digest-type vm-digest-burst-type)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((start-buffer (current-buffer)) m totals-blurb + (mlist (vm-select-operable-messages + 1 (vm-interactive-p) "Burst digest of")) + (work-buffer nil)) + (vm-retrieve-operable-messages 1 mlist) + (unwind-protect + (save-excursion ; to go to work-buffer + (setq work-buffer (generate-new-buffer + (format "digest from %s/%s%s" + (current-buffer) + (vm-number-of (car vm-message-pointer)) + (if (cdr mlist) " ..." "")))) + (buffer-disable-undo work-buffer) + (set-buffer work-buffer) + (setq vm-folder-type vm-default-folder-type) + (while mlist + (if (vm-virtual-message-p (car mlist)) + (setq m (vm-real-message-of (car mlist))) + (setq m (car mlist))) + (if (equal digest-type "guess") + (progn + (setq digest-type (vm-guess-digest-type m)) + (if (null digest-type) + (error "Couldn't guess digest type.")))) + (vm-inform 5 "Bursting %s digest to folder..." digest-type) + (cond ((equal digest-type "mime") + (vm-mime-burst-message m)) + ((equal digest-type "rfc934") + (vm-rfc934-burst-message m)) + ((equal digest-type "rfc1153") + (vm-rfc1153-burst-message m)) + (t (error "Unknown digest type: %s" digest-type))) + (vm-inform 5 "Bursting %s digest... done" digest-type) + (and vm-delete-after-bursting + (yes-or-no-p (format "Delete message %s? " (vm-number-of m))) + (save-excursion + (set-buffer start-buffer) + ;; don't move message pointer when deleting the message + (let ((vm-move-after-deleting nil)) + (vm-delete-message 1)))) + (setq mlist (cdr mlist))) + (set-buffer-modified-p nil) ; work-buffer + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode) + (if (vm-should-generate-summary) + (progn + (vm-goto-new-folder-frame-maybe 'summary) + (vm-summarize)))) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup)) + (setq work-buffer nil)) + (when work-buffer (kill-buffer work-buffer))))) + +(defun vm-guess-digest-type (m) + "Guess the digest type of the message M. +M should be the message struct of a real message. +Returns either \"rfc934\", \"rfc1153\" or \"mime\"." + (catch 'return-value + (save-excursion + (set-buffer (vm-buffer-of m)) + (let ((layout (vm-mm-layout m))) + (if (and (vectorp layout) + (or (vm-mime-layout-contains-type + layout + "multipart/digest") + (vm-mime-layout-contains-type + layout + "message/rfc822") + (vm-mime-layout-contains-type + layout + "message/news"))) + (throw 'return-value "mime")))) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-text-of m)) + (cond ((and (search-forward "\n----------------------------------------------------------------------\n" (vm-text-end-of m) t) + (search-forward "\n------------------------------\n" (vm-text-end-of m) t)) + "rfc1153") + (t "rfc934")))))) + +(defun vm-digest-get-header-contents (header-name-regexp) + (let ((contents nil) + regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^$\\)")) + (save-excursion + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (vm-matched-header-contents) + nil ))))) + +;;; vm-digest.el ends here diff --git a/lisp/vm-dired.el b/lisp/vm-dired.el new file mode 100755 index 0000000..969df88 --- /dev/null +++ b/lisp/vm-dired.el @@ -0,0 +1,127 @@ +;;; vm-reply.el --- Mailing, forwarding, and replying commands +;; +;; This file is part of VM +;; +;; Copyright (C) 2011 Uday S. Reddy +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: +;; This file provides functions that can be used in a Dired buffer to +;; send files to VM. +;;; Interface: +;; Interactive commands: +;; +;; vm-dired-attach-file: (buffer) -> unit +;; vm-dired-do-attach-files: (buffer) -> unit +;; +;;; Code: + +(provide 'vm-dired) + +(require 'dired) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-mime) + (require 'vm-digest) + (require 'vm-undo) + ) + +(eval-and-compile + (require 'dired)) + +(declare-function vm-dired-file-name-at-point "vm-dired.el" ()) + +(cond ((fboundp 'dired-file-name-at-point) ; Emacs 23 dired + (fset 'vm-dired-file-name-at-point 'dired-file-name-at-point)) + ((fboundp 'dired-filename-at-point) ; Emacs 22 dired-x + (fset 'vm-dired-file-name-at-point 'dired-filename-at-point)) + (t + (error "vm-dired not supported in Emacs version %s" emacs-version))) + +;;;###autoload +(defun vm-dired-attach-file (composition) + "Attach the file at point in the dired buffer to a VM composition +buffer as a mime attachment. + +The file is not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. A visible tag +indicating the existence of the object is placed in the +composition buffer. You can move the object around or remove +it entirely with normal text editing commands. If you remove the +object tag, the object will not be sent. + +First argument COMPOSITION is the buffer into which the object +will be inserted. When this function is called interactively +COMPOSITION's name will be read from the minibuffer." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command)) + (list (read-buffer "Attach file to buffer: " + (vm-find-composition-buffer) t)))) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (let ((file (vm-dired-file-name-at-point)) + type) + (when (and file (file-regular-p file)) + (setq type (or (vm-mime-default-type-from-filename file) + "application/octet-stream")) + (with-current-buffer composition + (vm-attach-file file type))))) + +;;;###autoload +(defun vm-dired-do-attach-files (composition) + "Attach all marked files in the dired buffer to a VM composition +buffer as mime attachments. + +The files are not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. For each +file, a visible tag indicating the existence of the object is +placed in the composition buffer. You can move the objects around +or remove them entirely with normal text editing commands. If you +remove an object tag, the object will not be sent. + +First argument COMPOSITION is the buffer into which the objects +will be inserted. When this function is called interactively +COMPOSITION's name will be read from the minibuffer." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command)) + (list (read-buffer "Attach object to buffer: " + (vm-find-composition-buffer) t)))) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (dired-map-over-marks + (let ((file (dired-get-filename)) + type) + (setq type (or (vm-mime-default-type-from-filename file) + "application/octet-stream")) + (with-current-buffer composition + (vm-attach-file file type))) + nil)) + +;;; vm-dired.el ends here diff --git a/lisp/vm-edit.el b/lisp/vm-edit.el new file mode 100755 index 0000000..cd9db5e --- /dev/null +++ b/lisp/vm-edit.el @@ -0,0 +1,331 @@ +;;; vm-edit.el --- Editing VM messages +;; +;; This file is part of VM +;; +;; Copyright (C) 1990, 1991, 1993, 1994, 1997, 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-edit) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-page) + (require 'vm-thread) + (require 'vm-sort) + (require 'vm-motion) +) + + +;;;###autoload +(defun vm-edit-message (&optional prefix-argument) + "Edit the current message. Prefix arg means mark as unedited instead. +If editing, the current message is copied into a temporary buffer, and +this buffer is selected for editing. The major mode of this buffer is +controlled by the variable vm-edit-message-mode. The hooks specified +in vm-edit-message-hook are run just prior to returning control to the user +for editing. + +Use C-c ESC when you have finished editing the message. The message +will be inserted into its folder replacing the old version of the +message. If you don't want your edited version of the message to +replace the original, use C-c C-] and the edit will be aborted." + (interactive "P") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (if (and (vm-virtual-message-p (car vm-message-pointer)) + (null (vm-virtual-messages-of (car vm-message-pointer)))) + (error "Can't edit unmirrored virtual messages.")) + (if prefix-argument + (when (vm-edited-flag (car vm-message-pointer)) + (vm-set-edited-flag-of (car vm-message-pointer) nil) + (vm-update-summary-and-mode-line)) + (let ((mp vm-message-pointer) + (offset (save-excursion + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (- (point) (vm-headers-of (car vm-message-pointer))))) + (edit-buf (vm-edit-buffer-of (car vm-message-pointer))) + (folder-buffer (current-buffer))) + ;; (vm-load-message) + (vm-retrieve-operable-messages 1 (list (car vm-message-pointer))) + (if (and edit-buf (buffer-name edit-buf)) + (set-buffer edit-buf) + (vm-save-restriction + (widen) + (setq edit-buf + (generate-new-buffer + (format "edit of %s's note re: %s" + (vm-su-full-name (car vm-message-pointer)) + (vm-su-subject (car vm-message-pointer))))) + (if vm-fsfemacs-mule-p + (set-buffer-multibyte nil)) ; for new buffer + (vm-set-edit-buffer-of (car mp) edit-buf) + (copy-to-buffer edit-buf + (vm-headers-of (car mp)) + (vm-text-end-of (car mp)))) + (set-buffer edit-buf) + (set-buffer-modified-p nil) ; edit-buf + (goto-char (point-min)) + (if (< offset 0) + (search-forward "\n\n" nil t) + (forward-char offset)) + (funcall (or vm-edit-message-mode 'text-mode)) + (set-keymap-parent vm-edit-message-map (current-local-map)) + (use-local-map vm-edit-message-map) + ;; (list (car mp)) because a different message may + ;; later be stuffed into a cons linked that is linked + ;; into the folder's message list. + (setq vm-message-pointer (list (car mp)) + vm-mail-buffer folder-buffer + vm-system-state 'editing + buffer-offer-save t) + (run-hooks 'vm-edit-message-hook) + (vm-inform 5 + (substitute-command-keys + "Type \\[vm-edit-message-end] to end edit, \\[vm-edit-message-abort] to abort with no change.")) + ) + (when (and vm-mutable-frame-configuration vm-frame-per-edit + (vm-multiple-frames-possible-p)) + (let ((w (vm-get-buffer-window edit-buf))) + (if (null w) + (progn + (vm-goto-new-frame 'edit) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w))))))) + (vm-display edit-buf t '(vm-edit-message vm-edit-message-other-frame) + (list this-command 'editing-message))))) + +;;;###autoload +(defun vm-edit-message-other-frame (&optional prefix) + "Like vm-edit-message, but run in a newly created frame." + (interactive "P") + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'edit)) + (let ((vm-search-other-frames nil) + (vm-frame-per-edit nil)) + (vm-edit-message prefix)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-discard-cached-data (&optional count) + "Discard cached information about the current message. +When VM gathers information from the headers of a message, it stores it +internally for future reference. This command causes VM to forget this +information, and VM will be forced to search the headers of the message +again for these data. VM will also have to decide again which headers +should be displayed and which should not. Therefore this command is +useful if you change the value of vm-visible-headers or +vm-invisible-header-regexp in the midst of a VM session. + +Numeric prefix argument N means to discard data from the current message +plus the next N-1 messages. A negative N means discard data from the +current message and the previous N-1 messages. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +data is discarded only from the marked messages in the current folder. +If applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread have their cached data discarded." + (interactive "p") + (or count (setq count 1)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Discard data of"))) + (vm-discard-cached-data-internal mlist (vm-interactive-p) )) + (vm-display nil nil '(vm-discard-cached-data) '(vm-discard-cached-data)) + (vm-update-summary-and-mode-line)) + +(defun vm-discard-cached-data-internal (mlist &optional interactive-p) + (let ((buffers-needing-thread-sort (make-vector 29 0)) + m) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (with-current-buffer (vm-buffer-of m) + (vm-garbage-collect-message) + (if (vectorp vm-thread-obarray) + (vm-unthread-message-and-mirrors m :message-changing t)) + ;; It was a mistake to store the POP & IMAP UID data here but + ;; it's too late to change it now. So keep the data from + ;; getting wiped. + (let ((uid (vm-imap-uid-of m)) + (uid-validity (vm-imap-uid-validity-of m)) + (headers-flag (vm-headers-to-be-retrieved-of m)) + (body-flag (vm-body-to-be-retrieved-of m)) + (body-discard-flag (vm-body-to-be-discarded-of m))) + (fillarray (vm-cached-data-of m) nil) + (vm-set-imap-uid-of m uid) + (vm-set-imap-uid-validity-of m uid-validity) + (vm-set-headers-to-be-retrieved-of m headers-flag) + (vm-set-body-to-be-retrieved-of m body-flag) + (vm-set-body-to-be-discarded-of m body-discard-flag)) + (vm-set-vheaders-of m nil) + (vm-set-vheaders-regexp-of m nil) + (vm-set-text-of m nil) + (vm-set-mime-layout-of m nil) + (vm-set-mime-encoded-header-flag-of m nil) + (if (vectorp vm-thread-obarray) + (vm-build-threads (list m))) + (if vm-thread-debug + (vm-check-thread-integrity)) + (if vm-summary-show-threads + (intern (buffer-name) buffers-needing-thread-sort)) + (dolist (v-m (vm-virtual-messages-of m)) + (when (buffer-name (vm-buffer-of v-m)) + (with-current-buffer (vm-buffer-of v-m) + (vm-set-mime-layout-of v-m nil) + (vm-set-mime-encoded-header-flag-of v-m nil) + (if (vectorp vm-thread-obarray) + (vm-build-threads (list v-m))) + (if vm-summary-show-threads + (intern (buffer-name) buffers-needing-thread-sort)) + + (if (and vm-presentation-buffer + (eq (car vm-message-pointer) v-m)) + (save-excursion (vm-present-current-message)))))) + (vm-mark-for-summary-update m) + (vm-set-stuff-flag-of m t) + (if (and interactive-p vm-presentation-buffer + (eq (car vm-message-pointer) m)) + (save-excursion (vm-present-current-message))) + (setq mlist (cdr mlist)))) + (save-excursion + (mapatoms (function (lambda (s) + (set-buffer (get-buffer (symbol-name s))) + (vm-sort-messages (or vm-ml-sort-keys "activity")))) + buffers-needing-thread-sort)))) + +;;;###autoload +(defun vm-edit-message-end () + "End the edit of a message and copy the result to its folder." + (interactive) + (if (null vm-message-pointer) + (error "This is not a VM message edit buffer.")) + (if (null (buffer-name (vm-buffer-of (car vm-message-pointer)))) + (error "The folder buffer for this message has been killed.")) + (let ((pos-offset (- (point) (point-min)))) + ;; make sure the message ends with a newline + (goto-char (point-max)) + (and (/= (preceding-char) ?\n) (insert ?\n)) + ;; munge message separators found in the edited message to + ;; prevent message from being split into several messages. + (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer)) + (point-min) (point-max)) + ;; for From_-with-Content-Length recompute the Content-Length header + (if (eq (vm-message-type-of (car vm-message-pointer)) + 'From_-with-Content-Length) + (let ((buffer-read-only nil) + length) + (goto-char (point-min)) + ;; first delete all copies of Content-Length + (while (and (re-search-forward vm-content-length-search-regexp nil t) + (null (match-beginning 1)) + (progn (goto-char (match-beginning 0)) + (vm-match-header vm-content-length-header))) + (delete-region (vm-matched-header-start) (vm-matched-header-end))) + ;; now compute the message body length + (goto-char (point-min)) + (search-forward "\n\n" nil 0) + (setq length (- (point-max) (point))) + ;; insert the header + (goto-char (point-min)) + (insert vm-content-length-header " " (int-to-string length) "\n"))) + (let ((edit-buf (current-buffer)) + (mp vm-message-pointer)) + (if (not (buffer-modified-p)) + (vm-inform 5 "No change.") + (widen) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of (car mp)))) + (if (not (memq (vm-real-message-of (car mp)) vm-message-list)) + (error "The original copy of this message has been expunged.")) + (vm-save-restriction + (widen) + (goto-char (vm-headers-of (vm-real-message-of (car mp)))) + (let ((vm-message-pointer mp) + opoint + (buffer-read-only nil)) + (setq opoint (point)) + (insert-buffer-substring edit-buf) + (delete-region + (point) (vm-text-end-of (vm-real-message-of (car mp)))) + (vm-discard-cached-data-internal (list (car mp)))) + (vm-set-edited-flag-of (car mp) t) + (vm-set-edit-buffer-of (car mp) nil)) + (set-buffer (vm-buffer-of (car mp))) + (if (eq (vm-real-message-of (car mp)) + (vm-real-message-of (car vm-message-pointer))) + (progn + (vm-present-current-message) + ;; Try to position the cursor in the message + ;; window close to where it was in the edit + ;; window. This works well for non MIME + ;; messages, but the cursor drifts badly for + ;; MIME and for refilled messages. + (vm-save-buffer-excursion + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (vm-save-restriction + (vm-save-buffer-excursion + (widen) + (let ((osw (selected-window)) + (new-win (vm-get-visible-buffer-window + (current-buffer)))) + (unwind-protect + (if new-win + (progn + (select-window new-win) + (goto-char (vm-headers-of + (car vm-message-pointer))) + (condition-case nil + (forward-char pos-offset) + (error nil)))) + (if (not (eq osw (selected-window))) + (select-window osw)))))))) + (vm-update-summary-and-mode-line)))) + (vm-display edit-buf nil '(vm-edit-message-end) + '(vm-edit-message-end reading-message startup)) + (set-buffer-modified-p nil) ; edit-buf + (kill-buffer edit-buf)))) + +(defun vm-edit-message-abort () + "Abort the edit of a message, forgetting changes to the message." + (interactive) + (unless vm-message-pointer + (error "This is not a VM message edit buffer.")) + (unless (buffer-name + (vm-buffer-of (vm-real-message-of (car vm-message-pointer)))) + (error "The folder buffer for this message has been killed.")) + (vm-set-edit-buffer-of (car vm-message-pointer) nil) + (vm-display (current-buffer) nil + '(vm-edit-message-abort) + '(vm-edit-message-abort reading-message startup)) + (set-buffer-modified-p nil) ; edit-buffer + (kill-buffer (current-buffer)) + (vm-inform 5 "Aborted, no change.")) + +;;; vm-edit.el ends here diff --git a/lisp/vm-folder.el b/lisp/vm-folder.el new file mode 100755 index 0000000..b37f7dc --- /dev/null +++ b/lisp/vm-folder.el @@ -0,0 +1,5419 @@ +;;; vm-folder.el --- VM folder related functions +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; Copyright (C) 2008-2010 Uday S. Reddy +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-folder) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-toolbar) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-mark) + (require 'vm-virtual) + (require 'vm-mime) + (require 'vm-sort) + (require 'vm-thread) + (require 'vm-pop) + (require 'vm-imap) +) + +;; vm-xemacs.el is a fake file to fool the Emacs 23 compiler +(declare-function get-itimer "vm-xemacs.el" (name)) +(declare-function start-itimer "vm-xemacs.el" + (name function value &optional restart is-idle with-args + &rest function-arguments)) +(declare-function set-itimer-restart "vm-xemacs.el" (itimer restart)) + +(declare-function vm-update-draft-count "vm.el" ()) +(declare-function vm "vm.el" + (&optional folder + &key read-only access-method reload revisit)) +(declare-function vm-mode "vm.el" (&optional read-only)) + + +;; Operations for vm-folder-access-data + +(defsubst vm-folder-pop-maildrop-spec () + (aref vm-folder-access-data 0)) +(defsubst vm-folder-pop-process () + (aref vm-folder-access-data 1)) + +(defsubst vm-set-folder-pop-maildrop-spec (val) + (aset vm-folder-access-data 0 val)) +(defsubst vm-set-folder-pop-process (val) + (aset vm-folder-access-data 1 val)) + +;; the maildrop spec of the imap folder +(defsubst vm-folder-imap-maildrop-spec () + (aref vm-folder-access-data 0)) +;; current imap process of the folder - each folder has a separate one +(defsubst vm-folder-imap-process () + (aref vm-folder-access-data 1)) +;; the UIDVALIDITY value of the imap folder on the server +(defsubst vm-folder-imap-uid-validity () + (aref vm-folder-access-data 2)) +;; the list of uid's and flags of the messages in the imap folder on +;; the server (msg-num . uid . size . flags list) +(defsubst vm-folder-imap-uid-list () + (aref vm-folder-access-data 3)) +;; the number of messages in the imap folder on the server +(defsubst vm-folder-imap-mailbox-count () + (aref vm-folder-access-data 4)) +;; flag indicating whether the imap folder allows writing +(defsubst vm-folder-imap-read-write () + (aref vm-folder-access-data 5)) +;; flag indicating whether the imap folder allows deleting +(defsubst vm-folder-imap-can-delete () + (aref vm-folder-access-data 6)) +;; flag indicating whether the imap server has body-peek functionality +(defsubst vm-folder-imap-body-peek () + (aref vm-folder-access-data 7)) +;; list of permanent flags storable on the imap server +(defsubst vm-folder-imap-permanent-flags () + (aref vm-folder-access-data 8)) +;; obarray of uid's with message numbers as their values (on the server) +(defsubst vm-folder-imap-uid-obarray () + (aref vm-folder-access-data 9)) ; obarray(uid, msg-num) +;; obarray of uid's with flags lists as their values (on the server) +(defsubst vm-folder-imap-flags-obarray () + (aref vm-folder-access-data 10)) ; obarray(uid, (size . flags list)) + ; cons-pair shared with imap-uid-list +;; the number of recent messages in the imap folder on the server +(defsubst vm-folder-imap-recent-count () + (aref vm-folder-access-data 11)) +;; the number of messages in the imap folder on the server, when last retrieved +(defsubst vm-folder-imap-retrieved-count () + (aref vm-folder-access-data 12)) + +(defsubst vm-set-folder-imap-maildrop-spec (val) + (aset vm-folder-access-data 0 val)) +(defsubst vm-set-folder-imap-process (val) + (aset vm-folder-access-data 1 val)) +(defsubst vm-set-folder-imap-uid-validity (val) + (aset vm-folder-access-data 2 val)) +(defsubst vm-set-folder-imap-uid-list (val) + (aset vm-folder-access-data 3 val)) +(defsubst vm-set-folder-imap-mailbox-count (val) + (aset vm-folder-access-data 4 val)) +(defsubst vm-set-folder-imap-read-write (val) + (aset vm-folder-access-data 5 val)) +(defsubst vm-set-folder-imap-can-delete (val) + (aset vm-folder-access-data 6 val)) +(defsubst vm-set-folder-imap-body-peek (val) + (aset vm-folder-access-data 7 val)) +(defsubst vm-set-folder-imap-permanent-flags (val) + (aset vm-folder-access-data 8 val)) +(defsubst vm-set-folder-imap-uid-obarray (val) + (aset vm-folder-access-data 9 val)) +(defsubst vm-set-folder-imap-flags-obarray (val) + (aset vm-folder-access-data 10 val)) +(defsubst vm-set-folder-imap-recent-count (val) + (aset vm-folder-access-data 11 val)) +(defsubst vm-set-folder-imap-retrieved-count (val) + (aset vm-folder-access-data 12 val)) + +(defun vm-set-buffer-modified-p (flag &optional buffer) + "Sets the `buffer-modified-p' of the current folder to FLAG. Optional +argument BUFFER can ask for it to be done for some other folder. + +This function is deprecated. Use `vm-mark-folder-modified-p' or + `vm-unmark-folder-modified-p' instead." + (if flag + (vm-mark-folder-modified-p buffer) + (vm-unmark-folder-modified-p buffer))) + +(defun vm-mark-folder-modified-p (&optional buffer) + "Sets the `buffer-modified-p' flag of the current folder to t. Optional +argument BUFFER can ask for it to be done for some other folder. + +This function also zeroes `vm-messages-not-on-disk' and schedules the +folder for redisplay." + (with-current-buffer (or buffer (current-buffer)) + (set-buffer-modified-p t) + (vm-increment vm-modification-counter) + (intern (buffer-name) vm-buffers-needing-display-update) + (setq vm-messages-not-on-disk 0))) + +(defun vm-unmark-folder-modified-p (buffer) + "Sets the `buffer-modified-p' flag of the current folder to nil." + (with-current-buffer (or buffer (current-buffer)) + (set-buffer-modified-p nil) + (vm-increment vm-modification-counter) + (intern (buffer-name) vm-buffers-needing-display-update))) + +(defun vm-reset-buffer-modified-p (value buffer) + "Sets the `buffer-modified-p' flag of BUFFER to VALUE. This +is not meant for changing the flag for folders. Use +`vm-mark-folder-modified-p' or `vm-unset-folder-modified-p' instead." + (with-current-buffer buffer + (set-buffer-modified-p value))) + +(defun vm-restore-buffer-modified-p (value buffer) + "Restores the `buffer-modified-p' flag of BUFFER to a saved VALUE. +This is the same as `vm-reset-buffer-modified-p' but represents a +specific intent." + (with-current-buffer buffer + (set-buffer-modified-p value))) + +(defun vm-message-position (m) + "Return a message-pointer pointing to the message M in the +`vm-message-list'." + (memq m vm-message-list)) + +(defun vm-number-messages (&optional start-point end-point) + "Set the number-of and padded-number-of slots of messages +in vm-message-list. + +If non-nil, START-POINT should point to a cons cell in +vm-message-list and the numbering will begin there, else the +numbering will begin at the head of vm-message-list. If +START-POINT is non-nil the reverse-link-of slot of the message in +the cons must be valid and the message pointed to (if any) must +have a non-nil number-of slot, because it is used to determine +what the starting message number should be. + +If non-nil, END-POINT should point to a cons cell in +vm-message-list and the numbering will end with the message just +before this cell. A nil value means numbering will be done until +the end of vm-message-list is reached." + (let ((n 1) + (message-list vm-message-list)) + (when (and start-point (vm-reverse-link-of (car start-point))) + (if (null (vm-number-of (car (vm-reverse-link-of (car start-point))))) + (vm-warn 0 2 "Bad numbering start-point; please report bug.") + (setq n (1+ (string-to-number + (vm-number-of + (car (vm-reverse-link-of (car start-point)))))) + message-list start-point))) + (while (not (eq message-list end-point)) + (vm-set-number-of (car message-list) (int-to-string n)) + (vm-set-padded-number-of (car message-list) (format "%3d" n)) + (setq n (1+ n) + message-list (cdr message-list))) + (or end-point (setq vm-ml-highest-message-number (int-to-string (1- n)))) + (if vm-summary-buffer + (vm-copy-local-variables vm-summary-buffer + 'vm-ml-highest-message-number)))) + +(defun vm-set-numbering-redo-start-point (start-point) + "Set vm-numbering-redo-start-point to START-POINT if appropriate. +Also mark the current buffer as needing a display update. + +START-POINT should be a cons in vm-message-list or just t. + (t means start from the beginning of vm-message-list.) +If START-POINT is closer to the head of vm-message-list than +vm-numbering-redo-start-point or is equal to t, then +vm-numbering-redo-start-point is set to match it. +If START-POINT is nil, nothing is updated." + (when start-point + (intern (buffer-name) vm-buffers-needing-display-update) + (cond ((eq vm-numbering-redo-start-point t) + nil) + ((and (consp start-point) (consp vm-numbering-redo-start-point)) + (let ((mp vm-message-list)) + (while (and mp + (not + (or (eq (car mp) (car start-point)) + (eq (car mp) + (car vm-numbering-redo-start-point))))) + (setq mp (cdr mp))) + (when (null mp) + (error + "Something is wrong in vm-set-numbering-redo-start-point")) + (when (eq (car mp) (car start-point)) + (setq vm-numbering-redo-start-point start-point)))) + (t + (setq vm-numbering-redo-start-point start-point))))) + +(defun vm-set-numbering-redo-end-point (end-point) + "Set vm-numbering-redo-end-point to END-POINT if appropriate. +Also mark the current buffer as needing a display update. + +END-POINT should be a cons in vm-message-list or just t. + (t means number all the way to the end of vm-message-list.) +If END-POINT is closer to the end of vm-message-list or is equal +to t, then vm-numbering-redo-start-point is set to match it. +The number-of slot is used to determine proximity to the end of +vm-message-list, so this slot must be valid in END-POINT's message +and the message in the cons pointed to by vm-numbering-redo-end-point. +If END-PIONT is nil, nothing is updated." + (when end-point + (intern (buffer-name) vm-buffers-needing-display-update) + (cond ((eq end-point t) + (setq vm-numbering-redo-end-point t)) + ((and (consp end-point) + (> (string-to-number + (vm-number-of + (car end-point))) + (string-to-number + (vm-number-of + (car vm-numbering-redo-end-point))))) + (setq vm-numbering-redo-end-point end-point)) + ((null end-point) + (setq vm-numbering-redo-end-point end-point))))) + +(defun vm-do-needed-renumbering () + "Number messages in vm-message-list as specified by +vm-numbering-redo-start-point and vm-numbering-redo-end-point. + +vm-numbering-redo-start-point = t means start at the head +of vm-message-list. +vm-numbering-redo-end-point = t means number all the way to the +end of vm-message-list. + +Otherwise the variables' values should be conses in vm-message-list +or nil." + (when vm-numbering-redo-start-point + (vm-number-messages (if (consp vm-numbering-redo-start-point) + vm-numbering-redo-start-point) + vm-numbering-redo-end-point) + (setq vm-numbering-redo-start-point nil + vm-numbering-redo-end-point nil))) + +(defun vm-set-summary-redo-start-point (start-point) + "Set vm-summary-redo-start-point to START-POINT if appropriate. +Also mark the current buffer as needing a display update. + +START-POINT should be a cons in vm-message-list or just t. + (t means start from the beginning of vm-message-list.) +If START-POINT is closer to the head of vm-message-list than +vm-summary-redo-start-point or is equal to t, then +vm-summary-redo-start-point is set to match it. +If START-POINT is nil, nothing is updated." + (when start-point + (intern (buffer-name) vm-buffers-needing-display-update) + (cond ((eq vm-summary-redo-start-point t) + nil) + ((and (consp start-point) (consp vm-summary-redo-start-point)) + (let ((mp vm-message-list)) + (while (and mp (not (or (eq mp start-point) + (eq mp vm-summary-redo-start-point)))) + (setq mp (cdr mp))) + (when (null mp) + (error "Something is wrong in vm-set-summary-redo-start-point")) + (when (eq mp start-point) + (setq vm-summary-redo-start-point start-point)))) + (t + (setq vm-summary-redo-start-point start-point))))) + +(defun vm-mark-for-summary-update (m &optional dont-kill-cache) + "Mark message M and all its mirrored mesages for a summary update. +Also mark M's buffer as needing a display update. Any virtual +messages of M and their buffers are similarly marked for update. +If M is a virtual message and virtual mirroring is in effect for +M (i.e. attribute-of eq attributes-of M's real message), M's real +message and its buffer are scheduled for an update. + +Optional arg DONT-KILL-CACHE non-nil means don't invalidate the +summary-of slot for any messages marked for update. This is +meant to be used by functions that update message information +that is not cached in the summary-of slot, e.g. message numbers +and thread indentation." + (cond ((eq m (vm-real-message-of m)) + ;; this is a real message. + ;; its summary and modeline need to be updated. + (unless dont-kill-cache + ;; toss the cache. this also tosses the cache of any + ;; virtual messages mirroring this message. the summary + ;; entry cache must be cleared when an attribute of a + ;; message that could appear in the summary has changed. + (vm-set-summary-of m nil)) + (when (vm-su-start-of m) + (vm-add-to-list m vm-messages-needing-summary-update)) + (intern (buffer-name (vm-buffer-of m)) + vm-buffers-needing-display-update) + ;; find the virtual messages of this real message that + ;; need a summary update. + (dolist (v-m (vm-virtual-messages-of m)) + (when (eq (vm-attributes-of m) (vm-attributes-of v-m)) + (when (vm-su-start-of v-m) + (vm-add-to-list v-m + vm-messages-needing-summary-update)) + ;; don't trust blindly. The user could have killed some + ;; of these buffers + (when (buffer-name (vm-buffer-of v-m)) + (intern (buffer-name (vm-buffer-of v-m)) + vm-buffers-needing-display-update))))) + (t + ;; this is a virtual message. + ;; + ;; if this message has virtual messages then we need to + ;; schedule updates for all the virtual messages that + ;; share a cache with this message and we need to + ;; schedule an update for the underlying real message + ;; since we are mirroring it. + ;; + ;; if there are no virtual messages, then this virtual + ;; message is not mirroring its real message so we need + ;; only take care of this one message. + (if (vm-virtual-messages-of m) + (progn + ;; schedule updates for all the virtual message who share + ;; the same cache as this message. + (dolist (v-m (vm-virtual-messages-of m)) + (when (eq (vm-attributes-of m) (vm-attributes-of v-m)) + (when (vm-su-start-of v-m) + (vm-add-to-list v-m + vm-messages-needing-summary-update)) + (when (buffer-name (vm-buffer-of v-m)) + (intern (buffer-name (vm-buffer-of v-m)) + vm-buffers-needing-display-update)))) + ;; now take care of the real message + (unless dont-kill-cache + ;; toss the cache. this also tosses the cache of + ;; any virtual messages sharing the same cache as + ;; this message. + (vm-set-summary-of m nil)) + (when (vm-su-start-of (vm-real-message-of m)) + (vm-add-to-list (vm-real-message-of m) + vm-messages-needing-summary-update)) + (intern (buffer-name (vm-buffer-of (vm-real-message-of m))) + vm-buffers-needing-display-update)) + (unless dont-kill-cache + (vm-set-virtual-summary-of m nil)) + (when (vm-su-start-of m) + (vm-add-to-list m vm-messages-needing-summary-update)) + (intern (buffer-name (vm-buffer-of m)) + vm-buffers-needing-display-update))))) + +(defun vm-do-needed-mode-line-update () + "Do a modeline update for the current folder buffer. +This means setting up all the various vm-ml attribute variables +in the folder buffer and copying necessary variables to the +folder buffer's summary and presentation buffers, and then +forcing Emacs to update all modelines. + +If a virtual folder being updated has no messages, then +erase-buffer is called on its buffer. + +If any type of folder is empty, erase-buffer is called +on its presentation buffer, if any." + ;; XXX This last bit should probably should be moved to + ;; XXX vm-expunge-folder. + + (if (null vm-message-pointer) + (progn + ;; erase the leftover message if the folder is really empty. + (if (eq major-mode 'vm-virtual-mode) + (let ((buffer-read-only nil) + (omodified (buffer-modified-p))) + (unwind-protect + (erase-buffer) + (vm-restore-buffer-modified-p omodified (current-buffer))))) + (if (and vm-presentation-buffer (buffer-name vm-presentation-buffer)) + (let ((omodified (buffer-modified-p))) + (unwind-protect + (with-current-buffer vm-presentation-buffer + (let ((buffer-read-only nil)) + (erase-buffer))) + (vm-restore-buffer-modified-p omodified (current-buffer)))))) + ;; try to avoid calling vm-su-labels if possible so as to + ;; avoid loading vm-summary.el. + (if (vm-labels-of (car vm-message-pointer)) + (setq vm-ml-labels (vm-su-labels (car vm-message-pointer))) + (setq vm-ml-labels nil)) + (setq vm-ml-message-number (vm-number-of (car vm-message-pointer))) + (setq vm-ml-message-new (vm-new-flag (car vm-message-pointer))) + (setq vm-ml-message-unread (vm-unread-flag (car vm-message-pointer))) + (setq vm-ml-message-read + (and (not (vm-new-flag (car vm-message-pointer))) + (not (vm-unread-flag (car vm-message-pointer))))) + (setq vm-ml-message-edited (vm-edited-flag (car vm-message-pointer))) + (setq vm-ml-message-filed (vm-filed-flag (car vm-message-pointer))) + (setq vm-ml-message-written (vm-written-flag (car vm-message-pointer))) + (setq vm-ml-message-replied (vm-replied-flag (car vm-message-pointer))) + (setq vm-ml-message-forwarded (vm-forwarded-flag (car vm-message-pointer))) + (setq vm-ml-message-redistributed (vm-redistributed-flag (car vm-message-pointer))) + (setq vm-ml-message-deleted (vm-deleted-flag (car vm-message-pointer))) + (setq vm-ml-message-marked (vm-mark-of (car vm-message-pointer)))) + (if (and vm-summary-buffer (buffer-name vm-summary-buffer)) + (let ((modified (buffer-modified-p))) + (vm-copy-local-variables vm-summary-buffer + 'default-directory + 'vm-ml-message-new + 'vm-ml-message-unread + 'vm-ml-message-read + 'vm-ml-message-edited + 'vm-ml-message-replied + 'vm-ml-message-forwarded + 'vm-ml-message-filed + 'vm-ml-message-written + 'vm-ml-message-deleted + 'vm-ml-message-marked + 'vm-ml-message-redistributed + 'vm-ml-message-number + 'vm-ml-highest-message-number + 'vm-folder-read-only + 'vm-folder-type + 'vm-virtual-folder-definition + 'vm-virtual-mirror + 'vm-ml-sort-keys + 'vm-ml-labels + 'vm-spooled-mail-waiting + 'vm-message-list) + (vm-reset-buffer-modified-p modified vm-summary-buffer))) + (if (and vm-presentation-buffer (buffer-name vm-presentation-buffer)) + (let ((modified (buffer-modified-p))) + (vm-copy-local-variables vm-presentation-buffer + 'default-directory + 'vm-ml-message-new + 'vm-ml-message-unread + 'vm-ml-message-read + 'vm-ml-message-edited + 'vm-ml-message-replied + 'vm-ml-message-forwarded + 'vm-ml-message-filed + 'vm-ml-message-written + 'vm-ml-message-deleted + 'vm-ml-message-marked + 'vm-ml-message-number + 'vm-ml-message-redistributed + 'vm-ml-highest-message-number + 'vm-folder-read-only + 'vm-folder-type + 'vm-virtual-folder-definition + 'vm-virtual-mirror + 'vm-ml-labels + 'vm-spooled-mail-waiting + 'vm-message-list) + (vm-reset-buffer-modified-p modified vm-presentation-buffer))) + (vm-force-mode-line-update)) + +(defun vm-update-summary-and-mode-line () + "Update summary and mode line for all VM folder and summary buffers. +Really this updates all the visible status indicators. + +Message lists are renumbered. +Summary entries are wiped and regenerated. +Mode lines are updated. +Toolbars are updated." + (save-excursion + (vm-update-draft-count) + (mapatoms (function + (lambda (b) + (setq b (get-buffer (symbol-name b))) + (when b + (set-buffer b) + (intern (buffer-name) + vm-buffers-needing-undo-boundaries) + (vm-check-for-killed-summary) + (when (and vm-use-toolbar (vm-toolbar-support-possible-p)) + (vm-toolbar-update-toolbar)) + (when vm-summary-show-threads + (vm-build-threads-if-unbuilt)) + (vm-do-needed-renumbering) + (when vm-summary-buffer + (vm-do-needed-summary-rebuild)) + (vm-do-needed-mode-line-update)))) + vm-buffers-needing-display-update) + (fillarray vm-buffers-needing-display-update 0)) + (when vm-messages-needing-summary-update + (let ((n 1) + (ms vm-messages-needing-summary-update) + m) + (while ms + (setq m (car ms)) + (unless (or (eq (vm-deleted-flag m) 'expunged) + (equal (vm-message-id-number-of m) "Q")) + (vm-update-message-summary (car ms))) + (if (eq (mod n 10) 0) + (vm-inform 6 "Recreating summary... %s" n)) + (setq n (1+ n)) + (setq ms (cdr ms))) + (vm-inform 6 "Recreating summary... done") + (setq vm-messages-needing-summary-update nil))) + (vm-do-needed-folders-summary-update) + (vm-force-mode-line-update)) + +(defun vm-reverse-link-messages () + "Set reverse links for all messages in vm-message-list." + (let ((mp vm-message-list) + (prev nil)) + (while mp + (vm-set-reverse-link-of (car mp) prev) + (setq prev mp mp (cdr mp))))) + +(defun vm-match-ordered-header (alist) + "Try to match a header in ALIST and return the matching cell. +This is used by header ordering code. + +ALIST looks like this ((\"From\") (\"To\")). This function returns +the alist element whose car matches the header starting at point. +The header ordering code uses the cdr of the element +returned to hold headers to be output later." + (let ((case-fold-search t)) + (catch 'match + (while alist + (if (looking-at (car (car alist))) + (throw 'match (car alist))) + (setq alist (cdr alist))) + nil))) + +(defun vm-match-header (&optional header-name) + "Match a header and save some state information about the matched header. +Optional first arg HEADER-NAME means match the header only +if it matches HEADER-NAME. HEADER-NAME should be a string +containing a header name. The string should end with a colon if just +that name should be matched. A string that does not end in a colon +will match all headers that begin with that string. + +State information is stored in vm-matched-header-vector bound to a vector +of this form. + + [ header-start header-end + header-name-start header-name-end + header-contents-start header-contents-end ] + +Elements are integers. +There are functions to access and use this info." + (let ((case-fold-search t) + (header-name-regexp "\\([^ \t\n:]+\\):")) + (if (if header-name + (and (looking-at header-name) (looking-at header-name-regexp)) + (looking-at header-name-regexp)) + (save-excursion + (aset vm-matched-header-vector 0 (point)) + (aset vm-matched-header-vector 2 (point)) + (aset vm-matched-header-vector 3 (match-end 1)) + (goto-char (match-end 0)) + ;; skip leading whitespace + (skip-chars-forward " \t") + (aset vm-matched-header-vector 4 (point)) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + (aset vm-matched-header-vector 1 (point)) + ;; drop the trailing newline + (aset vm-matched-header-vector 5 (1- (point))))))) + +(defun vm-matched-header () + "Returns the header last matched by vm-match-header. +Trailing newline is included." + (vm-buffer-substring-no-properties (aref vm-matched-header-vector 0) + (aref vm-matched-header-vector 1))) + +(defun vm-matched-header-name () + "Returns the name of the header last matched by vm-match-header." + (vm-buffer-substring-no-properties (aref vm-matched-header-vector 2) + (aref vm-matched-header-vector 3))) + +(defun vm-matched-header-contents () + "Returns the contents of the header last matched by vm-match-header. +Trailing newline is not included." + (vm-buffer-substring-no-properties (aref vm-matched-header-vector 4) + (aref vm-matched-header-vector 5))) + +(defun vm-matched-header-start () + "Returns the start position of the header last matched by vm-match-header." + (aref vm-matched-header-vector 0)) + +(defun vm-matched-header-end () + "Returns the end position of the header last matched by vm-match-header." + (aref vm-matched-header-vector 1)) + +(defun vm-matched-header-name-start () + "Returns the start position of the name of the header last matched +by vm-match-header." + (aref vm-matched-header-vector 2)) + +(defun vm-matched-header-name-end () + "Returns the end position of the name of the header last matched +by vm-match-header." + (aref vm-matched-header-vector 3)) + +(defun vm-matched-header-contents-start () + "Returns the start position of the contents of the header last matched +by vm-match-header." + (aref vm-matched-header-vector 4)) + +(defun vm-matched-header-contents-end () + "Returns the end position of the contents of the header last matched +by vm-match-header." + (aref vm-matched-header-vector 5)) + +(defun vm-get-folder-type (&optional file start end ignore-visited) + "Return a symbol indicating the folder type of the current buffer. +This function works by examining the beginning of a folder. +If optional arg FILE is present the type of FILE is returned instead. +If FILE is being visited, the type of the buffer is returned. +If optional second and third arg START and END are provided, +vm-get-folder-type will examine the text between those buffer +positions. START and END default to 1 and (buffer-size) + 1. +If IGNORED-VISITED is non-nil, even if FILE is being visited, its +buffer is ignored and the disk copy of FILE is examined. + +Returns + nil if folder has no type (empty) + unknown if the type is not known to VM + mmdf for MMDF folders + babyl for BABYL folders + From_ for BSD UNIX From_ folders + BellFrom_ for old SysV From_ folders + From_-with-Content-Length + for new SysV folders that use the Content-Length header + +If vm-trust-From_-with-Content-Length is non-nil, +From_-with-Content-Length is returned if the first message in the +folder has a Content-Length header and the folder otherwise looks +like a From_ folder. + +Since BellFrom_ and From_ folders cannot be reliably distinguished +from each other, you must tell VM which one your system uses by +setting the variable vm-default-From_-folder-type to either From_ or +BellFrom_. For folders that could be From_ or BellFrom_ folders, +the value of vm-default-From_folder-type will be returned." + (let ((temp-buffer nil) + (b nil) + (case-fold-search nil)) + (unwind-protect + (save-excursion + (if file + (progn + (if (not ignore-visited) + (setq b (vm-get-file-buffer file))) + (if b + (set-buffer b) + (setq temp-buffer (vm-make-work-buffer)) + (set-buffer temp-buffer) + (if (file-readable-p file) + (condition-case nil + (let ((coding-system-for-read + (vm-binary-coding-system))) + (insert-file-contents file nil 0 4096)) + (wrong-number-of-arguments + (call-process "sed" file temp-buffer nil + "-n" "1,/^$/p"))))))) + (save-excursion + (save-restriction + (or start (setq start 1)) + (or end (setq end (1+ (buffer-size)))) + (widen) + (narrow-to-region start end) + (goto-char (point-min)) + (cond ((zerop (buffer-size)) nil) + ((looking-at "\n*From ") + (if (not vm-trust-From_-with-Content-Length) + vm-default-From_-folder-type + (let ((case-fold-search t)) + (re-search-forward vm-content-length-search-regexp + nil t)) + (cond ((match-beginning 1) + vm-default-From_-folder-type) + ((match-beginning 0) + 'From_-with-Content-Length) + (t vm-default-From_-folder-type)))) + ((looking-at "\001\001\001\001\n") 'mmdf) + ((looking-at "BABYL OPTIONS:") 'babyl) + (t 'unknown))))) + (and temp-buffer (kill-buffer temp-buffer))))) + +(defun vm-convert-folder-type (old-type new-type) + "Convert buffer from OLD-TYPE to NEW-TYPE. +OLD-TYPE and NEW-TYPE should be symbols returned from vm-get-folder-type. +This should be called on non-live buffers like crash boxes. +This will confuse VM if called on a folder buffer in vm-mode." + (let ((vm-folder-type old-type) + (pos-list nil) + beg end) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (while (vm-find-leading-message-separator) + (setq pos-list (cons (point-marker) pos-list)) + (vm-skip-past-leading-message-separator) + (setq pos-list (cons (point-marker) pos-list)) + (vm-find-trailing-message-separator) + (setq pos-list (cons (point-marker) pos-list)) + (vm-skip-past-trailing-message-separator) + (setq pos-list (cons (point-marker) pos-list))) + (setq pos-list (nreverse pos-list)) + (goto-char (point-min)) + (vm-convert-folder-header old-type new-type) + (while pos-list + (setq beg (car pos-list)) + (goto-char (car pos-list)) + (insert-before-markers (vm-leading-message-separator new-type)) + (delete-region (car pos-list) (car (cdr pos-list))) + (vm-convert-folder-type-headers old-type new-type) + (setq pos-list (cdr (cdr pos-list))) + (setq end (marker-position (car pos-list))) + (goto-char (car pos-list)) + (insert-before-markers (vm-trailing-message-separator new-type)) + (delete-region (car pos-list) (car (cdr pos-list))) + (goto-char beg) + (vm-munge-message-separators new-type beg end) + (setq pos-list (cdr (cdr pos-list)))))) + +(defun vm-convert-folder-header (old-type new-type) + "Convert the folder header form OLD-TYPE to NEW-TYPE. +The folder header is the text at the beginning of a folder that +is a legal part of the folder but is not part of the first +message. This is for dealing with BABYL files." + (if (eq old-type 'babyl) + (save-excursion + (let ((beg (point)) + (case-fold-search t)) + (cond ((and (looking-at "BABYL OPTIONS:") + (search-forward "\037" nil t)) + (delete-region beg (point))))))) + (if (eq new-type 'babyl) + ;; insert before markers so that message location markers + ;; for the first message get moved forward. + (insert-before-markers "BABYL OPTIONS:\nVersion: 5\n\037"))) + +(defun vm-skip-past-folder-header () + "Move point past the folder header. +The folder header is the text at the beginning of a folder that +is a legal part of the folder but is not part of the first +message. This is for dealing with BABYL files." + (cond ((eq vm-folder-type 'babyl) + (search-forward "\037" nil 0)))) + +(defun vm-convert-folder-type-headers (old-type new-type) + "Convert headers in the message around point from OLD-TYPE to NEW-TYPE. +This means to add/delete Content-Length and any other +headers related to folder-type as needed for folder type +conversions. This function expects point to be at the beginning +of the header section of a message, and it only deals with that +message." + (let (length) + ;; get the length now before the content-length headers are + ;; removed. + (if (eq new-type 'From_-with-Content-Length) + (let (start) + (save-excursion + (save-excursion + (search-forward "\n\n" nil 0) + (setq start (point))) + (let ((vm-folder-type old-type)) + (vm-find-trailing-message-separator)) + (setq length (- (point) start))))) + ;; chop out content-length header if new format doesn't need + ;; it or if the new format computed his own copy. + (if (or (eq old-type 'From_-with-Content-Length) + (eq new-type 'From_-with-Content-Length)) + (save-excursion + (while (and (let ((case-fold-search t)) + (re-search-forward vm-content-length-search-regexp + nil t)) + (null (match-beginning 1)) + (progn (goto-char (match-beginning 0)) + (vm-match-header vm-content-length-header))) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; insert the content-length header if needed + (if (eq new-type 'From_-with-Content-Length) + (save-excursion + (insert vm-content-length-header " " (int-to-string length) "\n"))))) + +(defun vm-munge-message-separators (folder-type start end) + "Munge message separators of FOLDER-TYPE found between START and END. +This function is used to eliminate message separators for a particular +folder type that happen to occur in a message. \">\" is prepended to such +separators." + (save-excursion + ;; when munging From-type separators it is best to use the + ;; least forgiving of the folder types, so that we don't + ;; create folders that other mailers or older versions of VM + ;; will misparse. + (if (eq folder-type 'From_) + (setq folder-type 'BellFrom_)) + (let ((vm-folder-type folder-type)) + (cond ((memq folder-type '(From_ From_-with-Content-Length mmdf + BellFrom_ babyl)) + (setq end (vm-marker end)) + (goto-char start) + (while (and (vm-find-leading-message-separator) + (< (point) end)) + (insert ">")) + (set-marker end nil)))))) + +(defun vm-compatible-folder-p (file) + "Return non-nil if FILE is a compatible folder with the current buffer. +The current folder must have vm-folder-type initialized. +FILE is compatible if + - it is empty + - the current folder is empty + - the two folder types are equal" + (let ((type (vm-get-folder-type file))) + (or (not (and vm-folder-type type)) + (eq vm-folder-type type)))) + +(defun vm-leading-message-separator (&optional folder-type message + for-other-folder) + "Returns a leading message separator for the current folder. +Defaults to returning a separator for the current folder type. + +Optional first arg FOLDER-TYPE means return a separator for that +folder type instead. + +Optional second arg MESSAGE should be a message struct. This is used +generating BABYL separators, because they contain message attributes +and labels that must must be copied from the message. + +Optional third arg FOR-OTHER-FOLDER non-nil means that this separator will +be used a `foreign' folder. This means that the `deleted' +attributes should not be copied for BABYL folders." + (let ((type (or folder-type vm-folder-type))) + (cond ((memq type '(From_ From_-with-Content-Length BellFrom_)) + (concat "From VM " (current-time-string) "\n")) + ((eq type 'mmdf) + "\001\001\001\001\n") + ((eq type 'babyl) + (cond (message + (concat "\014\n0," + (vm-babyl-attributes-string message for-other-folder) + ",\n*** EOOH ***\n")) + (t "\014\n0, recent, unseen,,\n*** EOOH ***\n")))))) + +(defun vm-trailing-message-separator (&optional folder-type) + "Returns a trailing message separator for the current folder. +Defaults to returning a separator for the current folder type. + +Optional first arg FOLDER-TYPE means return a separator for that +folder type instead." + (let ((type (or folder-type vm-folder-type))) + (cond ((eq type 'From_) "\n") + ((eq type 'From_-with-Content-Length) "") + ((eq type 'BellFrom_) "") + ((eq type 'mmdf) "\001\001\001\001\n") + ((eq type 'babyl) "\037")))) + +(defun vm-folder-header (&optional folder-type label-obarray) + "Returns a folder header for the current folder. +Defaults to returning a folder header for the current folder type. + +Optional first arg FOLDER-TYPE means return a folder header for that +folder type instead. + +Optional second arg LABEL-OBARRAY should be an obarray of labels +that have been used in this folder. This is used for BABYL folders." + (let ((type (or folder-type vm-folder-type))) + (cond ((eq type 'babyl) + (let ((list nil)) + (if label-obarray + (mapatoms (function + (lambda (sym) + (setq list (cons sym list)))) + label-obarray)) + (if list + (format "BABYL OPTIONS:\nVersion: 5\nLabels: %s\n\037" + (mapconcat (function symbol-name) list ", ")) + "BABYL OPTIONS:\nVersion: 5\n\037"))) + (t "")))) + +;; This separator regexp is a bit too permissive. +;; Jose Manuel Garcia-Patos suggests the following +;; "^From .+[@]?.+ .+ [+-]?[0-9][0-9][0-9][0-9]$" +(defvar vm-leading-message-separator-regexp-From_ + "^From .*[0-9]$" + "Regular expression that matches the leading message separator in +From_ type mail folders.") +(defvar vm-leading-message-separator-regexp-BellFrom_ + "^From .*[0-9]$" + "Regular expression that matches the leading message separator in +BellFrom_ type mail folders.") +(defvar vm-leading-message-separator-regexp-From_-with-Content-Length + "\\(^\\|\n+\\)From " + "Regular expression that matches the leading message separator in +From_-with-Content-Length type mail folders.") +(defvar vm-leading-message-separator-regexp-mmdf + "^\001\001\001\001" + "Regular expression that matches the leading message separator in +mmdf_ type mail folders.") + + +(defun vm-find-leading-message-separator () + "Find the next leading message separator in a folder. +Returns non-nil if the separator is found, nil otherwise." + (cond + ((eq vm-folder-type 'From_) + (let ((case-fold-search nil)) + (catch 'done + (while (re-search-forward + vm-leading-message-separator-regexp-From_ nil 'no-error) + (goto-char (match-beginning 0)) + (if (or (< (point) 3) + (equal (char-after (- (point) 2)) ?\n)) + (throw 'done t) + (forward-char 1))) + nil ))) + ((eq vm-folder-type 'BellFrom_) + (let ((case-fold-search nil)) + (if (re-search-forward + vm-leading-message-separator-regexp-BellFrom_ nil 'no-error) + (progn + (goto-char (match-beginning 0)) + t ) + nil ))) + ((eq vm-folder-type 'From_-with-Content-Length) + (let ((case-fold-search nil)) + (if (re-search-forward + vm-leading-message-separator-regexp-From_-with-Content-Length + nil 'no-error) + (progn (goto-char (match-end 1)) t) + nil ))) + ((eq vm-folder-type 'mmdf) + (let ((case-fold-search nil)) + (if (re-search-forward + vm-leading-message-separator-regexp-mmdf nil 'no-error) + (progn + (goto-char (match-beginning 0)) + t ) + nil ))) + ((eq vm-folder-type 'baremessage) + (goto-char (point-max))) + ((eq vm-folder-type 'babyl) + (let ((reg1 "\014\n[01],") + (case-fold-search nil)) + (catch 'done + (while (re-search-forward reg1 nil 'no-error) + (goto-char (match-beginning 0)) + (if (and (not (bobp)) (= (preceding-char) ?\037)) + (throw 'done t) + (forward-char 1))) + nil ))))) + +(defun vm-find-trailing-message-separator () + "Find the next trailing message separator in a folder." + (cond + ((eq vm-folder-type 'From_) + (vm-find-leading-message-separator) + (forward-char -1)) + ((eq vm-folder-type 'BellFrom_) + (vm-find-leading-message-separator)) + ((eq vm-folder-type 'From_-with-Content-Length) + (let ((reg1 "^From ") + content-length + (start-point (point)) + (case-fold-search nil)) + (if (and (let ((case-fold-search t)) + (re-search-forward vm-content-length-search-regexp nil t)) + (null (match-beginning 1)) + (progn (goto-char (match-beginning 0)) + (vm-match-header vm-content-length-header))) + (progn + (setq content-length + (string-to-number (vm-matched-header-contents))) + ;; if search fails, we'll be at point-max + ;; if specified content-length is too long, go to point-max + (if (search-forward "\n\n" nil 0) + (if (>= (- (point-max) (point)) content-length) + (forward-char content-length) + (goto-char (point-max)))) + ;; Some systems seem to add a trailing newline that's + ;; not counted in the Content-Length header. Allow + ;; any number of them to avoid trouble. + (skip-chars-forward "\n"))) + (if (or (eobp) (looking-at reg1)) + nil + (goto-char start-point) + (if (re-search-forward reg1 nil 0) + (forward-char -5))))) + ((eq vm-folder-type 'mmdf) + (vm-find-leading-message-separator)) + ((eq vm-folder-type 'baremessage) + (goto-char (point-max))) + ((eq vm-folder-type 'babyl) + (vm-find-leading-message-separator) + (forward-char -1)))) + +(defun vm-skip-past-leading-message-separator () + "Move point past a leading message separator at point." + (cond + ((memq vm-folder-type '(From_ BellFrom_ From_-with-Content-Length)) + (let ((reg1 "^>From ") + (case-fold-search nil)) + (forward-line 1) + (while (looking-at reg1) + (forward-line 1)))) + ((eq vm-folder-type 'mmdf) + (forward-char 5) + ;; skip >From. Either SCO's MMDF implementation leaves this + ;; stuff in the message, or many sysadmins have screwed up + ;; their mail configuration. Either way I'm tired of getting + ;; bug reports about it. + (let ((reg1 "^>From ") + (case-fold-search nil)) + (while (looking-at reg1) + (forward-line 1)))) + ((eq vm-folder-type 'babyl) + (search-forward "\n*** EOOH ***\n" nil 0)))) + +(defun vm-skip-past-trailing-message-separator () + "Move point past a trailing message separator at point." + (cond + ((eq vm-folder-type 'From_) + (if (not (eobp)) + (forward-char 1))) + ((eq vm-folder-type 'From_-with-Content-Length)) + ((eq vm-folder-type 'BellFrom_)) + ((eq vm-folder-type 'mmdf) + (forward-char 5)) + ((eq vm-folder-type 'babyl) + (forward-char 1)))) + +(defun vm-build-message-list () + "Build a chain of message structures, stored them in vm-message-list. +Finds the start and end of each message and fills in the relevant +fields in the message structures. + +Also finds the beginning of the header section and the end of the +text section and fills in these fields in the message structures. + +vm-text-of and vm-vheaders-of fields don't get filled until they +are needed. + +If vm-message-list already contained messages, the end of the last +known message is found and then the parsing of new messages begins +there and the message are appended to vm-message-list. + +vm-folder-type is initialized here." + (setq vm-folder-type (vm-get-folder-type)) + (save-excursion + (let ((tail-cons nil) + (n 0) + ;; Just for yucks, make the update interval vary. + (modulus (+ (% (vm-abs (random)) 11) 25)) + message last-end) + (if vm-message-list + ;; there are already messages, therefore we're supposed + ;; to add to this list. + (let ((mp vm-message-list) + (end (point-min))) + ;; first we have to find physical end of the folder + ;; prior to the new messages that just came in. + (while mp + (if (< end (vm-end-of (car mp))) + (setq end (vm-end-of (car mp)))) + (if (not (consp (cdr mp))) + (setq tail-cons mp)) + (setq mp (cdr mp))) + (goto-char end)) + ;; there are no messages so we're building the whole list. + ;; start from the beginning of the folder. + (goto-char (point-min)) + ;; whine about newlines at the beginning of the folder. + ;; technically I think this is corruption, but there are + ;; too many busted mail-do-fcc's installed out there to + ;; do more than whine. + (if (and (memq vm-folder-type '(From_ BellFrom_ + From_-with-Content-Length)) + (= (following-char) ?\n)) + (vm-warn 0 2 "Warning: newline found at beginning of folder, %s" + (or buffer-file-name (buffer-name)))) + (vm-skip-past-folder-header)) + (setq last-end (point)) + ;; parse the messages, set the markers that specify where + ;; things are. + (while (vm-find-leading-message-separator) + (setq message (vm-make-message)) + (vm-set-message-type-of message vm-folder-type) + (vm-set-message-access-method-of message vm-folder-access-method) + (vm-set-start-of message (vm-marker (point))) + (vm-skip-past-leading-message-separator) + (vm-set-headers-of message (vm-marker (point))) + (vm-find-trailing-message-separator) + (vm-set-text-end-of message (vm-marker (point))) + (vm-skip-past-trailing-message-separator) + (setq last-end (point)) + (vm-set-end-of message (vm-marker (point))) + (vm-set-reverse-link-of message tail-cons) + (if (null tail-cons) + (setq vm-message-list (list message) + tail-cons vm-message-list) + (setcdr tail-cons (list message)) + (setq tail-cons (cdr tail-cons))) + (vm-increment n) + (if (zerop (% n modulus)) + (vm-inform 7 "Parsing messages... %d" n))) + (if (>= n modulus) + (vm-inform 7 "Parsing messages... done")) + (if (and (not (= last-end (point-max))) + (not (eq vm-folder-type 'unknown))) + (vm-warn 1 2 + "Warning: garbage found at end of folder, %s, starting at %d" + (or buffer-file-name (buffer-name)) + last-end))))) + +(defun vm-build-header-order-alist (vheaders) + (let ((order-alist (cons nil nil)) + list) + (setq list order-alist) + (while vheaders + (setcdr list (cons (cons (car vheaders) nil) nil)) + (setq list (cdr list) vheaders (cdr vheaders))) + (cdr order-alist))) + +;; Reorder the headers in a message. +;; +;; If a message struct is passed into this function, then we're +;; operating on a message in a folder buffer. Headers are +;; grouped so that the headers that the user wants to see are at +;; the end of the headers section so we can narrow to them. This +;; is done according to the preferences specified in +;; vm-visible-header and vm-invisible-header-regexp. The +;; vheaders field of the message struct is also set. This +;; function is called on demand whenever a vheaders field is +;; discovered to be nil for a particular message. +;; +;; If the message argument is nil, then we are operating on a +;; freestanding message that is not part of a folder buffer. The +;; keep-list and discard-regexp parameters are used in this case. +;; Headers not matched by the keep list or matched by the discard +;; list are stripped from the message. The remaining headers +;; are ordered according to the order of the keep list. + +;;;###autoload +(defun* vm-reorder-message-headers (message &optional + &key (keep-list nil) + (discard-regexp nil)) + (interactive + (progn + (goto-char (point-min)) + (list nil vm-mail-header-order "NO_MATCH_ON_HEADERS:"))) + (save-excursion + (when message + (with-current-buffer (vm-buffer-of message) + (setq keep-list vm-visible-headers + discard-regexp vm-invisible-header-regexp))) + (save-excursion + (save-restriction + (widen) + ;; if there is a cached regexp that points to the already + ;; ordered headers then use it and avoid a lot of work. + (if (and message (vm-vheaders-regexp-of message)) + (save-excursion + (goto-char (vm-headers-of message)) + (let ((case-fold-search t)) + (re-search-forward (vm-vheaders-regexp-of message) + (vm-text-of message) t)) + (vm-set-vheaders-of message (vm-marker (match-beginning 0)))) + ;; oh well, we gotta do it the hard way. + ;; + ;; header-alist will contain an assoc list version of + ;; keep-list. For messages associated with a folder + ;; buffer: when a matching header is found, the + ;; header's start and end positions are added to its + ;; corresponding assoc cell. The positions of unwanted + ;; headers are remember also so that they can be copied + ;; to the top of the message, to be out of sight after + ;; narrowing. Once the positions have all been + ;; recorded a new copy of the headers is inserted in + ;; the proper order and the old headers are deleted. + ;; + ;; For free standing messages, unwanted headers are + ;; stripped from the message, unremembered. + (vm-save-restriction + (let ((header-alist (vm-build-header-order-alist keep-list)) + (buffer-read-only nil) + (work-buffer nil) + (extras nil) + list end-of-header vheader-offset + (folder-buffer (current-buffer)) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock directory + ;; is on a slow device. We don't need locking here because + ;; in a mail context reordering headers is harmless. + (buffer-file-name nil) + (case-fold-search t) + (unwanted-list nil) + unwanted-tail + new-header-start + old-header-start + (old-buffer-modified-p (buffer-modified-p))) + (unwind-protect + (progn + (if message + (progn + ;; for babyl folders, keep an untouched + ;; copy of the headers between the + ;; attributes line and the *** EOOH *** + ;; line. + (if (and (eq vm-folder-type 'babyl) + (null (vm-babyl-frob-flag-of message))) + (progn + (goto-char (vm-start-of message)) + (forward-line 2) + (vm-set-babyl-frob-flag-of message t) + (insert-buffer-substring + (current-buffer) + (vm-headers-of message) + (1- (vm-text-of message))) + ;; Yep, messages can come in + ;; without the two newlines after + ;; the header section. + (if (not (eq (char-after (1- (point))) ?\n)) + (insert ?\n)))) + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (insert-buffer-substring + folder-buffer + (vm-headers-of message) + (vm-text-of message)) + (goto-char (point-min)))) + (setq old-header-start (point)) + ;; as we loop through the headers, skip >From + ;; lines. these can occur anywhere in the + ;; header section if the message has been + ;; manhandled by some dumb delivery agents + ;; (SCO and Solaris are the usual suspects.) + ;; it's a tough ol' world. + (while (progn (while (looking-at ">From ") + (forward-line)) + (and (not (= (following-char) ?\n)) + (vm-match-header))) + (setq end-of-header (vm-matched-header-end) + list (vm-match-ordered-header header-alist)) + ;; don't display/keep this header if + ;; keep-list not matched + ;; and discard-regexp is nil + ;; or + ;; discard-regexp is matched + (if (or (and (null list) (null discard-regexp)) + (and discard-regexp + (not (eq 'none discard-regexp)) + discard-regexp (looking-at discard-regexp))) + ;; delete the unwanted header if not doing + ;; work for a folder buffer, otherwise + ;; remember the start and end of the + ;; unwanted header so we can copy it + ;; later. + (if (not message) + (delete-region (point) end-of-header) + (if (null unwanted-list) + (setq unwanted-list + (cons (point) (cons end-of-header nil)) + unwanted-tail unwanted-list) + (if (= (point) (car (cdr unwanted-tail))) + (setcar (cdr unwanted-tail) + end-of-header) + (setcdr (cdr unwanted-tail) + (cons (point) + (cons end-of-header nil))) + (setq unwanted-tail (cdr (cdr unwanted-tail))))) + (goto-char end-of-header)) + ;; got a match + ;; stuff the start and end of the header + ;; into the cdr of the returned alist + ;; element. + (if list + ;; reverse point and end-of-header. + ;; list will be nreversed later. + (setcdr list (cons end-of-header + (cons (point) + (cdr list)))) + ;; reverse point and end-of-header. + ;; list will be nreversed later. + (setq extras + (cons end-of-header + (cons (point) extras)))) + (goto-char end-of-header))) + (setq new-header-start (point)) + (while unwanted-list + (insert-buffer-substring (current-buffer) + (car unwanted-list) + (car (cdr unwanted-list))) + (setq unwanted-list (cdr (cdr unwanted-list)))) + ;; remember the offset of where the visible + ;; header start so we can initialize the + ;; vm-vheaders-of field later. + (if message + (setq vheader-offset (- (point) new-header-start))) + (while header-alist + (setq list (nreverse (cdr (car header-alist)))) + (while list + (insert-buffer-substring (current-buffer) + (car list) + (car (cdr list))) + (setq list (cdr (cdr list)))) + (setq header-alist (cdr header-alist))) + ;; now the headers that were not explicitly + ;; undesirable, if any. + (setq extras (nreverse extras)) + (while extras + (insert-buffer-substring (current-buffer) + (car extras) + (car (cdr extras))) + (setq extras (cdr (cdr extras)))) + (delete-region old-header-start new-header-start) + ;; update the folder buffer if we're supposed to. + ;; lock out interrupts. + (if message + (let ((inhibit-quit t)) + (set-buffer (vm-buffer-of message)) + (goto-char (vm-headers-of message)) + (insert-buffer-substring work-buffer) + (delete-region (point) (vm-text-of message)) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))) + (when work-buffer (kill-buffer work-buffer))) + (if message + (progn + (vm-set-vheaders-of message + (vm-marker (+ (vm-headers-of message) + vheader-offset))) + ;; cache a regular expression that can be used to + ;; find the start of the reordered header the next + ;; time this folder is visited. + (goto-char (vm-vheaders-of message)) + (if (vm-match-header) + (vm-set-vheaders-regexp-of + message + (concat "^" (vm-matched-header-name) ":")))))))))))) + +;; Thunderbird source code files describing the status flags +;; http://mxr.mozilla.org/seamonkey/source/mailnews/base/public/nsMsgMessageFlags.h#45 +;; http://mxr.mozilla.org/seamonkey/source/mailnews/base/public/nsMsgMessageFlags.h#108 +;; Commentary here: +;; http://www.eyrich-net.org/mozilla/X-Mozilla-Status.html?en + +(defun vm-read-thunderbird-status (message) + (let (status) + (setq status (vm-get-header-contents message "X-Mozilla-Status:")) + (when status + (setq status (string-to-number status 16)) + ;; read flag + (vm-set-unread-flag-of message (= 0 (logand status #x0001))) + ;; answered flag + (vm-set-replied-flag-of message (not (= 0 (logand status #x0002)))) + ;; flagged flag + (vm-set-flagged-flag-of message (not (= 0 (logand status #x0004)))) + ;; deleted flag + (vm-set-deleted-flag-of message (not (= 0 (logand status #x0008)))) + ;; (unless (= 0 (logand status #x0010)) ; subject with "Re:" prefix + ;; nil) + ;; folded flag + (vm-set-folded-flag-of message (not (= 0 (logand status #x0020)))) + ;; (unless (= 0 (logand status #x0080)) ; offline article + ;; nil) + ;; watched flag + (vm-set-watched-flag-of message (not (= 0 (logand status #x0100)))) + ;; (unless (= 0 (logand status #x0200)) ; authenticated sender + ;; nil) + ;; (unless (= 0 (logand status #x0400)) ; remote POP article + ;; nil) + ;; (unless (= 0 (logand status #x0800)) ; queued + ;; nil) + ;; forwarded + (vm-set-forwarded-flag-of message (not (= 0 (logand status #x1000))))) + + (setq status (vm-get-header-contents message "X-Mozilla-Status2:")) + (when status + (if (> (length status) 4) + (progn + (setq status (substring status 0 -4)) ; ignore the last 4 hextets, + ; which are assumed to be 0000 + (setq status (string-to-number status 16))) + ;; handle badly formatted status strings written by older versions + (setq status (string-to-number status 16)) + (setq status (/ status #x1000))) + ;; new on the server + (vm-set-new-flag-of message (not (= 0 (logand status #x0001)))) + ;; ignored thread + (vm-set-ignored-flag-of message (not (= 0 (logand status #x0004)))) + ;; (unless (= 0 (logand status #x0020)) ; deleted on the server + ;; nil) + ;; read-receipt requested + (vm-set-read-receipt-flag-of message (not (= 0 (logand status #x0040)))) + ;; read-receipt sent + (vm-set-read-receipt-sent-flag-of message (not (logand status #x0080))) + ;; (unless (= 0 (logand status #x0100)) ; template + ;; nil) + ;; has attachments + (vm-set-attachments-flag-of message (not (= 0 (logand status #x1000)))) + ;; nil) + ;; (unless (= 0 (logand status #x0E00)) + ;; nil) + ;; FIXME care for message labels + ) + + (vm-mark-for-summary-update message) + (vm-set-stuff-flag-of message t))) + +(defun vm-read-attributes (message-list) + "Reads the message attributes and cached header information. + +Reads the message attributes and cached header information from the +header portion of the each message, if our X-VM- attributes header is +present. If the header is not present, assume the message is new, +unless we are being compatible with Berkeley Mail in which case we +also check for a Status header. + +If a message already has attributes don't bother checking the +headers. + +This function also discovers and stores the position where the +message text begins. + +Totals are gathered for use by vm-emit-totals-blurb. + +Supports version 4 format of attribute storage, for backward compatibility." + (save-excursion + (let ((mp (or message-list vm-message-list)) + (vm-new-count 0) + (vm-unread-count 0) + (vm-deleted-count 0) + (vm-total-count 0) + (modulus (+ (% (vm-abs (random)) 11) 25)) + (case-fold-search t) + oldpoint data cache) + (while mp + (vm-increment vm-total-count) + (if (vm-attributes-of (car mp)) + () + (goto-char (vm-headers-of (car mp))) + ;; find start of text section and save it + (search-forward "\n\n" (vm-text-end-of (car mp)) 0) + (vm-set-text-of (car mp) (point-marker)) + ;; now look for our header + (goto-char (vm-headers-of (car mp))) + (cond + ((re-search-forward vm-attributes-header-regexp + (vm-text-of (car mp)) t) + (goto-char (match-beginning 2)) + (condition-case () + (progn + (setq oldpoint (point) + data (read (current-buffer)) + cache (cadr data)) + (when (and (or (not (listp data)) (not (> (length data) 1))) + (not (vectorp data))) + (error "Bad x-vm-v5-data at %d in buffer %s: %S" + oldpoint (buffer-name) data) + (sit-for 1)) + data) + (error + (vm-warn 1 1 + "Bad x-vm-v5-data header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq data + (list + (make-vector vm-attributes-vector-length nil) + (make-vector vm-cached-data-vector-length nil) + nil)) + ;; In lieu of a valid attributes header + ;; assume the message is new. avoid + ;; vm-set-new-flag because it asks for a + ;; summary update. + (vm-set-new-flag-in-vector (car data) t))) + ;; support version 4 format + (cond ((vectorp data) + (setq data (vm-convert-v4-attributes data)) + ;; tink the message stuff flag so that if the + ;; user saves we get rid of the old v4 + ;; attributes header. otherwise we could be + ;; dealing with these things for all eternity. + (vm-set-stuff-flag-of (car mp) t)) + (t + ;; extend vectors if necessary to accomodate + ;; more caching and attributes without alienating + ;; other version 5 folders. + (cond ((< (length (car data)) + vm-attributes-vector-length) + ;; tink the message stuff flag so that if + ;; the user saves we get rid of the old + ;; short vector. otherwise we could be + ;; dealing with these things for all + ;; eternity. + (vm-set-stuff-flag-of (car mp) t) + (setcar data (vm-extend-vector + (car data) + vm-attributes-vector-length)))) + (cond ((< (length cache) + vm-cached-data-vector-length) + ;; tink the message stuff flag so that if + ;; the user saves we get rid of the old + ;; short vector. otherwise we could be + ;; dealing with these things for all + ;; eternity. + (vm-set-stuff-flag-of (car mp) t) + (setcar (cdr data) + (vm-extend-vector + cache + vm-cached-data-vector-length)) + (setq cache (cadr data)))))) + ;; data list might not be long enough for (nth 2 ...) but + ;; that's OK because nth returns nil if you overshoot the + ;; end of the list. + (unless (and (vectorp cache) + (= (length cache) vm-cached-data-vector-length) + (or (null (aref cache 7)) (stringp (aref cache 7))) + (or (null (aref cache 11)) (stringp (aref cache 11)))) + (vm-warn 0 2 "Bad VM cache data: %S" cache) + (vm-set-stuff-flag-of (car mp) t) + (setcar (cdr data) + (setq cache + (make-vector vm-cached-data-vector-length nil)))) + + (vm-set-labels-of (car mp) (nth 2 data)) + (vm-set-cached-data-of (car mp) cache) + (vm-set-attributes-of (car mp) (car data))) + ((and vm-berkeley-mail-compatibility + (re-search-forward vm-berkeley-mail-status-header-regexp + (vm-text-of (car mp)) t)) + (vm-set-cached-data-of + (car mp) (make-vector vm-cached-data-vector-length nil)) + (goto-char (match-beginning 1)) + (vm-set-attributes-of + (car mp) + (make-vector vm-attributes-vector-length nil)) + (vm-set-unread-flag (car mp) (not (looking-at ".*R.*")) 'norecord)) + (t + (vm-set-cached-data-of + (car mp) (make-vector vm-cached-data-vector-length nil)) + (vm-set-attributes-of + (car mp) + (make-vector vm-attributes-vector-length nil)) + ;; In lieu of a valid attributes header + ;; assume the message is new. avoid + ;; vm-set-new-flag because it asks for a + ;; summary update. + (vm-set-new-flag-of (car mp) t))) + ;; let babyl attributes override the normal VM + ;; attributes header. + (cond ((eq vm-folder-type 'babyl) + (vm-read-babyl-attributes (car mp)))) + ;; read the status flags of Thunderbird + (if vm-folder-read-thunderbird-status + (vm-read-thunderbird-status (car mp)))) + (cond ((vm-deleted-flag (car mp)) + (vm-increment vm-deleted-count)) + ((vm-new-flag (car mp)) + (vm-increment vm-new-count)) + ((vm-unread-flag (car mp)) + (vm-increment vm-unread-count))) + (if (zerop (% vm-total-count modulus)) + (vm-inform 6 "Reading attributes... %d" vm-total-count)) + (setq mp (cdr mp))) + (if (>= vm-total-count modulus) + (vm-inform 6 "Reading attributes... done")) + (if (null message-list) + (setq vm-totals (list vm-modification-counter + vm-total-count + vm-new-count + vm-unread-count + vm-deleted-count)))))) + +(defun vm-read-babyl-attributes (message) + (let ((case-fold-search t) + (labels nil) + (vect (make-vector vm-attributes-vector-length nil))) + (vm-set-attributes-of message vect) + (save-excursion + (goto-char (vm-start-of message)) + ;; skip past ^L\n + (forward-char 2) + (vm-set-babyl-frob-flag-of message (if (= (following-char) ?1) t nil)) + ;; skip past 0, + (forward-char 2) + ;; loop, noting attributes as we go. + (while (and (not (eobp)) (not (looking-at ","))) + (cond ((looking-at " unseen,") + (vm-set-unread-flag-of message t)) + ((looking-at " recent,") + (vm-set-new-flag-of message t)) + ((looking-at " deleted,") + (vm-set-deleted-flag-of message t)) + ((looking-at " answered,") + (vm-set-replied-flag-of message t)) + ((looking-at " forwarded,") + (vm-set-forwarded-flag-of message t)) + ((looking-at " filed,") + (vm-set-filed-flag-of message t)) + ((looking-at " redistributed,") + (vm-set-redistributed-flag-of message t)) + ;; only VM knows about these, as far as I know. + ((looking-at " edited,") + (vm-set-forwarded-flag-of message t)) + ((looking-at " written,") + (vm-set-forwarded-flag-of message t))) + (skip-chars-forward "^,") + (and (not (eobp)) (forward-char 1))) + (and (not (eobp)) (forward-char 1)) + (while (looking-at " \\([^\000-\040,\177-\377]+\\),") + (setq labels (cons (vm-buffer-substring-no-properties + (match-beginning 1) + (match-end 1)) + labels)) + (goto-char (match-end 0))) + (vm-set-labels-of message labels)))) + +(defun vm-set-default-attributes (message-list) + (let ((mp (or message-list vm-message-list)) attr access-method cache) + (while mp + (setq attr (make-vector vm-attributes-vector-length nil) + cache (make-vector vm-cached-data-vector-length nil)) + (vm-set-cached-data-of (car mp) cache) + (vm-set-attributes-of (car mp) attr) + ;; make message be new by default, but avoid vm-set-new-flag + ;; because it asks for a summary update for the message. + (vm-set-new-flag-of (car mp) t) + (vm-set-unread-flag-of (car mp) t) + (setq access-method (vm-message-access-method-of (car mp))) + (cond ((eq access-method 'imap) + (vm-imap-set-default-attributes (car mp))) + ((eq access-method 'pop) + (vm-pop-set-default-attributes (car mp)))) + ;; since this function is usually called in lieu of reading + ;; attributes from the buffer, the buffer attributes may be + ;; untrustworthy. tink the message stuff flag to force the + ;; new attributes out if the user saves. + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp))))) + +(defun vm-compute-totals () + (save-excursion + (vm-select-folder-buffer) + (let ((mp vm-message-list) + (vm-new-count 0) + (vm-unread-count 0) + (vm-deleted-count 0) + (vm-total-count 0)) + (while mp + (vm-increment vm-total-count) + (cond ((vm-deleted-flag (car mp)) + (vm-increment vm-deleted-count)) + ((vm-new-flag (car mp)) + (vm-increment vm-new-count)) + ((vm-unread-flag (car mp)) + (vm-increment vm-unread-count))) + (setq mp (cdr mp))) + (setq vm-totals (list vm-modification-counter + vm-total-count + vm-new-count + vm-unread-count + vm-deleted-count))))) + +(defun vm-emit-totals-blurb () + (interactive) + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (not (equal (nth 0 vm-totals) vm-modification-counter)) + (vm-compute-totals)) + (if (equal (nth 1 vm-totals) 0) + (vm-inform 5 "No messages.") + (vm-inform 5 "%d message%s, %d new, %d unread, %d deleted" + (nth 1 vm-totals) (if (= (nth 1 vm-totals) 1) "" "s") + (nth 2 vm-totals) + (nth 3 vm-totals) + (nth 4 vm-totals))))) + +(defun vm-convert-v4-attributes (data) + (list (apply 'vector + (nconc (vm-vector-to-list data) + (make-list (- vm-attributes-vector-length + (length data)) + nil))) + (make-vector vm-cached-data-vector-length nil))) + +(defun vm-gobble-last-modified () + (let ((case-fold-search t) + (time nil) + time lim oldpoint) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-last-modified-header-regexp lim t) + (condition-case () + (progn + (setq oldpoint (point) + time (read (current-buffer))) + (unless (consp time) + (error "Bad last-modified header at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + time ) + (error + (vm-warn 1 1 + "Bad last-modified header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq time '(0 0 0))))))) + time )) + +(defun vm-gobble-labels () + (let ((case-fold-search t) + lim) + (save-excursion + (vm-save-restriction + (widen) + (if (eq vm-folder-type 'babyl) + (progn + (goto-char (point-min)) + (vm-skip-past-folder-header) + (setq lim (point)) + (goto-char (point-min)) + (if (re-search-forward "^Labels:" lim t) + (let (string list) + (setq string (buffer-substring + (point) + (progn (end-of-line) (point))) + list (vm-parse string +"[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*")) + (mapc (function + (lambda (s) + (intern (downcase s) vm-label-obarray))) + list)))) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-labels-header-regexp lim t) + (let ((oldpoint (point)) + list) + (condition-case () + (progn + (setq list (read (current-buffer))) + (unless (listp list) + (error "Bad global label list at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + list ) + (error + (vm-warn 1 1 + "Bad global label list at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq list nil) )) + (vm-startup-apply-labels list)))))) + t )) + +(defun vm-startup-apply-labels (labels) + (mapcar (function (lambda (s) (intern s vm-label-obarray))) labels)) + +;; Go to the message specified in a bookmark and eat the bookmark. +;; Returns non-nil if successful, nil otherwise. +(defun vm-gobble-bookmark () + (let ((case-fold-search t) + (n nil) + lim oldpoint) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-bookmark-header-regexp lim t) + (condition-case () + (progn + (setq oldpoint (point) + n (read (current-buffer))) + (unless (natnump n) + (error "Bad bookmark at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + n ) + (error + (vm-warn 1 1 "Bad bookmark at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq n 1)))))) + (vm-startup-apply-bookmark n) + t )) + +(defun vm-startup-apply-bookmark (n) + (if n + (vm-record-and-change-message-pointer + vm-message-pointer + (nthcdr (1- n) vm-message-list)))) + +(defun vm-gobble-pop-retrieved () + (let ((case-fold-search t) + ob lim oldpoint) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-pop-retrieved-header-regexp lim t) + (condition-case () + (progn + (setq oldpoint (point) + ob (read (current-buffer))) + (unless (listp ob) + (error "Bad pop-retrieved header at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + (setq vm-pop-retrieved-messages ob)) + (error + (vm-warn 1 1 + "Bad pop-retrieved header at %d in buffer %s, ignoring" + oldpoint (buffer-name))))))) + t )) + +(defun vm-gobble-imap-retrieved () + (let ((case-fold-search t) + ob lim oldpoint) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-imap-retrieved-header-regexp lim t) + (condition-case () + (progn + (setq oldpoint (point) + ob (read (current-buffer))) + (unless (listp ob) + (error "Bad imap-retrieved header at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + (setq vm-imap-retrieved-messages ob)) + (error + (vm-warn 1 1 + "Bad imap-retrieved header at %d in buffer %s, ignoring" + oldpoint (buffer-name))))))) + t )) + +(defun vm-gobble-visible-header-variables () + (save-excursion + (vm-save-restriction + (let ((case-fold-search t) + lim) + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-vheader-header-regexp lim t) + (let (vis invis (got nil)) + (condition-case () + (setq vis (read (current-buffer)) + invis (read (current-buffer)) + got t) + (error nil)) + (if got + (vm-startup-apply-header-variables vis invis)))))))) + +(defun vm-startup-apply-header-variables (vis invis) + ;; if the variables don't match the values stored when this + ;; folder was saved, then we have to discard any cached + ;; vheader info so the user will see the right headers. + (and (or (not (equal vis vm-visible-headers)) + (not (equal invis vm-invisible-header-regexp))) + (let ((mp vm-message-list)) + (vm-inform 6 "Discarding visible header info...") + (while mp + (vm-set-vheaders-regexp-of (car mp) nil) + (vm-set-vheaders-of (car mp) nil) + (setq mp (cdr mp)))))) + +;; Read and delete the header that gives the folder's desired +;; message order. +(defun vm-gobble-message-order () + (let ((case-fold-search t) + lim order) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-message-order-header-regexp lim t) + (let ((oldpoint (point))) + (condition-case nil + (progn + (setq order (read (current-buffer))) + (unless (listp order) + (error "Bad order header at %d in buffer %s" + oldpoint (buffer-name)) + (sit-for 1)) + order ) + (error + (vm-warn 1 1 + "Bad order header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq order nil))) + (if order + (progn + (vm-inform 6 "Reordering messages...") + (vm-startup-apply-message-order order) + (vm-inform 6 "Reordering messages... done"))))))))) + +(defun vm-has-message-order () + (let ((case-fold-search t) + lim order) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (re-search-forward vm-message-order-header-regexp lim t))))) + +(defun vm-startup-apply-message-order (order) + (let (list-length v (mp vm-message-list)) + (setq list-length (length vm-message-list) + v (make-vector (max list-length (length order)) nil)) + (while (and order mp) + (condition-case nil + (aset v (1- (car order)) (car mp)) + (args-out-of-range nil)) + (setq order (cdr order) mp (cdr mp))) + ;; lock out interrupts while the message list is in + ;; an inconsistent state. + (let ((inhibit-quit t)) + (setq vm-message-list (delq nil (append v mp)) + vm-message-order-changed nil + vm-message-order-header-present t + vm-message-pointer (memq (car vm-message-pointer) + vm-message-list)) + (vm-set-numbering-redo-start-point t) + (vm-reverse-link-messages)))) + +;; Read the header that gives the folder's cached summary format +;; If the current summary format is different, then the cached +;; summary lines are discarded. +(defun vm-gobble-summary () + (let ((case-fold-search t) + summary lim) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-summary-header-regexp lim t) + (let ((oldpoint (point))) + (condition-case () + (setq summary (read (current-buffer))) + (error + (vm-warn 1 1 + "Bad summary header at %d in buffer %s, ignoring" + oldpoint (buffer-name)) + (setq summary ""))) + (vm-startup-apply-summary summary))))))) + +(defun vm-startup-apply-summary (summary) + (if (not (equal summary vm-summary-format)) + (if vm-restore-saved-summary-formats + (progn + (make-local-variable 'vm-summary-format) + (setq vm-summary-format summary)) + (let ((mp vm-message-list)) + (while mp + (vm-set-summary-of (car mp) nil) + ;; force restuffing of cache to clear old + ;; summary entry cache. + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp))))))) + +;; Add a X-VM-Storage header +(defun vm-add-storage-header (mp &rest args) + (save-excursion + (let ((buffer-read-only nil) + opoint) + (goto-char (vm-headers-of (car mp))) + (setq opoint (point)) + (insert-before-markers vm-storage-header " (") + (when args (insert-before-markers (format "%s" (car args)))) + (setq args (cdr args)) + (while args + (insert-before-markers (format " %s" (car args))) + (setq args (cdr args))) + (insert-before-markers ")\n") + (set-marker (vm-headers-of (car mp)) opoint)))) + + +;; This is now replaced by vm-mime-encode-words-in-cache-vector +;; +;; (defun vm-encode-words-in-cache-vector (list) +;; (vm-mapvector (lambda (e) +;; (if (stringp e) +;; (vm-mime-encode-words-in-string e) +;; e)) +;; list)) + +(defun vm-stuff-message-data (m &optional for-other-folder) + "Stuff the attributes, labels, soft and cached data of the +message M into the folder buffer. The optional argument +FOR-OTHER-FOLDER indicates <someting unknown>. USR 2010-03-06" + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (vm-mime-qp-encoder-program nil) ; use internal code + (vm-mime-base64-encoder-program nil) ; for speed + attributes cache + (case-fold-search t) + (buffer-read-only nil) + ;; don't truncate the printing of large Lisp objects + (print-length nil) + opoint + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (delflag (vm-deleted-flag m))) + (unwind-protect + (progn + ;; don't put this folder's summary entry into another folder. + (if for-other-folder + (vm-set-summary-of m nil) + (if (vm-su-start-of m) + ;; fill the summary cache if it's not done already. + (vm-su-summary m))) + (setq attributes (vm-attributes-of m) + cache (vm-cached-data-of m)) + (when (and delflag for-other-folder) + (vm-set-deleted-flag-in-vector + (setq attributes (copy-sequence attributes)) nil)) + (when (eq vm-folder-type 'babyl) + (vm-stuff-babyl-attributes m for-other-folder)) + (when (eq vm-sync-thunderbird-status t) + (vm-stuff-thunderbird-status m)) + (goto-char (vm-headers-of m)) + (while (re-search-forward vm-attributes-header-regexp + (vm-text-of m) t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (vm-headers-of m)) + (setq opoint (point)) + (insert ; insert-before-markers? + vm-attributes-header " (" + (let ((print-escape-newlines t)) + (prin1-to-string attributes)) + "\n\t" + (let ((print-escape-newlines t)) + (prin1-to-string (vm-mime-encode-words-in-cache-vector cache))) + "\n\t" + (let ((print-escape-newlines t)) + (prin1-to-string (vm-labels-of m))) + ")\n") + (set-marker (vm-headers-of m) opoint) + (cond ((and (eq vm-folder-type 'From_) + vm-berkeley-mail-compatibility) + (goto-char (vm-headers-of m)) + (while (re-search-forward + vm-berkeley-mail-status-header-regexp + (vm-text-of m) t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (vm-headers-of m)) + (cond ((not (vm-new-flag m)) + (insert-before-markers + vm-berkeley-mail-status-header + (if (vm-unread-flag m) "" "R") + "O\n") + (set-marker (vm-headers-of m) opoint))))) + (if for-other-folder + (vm-set-stuff-flag-of m nil) ; same effect as VM 7.19 + (vm-set-stuff-flag-of m nil)) ; new + ) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +(defun vm-stuff-folder-data (&optional abort-if-input-pending quiet) + "Stuff the soft and cached data of all the messages that have the +stuff-flag set in the current folder. USR 2010-04-20" + (let ((newlist nil) mp len (n 0)) + ;; stuff the attributes of messages that need it. + ;; build a list of messages that need their attributes stuffed + (setq mp vm-message-list) + (while mp + (if (vm-stuff-flag-of (car mp)) + (setq newlist (cons (car mp) newlist))) + (setq mp (cdr mp))) + (when (and newlist (not quiet)) + (setq len (length newlist)) + (vm-inform 7 "%d message%s to stuff" len (if (= 1 len) "" "s"))) + ;; now sort the list by physical order so that we + ;; reduce the amount of gap motion induced by modifying + ;; the buffer. what we want to avoid is updating + ;; message 3, then 234, then 10, then 500, thus causing + ;; large chunks of memory to be copied repeatedly as + ;; the gap moves to accomodate the insertions. + (if (not quiet) + (vm-inform 6 "Ordering updates...")) + (let ((vm-key-functions '(vm-sort-compare-physical-order-r))) + (setq mp (sort newlist 'vm-sort-compare-xxxxxx))) + (while (and mp (or (not abort-if-input-pending) (not (input-pending-p)))) + (vm-stuff-message-data (car mp)) + (setq n (1+ n)) + (if (not quiet) + (vm-inform 6 "Stuffing %d%% complete..." (* (/ (+ n 0.0) len) 100))) + (setq mp (cdr mp))) + (if mp nil t))) + +;; we can be a bit lazy in this function since it's only called +;; from within vm-stuff-message-data. we don't worry about +;; restoring the modified flag, setting buffer-read-only, or +;; about not moving point. +(defun vm-stuff-babyl-attributes (m for-other-folder) + (goto-char (vm-start-of m)) + (forward-char 2) + (if (vm-babyl-frob-flag-of m) + (insert "1") + (insert "0")) + (delete-char 1) + (forward-char 1) + (if (looking-at "\\( [^\000-\040,\177-\377]+,\\)+") + (delete-region (match-beginning 0) (match-end 0))) + (if (vm-new-flag m) + (insert " recent, unseen,") + (if (vm-unread-flag m) + (insert " unseen,"))) + (if (and (not for-other-folder) (vm-deleted-flag m)) + (insert " deleted,")) + (if (vm-replied-flag m) + (insert " answered,")) + (if (vm-forwarded-flag m) + (insert " forwarded,")) + (if (vm-redistributed-flag m) + (insert " redistributed,")) + (if (vm-filed-flag m) + (insert " filed,")) + (if (vm-edited-flag m) + (insert " edited,")) + (if (vm-written-flag m) + (insert " written,")) + (forward-char 1) + (if (looking-at "\\( [^\000-\040,\177-\377]+,\\)+") + (delete-region (match-beginning 0) (match-end 0))) + (mapcar (function (lambda (label) (insert " " label ","))) + (vm-labels-of m))) + +(defun vm-babyl-attributes-string (m for-other-folder) + (concat + (if (vm-new-flag m) + " recent, unseen," + (if (vm-unread-flag m) + " unseen,")) + (if (and (not for-other-folder) (vm-deleted-flag m)) + " deleted,") + (if (vm-replied-flag m) + " answered,") + (if (vm-forwarded-flag m) + " forwarded,") + (if (vm-redistributed-flag m) + " redistributed,") + (if (vm-filed-flag m) + " filed,") + (if (vm-edited-flag m) + " edited,") + (if (vm-written-flag m) + " written,"))) + +(defun vm-babyl-labels-string (m) + (let ((list nil) + (labels (vm-labels-of m))) + (while labels + (setq list (cons "," (cons (car labels) (cons " " list))) + labels (cdr labels))) + (apply 'concat (nreverse list)))) + +(defun vm-stuff-virtual-message-data (message) + (let ((virtual (vm-virtual-message-p message)) + (real-m (vm-real-message-of message))) + (if (or (not virtual) (and virtual (vm-virtual-messages-of message))) + (with-current-buffer + (vm-buffer-of real-m) + (vm-stuff-message-data real-m))))) + +(defun vm-stuff-thunderbird-status (message) + (let (status status2 status2-hi status2-lo) + (setq status (vm-get-header-contents message "X-Mozilla-Status:")) + (if (not status) + (setq status 0) + (setq status (string-to-number status 16)) + ;; clear those bits we are using and keep others ... + (setq status (logand status (lognot (logior #x1 #x2 #x4 #x8 #x1000)))) + (goto-char (vm-headers-of message)) + (if (re-search-forward "^X-Mozilla-Status: [ 0-9A-Fa-f]+\n" + (vm-text-of message) t) + (delete-region (match-beginning 0) (match-end 0)))) + (setq status2 (vm-get-header-contents message "X-Mozilla-Status2:")) + (if (not status2) + (setq status2 0 + status2-hi 0 + status2-lo 0) + (if (> (length status2) 4) + (setq status2-hi (string-to-number (substring status2 0 -4) 16) + status2-lo (string-to-number (substring status2 -4 nil) 16)) + ;; handle badly fomatted status strings written by old + ;; versions + (setq status2 (string-to-number status2 16) + status2-hi (/ status2 #x1000) + status2-lo (mod status2 #x1000))) + ;; clear those bits we are using and keep others ... + (setq status2-hi (logand status2-hi (lognot (logior #x1)))) + (goto-char (vm-headers-of message)) + (if (re-search-forward "^X-Mozilla-Status2: [ 0-9A-Fa-f]+\n" + (vm-text-of message) t) + (delete-region (match-beginning 0) (match-end 0)))) + (unless (vm-unread-flag message) + (setq status (logior status #x1))) + (when (vm-replied-flag message) + (setq status (logior status #x2))) + (when (vm-flagged-flag message) + (setq status (logior status #x4))) + (when (vm-deleted-flag message) + (setq status (logior status #x8))) + (when (vm-folded-flag message) + (setq status (logior status #x0020))) + (when (vm-watched-flag message) + (setq status (logior status #x0100))) + (when (vm-forwarded-flag message) + (setq status (logior status #x1000))) + (when (vm-new-flag message) + (setq status2-hi (logior status2-hi #x0001))) + (when (vm-ignored-flag message) + (setq status2-hi (logior status2-hi #x0004))) + (when (vm-read-receipt-flag message) + (setq status2-hi (logior status2-hi #x0040))) + (when (vm-read-receipt-sent-flag message) + (setq status2-hi (logior status2-hi #x0080))) + (when (vm-attachments-flag message) + (setq status2-hi (logior status2-hi #x1000))) + (goto-char (vm-headers-of message)) + (insert (format "X-Mozilla-Status: %04x\n" status)) + (insert (format "X-Mozilla-Status2: %04x%04x\n" status2-hi status2-lo)))) + +(defun vm-stuff-labels () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; don't truncate the printing of large Lisp objects + (print-length nil) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + lim) + (if (eq vm-folder-type 'babyl) + (progn + (goto-char (point-min)) + (vm-skip-past-folder-header) + (delete-region (point) (point-min)) + (insert-before-markers (vm-folder-header vm-folder-type + vm-label-obarray)))) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (while (re-search-forward vm-labels-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-labels-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the summary header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-labels-header " " + (let ((print-escape-newlines t) + (list nil)) + (mapatoms (function + (lambda (sym) + (setq list (cons (symbol-name sym) list)))) + vm-label-obarray) + (prin1-to-string list)) + "\n") + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +;; Insert a bookmark into the first message in the folder. +(defun vm-stuff-bookmark () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + lim) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-bookmark-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-bookmark-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the bookmark header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-bookmark-header " " + (vm-number-of (car vm-message-pointer)) + "\n") + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +(defun vm-stuff-last-modified () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + lim) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-last-modified-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-last-modified-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the last-modified header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-last-modified-header " " + (prin1-to-string (current-time)) + "\n") + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +(defun vm-stuff-pop-retrieved () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + (print-length nil) + (p vm-pop-retrieved-messages) + (curbuf (current-buffer)) + lim) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-pop-retrieved-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-pop-retrieved-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the pop-retrieved header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-pop-retrieved-header) + (if (null p) + (insert " nil\n") + (insert "\n (\n") + (while p + (insert "\t") + (prin1 (car p) curbuf) + (insert "\n") + (setq p (cdr p))) + (insert " )\n")) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +(defun vm-stuff-imap-retrieved () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + (print-length nil) + (p vm-imap-retrieved-messages) + (curbuf (current-buffer)) + lim) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (if (re-search-forward vm-imap-retrieved-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-imap-retrieved-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the imap-retrieved header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-imap-retrieved-header) + (if (null p) + (insert " nil\n") + (insert "\n (\n") + (while p + (insert "\t") + (prin1 (car p) curbuf) + (insert "\n") + (setq p (cdr p))) + (insert " )\n")) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +;; Insert the summary format variable header into the first message. +(defun vm-stuff-summary () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; don't truncate the printing of large Lisp objects + (print-length nil) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil) + lim) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (while (re-search-forward vm-summary-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-summary-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This will cause the summary header + ;; to be visible if there are no non-visible headers, + ;; oh well, no way around this. + (insert vm-summary-header " " + (let ((print-escape-newlines t)) + (prin1-to-string vm-summary-format)) + "\n") + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +;; stuff the current values of the header variables for future messages. +(defun vm-stuff-header-variables () + (if vm-message-list + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + (print-escape-newlines t) + lim + ;; don't truncate the printing of large Lisp objects + (print-length nil) + (buffer-read-only nil) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (while (re-search-forward vm-vheader-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-vheader-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This header will be visible if there + ;; are no non-visible headers, oh well, no way around this. + (insert vm-vheader-header " " + (prin1-to-string vm-visible-headers) " " + (prin1-to-string vm-invisible-header-regexp) + "\n") + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +;; Insert a header into the first message of the folder that lists +;; the folder's message order. +(defun vm-stuff-message-order () + (if (cdr vm-message-list) + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + lim n + (buffer-read-only nil) + (mp (copy-sequence vm-message-list))) + (setq mp + (sort mp + (function + (lambda (p q) + (< (vm-start-of p) (vm-start-of q)))))) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-find-leading-message-separator) + (vm-skip-past-leading-message-separator) + (while (re-search-forward vm-message-order-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-message-order-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + ;; To insert or to insert-before-markers, that is the question. + ;; + ;; If we insert-before-markers we push a header behind + ;; vm-headers-of, which is clearly undesirable. So we + ;; just insert. This header will be visible if there + ;; are no non-visible headers, oh well, no way around this. + (insert vm-message-order-header "\n\t(") + (setq n 0) + (while mp + (insert (vm-number-of (car mp))) + (setq n (1+ n) mp (cdr mp)) + (and mp (insert + (if (zerop (% n 15)) + "\n\t " + " ")))) + (insert ")\n") + (setq vm-message-order-changed nil + vm-message-order-header-present t) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +;; Remove the message order header. +(defun vm-remove-message-order () + (if (cdr vm-message-list) + (save-excursion + (vm-save-restriction + (widen) + (let ((old-buffer-modified-p (buffer-modified-p)) + (case-fold-search t) + lim + ;; This prevents file locking from occuring. Disabling + ;; locking can speed things noticeably if the lock + ;; directory is on a slow device. We don't need locking + ;; here because the user shouldn't care about VM stuffing + ;; its own status headers. + (buffer-file-name nil) + (buffer-read-only nil)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (search-forward "\n\n" nil t) + (setq lim (point)) + (goto-char (point-min)) + (vm-skip-past-folder-header) + (vm-skip-past-leading-message-separator) + (while (re-search-forward vm-message-order-header-regexp lim t) + (progn (goto-char (match-beginning 0)) + (if (vm-match-header vm-message-order-header) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))))) + (setq vm-message-order-header-present nil) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))))))) + +(defun vm-make-index-file-name () + (concat (file-name-directory buffer-file-name) + "." + (file-name-nondirectory buffer-file-name) + vm-index-file-suffix)) + +(defun vm-read-index-file-maybe () + (catch 'done + (if (or (not (stringp buffer-file-name)) + (not (stringp vm-index-file-suffix))) + (throw 'done nil)) + (let* ((index-file (vm-make-index-file-name)) + (mtime-buffer (nth 5 (file-attributes buffer-file-name))) + (mtime-index (nth 5 (file-attributes index-file)))) + (if (and (file-readable-p index-file) + (>= (car mtime-index) (car mtime-buffer)) + (>= (car (cdr mtime-index)) (car (cdr mtime-buffer)))) + (vm-read-index-file index-file) + nil)))) + +(defun vm-read-index-file (index-file) + (catch 'done + (condition-case error-data + (let ((work-buffer nil)) + (unwind-protect + (let (obj attr-list cache-list location-list label-list + validity-check vis invis folder-type + bookmark summary labels pop-retrieved imap-retrieved order + v m (m-list nil) tail) + (vm-inform 5 "Reading index file...") + (setq work-buffer (vm-make-work-buffer)) + (with-current-buffer work-buffer + (insert-file-contents-literally index-file)) + (goto-char (point-min)) + + ;; check version + (setq obj (read work-buffer)) + (if (not (eq obj 1)) + (error "Unsupported index file version: %s" obj)) + + ;; folder type + (setq folder-type (read work-buffer)) + + ;; validity check + (setq validity-check (read work-buffer)) + (if (null (vm-check-index-file-validity validity-check)) + (throw 'done nil)) + + ;; bookmark + (setq bookmark (read work-buffer)) + + ;; message order + (setq order (read work-buffer)) + + ;; what summary format was used to produce the + ;; folder's summary cache line. + (setq summary (read work-buffer)) + + ;; folder-wide list of labels + (setq labels (read work-buffer)) + + ;; what vm-visible-headers / vm-invisible-header-regexp + ;; settings were used to order the headers and to + ;; produce the vm-headers-regexp-of slot value. + (setq vis (read work-buffer)) + (setq invis (read work-buffer)) + + ;; location offsets + ;; attributes list + ;; cache list + ;; label list + (setq location-list (read work-buffer)) + (setq attr-list (read work-buffer)) + (setq cache-list (read work-buffer)) + (setq label-list (read work-buffer)) + (while location-list + (setq v (car location-list) + m (vm-make-message)) + (if (null m-list) + (setq m-list (list m) + tail m-list) + (setcdr tail (list m)) + (setq tail (cdr tail))) + (vm-set-start-of m (vm-marker (aref v 0))) + (vm-set-headers-of m (vm-marker (aref v 1))) + (vm-set-text-end-of m (vm-marker (aref v 2))) + (vm-set-end-of m (vm-marker (aref v 3))) + (if (null attr-list) + (error "Attribute list is shorter than location list") + (setq v (car attr-list)) + (if (< (length v) vm-attributes-vector-length) + (setq v (vm-extend-vector + v vm-attributes-vector-length))) + (vm-set-attributes-of m v)) + (if (null cache-list) + (error "Cache list is shorter than location list") + (setq v (car cache-list)) + (if (< (length v) vm-cached-data-vector-length) + (setq v (vm-extend-vector v vm-cached-data-vector-length))) + (vm-set-cached-data-of m v)) + (if (null label-list) + (error "Label list is shorter than location list") + (vm-set-labels-of m (car label-list))) + (setq location-list (cdr location-list) + attr-list (cdr attr-list) + cache-list (cdr cache-list) + label-list (cdr label-list))) + + ;; pop retrieved messages + (setq pop-retrieved (read work-buffer)) + + ;; imap retrieved messages + (setq imap-retrieved (read work-buffer)) + + (setq vm-message-list m-list + vm-folder-type folder-type + vm-pop-retrieved-messages pop-retrieved + vm-imap-retrieved-messages imap-retrieved) + + (vm-startup-apply-bookmark bookmark) + (and order (vm-startup-apply-message-order order)) + (if vm-summary-show-threads + (progn + ;; get numbering of new messages done now + ;; so that the sort code only has to worry about the + ;; changes it needs to make. + (vm-update-summary-and-mode-line) + (vm-sort-messages (or vm-ml-sort-keys "activity")))) + (vm-startup-apply-summary summary) + (vm-startup-apply-labels labels) + (vm-startup-apply-header-variables vis invis) + + (vm-inform 5 "Reading index file... done") + t ) + (and work-buffer (kill-buffer work-buffer)))) + (error (vm-warn 1 2 "Index file read of %s signaled: %s" + index-file error-data) + (vm-warn 1 2 "Ignoring index file..."))))) + +(defun vm-check-index-file-validity (blob) + (save-excursion + (widen) + (catch 'done + (cond ((not (consp blob)) + (error "Validity check object not a cons: %s" blob)) + ((eq (car blob) 'file) + (let (ch time time2) + (setq blob (cdr blob)) + (setq time (car blob) + time2 (vm-gobble-last-modified)) + (if (and time2 (> 0 (vm-time-difference time time2))) + (throw 'done nil)) + (setq blob (cdr blob)) + (while blob + (setq ch (char-after (car blob))) + (if (or (null ch) (not (eq (vm-char-to-int ch) (nth 1 blob)))) + (throw 'done nil)) + (setq blob (cdr (cdr blob))))) + t ) + (t (error "Unknown validity check type: %s" (car blob))))))) + +(defun vm-generate-index-file-validity-check () + (save-restriction + (widen) + (let ((step (max 1 (/ (point-max) 11))) + (pos (1- (point-max))) + (lim (point-min)) + (blob nil)) + (while (>= pos lim) + (setq blob (cons pos (cons (vm-char-to-int (char-after pos)) blob)) + pos (- pos step))) + (cons 'file (cons (current-time) blob))))) + +(defun vm-write-index-file-maybe () + (catch 'done + (if (not (stringp buffer-file-name)) + (throw 'done nil)) + (if (not (stringp vm-index-file-suffix)) + (throw 'done nil)) + (let ((index-file (vm-make-index-file-name))) + (vm-write-index-file index-file)))) + +(defun vm-write-index-file (index-file) + (let ((work-buffer nil)) + (unwind-protect + (let ((print-escape-newlines t) + (print-length nil) + m-list mp m) + (vm-inform 6 "Sorting for index file...") + (setq m-list (sort (copy-sequence vm-message-list) + (function vm-sort-compare-physical-order))) + (vm-inform 6 "Stuffing index file...") + (setq work-buffer (vm-make-work-buffer)) + + (princ ";; index file version\n" work-buffer) + (prin1 1 work-buffer) + (terpri work-buffer) + + (princ ";; folder type\n" work-buffer) + (prin1 vm-folder-type work-buffer) + (terpri work-buffer) + + (princ + ";; timestamp + sample of folder bytes for consistency check\n" + work-buffer) + (prin1 (vm-generate-index-file-validity-check) work-buffer) + (terpri work-buffer) + + (princ ";; bookmark\n" work-buffer) + (princ (if vm-message-pointer + (vm-number-of (car vm-message-pointer)) + "1") + work-buffer) + (terpri work-buffer) + + (princ ";; message order\n" work-buffer) + (let ((n 0) (mp vm-message-list)) + (princ "(" work-buffer) + (setq n 0) + (while mp + (if (zerop (% n 15)) + (princ "\n\t" work-buffer) + (princ " " work-buffer)) + (princ (vm-number-of (car mp)) work-buffer) + (setq n (1+ n) mp (cdr mp))) + (princ "\n)\n" work-buffer)) + + (princ ";; summary\n" work-buffer) + (prin1 vm-summary-format work-buffer) + (terpri work-buffer) + + (princ ";; labels used in this folder\n" work-buffer) + (let ((list nil)) + (mapatoms (function + (lambda (sym) + (setq list (cons (symbol-name sym) list)))) + vm-label-obarray) + (prin1 list work-buffer)) + (terpri work-buffer) + + (princ ";; visible headers\n" work-buffer) + (prin1 vm-visible-headers work-buffer) + (terpri work-buffer) + + (princ ";; hidden headers\n" work-buffer) + (prin1 vm-invisible-header-regexp work-buffer) + (terpri work-buffer) + + (princ ";; location list\n" work-buffer) + (princ "(\n" work-buffer) + (setq mp m-list) + (while mp + (setq m (car mp)) + (princ " [" work-buffer) + (prin1 (marker-position (vm-start-of m)) work-buffer) + (princ " " work-buffer) + (prin1 (marker-position (vm-headers-of m)) work-buffer) + (princ " " work-buffer) + (prin1 (marker-position (vm-text-end-of m)) work-buffer) + (princ " " work-buffer) + (prin1 (marker-position (vm-end-of m)) work-buffer) + (princ "]\n" work-buffer) + (setq mp (cdr mp))) + (princ ")\n" work-buffer) + (princ ";; attribute list\n" work-buffer) + (princ "(\n" work-buffer) + (setq mp m-list) + (while mp + (setq m (car mp)) + (princ " " work-buffer) + (prin1 (vm-attributes-of m) work-buffer) + (princ "\n" work-buffer) + (setq mp (cdr mp))) + (princ ")\n" work-buffer) + (princ ";; cache list\n" work-buffer) + (princ "(\n" work-buffer) + (setq mp m-list) + (while mp + (setq m (car mp)) + (princ " " work-buffer) + (prin1 (vm-cached-data-of m) work-buffer) + (princ "\n" work-buffer) + (setq mp (cdr mp))) + (princ ")\n" work-buffer) + (princ ";; labels list\n" work-buffer) + (princ "(\n" work-buffer) + (setq mp m-list) + (while mp + (setq m (car mp)) + (princ " " work-buffer) + (prin1 (vm-labels-of m) work-buffer) + (princ "\n" work-buffer) + (setq mp (cdr mp))) + (princ ")\n" work-buffer) + (princ ";; retrieved POP messages\n" work-buffer) + (let ((p vm-pop-retrieved-messages)) + (if (null p) + (princ "nil\n" work-buffer) + (princ "(\n" work-buffer) + (while p + (princ "\t" work-buffer) + (prin1 (car p) work-buffer) + (princ "\n" work-buffer) + (setq p (cdr p))) + (princ ")\n" work-buffer))) + (princ ";; retrieved IMAP messages\n" work-buffer) + (let ((p vm-imap-retrieved-messages)) + (if (null p) + (princ "nil\n" work-buffer) + (princ "(\n" work-buffer) + (while p + (princ "\t" work-buffer) + (prin1 (car p) work-buffer) + (princ "\n" work-buffer) + (setq p (cdr p))) + (princ ")\n" work-buffer))) + + (princ ";; end of index file\n" work-buffer) + + (vm-inform 6 "Writing index file...") + (catch 'done + (with-current-buffer work-buffer + (condition-case data + (let ((coding-system-for-write (vm-binary-coding-system)) + (selective-display nil)) + (write-region (point-min) (point-max) index-file)) + (error + (vm-warn 1 2 "Write of %s signaled: %s" index-file data) + (throw 'done nil)))) + (vm-error-free-call 'set-file-modes index-file (vm-octal 600)) + (vm-inform 6 "Writing index file... done") + t )) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-delete-index-file () + (if (stringp vm-index-file-suffix) + (let ((index-file (vm-make-index-file-name))) + (vm-error-free-call 'delete-file index-file)))) + +(defun vm-change-all-new-to-unread () + (let ((mp vm-message-list)) + (while mp + (if (vm-new-flag (car mp)) + (progn + (vm-set-new-flag (car mp) nil) + (vm-set-unread-flag (car mp) t))) + (setq mp (cdr mp))))) + +;;;###autoload +(defun vm-mark-message-unread (&optional count) + "Mark the current message as unread. If the message is already +new or unread, then it is left unchanged. + +Numeric prefix argument N means to mark the current message plus +the next N-1 messages as unread. A negative N means mark the +current message and the previous N-1 messages as unread. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages are affected, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are affected." + (interactive "p") + (or count (setq count 1)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Unread"))) + (while mlist + (if (and (not (vm-unread-flag (car mlist))) + (not (vm-new-flag (car mlist)))) + (vm-set-unread-flag (car mlist) t)) + (setq mlist (cdr mlist)))) + (vm-display nil nil '(vm-mark-message-unread) '(vm-mark-message-unread)) + (vm-update-summary-and-mode-line)) +(defalias 'vm-unread-message 'vm-mark-message-unread) +(defalias 'vm-flag-message-unread 'vm-mark-message-unread) +(make-obsolete 'vm-flag-message-unread + 'vm-mark-message-unread "8.2.0") + +;;;###autoload +(defun vm-mark-message-read (&optional count) + "Mark the current message as read, i.e., set the `unread' and `new' +attributes to nil. If the message is already marked as read, then +it is left unchanged. + +Numeric prefix argument N means to unread the current message plus the +next N-1 messages. A negative N means mark the current message and +the previous N-1 messages as read. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages are affected, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are affected." + (interactive "p") + (or count (setq count 1)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Mark as read"))) + (while mlist + (when (or (vm-unread-flag (car mlist)) + (vm-new-flag (car mlist))) + (vm-set-unread-flag (car mlist) nil) + (vm-set-new-flag (car mlist) nil)) + (setq mlist (cdr mlist)))) + (vm-display nil nil '(vm-mark-message-read) '(vm-mark-message-read)) + (vm-update-summary-and-mode-line)) +(defalias 'vm-flag-message-read 'vm-mark-message-read) +(make-obsolete 'vm-flag-message-read + 'vm-mark-message-read "8.2.0") + + +;;;###autoload +(defun vm-quit-just-bury () + "Bury the current VM folder and summary buffers. +The folder is not altered and Emacs is still visiting it. You +can switch back to it with switch-to-buffer or by using the +Buffer Menu." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (not (memq major-mode '(vm-mode vm-virtual-mode))) + (error "%s must be invoked from a VM buffer." this-command)) + + (save-excursion (run-hooks 'vm-quit-hook)) + + (vm-garbage-collect-message) + + (vm-display nil nil '(vm-quit-just-bury) + '(vm-quit-just-bury quitting)) + (if vm-summary-buffer + (vm-display vm-summary-buffer nil nil nil)) + (if vm-summary-buffer + (vm-bury-buffer vm-summary-buffer)) + (if vm-presentation-buffer-handle + (vm-display vm-presentation-buffer-handle nil nil nil)) + (if vm-presentation-buffer-handle + (vm-bury-buffer vm-presentation-buffer-handle)) + (vm-display (current-buffer) nil nil nil) + (vm-bury-buffer (current-buffer))) + +;;;###autoload +(defun vm-quit-just-iconify () + "Iconify the frame and bury the current VM folder and summary buffers. +The folder is not altered and Emacs is still visiting it." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (not (memq major-mode '(vm-mode vm-virtual-mode))) + (error "%s must be invoked from a VM buffer." this-command)) + + (save-excursion (run-hooks 'vm-quit-hook)) + + (vm-garbage-collect-message) + + (vm-display nil nil '(vm-quit-just-iconify) + '(vm-quit-just-iconify quitting)) + (let ((summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle)) + (vm-bury-buffer (current-buffer)) + (if summary-buffer + (vm-bury-buffer summary-buffer)) + (if pres-buffer + (vm-bury-buffer pres-buffer)) + (vm-iconify-frame))) + +;;;###autoload +(defun vm-quit-no-change () + "Quit visiting the current folder without saving changes made to the folder." + (interactive) + (vm-quit t t)) + +;;;###autoload +(defun vm-quit-no-expunge () + "Quit visiting the current folder without expunging deleted +messages. + +The setting of `vm-expunge-before-quit' is ignored." + (interactive) + (vm-quit t nil)) + +(defvar dired-listing-switches) ; defined only in FSF Emacs? + +;;;###autoload +(defun vm-quit (&optional no-expunge no-change) + "Quit visiting the current folder, saving changes. + +If the customization variable `vm-expunge-before-quit' is set to + non-nil value then deleted messages are expunged. + +Giving a prefix argument overrides the variable and no expunge is done." + (interactive "P") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (not (memq major-mode '(vm-mode vm-virtual-mode))) + (error "%s must be invoked from a VM buffer." this-command)) + (vm-display nil nil '(vm-quit vm-quit-no-change vm-quit-no-expunge) + (list this-command 'quitting)) + (let ((virtual (eq major-mode 'vm-virtual-mode)) + (process nil)) + (cond + ((and (not virtual) no-change (buffer-modified-p) + (or buffer-file-name buffer-offer-save) + (not (zerop vm-messages-not-on-disk)) + ;; Folder may have been saved with C-x C-s and attributes may have + ;; been changed after that; in that case vm-messages-not-on-disk + ;; would not have been zeroed. However, all modification flag + ;; undos are cleared if VM actually modifies the folder buffer + ;; (as opposed to the folder's attributes), so this can be used + ;; to verify that there are indeed unsaved messages. + (null (assq 'vm-set-buffer-modified-p vm-undo-record-list)) + (not + (y-or-n-p + (format + "%d message%s have not been saved to disk, quit anyway? " + vm-messages-not-on-disk + (if (= 1 vm-messages-not-on-disk) "" "s"))))) + (error "Aborted")) + ((and (not virtual) + no-change + (or buffer-file-name buffer-offer-save) + (buffer-modified-p) + vm-confirm-quit + (not (y-or-n-p "There are unsaved changes, quit anyway? "))) + (error "Aborted")) + ((and (eq vm-confirm-quit t) + (not (y-or-n-p "Do you really want to quit? "))) + (error "Aborted"))) + + (save-excursion (run-hooks 'vm-quit-hook)) + + (when (and vm-expunge-before-quit + (not no-expunge) + (not no-change) + (buffer-modified-p)) + (vm-expunge-folder)) + + (vm-garbage-collect-message) + (vm-garbage-collect-folder) + + (unless (or no-change virtual) + ;; this could take a while, so give the user some feedback + (vm-inform 5 "Quitting...") + (unless (or vm-folder-read-only (eq major-mode 'vm-virtual-mode)) + (vm-change-all-new-to-unread))) + (when (and (buffer-modified-p) + (or buffer-file-name buffer-offer-save) + (not no-change) + (not virtual)) + (vm-save-folder)) + + (vm-virtual-quit no-expunge no-change) + + (cond ((and (eq vm-folder-access-method 'pop) + (setq process (vm-folder-pop-process))) + (vm-pop-end-session process)) + ((and (eq vm-folder-access-method 'imap) + (setq process (vm-folder-imap-process))) + (vm-imap-end-session process)) + ) + (message "") ; why this? USR, 2010-05-03 + (let ((summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle) + (mail-buffer (current-buffer))) + (if summary-buffer + (progn + (vm-display summary-buffer nil nil nil) + (kill-buffer summary-buffer))) + (if pres-buffer + (progn + (vm-display pres-buffer nil nil nil) + (kill-buffer pres-buffer))) + (set-buffer mail-buffer) + (vm-display mail-buffer nil nil nil) + ;; vm-display is not supposed to change the current buffer. + ;; still it's better to be safe here. + (set-buffer mail-buffer) + ;; if folder is selected in the folders summary, force + ;; selcetion of some other folder. + (if buffer-file-name + (vm-mark-for-folders-summary-update buffer-file-name)) + (vm-delete-auto-save-file-if-necessary) + ;; this is a hack to suppress another confirmation dialogue + ;; coming from kill-buffer + (set-buffer-modified-p nil) ; folder buffer + (kill-buffer (current-buffer))) + (vm-update-summary-and-mode-line))) + +(defun vm-start-itimers-if-needed () + (cond ((and (not (natnump vm-flush-interval)) + (not (natnump vm-auto-get-new-mail)) + (not (natnump vm-mail-check-interval)))) + ((condition-case data + (progn (require 'itimer) t) + (error nil)) + (when (and (natnump vm-flush-interval) (not (get-itimer "vm-flush"))) + ;; name function time restart-time + ;; ...... idle with-args args + (start-itimer "vm-flush" 'vm-flush-itimer-function + vm-flush-interval nil)) + (when (and (natnump vm-auto-get-new-mail) + (not (get-itimer "vm-get-mail"))) + (start-itimer "vm-get-mail" 'vm-get-mail-itimer-function + vm-auto-get-new-mail nil)) + (when (and (natnump vm-mail-check-interval) + (not (get-itimer "vm-check-mail"))) + (start-itimer "vm-check-mail" 'vm-check-mail-itimer-function + vm-mail-check-interval nil))) + ((condition-case data + (progn (require 'timer) t) + (error nil)) + (let (timer) + (when (and (natnump vm-flush-interval) + (not (vm-timer-using 'vm-flush-itimer-function)) + (setq timer + ;; time restart-time function args + (run-at-time vm-flush-interval vm-flush-interval + 'vm-flush-itimer-function nil))) + (timer-set-function timer 'vm-flush-itimer-function + (list timer))) + (when (and (natnump vm-mail-check-interval) + (not (vm-timer-using 'vm-check-mail-itimer-function)) + (setq timer + (run-at-time vm-mail-check-interval + vm-mail-check-interval + 'vm-check-mail-itimer-function nil))) + (timer-set-function timer 'vm-check-mail-itimer-function + (list timer))) + (when (and (natnump vm-auto-get-new-mail) + (not (vm-timer-using 'vm-get-mail-itimer-function)) + (setq timer + (run-at-time vm-auto-get-new-mail + vm-auto-get-new-mail + 'vm-get-mail-itimer-function nil))) + (timer-set-function timer 'vm-get-mail-itimer-function + (list timer))))) + (t + (setq vm-flush-interval t + vm-auto-get-new-mail t)))) + +(defvar timer-list) +(defun vm-timer-using (fun) + (let ((p timer-list) + (done nil)) + (while (and p (not done)) + (if (eq (aref (car p) 5) fun) + (setq done t) + (setq p (cdr p)))) + p )) + +(defvar current-itimer) + +;; support for vm-mail-check-interval +;; if timer argument is present, this means we're using the Emacs +;; 'timer package rather than the 'itimer package. +(defun vm-check-mail-itimer-function (&optional timer) + ;; FSF Emacs sets this non-nil, which means the user can't + ;; interrupt the check. Bogus. + (setq inhibit-quit nil) + (if (integerp vm-mail-check-interval) + (if timer + (timer-set-time + timer + (timer-relative-time (current-time) vm-mail-check-interval) + vm-mail-check-interval) + (set-itimer-restart current-itimer vm-mail-check-interval)) + ;; user has changed the variable value to something that + ;; isn't a number, make the timer go away. + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil))) + (let ((b-list (buffer-list)) + (found-one nil) + oldval) + (save-excursion + (while (and (not (input-pending-p)) b-list) + (when (buffer-live-p (car b-list)) + (set-buffer (car b-list)) + (when (and (eq major-mode 'vm-mode) + (setq found-one t) + (or (not vm-spooled-mail-waiting) + vm-mail-check-always) + ;; to avoid reentrance into the pop and imap code + (not vm-global-block-new-mail)) + (setq oldval vm-spooled-mail-waiting) + (setq vm-spooled-mail-waiting (vm-check-for-spooled-mail nil t)) + (unless (eq oldval vm-spooled-mail-waiting) + (intern (buffer-name) vm-buffers-needing-display-update) + (run-hooks 'vm-spooled-mail-waiting-hook)))) + (setq b-list (cdr b-list)))) + (vm-update-summary-and-mode-line) + ;; make the timer go away if we didn't encounter a vm-mode buffer. + (when (and (not found-one) (null b-list)) + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil))))) + +;; support for numeric vm-auto-get-new-mail +;; if timer argument is present, this means we're using the Emacs +;; 'timer package rather than the 'itimer package. +(defun vm-get-mail-itimer-function (&optional timer) + ;; FSF Emacs sets this non-nil, which means the user can't + ;; interrupt mail retrieval. Bogus. + (setq inhibit-quit nil) + (if (integerp vm-auto-get-new-mail) + (if timer + (timer-set-time + timer + (timer-relative-time (current-time) vm-auto-get-new-mail) + vm-auto-get-new-mail) + (set-itimer-restart current-itimer vm-auto-get-new-mail)) + ;; user has changed the variable value to something that + ;; isn't a number, make the timer go away. + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil))) + (let ((b-list (buffer-list)) + (found-one nil)) + (while (and (not (input-pending-p)) b-list) + (save-excursion + (when (buffer-live-p (car b-list)) + (set-buffer (car b-list)) + (when (and (eq major-mode 'vm-mode) + (setq found-one t) + (not vm-global-block-new-mail) + (not vm-block-new-mail) + (not vm-folder-read-only) + (not (and (not (buffer-modified-p)) + buffer-file-name + (file-newer-than-file-p + (make-auto-save-file-name) + buffer-file-name))) + (vm-get-spooled-mail nil)) + ;; don't move the message pointer unless the folder + ;; was empty. + (if (and (null vm-message-pointer) + (vm-thoughtfully-select-message)) + (vm-present-current-message) + (vm-update-summary-and-mode-line))))) + (setq b-list (cdr b-list))) + ;; make the timer go away if we didn't encounter a vm-mode buffer. + (when (and (not found-one) (null b-list)) + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil))))) + +;; support for numeric vm-flush-interval +;; if timer argument is present, this means we're using the Emacs +;; 'timer package rather than the 'itimer package. +(defun vm-flush-itimer-function (&optional timer) + (when (integerp vm-flush-interval) + (if timer + (timer-set-time + timer + (timer-relative-time (current-time) vm-flush-interval) + vm-flush-interval) + (set-itimer-restart current-itimer vm-flush-interval))) + ;; if no vm-mode buffers are found, we might as well shut down the + ;; flush itimer. + (unless (vm-flush-cached-data) + (if timer + (cancel-timer timer) + (set-itimer-restart current-itimer nil)))) + +;; flush cached data in all vm-mode buffers. +;; returns non-nil if any vm-mode buffers were found. +(defun vm-flush-cached-data () + (save-excursion + (let ((buf-list (buffer-list)) + (found-one nil)) + (while (and buf-list (not (input-pending-p))) + (if (not (buffer-live-p (car buf-list))) + nil + (set-buffer (car buf-list)) + (cond ((and (eq major-mode 'vm-mode) vm-message-list) + (setq found-one t) + (if (not (eq vm-modification-counter + vm-flushed-modification-counter)) + (progn + (vm-stuff-last-modified) + (vm-stuff-pop-retrieved) + (vm-stuff-imap-retrieved) + (vm-stuff-summary) + (vm-stuff-labels) + (and vm-message-order-changed + (vm-stuff-message-order)) + (and (vm-stuff-folder-data t t) + (setq vm-flushed-modification-counter + vm-modification-counter))))))) + (setq buf-list (cdr buf-list))) + ;; if we haven't checked them all return non-nil so + ;; the flusher won't give up trying. + (or buf-list found-one) ))) + +;; This allows C-x C-s to do the right thing for VM mail buffers. +;; Note that deleted messages are not expunged. +(defun vm-write-file-hook () + (if (and (eq major-mode 'vm-mode) (not vm-inhibit-write-file-hook)) + ;; The vm-save-restriction isn't really necessary here, since + ;; the stuff routines clean up after themselves, but should remain + ;; as a safeguard against the time when other stuff is added here. + (vm-save-restriction + (let ((buffer-read-only)) + (vm-discard-fetched-messages) + (vm-inform 6 "Stuffing cached data...") + (vm-stuff-folder-data nil) + (vm-inform 6 "Stuffing cached data... done") + (if vm-message-list + (progn + (if (and vm-folders-summary-database buffer-file-name) + (progn + (vm-compute-totals) + (vm-store-folder-totals buffer-file-name (cdr vm-totals)))) + ;; get summary cache up-to-date + (vm-inform 6 "Stuffing folder data...") + (vm-update-summary-and-mode-line) + (vm-stuff-bookmark) + (vm-stuff-pop-retrieved) + (vm-stuff-imap-retrieved) + (vm-stuff-last-modified) + (vm-stuff-header-variables) + (vm-stuff-labels) + (vm-stuff-summary) + (and vm-message-order-changed + (vm-stuff-message-order)) + (vm-inform 6 "Stuffing folder data... done"))) + nil )))) + +;;;###autoload +(defun vm-save-buffer (prefix) + ;; This function hasn't been documented. Not clear why it is + ;; different from vm-save-folder. USR, 2011-04-27 + (interactive "P") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (save-buffer prefix) + (intern (buffer-name) vm-buffers-needing-display-update) + (setq vm-block-new-mail nil) + (vm-display nil nil '(vm-save-buffer) '(vm-save-buffer)) + (if (and vm-folders-summary-database buffer-file-name) + (progn + (vm-compute-totals) + (vm-store-folder-totals buffer-file-name (cdr vm-totals)))) + (vm-update-summary-and-mode-line) + (vm-write-index-file-maybe)) + +;;;###autoload +(defun vm-write-file () + ;; This function hasn't been documented. Not clear what it does. + ;; USR, 2011-04-27 + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (let ((old-buffer-name (buffer-name)) + (oldmodebits (and (fboundp 'default-file-modes) + (default-file-modes)))) + (unwind-protect + (save-excursion + (and oldmodebits (set-default-file-modes + vm-default-folder-permission-bits)) + (call-interactively 'write-file)) + (and oldmodebits (set-default-file-modes oldmodebits))) + (if (and vm-folders-summary-database buffer-file-name) + (progn + (vm-compute-totals) + (vm-store-folder-totals buffer-file-name (cdr vm-totals)))) + (if (not (equal (buffer-name) old-buffer-name)) + (progn + (vm-check-for-killed-summary) + (if vm-summary-buffer + (save-excursion + (let ((name (buffer-name))) + (set-buffer vm-summary-buffer) + (rename-buffer (format "%s Summary" name) t)))) + (vm-check-for-killed-presentation) + (if vm-presentation-buffer-handle + (save-excursion + (let ((name (buffer-name))) + (set-buffer vm-presentation-buffer-handle) + (rename-buffer (format "%s Presentation" name) t))))))) + (intern (buffer-name) vm-buffers-needing-display-update) + (setq vm-block-new-mail nil) + (vm-display nil nil '(vm-write-file) '(vm-write-file)) + (vm-update-summary-and-mode-line) + (vm-write-index-file-maybe)) + +(defun vm-unblock-new-mail () + (setq vm-block-new-mail nil)) + +;;;###autoload +(defun vm-save-folder-no-expunge (&optional prefix) + "Save current folder to disk. +Prefix arg is handled the same as for the command `save-buffer'. + +Deleted messages are _not_ expunged irrespective of the variable +`vm-expunge-before-save'. + +When applied to a virtual folder, this command runs itself on +each of the underlying real folders associated with the virtual +folder." + (interactive (list current-prefix-arg)) + (let ((vm-expunge-before-save nil)) + (vm-save-folder prefix))) + + +;;;###autoload +(defun vm-save-folder (&optional prefix) + "Save current folder to disk. +Prefix arg is handled the same as for the command `save-buffer'. + +If the customization variable `vm-expunge-before-save' is set to +non-nil value then deleted messages are expunged. + +When applied to a virtual folder, this command runs itself on +each of the underlying real folders associated with the virtual +folder." + (interactive (list current-prefix-arg)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-save-folder) '(vm-save-folder)) + (if (eq major-mode 'vm-virtual-mode) + (vm-virtual-save-folder prefix) + (if (buffer-modified-p) + (let (mp (newlist nil) (buffer-undo-list t)) + (when vm-expunge-before-save + (vm-expunge-folder)) + (cond ((eq vm-folder-access-method 'pop) + (vm-pop-synchronize-folder :interactive t + :do-remote-expunges t + :do-local-expunges t + :do-retrieves nil)) + ((eq vm-folder-access-method 'imap) + (vm-imap-synchronize-folder :interactive t + :do-remote-expunges t + :do-local-expunges t + :do-retrieves nil + :save-attributes t))) + (vm-discard-fetched-messages) + ;; remove the message summary file of Thunderbird and force + ;; it to rebuild it. Expect error if Thunderbird is active. + (let ((msf (concat buffer-file-name ".msf"))) + (if (and (eq vm-sync-thunderbird-status t) + (file-exists-p msf)) + (delete-file msf))) + ;; stuff the attributes of messages that need it. + (vm-inform 6 "Stuffing cached data...") + (vm-stuff-folder-data nil) + (vm-inform 6 "Stuffing cached data... done") + ;; stuff bookmark and header variable values + (if vm-message-list + (progn + ;; get summary cache up-to-date + (vm-inform 6 "Stuffing folder data...") + (vm-update-summary-and-mode-line) + (vm-stuff-bookmark) + (vm-stuff-pop-retrieved) + (vm-stuff-imap-retrieved) + (vm-stuff-last-modified) + (vm-stuff-header-variables) + (vm-stuff-labels) + (vm-stuff-summary) + (and vm-message-order-changed + (vm-stuff-message-order)) + (vm-inform 6 "Stuffing folder data... done"))) + (vm-inform 5 "Saving folder %s..." (buffer-name)) + (let ((vm-inhibit-write-file-hook t) + (oldmodebits (and (fboundp 'default-file-modes) + (default-file-modes)))) + (unwind-protect + (progn + (and oldmodebits (set-default-file-modes + vm-default-folder-permission-bits)) + (save-buffer prefix)) + (and oldmodebits (set-default-file-modes oldmodebits)))) + (vm-unmark-folder-modified-p (current-buffer)) ; folder buffer + ;; clear the modified flag in virtual folders if all the + ;; real buffers associated with them are unmodified. + (let ((b-list vm-virtual-buffers) rb-list one-modified) + (save-excursion + (while b-list + (if (null (cdr (with-current-buffer (car b-list) + vm-real-buffers))) + (vm-unmark-folder-modified-p (car b-list)) + (set-buffer (car b-list)) + (setq rb-list vm-real-buffers one-modified nil) + (while rb-list + (if (buffer-modified-p (car rb-list)) + (setq one-modified t rb-list nil) + (setq rb-list (cdr rb-list)))) + (if (not one-modified) + (vm-unmark-folder-modified-p (car b-list)))) + (setq b-list (cdr b-list))))) + (vm-clear-modification-flag-undos) + (setq vm-messages-not-on-disk 0) + (setq vm-block-new-mail nil) + (vm-write-index-file-maybe) + (if (and vm-folders-summary-database buffer-file-name) + (progn + (vm-compute-totals) + (vm-store-folder-totals buffer-file-name (cdr vm-totals)))) + (vm-update-summary-and-mode-line) + (and (zerop (buffer-size)) + vm-delete-empty-folders + buffer-file-name + (or (eq vm-delete-empty-folders t) + (y-or-n-p (format "%s is empty, remove it? " + (or buffer-file-name (buffer-name))))) + (condition-case () + (progn + (delete-file buffer-file-name) + (vm-delete-index-file) + (clear-visited-file-modtime) + (vm-inform 5 "%s removed" buffer-file-name)) + ;; no can do, oh well. + (error nil))) + ) + (vm-inform 5 "No changes need to be saved")))) + +;;;###autoload +(defun vm-save-and-expunge-folder (&optional prefix) + "Expunge folder, then save it to disk. +Prefix arg is handled the same as for the command save-buffer. +Expunge won't be done if folder is read-only. + +When applied to a virtual folder, this command works as if you had +run vm-expunge-folder followed by vm-save-folder." + (interactive (list current-prefix-arg)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-save-and-expunge-folder) + '(vm-save-and-expunge-folder)) + (if (not vm-folder-read-only) + (progn + (vm-inform 6 "Expunging...") + (vm-expunge-folder :quiet t))) + (vm-save-folder prefix)) + +;;;###autoload +(defun vm-read-folder (folder &optional remote-spec folder-name) + "Reads the FOLDER from the file system and creates a buffer. +Returns the buffer created. +Optional argument REMOTE-SPEC gives the maildrop specification for +the server folder that the FOLDER might be caching. +Optional argument FOLDER-NAME gives the name of the folder that should +be used as the name of the buffer." + (let ((file (or folder (expand-file-name vm-primary-inbox + vm-folder-directory)))) + (if (file-directory-p file) + ;; MH code perhaps... ? + (error "%s is a directory" file) + (or (vm-get-file-buffer file) + (let ((default-directory + (or (and vm-folder-directory + (expand-file-name vm-folder-directory)) + default-directory)) + (inhibit-local-variables t) + (enable-local-variables nil) + (enable-local-eval nil) + ;; for Emacs/MULE + ;; disabled because Emacs 23 doesn't like it, and it + ;; is not clear if it does anything at all. USR, 2010-07-10. + ;; The only place this function is called from is vm, + ;; which takes care of multibyte issues. TX, 2010-07-03 + ;; (default-enable-multibyte-characters nil) + + ;; for XEmacs/Mule + (coding-system-for-read + (vm-line-ending-coding-system))) + (vm-inform 5 "Reading folder %s..." (or folder-name file)) + (let ((buffer (find-file-noselect file t)) + (hist-item (or remote-spec folder vm-primary-inbox))) + (when folder-name + (with-current-buffer buffer + (rename-buffer folder-name t))) + ;; update folder history + (if (not (equal hist-item (car vm-folder-history))) + (setq vm-folder-history + (cons hist-item vm-folder-history))) + (vm-inform 5 "Reading folder %s... done" (or folder-name file)) + buffer)))))) + +;;;###autoload +(defun vm-revert-buffer () +"Revert the current folder to its version on the disk. +Same as \\[vm-revert-folder]." + (interactive) + (vm-select-folder-buffer-if-possible) + (let ((access-method vm-folder-access-method) ; preserve these across + (access-data vm-folder-access-data) ; the revert-buffer opn + (summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle)) + (if summary-buffer + (progn + (vm-display summary-buffer nil nil nil) + (kill-buffer summary-buffer))) + (if pres-buffer + (progn + (vm-display pres-buffer nil nil nil) + (kill-buffer pres-buffer))) + (call-interactively 'revert-buffer) + (setq vm-folder-access-data access-data) ; restore preserved data + (setq vm-folder-access-method access-method) + (vm (current-buffer) :access-method access-method :reload 'reload))) + +(defalias 'vm-revert-folder 'vm-revert-buffer) + +;;;###autoload +(defun vm-recover-file () +"Recover the autosave file for the current folder. +Same as \\[vm-recover-folder]." + (interactive) + (vm-select-folder-buffer-if-possible) + (let ((access-method vm-folder-access-method) ; preserve these across + (access-data vm-folder-access-data) ; the recover-file opn. + (summary-buffer vm-summary-buffer) + (pres-buffer vm-presentation-buffer-handle)) + (if summary-buffer + (progn + (vm-display summary-buffer nil nil nil) + (kill-buffer summary-buffer))) + (if pres-buffer + (progn + (vm-display pres-buffer nil nil nil) + (kill-buffer pres-buffer))) + (call-interactively 'recover-file) + (setq vm-folder-access-method access-method) + (setq vm-folder-access-data access-data) ; restore data + (vm (current-buffer) :access-method access-method :reload 'reload))) + +(defalias 'vm-recover-folder 'vm-recover-file) + +;; It doesn't seem that any of these recover/reversion handlers are +;; working any more. Not on GNU Emacs. USR, 2010-01-23 + +(defun vm-handle-file-recovery-or-reversion (recovery) + (if (and vm-summary-buffer (buffer-name vm-summary-buffer)) + (kill-buffer vm-summary-buffer)) + (vm-virtual-quit) + ;; reset major mode, this will cause vm to start from scratch. + (setq major-mode 'fundamental-mode) + ;; If this is a recovery, we can't allow the user to get new + ;; mail until a real save is performed. Until then the buffer + ;; and the disk don't match. + (if recovery + (setq vm-block-new-mail t)) + (let ((name (cond ((eq vm-folder-access-method 'pop) + (vm-pop-find-name-for-buffer (current-buffer))) + ((eq vm-folder-access-method 'imap) + (vm-imap-find-spec-for-buffer (current-buffer)))))) + (vm (or name buffer-file-name) :access-method vm-folder-access-method))) + +;; detect if a recover-file is being performed +;; and handle things properly. +(defun vm-handle-file-recovery () + (if (and (buffer-modified-p) + (eq major-mode 'vm-mode) + (or (null vm-message-list) + (= (vm-end-of (car vm-message-list)) 1))) + (vm-handle-file-recovery-or-reversion t))) + +;; detect if a revert-buffer is being performed +;; and handle things properly. +(defun vm-handle-file-reversion () + (if (and (not (buffer-modified-p)) + (eq major-mode 'vm-mode) + (or (null vm-message-list) + (= (vm-end-of (car vm-message-list)) 1))) + (vm-handle-file-recovery-or-reversion nil))) + +;; FSF v19.23 revert-buffer doesn't mash all the markers together +;; like v18 and prior v19 versions, so the check in +;; vm-handle-file-reversion doesn't work. However v19.23 has a +;; hook we can use, after-revert-hook. +(defun vm-after-revert-buffer-hook () + (if (eq major-mode 'vm-mode) + (vm-handle-file-recovery-or-reversion nil))) + +;;;###autoload +(defun vm-help () + "Display help for various VM activities." + (interactive) + (if (eq major-mode 'vm-summary-mode) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p))) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-window-configuration t))) + (pop-up-frames (and vm-mutable-frame-configuration vm-frame-per-help))) + (cond + ((eq last-command 'vm-help) + (describe-function major-mode)) + ((eq vm-system-state 'previewing) + (vm-inform 0 "Type SPC to read message, n previews next message (? gives more help)")) + ((memq vm-system-state '(showing reading)) + (vm-inform 0 "SPC and b scroll, (d)elete, (s)ave, (n)ext, (r)eply (? gives more help)")) + ((eq vm-system-state 'editing) + (vm-inform 0 + (substitute-command-keys + "Type \\[vm-edit-message-end] to end edit, \\[vm-edit-message-abort] to abort with no change."))) + ((eq major-mode 'mail-mode) + (vm-inform 0 + (substitute-command-keys + "Type \\[vm-mail-send-and-exit] to send message, \\[kill-buffer] to discard this composition"))) + (t (describe-mode))))) + +;;;###autoload +(defun vm-spool-move-mail (source destination) + (let ((handler (and (fboundp 'find-file-name-handler) + (vm-find-file-name-handler source 'vm-spool-move-mail))) + status error-buffer) + (if handler + (funcall handler 'vm-spool-move-mail source destination) + (setq error-buffer + (get-buffer-create + (format "*output of %s %s %s*" + vm-movemail-program source destination))) + (with-current-buffer error-buffer + (erase-buffer)) + (setq status + (apply 'call-process + (nconc + (list vm-movemail-program nil error-buffer t) + (copy-sequence vm-movemail-program-switches) + (list source destination)))) + (save-current-buffer + (set-buffer error-buffer) + (if (and (numberp status) (not (= 0 status))) + (insert (format "\n%s exited with code %s\n" + vm-movemail-program status))) + (if (> (buffer-size) 0) + (progn + (vm-display-buffer error-buffer) + (if (and (numberp status) (not (= 0 status))) + (error "Failed getting new mail from %s" source) + (vm-warn 1 2 "Warning: unexpected output from %s" + vm-movemail-program))) + ;; nag, nag, nag. + (kill-buffer error-buffer)) + t )))) + +(defun vm-gobble-crash-box (crash-box) + (save-excursion + (vm-save-restriction + (widen) + (let ((opoint-max (point-max)) crash-buf + (buffer-read-only nil) + (inbox-buffer-file buffer-file-name) + (inbox-folder-type vm-folder-type) + (inbox-empty (zerop (buffer-size))) + got-mail crash-folder-type + (old-buffer-modified-p (buffer-modified-p))) + (setq crash-buf + ;; crash box could contain a letter bomb... + ;; force user notification of file variables for v18 Emacses + ;; enable-local-variables == nil disables them for newer Emacses + (let ((inhibit-local-variables t) + (enable-local-variables nil) + (enable-local-eval nil) + (coding-system-for-read (vm-line-ending-coding-system))) + (find-file-noselect crash-box))) + (if (eq (current-buffer) crash-buf) + (error "folder is the same file as crash box, cannot continue")) + (save-excursion + (set-buffer crash-buf) + (setq crash-folder-type (vm-get-folder-type)) + (if (and crash-folder-type vm-check-folder-types) + (cond ((eq crash-folder-type 'unknown) + (error "crash box %s's type is unrecognized" crash-box)) + ((eq inbox-folder-type 'unknown) + (error "inbox %s's type is unrecognized" + inbox-buffer-file)) + ((null inbox-folder-type) + (if vm-default-folder-type + (if (not (eq vm-default-folder-type + crash-folder-type)) + (if vm-convert-folder-types + (progn + (vm-convert-folder-type + crash-folder-type + vm-default-folder-type) + ;; so that kill-buffer won't ask a + ;; question later... + (set-buffer-modified-p nil)) ; crash-buf + (error "crash box %s mismatches vm-default-folder-type: %s, %s" + crash-box crash-folder-type + vm-default-folder-type))))) + ((not (eq inbox-folder-type crash-folder-type)) + (if vm-convert-folder-types + (progn + (vm-convert-folder-type crash-folder-type + inbox-folder-type) + ;; so that kill-buffer won't ask a + ;; question later... + (set-buffer-modified-p nil)) ; crash-buf + (error "crash box %s mismatches %s's folder type: %s, %s" + crash-box inbox-buffer-file + crash-folder-type inbox-folder-type))))) + ;; toss the folder header if the inbox is not empty + (goto-char (point-min)) + (if (not inbox-empty) + (vm-convert-folder-header (or inbox-folder-type + vm-default-folder-type) + nil) + (set-buffer-modified-p nil))) ; crash-buf + (goto-char (point-max)) + (insert-buffer-substring crash-buf + 1 (1+ (with-current-buffer crash-buf + (widen) + (buffer-size)))) + (setq got-mail (/= opoint-max (point-max))) + (if (not got-mail) + nil + (let ((coding-system-for-write (vm-binary-coding-system)) + (selective-display nil)) + (write-region opoint-max (point-max) buffer-file-name t t)) + (vm-increment vm-modification-counter) + (vm-restore-buffer-modified-p ; folder-buffer + old-buffer-modified-p (current-buffer))) + (kill-buffer crash-buf) + (if (not (stringp vm-keep-crash-boxes)) + (vm-error-free-call 'delete-file crash-box) + (let ((time (decode-time (current-time))) + name) + (setq name + (expand-file-name (format "Z-%02d-%02d-%02d%02d%02d-%05d" + (nth 4 time) + (nth 3 time) + (nth 2 time) + (nth 1 time) + (nth 0 time) + (% (vm-abs (random)) 100000)) + vm-keep-crash-boxes)) + (while (file-exists-p name) + (setq name + (expand-file-name (format "Z-%02d-%02d-%02d%02d%02d-%05d" + (nth 4 time) + (nth 3 time) + (nth 2 time) + (nth 1 time) + (nth 0 time) + (% (vm-abs (random)) 100000)) + vm-keep-crash-boxes))) + (rename-file crash-box name))) + got-mail )))) + +(defun vm-compute-spool-files (&optional all) + (let ((fallback-triples nil) + (crash-box (or vm-crash-box + (concat vm-primary-inbox vm-crash-box-suffix))) + file file-list + triples) + (cond ((null (vm-spool-files)) + (setq triples (list + (list vm-primary-inbox + (concat vm-spool-directory (user-login-name)) + crash-box)))) + ((stringp (car (vm-spool-files))) + (setq triples + (mapcar (function + (lambda (s) (list vm-primary-inbox s crash-box))) + (vm-spool-files)))) + ((consp (car (vm-spool-files))) + (setq triples (vm-spool-files)))) + (setq file-list (if all (mapcar 'car triples) (list buffer-file-name))) + (while file-list + (setq file (car file-list)) + (setq file-list (cdr file-list)) + (cond ((and file + (consp vm-spool-file-suffixes) + (stringp vm-crash-box-suffix)) + (setq fallback-triples + (mapcar (function + (lambda (suffix) + (list file + (concat file suffix) + (concat file + vm-crash-box-suffix)))) + vm-spool-file-suffixes)))) + (cond ((and file + vm-make-spool-file-name vm-make-crash-box-name) + (setq fallback-triples + (nconc fallback-triples + (list (list file + (save-excursion + (funcall vm-make-spool-file-name + file)) + (save-excursion + (funcall vm-make-crash-box-name + file))))))))) + (setq triples (append triples fallback-triples)) + triples )) + +(defun vm-spool-check-mail (source) + (let ((handler (vm-find-file-name-handler source 'vm-spool-check-mail))) + (if handler + (funcall handler 'vm-spool-check-mail source) + (let ((size (nth 7 (file-attributes source))) + (hash vm-spool-file-message-count-hash) + val) + (setq val (symbol-value (intern-soft source hash))) + (if (and val (equal size (car val))) + (> (nth 1 val) 0) + (let ((count (vm-count-messages-in-file source))) + (if (null count) + nil + (set (intern source hash) (list size count)) + (vm-store-folder-totals source (list count 0 0 0)) + (> count 0)))))))) + +(defun vm-count-messages-in-file (file &optional quietly) + (let ((type (vm-get-folder-type file nil nil t)) + (work-buffer nil) + count) + (if (or (memq type '(unknown nil)) (null vm-grep-program)) + nil + (unwind-protect + (let (regexp) + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (cond ((memq type '(From_ BellFrom_ From_-with-Content-Length)) + (setq regexp "^From ")) + ((eq type 'mmdf) + (setq regexp "^\001\001\001\001")) + ((eq type 'babyl) + (setq regexp "^\037"))) + (condition-case data + (progn + (unless quietly + (vm-inform 6 "Counting messages in %s..." file)) + (call-process vm-grep-program nil t nil "-c" regexp + (expand-file-name file)) + (unless quietly + (vm-inform 6 "Counting messages in %s... done" file))) + (error (vm-warn 1 2 "Attempt to run %s on %s signaled: %s" + vm-grep-program file data) + (setq vm-grep-program nil))) + (setq count (string-to-number (buffer-string))) + (cond ((memq type '(From_ BellFrom_ From_-with-Content-Length)) + t ) + ((eq type 'mmdf) + (setq count (/ count 2))) + ((eq type 'babyl) + (setq count (1- count)))) + count )) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-movemail-specific-spool-file-p (file) + (string-match "^po:[^:]+$" file)) + +(defun vm-check-for-spooled-mail (&optional interactive this-buffer-only) + (if vm-global-block-new-mail + nil + (if (and vm-folder-access-method this-buffer-only) + (cond ((eq vm-folder-access-method 'pop) + (vm-pop-folder-check-mail interactive)) + ((eq vm-folder-access-method 'imap) + (vm-imap-folder-check-mail interactive))) + (let ((triples (vm-compute-spool-files (not this-buffer-only))) + ;; since we could accept-process-output here (POP code), + ;; a timer process might try to start retrieving mail + ;; before we finish. block these attempts. + (vm-global-block-new-mail t) + (vm-pop-ok-to-ask interactive) + (vm-imap-ok-to-ask interactive) + ;; for string-match calls below + (case-fold-search nil) + this-buffer crash in maildrop meth + (mail-waiting nil)) + (while triples + (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory) + maildrop (nth 1 (car triples)) + crash (nth 2 (car triples))) + (if (vm-movemail-specific-spool-file-p maildrop) + ;; spool file is accessible only with movemail + ;; so skip it. + nil + (setq this-buffer (eq (current-buffer) (vm-get-file-buffer in))) + (when (or this-buffer (not this-buffer-only)) + (if (file-exists-p crash) + (setq mail-waiting t) + (cond ((vm-imap-folder-spec-p maildrop) + (setq meth 'vm-imap-check-mail)) + ((vm-pop-folder-spec-p maildrop) + (setq meth 'vm-pop-check-mail)) + (t (setq meth 'vm-spool-check-mail))) + (if (not interactive) + ;; allow no error to be signaled + (condition-case nil + (setq mail-waiting + (or mail-waiting + (funcall meth maildrop))) + (error nil)) + (setq mail-waiting + (or mail-waiting + (funcall meth maildrop))))))) + (setq triples (cdr triples))) + mail-waiting )))) + +(defun vm-get-spooled-mail (&optional interactive) + (if vm-block-new-mail + (error "Can't get new mail until you save this folder.")) + (cond ((eq vm-folder-access-method 'pop) + (vm-pop-synchronize-folder :interactive interactive + :do-retrieves t)) + ((eq vm-folder-access-method 'imap) + (if vm-imap-sync-on-get + (progn +;; (vm-imap-synchronize-folder :interactive interactive +;; :save-attributes t) + (vm-imap-synchronize-folder :interactive interactive + :do-local-expunges t + :do-retrieves t + :save-attributes t + :retrieve-attributes t)) + (vm-imap-synchronize-folder :interactive interactive + :do-retrieves t))) + (t (vm-get-spooled-mail-normal interactive)))) + +(defun vm-get-spooled-mail-normal (&optional interactive) + (if vm-global-block-new-mail + nil + (let ((triples (vm-compute-spool-files)) + ;; since we could accept-process-output here (POP code), + ;; a timer process might try to start retrieving mail + ;; before we finish. block these attempts. + (vm-global-block-new-mail t) + (vm-pop-ok-to-ask interactive) + (vm-imap-ok-to-ask interactive) + ;; for string-match calls below + (case-fold-search nil) + non-file-maildrop crash in safe-maildrop maildrop popdrop + retrieval-function + (got-mail nil)) + (if (and (not (verify-visited-file-modtime (current-buffer))) + (or (null interactive) + (not (yes-or-no-p + (format + "Folder %s changed on disk, discard those changes? " + (buffer-name (current-buffer))))))) + (progn + (vm-warn 0 2 + "Folder %s changed on disk, consider M-x revert-buffer" + (buffer-name (current-buffer))) + nil ) + (while triples + (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory)) + (setq maildrop (nth 1 (car triples))) + (setq crash (nth 2 (car triples))) + (setq safe-maildrop maildrop) + (setq non-file-maildrop nil) + (cond ((vm-movemail-specific-spool-file-p maildrop) + (setq non-file-maildrop t) + (setq retrieval-function 'vm-spool-move-mail)) + ((vm-imap-folder-spec-p maildrop) + (setq non-file-maildrop t) + (setq safe-maildrop + (or (vm-imap-account-name-for-spec maildrop) + (vm-safe-imapdrop-string maildrop))) + (setq retrieval-function 'vm-imap-move-mail)) + ((vm-pop-folder-spec-p maildrop) + (setq non-file-maildrop t) + (setq safe-maildrop + (or (vm-pop-find-name-for-spec maildrop) + (vm-safe-popdrop-string maildrop))) + (setq retrieval-function 'vm-pop-move-mail)) + (t (setq retrieval-function 'vm-spool-move-mail))) + (setq crash (expand-file-name crash vm-folder-directory)) + (when (eq (current-buffer) (vm-get-file-buffer in)) + (when (file-exists-p crash) + (vm-inform 1 "Recovering messages from %s..." crash) + (setq got-mail (or (vm-gobble-crash-box crash) got-mail)) + (vm-inform 1 "Recovering messages from %s... done" crash)) + (when (or non-file-maildrop + (and (not (equal 0 (nth 7 (file-attributes maildrop)))) + (file-readable-p maildrop))) + (unless non-file-maildrop + (setq maildrop + (expand-file-name maildrop + vm-folder-directory))) + (when (if got-mail + ;; don't allow errors to be signaled unless no + ;; mail has been appended to the incore + ;; copy of the folder. otherwise the + ;; user will wonder where the mail is, + ;; since it is not in the crash box or + ;; the spool file and doesn't _appear_ to + ;; be in the folder either. + (condition-case error-data + (funcall retrieval-function maildrop crash) + (error (vm-warn 0 2 "%s signaled: %s" + retrieval-function + error-data) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t ) + (quit (vm-warn 0 2 "quitting from %s..." + retrieval-function) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. + t )) + (funcall retrieval-function maildrop crash)) + (when (vm-gobble-crash-box crash) + (setq got-mail t) + (when (not non-file-maildrop) + (vm-store-folder-totals maildrop + '(0 0 0 0))) + (vm-inform 5 "Got mail from %s." + safe-maildrop))))) + (setq triples (cdr triples))) + ;; not really correct, but it is what the user expects to see. + (setq vm-spooled-mail-waiting nil) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (when got-mail + (condition-case errmsg + (run-hooks 'vm-retrieved-spooled-mail-hook) + (t + (vm-warn 0 2 + "Ignoring error while running vm-retrieved-spooled-mail-hook. %S" + errmsg))) + (vm-assimilate-new-messages :read-attributes nil)))))) + +;;;###autoload +(defun vm-folder-name () + "Return the current folder's name (local file name, or POP/IMAP +maildrop string)." + (interactive) + (if vm-folder-access-method + (aref vm-folder-access-data 0) + buffer-file-name)) + +;; This function is now obsolete. USR, 2011-12-26 +(defun vm-safe-popdrop-string (maildrop) + "Return a human-readable version of a pop MAILDROP string." + (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]*\\):[^:]*:[^:]*:\\([^:]*\\):[^:]*" maildrop) + (concat (substring maildrop (match-beginning 3) (match-end 3)) + "@" + (substring maildrop (match-beginning 2) (match-end 2)))) + "???")) + +(defun vm-popdrop-sans-password (source) + "Return popdrop SOURCE, but replace the password by a \"*\"." + (mapconcat 'identity + (append (reverse (cdr (reverse (vm-parse source "\\([^:]*\\):?")))) + '("*")) + ":")) + +(defun vm-popdrop-sans-personal-info (source) + "Return popdrop SOURCE, but replace the login and password by a \"*\"." + (mapconcat 'identity + (append (reverse (cdr (cdr (reverse (vm-parse source "\\([^:]*\\):?"))))) + '("*" "*")) + ":")) + +;; This function is now obsolete. USR, 2011-12-26 +(defun vm-safe-imapdrop-string (maildrop) + "Return a human-readable version of an imap MAILDROP string." + (or (and (string-match "^\\(imap\\|imap-ssl\\|imap-ssh\\):\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*" maildrop) + (concat (substring maildrop (match-beginning 4) (match-end 4)) + "@" + (substring maildrop (match-beginning 2) (match-end 2)) + " [" + (substring maildrop (match-beginning 3) (match-end 3)) + "]")) + "???")) + +(defun vm-imapdrop-sans-password (source) + (let (source-list) + (setq source-list (vm-parse source "\\([^:]*\\):?")) + (concat (nth 0 source-list) ":" + (nth 1 source-list) ":" + (nth 2 source-list) ":" + (nth 3 source-list) ":" + (nth 4 source-list) ":" + (nth 5 source-list) ":" "*"))) + +(defun vm-imapdrop-sans-password-and-mailbox (source) + (let (source-list) + (setq source-list (vm-parse source "\\([^:]*\\):?")) + (concat (nth 0 source-list) ":" + (nth 1 source-list) ":" + (nth 2 source-list) ":" "*:" + (nth 4 source-list) ":" + (nth 5 source-list) ":" "*"))) + +(defun vm-imapdrop-sans-personal-info (source) + (let (source-list) + (setq source-list (vm-parse source "\\([^:]*\\):?")) + (concat (nth 0 source-list) ":" + (nth 1 source-list) ":" + (nth 2 source-list) ":" "*:" + (nth 4 source-list) ":" "*:" "*"))) + +(defun vm-maildrop-sans-password (drop) + (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]*\\):[^:]*:[^:]*:\\([^:]*\\):[^:]*" drop) + (vm-popdrop-sans-password drop)) + (and (string-match "^\\(imap\\|imap-ssl\\|imap-ssh\\):\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*" drop) + (vm-imapdrop-sans-password drop)) + drop)) + +(defun vm-maildrop-sans-personal-info (drop) + (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]*\\):[^:]*:[^:]*:\\([^:]*\\):[^:]*" drop) + (vm-popdrop-sans-personal-info drop)) + (and (string-match "^\\(imap\\|imap-ssl\\|imap-ssh\\):\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*" drop) + (vm-imapdrop-sans-personal-info drop)) + drop)) + +(defun vm-maildrop-alist-sans-password (alist) + (vm-mapcar + (lambda (pair-xxx) + (cons (vm-maildrop-sans-password (car pair-xxx)) (cdr pair-xxx))) + alist)) + +(defun vm-maildrop-alist-sans-personal-info (alist) + (vm-mapcar + (lambda (pair-xxx) + (cons (vm-maildrop-sans-personal-info (car pair-xxx)) (cdr pair-xxx))) + alist)) + +;;;###autoload +(defun vm-get-new-mail (&optional arg) + "Move any new mail that has arrived in any of the spool files for the +current folder into the folder. New mail is appended to the disk +and buffer copies of the folder. + +Prefix arg means to gather mail from a user specified folder, instead of +the usual spool files. The file name will be read from the minibuffer. +Unlike when getting mail from a spool file, the source file is left +undisturbed after its messages have been copied. + +When applied to a virtual folder, this command runs itself on +each of the underlying real folders associated with this virtual +folder. A prefix argument has no effect when this command is +applied to virtual folder; mail is always gathered from the spool +files." + (interactive "P") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let* ((folder (buffer-name)) + (description (if (consp (car (vm-spool-files))) + ; folder-specific spool files + (format "new mail for %s" (buffer-name)) + (format "new mail"))) + totals-blurb) + (cond ((eq major-mode 'vm-virtual-mode) + (vm-virtual-get-new-mail)) + ((not (eq major-mode 'vm-mode)) + (error "Can't get mail for a non-VM folder buffer")) + ((null arg) + ;; This is redundant now. USR, 2011-12-26 + ;; (if (not (eq major-mode 'vm-mode)) + ;; (vm-mode)) + (vm-inform 5 "Checking for %s..." description) + (if (vm-get-spooled-mail t) + (progn + ;; say this NOW, before the non-previewers read + ;; a message, alter the new message count and + ;; confuse themselves. + (setq totals-blurb (vm-emit-totals-blurb)) + (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail)) + (if (vm-thoughtfully-select-message) + (vm-present-current-message) + (vm-update-summary-and-mode-line)) + (vm-inform 5 totals-blurb)) + (vm-inform 5 "No new %s" description) + (and (vm-interactive-p) (vm-sit-for 4) (vm-inform 5 "")) + )) + (t + (let ((buffer-read-only nil) + folder mcount) + (setq folder (read-file-name "Gather mail from folder: " + vm-folder-directory nil t)) + (if (and vm-check-folder-types + (not (vm-compatible-folder-p folder))) + (error "Folder %s is not the same format as this folder." + folder)) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-max)) + (let ((coding-system-for-read (vm-binary-coding-system))) + (insert-file-contents folder)))) + (setq mcount (length vm-message-list)) + (if (vm-assimilate-new-messages) + (progn + ;; say this NOW, before the non-previewers read + ;; a message, alter the new message count and + ;; confuse themselves. + (setq totals-blurb (vm-emit-totals-blurb)) + (vm-display nil nil '(vm-get-new-mail) '(vm-get-new-mail)) + (if (vm-thoughtfully-select-message) + (vm-present-current-message) + (vm-update-summary-and-mode-line)) + (vm-inform 5 totals-blurb) + ;; The gathered messages are actually still on disk + ;; unless the user deletes the folder himself. + ;; However, users may not understand what happened if + ;; the messages go away after a "quit, no save". + (setq vm-messages-not-on-disk + (+ vm-messages-not-on-disk + (- (length vm-message-list) + mcount)))) + (vm-inform 5 "No messages gathered."))))))) + +;; returns list of new messages if there were any new messages, nil otherwise +(defun* vm-assimilate-new-messages (&key + (read-attributes t) (run-hooks t) + gobble-order labels) + ;; We are only guessing what this function does. USR, 2010-05-20 + ;; This is called in a Folder buffer, which already has messages + ;; loaded into it, but some of the messages (the "new" messages) + ;; have not been parsed and separated yet. + ;; The function first builds a vm-message-list. + ;; If READ-ATTRIBUTES is non-nil, it reads the message + ;; attributes in the X-VM-v5-Data headers and stores them. + ;; If GOBBLE-ORDER is non-nil, it reads the X-VM-Message-Order + ;; header and uses it to reorder the messages. + ;; If vm-summary-show-threads is non-nil, it builds threads. + ;; If vm-ml-sort-keys is non-nil, sorts the messages accordingly. + ;; If LABELS is non-nil, they are added to the message labels of all + ;; the new messages. + ;; If RUN-HOOKS is t, arrived-message-hook functions are + ;; called. Normally, this argument is nil for the first + ;; time vm-assimilate-new-messages is called in a folder. It is + ;; t for subsequent calls when new mail is being incorporated. + (let ((tail-cons (vm-last vm-message-list)) + b-list new-messages) + (save-excursion + (vm-save-restriction + (widen) + (vm-build-message-list) + (when (or (null tail-cons) (cdr tail-cons)) + (unless vm-assimilate-new-messages-sorted + (setq vm-ml-sort-keys nil)) + (if read-attributes + (vm-read-attributes (cdr tail-cons)) + (vm-set-default-attributes (cdr tail-cons))) + ;; Yuck. This has to be done here instead of in the + ;; vm function because this needs to be done before + ;; any initial thread sort (so that if the thread + ;; sort matches the saved order the folder won't be + ;; modified) but after the message list is created. + ;; Since thread sorting is done here this has to be + ;; done here too. + (when gobble-order + (vm-gobble-message-order)) + (when (or (vectorp vm-thread-obarray) + vm-summary-show-threads) + ;; may need threads for sorting + (vm-build-threads (cdr tail-cons))))) + (setq new-messages (if tail-cons (cdr tail-cons) vm-message-list)) + (when new-messages + (vm-set-numbering-redo-start-point new-messages) + (vm-set-summary-redo-start-point new-messages))) + ;; Only update the folders summary count here if new messages + ;; have arrived, not when we're reading the folder for the + ;; first time, and not if we cannot assume that all the arrived + ;; messages should be considered new. Use gobble-order as a + ;; first time indicator along with the new messages being equal + ;; to the whole message list. + (when new-messages + (if (and (not read-attributes) + (or (not (eq new-messages vm-message-list)) + (null gobble-order))) + (vm-modify-folder-totals buffer-file-name 'arrived + (length new-messages))) + ;; copy the new-messages list because sorting might scramble + ;; it. Also something the user does when + ;; vm-arrived-message-hook is run might affect it. + ;; vm-assimilate-new-messages returns this value so it must + ;; not be mangled. + (setq new-messages (copy-sequence new-messages)) + ;; add the labels + (when (and labels vm-burst-digest-messages-inherit-labels) + (mapc (lambda (m) + (vm-set-labels-of m (copy-sequence labels))) + new-messages)) + (when vm-summary-show-threads + ;; get numbering of new messages done now + ;; so that the sort code only has to worry about the + ;; changes it needs to make. + (vm-update-summary-and-mode-line) + (vm-sort-messages (or vm-ml-sort-keys + (if vm-summary-show-threads + "activity" + "date")))) + (when (and run-hooks + (or vm-arrived-message-hook vm-arrived-messages-hook)) + ;; seems wise to do this so that if the user runs VM + ;; commands here they start with as much of a clean + ;; slate as we can provide, given we're currently deep + ;; in the guts of VM. + (vm-update-summary-and-mode-line) + (when (and vm-arrived-message-hook + (not (eq vm-folder-access-method 'imap))) + (mapc (lambda (m) + (vm-run-hook-on-message 'vm-arrived-message-hook m)) + new-messages)) + (run-hooks 'vm-arrived-messages-hook)) + (when vm-virtual-buffers + (save-excursion + (setq b-list vm-virtual-buffers) + (while b-list + ;; buffer might be dead + (when (buffer-name (car b-list)) + (let (tail-cons) + (set-buffer (car b-list)) + (setq tail-cons (vm-last vm-message-list)) + (vm-build-virtual-message-list new-messages) + (when (or (null tail-cons) (cdr tail-cons)) + (if (not vm-assimilate-new-messages-sorted) + (setq vm-ml-sort-keys nil)) + (if (vectorp vm-thread-obarray) + (vm-build-threads (cdr tail-cons))) + (vm-set-summary-redo-start-point + (or (cdr tail-cons) vm-message-list)) + (vm-set-numbering-redo-start-point + (or (cdr tail-cons) vm-message-list)) + (unless vm-message-pointer + (setq vm-message-pointer vm-message-list + vm-need-summary-pointer-update t) + (if vm-message-pointer + (vm-present-current-message))) + (when vm-summary-show-threads + (vm-update-summary-and-mode-line) + (vm-sort-messages (or vm-ml-sort-keys "activity"))) + ))) + (setq b-list (cdr b-list))))) + (when vm-ml-sort-keys + (vm-sort-messages vm-ml-sort-keys))) + new-messages )) + +(defun vm-select-operable-messages (prefix + &optional interactive op-description) + "Return a list of all marked messages, messages indicated by +the PREFIX argument or messages in a collapsed thread, in that +order. Marked messages are returned only if the previous command +was `vm-next-command-uses-marks'. PREFIX is used if it is not 1 +or INTERACTIVE is nil, returning a number of messages around +`vm-message-pointer' equal to (abs prefix), either backward (if +prefix is negative) or forward (if positive). + +OP-DESCRIPTION is a string describing the opeartion being peformed, +which is used in interactive confirmations." + (cond ((eq last-command 'vm-next-command-uses-marks) + (vm-marked-messages)) + ((not (= prefix 1)) + (let ((direction (if (< prefix 0) 'backward 'forward)) + (count (vm-abs prefix)) + (vm-message-pointer vm-message-pointer) ; why this? + mlist) + (unless (eq vm-circular-folders t) + (vm-check-count prefix)) + (while (not (zerop count)) + (setq mlist (cons (car vm-message-pointer) mlist)) + (vm-decrement count) + (unless (zerop count) + (vm-move-message-pointer direction))) + (nreverse mlist))) + ((and interactive + (vm-summary-operation-p) + vm-summary-enable-thread-folding + vm-summary-show-threads + vm-enable-thread-operations + (vm-thread-root-p (vm-current-message)) + (vm-collapsed-root-p (vm-current-message)) + (or (eq vm-enable-thread-operations t) + (y-or-n-p + (format "%s all messages in thread? " op-description)))) + (vm-thread-subtree (vm-current-message))) + (t + (list (vm-current-message))) + )) + +(defun vm-display-startup-message () + (if (sit-for 5) + (let ((lines vm-startup-message-lines)) + (vm-inform 8 "VM %s. Type ? for help." (vm-version)) + (setq vm-startup-message-displayed t) + (while (and (sit-for 4) lines) + (vm-inform 8 (substitute-command-keys (car lines))) + (setq lines (cdr lines))))) + (vm-inform 8 "")) + +;;;###autoload +(defun vm-toggle-read-only () + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq vm-folder-read-only (not vm-folder-read-only)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-inform 5 "Folder is now %s" + (if vm-folder-read-only "read-only" "modifiable")) + (vm-display nil nil '(vm-toggle-read-only) '(vm-toggle-read-only)) + (vm-update-summary-and-mode-line)) + +(defvar scroll-in-place) + +;; this does the real major mode scutwork. +(defun vm-mode-internal (&optional access-method reload) + "Turn on vm-mode in the current buffer. +ACCESS-METHOD is either 'pop or 'imap for server folders. +If RELOAD is non-Nil, then the folder is being recovered. So, +folder-access-data should be preserved." + (widen) + (make-local-variable 'require-final-newline) + ;; don't kill local variables, as there is some state we'd like to + ;; keep. rather than non-portably marking the variables we + ;; want to keep, just avoid calling kill-local-variables and + ;; reset everything that needs to be reset. + (setq + major-mode 'vm-mode + mode-line-format vm-mode-line-format + mode-name "VM" + ;; must come after the setting of major-mode + mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu)) + buffer-read-only t + ;; If the user quits a vm-mode buffer, the default action is + ;; to kill the buffer. Make a note that we should offer to + ;; save this buffer even if it has no file associated with it. + ;; We have no idea of the value of the data in the buffer + ;; before it was put into vm-mode. + buffer-offer-save t + require-final-newline nil + ;; don't let CR's in folders be mashed into LF's because of a + ;; stupid user setting. + selective-display nil + vm-thread-obarray 'bonk + vm-thread-subject-obarray 'bonk + vm-label-obarray (make-vector 29 0) + vm-last-message-pointer nil + vm-modification-counter 0 + vm-message-list nil + vm-message-pointer nil + vm-message-order-changed nil + vm-message-order-header-present nil + vm-imap-retrieved-messages nil + vm-pop-retrieved-messages nil + vm-summary-buffer nil + vm-system-state nil + vm-undo-record-list nil + vm-undo-record-pointer nil + vm-virtual-buffers (vm-link-to-virtual-buffers) + vm-folder-type (vm-get-folder-type)) + (when (not reload) + (cond ((eq access-method 'pop) + (setq vm-folder-access-method 'pop) + (setq vm-folder-access-data + (make-vector vm-folder-pop-access-data-length nil))) + ((eq access-method 'imap) + (setq vm-folder-access-method 'imap) + (setq vm-folder-access-data + (make-vector vm-folder-imap-access-data-length nil))))) + (use-local-map vm-mode-map) + ;; if the user saves after M-x recover-file, let them get new + ;; mail again. + (vm-make-local-hook 'after-save-hook) + (add-hook 'after-save-hook 'vm-unblock-new-mail nil t) + (when (vm-menu-support-possible-p) + (vm-menu-install-menus)) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-folder) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-message) + ;; avoid the XEmacs file dialog box. + (defvar use-dialog-box) + (make-local-variable 'use-dialog-box) + (setq use-dialog-box nil) + ;; mail folders are precious. protect them by default. + (make-local-variable 'file-precious-flag) + (setq file-precious-flag vm-folder-file-precious-flag) + ;; scroll in place messes with scroll-up and this loses + (make-local-variable 'scroll-in-place) + (setq scroll-in-place nil) + (run-hooks 'vm-mode-hook) + ;; compatibility + (run-hooks 'vm-mode-hooks)) + +(defun vm-link-to-virtual-buffers () + "If there are visited virtual folders that depend on the current +real folder, then link them to the current folder and update their +contents." + (let ((b-list (buffer-list)) + (vbuffers nil) + (folder-buffer (current-buffer)) + folders folder clauses) + (save-excursion + (while b-list + (set-buffer (car b-list)) + (cond ((eq major-mode 'vm-virtual-mode) + (setq clauses (cdr vm-virtual-folder-definition)) + (while clauses + (setq folders (car (car clauses))) + (while folders + (setq folder (car folders)) + (if (eq folder-buffer + (or (and (stringp folder) + (vm-get-file-buffer + (expand-file-name folder + vm-folder-directory))) + (and (listp folder) + (eval folder)))) + (setq vbuffers (cons (car b-list) vbuffers) + vm-real-buffers (cons folder-buffer + vm-real-buffers) + folders nil + clauses nil)) + (setq folders (cdr folders))) + (setq clauses (cdr clauses))))) + (setq b-list (cdr b-list))) + vbuffers ))) + +;;;###autoload +(defun vm-change-folder-type (type) + "Change folder type to TYPE. +TYPE may be one of the following symbol values: + + From_ + From_-with-Content-Length + BellFrom_ + mmdf + babyl + +Interactively TYPE will be read from the minibuffer." + (interactive + (let ((this-command this-command) + (last-command last-command) + (types vm-supported-folder-types)) + (save-current-buffer + (vm-select-folder-buffer) + (vm-error-if-virtual-folder) + (setq types (vm-delqual (symbol-name vm-folder-type) + (copy-sequence types))) + (list (intern (vm-read-string "Change folder to type: " types)))))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (if (not (memq type '(From_ BellFrom_ From_-with-Content-Length mmdf babyl))) + (error "Unknown folder type: %s" type)) + (if (or (null vm-folder-type) + (eq vm-folder-type 'unknown)) + (error "Current folder's type is unknown, can't change it.")) + (let ((mp vm-message-list) + (buffer-read-only nil) + (old-type vm-folder-type) + ;; no interruptions + (inhibit-quit t) + (n 0) + ;; Just for laughs, make the update interval vary. + (modulus (+ (% (vm-abs (random)) 11) 5)) + text-end opoint) + (save-excursion + (vm-save-restriction + (widen) + (setq vm-folder-type type) + (goto-char (point-min)) + (vm-convert-folder-header old-type type) + (while mp + (goto-char (vm-start-of (car mp))) + (setq opoint (point)) + (insert (vm-leading-message-separator type (car mp))) + (if (> (vm-headers-of (car mp)) (vm-start-of (car mp))) + (delete-region (point) (vm-headers-of (car mp))) + (set-marker (vm-headers-of (car mp)) (point)) + ;; if headers-of == start-of then so could vheaders-of + ;; and text-of. clear them to force a recompute. + (vm-set-vheaders-of (car mp) nil) + (vm-set-text-of (car mp) nil)) + (vm-convert-folder-type-headers old-type type) + (goto-char (vm-text-end-of (car mp))) + (setq text-end (point)) + (insert-before-markers (vm-trailing-message-separator type)) + (delete-region (vm-text-end-of (car mp)) (vm-end-of (car mp))) + (set-marker (vm-text-end-of (car mp)) text-end) + (goto-char (vm-headers-of (car mp))) + (vm-munge-message-separators type (vm-headers-of (car mp)) + (vm-text-end-of (car mp))) + (vm-set-byte-count-of (car mp) nil) + (vm-set-babyl-frob-flag-of (car mp) nil) + (vm-set-message-type-of (car mp) type) + ;; Technically we should mark each message for a + ;; summary update since the message byte counts might + ;; have changed. But I don't think anyone cares that + ;; much and the summary regeneration would make this + ;; process slower. + (setq mp (cdr mp) n (1+ n)) + (if (zerop (% n modulus)) + (vm-inform 5 "Converting... %d" n)))))) + (vm-clear-modification-flag-undos) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (vm-inform 5 "Conversion complete.") + ;; message separator strings may have leaked into view + (if (> (point-max) (vm-text-end-of (car vm-message-pointer))) + (narrow-to-region (point-min) (vm-text-end-of (car vm-message-pointer)))) + (vm-display nil nil '(vm-change-folder-type) '(vm-change-folder-type))) + +(defun vm-register-global-garbage-files (files) + "Add global garbage collection actions to delete all of FILES." + (while files + (setq vm-global-garbage-alist + (cons (cons (car files) 'delete-file) + vm-global-garbage-alist) + files (cdr files)))) + +(defun vm-garbage-collect-global () + "Carry out all the registered global garbage collection actions." + (save-excursion + (while vm-global-garbage-alist + (condition-case nil + (funcall (cdr (car vm-global-garbage-alist)) + (car (car vm-global-garbage-alist))) + (error nil)) + (setq vm-global-garbage-alist (cdr vm-global-garbage-alist))))) + +(defun vm-register-folder-garbage-files (files) + "Add folder garbage collection actions to delete all of FILES." + (vm-register-global-garbage-files files) + (save-excursion + (vm-select-folder-buffer) + (while files + (setq vm-folder-garbage-alist + (cons (cons (car files) 'delete-file) + vm-folder-garbage-alist) + files (cdr files))))) + +(defun vm-register-folder-garbage (action garbage) + "Add a folder garbage-collection action to carry out ACTION on +argument GARBAGE." + (save-excursion + (vm-select-folder-buffer) + (setq vm-folder-garbage-alist + (cons (cons garbage action) + vm-folder-garbage-alist)))) + +(defun vm-garbage-collect-folder () + "Carry out all the folder garbage-collection actions." + (save-excursion + (while vm-folder-garbage-alist + (condition-case nil + (funcall (cdr (car vm-folder-garbage-alist)) + (car (car vm-folder-garbage-alist))) + (error nil)) + (setq vm-folder-garbage-alist (cdr vm-folder-garbage-alist))))) + +(defun vm-register-fetched-message (m) + "Register real message M as having been fetched into its folder +temporarily. Such fetched messages are discarded before the +folder is saved." + (save-current-buffer + (set-buffer (vm-buffer-of m)) + ;; m should have retrieve=nil, i.e., already retrieved + (vm-assert (vm-body-retrieved-of m)) + (let ((vm-folder-read-only nil) + (modified (buffer-modified-p))) + (if (memq m vm-fetched-messages) + (progn + ;; at the moment, this case doesn't arise. USR, 2010-06-11 + ;; move m to the rear + (setq vm-fetched-messages + (delq m vm-fetched-messages)) + (setq vm-fetched-messages ; add-to-list is no good on XEmacs + (nconc vm-fetched-messages (list m)))) + + (if vm-fetched-message-limit + (while (>= vm-fetched-message-count + vm-fetched-message-limit) + (let ((mm (car vm-fetched-messages))) + ;; These tests should always come out true, but we are + ;; not confident. A lot could have happened since the + ;; message was first loaded. + (when (and (vm-body-retrieved-of mm) + (vm-body-to-be-discarded-of mm)) + (vm-discard-real-message-body mm)) + (vm-unregister-fetched-message mm)))) + (setq vm-fetched-messages + (nconc vm-fetched-messages (list m))) + (vm-increment vm-fetched-message-count) + (vm-set-body-to-be-discarded-of m t) + (vm-restore-buffer-modified-p + modified (vm-buffer-of m)))))) + +(defun vm-unregister-fetched-message (m) + "Unregister a real message M as a fetched message. If M was never +registered as a fetched message, then there is no effect." + (save-current-buffer + (set-buffer (vm-buffer-of m)) + (let ((vm-folder-read-only nil)) + (setq vm-fetched-messages (delq m vm-fetched-messages)) + (vm-decrement vm-fetched-message-count) + (vm-set-body-to-be-discarded-of m nil)))) + +(defun vm-discard-fetched-messages () + "Discard the message bodies of all the fetched messages in the +current folder." + (while vm-fetched-messages + (let ((m (car vm-fetched-messages)) + (vm-folder-read-only nil)) + (vm-discard-real-message-body m) + (vm-set-body-to-be-discarded-of m nil)) + (setq vm-fetched-messages (cdr vm-fetched-messages))) + (setq vm-fetched-message-count 0)) + +(defun vm-register-message-garbage-files (files) + "Add message garbage collection actions to delete all of FILES." + (vm-register-folder-garbage-files files) + (save-excursion + (vm-select-folder-buffer) + (while files + (setq vm-message-garbage-alist + (cons (cons (car files) 'delete-file) + vm-message-garbage-alist) + files (cdr files))))) + +(defun vm-register-message-garbage (action garbage) + "Add a message garbage-collection action to carry out ACTION on +argument GARBAGE." + (vm-register-folder-garbage action garbage) + (save-excursion + (vm-select-folder-buffer) + (setq vm-message-garbage-alist + (cons (cons garbage action) + vm-message-garbage-alist)))) + +(defun vm-garbage-collect-message () + "Carry out all the folder garbage-collection actions." + (save-excursion + (while vm-message-garbage-alist + (condition-case nil + (funcall (cdr (car vm-message-garbage-alist)) + (car (car vm-message-garbage-alist))) + (error nil)) + (setq vm-message-garbage-alist (cdr vm-message-garbage-alist))))) + +(vm-add-write-file-hook 'vm-write-file-hook) +(vm-add-find-file-hook 'vm-handle-file-recovery) +(vm-add-find-file-hook 'vm-handle-file-reversion) + +;; after-revert-hook is new to FSF v19.23 +(defvar after-revert-hook) +(if (boundp 'after-revert-hook) + (setq after-revert-hook + (cons 'vm-after-revert-buffer-hook after-revert-hook)) + (setq after-revert-hook (list 'vm-after-revert-buffer-hook))) + +(defun vm-message-can-be-external (m) + "Check if the message M can be used in external (headers-only) mode." + (and (eq (vm-message-access-method-of m) 'imap) + (or (eq vm-enable-external-messages t) + (memq 'imap vm-enable-external-messages)) + )) + +;;;###autoload +(defun vm-load-message (&optional count) + "Load the message by retrieving its body from its +permanent location. Currently this facility is only available for IMAP +folders. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are loaded. A negative argument means +the current message and the previous |COUNT| - 1 messages are +loaded. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are loaded, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are loaded." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (when (null count) (setq count 1)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Load")) + (errors 0) + (n 0) + fetch-method + m mm) + (setq count 0) + (unwind-protect + (save-excursion + (vm-inform 8 "Retrieving message body...") + (while mlist + (setq m (car mlist)) + (setq mm (vm-real-message-of m)) + (set-buffer (vm-buffer-of mm)) + (if (vm-body-retrieved-of mm) + (when (vm-body-to-be-discarded-of mm) + (vm-unregister-fetched-message mm) + (setq count (1+ count))) + ;; else retrieve the body + (setq n (1+ n)) + (vm-inform 8 "Retrieving message body... %s" n) + (vm-retrieve-real-message-body mm) + (setq count (1+ count)) + (when (> n 0) + (vm-inform 8 "Retrieving message body... done"))) + (setq mlist (cdr mlist))) + (intern (buffer-name) vm-buffers-needing-display-update) + ;; FIXME - is this needed? Is it correct? + (vm-display nil nil '(vm-load-message vm-refresh-message) + (list this-command)) + (when (> count 0) (vm-mark-folder-modified-p)) + (vm-update-summary-and-mode-line)) + (if (= count 1) + (vm-inform 5 "Message body loaded") + (vm-inform 5 "%s message bodies loaded" + (if (= count 0) "No" count)))) + )) + +;;;###autoload +(defun vm-retrieve-operable-messages (&optional count mlist) + "Retrieve the message from from its permanent location for +temporary use. Currently this facility is only available for +IMAP folders. + +If the optional argument MLIST is non-nil, then the messages in +MLIST are retrieved. Otherwise, the following applies. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are retrieved. A negative argument means +the current message and the previous |COUNT| - 1 messages are +retrieved. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are retrieved, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are retrieved." + (save-current-buffer + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (when (null count) (setq count 1)) + (let ((used-marks (eq last-command 'vm-next-command-uses-marks)) + (vm-fetched-message-limit nil) + (errors 0) + (n 0) + fetch-method + m mm) + ;; (if (not used-marks) + ;; (setq mlist (list (car vm-message-pointer)))) + (unless mlist + (setq mlist (vm-select-operable-messages + count (vm-interactive-p) "Retrieve"))) + (save-excursion + (while mlist + (setq m (car mlist)) + (setq mm (vm-real-message-of m)) + (set-buffer (vm-buffer-of mm)) + (when (vm-body-to-be-retrieved-of mm) + (setq n (1+ n)) + (vm-inform 8 "Retrieving message body... %s" n) + (vm-retrieve-real-message-body mm :register t)) + (setq mlist (cdr mlist))) + (when (> n 0) + (vm-inform 8 "Retrieving message body... done") + (intern (buffer-name) vm-buffers-needing-display-update) + (when (vm-interactive-p) + (vm-update-summary-and-mode-line)))) + ))) + +(defun* vm-retrieve-real-message-body (mm &key (fetch nil) (register nil)) + "Retrieve the body of a real message MM from its external +source and insert it into the Folder buffer. If the optional argument +FETCH is t, then the retrieval is for a temporary message fetch. If +the optional argument REGISTER is t, then register it as a fetched +message. + +Gives an error if unable to retrieve message." + (if (not (eq (vm-message-access-method-of mm) 'imap)) + (message "External messages currently available only for imap folders.") + (save-excursion + (set-buffer (vm-buffer-of mm)) + (vm-save-restriction + (widen) + (narrow-to-region (marker-position (vm-headers-of mm)) + (marker-position (vm-text-end-of mm))) + (let ((fetch-method (vm-message-access-method-of mm)) + (vm-folder-read-only (and vm-folder-read-only (not fetch))) + (inhibit-read-only t) + ;; (buffer-read-only nil) ; seems redundant + (buffer-undo-list t) ; why this? USR, 2010-06-11 + (modified (buffer-modified-p)) + (fetch-result nil) + (testing 0)) + (goto-char (vm-text-of mm)) + ;; Check to see that we are at the right place + (vm-assert (save-excursion (forward-line -1) (looking-at "\n"))) + (vm-increment testing) + + (delete-region (point) (point-max)) + ;; Remember that this does I/O and accept-process-output, + ;; allowing concurrent threads to run!!! USR, 2010-07-11 + (condition-case err + (setq fetch-result + (apply (intern (format "vm-fetch-%s-message" fetch-method)) + mm nil)) + (error + (vm-warn 0 0 "Unable to load message; %s" + (error-message-string err)))) + (when fetch-result + (vm-assert (eq (point) (marker-position (vm-text-of mm)))) + (vm-increment testing) + ;; delete the new headers + (delete-region + (vm-text-of mm) + (or (re-search-forward "\n\n" (point-max) t) (point-max))) + (vm-assert (eq (point) (marker-position (vm-text-of mm)))) + (vm-increment testing) + ;; fix markers now + (set-marker (vm-text-end-of mm) (point-max)) + (vm-assert (eq (point) (marker-position (vm-text-of mm)))) + (vm-assert (save-excursion (forward-line -1) (looking-at "\n"))) + (vm-increment testing) + ;; now care for the layout of the message + (vm-set-mime-layout-of mm (vm-mime-parse-entity-safe mm)) + ;; update the message data + (vm-set-body-to-be-retrieved-flag mm nil) + (vm-set-body-to-be-discarded-flag mm nil) + (vm-set-line-count-of mm nil) + (vm-set-byte-count-of mm nil) + ;; update the virtual messages + (vm-update-virtual-messages mm :message-changing nil) + (vm-restore-buffer-modified-p modified (vm-buffer-of mm)) + + (vm-assert (eq (point) (marker-position (vm-text-of mm)))) + (vm-assert (save-excursion (forward-line -1) (looking-at "\n"))) + (vm-increment testing) + (when register + (vm-register-fetched-message mm)))))))) + +;;;###autoload +(defun vm-refresh-message () + "Reload the message body from its permanent location. Currently +this facilty is only available for IMAP folders." + (interactive) + (vm-unload-message 1 t) + (vm-load-message) + (intern (buffer-name) vm-buffers-needing-display-update) + (let ((vm-preview-lines nil)) + (vm-present-current-message))) + +;;;###autoload +(defun vm-unload-message (&optional count physical) + "Unload the message body, i.e., delete it from the folder +buffer. It can be retrieved again in future from its permanent +external location. Currently this facility is only available for +IMAP folders. + +With a prefix argument COUNT, the current message and the next +COUNT - 1 messages are unloaded. A negative argument means +the current message and the previous |COUNT| - 1 messages are +unloaded. + +When invoked on marked messages (via `vm-next-command-uses-marks'), only +marked messages are unloaded, other messages are ignored. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in +the thread are unloaded. + +If the optional argument PHYSICAL is non-nil, then the message is +physically discarded. Otherwise, the discarding may be delayed until +the folder is saved." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (when (null count) + (setq count 1)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Unload")) + (buffer-undo-list t) + (errors 0) + m mm) + (save-excursion + (setq count 0) + (while mlist + (setq m (car mlist)) + (setq mm (vm-real-message-of m)) + (set-buffer (vm-buffer-of mm)) + (cond ((null (vm-message-can-be-external mm))) + ((vm-body-to-be-retrieved-of mm)) + ((vm-body-to-be-discarded-of mm) + (when physical + (vm-discard-real-message-body mm) + (setq count (1+ count)))) + (t + (if physical + (vm-discard-real-message-body mm) + ;; Register the message as fetched instead of actually + ;; discarding the message + (vm-register-fetched-message mm)) + (setq count (1+ count)))) + (setq mlist (cdr mlist)))) + (if (= count 1) + (vm-inform 5 "Message body discarded") + (vm-inform 5 "%s message bodies discarded" + (if (= count 0) "No" count))) + (vm-mark-folder-modified-p) + (vm-update-summary-and-mode-line) + )) + +(defun vm-discard-real-message-body (mm) + "Discard the real message body of MM from its Folder buffer." + (if (not (vm-message-can-be-external mm)) + (vm-set-body-to-be-discarded-flag mm nil) + (save-current-buffer + (set-buffer (vm-buffer-of mm)) + (vm-save-restriction + (widen) + (let ((inhibit-read-only t) + ;; (buffer-read-only nil) ; seems redundant + (modified (buffer-modified-p))) + (goto-char (vm-text-of mm)) + ;; Check to see that we are at the right place + (if (or (bobp) + (save-excursion (forward-line -1) (looking-at "\n"))) + (progn + (delete-region (point) (vm-text-end-of mm)) + (vm-set-mime-layout-of mm nil) + (vm-set-body-to-be-retrieved-flag mm t) + (vm-set-body-to-be-discarded-flag mm nil) + (vm-set-line-count-of mm nil) + (vm-update-virtual-messages mm :message-changing nil) + (vm-restore-buffer-modified-p modified (vm-buffer-of mm))) + (if (y-or-n-p + (concat "VM internal error: " + "headers of a message have been corrupted. " + "Continue? ")) + (progn + (vm-warn 1 5 (concat "The damaged message, with UID %s, " + "is left in the folder") + (vm-imap-uid-of mm)) + (vm-set-body-to-be-discarded-flag mm nil)) + (error "Aborted operation"))) + ))))) + + +;;; vm-folder.el ends here diff --git a/lisp/vm-grepmail.el b/lisp/vm-grepmail.el new file mode 100755 index 0000000..ee0e8a7 --- /dev/null +++ b/lisp/vm-grepmail.el @@ -0,0 +1,261 @@ +;;; vm-grepmail.el --- VM interface for grepmail +;; +;; This file is part of VM +;; +;; Copyright (C) 2001-2005 Robert Widhopf-Fenk +;; +;; Author: Robert Widhopf-Fenk +;; Status: Tested with XEmacs 21.4.15 & VM 7.19 +;; Keywords: VM helpers +;; X-URL: http://www.robf.de/Hacking/elisp + +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; +;; Add the following line to your .vm +;; (require 'vm-grepmail) +;; + +;;; Bugs: +;; +;; Somehow/sometimes the parsing stuff might create a corrupted folder but +;; sofar I have not been able to reproduce this problem! +;; +;; I would be thankful if you could provide me with an testing example. +;; + +;;; Code: + +(provide 'vm-grepmail) + +(eval-and-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-undo) + (require 'vm-startup) + (require 'vm-motion) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) +) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; group already defined in vm-vars.el +;(defgroup vm nil +; "VM" +; :group 'mail) + +(defgroup vm-grepmail nil + "The VM grepmail lib" + :group 'vm) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defcustom vm-grepmail-command "grepmail" + "*Path to the program." + :group 'vm-grepmail + :type 'file) + +;;;###autoload +(defcustom vm-grepmail-arguments (list "-q" "-m" "-R" "-e" + (format "%S" user-full-name)) + "*Arguments for grepmail program." + :group 'vm-grepmail + :type '(repeat (string))) + +(defvar vm-grepmail-arguments-history + nil + "*History of previously used grepmail parameters.") + +(defvar vm-grepmail-folders-history nil + "*History for folders/directories for grepmail program.") + +(defvar vm-grepmail-folder-buffer nil) + +(if vm-fsfemacs-p + ;; For sixth arg of read-file-name in Emacs 21. cf vm-folder-history. + (defun vm-grepmail-folders-history (&rest ignored) t)) + +;;;###autoload +(defun vm-grepmail (arguments folders) + "A not so excellent interface to grepmail. +Grepmail is a fast perl-script for finding mails which got lost in the +folder jungle. End your input or folders and directories with an empty sting +or the default folder. + +ARGUMENTS the command line aruments to grepmail. +FOLDERS should be a list of files/directories to search in." + (interactive (list + (split-string + (read-string "grepmail arguments: " + (mapconcat 'identity vm-grepmail-arguments " ") + 'vm-grepmail-arguments-history)) + (let ((default (or vm-folder-directory + "~/Mail")) + fd folders) + (while (or (not (string= fd (expand-file-name default))) + (string= fd "")) + (setq fd (vm-read-file-name + (format "Search folder/directory %s%s: " + (if (not folders) + "[end list with RET]" "") + (if folders + (concat "(" + (mapconcat 'identity + folders ", ") ")") + "")) + default + default + t nil 'vm-grepmail-folders-history) + fd (expand-file-name fd)) + (if (not (string= fd (expand-file-name default))) + (setq folders (add-to-list 'folders fd)))) + (if (null folders) + (setq folders (add-to-list 'folders fd))) + folders))) + + (setq vm-grepmail-arguments arguments) + (setq vm-grepmail-folders-history + (append folders vm-grepmail-folders-history)) + + (let ((folder-buffer (format "* VM folder: grepmail %s %s *" + arguments folders)) + (process-buffer (get-buffer-create + (format "* grepmail %s %s *" + arguments folders))) + (vm-folder-directory (or vm-folder-directory "~/Mail")) + process) + + (when (get-buffer folder-buffer) + (set-buffer folder-buffer) + (if vm-summary-buffer (kill-buffer vm-summary-buffer)) + (if vm-presentation-buffer (kill-buffer vm-presentation-buffer)) + (kill-buffer folder-buffer)) + + (setq folder-buffer (get-buffer-create folder-buffer)) + (set-buffer folder-buffer) + (setq default-directory (expand-file-name vm-folder-directory)) + (setq buffer-read-only nil) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (switch-to-buffer folder-buffer) + (set-buffer-modified-p nil) + (vm-mode) + (font-lock-mode -1) + (vm-update-summary-and-mode-line) + (vm-display (current-buffer) t + '(vm-scroll-forward vm-scroll-backward) + '(reading-message)) + + (vm-summarize t t) + (vm-display (current-buffer) nil nil '(reading-message)) + (vm-display (current-buffer) t nil '(vm-next-message reading-message)) + + (save-excursion + (set-buffer process-buffer) + (setq default-directory (expand-file-name vm-folder-directory)) + (erase-buffer) + (switch-to-buffer process-buffer) + (make-local-variable 'vm-grepmail-folder-buffer) + (setq vm-grepmail-folder-buffer folder-buffer) + + (setq process + (apply 'start-process-shell-command "grepmail" + process-buffer + vm-grepmail-command + (append arguments folders))) + + (if (null process) + (error "Cannot start grepmail")) + ;; set the send-filter + (if vm-fsfemacs-p + (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)) + (set-process-filter process 'vm-grepmail-process-filter) + (set-process-sentinel process 'vm-grepmail-process-done) + process))) + +(defun vm-grepmail-process-filter (process output) + "The PROCESS insert OUTPUT into an folder biuffer." + (condition-case nil ;err + (progn + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert output) + (let (end) + (goto-char (1+ (point-min))) + (when (and (string-match "^\nFrom " output) + (setq end (and (re-search-forward "^\nFrom " + (point-max) t) + (match-beginning 0)))) + (vm-grepmail-grab-message (current-buffer) (point-min) end) + (delete-region (point-min) end))) + (sit-for 0)) + (error nil + ;; TODO: there are some problems here but we ignore them +; (message "%S" err) +; (backtrace) + )) + ) + +(defun vm-grepmail-process-done (process state) + "Called when the grepmail PROCESS is finished returning STATE." + (message "grepmail cleanup.") + (setq state (process-status process)) + (if (not (or (eq state 'exit) (eq state 'finished) + (not (= (process-exit-status process) 0)))) + (error "Grepmail terminated abnormally with %S %d" + state (process-exit-status process))) + + ;; grab the last message + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (beginning-of-line) + (vm-grepmail-grab-message (current-buffer) (point-min) (point)) + + ;; cleanup + (let ((folder-buffer vm-grepmail-folder-buffer)) + (kill-this-buffer) + (set-buffer folder-buffer) + (vm-next-message 1) + (vm-clear-modification-flag-undos) + (set-buffer-modified-p nil) + (setq major-mode 'vm-virtual-mode) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + (message "grepmail is finished.")) + +(defun vm-grepmail-grab-message (message-buffer start end) + "Assimilates a message after it is complete. +MESSAGE-BUFFER is the buffer of the message. +START the start position in the process output buffer. +END the end position in the process output buffer." + (save-excursion + (set-buffer vm-grepmail-folder-buffer) + (let ((buffer-read-only nil)) + (vm-save-restriction + (widen) + (goto-char (point-max)) + (insert-buffer-substring message-buffer start end) + (cond ((eq major-mode 'vm-mode) + (vm-clear-modification-flag-undos))) + (vm-check-for-killed-summary) + (vm-assimilate-new-messages) + (vm-update-summary-and-mode-line) + (set-buffer-modified-p nil)))) + (sit-for 0)) + +;;; vm-grepmail.el ends here diff --git a/lisp/vm-imap.el b/lisp/vm-imap.el new file mode 100755 index 0000000..89b55a5 --- /dev/null +++ b/lisp/vm-imap.el @@ -0,0 +1,4626 @@ +;;; vm-imap.el --- Simple IMAP4 (RFC 2060) client for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1998, 2001, 2003 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; Copyright (C) 2006 Robert P. Goldman +;; Copyright (C) 2008-2011 Uday S. Reddy +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-imap) + +(eval-when-compile + (require 'sendmail) + (require 'vm-misc)) + +;; For function declarations +(eval-when-compile + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-crypto) + (require 'vm-mime) + (require 'vm-reply) +) + +(declare-function vm-session-initialization + "vm.el" ()) +(declare-function vm-submit-bug-report + "vm.el" (&optional pre-hooks post-hooks)) +(declare-function open-network-stream + "subr.el" (name buffer host service &rest parameters)) + +(defvar selectable-only) ; used with dynamic binding + +;;; To-Do (USR) +;; - Need to ensure that new imap sessions get created as and when needed. + +;; ------------------------------------------------------------------------ +;; The IMAP session protocol +;; ------------------------------------------------------------------------ + +;; movemail: Folder-specific IMAP sessions are created and destroyed +;; for each get-new-mail. (Same as in VM 7.19) +;; +;; expunge: expunge-imap-messages creates and destroys sessions. +;; checkmail: check-for-mail also creates and destroys sessions. + +;; checkmail: check-for-mail also creates and destroys sessions. + +;; IMAP-FCC: Rob F's save-composition creates and destroys its own sessions. + +;; folders: imap-folder-completion-list creates and destroys (?) sessions. + +;; create, delete folder, rename folder, folders: They are also +;; created and destroyed at a global level for operations like +;; create-mailbox. (VM 7.19 didn't destroy them in the end, but we +;; do.) + +;; general operation: synchronize-folder creates an IMAP session but +;; leaves it active. Since session is linked to the folder buffer, +;; the folder can use it for other operations like fetch-imap-message +;; and copy-message. The next time a synchronize-folder is done, this +;; session is killed and a fresh session is created. + +;; ------------------------------------------------------------------------ +;;; Utilities +;; ------------------------------------------------------------------------ + + +;; +;; vm-folder-access-data +;; +;; See the info manual section on "Folder Internals" for the structure +;; of the data stored here. +;; +;; The following functions are based on cached folder-access-data. +;; They will only function when the IMAP process is "valid" and the +;; server message data is non-nil. + +(defun vm-folder-imap-msn-uid (n) + "Returns the UID of the message sequence number N on the IMAP +server, using cached data." + (let ((cell (assq n (vm-folder-imap-uid-list)))) + (nth 1 cell))) + +(defun vm-folder-imap-msn-size (n) + "Returns the message size of the message sequence number N on the +IMAP server, using cached data." + (let ((cell (assq n (vm-folder-imap-uid-list)))) + (nth 2 cell))) + +(defun vm-folder-imap-msn-flags (n) + "Returns the message flags of the message sequence number N on the +IMAP server, using cached data." + (let ((cell (assq n (vm-folder-imap-uid-list)))) + (nthcdr 2 cell))) + +(defun vm-folder-imap-message-msn (m) + "Returns the message sequence number of message M on the IMAP +server, using cached data." + (let ((uid-key (intern (vm-imap-uid-of m) (vm-folder-imap-uid-obarray)))) + (and (boundp uid-key) (symbol-value uid-key)))) + +(defun vm-folder-imap-message-size (m) + "Returns the size of the message M on the IMAP server (as a string), +using cached data." + (let ((uid-key (intern (vm-imap-uid-of m) (vm-folder-imap-flags-obarray)))) + (and (boundp uid-key) (car (symbol-value uid-key))))) + +(defun vm-folder-imap-message-flags (m) + "Returns the flags of the message M on the IMAP server, +using cached data." + (let ((uid-key (intern (vm-imap-uid-of m) (vm-folder-imap-flags-obarray)))) + (and (boundp uid-key) (cdr (symbol-value uid-key))))) + +(defun vm-folder-imap-uid-msn (uid) + "Returns the message sequence number of message with UID on the IMAP +server, using cached data." + (let ((uid-key (intern uid (vm-folder-imap-uid-obarray)))) + (and (boundp uid-key) (symbol-value uid-key)))) + +(defun vm-folder-imap-uid-message-size (uid) + "Returns the size of the message with UID on the IMAP server (as a +string), using cached data." + (let ((uid-key (intern uid (vm-folder-imap-flags-obarray)))) + (and (boundp uid-key) (car (symbol-value uid-key))))) + +(defun vm-folder-imap-uid-message-flags (uid) + "Returns the flags of the message with UID on the IMAP server, +using cached data." + (let ((uid-key (intern uid (vm-folder-imap-flags-obarray)))) + (and (boundp uid-key) (cdr (symbol-value uid-key))))) + +;; Status indicator vector +;; timer +(defsubst vm-imap-status-timer (o) (aref o 0)) +;; whether the current status has been reported already +(defsubst vm-imap-status-did-report (o) (aref o 1)) +;; mailbox specification +(defsubst vm-imap-status-mailbox (o) (aref o 2)) +;; message number (count) of the message currently being retrieved +(defsubst vm-imap-status-currmsg (o) (aref o 3)) +;; total number of mesasges that need to be retrieved in this round +(defsubst vm-imap-status-maxmsg (o) (aref o 4)) +;; amount of the current message that has been retrieved +(defsubst vm-imap-status-got (o) (aref o 5)) +;; size of the current message +(defsubst vm-imap-status-need (o) (aref o 6)) +;; Data for the message last reported +(defsubst vm-imap-status-last-mailbox (o) (aref o 7)) +(defsubst vm-imap-status-last-currmsg (o) (aref o 8)) +(defsubst vm-imap-status-last-maxmsg (o) (aref o 9)) +(defsubst vm-imap-status-last-got (o) (aref o 10)) +(defsubst vm-imap-status-last-need (o) (aref o 11)) + +(defsubst vm-set-imap-status-timer (o val) (aset o 0 val)) +(defsubst vm-set-imap-status-did-report (o val) (aset o 1 val)) +(defsubst vm-set-imap-status-mailbox (o val) (aset o 2 val)) +(defsubst vm-set-imap-status-currmsg (o val) (aset o 3 val)) +(defsubst vm-set-imap-status-maxmsg (o val) (aset o 4 val)) +(defsubst vm-set-imap-status-got (o val) (aset o 5 val)) +(defsubst vm-set-imap-status-need (o val) (aset o 6 val)) +(defsubst vm-set-imap-status-last-mailbox (o val) (aset o 7 val)) +(defsubst vm-set-imap-status-last-currmsg (o val) (aset o 8 val)) +(defsubst vm-set-imap-status-last-maxmsg (o val) (aset o 9 val)) +(defsubst vm-set-imap-status-last-got (o val) (aset o 10 val)) +(defsubst vm-set-imap-status-last-need (o val) (aset o 11 val)) + +(defun vm-imap-start-status-timer () + (let ((blob (make-vector 12 nil)) + timer) + (setq timer (add-timeout 2 'vm-imap-report-retrieval-status blob 2)) + (vm-set-imap-status-timer blob timer) + blob )) + +(defun vm-imap-stop-status-timer (status-blob) + (if (vm-imap-status-did-report status-blob) + (vm-inform 6 "")) + (if (fboundp 'disable-timeout) + (disable-timeout (vm-imap-status-timer status-blob)) + (cancel-timer (vm-imap-status-timer status-blob)))) + +(defun vm-imap-report-retrieval-status (o) + (condition-case err + (progn + (vm-set-imap-status-did-report o t) + (cond ((null (vm-imap-status-got o)) t) + ;; should not be possible, but better safe... + ((not (eq (vm-imap-status-mailbox o) + (vm-imap-status-last-mailbox o))) + t) + ((not (eq (vm-imap-status-currmsg o) + (vm-imap-status-last-currmsg o))) + t) + (t + (vm-inform 7 "Retrieving message %d (of %d) from %s, %s..." + (vm-imap-status-currmsg o) + (vm-imap-status-maxmsg o) + (vm-imap-status-mailbox o) + (if (vm-imap-status-need o) + (format "%d%%%s" + (/ (* 100 (vm-imap-status-got o)) + (vm-imap-status-need o)) + (if (eq (vm-imap-status-got o) + (vm-imap-status-last-got o)) + " (stalled)" + "")) + "100%") + ))) + (vm-set-imap-status-last-mailbox o (vm-imap-status-mailbox o)) + (vm-set-imap-status-last-currmsg o (vm-imap-status-currmsg o)) + (vm-set-imap-status-last-maxmsg o (vm-imap-status-maxmsg o)) + (vm-set-imap-status-last-got o (vm-imap-status-got o)) + (vm-set-imap-status-last-need o (vm-imap-status-need o))) + (error nil))) + +;; For logging IMAP sessions + +(defvar vm-imap-log-sessions nil + "* Boolean flag to turn on or off logging of IMAP sessions. Meant + for debugging IMAP server interactions.") + +(defvar vm-imap-tokens nil) + +(defsubst vm-imap-init-log () + (setq vm-imap-tokens nil)) + +(defsubst vm-imap-log-token (token) + (if vm-imap-log-sessions + (setq vm-imap-tokens (cons token vm-imap-tokens)))) + +(defsubst vm-imap-log-tokens (tokens) + (if vm-imap-log-sessions + (setq vm-imap-tokens (append (nreverse tokens) vm-imap-tokens)))) + +;; For verification of session protocol +;; Possible values are +;; 'active - active session present +;; 'valid - message sequence numbers are valid +;; validity is preserved by FETCH, STORE and SEARCH operations +;; 'inactive - session is inactive + +;; (defvar vm-imap-session-type nil) ; moved to vm-vars.el + +(defsubst vm-imap-session-type:set (type) + (setq vm-imap-session-type type)) + +(defsubst vm-imap-session-type:make-active () + (if (eq vm-imap-session-type 'inactive) + (setq vm-imap-session-type 'active))) + +(defsubst vm-imap-session-type:assert (type) + (vm-assert (eq vm-imap-session-type type))) + +(defsubst vm-imap-folder-session-type:assert (type) + (with-current-buffer (process-buffer (vm-folder-imap-process)) + (vm-assert (eq vm-imap-session-type type)))) + +(defsubst vm-imap-session-type:assert-active () + (vm-assert (or (eq vm-imap-session-type 'active) + (eq vm-imap-session-type 'valid)))) + +;; Simple macros + +(defsubst vm-imap-delete-message (process n) + (vm-imap-delete-messages process n n)) + +(if (fboundp 'define-error) + (progn + (define-error 'vm-imap-protocol-error "IMAP protocol error") + (define-error 'vm-imap-normal-error "IMAP error" 'vm-imap-protocol-error) + ) + (put 'vm-imap-protocol-error 'error-conditions + '(vm-imap-protocol-error error)) + (put 'vm-imap-protocol-error 'error-message "IMAP protocol error") + (put 'vm-imap-normal-error 'error-conditions + '(vm-imap-protocol-error vm-imap-normal-error error)) + (put 'vm-imap-normal-error 'error-message "IMAP error") + ) + +(defun vm-imap-protocol-error (&rest args) + (let ((local (make-local-variable 'vm-imap-keep-trace-buffer))) + (unless (symbol-value local) (set local 1))) + (signal 'vm-imap-protocol-error (list (apply 'format args)))) + +(defun vm-imap-normal-error (&rest args) + (let ((local (make-local-variable 'vm-imap-keep-trace-buffer))) + (unless (symbol-value local) (set local 1))) + (signal 'vm-imap-normal-error (list (apply 'format args)))) + +(defun vm-imap-capability (cap &optional process) + (if process + (with-current-buffer (process-buffer process) + (memq cap vm-imap-capabilities)) + (memq cap vm-imap-capabilities))) + +(defsubst vm-imap-auth-method (auth) + (memq auth vm-imap-auth-methods)) + +(defsubst vm-accept-process-output (process) + "Accept output from PROCESS. The variable `vm-imap-server-timeout' +specifies how many seconds to wait before timing out. If a timeout +occurs, typically VM cannot proceed." + ;; protect against possible buffer change due to bug in Emacs + (let ((buf (current-buffer)) + (got-output (accept-process-output process vm-imap-server-timeout))) + (if got-output + (when (not (equal (current-buffer) buf)) + (when (string-lessp "24" emacs-version) + ;; the Emacs bug should have been fixed in version 24 + (vm-warn 0 2 + "Emacs process output error: Buffer changed to %s" + (current-buffer))) + ;; recover from the bug + (set-buffer buf)) + (vm-imap-protocol-error "No response from the IMAP server")))) + + +;; Mollify the pesky compiler +(defvar selectable-only) + +(defvar vm-imap-connection-mode 'online + "* The mode of connection to the IMAP server. Possible values +are: 'online, 'offline and 'autoconnect. In the 'online mode, +synchronization works normally and message bodies of external +messages are fetched when needed. In 'offline mode, no +connection is established to the IMAP server and message bodies +are not fetched. In the 'autoconnect mode, a connection is +established whenever a synchronization operation is performed and the +connection mode is then turned into 'online.") + +(defun delete-common-elements (list1 list2 pred) + ;; Takes two lists of unique values with dummy headers and + ;; destructively deletes all their common elements + (rplacd list1 (sort (cdr list1) pred)) + (rplacd list2 (sort (cdr list2) pred)) + (while (and (cdr list1) (cdr list2)) + (cond ((equal (car (cdr list1)) (car (cdr list2))) + (rplacd list1 (cdr (cdr list1))) + (rplacd list2 (cdr (cdr list2)))) + ((apply pred (car (cdr list1)) (car (cdr list2)) nil) + (setq list1 (cdr list1))) + (t + (setq list2 (cdr list2))) + ))) + + +;; ----------------------------------------------------------------------- +;;; IMAP Spool +;; +;; -- Functions that treat IMAP mailboxes as spools to get mail +;; -- into local buffers and subsequently expunge on the server. +;; -- USR thinks this is obsolete functionality that should not be +;; -- used. Use 'IMAP folders' instead. +;; +;; handler methods: +;; vm-imap-move-mail: (string & string) -> bool +;; vm-imap-check-mail: string -> void +;; +;; interactive commands: +;; vm-expunge-imap-messages: () -> void +;; +;; vm-imap-prune-retrieval-entries: (string & list & +;; (retrieval-entry -> bool) -> list +;; vm-imap-clear-invalid-retrieval-entries: (string & list & string) -> list +;; ------------------------------------------------------------------------ + + +(defsubst vm-imap-fetch-message (process n use-body-peek + &optional headers-only) + "Fetch IMAP message with sequence number N via PROCESS, which +must be a network connection to an IMAP server. If the optional +argument HEADERS-ONLY is non-nil, then only the headers are +retrieved." + (vm-imap-fetch-messages process n n use-body-peek headers-only)) + +(defun vm-imap-fetch-messages (process beg end use-body-peek + &optional headers-only) + "Fetch IMAP message with sequence numbers in the range BEG and +END via PROCESS, which must be a network connection to an IMAP +server. If the optional argument HEADERS-ONLY is non-nil, then +only the headers are retrieved." + (let ((fetchcmd + (if headers-only + (if use-body-peek "(BODY.PEEK[HEADER])" "(RFC822.HEADER)") + (if use-body-peek "(BODY.PEEK[])" "(RFC822.PEEK)")))) + (vm-imap-send-command process (format "FETCH %d:%d %s" beg end fetchcmd)))) + +(defsubst vm-imap-fetch-uid-message (process uid use-body-peek + &optional headers-only) + "Fetch IMAP message with UID via PROCESS, which must be a +network connection to an IMAP server. If the optional argument +HEADERS-ONLY is non-nil, then only the headers are retrieved." + (let ((fetchcmd + (if headers-only + (if use-body-peek "(BODY.PEEK[HEADER])" "(RFC822.HEADER)") + (if use-body-peek "(BODY.PEEK[])" "(RFC822.PEEK)")))) + (vm-imap-send-command + process (format "UID FETCH %s:%s %s" uid uid fetchcmd)))) + +;; Our goal is to drag the mail from the IMAP maildrop to the crash box. +;; just as if we were using movemail on a spool file. +;; We remember which messages we have retrieved so that we can +;; leave the message in the mailbox, and yet not retrieve the +;; same messages again and again. + +;;;###autoload +(defun vm-imap-move-mail (source destination) + "move-mail function for IMAP folders. SOURCE is the IMAP mail box +from which mail is to be moved and DESTINATION is the VM folder." + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (let ((process nil) + (m-per-session vm-imap-messages-per-session) + (b-per-session vm-imap-bytes-per-session) + (handler (vm-find-file-name-handler source 'vm-imap-move-mail)) + (folder (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source))) + (statblob nil) + (msgid (list nil nil (vm-imapdrop-sans-password source) 'uid)) + (imap-retrieved-messages vm-imap-retrieved-messages) + (did-delete nil) + (did-retain nil) + (source-nopwd (vm-imapdrop-sans-password source)) + use-body-peek auto-expunge x select source-list uid + can-delete read-write uid-validity + mailbox mailbox-count recent-count message-size response + n (retrieved 0) retrieved-bytes process-buffer) + (setq auto-expunge + (cond ((setq x (assoc source + vm-imap-auto-expunge-alist)) + (cdr x)) + ((setq x (assoc (vm-imapdrop-sans-password source) + vm-imap-auto-expunge-alist)) + (cdr x)) + (vm-imap-expunge-after-retrieving + t) + ((member source vm-imap-auto-expunge-warned) + nil) + (t + (vm-warn 6 1 + "Warning: IMAP folder is not set to auto-expunge") + (setq vm-imap-auto-expunge-warned + (cons source vm-imap-auto-expunge-warned)) + nil))) + + (unwind-protect + (catch 'end-of-session + (when handler + (throw 'end-of-session + (funcall handler 'vm-imap-move-mail source destination))) + (setq process + (vm-imap-make-session source vm-imap-ok-to-ask "movemail")) + (or process (throw 'end-of-session nil)) + (setq process-buffer (process-buffer process)) + (save-excursion ; = save-current-buffer? + (set-buffer process-buffer) + ;;-------------------------------- + (vm-buffer-type:enter 'process) + ;;-------------------------------- + ;; find out how many messages are in the box. + (setq source-list (vm-parse source "\\([^:]+\\):?") + mailbox (nth 3 source-list)) + (setq select (vm-imap-select-mailbox process mailbox t)) + (setq mailbox-count (nth 0 select) + recent-count (nth 1 select) + uid-validity (nth 2 select) + read-write (nth 3 select) + can-delete (nth 4 select) + use-body-peek (vm-imap-capability 'IMAP4REV1)) + ;;-------------------------------- + (vm-imap-session-type:set 'valid) + ;;-------------------------------- + ;; The session type is not really "valid" because the uid + ;; and flags data has not been obtained. But since + ;; move-mail uses a short, bursty session, the effect is + ;; that of a valid session throughout. + + ;; sweep through the retrieval list, removing entries + ;; that have been invalidated by the new UIDVALIDITY + ;; value. + (setq imap-retrieved-messages + (vm-imap-clear-invalid-retrieval-entries + source-nopwd + imap-retrieved-messages + uid-validity)) + ;; loop through the maildrop retrieving and deleting + ;; messages as we go. + (setq n 1 retrieved-bytes 0) + (setq statblob (vm-imap-start-status-timer)) + (vm-set-imap-status-mailbox statblob folder) + (vm-set-imap-status-maxmsg statblob mailbox-count) + (while (and (<= n mailbox-count) + (or (not (natnump m-per-session)) + (< retrieved m-per-session)) + (or (not (natnump b-per-session)) + (< retrieved-bytes b-per-session))) + (catch 'skip + (vm-set-imap-status-currmsg statblob n) + (let (list) + (setq list (vm-imap-get-uid-list process n n)) + (setq uid (cdr (car list))) + (setcar msgid uid) + (setcar (cdr msgid) uid-validity) + (when (member msgid imap-retrieved-messages) + (if vm-imap-ok-to-ask + (vm-inform + 7 + "Skipping message %d (of %d) from %s (retrieved already)..." + n mailbox-count folder)) + (throw 'skip t))) + (setq message-size (vm-imap-get-message-size process n)) + (vm-set-imap-status-need statblob message-size) + (when (and (integerp vm-imap-max-message-size) + (> message-size vm-imap-max-message-size) + (progn + (setq response + (if vm-imap-ok-to-ask + (vm-imap-ask-about-large-message + process message-size n) + 'skip)) + (not (eq response 'retrieve)))) + (cond ((and read-write can-delete (eq response 'delete)) + (vm-inform 6 "Deleting message %d..." n) + (vm-imap-delete-message process n) + (setq did-delete t)) + (vm-imap-ok-to-ask + (vm-inform 7 "Skipping message %d..." n)) + (t + (vm-inform + 5 + "Skipping message %d in %s, too large (%d > %d)..." + n folder message-size vm-imap-max-message-size))) + (throw 'skip t)) + (vm-inform 7 "Retrieving message %d (of %d) from %s..." + n mailbox-count folder) + (vm-imap-fetch-message process n + use-body-peek nil) ; no headers-only + (vm-imap-retrieve-to-target process destination + statblob use-body-peek) + (vm-imap-read-ok-response process) + (vm-inform 7 "Retrieving message %d (of %d) from %s...done" + n mailbox-count folder) + (vm-increment retrieved) + (and b-per-session + (setq retrieved-bytes (+ retrieved-bytes message-size))) + (if auto-expunge + ;; The user doesn't want the messages kept in the mailbox. + (when (and read-write can-delete) + (vm-imap-delete-message process n) + (setq did-delete t)) + ;; If message retained on the server, record the UID + (setq imap-retrieved-messages + (cons (copy-sequence msgid) imap-retrieved-messages)) + (setq did-retain t))) + (vm-increment n)) + (when did-delete + ;; CLOSE forces an expunge and avoids the EXPUNGE + ;; responses. + (vm-imap-send-command process "CLOSE") + (vm-imap-read-ok-response process) + ;;---------------------------------- + (vm-imap-session-type:set 'inactive) + ;;---------------------------------- + ) + (not (equal retrieved 0)) ; return result + )) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when did-retain + (setq vm-imap-retrieved-messages imap-retrieved-messages) + (when (eq vm-flush-interval t) + (vm-stuff-imap-retrieved)) + (vm-mark-folder-modified-p (current-buffer))) + (when statblob + (vm-imap-stop-status-timer statblob)) + (when process + (vm-imap-end-session process)) + ))) + +(defun vm-imap-check-mail (source) + "Check if there is new mail on the IMAP server mailbox SOURCE. +Returns a boolean value." + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (let ((process nil) + (handler (vm-find-file-name-handler source 'vm-imap-check-mail)) + (retrieved vm-imap-retrieved-messages) + (imapdrop (vm-imapdrop-sans-password source)) + (count 0) + msg-count recent-count uid-validity + x response select mailbox source-list + result) + (unwind-protect + (prog1 + (save-excursion ; = save-current-buffer? + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (catch 'end-of-session + (when handler + (throw 'end-of-session + (funcall handler 'vm-imap-check-mail source))) + (setq process + (vm-imap-make-session source nil "checkmail")) + (unless process (throw 'end-of-session nil)) + (set-buffer (process-buffer process)) + (setq source-list (vm-parse source "\\([^:]+\\):?") + mailbox (nth 3 source-list)) + (setq select (vm-imap-select-mailbox process mailbox t) + msg-count (car select) + recent-count (nth 1 select) + uid-validity (nth 2 select)) + (when (zerop msg-count) + (vm-store-folder-totals source '(0 0 0 0)) + (throw 'end-of-session nil)) + ;; sweep through the retrieval list, removing entries + ;; that have been invalidated by the new UIDVALIDITY + ;; value. + (setq retrieved + (vm-imap-clear-invalid-retrieval-entries imapdrop + retrieved + uid-validity)) + (setq response (vm-imap-get-uid-list process 1 msg-count)) + (if (null response) + nil + (if (null (car response)) + ;; (nil . nil) is returned if there are no + ;; messages in the mailbox. + (progn + (vm-store-folder-totals source '(0 0 0 0)) + (throw 'end-of-session nil)) + (while response + (if (not (and (setq x (assoc (cdr (car response)) + retrieved)) + (equal (nth 1 x) imapdrop) + (eq (nth 2 x) 'uid))) + (vm-increment count)) + (setq response (cdr response)))) + (vm-store-folder-totals source (list count 0 0 0)) + (throw 'end-of-session (not (eq count 0)))) + (not (equal 0 (car select))))) + + (setq vm-imap-retrieved-messages retrieved)) + + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when process + (vm-imap-end-session process) + ;; (vm-imap-dump-uid-and-flags-data) + )))) + +(defun vm-expunge-imap-messages () + "Deletes all messages from IMAP mailbox that have already been retrieved +into the current folder. VM sets the \\Deleted flag on all such messages +on all the relevant IMAP servers and then immediately expunges." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (let ((process nil) + (source nil) + (trouble nil) + (delete-count 0) + (vm-global-block-new-mail t) + (vm-imap-ok-to-ask t) + (did-delete nil) + msg-count can-delete read-write uid-validity + select-response source-list folder uid-alist mailbox data mp match) + (unwind-protect + (save-excursion ; save-current-buffer? + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (setq vm-imap-retrieved-messages + (sort vm-imap-retrieved-messages + (function + (lambda (a b) + (cond ((string-lessp (nth 2 a) (nth 2 b)) t) + ((string-lessp (nth 2 b) (nth 2 a)) nil) + ((string-lessp (nth 1 a) (nth 1 b)) t) + ((string-lessp (nth 1 b) (nth 1 a)) nil) + ((string-lessp (nth 0 a) (nth 0 b)) t) + (t nil)))))) + (setq mp vm-imap-retrieved-messages) + (while mp + (catch 'replay + (condition-case error-data + (progn + (setq data (car mp)) + (when (not (equal source (nth 2 data))) + (when process + (when did-delete + (vm-imap-send-command process "CLOSE") + (vm-imap-read-ok-response process) + ;;---------------------------------- + (vm-imap-session-type:set 'inactive) + ;; (vm-imap-dump-uid-and-flags-data) + ;;---------------------------------- + ) + (vm-imap-end-session process) + + (setq process nil + did-delete nil)) + (setq source (nth 2 data)) + (setq folder (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source))) + (condition-case error-data + (progn + (vm-inform 6 "Opening IMAP session to %s..." + folder) + (setq process + (vm-imap-make-session + source vm-imap-ok-to-ask "expunge")) + (if (null process) + (signal 'vm-imap-protocol-error nil)) + ;;-------------------------- + (vm-buffer-type:set 'process) + ;;-------------------------- + (set-buffer (process-buffer process)) + (setq source-list (vm-parse source + "\\([^:]+\\):?") + mailbox (nth 3 source-list) + select-response (vm-imap-select-mailbox + process mailbox t) + msg-count (car select-response) + uid-validity (nth 2 select-response) + read-write (nth 3 select-response) + can-delete (nth 4 select-response)) + (setq mp + (vm-imap-clear-invalid-retrieval-entries + source mp uid-validity)) + (unless (eq data (car mp)) + ;; this entry must have been + ;; discarded as invalid, so + ;; skip it and process the + ;; entry that is now at the + ;; head of the list. + (throw 'replay t)) + (unless can-delete + (error "Can't delete messages in mailbox %s, skipping..." mailbox)) + (unless read-write + (error "Mailbox %s is read-only, skipping..." mailbox)) + (vm-inform 6 "Expunging messages in %s..." folder)) + (error + (if (cdr error-data) + (apply 'message (cdr error-data)) + (vm-warn 0 2 + "Couldn't open IMAP session to %s, skipping..." + folder)) + (setq trouble (cons folder trouble)) + (while (equal (nth 1 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t))) + (when (zerop msg-count) + (while (equal (nth 1 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t)) + (setq uid-alist (vm-imap-get-uid-list + process 1 msg-count)) + (vm-imap-session-type:make-active)) + (when (setq match (rassoc (car data) uid-alist)) + (vm-imap-delete-message process (car match)) + (setq did-delete t) + (vm-increment delete-count))) + (error + (setq trouble (cons folder trouble)) + (vm-warn 0 2 "Something signaled: %s" + (prin1-to-string error-data)) + (vm-inform 0 "Skipping rest of mailbox %s..." folder) + (sleep-for 2) + (while (equal (nth 2 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t))) + (setq mp (cdr mp)))) + (when did-delete + (vm-imap-send-command process "CLOSE") + (vm-imap-read-ok-response process) + ;;---------------------------------- + (vm-imap-session-type:set 'inactive) + ;; (vm-imap-dump-uid-and-flags-data) + ;;---------------------------------- + ) + (if trouble + (progn + ;;-------------------------- + (vm-buffer-type:set 'scratch) + ;;-------------------------- + (set-buffer (get-buffer-create "*IMAP Expunge Trouble*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert (format "%s IMAP message%s expunged.\n\n" + (if (zerop delete-count) "No" delete-count) + (if (= delete-count 1) "" "s"))) + (insert "VM had problems expunging messages from:\n") + (nreverse trouble) + (setq mp trouble) + (while mp + (insert " " (car mp) "\n") + (setq mp (cdr mp))) + (setq buffer-read-only t) + (display-buffer (current-buffer))) + (vm-inform 5 "%s IMAP message%s expunged." + (if (zerop delete-count) "No" delete-count) + (if (= delete-count 1) "" "s")))) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when process (vm-imap-end-session process))) + (unless trouble + (setq vm-imap-retrieved-messages nil) + (when (> delete-count 0) + (vm-mark-folder-modified-p (current-buffer)))))) + +(defun vm-prune-imap-retrieved-list (source) + "Prune the X-VM-IMAP-Retrieved header of the current folder by +examining which messages are still present in SOURCE. SOURCE +should be a maildrop folder on an IMAP server. USR, 2011-04-06" + (interactive + (let ((this-command this-command) + (last-command last-command)) + (vm-follow-summary-cursor) + (save-current-buffer + (vm-session-initialization) + (vm-select-folder-buffer) + (vm-error-if-folder-empty) + (list (vm-read-imap-folder-name + "Prune messages from IMAP folder: " t nil nil))))) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-prune-imap-retrieved-list) + '(vm-prune-imap-retrieved-list)) + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (let* ((imapdrop (vm-imapdrop-sans-password source)) + (process (vm-imap-make-session imapdrop nil "list")) + (uid-obarray (make-vector 67 0)) + mailbox select mailbox-count uid-validity + list retrieved-count pruned-count) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + (setq mailbox (nth 3 (vm-parse source "\\([^:]+\\):?"))) + (setq select (vm-imap-select-mailbox process mailbox t) + mailbox-count (nth 0 select) + uid-validity (nth 2 select)) + (unless (eq mailbox-count 0) + (setq list (vm-imap-get-message-data-list process 1 mailbox-count))) + (mapc (lambda (tuple) + (set (intern (cadr tuple) uid-obarray) (car tuple))) + list)) + ;; unwind-protections + ;;----------------------------- + (vm-buffer-type:exit) + ;;----------------------------- + (when process (vm-imap-end-session process))) + (setq retrieved-count (length vm-imap-retrieved-messages)) + (setq vm-imap-retrieved-messages + (vm-imap-prune-retrieval-entries + imapdrop vm-imap-retrieved-messages + (lambda (tuple) + (and (equal (nth 1 tuple) uid-validity) + (intern-soft (car tuple) uid-obarray))))) + (setq pruned-count (- retrieved-count (length vm-imap-retrieved-messages))) + (if (= pruned-count 0) + (vm-inform 5 "No messages to be pruned") + (vm-mark-folder-modified-p) + (vm-update-summary-and-mode-line) + (vm-inform 5 "%d message%s pruned" + pruned-count (if (= pruned-count 1) "" "s"))) + )) + +(defun vm-imap-prune-retrieval-entries (source retrieved pred) + "Prune RETRIEVED (a copy of `vm-imap-retrieved-messages') by +keeping only those messages from SOURCE that satisfy PRED. +SOURCE must be an IMAP maildrop spec without password info. + USR, 2011-04-06" + (let ((list retrieved) + (prev nil)) + (setq source (vm-imap-normalize-spec source)) + (while list + (if (and (equal source (vm-imap-normalize-spec (nth 2 (car list)))) + (not (apply pred (car list) nil))) + (if prev + (setcdr prev (cdr list)) + (setq retrieved (cdr retrieved))) + (setq prev list)) + (setq list (cdr list))) + retrieved )) + + +(defun vm-imap-clear-invalid-retrieval-entries (source retrieved uid-validity) + "Remove from RETRIEVED (a copy of `vm-imap-retrieved-messages') +all the entries for the password-free maildrop spec SOURCE which +do not match the given UID-VALIDITY. USR, 2010-05-24" + (vm-imap-prune-retrieval-entries + source retrieved + (lambda (tuple) (equal (nth 1 tuple) uid-validity)))) + +(defun vm-imap-recorded-uid-validity () + "Return the UID-VALIDITY value recorded in the X-IMAP-Retrieved header +of the current folder, or nil if none has been recorded." + (let ((pos (vm-find vm-imap-retrieved-messages + (lambda (record) (nth 1 record))))) + (and pos + (nth 1 (nth pos vm-imap-retrieved-messages))))) + + + +;; -------------------------------------------------------------------- +;;; Server-side +;; +;; vm-establish-new-folder-imap-session: +;; (&optional interactive string) -> process +;; vm-re-establish-folder-imap-session: +;; (&optional interactive string) -> process +;; vm-establish-writable-imap-session: +;; (maildrop &optional interactive string) -> process +;; +;; -- Functions to handle the interaction with the IMAP server +;; +;; vm-imap-make-session: folder -> process +;; vm-imap-end-session: (process &optional buffer) -> void +;; vm-imap-check-connection: process -> void +;; +;; -- mailbox operations +;; vm-imap-mailbox-list: (process & bool) -> string list +;; vm-imap-create-mailbox: (process & string &optional bool) -> void +;; vm-imap-delete-mailbox: (process & string) -> void +;; vm-imap-rename-mailbox: (process & string & string) -> void +;; +;; -- lower level I/O +;; vm-imap-send-command: (process command &optional tag no-tag) -> +;; void +;; vm-imap-select-mailbox: (process & mailbox &optional bool bool) -> +;; (int int uid-validity bool bool (flag list)) +;; vm-imap-read-capability-response: process -> ? +;; vm-imap-read-greeting: process -> ? +;; vm-imap-read-ok-response: process -> ? +;; vm-imap-read-response: process -> server-resonse +;; vm-imap-read-response-and-verify: process -> server-resopnse +;; vm-imap-read-boolean-response: process -> ? +;; vm-imap-read-object: (process &optinal bool) -> ? +;; vm-imap-response-matches: (string &rest symbol) -> bool +;; vm-imap-response-bail-if-server-says-farewell: +;; response -> void + 'end-of-session exception +;; vm-imap-protocol-error: *&rest +;; +;; -- message opeations +;; vm-imap-retrieve-uid-and-flags-data: () -> void +;; vm-imap-dump-uid-and-flags-data: () -> void +;; vm-imap-dump-uid-seq-num-data: () -> void +;; vm-imap-get-uid-list: (process & int & int) -> (int . uid) list +;; vm-imap-get-message-data-list: (process & int & int) -> +;; (int . uid . string list) list +;; vm-imap-get-message-data: (process & vm-message) -> +;; (int . uid . string list) +;; vm-imap-save-message-flags: (process & int &optional bool) -> void +;; vm-imap-get-message-size: (process & int) -> int +;; vm-imap-get-uid-message-size: (process & uid) -> int +;; vm-imap-save-message: (process & int & string?) -> void +;; vm-imap-delete-message: (process & int) -> void +;; +;; vm-imap-ask-about-large-message: (process int int) -> ? +;; vm-imap-retrieve-to-target: (process target statblob bodypeek) -> bool +;; +;; -- to be phased out +;; vm-imap-get-message-flags: +;; (process & vm-message &optional norecord:bool) -> +;; -------------------------------------------------------------------- + + +;; The IMAP sessions work as follows: + +;; Generally, sessions are created for get-new-mail, save-folder and +;; vm-imap-synchronize operations. All these operations read the +;; uid-and-flags-data and cache it internally. At this stage, the +;; IMAP session is said to be "valid", i.e., message numbers stored in +;; the cache are valid. As long as FETCH and STORE operations are +;; performed, the session remains valid. + +;; When other IMAP operations are performed, the server can send +;; EXPUNGE responses and invalidate the cached message sequence +;; numbers. In this state, the IMAP session is "active", but not +;; "valid". Only UID-based commands can be issued in this state. + + +;;;###autoload +(defun vm-imap-make-session (source &optional interactive purpose) + "Create a new IMAP session for the IMAP mail box SOURCE. +Optional argument INTERACTIVE says the operation has been invoked +interactively, and the optional argument PURPOSE is inserted in +the process buffer for tracing purposes. Returns the process or +nil if the session could not be created." + (let ((shutdown nil) ; whether process is to be shutdown + (folder-type vm-folder-type) + process ooo success + (folder (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source))) + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (use-ssl nil) + (use-ssh nil) + (session-name "IMAP") + (process-connection-type nil) + greeting + host port mailbox auth user pass authinfo + source-list imap-buffer + source-nopwd-nombox) + (vm-imap-log-token 'make) + ;; parse the maildrop + (setq source-list (vm-parse source "\\([^:]*\\):?" 1 7) + host (nth 1 source-list) + port (nth 2 source-list) + ;; mailbox (nth 3 source-list) + auth (nth 4 source-list) + user (nth 5 source-list) + pass (nth 6 source-list) + source-nopwd-nombox + (vm-imapdrop-sans-personal-info source)) + (cond ((equal auth "preauth") t) + ((equal "imap-ssl" (car source-list)) + (setq use-ssl t + session-name "IMAP over SSL")) + ((equal "imap-ssh" (car source-list)) + (setq use-ssh t + session-name "IMAP over SSH"))) + (vm-imap-check-for-server-spec source host port auth user pass + use-ssl use-ssh) + (setq port (string-to-number port)) + (when (and (equal pass "*") (not (equal auth "preauth"))) + (setq pass + (car (cdr (assoc source-nopwd-nombox vm-imap-passwords)))) + (when (and (null pass) + (boundp 'auth-sources) + (fboundp 'auth-source-user-or-password)) + (cond ((and (setq authinfo + (auth-source-user-or-password + '("login" "password") + (vm-imap-account-name-for-spec source) + port)) + (equal user (car authinfo))) + (setq pass (cadr authinfo))) + ((and (setq authinfo + (auth-source-user-or-password + '("login" "password") + host port)) + (equal user (car authinfo))) + (setq pass (cadr authinfo))))) + (while (and (null pass) interactive) + (setq pass + (read-passwd (format "IMAP password for %s: " folder))) + (when (equal pass "") + (vm-warn 0 2 "Password cannot be empty") + (setq pass nil))) + (when (null pass) + (error "Need password for %s for %s" folder purpose))) + ;; get the trace buffer + (setq imap-buffer + (vm-make-work-buffer + (vm-make-trace-buffer-name session-name host))) + (vm-imap-log-token imap-buffer) + + (unwind-protect + (catch 'end-of-session + (save-excursion ; = save-current-buffer? + (set-buffer imap-buffer) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (setq vm-folder-type (or folder-type vm-default-folder-type)) + (buffer-disable-undo imap-buffer) + (make-local-variable 'vm-imap-read-point) + ;; clear the trace buffer of old output + (erase-buffer) + ;; Tell MULE not to mess with the text. + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system (vm-binary-coding-system) t)) + (if (equal auth "preauth") + (setq process + (run-hook-with-args-until-success + 'vm-imap-session-preauth-hook + host port mailbox user pass))) + (if (processp process) + (set-process-buffer process (current-buffer)) + (insert "Starting " session-name + " session " (current-time-string) "\r\n") + (insert (format "-- connecting to %s:%s\r\n" host port)) + ;; open the connection to the server + (condition-case err + (cond + (use-ssl + (if (null vm-stunnel-program) + (setq process + (open-network-stream session-name + imap-buffer + host port + :type 'tls)) + (vm-setup-stunnel-random-data-if-needed) + (setq process + (apply 'start-process session-name imap-buffer + vm-stunnel-program + (nconc (vm-stunnel-configuration-args host + port) + vm-stunnel-program-switches))))) + (use-ssh + (setq process (open-network-stream + session-name imap-buffer + "127.0.0.1" + (vm-setup-ssh-tunnel host port)))) + (t + (setq process (open-network-stream session-name + imap-buffer + host port)))) + (error + (vm-warn 0 1 "%s" (error-message-string err)) + (setq shutdown t) + (throw 'end-of-session nil)))) + (setq shutdown t) + (setq vm-imap-read-point (point)) + (vm-process-kill-without-query process) + (if (setq greeting (vm-imap-read-greeting process)) + (insert-before-markers + (format "-- connected for %s\r\n" purpose)) + (delete-process process) ; why here? USR + (throw 'end-of-session nil)) + (set (make-local-variable 'vm-imap-session-done) nil) + ;; record server capabilities + (vm-imap-send-command process "CAPABILITY") + (if (null (setq ooo (vm-imap-read-capability-response process))) + (throw 'end-of-session nil)) + (set (make-local-variable 'vm-imap-capabilities) (car ooo)) + (set (make-local-variable 'vm-imap-auth-methods) (nth 1 ooo)) + ;; authentication + (cond + ((equal auth "login") + ;; LOGIN must be supported by all imap servers, + ;; no need to check for it in CAPABILITIES. + (vm-imap-send-command + process + (format "LOGIN %s %s" + (vm-imap-quote-string user) (vm-imap-quote-string pass))) + (unless (vm-imap-read-ok-response process) + (vm-inform 0 "IMAP password for %s incorrect" folder) + (setq vm-imap-passwords + (vm-delete (lambda (pair) + (equal (car pair) source-nopwd-nombox)) + vm-imap-passwords)) + ;; don't sleep unless we're running synchronously. + (if vm-imap-ok-to-ask + (sleep-for 2)) + (throw 'end-of-session nil)) + (unless (assoc source-nopwd-nombox vm-imap-passwords) + (setq vm-imap-passwords (cons (list source-nopwd-nombox pass) + vm-imap-passwords))) + (setq success t) + ;;-------------------------------- + (vm-imap-session-type:set 'active)) + ;;-------------------------------- + ((equal auth "cram-md5") + (if (not (vm-imap-auth-method 'CRAM-MD5)) + (error "CRAM-MD5 authentication unsupported by this server")) + (let ((ipad (make-string 64 54)) + (opad (make-string 64 92)) + (command "AUTHENTICATE CRAM-MD5") + (secret (concat + pass + (make-string (max 0 (- 64 (length pass))) 0))) + response p challenge answer) + (vm-imap-send-command process command) + (setq response + (vm-imap-read-response-and-verify process command)) + (cond ((vm-imap-response-matches response '+ 'atom) + (setq p (cdr (nth 1 response)) + challenge (buffer-substring (nth 0 p) (nth 1 p)) + challenge (vm-mime-base64-decode-string + challenge))) + (t + (vm-imap-protocol-error + "Don't understand AUTHENTICATE response"))) + (setq answer + (concat + user " " + (vm-md5-string + (concat + (vm-xor-string secret opad) + (vm-md5-raw-string + (concat + (vm-xor-string secret ipad) challenge))))) + answer (vm-mime-base64-encode-string answer)) + (vm-imap-send-command process answer nil t) + (unless (vm-imap-read-ok-response process) + (vm-inform 0 "IMAP password for %s incorrect" folder) + ;; don't sleep unless we're running synchronously. + (if vm-imap-ok-to-ask + (sleep-for 2)) + (throw 'end-of-session nil)) + (setq success t) + (unless (assoc source-nopwd-nombox vm-imap-passwords) + (setq vm-imap-passwords (cons (list source-nopwd-nombox pass) + vm-imap-passwords))) + ;;------------------------------- + (vm-imap-session-type:set 'active))) + ;;------------------------------- + ((equal auth "preauth") + (unless (eq greeting 'preauth) + (vm-inform 0 "IMAP session was not pre-authenticated") + ;; don't sleep unless we're running synchronously. + (if vm-imap-ok-to-ask + (sleep-for 2)) + (throw 'end-of-session nil)) + (setq success t) + ;;------------------------------- + (vm-imap-session-type:set 'active) + ;;------------------------------- + ) + (t (error "Don't know how to authenticate using %s" auth))) + (setq shutdown nil))) + ;; unwind-protection + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (if shutdown + (vm-imap-end-session process imap-buffer)) + (vm-tear-down-stunnel-random-data)) + + (if success + process + ;; try again if possible, treat it as non-interactive the next time + (when interactive + (vm-imap-make-session source nil purpose))))) + +(defun vm-imap-check-for-server-spec (source host port auth user pass + use-ssl use-ssh) + (when (null host) + (error "No host in IMAP maildrop specification, \"%s\"" source)) + (when (or (null port) (not (string-match "^[0-9]+$" port))) + (error "No port in IMAP maildrop specification, \"%s\"" source)) + (when (null auth) + (error "No authentication method in IMAP maildrop specification, \"%s\"" + source)) + (when (null user) + (error "No user in IMAP maildrop specification, \"%s\"" source)) + (when (null pass) + (error "No password in IMAP maildrop specification, \"%s\"" source)) + ;; (when use-ssl + ;; (if (null vm-stunnel-program) + ;; (error "vm-stunnel-program must be non-nil to use IMAP over SSL."))) + (when use-ssh + (if (null vm-ssh-program) + (error "vm-ssh-program must be non-nil to use IMAP over SSH."))) + ) + + + +;;;###autoload +(defun vm-imap-end-session (process &optional imap-buffer keep-buffer) + "Kill the IMAP session represented by PROCESS. PROCESS could +be nil or be already closed. Optional argument IMAP-BUFFER specifies +the process-buffer. If the optional argument KEEP-BUFFER is +non-nil, the process buffer is retained, otherwise it is killed +as well." + (vm-imap-log-token 'end-session) + (when (and process (null imap-buffer)) + (setq imap-buffer (process-buffer process))) + (when (and process (memq (process-status process) '(open run)) + (buffer-live-p (process-buffer process))) + (unwind-protect + (save-excursion ; = save-current-buffer? + (set-buffer imap-buffer) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + ;; vm-imap-end-session might have already been called on + ;; this process, so don't logout and schedule the killing + ;; the process again if it's already been done. + (unwind-protect + (condition-case nil + (if vm-imap-session-done + ;;------------------------------------- + (vm-imap-session-type:assert 'inactive) + ;;------------------------------------- + (vm-imap-send-command process "LOGOUT") + ;; we don't care about the response. + ;; try reading it anyway and trap any errors. + (vm-imap-read-ok-response process)) + (vm-imap-protocol-error ; handler + nil) ; ignore errors + (error nil)) ; handler + ;; unwind-protections + (setq vm-imap-session-done t) + ;;---------------------------------- + (vm-imap-session-type:set 'inactive) + ;;---------------------------------- + ;; This is just for tracing purposes + (goto-char (point-max)) + (insert "ending IMAP session " (current-time-string) "\r\n") + ;; Schedule killing of the process after a delay to allow + ;; any output to be received first + (if (fboundp 'add-async-timeout) + (add-async-timeout 2 'delete-process process) + (run-at-time 2 nil 'delete-process process)))) + ;; unwind-protections + ;;---------------------------------- + (vm-buffer-type:exit) + ;;---------------------------------- + )) + (when (and imap-buffer (buffer-live-p imap-buffer)) + (if (and (null vm-imap-keep-trace-buffer) (not keep-buffer)) + (kill-buffer imap-buffer) + (vm-keep-some-buffers imap-buffer 'vm-kept-imap-buffers + vm-imap-keep-trace-buffer + "saved ") + )) + ) + +(defun vm-imap-check-connection (process) + ;;------------------------------ + ;; (vm-buffer-type:assert 'process) + ;;------------------------------ + (cond ((not (memq (process-status process) '(open run))) + ;;------------------- + ;; (vm-buffer-type:exit) + ;;------------------- + (vm-imap-normal-error "not connected")) + ((not (buffer-live-p (process-buffer process))) + ;;------------------- + ;; (vm-buffer-type:exit) + ;;------------------- + (vm-imap-protocol-error + "IMAP process %s's buffer has been killed" process)))) + +(defun vm-imap-send-command (process command &optional tag no-tag) + (vm-imap-log-token 'send) + ;;------------------------------ + (vm-buffer-type:assert 'process) + ;;------------------------------ + (vm-imap-check-connection process) + (if (not (= (point) (point-max))) + (vm-imap-log-tokens (list 'send1 (point) (point-max)))) + (goto-char (point-max)) +;; try if it makes a difference to get pending output here, use timeout +;; (accept-process-output process 0 0.01) +;; (if (not (= (point) (point-max))) +;; (vm-imap-log-tokens (list 'send2 (point) (point-max)))) +;; (goto-char (point-max)) + + (or no-tag (insert-before-markers (or tag "VM") " ")) + (let ((case-fold-search t)) + (if (string-match "^LOGIN" command) + (insert-before-markers "LOGIN <parameters omitted>\r\n") + (insert-before-markers command "\r\n"))) + (setq vm-imap-read-point (point)) + ;; previously we had a process-send-string call for each string + ;; to avoid extra consing but that caused a lot of packet overhead. + (if no-tag + (process-send-string process (format "%s\r\n" command)) + (process-send-string process (format "%s %s\r\n" (or tag "VM") command)))) + +(defun vm-imap-select-mailbox (process mailbox &optional + just-retrieve just-examine) + "I/O function to select an IMAP mailbox + PROCESS - the IMAP process + MAILBOX - the name of the mailbox to be selected + JUST-RETRIEVE - select the mailbox for retrieval, no writing + JUST-EXAMINE - select the mailbox in a read-only (examine) mode +Returns a list containing: + int msg-count - number of messages in the mailbox + int recent-count - number of recent messages in the mailbox + string uid-validity - the UID validity value of the mailbox + bool read-write - whether the mailbox is writable + bool can-delete - whether the mailbox allows message deletion + server-response permanent-flags - permanent flags used in the mailbox." + + ;;------------------------------ + (vm-buffer-type:assert 'process) + ;;------------------------------ + + (let ((imap-buffer (current-buffer)) + (command (if just-examine "EXAMINE" "SELECT")) + tok response p + (flags nil) + (permanent-flags nil) + (msg-count nil) + (recent-count nil) + (uid-validity nil) + (read-write (not just-examine)) + (can-delete t) + (need-ok t)) + (vm-imap-log-token 'select-mailbox) + (vm-imap-send-command + process (format "%s %s" command (vm-imap-quote-string mailbox))) + (while need-ok + (setq response (vm-imap-read-response-and-verify process command)) + (cond ((vm-imap-response-matches response '* 'OK 'vector) + (setq p (cdr (nth 2 response))) + (cond ((vm-imap-response-matches p 'UIDVALIDITY 'atom) + (setq tok (nth 1 p)) + (setq uid-validity (buffer-substring (nth 1 tok) + (nth 2 tok)))) + ((vm-imap-response-matches p 'PERMANENTFLAGS 'list) + (setq permanent-flags (nth 1 p))))) + ((vm-imap-response-matches response '* 'FLAGS 'list) + (setq flags (nth 2 response))) + ((vm-imap-response-matches response '* 'atom 'EXISTS) + (setq tok (nth 1 response)) + (goto-char (nth 1 tok)) + (setq msg-count (read imap-buffer))) + ((vm-imap-response-matches response '* 'atom 'RECENT) + (setq tok (nth 1 response)) + (goto-char (nth 1 tok)) + (setq recent-count (read imap-buffer))) + ((vm-imap-response-matches response 'VM 'OK '(vector READ-WRITE)) + (setq need-ok nil read-write t)) + ((vm-imap-response-matches response 'VM 'OK '(vector READ-ONLY)) + (setq need-ok nil read-write nil)) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + (if (null flags) + (vm-imap-protocol-error "FLAGS missing from SELECT responses")) + (if (null msg-count) + (vm-imap-protocol-error "EXISTS missing from SELECT responses")) + (if (null uid-validity) + (vm-imap-protocol-error "UIDVALIDITY missing from SELECT responses")) + (setq can-delete (vm-imap-scan-list-for-flag flags "\\Deleted")) + (unless just-retrieve + (if (vm-imap-scan-list-for-flag permanent-flags "\\*") + (unless (vm-imap-scan-list-for-flag flags "\\Seen") + (vm-inform 5 + "Warning: No permanent changes permitted for the IMAP mailbox")) + (vm-inform 5 + "Warning: No user-definable flags available for the IMAP mailbox"))) + ;;------------------------------- + (vm-imap-session-type:set 'active) + ;;------------------------------- + (list msg-count recent-count + uid-validity read-write can-delete permanent-flags))) + +(defun vm-imap-read-expunge-response (process) + (let ((list nil) + (imap-buffer (current-buffer)) + (need-ok t) + tok msg-num response + ) + (vm-imap-log-token 'read-expunge) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "EXPUNGE")) + (cond ((vm-imap-response-matches response '* 'atom 'EXPUNGE) + (setq tok (nth 1 response)) + (goto-char (nth 1 tok)) + (setq msg-num (read imap-buffer)) + (setq list (cons msg-num list))) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + ;;-------------------------------- + (vm-imap-session-type:set 'active) ; seq nums are now invalid + ;;-------------------------------- + (nreverse list))) + +(defun vm-imap-get-uid-list (process first last) + "I/O function to read the uid's of a message range + PROCESS - the IMAP process + FIRST - message sequence number of the first message in the range + LAST - message sequene number of the last message in the range +Returns an alist with pairs + int msg-num - message sequence number of a message + string uid - uid of the message +or nil indicating failure +If there are no messages in the range then (nil) is returned. + +See also `vm-imap-get-message-data-list' for a newer version of this function." + + (let ((list nil) + (imap-buffer (current-buffer)) + tok msg-num uid response p + (need-ok t)) + (vm-imap-log-token 'uid-list) + ;;---------------------------------- + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command process (format "FETCH %s:%s (UID)" first last)) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "UID FETCH")) + (cond ((vm-imap-response-matches response '* 'atom 'FETCH 'list) + (setq p (cdr (nth 3 response))) + (if (not (vm-imap-response-matches p 'UID 'atom)) + (vm-imap-protocol-error + "expected (UID number) in FETCH response")) + (setq tok (nth 1 response)) + (goto-char (nth 1 tok)) + (setq msg-num (read imap-buffer)) + (setq tok (nth 1 p)) + (setq uid (buffer-substring (nth 1 tok) (nth 2 tok)) + list (cons (cons msg-num uid) list))) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + ;;------------------------------- + (vm-imap-session-type:set 'valid) + ;;------------------------------- + ;; returning nil means the uid fetch failed so return + ;; something other than nil if there aren't any messages. + (if (null list) + (cons nil nil) + list ))) + +;; This function is not recommended, but is available to use when +;; caching uid-and-flags data might be too expensive. + +(defun vm-imap-get-message-data (process m uid-validity) + "I/O function to read the flags of a message + PROCESS - The IMAP process + M - a vm-message + uid-validity - the folder's uid-validity +Returns (msg-num: int . uid: string . size: string . flags: string list) +Throws vm-imap-protocol-error for failure. + +See also `vm-imap-get-message-list' for a bulk version of this function." + + (let ((imap-buffer (current-buffer)) + response tok need-ok msg-num list) + (if (not (equal (vm-imap-uid-validity-of m) uid-validity)) + (vm-imap-normal-error "message has invalid uid")) + (vm-imap-log-tokens (list 'message-data (current-buffer))) + ;;---------------------------------- + (vm-imap-session-type:assert 'valid) + ;;---------------------------------- + (vm-imap-send-command + process (format "SEARCH UID %s" (vm-imap-uid-of m))) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "UID")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'SEARCH 'atom) + (if (null (setq tok (nth 2 response))) + (vm-imap-normal-error "message not found on server")) + (goto-char (nth 1 tok)) + (setq msg-num (read imap-buffer)) + ))) + (setq list (vm-imap-get-message-data-list process msg-num msg-num)) + (car list))) + + +(defun vm-imap-get-message-data-list (process first last) + "I/O function to read the flags of a message range + PROCESS - the IMAP process + FIRST - message sequence number of the first message in the range + LAST - message sequene number of the last message in the range +Returns an assoc list with entries + int msg-num - message sequence number of a message + string uid - uid of the message + string size - message size + (string list) flags - list of flags for the message +throws vm-imap-protocol-error for failure. + +See `vm-imap-get-message-data' for getting the data for individual +messages. `vm-imap-get-uid-list' is an older version of this function." + + (let ((list nil) + (imap-buffer (current-buffer)) + tok msg-num uid size flag flags response p pl + (need-ok t)) + (vm-imap-log-token (list 'message-data-list (current-buffer))) + ;;---------------------------------- + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'message-data vm-buffer-type-trail))) + (vm-buffer-type:assert 'process) + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command + process (format "FETCH %s:%s (UID RFC822.SIZE FLAGS)" first last)) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "FLAGS FETCH")) + (cond + ((vm-imap-response-matches response '* 'atom 'FETCH 'list) + (setq p (cdr (nth 3 response))) + (setq tok (nth 1 response)) + (goto-char (nth 1 tok)) + (setq msg-num (read imap-buffer)) + (while p + (cond + ((vm-imap-response-matches p 'UID 'atom) + (setq tok (nth 1 p)) + (setq uid (buffer-substring (nth 1 tok) (nth 2 tok))) + (setq p (nthcdr 2 p))) + ((vm-imap-response-matches p 'RFC822\.SIZE 'atom) + (setq tok (nth 1 p)) + (setq size (buffer-substring (nth 1 tok) (nth 2 tok))) + (setq p (nthcdr 2 p))) + ((vm-imap-response-matches p 'FLAGS 'list) + (setq pl (cdr (nth 1 p)) + flags nil) + (while pl + (setq tok (car pl)) + (if (not (vm-imap-response-matches (list tok) 'atom)) + (vm-imap-protocol-error + "expected atom in FLAGS list in FETCH response")) + (setq flag (downcase + (buffer-substring (nth 1 tok) (nth 2 tok))) + flags (cons flag flags) + pl (cdr pl))) + (setq p (nthcdr 2 p))) + (t + (vm-imap-protocol-error + "expected UID, RFC822.SIZE and (FLAGS list) in FETCH response")) + )) + (setq list + (cons (cons msg-num (cons uid (cons size flags))) + list))) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + list)) + +(defun vm-imap-ask-about-large-message (process size n) + (let ((work-buffer nil) + (imap-buffer (current-buffer)) + (need-ok t) + (need-header t) + response fetch-response + list p + start end) + (unwind-protect + (save-excursion ; save-current-buffer? + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (save-window-excursion + ;;---------------------------------- + (vm-imap-session-type:assert 'valid) + ;;---------------------------------- + (vm-imap-send-command process + (format "FETCH %d (RFC822.HEADER)" n)) + (while need-ok + (setq response + (vm-imap-read-response-and-verify process "header FETCH")) + (cond ((vm-imap-response-matches response '* 'atom 'FETCH 'list) + (setq fetch-response response + need-header nil)) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + (if need-header + (vm-imap-protocol-error "FETCH OK sent before FETCH response")) + (setq vm-imap-read-point (point-marker)) + (setq list (cdr (nth 3 fetch-response))) + (if (not (vm-imap-response-matches list 'RFC822\.HEADER 'string)) + (vm-imap-protocol-error + "expected (RFC822.HEADER string) in FETCH response")) + (setq p (nth 1 list) + start (nth 1 p) + end (nth 2 p)) + (setq work-buffer (generate-new-buffer "*imap-glop*")) + ;;-------------------------- + (vm-buffer-type:set 'scratch) + ;;-------------------------- + (set-buffer work-buffer) + (insert-buffer-substring imap-buffer start end) + (vm-imap-cleanup-region (point-min) (point-max)) + (vm-display-buffer work-buffer) + (setq minibuffer-scroll-window (selected-window)) + (goto-char (point-min)) + (if (re-search-forward "^Received:" nil t) + (progn + (goto-char (match-beginning 0)) + (vm-reorder-message-headers + nil :keep-list vm-visible-headers + :discard-regexp vm-invisible-header-regexp))) + (set-window-point (selected-window) (point)) + (if (y-or-n-p + (format "Retrieve message %d (size = %d)? " n size)) + 'retrieve + (if (y-or-n-p + (format "Delete message %d (size = %d) from maildrop? " + n size)) + 'delete + 'skip)))) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when work-buffer (kill-buffer work-buffer))))) + +(defun vm-imap-retrieve-to-target (process target statblob bodypeek) + "Read a mail message from PROCESS and store it in TARGET, which +is either a file or a buffer. Report status using STATBLOB. The +boolean BODYPEEK tells if the bodypeek function is available for +the IMAP server." + (vm-assert (not (null vm-imap-read-point))) + (vm-imap-log-token 'retrieve) + (let ((***start vm-imap-read-point) ; avoid dynamic binding of 'start' + end fetch-response list p) + (goto-char ***start) + (vm-set-imap-status-got statblob 0) + (let* ((func + (function + (lambda (beg end len) + (if vm-imap-read-point + (progn + (vm-set-imap-status-got statblob (- end ***start)) + (if (zerop (% (random) 10)) + (vm-imap-report-retrieval-status statblob))))))) + ;; this seems to slow things down. USR, 2008-04-25 + ;; reenabled. USR, 2010-09-17 + (after-change-functions (cons func after-change-functions)) + + (need-ok t) + response) + (setq response (vm-imap-read-response-and-verify process "message FETCH")) + (cond ((vm-imap-response-matches response '* 'atom 'FETCH 'list) + (setq fetch-response response)) + (t + (vm-imap-normal-error "cannot retrieve message from the server")))) + + ;; must make the read point a marker so that it stays fixed + ;; relative to the text when we modify things below. + (setq vm-imap-read-point (point-marker)) + (setq list (cdr (nth 3 fetch-response))) + (cond + (bodypeek + (cond ((vm-imap-response-matches list 'BODY '(vector) 'string) + (setq p (nth 2 list) + ***start (nth 1 p))) + ((vm-imap-response-matches list 'UID 'atom 'BODY '(vector) 'string) + (setq p (nth 4 list) + ***start (nth 1 p))) + (t + (vm-imap-protocol-error + "expected (BODY[] string) in FETCH response")))) + (t + (if (not (vm-imap-response-matches list 'RFC822 'string)) + (vm-imap-protocol-error + "expected (RFC822 string) in FETCH response")) + (setq p (nth 1 list) + ***start (nth 1 p)))) + (goto-char (nth 2 p)) + (setq end (point-marker)) + (vm-set-imap-status-need statblob nil) + (vm-imap-cleanup-region ***start end) + (vm-munge-message-separators vm-folder-type ***start end) + (goto-char ***start) + (vm-set-imap-status-got statblob nil) + ;; avoid the consing and stat() call for all but babyl + ;; files, since this will probably slow things down. + ;; only babyl files have the folder header, and we + ;; should only insert it if the crash box is empty. + (if (and (eq vm-folder-type 'babyl) + (cond ((stringp target) + (let ((attrs (file-attributes target))) + (or (null attrs) (equal 0 (nth 7 attrs))))) + ((bufferp target) + (with-current-buffer target + (zerop (buffer-size)))))) + (let ((opoint (point))) + (vm-convert-folder-header nil vm-folder-type) + ;; if start is a marker, then it was moved + ;; forward by the insertion. restore it. + (setq ***start opoint) + (goto-char ***start) + (vm-skip-past-folder-header))) + (insert (vm-leading-message-separator)) + (save-restriction + (narrow-to-region (point) end) + (vm-convert-folder-type-headers 'baremessage vm-folder-type)) + (goto-char end) + ;; Some IMAP servers don't understand Sun's stupid + ;; From_-with-Content-Length style folder and assume the last + ;; newline in the message is a separator. And so the server + ;; strips it, leaving us with a message that does not end + ;; with a newline. Add the newline if needed. + ;; + ;; Added From_ folders among the ones to be repaired. USR, 2010-05-19 + (if (and (not (eq ?\n (char-after (1- (point))))) + (memq vm-folder-type + '(From_-with-Content-Length BellFrom_ From_))) + (insert-before-markers "\n")) + (insert-before-markers (vm-trailing-message-separator)) + (if (stringp target) + ;; Set file type to binary for DOS/Windows. I don't know if + ;; this is correct to do or not; it depends on whether the + ;; the CRLF or the LF newline convention is used on the inbox + ;; associated with this crashbox. This setting assumes the LF + ;; newline convention is used. + (let ((buffer-file-type t) + (selective-display nil)) + (write-region ***start end target t 0)) + (let ((b (current-buffer))) + (with-current-buffer target + ;;---------------------------- + (vm-buffer-type:enter 'unknown) + ;;---------------------------- + (let ((buffer-read-only nil)) + (insert-buffer-substring b ***start end) + ) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + (delete-region ***start end) + t )) + +(defun vm-imap-delete-messages (process beg end) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + (vm-imap-session-type:assert 'valid) + ;;---------------------------------- + (vm-imap-send-command process (format "STORE %d:%d +FLAGS.SILENT (\\Deleted)" + beg end)) + (if (null (vm-imap-read-ok-response process)) + (vm-imap-normal-error "deletion failed"))) + +(defun vm-imap-get-message-size (process n) + "Use imap PROCESS to query the size the message with sequence number +N. Returns the size. + +See also `vm-imap-get-uid-message-size'." + (let ((imap-buffer (current-buffer)) + tok size response p + (need-size t) + (need-ok t)) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + (vm-imap-session-type:assert 'valid) + (vm-imap-log-tokens (list 'message-size (current-buffer))) + ;;---------------------------------- + (vm-imap-send-command process (format "FETCH %d:%d (RFC822.SIZE)" n n)) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "size FETCH")) + (cond ((and need-size + (vm-imap-response-matches response '* 'atom 'FETCH 'list)) + (setq need-size nil) + (setq p (cdr (nth 3 response))) + (catch 'done + (while p + (if (vm-imap-response-matches p 'RFC822\.SIZE 'atom) + (throw 'done nil) + (setq p (nthcdr 2 p)) + (if (null p) + (vm-imap-protocol-error + "expected (RFC822.SIZE number) in FETCH response"))))) + (setq tok (nth 1 p)) + (goto-char (nth 1 tok)) + (setq size (read imap-buffer))) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + size )) + +(defun vm-imap-get-uid-message-size (process uid) + "Uses imap PROCESS to get the size of the message with UID. Returns +the size. + +See also `vm-imap-get-message-size'." + (let ((imap-buffer (current-buffer)) + tok size response p + (need-size t) + (need-ok t)) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-log-token 'uid-size) + (vm-imap-send-command + process (format "UID FETCH %s:%s (RFC822.SIZE)" uid uid)) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "size FETCH")) + (cond ((and need-size + (vm-imap-response-matches response '* 'atom 'FETCH 'list)) + (setq p (cdr (nth 3 response))) + (while p + (cond + ((vm-imap-response-matches p 'UID 'atom) + (setq tok (nth 1 p)) + (unless (equal uid (buffer-substring (nth 1 tok) (nth 2 tok))) + (vm-imap-protocol-error + "UID number mismatch in SIZE query")) + (setq p (nthcdr 2 p))) + ((vm-imap-response-matches p 'RFC822\.SIZE 'atom) + (setq tok (nth 1 p)) + (goto-char (nth 1 tok)) + (setq size (read imap-buffer)) + (setq need-size nil) + (setq p (nthcdr 2 p))) + (t + (setq p (nthcdr 2 p)))))) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ;; Otherwise, skip the response + )) + (if need-size + (vm-imap-protocol-error + "expected UID, RFC822.SIZE in FETCH response") + size ))) + +(defun vm-imap-read-capability-response (process) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + ;;---------------------------------- + (vm-imap-log-token 'read-capability) + (let (response r cap-list auth-list (need-ok t)) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "CAPABILITY")) + (if (vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil) + (if (not (vm-imap-response-matches response '* 'CAPABILITY)) + nil + ;; skip * CAPABILITY + (setq response (cdr (cdr response))) + (while response + (setq r (car response)) + (if (not (eq (car r) 'atom)) + nil + (if (save-excursion + (goto-char (nth 1 r)) + (let ((case-fold-search t)) + (eq (re-search-forward "AUTH=." (nth 2 r) t) + (+ 6 (nth 1 r))))) + (progn + (setq auth-list (cons (intern + (upcase (buffer-substring + (+ 5 (nth 1 r)) + (nth 2 r)))) + auth-list))) + (setq r (car response)) + (if (not (eq (car r) 'atom)) + nil + (setq cap-list (cons (intern + (upcase (buffer-substring + (nth 1 r) (nth 2 r)))) + cap-list))))) + (setq response (cdr response)))))) + (if (or cap-list auth-list) + (list (nreverse cap-list) (nreverse auth-list)) + nil))) + +(defun vm-imap-read-greeting (process) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + ;;---------------------------------- + (vm-imap-log-token 'read-greeting) + (let (response) + (setq response (vm-imap-read-response process)) + (cond ((vm-imap-response-matches response '* 'OK) + t ) + ((vm-imap-response-matches response '* 'PREAUTH) + 'preauth ) + (t nil)))) + +(defun vm-imap-read-ok-response (process) + ;;---------------------------------- + (vm-buffer-type:assert 'process) + ;;---------------------------------- + (vm-imap-log-token 'read-ok) + (let (response retval (done nil)) + (while (not done) + (setq response (vm-imap-read-response process)) + (cond ((vm-imap-response-matches response '*) + nil ) + ((vm-imap-response-matches response 'VM 'OK) + (setq retval t done t)) + ((vm-imap-response-matches response 'VM 'NO) + (setq retval nil done t)) + ((vm-imap-response-matches response 'VM 'BAD) + (setq retval nil done t) + (vm-imap-normal-error "Server said BAD")) + (t + (vm-imap-protocol-error "Did not receive OK response")))) + retval )) + +(defun vm-imap-cleanup-region (start end) + (setq end (vm-marker end)) + (save-excursion + (goto-char start) + ;; CRLF -> LF + (while (and (< (point) end) (search-forward "\r\n" end t)) + (replace-match "\n" t t))) + (set-marker end nil)) + +(defun vm-imap-read-response (process) + ;; Reads a line of respose from the imap PROCESS + ;;-------------------------------------------- + ;; This assertion often fails for some reason, + ;; perhaps some asynchrony involved? + ;; Assertion check being disabled unless debugging is on. + (if vm-buffer-type-debug + (vm-buffer-type:assert 'process)) + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'read vm-buffer-type-trail))) + ;;-------------------------------------------- + (vm-imap-log-tokens (list 'response vm-imap-read-point)) + (let ((list nil) tail obj) + (when vm-buffer-type-debug + (unless vm-imap-read-point + (debug nil "vm-imap-read-response: null vm-imap-read-point"))) + (goto-char vm-imap-read-point) + (catch 'done + (while t + (setq obj (vm-imap-read-object process)) + (if (eq (car obj) 'end-of-line) + (throw 'done list)) + (if (null list) + (setq list (cons obj nil) + tail list) + (setcdr tail (cons obj nil)) + (setq tail (cdr tail))))))) + +(defun vm-imap-read-response-and-verify (process &optional command-desc) + ;; Reads a line of response from the imap PROCESS and checks for + ;; standard errors like "BAD" and "BYE". Optional COMMAND-DESC is a + ;; command description that can be printed with the error message. + ;;-------------------------------------------- + ;; This assertion often fails for some reason, + ;; perhaps some asynchrony involved? + ;; Assertion check being disabled unless debugging is on. + (if vm-buffer-type-debug + (vm-buffer-type:assert 'process)) + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'verify vm-buffer-type-trail))) + ;;-------------------------------------------- + (let ((response (vm-imap-read-response process))) + (if (vm-imap-response-matches response 'VM 'NO) + (vm-imap-normal-error (format "server said NO"))) + (if (vm-imap-response-matches response 'VM 'BAD) + (vm-imap-normal-error (format "server said BAD"))) + (if (vm-imap-response-matches response '* 'BYE) + (vm-imap-normal-error (format "server disconnected"))) + response)) + + +(defun vm-imap-read-object (process &optional skip-eol) + ;;---------------------------------- + ;; Originally, this assertion failed often for some reason, + ;; perhaps some asynchrony involved? + ;; It has been mostly chased up by now. (Nov 2009) + ;; Still assertion check being disabled unless debugging is on. + (when vm-buffer-type-debug + (vm-buffer-type:assert 'process)) + (vm-imap-log-tokens (list 'object (current-buffer))) + ;;---------------------------------- + (let ((done nil) + opoint + (token nil)) + (unwind-protect + (while (not done) ; object continuing + (skip-chars-forward " \t") + (cond ((< (- (point-max) (point)) 2) + (setq opoint (point)) + (vm-imap-check-connection process) + ;; point might change here? + (vm-accept-process-output process) + (goto-char opoint)) + ((looking-at "\r\n") + (forward-char 2) + (setq token '(end-of-line) done (not skip-eol))) + ((looking-at "\n") + (vm-warn 0 2 + "missing CR before LF - possible connection problem") + (forward-char 1) + (setq token '(end-of-line) done (not skip-eol))) + ((looking-at "\\[") + (forward-char 1) + (let* ((list (list 'vector)) + (tail list) + obj) + (setq obj (vm-imap-read-object process t)) + (while (not (eq (car obj) 'close-bracket)) + (when (eq (car obj) 'close-paren) + (vm-imap-protocol-error "unexpected )")) + (setcdr tail (cons obj nil)) + (setq tail (cdr tail)) + (setq obj (vm-imap-read-object process t))) + (setq token list done t))) + ((looking-at "\\]") + (forward-char 1) + (setq token '(close-bracket) done t)) + ((looking-at "(") + (forward-char 1) + (let* ((list (list 'list)) + (tail list) + obj) + (setq obj (vm-imap-read-object process t)) + (while (not (eq (car obj) 'close-paren)) + (when (eq (car obj) 'close-bracket) + (vm-imap-protocol-error "unexpected ]")) + (setcdr tail (cons obj nil)) + (setq tail (cdr tail)) + (setq obj (vm-imap-read-object process t))) + (setq token list done t))) + ((looking-at ")") + (forward-char 1) + (setq token '(close-paren) done t)) + ((looking-at "{") + ;; string ::= { n-octets } end-of-line octets... + (forward-char 1) + (let (start obj n-octets) + ;; better check if we have a number here because + ;; gmail sometimes puts random stuff. + (if (not (save-excursion + (looking-at "[0-9]*}"))) + (setq token '(open-brace) done t) + (setq obj (vm-imap-read-object process)) + (unless (eq (car obj) 'atom) + (vm-imap-protocol-error "number expected after {")) + (setq n-octets (string-to-number + (buffer-substring (nth 1 obj) + (nth 2 obj)))) + (setq obj (vm-imap-read-object process)) + (unless (eq (car obj) 'close-brace) + (vm-imap-protocol-error "} expected")) + (setq obj (vm-imap-read-object process)) + (unless (eq (car obj) 'end-of-line) + (vm-imap-protocol-error "CRLF expected")) + (setq start (point)) + (while (< (- (point-max) start) n-octets) + (vm-imap-check-connection process) + ;; point might change here? USR, 2011-03-16 + (vm-accept-process-output process)) + (goto-char (+ start n-octets)) + (setq token (list 'string start (point)) + done t)))) + ((looking-at "}") + (forward-char 1) + (setq token '(close-brace) done t)) + ((looking-at "\042") ;; double quote + (forward-char 1) + (let ((start (point)) + (curpoint (point))) + (while (not done) + (skip-chars-forward "^\042") + (setq curpoint (point)) + (if (looking-at "\042") + (progn + (setq done t) + (forward-char 1)) + (vm-imap-check-connection process) + ;; point might change here? + (vm-accept-process-output process) + (goto-char curpoint)) + (setq token (list 'string start curpoint))))) + ;; should be (looking-at "[\000-\040\177-\377]") + ;; but Microsoft Exchange emits 8-bit chars. + ((and (looking-at "[\000-\040\177]") + (= vm-imap-tolerant-of-bad-imap 0)) + (vm-imap-protocol-error "illegal char (%d)" + (char-after (point)))) + (t + (let ((start (point)) + (curpoint (point)) + ;; We should be considering 8-bit chars as + ;; non-word chars also but Microsoft Exchange + ;; uses them, despite the RFC 2060 prohibition. + ;; If we ever resume disallowing 8-bit chars, + ;; remember to write the range as \177-\376 ... + ;; \376 instead of \377 because Emacs 19.34 has + ;; a bug in the fastmap initialization code + ;; that causes it to infloop. + (not-word-chars "^\000-\040\177()[]{}") + (not-word-regexp "[][\000-\040\177(){}]")) + (while (not done) + (skip-chars-forward not-word-chars) + (setq curpoint (point)) + (if (looking-at not-word-regexp) + (setq done t) + (vm-imap-check-connection process) + ;; point might change here? + (vm-accept-process-output process) + (goto-char curpoint)) + (vm-imap-log-token (buffer-substring start curpoint)) + (setq token (list 'atom start curpoint))))))) + ;; unwind-protections + (setq vm-imap-read-point (point)) + (vm-imap-log-token vm-imap-read-point) + (vm-imap-log-token token)) + token )) + +(defun vm-imap-response-matches (response &rest expr) + "Checks if a REPSONSE from the IMAP server matches the pattern +EXPR. The syntax of patterns is: + + expr ::= quoted-symbol | 'atom | 'string | ('vector expr*) | ('list expr*) + +Numbers are included among atoms." + (let ((case-fold-search t) e r) + (catch 'done + (while (and expr response) + (setq e (car expr) + r (car response)) + (cond ((stringp e) + (if (or (not (eq (car r) 'string)) + (save-excursion + (goto-char (nth 1 r)) + (not (eq (search-forward e (nth 2 r) t) (nth 2 r))))) + (throw 'done nil))) + ((numberp e) + (if (or (not (eq (car r) 'atom)) + (save-excursion + (goto-char (nth 1 r)) + (not (eq (search-forward (int-to-string e) + (nth 2 r) t) + (nth 2 r))))) + (throw 'done nil))) + ((consp e) + (if (not (eq (car e) (car r))) + (throw 'done nil)) + (apply 'vm-imap-response-matches (cdr r) (cdr e))) + ((eq e 'atom) + (if (not (eq (car r) 'atom)) + (throw 'done nil))) + ((eq e 'vector) + (if (not (eq (car r) 'vector)) + (throw 'done nil))) + ((eq e 'list) + (if (not (eq (car r) 'list)) + (throw 'done nil))) + ((eq e 'string) + (if (not (eq (car r) 'string)) + (throw 'done nil))) + ;; this must to come after all the comparisons for + ;; specific symbols. + ((symbolp e) + (if (or (not (eq (car r) 'atom)) + (save-excursion + (goto-char (nth 1 r)) + (not (eq (search-forward (symbol-name e) (nth 2 r) t) + (nth 2 r))))) + (throw 'done nil)))) + (setq response (cdr response) + expr (cdr expr))) + t ))) + +(defun vm-imap-bail-if-server-says-farewell (response) + (if (vm-imap-response-matches response '* 'BYE) + (throw 'end-of-session t))) + +(defun vm-imap-scan-list-for-flag (list flag) + (setq list (cdr list)) + (let ((case-fold-search t) e) + (catch 'done + (while list + (setq e (car list)) + (if (not (eq (car e) 'atom)) + nil + (goto-char (nth 1 e)) + (if (eq (search-forward flag (nth 2 e) t) (nth 2 e)) + (throw 'done t))) + (setq list (cdr list))) + nil ))) + +;; like Lisp get but for IMAP property lists like those returned by FETCH. +(defun vm-imap-plist-get (list name) + (setq list (cdr list)) + (let ((case-fold-search t) e) + (catch 'done + (while list + (setq e (car list)) + (if (not (eq (car e) 'atom)) + nil + (goto-char (nth 1 e)) + (if (eq (search-forward name (nth 2 e) t) (nth 2 e)) + (throw 'done (car (cdr list))))) + (setq list (cdr (cdr list)))) + nil ))) + +(defun vm-imap-quote-string (string) + (vm-with-string-as-temp-buffer string 'vm-imap-quote-buffer)) + +(defun vm-imap-quote-buffer () + (goto-char (point-min)) + (insert "\"") + (while (re-search-forward "[\"\\]" nil t) + (forward-char -1) + (insert "\\") + (forward-char 1)) + (goto-char (point-max)) + (insert "\"")) + +(defun vm-imap-poke-session (process) + "Poke the IMAP session by sending a NOOP command, just to make sure +that the session is active. Returns t or nil." + (if (and process (memq (process-status process) '(open run)) + (buffer-live-p (process-buffer process))) + (if vm-imap-ensure-active-sessions + (let ((buffer (process-buffer process))) + (with-current-buffer buffer + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (vm-imap-send-command process "NOOP") + (condition-case err + (let ((response nil) + (need-ok t)) + (while need-ok + (setq response + (vm-imap-read-response-and-verify process "NOOP")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + ;;---------------------------- + (vm-buffer-type:exit) + ;;---------------------------- + t) + (vm-imap-protocol-error ; handler + ;;-------------------- + (vm-buffer-type:exit) + ;;-------------------- + nil)))) ; ignore errors + t) + nil)) + +(defun vm-re-establish-folder-imap-session (&optional interactive purpose + just-retrieve) + "If the IMAP session for the current folder has died, +re-establish a new one. Optional argument PURPOSE is inserted +into the process buffer for tracing purposes. Optional argument +JUST-RETRIEVE says whether the session will only be used for +retrieval of mail. Returns the IMAP process or nil if +unsuccessful." + (let ((process (vm-folder-imap-process)) temp) + (if (and (processp process) + (vm-imap-poke-session process)) + process + (when process + (vm-imap-end-session process)) + (vm-establish-new-folder-imap-session + interactive purpose just-retrieve)))) + +(defun vm-establish-new-folder-imap-session (&optional interactive purpose + just-retrieve) + "Kill and restart the IMAP session for the current folder. +Optional argument PURPOSE is inserted into the process buffer for +tracing purposes. Optional argument JUST-RETRIEVE says whether +the session will only be used for retrieval of mail. Returns the +IMAP process or nil if unsuccessful." + ;; This is necessary because we might get unexpected EXPUNGE responses + ;; which we don't know how to deal with. + + (let (process + (vm-imap-ok-to-ask interactive) + mailbox select mailbox-count recent-count uid-validity permanent-flags + read-write can-delete body-peek) + (if (vm-folder-imap-process) + (vm-imap-end-session (vm-folder-imap-process))) + (vm-imap-log-token 'new) + (setq process + (vm-imap-make-session (vm-folder-imap-maildrop-spec) + interactive purpose)) + (when (processp process) + (vm-set-folder-imap-process process) + (setq mailbox (vm-imap-parse-spec-to-list (vm-folder-imap-maildrop-spec)) + mailbox (nth 3 mailbox)) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (setq select (vm-imap-select-mailbox process mailbox just-retrieve)) + (setq mailbox-count (nth 0 select) + recent-count (nth 1 select) + uid-validity (nth 2 select) + read-write (nth 3 select) + can-delete (nth 4 select) + permanent-flags (nth 5 select) + body-peek (vm-imap-capability 'IMAP4REV1)) + ;;--------------------------------- + (vm-imap-session-type:set 'active) + ;;--------------------------------- + ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when (and (vm-folder-imap-uid-validity) + (not (equal (vm-folder-imap-uid-validity) uid-validity))) + (unless (y-or-n-p + (concat "Folder's UID VALIDITY value has changed " + "on the server. Refresh cache? ")) + (error "Aborted")) + (vm-warn 5 4 + (concat "VM will download new copies of messages" + " and mark the old ones for deletion")) + (setq vm-imap-retrieved-messages + (vm-imap-clear-invalid-retrieval-entries + (vm-folder-imap-maildrop-spec) + vm-imap-retrieved-messages + uid-validity)) + (vm-mark-folder-modified-p (current-buffer)))) + + (vm-set-folder-imap-uid-validity uid-validity) ; unique per session + (vm-set-folder-imap-mailbox-count mailbox-count) + (unless (vm-folder-imap-retrieved-count) + (vm-set-folder-imap-retrieved-count mailbox-count)) + (vm-set-folder-imap-recent-count recent-count) + (vm-set-folder-imap-read-write read-write) + (vm-set-folder-imap-can-delete can-delete) + (vm-set-folder-imap-body-peek body-peek) + (vm-set-folder-imap-permanent-flags permanent-flags) + ;;------------------------------- + (vm-imap-dump-uid-and-flags-data) + ;;------------------------------- + process ))) + +(defun vm-re-establish-writable-imap-session (&optional interactive purpose) + "If the IMAP session for the current folder has died, re-establish a +new one. Returns the IMAP process or nil if unsuccessful." + (let ((process (vm-folder-imap-process)) temp) + (if (and (processp process) + (vm-imap-poke-session process)) + process + (if process + (vm-imap-end-session process)) + (vm-establish-writable-imap-session interactive purpose)))) + +(defun vm-establish-writable-imap-session (maildrop &optional + interactive purpose) + "Create a new writable IMAP session for MAILDROP and return the process. +Optional argument PURPOSE is inserted into the process buffer for +tracing purposes. Returns the IMAP process or nil if unsuccessful." + (let (process + (vm-imap-ok-to-ask interactive) + mailbox select mailbox-count recent-count uid-validity permanent-flags + read-write can-delete body-peek) + (vm-imap-log-token 'new) + (setq process + (vm-imap-make-session maildrop interactive purpose)) + (if (processp process) + (unwind-protect + (save-current-buffer + (setq mailbox (vm-imap-parse-spec-to-list maildrop) + mailbox (nth 3 mailbox)) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (set-buffer (process-buffer process)) + (setq select (vm-imap-select-mailbox process mailbox nil)) + (setq mailbox-count (nth 0 select) + recent-count (nth 1 select) + uid-validity (nth 2 select) + read-write (nth 3 select) + can-delete (nth 4 select) + permanent-flags (nth 5 select) + body-peek (vm-imap-capability 'IMAP4REV1)) + ;;--------------------------------- + (vm-imap-session-type:set 'active) + (vm-buffer-type:exit) + ;;--------------------------------- + (if read-write + process + (vm-imap-end-session process) + nil)) + ;; unwind-protections + ;;-------------------- + (vm-buffer-type:exit) + ;;-------------------- + ) + nil))) + + +(defun vm-kill-folder-imap-session (&optional interactive) + (let ((process (vm-folder-imap-process))) + (if (processp process) + (vm-imap-end-session process)))) + +(defun vm-imap-retrieve-uid-and-flags-data () + "Retrieve the uid's and message flags for all the messages on the +IMAP server in the current mail box. The results are stored in +`vm-folder-access-data' in the fields imap-uid-list, imap-uid-obarray +and imap-flags-obarray. +Throws vm-imap-protocol-error for failure. + +This function is preferable to `vm-imap-get-uid-list' because it +fetches flags in addition to uid's and stores them in obarrays." + ;;------------------------------ + (if vm-buffer-type-debug + (setq vm-buffer-type-trail + (cons 'uid-and-flags-data vm-buffer-type-trail))) + (vm-buffer-type:assert 'folder) + ;;------------------------------ + (if (vm-folder-imap-uid-list) + nil ; don't retrieve twice + (let ((there (make-vector 67 0)) + (flags (make-vector 67 0)) + (process (vm-folder-imap-process)) + (mailbox-count (vm-folder-imap-mailbox-count)) + list tuples tuple uid) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (if (eq mailbox-count 0) + (setq list nil) + (setq list (vm-imap-get-message-data-list + process 1 mailbox-count))) + (setq tuples list) + (while tuples + (setq tuple (car tuples)) + (set (intern (cadr tuple) there) (car tuple)) + (set (intern (cadr tuple) flags) (nthcdr 2 tuple)) + (setq tuples (cdr tuples))) + ;;------------------------------- + (vm-imap-session-type:set 'valid) + ;;------------------------------- + ) + ;; unwind-protections + ;; --------------------- + (vm-buffer-type:exit) + ;; --------------------- + ) + ;; Clear the old obarrays to make sure no space leaks + (let ((uid-obarray (vm-folder-imap-uid-obarray)) + (flags-obarray (vm-folder-imap-flags-obarray))) + (mapc (function + (lambda (uid) + (unintern uid uid-obarray) + (unintern uid flags-obarray))) + (vm-folder-imap-uid-list))) + ;; Assign the new data + (vm-set-folder-imap-uid-list list) + (vm-set-folder-imap-uid-obarray there) + (vm-set-folder-imap-flags-obarray flags)))) + +(defun vm-imap-dump-uid-and-flags-data () + (when (and vm-folder-access-data + (eq (car vm-buffer-types) 'folder)) + + ;;------------------------------ + (vm-buffer-type:assert 'folder) + ;;------------------------------ + (vm-set-folder-imap-uid-list nil) + (vm-set-folder-imap-uid-obarray nil) + (vm-set-folder-imap-flags-obarray nil) + (if (processp (vm-folder-imap-process)) + (with-current-buffer (process-buffer (vm-folder-imap-process)) + ;;--------------------------------- + (vm-imap-session-type:set 'active) + ;;--------------------------------- + )) + )) + +(defun vm-imap-dump-uid-seq-num-data () + (when (and vm-folder-access-data + (eq (car vm-buffer-types) 'folder)) + + ;;------------------------------ + (vm-buffer-type:assert 'folder) + ;;------------------------------ + (vm-set-folder-imap-uid-list nil) + (vm-set-folder-imap-uid-obarray nil) + (if (processp (vm-folder-imap-process)) + (with-current-buffer (process-buffer (vm-folder-imap-process)) + ;;--------------------------------- + (vm-imap-session-type:set 'active) + ;;--------------------------------- + )) + )) + +;; This function is now obsolete. It is faster to get flags of +;; several messages at once, using vm-imap-get-message-data-list + +(defun vm-imap-get-message-flags (process m &optional norecord) + ;; gives an error if the message has an invalid uid + (let (need-ok p r flag response saw-Seen) + (unless (equal (vm-imap-uid-validity-of m) + (vm-folder-imap-uid-validity)) + (vm-imap-normal-error "message UIDVALIDITY does not match the server")) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command process + (format "UID FETCH %s (FLAGS)" + (vm-imap-uid-of m))) + ;;-------------------------------- + (vm-imap-session-type:set 'active) + ;;-------------------------------- + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify + process "UID FETCH (FLAGS)")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'atom 'FETCH 'list) + (setq r (nthcdr 3 response) + r (car r) + r (vm-imap-plist-get r "FLAGS") + r (cdr r)) + (while r + (setq p (car r)) + (if (not (eq (car p) 'atom)) + nil + (setq flag (downcase (buffer-substring (nth 1 p) (nth 2 p)))) + (cond ((string= flag "\\answered") + (vm-set-replied-flag m t norecord)) + ((string= flag "\\deleted") + (vm-set-deleted-flag m t norecord)) + ((string= flag "\\flagged") + (vm-set-flagged-flag m t norecord)) + ((string= flag "\\seen") + (vm-set-unread-flag m nil norecord) + (vm-set-new-flag m nil norecord) + (setq saw-Seen t)) + ((string= flag "\\recent") + (vm-set-new-flag m t norecord)))) + (setq r (cdr r))) + (if (not saw-Seen) + (vm-set-unread-flag m t norecord)))))) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +(defun vm-imap-update-message-flags (m flags &optional norecord) + "Update the flags of the message M in the folder to imap flags FLAGS. +Optional argument NORECORD says whether this fact should not be +recorded in the undo stack." + (let (flag saw-Seen saw-Deleted saw-Flagged seen-labels labels) + (while flags + (setq flag (car flags)) + (cond ((string= flag "\\answered") + (when (null (vm-replied-flag m)) + (vm-set-replied-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + ((string= flag "\\deleted") + (when (null (vm-deleted-flag m)) + (vm-set-deleted-flag m t norecord) + (vm-set-stuff-flag-of m t)) + (setq saw-Deleted t)) + + ((string= flag "\\flagged") + (when (null (vm-flagged-flag m)) + (vm-set-flagged-flag m t norecord) + (vm-set-stuff-flag-of m t)) + (setq saw-Flagged t)) + + ((string= flag "\\seen") + (when (vm-unread-flag m) + (vm-set-unread-flag m nil norecord) + (vm-set-stuff-flag-of m t)) + (when (vm-new-flag m) + (vm-set-new-flag m nil norecord) + (vm-set-stuff-flag-of m t)) + (setq saw-Seen t)) + + ((string= flag "\\recent") + (when (null (vm-new-flag m)) + (vm-set-new-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + ((string= flag "forwarded") + (when (null (vm-forwarded-flag m)) + (vm-set-forwarded-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + ((string= flag "redistributed") + (when (null (vm-redistributed-flag m)) + (vm-set-redistributed-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + ((string= flag "filed") + (when (null (vm-filed-flag m)) + (vm-set-filed-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + ((string= flag "written") + (when (null (vm-written-flag m)) + (vm-set-written-flag m t norecord) + (vm-set-stuff-flag-of m t))) + + (t ; all other flags including \flagged + (setq seen-labels (cons flag seen-labels))) + ) + (setq flags (cdr flags))) + + (if (not saw-Seen) ; unread if the server says so + (if (null (vm-unread-flag m)) + (vm-set-unread-flag m t norecord))) + (if (not saw-Deleted) ; undelete if the server says so + (if (vm-deleted-flag m) + (vm-set-deleted-flag m nil norecord))) + (setq labels (sort (vm-labels-of m) 'string-lessp)) + (setq seen-labels (sort seen-labels 'string-lessp)) + (if (equal labels seen-labels) + t + (vm-set-labels-of m seen-labels) + (vm-set-label-string-of m nil) + (vm-mark-for-summary-update m) + (vm-set-stuff-flag-of m t)) + )) + +(defun vm-imap-save-message-flags (process m &optional by-uid) + "Saves the message flags of a message on the IMAP server, +adding or deleting flags on the server as necessary. Monotonic +flags, however, are not deleted. + +Optional argument BY-UID says that the save commands to the +server should be issued by UID, not message sequence number." + + ;; Comment by USR + ;; According to RFC 2060, it is not an error to store flags that + ;; are not listed in PERMANENTFLAGS. Removed unnecessary checks to + ;; this effect. + + ;; There are + ;; - monotonic flags that can only be set, and + ;; - reversible flags that can be set or unset. + ;; For monotonic flags that are set in VM, we set them on the + ;; server. + ;; For reversible flags, we copy the state from VM to the server. + ;; (We don't know which one has precedence, but we punt that issue.) + ;; The cache needs to be maintained consistently. + + ;;----------------------------------------------------- + (vm-buffer-type:assert 'folder) + (or by-uid (vm-imap-folder-session-type:assert 'valid)) + ;;----------------------------------------------------- + (if (not (equal (vm-imap-uid-validity-of m) + (vm-folder-imap-uid-validity))) + (vm-imap-normal-error "message UIDVALIDITY does not match the server")) + (let* ((uid (vm-imap-uid-of m)) + (uid-key1 (intern uid (vm-folder-imap-uid-obarray))) + (uid-key2 (intern-soft uid (vm-folder-imap-flags-obarray))) + (message-num (and (boundp uid-key1) (symbol-value uid-key1))) + (cached-flags (and (boundp uid-key2) (symbol-value uid-key2))) + ; leave uid as the dummy header + (labels (vm-labels-of m)) + copied-flags need-ok flags+ flags- response) + (when message-num + ;; Reversible flags are treated the same as labels + (if (not (vm-unread-flag m)) + (setq labels (cons "\\seen" labels))) + (if (vm-deleted-flag m) + (setq labels (cons "\\deleted" labels))) + (if (vm-flagged-flag m) + (setq labels (cons "\\flagged" labels))) + ;; Irreversible flags + (if (and (vm-replied-flag m) + (not (member "\\answered" cached-flags))) + (setq flags+ (cons "\\Answered" flags+))) + (if (and (vm-filed-flag m) (not (member "filed" cached-flags))) + (setq flags+ (cons "filed" flags+))) + (if (and (vm-written-flag m) + (not (member "written" cached-flags))) + (setq flags+ (cons "written" flags+))) + (if (and (vm-forwarded-flag m) + (not (member "forwarded" cached-flags))) + (setq flags+ (cons "forwarded" flags+))) + (if (and (vm-redistributed-flag m) + (not (member "redistributed" cached-flags))) + (setq flags+ (cons "redistributed" flags+))) + (mapc (lambda (flag) (delete flag cached-flags)) + '("\\answered" "filed" "written" "forwarded" "redistributed")) + ;; make copies for side effects + (setq copied-flags (copy-sequence cached-flags)) + (setq labels (cons nil (copy-sequence labels))) + ;; Ignore labels that are both in vm and the server + (delete-common-elements labels copied-flags 'string<) + ;; Ignore reversible flags that we have locally reversed -- Why? + ;; (mapc (lambda (flag) (delete flag copied-flags)) + ;; '("\\seen" "\\deleted" "\\flagged")) + ;; Flags to be added to the server + (setq flags+ (append (cdr labels) flags+)) + ;; Flags to be deleted from the server + (setq flags- (append (cdr copied-flags) flags-)) + + (unwind-protect + (save-excursion ; = save-current-buffer? + (set-buffer (process-buffer process)) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------------- + (when flags+ + (vm-imap-send-command + process + (format "%sSTORE %s +FLAGS.SILENT %s" + (if by-uid "UID " "") + (if by-uid uid message-num) + (mapc 'intern flags+))) + (setq need-ok t) + (while need-ok + (setq response + (vm-imap-read-response-and-verify + process "STORE +FLAGS.SILENT")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + (nconc cached-flags flags+)) + + (when flags- + (vm-imap-send-command + process + (format "%sSTORE %s -FLAGS.SILENT %s" + (if by-uid "UID " "") + (if by-uid uid message-num) + (mapc 'intern flags-))) + (setq need-ok t) + (while need-ok + (setq response + (vm-imap-read-response-and-verify + process "STORE -FLAGS.SILENT")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + (while flags- + (delete (car flags-) cached-flags) + (setq flags- (cdr flags-)))) + + (vm-set-attribute-modflag-of m nil) + ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + )))) + +(defvar vm-imap-subst-char-in-string-buffer + (get-buffer-create " *subst-char-in-string*")) + +(defun vm-imap-subst-CRLF-for-LF (string) + (with-current-buffer vm-imap-subst-char-in-string-buffer + (erase-buffer) + (insert string) + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (replace-match "\r\n" nil t)) + (buffer-substring-no-properties (point-min) (point-max)))) + +;;;###autoload +(defun vm-imap-save-message (process m mailbox) + "Using the IMAP process PROCESS, save the message M to IMAP mailbox +MAILBOX." + (let (need-ok need-plus flags response string) + ;; save the message's flag along with it. + ;; don't save the deleted flag. + (if (vm-replied-flag m) + (setq flags (cons (intern "\\Answered") flags))) + (if (not (vm-unread-flag m)) + (setq flags (cons (intern "\\Seen") flags))) + (with-current-buffer (vm-buffer-of m) + ;;---------------------------- + (vm-buffer-type:enter 'folder) + ;;---------------------------- + (save-restriction + (widen) + (setq string (buffer-substring (vm-headers-of m) (vm-text-end-of m)) + string (vm-imap-subst-CRLF-for-LF string))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ) + (unwind-protect + (save-excursion ; = save-current-buffer? + (set-buffer (process-buffer process)) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (condition-case nil + (vm-imap-create-mailbox process mailbox) + ;; ignore errors + (vm-imap-protocol-error (vm-buffer-type:set 'process))) + ;;---------------------------------- + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command process + (format "APPEND %s %s {%d}" + (vm-imap-quote-string mailbox) + (if flags flags "()") + (length string))) + ;;-------------------------------- + (vm-imap-session-type:set 'active) + ;;-------------------------------- + (setq need-plus t) + (while need-plus + (setq response (vm-imap-read-response-and-verify process "APPEND")) + (cond ((vm-imap-response-matches response '+) + (setq need-plus nil)))) + (vm-imap-send-command process string nil t) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify + process "APPEND data")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)))) + ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +;; Incomplete -- Yet to be finished. USR +;; creation of new mailboxes has to be straightened out + +(defun vm-imap-copy-message (process m mailbox) + "Use IMAP session PROCESS to copy message M to MAILBOX. The PROCESS +is expected to have logged in and selected the current folder. + +This is similar to `vm-imap-save-message' but uses the internal copy +operation of the server to minimize I/O." + ;;----------------------------- + (vm-buffer-type:set 'folder) + ;;----------------------------- + (let ((uid (vm-imap-uid-of m)) + (uid-validity (vm-imap-uid-validity-of m)) + need-ok response string) + (if (not (equal uid-validity (vm-folder-imap-uid-validity))) + (error "Message does not have a valid UID")) + (unwind-protect + (save-excursion + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (if (vm-attribute-modflag-of m) + (condition-case nil + (progn + (if (null (vm-folder-imap-flags-obarray)) + (vm-imap-retrieve-uid-and-flags-data)) + (vm-imap-save-message-flags process m 'by-uid)) + (vm-imap-protocol-error nil))) ; is this right? + ;; (condition-case nil + ;; (vm-imap-create-mailbox process mailbox) + ;; (vm-imap-protocol-error nil)) + + (set-buffer (process-buffer process)) + ;;----------------------------------------- + (vm-buffer-type:set 'process) + (vm-imap-session-type:assert-active) + ;;----------------------------------------- + (vm-imap-send-command + process + (format "UID COPY %s %s" + (vm-imap-uid-of m) + (vm-imap-quote-string mailbox))) + ;;-------------------------------- + (vm-imap-session-type:set 'active) + ;;-------------------------------- + (setq need-ok t) + (while need-ok + (setq response + (vm-imap-read-response-and-verify process "UID COPY")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil))))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +;; ------------------------------------------------------------------------ +;; +;;; interactive commands: +;; +;; vm-create-imap-folder: string -> void +;; vm-delete-imap-folder: string -> void +;; vm-rename-imap-folder: string & string -> void +;; +;; top-level operations +;; vm-fetch-imap-message: (vm-message) -> void +;; vm-imap-synchronize-folder: +;; (&optional :interactive bool & +;; :do-remote-expunges nil|t|'all & +;; :do-local-expunges bool & +;; :do-retrieves bool & +;; :save-attributes nil|t|'all & +;; :retrieve-attributes bool) -> void +;; vm-imap-save-attributes: (&optional :interactive bool & +;; :all-flags bool) -> void +;; vm-imap-folder-check-mail: (&optional interactive) -> ? +;; +;; vm-imap-get-synchronization-data: (&optional bool) -> +;; (retrieve-list: (uid . int) list & +;; remote-expunge-list: (uid . uidvalidity) list & +;; local-expunge-list: vm-message list & +;; stale-list: vm-message list) +;; +;; ------------------------------------------------------------------------ + + + +(defun vm-imap-get-synchronization-data (&optional do-retrieves) + "Compares the UID's of messages in the local cache and the IMAP +server. Returns a list containing: +RETRIEVE-LIST: A list of pairs consisting of UID's and message + sequence numbers of the messages that are not present in the + local cache and not retrieved previously, and, hence, need to be + retrieved now. +REMOTE-EXPUNGE-LIST: A list of pairs consisting of UID's and + UIDVALIDITY's of the messages that are not present in the local + cache (but we have reason to believe that they have been retrieved + previously) and, hence, need to be expunged on the server. +LOCAL-EXPUNGE-LIST: A list of message descriptors for messages in the + local cache which are not present on the server and, hence, need + to expunged locally. +STALE-LIST: A list of message descriptors for messages in the + local cache whose UIDVALIDITY values are stale. +If the argument DO-RETRIEVES is 'full, then all the messages that +are not presently in cache are retrieved. Otherwise, the +messages previously retrieved are ignored." + + ;; Comments by USR + ;; - Originally, messages with stale UIDVALIDITY values were + ;; ignored. So, they would never get expunged from the cache. The + ;; STALE-LIST component was added to fix this. + + ;;----------------------------- + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'synchronization-data + vm-buffer-type-trail))) + (vm-buffer-type:assert 'folder) + ;;----------------------------- + (let ((here (make-vector 67 0)) ; OBARRAY(uid, vm-message) + there flags + (uid-validity (vm-folder-imap-uid-validity)) + (do-full-retrieve (eq do-retrieves 'full)) + retrieve-list remote-expunge-list local-expunge-list stale-list uid + mp retrieved-entry) + (vm-imap-retrieve-uid-and-flags-data) + (setq there (vm-folder-imap-uid-obarray)) + ;; Figure out stale uidvalidity values and messages to be expunged + ;; in the cache. + (setq mp vm-message-list) + (while mp + (cond ((not (equal (vm-imap-uid-validity-of (car mp)) uid-validity)) + (setq stale-list (cons (car mp) stale-list))) + ((member "stale" (vm-labels-of (car mp))) + nil) + (t + (setq uid (vm-imap-uid-of (car mp))) + (set (intern uid here) (car mp)) + (if (not (boundp (intern uid there))) + (setq local-expunge-list (cons (car mp) local-expunge-list))))) + (setq mp (cdr mp))) + ;; Figure out messages that need to be retrieved + (mapatoms (lambda (sym) + (let ((uid (symbol-name sym))) + (unless (boundp (intern uid here)) + ;; message not in cache. if it has been retrieved + ;; previously, it needs to be expunged on the server. + ;; otherwise, it needs to be retrieved. + (setq retrieved-entry + (vm-find vm-imap-retrieved-messages + (lambda (entry) + (and (equal (car entry) uid) + (equal (cadr entry) uid-validity))))) + (if (or do-full-retrieve + (null retrieved-entry)) ; already retrieved + (setq retrieve-list + (cons (cons uid (symbol-value sym)) + retrieve-list)) + (setq remote-expunge-list + (cons (cons uid uid-validity) + remote-expunge-list)))))) + there) + (setq retrieve-list + (sort retrieve-list + (lambda (**pair1 **pair2) + (< (cdr **pair1) (cdr **pair2))))) + (list retrieve-list remote-expunge-list local-expunge-list stale-list))) + +(defun vm-imap-server-error (msg &rest args) + (if (eq vm-imap-connection-mode 'online) + (apply (function error) msg args) + (vm-inform 1 "VM working in offline mode"))) + +;;;###autoload +(defun* vm-imap-synchronize-folder (&key + (interactive nil) + (do-remote-expunges nil) + (do-local-expunges nil) + (do-retrieves nil) + (save-attributes nil) + (retrieve-attributes nil)) + "Synchronize IMAP folder with the server. + INTERACTIVE, true if the function was invoked interactively, e.g., as + vm-get-spooled-mail. + DO-REMOTE-EXPUNGES indicates whether the server mail box should be + expunged. If it is 'all, then all messages not present in the cache folder + are expunged. + DO-LOCAL-EXPUNGES indicates whether the cache buffer should be + expunged. + DO-RETRIEVES indicates if new messages that are not already in the + cache should be retrieved from the server. If this flag is 'full + then messages previously retrieved but not in cache are retrieved + as well. + SAVE-ATTRIBUTES indicates if the message attributes should be updated on + the server. If it is 'all, then the attributes of all messages are + updated irrespective of whether they were modified or not. + RETRIEVE-ATTRIBTUES indicates if the message attributes on the server + should be retrieved, updating the cache. +" + ;; -- Comments by USR + ;; Not clear why do-local-expunges and do-remote-expunges should be + ;; separate. It doesn't make sense to do one but not the other! + + ;;-------------------------- + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'synchronize vm-buffer-type-trail))) + (vm-buffer-type:set 'folder) + (vm-imap-init-log) + (vm-imap-log-tokens (list 'synchronize (current-buffer) + (vm-folder-imap-process))) + (setq vm-buffer-type-trail nil) + ;;-------------------------- + (if (and do-retrieves vm-block-new-mail) + (error "Can't get new mail until you save this folder")) + (if (or vm-global-block-new-mail + (eq vm-imap-connection-mode 'offline) + (null (vm-establish-new-folder-imap-session + interactive "general operation" nil))) + (vm-imap-server-error "Could not connect to the IMAP server") + (if do-retrieves + (vm-assimilate-new-messages)) ; Just to be sure + (vm-inform 6 "Logging into the IMAP server...") + (let* ((folder-buffer (current-buffer)) + (process (vm-folder-imap-process)) + (imap-buffer (process-buffer process)) + (uid-validity (vm-folder-imap-uid-validity)) + (imapdrop (vm-folder-imap-maildrop-spec)) + (folder (or (vm-imap-folder-for-spec imapdrop) + (vm-safe-imapdrop-string imapdrop))) + new-messages + (sync-data (vm-imap-get-synchronization-data do-retrieves)) + (retrieve-list (nth 0 sync-data)) + (remote-expunge-list (nth 1 sync-data)) + (local-expunge-list (nth 2 sync-data)) + (stale-list (nth 3 sync-data))) + (when save-attributes + (let ((mp vm-message-list) + (errors 0)) + ;; (perm-flags (vm-folder-imap-permanent-flags)) + (vm-inform 6 "Updating attributes on the IMAP server... ") + (while mp + (if (or (eq save-attributes 'all) + (vm-attribute-modflag-of (car mp))) + (condition-case nil + (vm-imap-save-message-flags process (car mp)) + (vm-imap-protocol-error ; handler + (setq errors (1+ errors)) + (vm-buffer-type:set 'folder)))) + (setq mp (cdr mp))) + (if (> errors 0) + (vm-inform 3 + "Updating attributes on the IMAP server... %d errors" errors) + (vm-inform 6 "Updating attributes on the IMAP server... done")))) + (when retrieve-attributes + (let ((mp vm-message-list) + (len (length vm-message-list)) + (n 0) + uid m mflags) + (vm-inform 6 "Retrieving message attributes and labels... ") + (while mp + (setq m (car mp)) + (setq uid (vm-imap-uid-of m)) + (when (and (equal (vm-imap-uid-validity-of m) uid-validity) + (vm-folder-imap-uid-msn uid)) + (setq mflags (vm-folder-imap-uid-message-flags uid)) + (vm-imap-update-message-flags m mflags t)) + (setq mp (cdr mp) + n (1+ n))) + (vm-inform 6 "Retrieving message atrributes and labels... done") + )) + (when (and do-retrieves retrieve-list) + (setq new-messages (vm-imap-retrieve-messages retrieve-list))) + + (when do-local-expunges + (vm-inform 6 "Expunging messages in cache... ") + (vm-expunge-folder :quiet t :just-these-messages local-expunge-list) + (if (and interactive stale-list) + (if (y-or-n-p + (format + "Found %s messages with invalid UIDs. Expunge them? " + (length stale-list))) + (vm-expunge-folder :quiet t :just-these-messages stale-list) + (vm-inform 1 "They will be labelled 'stale'") + (mapc + (lambda (m) + (vm-add-or-delete-message-labels "stale" (list m) 'all)) + stale-list) + )) + (vm-inform 6 "Expunging messages in cache... done")) + + (when (and do-remote-expunges + (if (eq do-remote-expunges 'all) + (setq vm-imap-messages-to-expunge + remote-expunge-list) + vm-imap-messages-to-expunge)) + (vm-imap-expunge-remote-messages)) + ;; Not clear that one should end the session right away. We + ;; will keep it around for use with headers-only messages. + ;; (vm-imap-end-session process) + (setq vm-imap-connection-mode 'online) + new-messages))) + +(defun vm-imap-retrieve-messages (retrieve-list) + "Retrieve into the current folder messages listed in +RETRIEVE-LIST and return the list of the retrieved messages. The +RETRIEVE-LIST is a list of cons-pairs (uid . n) of the UID's and +message sequence numbers of messages on the IMAP server. If +`vm-enable-external-messages' includes 'imap, then messages +larger than `vm-imap-max-message-size' are retrieved in +headers-only form." + (let* ((folder-buffer (current-buffer)) + (process (vm-folder-imap-process)) + (imapdrop (vm-folder-imap-maildrop-spec)) + (folder (or (vm-imap-folder-for-spec imapdrop) + (vm-safe-imapdrop-string imapdrop))) + (use-body-peek (vm-folder-imap-body-peek)) + (uid-validity (vm-folder-imap-uid-validity)) + uid r-list r-entry range new-messages message-size + statblob old-eob pos k mp pair + (headers-only (or (eq vm-enable-external-messages t) + (memq 'imap vm-enable-external-messages))) + (n 0)) + (save-excursion + (vm-inform 6 "Retrieving new messages... ") + (vm-save-restriction + (widen) + (setq old-eob (point-max)) + (goto-char (point-max)) + (when (null vm-imap-max-message-size) + (setq vm-imap-max-message-size most-positive-fixnum)) + ;; Annotate retrieve-list with headers-only flags + (setq retrieve-list + (mapcar + (lambda (pair) + (if (> (read (vm-folder-imap-uid-message-size (car pair))) + vm-imap-max-message-size) + (list (car pair) (cdr pair) headers-only) + (list (car pair) (cdr pair) nil))) + retrieve-list)) + (setq r-list (vm-imap-bunch-retrieve-list + (mapcar (function cdr) retrieve-list))) + (unwind-protect + (condition-case error-data + (save-excursion ; = save-current-buffer? + (set-buffer (process-buffer process)) + ;;---------------------------- + (vm-buffer-type:enter 'process) + ;;---------------------------- + (setq statblob (vm-imap-start-status-timer)) + (vm-set-imap-status-mailbox statblob folder) + (vm-set-imap-status-maxmsg statblob + (length retrieve-list)) + (while r-list + (setq pair (car r-list) + range (car pair) + headers-only (cadr pair)) + (vm-set-imap-status-currmsg statblob n) + (setq message-size + (vm-imap-get-message-size + process (car range))) ; sloppy, one size fits all + (vm-set-imap-status-need statblob message-size) + ;;---------------------------------- + (vm-imap-session-type:assert 'valid) + ;;---------------------------------- + (vm-imap-fetch-messages + process (car range) (cdr range) + use-body-peek headers-only) + (setq k (1+ (- (cdr range) (car range)))) + (setq pos (with-current-buffer folder-buffer (point))) + (while (> k 0) + (vm-imap-retrieve-to-target process folder-buffer + statblob use-body-peek) + (with-current-buffer folder-buffer + (if (= (point) pos) + (debug "IMAP internal error #2012: the point hasn't moved"))) + (setq k (1- k))) + (vm-imap-read-ok-response process) + (setq r-list (cdr r-list) + n (+ n (1+ (- (cdr range) (car range))))))) + (vm-imap-normal-error ; handler + (vm-warn 0 2 "IMAP error: %s" (cadr error-data))) + (vm-imap-protocol-error ; handler + (vm-warn 0 2 "Retrieval from %s signaled: %s" folder + error-data)) + ;; Continue with whatever messages have been read + (quit + (delete-region old-eob (point-max)) + (error (format "Quit received during retrieval from %s" + folder)))) + ;; unwind-protections + (when statblob + (vm-imap-stop-status-timer statblob)) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ) + ;; to make the "Mail" indicator go away + (setq vm-spooled-mail-waiting nil) + (vm-set-folder-imap-retrieved-count (vm-folder-imap-mailbox-count)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-inform 6 "Updating summary... ") + (vm-update-summary-and-mode-line) + (setq mp (vm-assimilate-new-messages :read-attributes nil)) + (setq new-messages mp) + (if new-messages + (vm-increment vm-modification-counter)) + (setq r-list retrieve-list) + (while mp + (setq r-entry (car r-list) + uid (car r-entry) + headers-only (nth 2 r-entry)) + (when headers-only + (vm-set-body-to-be-retrieved-of (car mp) t) + (vm-set-body-to-be-discarded-of (car mp) nil)) + (vm-set-imap-uid-of (car mp) uid) + (vm-set-imap-uid-validity-of (car mp) uid-validity) + (vm-set-byte-count-of + (car mp) (vm-folder-imap-uid-message-size uid)) + (vm-imap-update-message-flags + (car mp) (vm-folder-imap-uid-message-flags uid) t) + (vm-mark-for-summary-update (car mp)) + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp) + r-list (cdr r-list))) + ;; (vm-update-summary-and-mode-line) ; update message sizes, possibly + (when vm-arrived-message-hook + (mapc (lambda (m) + (vm-run-hook-on-message 'vm-arrived-message-hook m)) + new-messages)) + (run-hooks 'vm-arrived-messages-hook) + new-messages + )))) + +(defun vm-imap-expunge-remote-messages () + "Expunge from the IMAP server messages listed in +`vm-imap-messages-to-expunge'." + ;; New code. Kyle's version was piggybacking on IMAP spool + ;; file code and wasn't ideal. + (let* ((folder-buffer (current-buffer)) + (process (vm-folder-imap-process)) + (imapdrop (vm-folder-imap-maildrop-spec)) + (folder (or (vm-imap-folder-for-spec imapdrop) + (vm-safe-imapdrop-string imapdrop))) + (uid-validity (vm-folder-imap-uid-validity)) + (mailbox-count (vm-folder-imap-mailbox-count)) + (expunge-count (length vm-imap-messages-to-expunge)) + uids-to-delete m-list d-list message e-list count) + (vm-inform 6 "Expunging messages on the server... ") + ;; uids-to-delete to have UID's of all UID-valid messages in + ;; vm-imap-messages-to-expunge + (unwind-protect + (condition-case error-data + (progn + (setq uids-to-delete + (mapcar + (lambda (message) + (if (equal (cdr message) uid-validity) + (car message) + nil)) + vm-imap-messages-to-expunge)) + (setq uids-to-delete (delete nil uids-to-delete)) + (unless (equal expunge-count (length uids-to-delete)) + (vm-warn 3 2 "%s stale deleted messages are ignored" + (- expunge-count (length uids-to-delete)))) + ;; m-list to have the uid's and message sequence + ;; numbers of messages to be expunged, in descending + ;; order. the message sequence numbers don't change + ;; in the process, according to the IMAP4 protocol + (setq m-list + (mapcar + (lambda (uid) + (let* ((msn (vm-folder-imap-uid-msn uid))) + (and msn (cons uid msn)))) + uids-to-delete)) + (setq m-list + (sort (delete nil m-list) + (lambda (**pair1 **pair2) + (> (cdr **pair1) (cdr **pair2))))) + ;; d-list to have ranges of message sequence numbers + ;; of messages to be expuntged, in ascending order. + (setq d-list (vm-imap-bunch-messages + (nreverse (mapcar (function cdr) m-list)))) + (setq expunge-count 0) ; number of messages expunged + (save-excursion ; = save-current-buffer? + (set-buffer (process-buffer process)) + ;;--------------------------- + (vm-buffer-type:set 'process) + ;;--------------------------- + (mapc (lambda (range) + (vm-imap-delete-messages + process (car range) (cdr range))) + d-list) + ;; now expunge and verify that all messages are gone + (setq m-list (cons nil m-list)) ; dummy header added + (setq count 0) + (while (and (cdr m-list) (<= count vm-imap-expunge-retries)) + ;;---------------------------------- + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command process "EXPUNGE") + ;;-------------------------------- + (vm-imap-session-type:set 'active) + ;;-------------------------------- + ;; e-list to have the message sequence numbers of + ;; messages that got expunged + (setq e-list (sort + (vm-imap-read-expunge-response process) + '>)) + (setq expunge-count (+ expunge-count (length e-list))) + (mapc + (lambda (e) + (let ((m-cons m-list) + (m-pair nil)) ; uid . msn + (catch 'done + (while (cdr m-cons) + (setq m-pair (car (cdr m-cons))) + (if (> (cdr m-pair) e) + ; decrement the message sequence + ; numbers following e in m-list + (rplacd m-pair (1- (cdr m-pair))) + (when (= (cdr m-pair) e) + (rplacd m-cons (cdr (cdr m-cons)))) + ;; if (< (cdr m-pair) e) it is already expunged + ;; clear the message from + ;; vm-imap-retrieved-messages + (with-current-buffer folder-buffer + (setq vm-imap-retrieved-messages + (vm-delete + (lambda (ret) + (and (equal (car ret) (car m-pair)) + (equal (cadr ret) uid-validity))) + vm-imap-retrieved-messages))) + (throw 'done t)) + (setq m-cons (cdr m-cons)))))) + e-list) + ;; m-list has message sequence numbers of messages + ;; that haven't yet been expunged + (if (cdr m-list) + (vm-inform 7 "%s messages yet to be expunged" + (length (cdr m-list)))) + ; try again, if the user wants us to + (setq count (1+ count))) + (vm-inform 6 "Expunging messages on the server... done"))) + + (vm-imap-normal-error ; handler + (vm-warn 0 2 "IMAP error: %s" (cadr error-data))) + + (vm-imap-protocol-error ; handler + (vm-warn 0 2 "Expunge from %s signalled: %s" + folder error-data)) + (quit ; handler + (error "Quit received during expunge from %s" + folder))) + ;; unwind-protections + ;;----------------------------- + (vm-buffer-type:exit) + (vm-imap-dump-uid-seq-num-data) + ;;----------------------------- + ) + (vm-set-folder-imap-mailbox-count + (- mailbox-count expunge-count)) + (vm-set-folder-imap-retrieved-count + (- (vm-folder-imap-retrieved-count) expunge-count)) + (vm-mark-folder-modified-p) + )) + +(defun vm-imap-bunch-retrieve-list (retrieve-list) + "Given a sorted list of pairs consisting of message sequence numbers +and headers-only flags, creates a list of bunched message sequences, +each of the form (begin-num . end-num), along with their headers-only flags." + (let ((ranges nil) + pair headers-only + beg last last-headers-only next diff) + (when retrieve-list + (setq pair (car retrieve-list) + beg (car pair) + headers-only (cadr pair)) + (setq last beg + last-headers-only headers-only) + (setq retrieve-list (cdr retrieve-list)) + (while retrieve-list + (setq pair (car retrieve-list) + next (car pair) + headers-only (cadr pair)) + (if (and (= (- next last) 1) + (eq last-headers-only headers-only) + (< (- next beg) vm-imap-message-bunch-size)) + (setq last next) + (setq ranges (cons (list (cons beg last) last-headers-only) ranges)) + (setq beg next) + (setq last next) + (setq last-headers-only headers-only)) + (setq retrieve-list (cdr retrieve-list))) + (setq ranges (cons (list (cons beg last) last-headers-only) ranges))) + (nreverse ranges))) + +(defun vm-imap-bunch-messages (seq-nums) + "Given a sorted list of message sequence numbers, creates a + list of bunched message sequences, each of the form + (begin-num . end-num)." + (let ((seqs nil) + beg last next diff) + (when seq-nums + (setq beg (car seq-nums)) + (setq last beg) + (setq seq-nums (cdr seq-nums)) + (while seq-nums + (setq next (car seq-nums)) + (if (and (= (- next last) 1) + (< (- next beg) vm-imap-message-bunch-size)) + (setq last next) + (setq seqs (cons (cons beg last) seqs)) + (setq beg next) + (setq last next)) + (setq seq-nums (cdr seq-nums))) + (setq seqs (cons (cons beg last) seqs))) + (nreverse seqs))) + + +(defun vm-fetch-imap-message (m) + "Insert the message body of M in the current buffer, which must be +either the folder buffer or the presentation buffer. Returns a +boolean indicating success: t if the message was fully fetched and nil +otherwise. + + (This is a special case of vm-fetch-message, not to be confused with + vm-imap-fetch-message.)" + + (let ((body-buffer (current-buffer)) + (statblob nil)) + (unwind-protect + (save-excursion ; save-current-buffer? + ;;---------------------------------- + (vm-buffer-type:enter 'folder) + ;;---------------------------------- + (set-buffer (vm-buffer-of (vm-real-message-of m))) + (let* ((statblob nil) + (uid (vm-imap-uid-of m)) + (imapdrop (vm-folder-imap-maildrop-spec)) + (folder (or (vm-imap-folder-for-spec imapdrop) + (vm-safe-imapdrop-string imapdrop))) + (process (and (eq vm-imap-connection-mode 'online) + (vm-re-establish-folder-imap-session + imapdrop "fetch"))) + (imap-buffer (and process (process-buffer process))) + (use-body-peek (vm-folder-imap-body-peek)) + (server-uid-validity (vm-folder-imap-uid-validity)) + (old-eob (point-max)) + message-size + ) + + (when (null process) + (if (eq vm-imap-connection-mode 'offline) + (error "Working in offline mode") + (setq vm-imap-connection-mode 'autoconnect) + (error (concat "Could not connect to IMAP server; " + "Type g to reconnect")))) + (unless (equal (vm-imap-uid-validity-of m) + server-uid-validity) + (error "Message has an invalid UID")) + (setq imap-buffer (process-buffer process)) + (unwind-protect + (save-excursion ; = save-current-buffer? + (set-buffer imap-buffer) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (condition-case error-data + (progn + (setq message-size + (vm-imap-get-uid-message-size process uid)) + (setq statblob (vm-imap-start-status-timer)) + (vm-set-imap-status-mailbox statblob folder) + (vm-set-imap-status-maxmsg statblob 1) + (vm-set-imap-status-currmsg statblob 1) + (vm-set-imap-status-need statblob message-size) + (vm-imap-fetch-uid-message + process uid use-body-peek nil) + (vm-imap-retrieve-to-target + process body-buffer statblob use-body-peek) + (vm-imap-read-ok-response process) + t) + (vm-imap-normal-error ; handler + (vm-warn 0 2 "IMAP error: %s" (cadr error-data)) + nil) + (vm-imap-protocol-error ; handler + (vm-warn 0 2 "Retrieval from %s signaled: %s" folder + error-data) + nil + ;; Continue with whatever messages have been read + ) + (quit + (delete-region old-eob (point-max)) + (error (format "Quit received during retrieval from %s" + folder))))) + ;; unwind-protections + (when statblob + (vm-imap-stop-status-timer statblob)) + ;;----------------------------- + (vm-buffer-type:exit) + (vm-imap-dump-uid-seq-num-data) + ;;----------------------------- + ))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + + +(defun* vm-imap-save-attributes (&optional &key + (interactive nil) + (all-flags nil)) + "* Save the attributes of changed messages to the IMAP folder. + INTERACTIVE, true if the function was invoked interactively, e.g., as + vm-get-spooled-mail. + ALL-FLAGS, if true says that the attributes of all messages should + be saved to the IMAP folder, not only those of changed messages. +" + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (let* ((process (vm-folder-imap-process)) + (uid-validity (vm-folder-imap-uid-validity)) + (mp vm-message-list) + (errors 0)) + ;; (perm-flags (vm-folder-imap-permanent-flags)) + (vm-inform 6 "Updating attributes on the IMAP server... ") + ;;----------------------------------------- + (vm-imap-folder-session-type:assert 'valid) + ;;----------------------------------------- + (while mp + (if (or all-flags (vm-attribute-modflag-of (car mp))) + (condition-case nil + (vm-imap-save-message-flags process (car mp)) + (vm-imap-protocol-error ; handler + (setq errors (1+ errors)) + (vm-buffer-type:set 'folder)))) + (setq mp (cdr mp))) + (if (> errors 0) + (vm-inform 3 "Updating attributes on the IMAP server... %d errors" errors) + (vm-inform 6 "Updating attributes on the IMAP server... done")))) + + +(defun vm-imap-synchronize (&optional full) + "Synchronize the current folder with the IMAP mailbox. +Changes made to the buffer are uploaded to the server first before +downloading the server data. +Deleted messages are not expunged. + +Prefix argument FULL says that all the attribute changes and +expunges made to the cache folder should be written to the server +even if those changes were not made in the current VM session. +This is useful for saving offline work on the cache folder." + (interactive "P") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (vm-display nil nil '(vm-imap-synchronize) '(vm-imap-synchronize)) + (if (not (eq vm-folder-access-method 'imap)) + (vm-inform 0 "This is not an IMAP folder") + (when (vm-establish-new-folder-imap-session t "general operation" nil) + (vm-imap-retrieve-uid-and-flags-data) + (vm-imap-save-attributes :interactive t :all-flags full) + ;; (vm-imap-synchronize-folder :interactive t + ;; :save-attributes (if full 'all t)) + (vm-imap-synchronize-folder :interactive t + :do-remote-expunges (if full 'all t) + :do-local-expunges t + :do-retrieves t + :retrieve-attributes t) + ;; stuff the attributes of messages that need it. + ;; (vm-inform 7 "Stuffing cached data...") + ;; (vm-stuff-folder-data nil) + ;; (vm-inform 7 "Stuffing cached data... done") + ;; stuff bookmark and header variable values + (when vm-message-list + ;; get summary cache up-to-date + (vm-inform 6 "Updating summary... ") + (vm-update-summary-and-mode-line) + (vm-inform 6 "Updating summary... done") + ;; (vm-stuff-bookmark) + ;; (vm-stuff-pop-retrieved) + ;; (vm-stuff-imap-retrieved) + ;; (vm-stuff-last-modified) + ;; (vm-stuff-header-variables) + ;; (vm-stuff-labels) + ;; (vm-stuff-summary) + ;; (and vm-message-order-changed + ;; (vm-stuff-message-order)) + )))) + + +;;;###autoload +(defun vm-imap-folder-check-mail (&optional interactive) + "Check if there is new mail on the server for the current IMAP +folder. The optional argument INTERACTIVE says if the function +is being invoked interactively." + (vm-buffer-type:wait-for-imap-session) + ;;-------------------------- + (vm-buffer-type:set 'folder) + ;;-------------------------- + (vm-inform 10 + "Checking for new mail in %s... " (buffer-name (current-buffer))) + (cond (vm-global-block-new-mail + nil) + ((null (vm-establish-new-folder-imap-session + interactive "checkmail" t)) + nil) + (t + (let ((result nil)) + (cond ((> (vm-folder-imap-recent-count) 0) + t) + ((null (vm-folder-imap-retrieved-count)) + (setq result (car (vm-imap-get-synchronization-data)))) + (t + (setq result (> (vm-folder-imap-mailbox-count) + (vm-folder-imap-retrieved-count))))) + (vm-imap-end-session (vm-folder-imap-process)) + (vm-inform 10 "Checking for new mail in %s... done" + (buffer-name (current-buffer))) + result)))) +(defalias 'vm-imap-folder-check-for-mail 'vm-imap-folder-check-mail) +(make-obsolete 'vm-imap-folder-check-for-mail + 'vm-imap-folder-check-mail "8.2.0") + + + +;; --------------------------------------------------------------------------- +;;; Utilities for maildrop specs (this should be moved up top) +;; +;; A maildrop spec is of the form +;; protocol:hostname:port:mailbox:auth:loginid:password +;; 0 1 2 3 4 5 6 +;; vm-imap-find-spec-for-buffer: (buffer) -> maildrop-spec +;; vm-imap-make-filename-for-spec: (maildrop-spec) -> string +;; vm-imap-normalize-spec: (maildrop-spec) -> maildrop-spec +;; vm-imap-account-name-for-spec: (maildrop-spec) -> string +;; vm-imap-spec-for-account: (string) -> maildrop-spec +;; vm-imap-parse-spec-to-list: (maildrop-spec) -> string list +;; vm-imap-spec-list-to-host-alist: +;; (maildrop-spec list) -> (string, maildrop-spec) alist +;; --------------------------------------------------------------------------- + +;; ----------- missing functions----------- +;;;###autoload +(defun vm-imap-find-name-for-spec (spec) + "This is a stub for a function that has not been defined." + (error "vm-imap-find-name-for-spec has not been defined. Please report it." + )) +;;----------------------------------------- + +;;;###autoload +(defun vm-imap-find-spec-for-buffer (buffer) + "Find the IMAP maildrop spec for the folder BUFFER." + (with-current-buffer buffer + (vm-folder-imap-maildrop-spec))) +;; (let ((list (mapcar 'car vm-imap-account-alist)) +;; (done nil) +;; (spec-items nil)) +;; (while (and (not done) list) +;; (setq spec-items (vm-imap-parse-spec-to-list (car list))) +;; (setcar (nthcdr 3 spec-items) folder) +;; (if (eq buffer (vm-get-file-buffer +;; (vm-imap-make-filename-for-spec +;; (mapconcat 'identity spec-items ":")))) +;; (setq done t) +;; (setq list (cdr list)))) +;; (and list (car list))) + +;;;###autoload +(defun vm-imap-make-filename-for-spec (spec) + "Returns a cache file name appropriate for the IMAP maildrop +specification SPEC." + (let (md5) + (setq spec (vm-imap-normalize-spec spec)) + (setq md5 (vm-md5-string spec)) + (expand-file-name (concat "imap-cache-" md5) + (or vm-imap-folder-cache-directory + vm-folder-directory + (getenv "HOME"))))) + +;;;###autoload +(defun vm-imap-normalize-spec (spec) + (let (comps) + (setq comps (vm-imap-parse-spec-to-list spec)) + (setcar (vm-last comps) "*") ; scrub password + (setcar comps "imap") ; standardise protocol name + (setcar (nthcdr 2 comps) "*") ; scrub portnumber + (setcar (nthcdr 4 comps) "*") ; scrub authentication method + (setq spec (mapconcat (function identity) comps ":")) + spec )) + +;;;###autoload +(defun vm-imap-account-name-for-spec (spec) + "Returns the IMAP account name for maildrop specification SPEC, by +looking up `vm-imap-account-alist' or nil if there is no such account." + (let ((alist vm-imap-account-alist) + comps account-comps) + (setq comps (vm-imap-parse-spec-to-list spec)) + (catch 'return + (while alist + (setq account-comps (vm-imap-parse-spec-to-list (car (car alist)))) + (if (and (equal (nth 1 comps) (nth 1 account-comps)) ; host + (equal (nth 5 comps) (nth 5 account-comps))) ; login + (throw 'return (cadr (car alist))) + (setq alist (cdr alist)))) + nil))) + +;;;###autoload +(defun vm-imap-folder-for-spec (spec) + "Returns the IMAP folder for maildrop specification SPEC in the +format account:mailbox." + (let (comps account-comps (alist vm-imap-account-alist)) + (setq comps (vm-imap-parse-spec-to-list spec)) + (catch 'return + (while alist + (setq account-comps (vm-imap-parse-spec-to-list (car (car alist)))) + (if (and (equal (nth 1 comps) (nth 1 account-comps)) ; host + (equal (nth 5 comps) (nth 5 account-comps))) ; login + (throw 'return (concat (cadr (car alist)) ":" (nth 3 comps))) + (setq alist (cdr alist)))) + nil))) + +;;;###autoload +(defun vm-imap-spec-for-account (account) + "Returns the IMAP maildrop spec for ACCOUNT, by looking up +`vm-imap-account-alist' or nil if there is no such account." + (car (rassoc (list account) vm-imap-account-alist))) + +;;;###autoload +(defun vm-imap-parse-spec-to-list (spec) + "Parses the IMAP maildrop specification SPEC and returns a list of +its components." + (vm-parse spec "\\([^:]+\\):?" 1 6)) + +(defun vm-imap-spec-list-to-host-alist (spec-list) + (let (host-alist spec host) + (while spec-list + (setq spec (vm-imapdrop-sans-password-and-mailbox (car spec-list))) + (setq host-alist (cons + (list + (nth 1 (vm-imap-parse-spec-to-list spec)) + spec) + host-alist) + spec-list (cdr spec-list))) + host-alist )) + +(defvar vm-imap-account-folder-cache nil + "Caches the list of all folders on an IMAP account.") + +(defun vm-imap-folder-completion-list (string predicate flag) + "Find completions for STRING as an IMAP folder name, satisfying + PREDICATE. The third argument FLAG is one of: + +`nil' - try-completion, returns string if there are mult possibilities, +`t' - all-completions, returns a list of all completions, +`lambda' - test-completion, test if the string is an exact match for a + possibility , and +a pair (boundaries. SUFFIX) - completion-boundaries. + +See Info node `(elisp)Programmed Completion'." + ;; selectable-only is used via dynamic binding + + (let ((account-list (mapcar (lambda (a) (list (concat (cadr a) ":"))) + vm-imap-account-alist)) + completion-list folder account spec process mailbox-list) + + ;; handle SPC completion (remove last " " from string) + (and (> (length string) 0) + (string= " " (substring string -1)) + (setq string (substring string 0 -1))) + + ;; check for account + (setq folder (try-completion (or string "") account-list predicate)) + (if (stringp folder) + (setq account (car (vm-parse folder "\\([^:]+\\):?" 1))) + (setq account (car (vm-parse string "\\([^:]+\\):?" 1)))) + + ;; get folders of this account + (when account + (setq mailbox-list (cdr (assoc account vm-imap-account-folder-cache))) + (setq spec (vm-imap-spec-for-account account)) + (when (and (null mailbox-list) spec) + (unwind-protect + (progn + (setq process (vm-imap-make-session spec t "folders")) + (when process + (setq mailbox-list + (vm-imap-mailbox-list process selectable-only)) + (when mailbox-list + (add-to-list 'vm-imap-account-folder-cache + (cons account mailbox-list))))) + ;; unwind-protection + (when process (vm-imap-end-session process)))) + (setq completion-list + (mapcar (lambda (m) (list (format "%s:%s" account m))) + mailbox-list)) + (setq folder (try-completion (or string "") completion-list predicate))) + + (setq folder (or folder string)) + (if (eq folder t) + (setq folder string)) + (cond ((null flag) + folder) + ((eq t flag) + (mapcar 'car + (vm-delete (lambda (c) + (string-prefix-p folder (car c))) + (or completion-list account-list) t)) + ) + ((eq 'lambda flag) + (try-completion folder completion-list predicate))))) + +;;;###autoload +(defun vm-read-imap-folder-name (prompt &optional selectable-only + newone default) + "Read an IMAP folder name in the format account:mailbox, return an +IMAP mailbox spec." + (let* (folder-input completion-list spec process list + default-account default-folder + (vm-imap-ok-to-ask t) + (account-list (mapcar 'cadr vm-imap-account-alist)) + account-and-folder account folder mailbox-list) + (if (null account-list) + (error "No known IMAP accounts. Please set vm-imap-account-alist.")) + (if default + (setq list (vm-imap-parse-spec-to-list default) + default-account + (cadr (assoc (vm-imapdrop-sans-password-and-mailbox default) + vm-imap-account-alist)) + default-folder (nth 3 list)) + (setq default-account vm-last-visit-imap-account)) + (setq folder-input + (completing-read + (format ; prompt +;; "IMAP folder:%s " + "%s%s" prompt + (if (and default-account default-folder) + (format "(default %s:%s) " default-account default-folder) + "")) + 'vm-imap-folder-completion-list ; collection + nil ; predicate + nil ; require-match + (if default-account ; initial-input + (format "%s:" default-account) + ""))) + (if (or (equal folder-input "") + (equal folder-input (format "%s:" default-account))) + (if (and default-account default-folder) + (setq folder-input (format "%s:%s" default-account default-folder)) + (error + "IMAP folder required in the format account-name:folder-name"))) + (setq account-and-folder (vm-parse folder-input "\\([^:]+\\):?" 1 2) + account (car account-and-folder) + folder (cadr account-and-folder) + spec (vm-imap-spec-for-account account)) + (if (null folder) + (error + "IMAP folder required in the format account-name:folder-name")) + (if (null spec) + (error "Unknown IMAP account %s" account)) + (setq list (vm-imap-parse-spec-to-list spec)) + (setcar (nthcdr 3 list) folder) + (setq vm-last-visit-imap-account account) + (mapconcat 'identity list ":"))) + +(defun vm-imap-directory-separator (process ref) + (let ((c-list nil) + sep p r response need-ok) + (vm-imap-check-connection process) + (unwind-protect + (save-excursion ; = save-current-buffer? + (set-buffer (process-buffer process)) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + (vm-imap-session-type:assert-active) + ;;---------------------------------- + (vm-imap-send-command process (format "LIST %s \"\"" + (vm-imap-quote-string ref))) + ;;-------------------------------- + (vm-imap-dump-uid-seq-num-data) + ;;-------------------------------- + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "LIST")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'LIST 'list 'string) + (setq r (nthcdr 3 response) + p (car r) + sep (buffer-substring (nth 1 p) (nth 2 p)))) + ((vm-imap-response-matches response '* 'LIST 'list) + (vm-imap-protocol-error "unexpedcted LIST response")))) + sep ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +(defun vm-imap-mailbox-list (process selectable-only) + "Query the IMAP PROCESS to get a list of the mailboxes (folders) +available in the IMAP account. SELECTABLE-ONLY flag asks only +selectable mailboxes to be listed. Returns a list of mailbox names." + (let ((c-list nil) + p r response need-ok) + (vm-imap-check-connection process) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + (vm-imap-session-type:assert-active) + (vm-imap-dump-uid-seq-num-data) + ;;---------------------------------- + (vm-imap-send-command process "LIST \"\" \"*\"") + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "LIST")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'LIST 'list) + (setq r (nthcdr 2 response) + p (car r)) + (if (and selectable-only + (vm-imap-scan-list-for-flag p "\\Noselect")) + nil + (setq r (nthcdr 4 response) + p (car r)) + (if (memq (car p) '(atom string)) + (setq c-list (cons (buffer-substring + (nth 1 p) (nth 2 p)) + c-list))))))) + c-list ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +;; This is unfinished +(defun vm-imap-mailbox-p (process mailbox selectable-only) + "Query the IMAP PROCESS to check if MAILBOX exists as a folder. +SELECTABLE-ONLY flag asks whether the mailbox is selectable as +well. Returns a boolean value." + (let ((c-list nil) + p r response need-ok) + (vm-imap-check-connection process) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;---------------------------------- + (vm-buffer-type:enter 'process) + (vm-imap-session-type:assert-active) + (vm-imap-dump-uid-seq-num-data) + ;;---------------------------------- + (vm-imap-send-command process (concat "LIST \"\" \"" mailbox "\"")) + (setq need-ok t) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "LIST")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((vm-imap-response-matches response '* 'LIST 'list) + (setq r (nthcdr 2 response) + p (car r)) + (if (and selectable-only + (vm-imap-scan-list-for-flag p "\\Noselect")) + nil + (setq r (nthcdr 4 response) + p (car r)) + (if (memq (car p) '(atom string)) + (setq c-list (cons (buffer-substring + (nth 1 p) (nth 2 p)) + c-list))))))) + c-list ) + ;; unwind-protections + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) + +(defun vm-imap-read-boolean-response (process) + (let ((need-ok t) retval response) + (while need-ok + (vm-imap-check-connection process) + (setq response (vm-imap-read-response process)) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil retval t)) + ((vm-imap-response-matches response 'VM 'NO) + (setq need-ok nil retval nil)) + ((vm-imap-response-matches response '* 'BYE) + (vm-imap-normal-error "server disconnected")) + ((vm-imap-response-matches response 'VM 'BAD) + (vm-imap-normal-error "server said BAD")))) + retval )) + +(defun vm-imap-create-mailbox (process mailbox + &optional dont-create-parent-directories) + (if (not dont-create-parent-directories) + (let (dir sep sep-regexp i) + (setq sep (vm-imap-directory-separator process "") + sep-regexp (regexp-quote sep) + i 0) + (while (string-match sep-regexp mailbox i) + (setq dir (substring mailbox i (match-end 0))) + (vm-imap-create-mailbox process dir t) + ;; ignore command result since creating a directory will + ;; routinely fail with "File exists". We'll generate a + ;; real error if the final mailbox creation fails. + (vm-imap-read-boolean-response process) + (setq i (match-end 0))))) + (vm-imap-send-command process (format "CREATE %s" + (vm-imap-quote-string mailbox))) + (if (null (vm-imap-read-boolean-response process)) + (vm-imap-normal-error "creation of %s failed" mailbox))) + +(defun vm-imap-delete-mailbox (process mailbox) + (vm-imap-send-command process (format "DELETE %s" + (vm-imap-quote-string mailbox))) + (if (null (vm-imap-read-boolean-response process)) + (vm-imap-normal-error "deletion of %s failed" mailbox))) + +(defun vm-imap-rename-mailbox (process source dest) + (vm-imap-send-command process (format "RENAME %s %s" + (vm-imap-quote-string source) + (vm-imap-quote-string dest))) + (if (null (vm-imap-read-boolean-response process)) + (vm-imap-normal-error "renaming of %s to %s failed" source dest))) + +;;;###autoload +(defun vm-create-imap-folder (folder) + "Create a folder on an IMAP server. +First argument FOLDER is read from the minibuffer if called +interactively. Non-interactive callers must provide an IMAP +maildrop specification for the folder as described in the +documentation for `vm-spool-files'." + ;; Creates a self-contained IMAP session and destroys it at the end. + (interactive + (save-excursion + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (vm-session-initialization) + ;; (vm-check-for-killed-folder) ; seems no need for this + ;; (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command) + (folder (vm-read-imap-folder-name "Create IMAP folder: " nil t))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (list folder)) + )) + (let ((vm-imap-ok-to-ask t) + process mailbox folder-display) + (setq process (vm-imap-make-session folder t "create")) + (if (null process) + (error "Couldn't open IMAP session for %s" + (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder)))) + (unwind-protect + (with-current-buffer (process-buffer process) + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder))) + (setq folder-display (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder))) + (vm-imap-create-mailbox process mailbox t) + (vm-inform 5 "Folder %s created" folder-display)) + ;; unwind-protections + (when (and (processp process) + (memq (process-status process) '(open run))) + (vm-imap-end-session process)) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) +(defalias 'vm-imap-create-folder 'vm-create-imap-folder) + +;;;###autoload +(defun vm-delete-imap-folder (folder) + "Delete a folder on an IMAP server. +First argument FOLDER is read from the minibuffer if called +interactively. Non-interactive callers must provide an IMAP +maildrop specification for the folder as described in the +documentation for `vm-spool-files'." +;; Creates a self-contained IMAP session and destroys it at the end. + (interactive + (save-excursion + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (vm-session-initialization) + ;; (vm-check-for-killed-folder) ; seems no need for this + ;; (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name "Delete IMAP folder: " nil nil))))) + (let ((vm-imap-ok-to-ask t) + process mailbox folder-display) + (setq process (vm-imap-make-session folder t "delete folder")) + (if (null process) + (error "Couldn't open IMAP session for %s" + (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder)))) + (unwind-protect + (save-current-buffer + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + (set-buffer (process-buffer process)) + (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder))) + (setq folder-display (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder))) + (vm-imap-delete-mailbox process mailbox) + (vm-inform 5 "Folder %s deleted" folder-display)) + ;; unwind-protections + (when (and (processp process) + (memq (process-status process) '(open run))) + (vm-imap-end-session process)) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ))) +(defalias 'vm-imap-delete-folder 'vm-delete-imap-folder) + +;;;###autoload +(defun vm-rename-imap-folder (source dest) + "Rename a folder on an IMAP server. +Argument SOURCE and DEST are read from the minibuffer if called +interactively. Non-interactive callers must provide full IMAP +maildrop specifications for SOURCE and DEST as described in the +documentation for `vm-spool-files'." +;; Creates a self-contained IMAP session and destroys it at the end. + (interactive + (save-excursion + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (vm-session-initialization) + ;; (vm-check-for-killed-folder) ; seems no need for this + ;; (vm-select-folder-buffer-if-possible) + (let ((this-command this-command) + (last-command last-command) + source dest) + (setq source (vm-read-imap-folder-name "Rename IMAP folder: " t nil)) + (setq dest (vm-read-imap-folder-name + (format "Rename %s to: " + (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source))) + nil t)) + (list source dest)))) + (let ((vm-imap-ok-to-ask t) + process mailbox-source mailbox-dest) + (setq process (vm-imap-make-session source t "rename folder")) + (if (null process) + (error "Couldn't open IMAP session for %s" + (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source)))) + (unwind-protect + (save-current-buffer + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + (set-buffer (process-buffer process)) + (setq mailbox-source (nth 3 (vm-imap-parse-spec-to-list source))) + (setq mailbox-dest (nth 3 (vm-imap-parse-spec-to-list dest))) + (vm-imap-rename-mailbox process mailbox-source mailbox-dest) + (vm-inform 5 "Folder %s renamed to %s" + (or (vm-imap-folder-for-spec source) + (vm-safe-imapdrop-string source)) + (or (vm-imap-folder-for-spec dest) + (vm-safe-imapdrop-string dest)))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + (when (and (processp process) + (memq (process-status process) '(open run))) + (vm-imap-end-session process)) + ))) +(defalias 'vm-rename-imap-folder 'vm-imap-rename-folder) + +;;;###autoload +(defun vm-list-imap-folders (account &optional filter-new) + "List all folders on an IMAP account ACCOUNT, along with the +counts of messages in them. The account must be one declared in +`vm-imap-account-alist'. + +With a prefix argument, it lists only the folders with new messages in +them." +;; Creates a self-contained IMAP session and destroys it at the end. + (interactive + (save-excursion + ;;------------------------ + (vm-buffer-type:duplicate) + ;;------------------------ + (vm-session-initialization) + (let ((this-command this-command) + (last-command last-command) + (completion-list (mapcar (function cadr) vm-imap-account-alist))) + (list (completing-read + "IMAP account: " completion-list nil t + (if vm-last-visit-imap-account ; initial-input + (format "%s" vm-last-visit-imap-account) + "") + ) + current-prefix-arg)))) + (require 'ehelp) + (setq vm-last-visit-imap-account account) + (let ((vm-imap-ok-to-ask t) + folder spec process mailbox-list mailbox-status-list buffer) + (setq spec (vm-imap-spec-for-account account)) + (setq process (and spec (vm-imap-make-session spec t "folders"))) + ; new session required for STATUS + (if (null process) + (error "Couldn't open IMAP session for %s" + (or (vm-imap-folder-for-spec account) + (vm-safe-imapdrop-string account)))) + (unwind-protect + (progn + (setq mailbox-list + (vm-imap-mailbox-list process nil)) + (setq mailbox-status-list + (mapcar + (lambda (mailbox) + (cons mailbox + (vm-imap-get-mailbox-status process mailbox))) + mailbox-list)) + (when mailbox-list + (add-to-list 'vm-imap-account-folder-cache + (cons account mailbox-list)))) + ;; unwind-protection + (when process (vm-imap-end-session process))) + + (setq mailbox-status-list + (sort mailbox-status-list + (lambda (mbstat1 mbstat2) + (string-lessp (car mbstat1) (car mbstat2))))) + + ;; Display the results + (setq buffer (get-buffer-create (format "*%s folders*" account))) + ;; (with-help-buffer (buffer-name buffer) + ;; (dolist (mailbox mailbox-list) + ;; (princ (format "%s\n" mailbox)))) + (with-electric-help + (lambda () + (dolist (mbstat mailbox-status-list) + (if (or (null filter-new) (> (nth 2 mbstat) 0)) + (princ (format "%s: %s messages, %s new \n" + (car mbstat) (nth 1 mbstat) (nth 2 mbstat)))))) + buffer) + )) + +(defalias 'vm-imap-list-folders 'vm-list-imap-folders) + +(defun vm-imap-get-mailbox-status (process mailbox) + "Requests the status of IMAP MAILBOX from the server and returns the +message count and recent message count (a list of two numbers)." + (let ((imap-buffer (process-buffer process)) + (need-ok t) + response p tok msg-count recent-count) + (with-current-buffer imap-buffer + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + (vm-imap-send-command + process + (format "STATUS %s (MESSAGES RECENT)" (vm-imap-quote-string mailbox))) + (while need-ok + (setq response (vm-imap-read-response-and-verify process "STATUS")) + (cond ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil)) + ((or (vm-imap-response-matches response '* 'STATUS 'string 'list) + (vm-imap-response-matches response '* 'STATUS 'atom 'list)) + (setq p (cdr (nth 3 response))) + (while p + (cond + ((vm-imap-response-matches p 'MESSAGES 'atom) + (setq tok (nth 1 p)) + (goto-char (nth 1 tok)) + (setq msg-count (read imap-buffer)) + (setq p (nthcdr 2 p))) + ((vm-imap-response-matches p 'RECENT 'atom) + (setq tok (nth 1 p)) + (goto-char (nth 1 tok)) + (setq recent-count (read imap-buffer)) + (setq p (nthcdr 2 p))) + (t + (vm-imap-protocol-error + "expected MESSAGES and RECENT in STATUS response")) + ))) + (t + (vm-imap-protocol-error + "unexpected response to STATUS command")) + )) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ) + (list msg-count recent-count))) + +;;; Robert Fenk's draft function for saving messages to IMAP folders. + +;;;###autoload +(defun vm-imap-save-composition () + "Saves the current composition in the IMAP folder given by the +IMAP-FCC header. +Add this to your `mail-send-hook' and start composing from an IMAP +folder." +;; Creates a self-contained IMAP session and destroys it at the end. + (let ((mailbox (vm-mail-get-header-contents "IMAP-FCC:")) + (mailboxes nil) + (fcc-string (vm-mail-get-header-contents "FCC:" ",")) + fcc-list fcc maildrop spec-list + process flags response string m + (vm-imap-ok-to-ask t)) + (if (null mailbox) + (setq mailboxes nil) + ;; IMAP-FCC header present + (when vm-mail-buffer ; has parent folder + (save-current-buffer + ;;---------------------------- + (vm-buffer-type:enter 'folder) + ;;---------------------------- + (vm-select-folder-buffer) + (setq m (car vm-message-pointer)) + (when m + (set-buffer (vm-buffer-of (vm-real-message-of m)))) + (if (eq vm-folder-access-method 'imap) + (setq maildrop (vm-folder-imap-maildrop-spec))) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + )) + (when (and (null maildrop) vm-imap-default-account) + (setq maildrop + (vm-imap-spec-for-account vm-imap-default-account))) + (when (null maildrop) + (error "Set `vm-imap-default-account' to use IMAP-FCC")) + (setq process + (vm-imap-make-session maildrop t "IMAP-FCC")) + (if (null process) + (error "Could not connect to the IMAP server for IMAP-FCC")) + (setq mailboxes (list (cons mailbox process))) + (vm-mail-mode-remove-header "IMAP-FCC:")) + + (when fcc-string + (setq fcc-list (vm-parse fcc-string "\\([^,]+\\),?")) + (while fcc-list + (setq fcc (car fcc-list)) + (setq spec-list (vm-parse fcc "\\([^:]+\\):?")) + (when (member (car spec-list) '("imap" "imap-ssl" "imap-ssh")) + (setq process (vm-imap-make-session fcc nil "IMAP-FCC")) + (if (null process) + (error "Could not connect to the IMAP server for IMAP-FCC")) + (setq mailboxes (cons (cons (nth 3 spec-list) process) + mailboxes))) + (setq fcc-list (cdr fcc-list)))) + + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (setq string (concat (buffer-substring (point-min) (match-beginning 0)) + (buffer-substring + (match-end 0) (point-max)))) + (setq string (vm-imap-subst-CRLF-for-LF string)) + + (while mailboxes + (setq mailbox (car (car mailboxes))) + (setq process (cdr (car mailboxes))) + (unwind-protect + (save-excursion ; = save-current-buffer? + ;;----------------------------- + (vm-buffer-type:enter 'process) + ;;----------------------------- + ;; this can go awry if the process has died... + (unless process + (error "No connection to IMAP server for IMAP-FCC")) + (set-buffer (process-buffer process)) + (condition-case nil + (vm-imap-create-mailbox process mailbox) + (vm-imap-protocol-error ; handler + (vm-buffer-type:set 'process))) ; ignore errors + ;;---------------------------------- + ;; (vm-imap-session-type:assert-active) + ;;---------------------------------- + + (vm-imap-send-command process + (format "APPEND %s %s {%d}" + (vm-imap-quote-string mailbox) + (if flags flags "()") + (length string))) + ;; could these be done with vm-imap-read-boolean-response? + (let ((need-plus t) response) + (while need-plus + (setq response (vm-imap-read-response process)) + (cond ((vm-imap-response-matches response 'VM 'NO) + (vm-imap-normal-error "server said NO")) + ((vm-imap-response-matches response 'VM 'BAD) + (vm-imap-normal-error "server said BAD")) + ((vm-imap-response-matches response '* 'BYE) + (vm-imap-normal-error "server disconnected")) + ((vm-imap-response-matches response '+) + (setq need-plus nil))))) + + (vm-imap-send-command process string nil t) + (let ((need-ok t) response) + (while need-ok + + (setq response (vm-imap-read-response process)) + (cond + ((vm-imap-response-matches response 'VM 'NO) + (vm-imap-protocol-error "server said NO to APPEND data")) + ((vm-imap-response-matches response 'VM 'BAD) + (vm-imap-protocol-error "server said BAD to APPEND data")) + ((vm-imap-response-matches response '* 'BYE) + (vm-imap-protocol-error "server said BYE to APPEND data")) + ((vm-imap-response-matches response 'VM 'OK) + (setq need-ok nil))))) + ) + ;; unwind-protections + (when (and (processp process) + (memq (process-status process) '(open run))) + (vm-imap-end-session process)) + ;;------------------- + (vm-buffer-type:exit) + ;;------------------- + ) + (setq mailboxes (cdr mailboxes))) + )) + +(defun vm-imap-start-bug-report () + "Begin to compose a bug report for IMAP support functionality." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq vm-kept-imap-buffers nil) + (setq vm-imap-keep-trace-buffer 20)) + +(defun vm-imap-submit-bug-report () + "Submit a bug report for VM's IMAP support functionality. +It is necessary to run vm-imap-start-bug-report before the problem +occurrence and this command after the problem occurrence, in +order to capture the trace of IMAP sessions during the occurrence." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (or vm-imap-keep-trace-buffer + (y-or-n-p "Did you run vm-imap-start-bug-report earlier? ")) + (vm-inform 5 "Thank you. Preparing the bug report... ") + (vm-inform 1 "Consider running vm-imap-start-bug-report before the problem occurrence")) + (let ((process (vm-folder-imap-process))) + (if process + (vm-imap-end-session (vm-folder-imap-process)))) + (let ((trace-buffer-hook + (lambda () + (let ((bufs vm-kept-imap-buffers) + buf) + (insert "\n\n") + (insert "IMAP Trace buffers - most recent first\n\n") + (while bufs + (setq buf (car bufs)) + (insert "----") + (insert (format "%s" buf)) + (insert "----------\n") + (insert (with-current-buffer buf + (buffer-string))) + (setq bufs (cdr bufs))) + (insert "--------------------------------------------------\n")) + ))) + (vm-submit-bug-report nil (list trace-buffer-hook)) + )) + + +(defun vm-imap-set-default-attributes (m) + (vm-set-headers-to-be-retrieved-of m nil) + (vm-set-body-to-be-retrieved-of m nil) + (vm-set-body-to-be-discarded-of m nil)) + +(defun vm-imap-unset-body-retrieve () + "Unset the body-to-be-retrieved flag of all the messages. May + be needed if the folder has become corrupted somehow." + (interactive) + (save-current-buffer + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (let ((mp vm-message-list)) + (while mp + (vm-set-body-to-be-retrieved-of (car mp) nil) + (vm-set-body-to-be-discarded-of (car mp) nil) + (setq mp (cdr mp)))) + (vm-inform 5 "Marked %s messages as having retrieved bodies" + (length vm-message-list)) + )) + +(defun vm-imap-unset-byte-counts () + "Unset the byte counts of all the messages, so that the size of the +downloaded bodies will be displayed." + (interactive) + (save-current-buffer + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (let ((mp vm-message-list)) + (while mp + (vm-set-byte-count-of (car mp) nil) + (setq mp (cdr mp)))) + (vm-inform 5 "Unset the byte counts of %s messages" + (length vm-message-list)) + )) + + +;;; vm-imap.el ends here diff --git a/lisp/vm-license.el b/lisp/vm-license.el new file mode 100755 index 0000000..8d77d69 --- /dev/null +++ b/lisp/vm-license.el @@ -0,0 +1,61 @@ +;;; vm-license.el --- Code to show VM's warranty and copying restrictions +;; +;; This file is part of VM +;; +;; Copyright (C) 1989, 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-license) + +(eval-when-compile + (require 'vm-window)) + +(declare-function Info-goto-node "ext:info" (nodename &optional fork)) + +;;;###autoload +(defun vm-show-copying-restrictions (&optional warranty) + "Show VM's license, i.e. the GPL." + (interactive) + (require 'info) + (let ((pop-up-windows (eq vm-mutable-window-configuration t)) + (pop-up-frames (and vm-mutable-frame-configuration vm-frame-per-help))) + (or + (condition-case () + (progn (Info-goto-node "(vm)License") t) + (error nil)) + (condition-case () + (progn (Info-goto-node "(vm.info)License") t) + (error nil)) + (error "VM Info documentation appears not to be installed")) + (vm-display (current-buffer) t nil nil) + (vm-display nil nil '(vm-show-copying-restrictions vm-show-no-warranty) + (list this-command)) + (if warranty + (let ((case-fold-search nil)) + (search-forward "NO WARRANTY\n" nil t) + (forward-line -1) + (set-window-start (selected-window) (point)))))) + +;;;###autoload +(defun vm-show-no-warranty () + "Display \"NO WARRANTY\" section of the GNU General Public License." + (interactive) + (vm-show-copying-restrictions t)) + +;;; vm-license.el ends here diff --git a/lisp/vm-macro.el b/lisp/vm-macro.el new file mode 100755 index 0000000..9cbd91c --- /dev/null +++ b/lisp/vm-macro.el @@ -0,0 +1,292 @@ +;;; vm-macro.el --- Random VM macros +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-macro) + +;; Definitions for things that aren't in all Emacsen and that we really +;; prefer not to live without. +(eval-and-compile + (if (fboundp 'unless) nil + (defmacro unless (bool &rest forms) `(if ,bool nil ,@forms)) + (defmacro when (bool &rest forms) `(if ,bool (progn ,@forms)))) + (unless (fboundp 'save-current-buffer) + (defalias 'save-current-buffer 'save-excursion)) + (if (fboundp 'mapc) + (defalias 'bbdb-mapc 'mapc) + (defalias 'bbdb-mapc 'mapcar)) + ) + +(unless (fboundp 'with-current-buffer) + (defmacro with-current-buffer (buf &rest body) + `(save-current-buffer (set-buffer ,buf) ,@body))) + +(unless (fboundp 'defvaralias) + (defmacro defvaralias (&rest args))) + +(unless (fboundp 'declare-function) + (defmacro declare-function (fn file &optional arglist fileonly))) + +(declare-function vm-check-for-killed-summary "vm-misc" ()) +(declare-function vm-check-for-killed-presentation "vm-misc" ()) +(declare-function vm-error-if-folder-empty "vm-misc" ()) +(declare-function vm-build-threads "vm-thread" (message-list)) + +(defmacro vm-add-to-list (elem list) + "Like add-to-list, but compares elements by `eq' rather than `equal'." + `(if (not (memq ,elem ,list)) + (setq ,list (cons ,elem ,list)))) + +(defsubst vm-sit-for (seconds &optional nodisplay) + "Like sit-for, but has no effect if display-hourglass is set to t. +Otherwise, the hourglass would be displayed while sit-for happens." + (unless (and (boundp 'display-hourglass) display-hourglass) + (sit-for seconds nodisplay))) + +(defsubst vm-marker (pos &optional buffer) + (set-marker (make-marker) pos buffer)) + +(defsubst vm-pop-folder-spec-p (folder) + (and vm-recognize-pop-maildrops + (string-match vm-recognize-pop-maildrops folder))) + +(defsubst vm-imap-folder-spec-p (folder) + (and vm-recognize-imap-maildrops + (string-match vm-recognize-imap-maildrops folder))) + +(defsubst vm-select-folder-buffer () + "Select the folder buffer corresponding to the current buffer (which +could be Summary or Presentation). Gives an error message if there +isn't a folder buffer. USR, 2010-03-08" + (cond (vm-mail-buffer + (or (buffer-name vm-mail-buffer) + (error "Folder buffer has been killed.")) + (set-buffer vm-mail-buffer)) + ((not (memq major-mode '(vm-mode vm-virtual-mode))) + (error "No VM folder buffer associated with this buffer"))) + ;;-------------------------- + ;; This may be problematic - done in revno 570. + ;; All kinds of operations call vm-select-folder-buffer, including + ;; asynchronous things like the toolbar. + ;; (vm-buffer-type:set 'folder) + ;;-------------------------- + ) + +(defsubst vm-select-folder-buffer-if-possible () + "Select the folder buffer corresponding to the current buffer (which +could be Summary or Presentation). Returns normally if there +isn't a folder buffer. USR, 2010-03-08" + (cond ((and (bufferp vm-mail-buffer) + (buffer-name vm-mail-buffer)) + (set-buffer vm-mail-buffer) + ;;-------------------------- + ;; This may be problematic - done in revno 570. + ;; (vm-buffer-type:set 'folder) + ;;-------------------------- + ) + ((memq major-mode '(vm-mode vm-virtual-mode)) + ;;-------------------------- + ;; This may be problematic - done in revno 570. + ;; (vm-buffer-type:set 'folder) + ;;-------------------------- + ))) + +(defsubst vm-select-folder-buffer-and-validate (&optional minimum interactive-p) + "Select the folder buffer corresponding to the current buffer (which +could be Summary or Presentation) and make sure that it has valid +references to Summary and Presentation buffers. + +If optional argument MINIMUM is 1, the folder should be nonempty +as well. If INTERACTIVE-p is t, then it also records the +current-buffer in `vm-user-interaction-buffer'." + (when interactive-p + (setq vm-user-interaction-buffer (current-buffer))) + (cond (vm-mail-buffer + (or (buffer-name vm-mail-buffer) + (error "Folder buffer has been killed.")) + (set-buffer vm-mail-buffer)) + ((not (memq major-mode '(vm-mode vm-virtual-mode))) + (error "No VM folder buffer associated with this buffer"))) + ;;-------------------------- + ;; This may be problematic - done in revno 570. + ;; (vm-buffer-type:set 'folder) + ;;-------------------------- + + (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) + (if (and minimum (= minimum 1)) + (vm-error-if-folder-empty)) + ) + +(defsubst vm-error-if-folder-read-only () + (while vm-folder-read-only + (signal 'folder-read-only (list (current-buffer))))) + +(defsubst vm-error-if-virtual-folder () + (and (eq major-mode 'vm-virtual-mode) + (error "%s cannot be applied to virtual folders." this-command))) + +(defsubst vm-summary-operation-p () + (and vm-summary-buffer + (eq vm-summary-buffer vm-user-interaction-buffer))) + +(defsubst vm-build-threads-if-unbuilt () + (if (not (vectorp vm-thread-obarray)) + (vm-build-threads nil))) + +(defsubst vm-binary-coding-system () + (cond (vm-xemacs-mule-p 'binary) + (vm-xemacs-file-coding-p 'binary) + (t 'no-conversion))) + +(defsubst vm-line-ending-coding-system () + (cond (vm-xemacs-mule-p 'no-conversion) + (vm-xemacs-file-coding-p 'no-conversion) + (t 'raw-text))) + +;;; can't use defsubst where quoting is needed in some places but +;; not others. + +;; save-restriction flubs restoring the clipping region if you +;; (widen) and modify text outside the old region. +;; This should do it right. +(defmacro vm-save-restriction (&rest forms) + (let ((vm-sr-clip (make-symbol "vm-sr-clip")) + (vm-sr-min (make-symbol "vm-sr-min")) + (vm-sr-max (make-symbol "vm-sr-max"))) + `(let ((,vm-sr-clip (> (buffer-size) (- (point-max) (point-min)))) + ;; this shouldn't be necessary but the + ;; byte-compiler turns these into interned symbols + ;; which utterly defeats the purpose of the + ;; make-symbol calls above. Soooo, until the compiler + ;; is fixed, these must be made into (let ...) + ;; temporaries so that nested calls to this macros + ;; won't misbehave. + ,vm-sr-min ,vm-sr-max) + (and ,vm-sr-clip + (setq ,vm-sr-min (set-marker (make-marker) (point-min))) + (setq ,vm-sr-max (set-marker (make-marker) (point-max)))) + (unwind-protect + (progn ,@forms) + (widen) + (and ,vm-sr-clip + (progn + (narrow-to-region ,vm-sr-min ,vm-sr-max) + (set-marker ,vm-sr-min nil) + (set-marker ,vm-sr-max nil))))))) + +(put 'vm-save-restriction 'edebug-form-spec t) + +(defmacro vm-save-buffer-excursion (&rest forms) + `(let ((vm-sbe-buffer (current-buffer))) + (unwind-protect + (progn ,@forms) + (and (not (eq vm-sbe-buffer (current-buffer))) + (buffer-name vm-sbe-buffer) + (set-buffer vm-sbe-buffer))))) + +(put 'vm-save-buffer-excursion 'edebug-form-spec t) + +(defmacro vm-assert (expression) + (list 'or 'vm-assertion-checking-off + (list 'or expression + (list 'let + (list (list 'debug-on-error t)) + (list 'error "assertion failed: %S" + (list 'quote expression)))))) + +(defmacro vm-increment (variable) + (list 'setq variable (list '1+ variable))) + +(defmacro vm-decrement (variable) + (list 'setq variable (list '1- variable))) + +;; This should be turned into a defsubst eventually + +(defun vm-make-trace-buffer-name (session-name host) + (format "trace of %s session to %s at %s" + session-name host + (substring (current-time-string) 11 19))) + +;; For verification of the correct buffer protocol +;; Possible values are 'folder, 'presentation, 'summary, 'process + +;; (defvar vm-buffer-types nil) ; moved to vm-vars.el + +(defvar vm-buffer-type-debug nil + "*This flag can be set to t for debugging asynchronous buffer change + errors.") + +(defvar vm-buffer-type-debug nil) ; for debugging asynchronous + ; buffer change errors +(defvar vm-buffer-type-trail nil + "List of VM buffer types entered and exited, used for debugging +purposes.") + +(defsubst vm-buffer-type:enter (type) + "Note that vm is temporarily entering a buffer of TYPE." + (if vm-buffer-type-debug + (setq vm-buffer-type-trail + (cons type (cons 'enter vm-buffer-type-trail)))) + (setq vm-buffer-types (cons type vm-buffer-types))) + +(defsubst vm-buffer-type:exit () + "Note that vm is exiting the current temporary buffer." + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons 'exit vm-buffer-type-trail))) + (setq vm-buffer-types (cdr vm-buffer-types))) + +(defsubst vm-buffer-type:duplicate () + "Note that vm is reentering the current buffer for a temporary purpose." + (if vm-buffer-type-debug + (setq vm-buffer-type-trail (cons (car vm-buffer-type-trail) + vm-buffer-type-trail))) + (setq vm-buffer-types (cons (car vm-buffer-types) vm-buffer-types))) + +(defun vm-buffer-type:set (type) + "Note that vm is changing to a buffer of TYPE." + (when (and (eq type 'folder) vm-buffer-types + (eq (car vm-buffer-types) 'process)) + ;; This may or may not be a problem. + ;; It just means that no save-excursion was done among the + ;; functions currently tracked by vm-buffe-types. + (if vm-buffer-type-debug + (debug "folder buffer being entered from %s" (car vm-buffer-types)) + (message "folder buffer being entered from %s" (car vm-buffer-types))) + (setq vm-buffer-type-trail (cons type vm-buffer-type-trail))) + (if vm-buffer-types + (rplaca vm-buffer-types type) + (setq vm-buffer-types (cons type vm-buffer-types)))) + +(defsubst vm-buffer-type:assert (type) + "Check that vm is currently in a buffer of TYPE." + (vm-assert (eq (car vm-buffer-types) type))) + +(defsubst vm-buffer-type:wait-for-imap-session () + "Wait until the IMAP session is free to use, based on the +vm-buffer-types stack." + (while (and vm-buffer-types + (eq (car vm-buffer-types) 'process)) + (sleep-for 1))) + + +;;; vm-macro.el ends here diff --git a/lisp/vm-mark.el b/lisp/vm-mark.el new file mode 100755 index 0000000..45764b0 --- /dev/null +++ b/lisp/vm-mark.el @@ -0,0 +1,476 @@ +;;; vm-mark.el --- Commands for handling messages marks +;; +;; This file is part of VM +;; +;; Copyright (C) 1990, 1993, 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-mark) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-motion) + (require 'vm-thread) + (require 'vm-summary) + (require 'vm-sort) + (require 'vm-virtual) + (require 'vm-window) + ) + + +;;;###autoload +(defun vm-clear-all-marks () + "Removes all message marks in the current folder." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-inform 5 "Clearing all marks...") + (let ((mp vm-message-list)) + (while mp + (if (vm-mark-of (car mp)) + (progn + (vm-set-mark-of (car mp) nil) + (vm-mark-for-summary-update (car mp) t))) + (setq mp (cdr mp)))) + (vm-display nil nil '(vm-clear-all-marks) + '(vm-clear-all-marks marking-message)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "Clearing all marks... done")) + +;;;###autoload +(defun vm-toggle-all-marks () + "Toggles all message marks in the current folder. +Messages that are unmarked will become marked and messages that are +marked will become unmarked." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-inform 5 "Toggling all marks...") + (let ((mp vm-message-list)) + (while mp + (vm-set-mark-of (car mp) (not (vm-mark-of (car mp)))) + (vm-mark-for-summary-update (car mp) t) + (setq mp (cdr mp)))) + (vm-display nil nil '(vm-toggle-all-marks) + '(vm-toggle-all-marks marking-message)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "Toggling all marks... done")) + +;;;###autoload +(defun vm-mark-all-messages () + "Mark all messages in the current folder." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-inform 5 "Marking all messages...") + (let ((mp vm-message-list)) + (while mp + (vm-set-mark-of (car mp) t) + (vm-mark-for-summary-update (car mp) t) + (setq mp (cdr mp)))) + (vm-display nil nil '(vm-mark-all-messages) + '(vm-mark-all-messages marking-message)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "Marking all messages... done")) + +;;;###autoload +(defun vm-mark-message (count) + "Mark the current message. +Numeric prefix argument N means mark the current message and the next +N-1 messages. A negative N means mark the current message and the +previous N-1 messages." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((direction (if (< count 0) 'backward 'forward)) + (count (vm-abs count)) + (oldmp vm-message-pointer) + (vm-message-pointer vm-message-pointer)) + (while (not (zerop count)) + (if (not (vm-mark-of (car vm-message-pointer))) + (progn + (vm-set-mark-of (car vm-message-pointer) t) + (vm-mark-for-summary-update (car vm-message-pointer) t))) + (vm-decrement count) + (if (not (zerop count)) + (vm-move-message-pointer direction)))) + (vm-display nil nil '(vm-mark-message) + '(vm-mark-message marking-message)) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-unmark-message (count) + "Remove the mark from the current message. +Numeric prefix argument N means unmark the current message and the next +N-1 messages. A negative N means unmark the current message and the +previous N-1 messages." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Unmark"))) + (while mlist + (if (vm-mark-of (car mlist)) + (progn + (vm-set-mark-of (car mlist) nil) + (vm-mark-for-summary-update (car mlist) t))) + (setq mlist (cdr mlist)))) + (vm-display nil nil '(vm-unmark-message) + '(vm-unmark-message marking-message)) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-mark-summary-region () + "Mark all messages with summary lines contained in the region." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if (null vm-summary-buffer) + (error "No summary.")) + (set-buffer vm-summary-buffer) + (if (not (mark)) + (error "The region is not active now")) + (vm-mark-or-unmark-summary-region t) + (vm-display nil nil '(vm-mark-summary-region) + '(vm-mark-summary-region marking-message)) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-unmark-summary-region () + "Remove marks from messages with summary lines contained in the region." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if (null vm-summary-buffer) + (error "No summary.")) + (set-buffer vm-summary-buffer) + (if (not (mark)) + (error "The region is not active now")) + (vm-mark-or-unmark-summary-region nil) + (vm-display nil nil '(vm-unmark-summary-region) + '(vm-unmark-summary-region marking-message)) + (vm-update-summary-and-mode-line)) + +(defun vm-mark-or-unmark-summary-region (markit) + ;; The folder buffers copy of vm-message-list has already been + ;; propagated to the summary buffer. + (let ((mp vm-message-list) + (beg (point)) + (end (mark)) + tmp m) + (if (> beg end) + (setq tmp beg + beg end + end tmp)) + (while mp + (setq m (car mp)) + (if (not (eq (not markit) (not (vm-mark-of m)))) + (if (or (and (> (vm-su-end-of m) beg) + (< (vm-su-end-of m) end)) + (and (>= (vm-su-start-of m) beg) + (< (vm-su-start-of m) end)) + (and (>= beg (vm-su-start-of m)) + (< beg (vm-su-end-of m)))) + (progn + (vm-set-mark-of m markit) + (vm-mark-for-summary-update m t)))) + (setq mp (cdr mp))))) + +(defun vm-mark-or-unmark-messages-with-selector (val selector arg) + (let ((mlist vm-message-list) + (virtual (eq major-mode 'vm-virtual-mode)) + (arglist (if arg (list arg) nil)) + (count 0)) + (setq selector (intern (concat "vm-vs-" (symbol-name selector)))) + (while mlist + (if (if virtual + (save-excursion + (set-buffer + (vm-buffer-of + (vm-real-message-of + (car mlist)))) + (apply selector (vm-real-message-of (car mlist)) arglist)) + (apply selector (car mlist) arglist)) + (progn + (vm-set-mark-of (car mlist) val) + (vm-mark-for-summary-update (car mlist) t) + (vm-increment count))) + (setq mlist (cdr mlist))) + (vm-display nil nil + '(vm-mark-matching-messages vm-unmark-matching-messages) + (list this-command 'marking-message)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "%s message%s %smarked" + (if (> count 0) count "No") + (if (= 1 count) "" "s") + (if val "" "un")))) + +;;;###autoload +(defun vm-mark-matching-messages (selector &optional arg) + "Mark messages matching some criterion. +You can use any of the virtual folder selectors, except for the +`and', `or' and `not' selectors. See the documentation for the +variable vm-virtual-folder-alist for more information." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-select-folder-buffer) + (vm-read-virtual-selector "Mark messages: ")))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-with-selector t selector arg)) + +;;;###autoload +(defun vm-unmark-matching-messages (selector &optional arg) + "Unmark messages matching some criterion. +You can use any of the virtual folder selectors, except for the +`and', `or' and `not' selectors. See the documentation for the +variable vm-virtual-folder-alist for more information." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-select-folder-buffer) + (vm-read-virtual-selector "Unmark messages: ")))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-with-selector nil selector arg)) + +;;;###autoload +(defun vm-mark-thread-subtree () + "Mark all messages in the thread tree rooted at the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-thread-subtree t)) + +;;;###autoload +(defun vm-unmark-thread-subtree () + "Unmark all messages in the thread tree rooted at the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-thread-subtree nil)) + +(defun vm-mark-or-unmark-thread-subtree (mark) + (vm-build-threads-if-unbuilt) + (let ((list (vm-thread-subtree + (vm-thread-symbol (car vm-message-pointer))))) + (while list + (unless (eq (vm-mark-of (car list)) mark) + (vm-set-mark-of (car list) mark) + (vm-mark-for-summary-update (car list))) + (setq list (cdr list)))) +;; (let ((list (list (car vm-message-pointer))) +;; (loop-obarray (make-vector 29 0)) +;; subject-sym id-sym) +;; (while list +;; (if (not (eq (vm-mark-of (car list)) mark)) +;; (progn +;; (vm-set-mark-of (car list) mark) +;; (vm-mark-for-summary-update (car list)))) +;; (setq id-sym (vm-last-elem (vm-thread-list (car list)))) +;; (if (null (intern-soft (symbol-name id-sym) loop-obarray)) +;; (progn +;; (intern (symbol-name id-sym) loop-obarray) +;; (nconc list (copy-sequence (vm-th-child-messages-of id-sym))) +;; (setq subject-sym (intern (vm-so-sortable-subject (car list)) +;; vm-thread-subject-obarray)) +;; (if (and (boundp subject-sym) +;; (eq id-sym (aref (symbol-value subject-sym) 0))) +;; (nconc list (copy-sequence +;; (aref (symbol-value subject-sym) 2)))))) +;; (setq list (cdr list)))) + (vm-display nil nil + '(vm-mark-thread-subtree vm-unmark-thread-subtree) + (list this-command 'marking-message)) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-mark-messages-same-subject () + "Mark all messages with the same subject as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-same-subject t)) + +;;;###autoload +(defun vm-unmark-messages-same-subject () + "Unmark all messages with the same subject as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-same-subject nil)) + +(defun vm-mark-or-unmark-messages-same-subject (mark) + (let ((mp vm-message-list) + (mark-count 0) + (subject (vm-so-sortable-subject (car vm-message-pointer)))) + (while mp + (if (and (not (eq (vm-mark-of (car mp)) mark)) + (string-equal subject (vm-so-sortable-subject (car mp)))) + (progn + (vm-set-mark-of (car mp) mark) + (vm-increment mark-count) + (vm-mark-for-summary-update (car mp) t))) + (setq mp (cdr mp))) + (vm-display nil nil + '(vm-mark-messages-same-subject + vm-unmark-messages-same-subject) + (list this-command 'marking-message)) + (vm-update-summary-and-mode-line) + (if (zerop mark-count) + (vm-inform 5 "No messages %smarked" (if mark "" "un")) + (vm-inform 5 "%d message%s %smarked" + mark-count + (if (= 1 mark-count) "" "s") + (if mark "" "un"))))) + +;;;###autoload +(defun vm-mark-messages-same-author () + "Mark all messages with the same author as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-same-author t)) + +;;;###autoload +(defun vm-unmark-messages-same-author () + "Unmark all messages with the same author as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-same-author nil)) + +(defun vm-mark-or-unmark-messages-same-author (mark) + (let ((mp vm-message-list) + (mark-count 0) + (author (vm-su-from (car vm-message-pointer)))) + (while mp + (if (and (not (eq (vm-mark-of (car mp)) mark)) + (vm-string-equal-ignore-case author (vm-su-from (car mp)))) + (progn + (vm-set-mark-of (car mp) mark) + (vm-increment mark-count) + (vm-mark-for-summary-update (car mp) t))) + (setq mp (cdr mp))) + (vm-display nil nil + '(vm-mark-messages-same-author + vm-unmark-messages-same-author) + (list this-command 'marking-message)) + (vm-update-summary-and-mode-line) + (if (zerop mark-count) + (vm-inform 5 "No messages %smarked" (if mark "" "un")) + (vm-inform 5 "%d message%s %smarked" + mark-count + (if (= 1 mark-count) "" "s") + (if mark "" "un"))))) + +(defun vm-mark-or-unmark-messages-with-virtual-folder (val name) + (let* ((vfolder (assoc name vm-virtual-folder-alist)) + vm-virtual-folder-definition m mlist clauses + (count 0)) + (or vfolder (error "No such virtual folder, %s" name)) + (setq vfolder (vm-copy vfolder)) + (setq clauses (cdr vfolder)) + (while clauses + (setcar (car clauses) (list (list 'get-buffer (buffer-name)))) + (setq clauses (cdr clauses))) + (setq vm-virtual-folder-definition vfolder) + (setq mlist (vm-build-virtual-message-list vm-message-list t)) + (if (null vm-real-buffers) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (vm-set-mark-of m val) + (vm-mark-for-summary-update m t) + (vm-increment count) + (setq mlist (cdr mlist))) + (let ((curbuf (current-buffer)) vmlist) + (while mlist + (setq m (vm-real-message-of (car mlist)) + vmlist (vm-virtual-messages-of m)) + (while vmlist + (cond ((eq curbuf (vm-buffer-of (car vmlist))) + (vm-set-mark-of (car vmlist) val) + (vm-mark-for-summary-update (car vmlist) t) + (vm-increment count) + (setq vmlist nil)) + (t (setq vmlist (cdr vmlist))))) + (setq mlist (cdr mlist))))) + (vm-display nil nil + '(vm-mark-matching-messages-with-virtual-folder + vm-unmark-matching-messages-with-virtual-folder) + (list this-command 'marking-message)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "%s message%s %smarked" + (if (> count 0) count "No") + (if (= 1 count) "" "s") + (if val "" "un")))) + +;;;###autoload +(defun vm-mark-matching-messages-with-virtual-folder (name) + "Mark messages that are matched by the selectors of virtual folder NAME." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (list + (completing-read + "Mark messages matching this virtual folder's selectors: " + vm-virtual-folder-alist nil t)))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-with-virtual-folder t name)) + +;;;###autoload +(defun vm-unmark-matching-messages-with-virtual-folder (name) + "Unmark messages that are matched by the selectors of virtual folder NAME." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (list + (completing-read + "Unmark message matching this virtual folder's selectors: " + vm-virtual-folder-alist nil t)))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-mark-or-unmark-messages-with-virtual-folder nil name)) + +;;;###autoload +(defun vm-next-command-uses-marks () + "Does nothing except insure that the next VM command will operate only +on the marked messages in the current folder. This only works for +commands bound to key, menu or button press events. M-x vm-command will +not work." + (interactive) + (setq this-command 'vm-next-command-uses-marks) + (vm-inform 5 "Next command uses marks...") + (vm-display nil nil '(vm-next-command-uses-marks) + '(vm-next-command-uses-marks))) + +;;;###autoload +(defun vm-marked-messages () + (let (list (mp vm-message-list)) + (while mp + (if (vm-mark-of (car mp)) + (setq list (cons (car mp) list))) + (setq mp (cdr mp))) + (nreverse list))) + +;;;###autoload +(defun vm-mark-help () + (interactive) + (vm-display nil nil '(vm-mark-help) '(vm-mark-help)) + (vm-inform 0 "MM = mark, MU = unmark, Mm = mark all, Mu = unmark all, MN = use marks, ...")) + +;;; vm-mark.el ends here diff --git a/lisp/vm-menu.el b/lisp/vm-menu.el new file mode 100755 index 0000000..f5c50b8 --- /dev/null +++ b/lisp/vm-menu.el @@ -0,0 +1,1772 @@ +;;; vm-menu.el --- Menu related functions and commands +;; +;; This file is part of VM +;; +;; Copyright (C) 1994 Heiko Muenkel +;; Copyright (C) 1995, 1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +;; +;;; History: +;; +;; Folders menu derived from +;; vm-folder-menu.el +;; v1.10; 03-May-1994 +;; Copyright (C) 1994 Heiko Muenkel +;; email: muenkel@tnt.uni-hannover.de +;; Used with permission and my thanks. +;; Changed 18-May-1995, Kyle Jones +;; Cosmetic string changes, changed some variable names +;; and interfaced it with FSF Emacs via easymenu.el. +;; +;; Tree menu code is essentially tree-menu.el with renamed functions +;; tree-menu.el +;; v1.20; 10-May-1994 +;; Copyright (C) 1994 Heiko Muenkel +;; email: muenkel@tnt.uni-hannover.de +;; +;; Changed 18-May-1995, Kyle Jones +;; Removed the need for the utils.el package and references thereto. +;; Changed file-truename calls to tree-menu-file-truename so +;; the calls could be made compatible with FSF Emacs 19's +;; file-truename function. +;; Changed 30-May-1995, Kyle Jones +;; Renamed functions: tree- -> vm-menu-hm-tree. +;; Changed 5-July-1995, Kyle Jones +;; Removed the need for -A in ls flags. +;; Some systems' ls don't support -A. + +;;; Code: + +(provide 'vm-menu) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-mime) + + (defvar current-menubar nil)) + +(declare-function event-window "vm-xemacs" (event)) +(declare-function event-point "vm-xemacs" (event)) +(declare-function popup-mode-menu "vm-xemacs" (&optional event)) +(declare-function event-closest-point "vm-xemacs" (event)) +(declare-function find-menu-item "vm-xemacs" + (menubar item-path-list &optional parent)) +(declare-function add-menu-button "vm-xemacs" + (menu-path menu-leaf &optional before in-menu)) +(declare-function add-menu-item "vm-xemacs" + (menu-path item-name function enabled-p &optional before)) +(declare-function add-menu "vm-xemacs" + (menu-path menu-name menu-items &optional before)) +(declare-function set-menubar-dirty-flag "vm-xemacs" ()) +(declare-function set-buffer-menubar "vm-xemacs" (menubar)) + + +(declare-function vm-pop-find-name-for-spec "vm-pop" (spec)) +(declare-function vm-imap-folder-for-spec "vm-imap" (spec)) +(declare-function vm-mime-plain-message-p "vm-mime" (message)) +(declare-function vm-yank-message "vm-reply" (message)) +(declare-function vm-mail "vm" (&optional to subject)) +(declare-function vm-get-header-contents "vm-summary" + (message header-name-regexp &optional clump-sep)) +(declare-function vm-mail-mode-get-header-contents "vm-reply" + (header-name-regexp)) +(declare-function vm-create-virtual-folder "vm-virtual" + (selector &optional arg read-only name bookmark)) +(declare-function vm-create-virtual-folder-of-threads "vm-virtual" + (selector &optional arg read-only name bookmark)) +(declare-function vm-so-sortable-subject "vm-sort" (message)) +(declare-function vm-su-from "vm-summary" (message)) + + +;; This will be extended in code +(defvar vm-menu-folders-menu + '("Manipulate Folders" + ["Make Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory]) + "VM folder menu list.") + +(defconst vm-menu-folder-menu + `("Folder" + ,(if vm-fsfemacs-p + ["Manipulate Folders" ignore (ignore)] + vm-menu-folders-menu) + "---" + ["Display Summary" vm-summarize t] + ["Toggle Threading" vm-toggle-threads-display t] + "---" + ["Get New Mail" vm-get-new-mail (vm-menu-can-get-new-mail-p)] + "---" + ["Search" vm-isearch-forward vm-message-list] + "---" + ["Auto-Archive" vm-auto-archive-messages vm-message-list] + ["Expunge" vm-expunge-folder vm-message-list] + ["Expunge POP Messages" vm-expunge-pop-messages + (vm-menu-can-expunge-pop-messages-p)] + ["Expunge IMAP Messages" vm-expunge-imap-messages + (vm-menu-can-expunge-imap-messages-p)] + "---" + ["Visit Local Folder" vm-visit-folder t] + ["Visit POP Folder" vm-visit-pop-folder vm-pop-folder-alist] + ["Visit IMAP Folder" vm-visit-imap-folder vm-imap-account-alist] + ["Revert Folder (back to disk version)" vm-revert-buffer + (vm-menu-can-revert-p)] + ["Recover Folder (from auto-save file)" vm-recover-file + (vm-menu-can-recover-p)] + ["Save" vm-save-folder (vm-menu-can-save-p)] + ["Save As..." vm-write-file t] + ["Quit" vm-quit-no-change t] + ["Save & Quit" vm-quit t] + "---" + ;; "---" + ;; special string that marks the tail of this menu for + ;; vm-menu-install-visited-folders-menu. + "-------" + )) + +(defconst vm-menu-dispose-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Dispose" + "Dispose" + "---" + "---") + (list "Dispose")))) + `(,@title + ["Reply to Author" vm-reply vm-message-list] + ["Reply to All" vm-followup vm-message-list] + ["Reply to Author (citing original)" vm-reply-include-text + vm-message-list] + ["Reply to All (citing original)" vm-followup-include-text + vm-message-list] + ["Forward" vm-forward-message vm-message-list] + ["Forward in Plain Text" vm-forward-message-plain vm-message-list] + ["Resend" vm-resend-message vm-message-list] + ["Retry Bounce" vm-resend-bounced-message vm-message-list] + "---" + ["File" vm-save-message vm-message-list] + ["Delete" vm-delete-message vm-message-list] + ["Undelete" vm-undelete-message vm-message-list] + ["Kill Current Subject" vm-kill-subject vm-message-list] + ["Mark Unread" vm-mark-message-unread vm-message-list] + ["Edit" vm-edit-message vm-message-list] + ["Print" vm-print-message vm-message-list] + ["Pipe to Command" vm-pipe-message-to-command vm-message-list] + ["Attach to Message Composition" + vm-attach-message-to-composition vm-message-list] + "---" + ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list] + ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)] + ))) + +(defconst vm-menu-motion-menu + '("Motion" + ["Page Up" vm-scroll-backward vm-message-list] + ["Page Down" vm-scroll-forward vm-message-list] + "----" + ["Beginning" vm-beginning-of-message vm-message-list] + ["End" vm-end-of-message vm-message-list] + "----" + ["Expose/Hide Headers" vm-expose-hidden-headers vm-message-list] + "----" + ["Next Message" vm-next-message t] + ["Previous Message" vm-previous-message t] + "---" + ["Next, Same Subject" vm-next-message-same-subject t] + ["Previous, Same Subject" vm-previous-message-same-subject t] + "---" + ["Next Unread" vm-next-unread-message t] + ["Previous Unread" vm-previous-unread-message t] + "---" + ["Next Message (no skip)" vm-next-message-no-skip t] + ["Previous Message (no skip)" vm-previous-message-no-skip t] + "---" + ["Go to Last Seen Message" vm-goto-message-last-seen t] + ["Go to Message" vm-goto-message t] + ["Go to Parent Message" vm-goto-parent-message t] + )) + +(defconst vm-menu-virtual-menu + '("Virtual" + ["Visit Virtual Folder" vm-visit-virtual-folder t] + ["Apply Virtual Folder Selectors" vm-apply-virtual-folder t] + ["Omit Message" vm-virtual-omit-message t] + ["Update all" vm-virtual-update-folders] + "---" + "Search Folders" + ["Author" vm-create-author-virtual-folder t] + ["Recipients" vm-create-author-or-recipient-virtual-folder t] + ["Subject" vm-create-subject-virtual-folder t] + ["Text (Body)" vm-create-text-virtual-folder t] + ["Days" vm-create-date-virtual-folder t] + ["Label" vm-create-label-virtual-folder t] + ["Flagged" vm-create-flagged-virtual-folder t] + ["Unseen" vm-create-unseen-virtual-folder t] + ["Same Author as current" vm-create-virtual-folder-same-author t] + ["Same Subject as current" vm-create-virtual-folder-same-subject t] + ["Create General" vm-create-virtual-folder t] + ["Create General (Threads)" vm-create-virtual-folder-of-threads t] + "---" + "Auto operations" + ["Delete Message(s)" vm-virtual-auto-delete-message t] + ["Save Message(s)" vm-virtual-save-message t] + ["Archive Messages" vm-virtual-auto-archive-messages t] + + ;; special string that marks the tail of this menu for + ;; vm-menu-install-known-virtual-folders-menu. + "-------" + )) + +(defconst vm-menu-send-menu + '("Send" + ["Compose" vm-mail t] + ["Continue Composing" vm-continue-composing-message vm-message-list] + ["Reply to Author" vm-reply vm-message-list] + ["Reply to All" vm-followup vm-message-list] + ["Reply to Author (citing original)" vm-reply-include-text vm-message-list] + ["Reply to All (citing original)" vm-followup-include-text vm-message-list] + ["Forward Message" vm-forward-message vm-message-list] + ["Forward Message in Plain Text" vm-forward-message-plain vm-message-list] + ["Resend Message" vm-resend-message vm-message-list] + ["Retry Bounced Message" vm-resend-bounced-message vm-message-list] + ["Send Digest (RFC934)" vm-send-rfc934-digest vm-message-list] + ["Send Digest (RFC1153)" vm-send-rfc1153-digest vm-message-list] + ["Send MIME Digest" vm-send-mime-digest vm-message-list] + )) + +(defconst vm-menu-mark-menu + '("Mark" + ["Next Command Uses Marks..." vm-next-command-uses-marks + :active vm-message-list + :style radio + :selected (eq last-command 'vm-next-command-uses-marks)] + "----" + ["Mark" vm-mark-message vm-message-list] + ["Unmark" vm-unmark-message vm-message-list] + ["Mark All" vm-mark-all-messages vm-message-list] + ["Clear All Marks" vm-clear-all-marks vm-message-list] + ["Mark Region in Summary" vm-mark-summary-region vm-message-list] + ["Unmark Region in Summary" vm-unmark-summary-region vm-message-list] + "----" + ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list] + ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list] + ["Mark Same Author" vm-mark-messages-same-author vm-message-list] + ["Unmark Same Author" vm-unmark-messages-same-author vm-message-list] + ["Mark Messages Matching..." vm-mark-matching-messages vm-message-list] + ["Unmark Messages Matching..." vm-unmark-matching-messages vm-message-list] + ["Mark Thread Subtree" vm-mark-thread-subtree vm-message-list] + ["Unmark Thread Subtree" vm-unmark-thread-subtree vm-message-list] + )) + +(defconst vm-menu-label-menu + '("Label" + ["Add Label" vm-add-message-labels vm-message-list] + ["Add Existing Label" vm-add-existing-message-labels vm-message-list] + ["Remove Label" vm-delete-message-labels vm-message-list] + )) + +(defconst vm-menu-sort-menu + '("Sort" + "By ascending" + "---" + ["Date" (vm-sort-messages "date") vm-message-list] + ["Activity" (vm-sort-messages "activity") vm-message-list] + ["Subject" (vm-sort-messages "subject") vm-message-list] + ["Author" (vm-sort-messages "author") vm-message-list] + ["Recipients" (vm-sort-messages "recipients") vm-message-list] + ["Lines" (vm-sort-messages "line-count") vm-message-list] + ["Bytes" (vm-sort-messages "byte-count") vm-message-list] + "---" + "By descending" + "---" + ["Date" (vm-sort-messages "reversed-date") vm-message-list] + ["Activity" (vm-sort-messages "reversed-activity") vm-message-list] + ["Subject" (vm-sort-messages "reversed-subject") vm-message-list] + ["Author" (vm-sort-messages "reversed-author") vm-message-list] + ["Recipients" (vm-sort-messages "reversed-recipients") vm-message-list] + ["Lines" (vm-sort-messages "reversed-line-count") vm-message-list] + ["Bytes" (vm-sort-messages "reversed-byte-count") vm-message-list] + "---" + ["By Multiple Fields..." vm-sort-messages vm-message-list] + ["Revert to Physical Order" (vm-sort-messages "physical-order" t) vm-message-list] + "---" + ["Toggle Threading" vm-toggle-threads-display t] + ["Expand/Collapse Thread" vm-toggle-thread t] + ["Expand All Threads" vm-expand-all-threads t] + ["Collapse All Threads" vm-collapse-all-threads t] + )) + +(defconst vm-menu-help-menu + '("Help" + ["Switch to Emacs Menubar" vm-menu-toggle-menubar t] + "---" + ["Customize VM" vm-customize t] + ["Describe VM Mode" describe-mode t] + ["VM News" vm-view-news t] + ["VM Manual" vm-menu-view-manual t] + ["Submit Bug Report" vm-submit-bug-report t] + "---" + ["What Now?" vm-help t] + ["Revert Folder (back to disk version)" revert-buffer (vm-menu-can-revert-p)] + ["Recover Folder (from auto-save file)" recover-file (vm-menu-can-recover-p)] + "---" + ["Save Folder & Quit" vm-quit t] + ["Quit Without Saving" vm-quit-no-change t] + )) + +(defconst vm-menu-xemacs-undo-button + ["[Undo]" vm-undo (vm-menu-can-undo-p)] + ) + +(defconst vm-menu-undo-menu + '("Undo" + ["Undo" vm-undo (vm-menu-can-undo-p)] + ) + "Undo menu for FSF Emacs builds that do not allow menubar buttons.") + +(defconst vm-menu-emacs-button + ["[Emacs Menubar]" vm-menu-toggle-menubar t] + ) + +(defconst vm-menu-emacs-menu + '("Menubar" + ["Switch to Emacs Menubar" vm-menu-toggle-menubar t] + ) + "Menu with a \"Swich to Emacs\" action meant for FSF Emacs builds that +do not allow menubar buttons.") + +(defconst vm-menu-vm-button + ["[VM Menubar]" vm-menu-toggle-menubar t] + ) + +(defconst vm-menu-mail-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Mail Commands" + "Mail Commands" + "---" + "---") + (list "Mail Commands")))) + `(,@title + ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)] + ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)] + ["Cancel" kill-buffer t] + "----" + ["Yank Original" vm-menu-yank-original vm-reply-list] + "----" + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Send Using MIME..." + "Send Using MIME..." + "---" + "---") + (list "Send Using MIME...")) + ["Use MIME" + (progn (set (make-local-variable 'vm-send-using-mime) t) + (vm-mail-mode-remove-tm-hooks)) + :active t + :style radio + :selected vm-send-using-mime] + ["Don't use MIME" + (set (make-local-variable 'vm-send-using-mime) nil) + :active t + :style radio + :selected (not vm-send-using-mime)]) + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Fragment Messages Larger Than ..." + "Fragment Messages Larger Than ..." + "---" + "---") + (list "Fragment Messages Larger Than ...")) + ["Infinity, i.e., don't fragment" + (set (make-local-variable 'vm-mime-max-message-size) nil) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size nil)] + ["50000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 50000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 50000)] + ["100000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 100000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 100000)] + ["200000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 200000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 200000)] + ["500000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 500000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 500000)] + ["1000000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 1000000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 1000000)] + ["2000000 bytes" + (set (make-local-variable 'vm-mime-max-message-size) + 2000000) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-max-message-size 2000000)]) + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Encode 8-bit Characters Using ..." + "Encode 8-bit Characters Using ..." + "---" + "---") + (list "Encode 8-bit Characters Using ...")) + ["Nothing, i.e., send unencoded" + (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding) + '8bit) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)] + ["Quoted-Printable" + (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding) + 'quoted-printable) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-8bit-text-transfer-encoding + 'quoted-printable)] + ["BASE64" + (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding) + 'base64) + :active vm-send-using-mime + :style radio + :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]) + "----" + ["Attach File..." vm-attach-file vm-send-using-mime] + ["Attach MIME Message..." vm-attach-mime-file vm-send-using-mime] + ["Encode MIME, But Don't Send" vm-mime-encode-composition + (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:")))] + ["Preview MIME Before Sending" vm-preview-composition + vm-send-using-mime] + ))) + +(defconst vm-menu-mime-dispose-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Take Action on MIME body ..." + "Take Action on MIME body ..." + "---" + "---") + (list "Take Action on MIME body ...")))) + `(,@title + ["Display as Text (in default face)" + vm-mime-reader-map-display-using-default t] + ["Display using External Viewer" + vm-mime-reader-map-display-using-external-viewer t] + ["Convert to Text and Display" + vm-mime-reader-map-convert-then-display + (vm-menu-can-convert-to-text/plain (vm-mime-get-button-layout))] + ;; FSF Emacs does not allow a non-string menu element name. + ;; This is not working on XEmacs either. USR, 2011-03-05 + ;; ,@(if (vm-menu-can-eval-item-name) + ;; (list [(format "Convert to %s and Display" + ;; (or (nth 1 (vm-mime-can-convert + ;; (car + ;; (vm-mm-layout-type + ;; (vm-mime-get-button-layout))))) + ;; "different type")) + ;; (vm-mime-run-display-function-at-point + ;; 'vm-mime-convert-body-then-display) + ;; (vm-mime-can-convert + ;; (car (vm-mm-layout-type + ;; (vm-mime-get-button-layout))))])) + "---" + ["Undo" + vm-undo] + "---" + ["Save to File" + vm-mime-reader-map-save-file t] + ["Save to Folder" + vm-mime-reader-map-save-message + (let ((layout (vm-mime-get-button-layout))) + (if (null layout) + nil + (or (vm-mime-types-match "message/rfc822" + (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message/news" + (car (vm-mm-layout-type layout))))))] + ["Send to Printer" + vm-mime-reader-map-pipe-to-printer t] + ["Pipe to Shell Command (display output)" + vm-mime-reader-map-pipe-to-command t] + ["Pipe to Shell Command (discard output)" + vm-mime-reader-map-pipe-to-command-discard-output t] + ["Attach to Message Composition Buffer" + vm-mime-reader-map-attach-to-composition t] + ["Delete" vm-delete-mime-object t]))) + +(defconst vm-menu-url-browser-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Send URL to ..." + "Send URL to ..." + "---" + "---") + (list "Send URL to ..."))) + (w3 (cond ((fboundp 'w3-fetch-other-frame) + 'w3-fetch-other-frame) + ((fboundp 'w3-fetch) + 'w3-fetch) + (t 'w3-fetch-other-frame)))) + `(,@title + ["Window system (Copy)" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-window-system) + t] + ["X Clipboard" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-clipboard) + t] + ["browse-url" + (vm-mouse-send-url-at-position (point) 'browse-url) + browse-url-browser-function] + ["Emacs W3" (vm-mouse-send-url-at-position (point) (quote ,w3)) + (fboundp (quote ,w3))] + ["Emacs W3M" (vm-mouse-send-url-at-position (point) 'w3m-browse-url) + (fboundp 'w3m-browse-url)] + "---" + ["Firefox" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-firefox) + vm-firefox-client-program] + ["Konqueror" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-konqueror) + vm-konqueror-client-program] + ;; ["Mosaic" + ;; (vm-mouse-send-url-at-position + ;; (point) 'vm-mouse-send-url-to-mosaic) + ;; vm-mosaic-program] + ;; ["mMosaic" + ;; (vm-mouse-send-url-at-position + ;; (point) 'vm-mouse-send-url-to-mmosaic) + ;; vm-mmosaic-program] + ["Mozilla" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-mozilla) + vm-mozilla-program] +;; ["Netscape" +;; (vm-mouse-send-url-at-position +;; (point) 'vm-mouse-send-url-to-netscape) +;; vm-netscape-program] + ["Opera" + (vm-mouse-send-url-at-position + (point) 'vm-mouse-send-url-to-opera) + vm-opera-program]))) + +(defconst vm-menu-mailto-url-browser-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Send Mail using ..." + "Send Mail using ..." + "---" + "---") + (list "Send Mail using ...")))) + `(,@title + ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t]))) + +(defconst vm-menu-subject-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Take Action on Subject..." + "Take Action on Subject..." + "---" + "---") + (list "Take Action on Subject...")))) + `(,@title + ["Kill Subject" vm-kill-subject vm-message-list] + ["Next Message, Same Subject" vm-next-message-same-subject + vm-message-list] + ["Previous Message, Same Subject" vm-previous-message-same-subject + vm-message-list] + ["Mark Messages, Same Subject" vm-mark-messages-same-subject + vm-message-list] + ["Unmark Messages, Same Subject" vm-unmark-messages-same-subject + vm-message-list] + ["Virtual Folder, Matching Subject" vm-menu-create-subject-virtual-folder + vm-message-list] + ))) + +(defconst vm-menu-author-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Take Action on Author..." + "Take Action on Author..." + "---" + "---") + (list "Take Action on Author...")))) + `(,@title + ["Mark Messages, Same Author" vm-mark-messages-same-author + vm-message-list] + ["Unmark Messages, Same Author" vm-unmark-messages-same-author + vm-message-list] + ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder + vm-message-list] + ["Send a message" vm-menu-mail-to + vm-message-list] + ))) + +(defconst vm-menu-attachment-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Fiddle With Attachment" + "Fiddle With Attachment" + "---" + "---") + (list "Fiddle With Attachment")))) + `(,@title + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Set Content Disposition..." + "Set Content Disposition..." + "---" + "---") + (list "Set Content Disposition...")) + ["Unspecified" + (vm-mime-set-attachment-disposition-at-point 'unspecified) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) + 'unspecified)] + ["Inline" + (vm-mime-set-attachment-disposition-at-point 'inline) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)] + ["Attachment" + (vm-mime-set-attachment-disposition-at-point 'attachment) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) + 'attachment)]) + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Set Content Encoding..." + "Set Content Encoding..." + "---" + "---") + (list "Set Content Encoding...")) + ["Guess" + (vm-mime-set-attachment-encoding-at-point "guess") + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-encoding-at-point) nil)] + ["Binary" + (vm-mime-set-attachment-encoding-at-point "binary") + :active vm-send-using-mime + :style radio + :selected (string= (vm-mime-attachment-encoding-at-point) "binary")] + ["7bit" + (vm-mime-set-attachment-encoding-at-point "7bit") + :active vm-send-using-mime + :style radio + :selected (string= (vm-mime-attachment-encoding-at-point) "7bit")] + ["8bit" + (vm-mime-set-attachment-encoding-at-point "8bit") + :active vm-send-using-mime + :style radio + :selected (string= (vm-mime-attachment-encoding-at-point) "8bit")] + ["quoted-printable" + (vm-mime-set-attachment-encoding-at-point "quoted-printable") + :active vm-send-using-mime + :style radio + :selected (string= (vm-mime-attachment-encoding-at-point) "quoted-printable")] + ) + ( + ,@(if (vm-menu-fsfemacs19-menus-p) + (list "Forward Local External Bodies" + "Forward Local External Bodies" + "---" + "---") + (list "Forward Local External Bodies")) + ["Forward Unchanged" + (vm-mime-set-attachment-forward-local-refs-at-point t) + :active vm-send-using-mime + :style radio + :selected (vm-mime-attachment-forward-local-refs-at-point)] + ["Convert to Internal Object" + (vm-mime-set-attachment-forward-local-refs-at-point nil) + :active vm-send-using-mime + :style radio + :selected (not (vm-mime-attachment-forward-local-refs-at-point))]) + ["Delete" + (vm-mime-delete-attachment-button) + :style button] + ["Delete, but keep infos" + (vm-mime-delete-attachment-button-keep-infos) + :style button] + ))) + +(defconst vm-menu-image-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "Redisplay Image" + "Redisplay Image" + "---" + "---") + (list "Redisplay Image")))) + `(,@title + ["4x Larger" + (vm-mime-run-display-function-at-point 'vm-mime-larger-image) + (stringp vm-imagemagick-convert-program)] + ["4x Smaller" + (vm-mime-run-display-function-at-point 'vm-mime-smaller-image) + (stringp vm-imagemagick-convert-program)] + ["Rotate Left" + (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-left) + (stringp vm-imagemagick-convert-program)] + ["Rotate Right" + (vm-mime-run-display-function-at-point 'vm-mime-rotate-image-right) + (stringp vm-imagemagick-convert-program)] + ["Mirror" + (vm-mime-run-display-function-at-point 'vm-mime-mirror-image) + (stringp vm-imagemagick-convert-program)] + ["Brighter" + (vm-mime-run-display-function-at-point 'vm-mime-brighten-image) + (stringp vm-imagemagick-convert-program)] + ["Dimmer" + (vm-mime-run-display-function-at-point 'vm-mime-dim-image) + (stringp vm-imagemagick-convert-program)] + ["Monochrome" + (vm-mime-run-display-function-at-point 'vm-mime-monochrome-image) + (stringp vm-imagemagick-convert-program)] + ["Revert to Original" + (vm-mime-run-display-function-at-point 'vm-mime-revert-image) + (get + (vm-mm-layout-cache + (vm-extent-property (vm-find-layout-extent-at-point) 'vm-mime-layout)) + 'vm-image-modified)] + ))) + +(defvar vm-menu-vm-menubar nil) + +(defconst vm-menu-vm-menu + (let ((title (if (vm-menu-fsfemacs19-menus-p) + (list "VM" + "VM" + "---" + "---") + (list "VM")))) + `(,@title + ,vm-menu-folder-menu + ,vm-menu-motion-menu + ,vm-menu-send-menu + ,vm-menu-mark-menu + ,vm-menu-label-menu + ,vm-menu-sort-menu + ,vm-menu-virtual-menu +;; ,vm-menu-undo-menu + ,vm-menu-dispose-menu + "---" + "---" + ,vm-menu-help-menu))) + +(defvar vm-mode-menu-map nil + "If running in FSF Emacs, this variable stores the standard +menu bar of VM internally. USR, 2011-02-27") + +(defun vm-menu-run-command (command &rest args) + "Run COMMAND almost interactively, with ARGS. +call-interactive can't be used unfortunately, but this-command is +set to the command name so that window configuration will be done." + (setq this-command command) + (apply command args)) + +(defun vm-menu-can-revert-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (and (buffer-modified-p) buffer-file-name)) + (error nil))) + +(defun vm-menu-can-recover-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (and buffer-file-name + buffer-auto-save-file-name + (file-newer-than-file-p + buffer-auto-save-file-name + buffer-file-name))) + (error nil))) + +(defun vm-menu-can-save-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (or (eq major-mode 'vm-virtual-mode) + (buffer-modified-p))) + (error nil))) + +(defun vm-menu-can-get-new-mail-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (or (eq major-mode 'vm-virtual-mode) + (and (not vm-block-new-mail) (not vm-folder-read-only)))) + (error nil))) + +(defun vm-menu-can-undo-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + vm-undo-record-list) + (error nil))) + +(defun vm-menu-can-decode-mime-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (and vm-display-using-mime + vm-message-pointer + vm-presentation-buffer +;; (not vm-mime-decoded) + (not (vm-mime-plain-message-p (car vm-message-pointer))))) + (error nil))) + +(defun vm-menu-can-convert-to-text/plain (layout) + (let ((type (car (vm-mm-layout-type layout)))) + (or (equal (nth 1 (vm-mime-can-convert type)) "text/plain") + (and (equal type "message/external-body") + (vm-menu-can-convert-to-text/plain + (car (vm-mm-layout-parts layout))))))) + +(defun vm-menu-can-expunge-pop-messages-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (not (eq vm-folder-access-method 'pop))) + (error nil))) + +(defun vm-menu-can-expunge-imap-messages-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (not (eq vm-folder-access-method 'imap))) + (error nil))) + +(defun vm-menu-yank-original () + (interactive) + (save-excursion + (let ((mlist vm-reply-list)) + (while mlist + (vm-yank-message (car mlist)) + (goto-char (point-max)) + (setq mlist (cdr mlist)))))) + +(defun vm-menu-can-send-mail-p () + (save-match-data + (catch 'done + (let ((headers '("to" "cc" "bcc" "resent-to" "resent-cc" "resent-bcc")) + h) + (while headers + (setq h (vm-mail-mode-get-header-contents (car headers))) + (and (stringp h) (string-match "[^ \t\n,]" h) + (throw 'done t)) + (setq headers (cdr headers))) + nil )))) + +(defun vm-menu-create-subject-virtual-folder () + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq this-command 'vm-create-virtual-folder) + (vm-create-virtual-folder 'sortable-subject (regexp-quote + (vm-so-sortable-subject + (car vm-message-pointer))))) + +(defun vm-menu-create-author-virtual-folder () + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq this-command 'vm-create-virtual-folder) + (vm-create-virtual-folder 'author (regexp-quote + (vm-su-from (car vm-message-pointer))))) + +(defun vm-menu-mail-to () + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq this-command 'vm-mail) + (vm-mail (vm-get-header-contents (car vm-message-pointer) "From:"))) + + +(defun vm-menu-xemacs-global-menubar () + (save-excursion + (set-buffer (get-buffer-create "*scratch*")) + current-menubar)) + +(defun vm-menu-fsfemacs-global-menubar () + (lookup-key (current-global-map) [menu-bar])) + +(defun vm-menu-initialize-vm-mode-menu-map () + (if (null vm-mode-menu-map) + (let ((map (make-sparse-keymap)) + (dummy (make-sparse-keymap))) + ;; initialize all the vm-menu-fsfemacs-*-menu variables + ;; with the menus. + (easy-menu-define vm-menu-fsfemacs-help-menu (list dummy) nil + vm-menu-help-menu) + (easy-menu-define vm-menu-fsfemacs-dispose-menu (list dummy) nil + (cons "Dispose" (nthcdr 4 vm-menu-dispose-menu))) + (easy-menu-define vm-menu-fsfemacs-dispose-popup-menu (list dummy) nil + vm-menu-dispose-menu) + (easy-menu-define vm-menu-fsfemacs-undo-menu (list dummy) nil + vm-menu-undo-menu) + (easy-menu-define vm-menu-fsfemacs-emacs-menu (list dummy) nil + vm-menu-emacs-menu) + (easy-menu-define vm-menu-fsfemacs-virtual-menu (list dummy) nil + vm-menu-virtual-menu) + (easy-menu-define vm-menu-fsfemacs-sort-menu (list dummy) nil + vm-menu-sort-menu) + (easy-menu-define vm-menu-fsfemacs-label-menu (list dummy) nil + vm-menu-label-menu) + (easy-menu-define vm-menu-fsfemacs-mark-menu (list dummy) nil + vm-menu-mark-menu) + (easy-menu-define vm-menu-fsfemacs-send-menu (list dummy) nil + vm-menu-send-menu) + (easy-menu-define vm-menu-fsfemacs-motion-menu (list dummy) nil + vm-menu-motion-menu) +;; (easy-menu-define vm-menu-fsfemacs-folders-menu (list dummy) nil +;; vm-menu-folders-menu) + (easy-menu-define vm-menu-fsfemacs-folder-menu (list dummy) nil + vm-menu-folder-menu) + (easy-menu-define vm-menu-fsfemacs-vm-menu (list dummy) nil + vm-menu-vm-menu) + ;; for mail mode + (easy-menu-define vm-menu-fsfemacs-mail-menu (list dummy) nil + vm-menu-mail-menu) + ;; subject menu + (easy-menu-define vm-menu-fsfemacs-subject-menu (list dummy) nil + vm-menu-subject-menu) + ;; author menu + (easy-menu-define vm-menu-fsfemacs-author-menu (list dummy) nil + vm-menu-author-menu) + ;; url browser menu + (easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil + vm-menu-url-browser-menu) + ;; mailto url browser menu + (easy-menu-define vm-menu-fsfemacs-mailto-url-browser-menu + (list dummy) nil + vm-menu-url-browser-menu) + ;; mime dispose menu + (easy-menu-define vm-menu-fsfemacs-mime-dispose-menu + (list dummy) nil + vm-menu-mime-dispose-menu) + ;; attachment menu + (easy-menu-define vm-menu-fsfemacs-attachment-menu + (list dummy) nil + vm-menu-attachment-menu) + ;; image menu + (easy-menu-define vm-menu-fsfemacs-image-menu + (list dummy) nil + vm-menu-image-menu) + ;; block the global menubar entries in the map so that VM + ;; can take over the menubar if necessary. + (define-key map [rootmenu] (make-sparse-keymap)) + (define-key map [rootmenu vm] (cons "VM" (make-sparse-keymap "VM"))) + (define-key map [rootmenu vm file] 'undefined) + (define-key map [rootmenu vm files] 'undefined) + (define-key map [rootmenu vm search] 'undefined) + (define-key map [rootmenu vm edit] 'undefined) + (define-key map [rootmenu vm options] 'undefined) + (define-key map [rootmenu vm buffer] 'undefined) + (define-key map [rootmenu vm tools] 'undefined) + (define-key map [rootmenu vm help] 'undefined) + (define-key map [rootmenu vm mule] 'undefined) + ;; 19.29 changed the tag for the Help menu. + (define-key map [rootmenu vm help-menu] 'undefined) + ;; now build VM's menu tree. + (let ((menu-alist + '((dispose + (cons "Dispose" vm-menu-fsfemacs-dispose-menu)) + (folder + (cons "Folder" vm-menu-fsfemacs-folder-menu)) + (help + (cons "Help" vm-menu-fsfemacs-help-menu)) + (label + (cons "Label" vm-menu-fsfemacs-label-menu)) + (mark + (cons "Mark" vm-menu-fsfemacs-mark-menu)) + (motion + (cons "Motion" vm-menu-fsfemacs-motion-menu)) + (send + (cons "Send" vm-menu-fsfemacs-send-menu)) + (sort + (cons "Sort" vm-menu-fsfemacs-sort-menu)) + (virtual + (cons "Virtual" vm-menu-fsfemacs-virtual-menu)) + (emacs + (if (and (vm-menubar-buttons-possible-p) + vm-use-menubar-buttons) + (cons "[Emacs Menubar]" 'vm-menu-toggle-menubar) + (cons "Menubar" vm-menu-fsfemacs-emacs-menu))) + (undo + (if (and (vm-menubar-buttons-possible-p) + vm-use-menubar-buttons) + (cons "[Undo]" 'vm-undo) + (cons "Undo" vm-menu-fsfemacs-undo-menu))))) + (cons nil) + (vec (vector 'rootmenu 'vm nil)) + ;; menus appear in the opposite order that we + ;; define-key them. + (menu-list + (if (consp vm-use-menus) + (reverse vm-use-menus) + (list 'help nil 'dispose 'undo 'virtual 'sort + 'label 'mark 'send 'motion 'folder))) + (menu nil)) + (while menu-list + (setq menu (car menu-list)) + (if (null menu) + nil;; no flushright support in FSF Emacs + (aset vec 2 (intern (concat "vm-menubar-" (symbol-name menu)))) + (setq cons (assq menu menu-alist)) + (if cons + (define-key map vec (eval (cadr cons))))) + (setq menu-list (cdr menu-list)))) + (setq vm-mode-menu-map map) + (run-hooks 'vm-menu-setup-hook)))) + +(defun vm-menu-make-xemacs-menubar () + (let ((menu-alist + '((dispose . vm-menu-dispose-menu) + (folder . vm-menu-folder-menu) + (help . vm-menu-help-menu) + (label . vm-menu-label-menu) + (mark . vm-menu-mark-menu) + (motion . vm-menu-motion-menu) + (send . vm-menu-send-menu) + (sort . vm-menu-sort-menu) + (virtual . vm-menu-virtual-menu) + (emacs . vm-menu-emacs-button) + (undo . vm-menu-xemacs-undo-button))) + cons + (menubar nil) + (menu-list vm-use-menus)) + (while menu-list + (if (null (car menu-list)) + (setq menubar (cons nil menubar)) + (setq cons (assq (car menu-list) menu-alist)) + (if cons + (setq menubar (cons (symbol-value (cdr cons)) menubar)))) + (setq menu-list (cdr menu-list))) + (nreverse menubar) )) + +(defun vm-menu-popup-mode-menu (event) + (interactive "e") + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event))) + (popup-mode-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (vm-menu-popup-fsfemacs-menu event)))) + +(defvar vm-menu-fsfemacs-attachment-menu) +(defun vm-menu-popup-context-menu (event) + (interactive "e") + ;; We should not need to do anything here for XEmacs. The + ;; default binding of mouse-3 is popup-mode-menu which does + ;; what we want for the normal case. For special context,s + ;; like when the mouse is over an URL, XEmacs has local keymap + ;; support for extents. Any context sensitive area should be + ;; contained in an extent with a keymap that has mouse-3 bound + ;; to a function that will pop up a context sensitive menu. + (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (if (get-text-property (point) 'vm-mime-object) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-attachment-menu) + (let (o-list o menu (found nil)) + (setq o-list (overlays-at (point))) + (while (and o-list (not found)) + (cond ((overlay-get (car o-list) 'vm-url) + (setq found t) + (vm-menu-popup-url-browser-menu event)) + ((setq menu (overlay-get (car o-list) 'vm-header)) + (setq found t) + (vm-menu-popup-fsfemacs-menu event menu)) + ((setq menu (overlay-get (car o-list) 'vm-image)) + (setq found t) + (vm-menu-popup-fsfemacs-menu event menu)) + ((overlay-get (car o-list) 'vm-mime-layout) + (setq found t) + (vm-menu-popup-mime-dispose-menu event))) + (setq o-list (cdr o-list))) + (and (not found) (vm-menu-popup-fsfemacs-menu event))))))) + +;; to quiet the byte-compiler +(defvar vm-menu-fsfemacs-url-browser-menu) +(defvar vm-menu-fsfemacs-mailto-url-browser-menu) +(defvar vm-menu-fsfemacs-mime-dispose-menu) + +(defun vm-menu-goto-event (event) + (cond ((vm-menu-xemacs-menus-p) + ;; Must select window instead of just set-buffer because + ;; popup-menu returns before the user has made a + ;; selection. This will cause the command loop to + ;; resume which might undo what set-buffer does. + (select-window (event-window event)) + (and (event-closest-point event) + (goto-char (event-closest-point event)))) + ((vm-menu-fsfemacs-menus-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event)))))) + +(defun vm-menu-popup-url-browser-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-url-browser-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-url-browser-menu)))) + +(defun vm-menu-popup-mailto-url-browser-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-mailto-url-browser-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-mailto-url-browser-menu)))) + +(defun vm-menu-popup-mime-dispose-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-mime-dispose-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-mime-dispose-menu)))) + +(defun vm-menu-popup-attachment-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-attachment-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-attachment-menu)))) + +(defvar vm-menu-fsfemacs-image-menu) +(defun vm-menu-popup-image-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-image-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-image-menu)))) + +;; to quiet the byte-compiler +(defvar vm-menu-fsfemacs-mail-menu) +(defvar vm-menu-fsfemacs-dispose-popup-menu) +(defvar vm-menu-fsfemacs-vm-menu) + +(defun vm-menu-popup-fsfemacs-menu (event &optional menu) + (interactive "e") + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (let ((map (or menu mode-popup-menu)) + key command func) + (setq key (x-popup-menu event map) + key (apply 'vector key) + command (lookup-key map key) + func (and (symbolp command) (symbol-function command))) + (cond ((null func) (setq this-command last-command)) + ((symbolp func) + (setq this-command func) + (call-interactively this-command)) + (t + (call-interactively command))))) + +(defun vm-menu-mode-menu () + (if (vm-menu-xemacs-menus-p) + (cond ((eq major-mode 'mail-mode) + vm-menu-mail-menu) + ((memq major-mode '(vm-mode vm-presentation-mode + vm-summary-mode vm-virtual-mode)) + vm-menu-dispose-menu) + (t vm-menu-vm-menu)) + (cond ((eq major-mode 'mail-mode) + vm-menu-fsfemacs-mail-menu) + ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode)) + vm-menu-fsfemacs-dispose-popup-menu) + (t vm-menu-fsfemacs-vm-menu)))) + +(defun vm-menu-set-menubar-dirty-flag () + (cond ((vm-menu-xemacs-menus-p) + (set-menubar-dirty-flag)) + ((vm-menu-fsfemacs-menus-p) + ;; force-mode-line-update seems to have been buggy in Emacs + ;; 21, 22, and 23. So we do it ourselves. USR, 2011-02-26 + ;; (force-mode-line-update t) + (set-buffer-modified-p (buffer-modified-p)) + (when (and vm-user-interaction-buffer + (buffer-live-p vm-user-interaction-buffer)) + (with-current-buffer vm-user-interaction-buffer + (set-buffer-modified-p (buffer-modified-p))))))) + +(defun vm-menu-fsfemacs-add-vm-menu () + "Add a menu or a menubar button to the Emacs menubar for switching +to a VM menubar." + (if (and (vm-menubar-buttons-possible-p) vm-use-menubar-buttons) + (define-key vm-mode-map [menu-bar vm] + '(menu-item "[VM Menubar]" vm-menu-toggle-menubar)) + (define-key vm-mode-map [menu-bar vm] + (cons "Menubar" (make-sparse-keymap "VM"))) + (define-key vm-mode-map [menu-bar vm vm-toggle] + '(menu-item "Switch to VM Menubar" vm-menu-toggle-menubar)))) + +(defun vm-menu-toggle-menubar (&optional buffer) + "Toggle between the VM's dedicated menu bar and the standard Emacs +menu bar. USR, 2011-02-27" + (interactive) + (if buffer + (set-buffer buffer) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p))) + (cond ((vm-menu-xemacs-menus-p) + (if (null (car (find-menu-item current-menubar '("[Emacs Menubar]")))) + (set-buffer-menubar vm-menu-vm-menubar) + ;; copy the current menubar in case it has been changed. + (make-local-variable 'vm-menu-vm-menubar) + (setq vm-menu-vm-menubar (copy-sequence current-menubar)) + (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar))) + (condition-case nil + (add-menu-button nil vm-menu-vm-button nil) + (void-function + (add-menu-item nil "Menubar" 'vm-menu-toggle-menubar t)))) + (vm-menu-set-menubar-dirty-flag) + (vm-check-for-killed-summary) + (and vm-summary-buffer + (save-excursion + (vm-menu-toggle-menubar vm-summary-buffer))) + (vm-check-for-killed-presentation) + (and vm-presentation-buffer-handle + (save-excursion + (vm-menu-toggle-menubar vm-presentation-buffer-handle)))) + ((vm-menu-fsfemacs-menus-p) + (if (not (eq (lookup-key vm-mode-map [menu-bar]) + (lookup-key vm-mode-menu-map [rootmenu vm]))) + (define-key vm-mode-map [menu-bar] + (lookup-key vm-mode-menu-map [rootmenu vm])) + (define-key vm-mode-map [menu-bar] + (make-sparse-keymap "Menu")) + (vm-menu-fsfemacs-add-vm-menu)) + (vm-menu-set-menubar-dirty-flag)))) + +(defun vm-menu-install-menubar () + "Install the dedicated menu bar of VM. USR, 2011-02-27" + (cond ((vm-menu-xemacs-menus-p) + (setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar)) + (set-buffer-menubar vm-menu-vm-menubar) + (run-hooks 'vm-menu-setup-hook) + (setq vm-menu-vm-menubar current-menubar)) + ((and (vm-menu-fsfemacs-menus-p) + ;; menus only need to be installed once for FSF Emacs + (not (fboundp 'vm-menu-undo-menu))) + (vm-menu-initialize-vm-mode-menu-map) + (define-key vm-mode-map [menu-bar] + (lookup-key vm-mode-menu-map [rootmenu vm]))))) + +(defun vm-menu-install-menubar-item () + "Install VM's menu on the current - presumably the standard - menu +bar. USR, 2011-02-27" + (cond ((and (vm-menu-xemacs-menus-p) (vm-menu-xemacs-global-menubar)) + (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar))) + (add-menu nil "VM" (cdr vm-menu-vm-menu))) + ((and (vm-menu-fsfemacs-menus-p) + ;; menus only need to be installed once for FSF Emacs + (not (fboundp 'vm-menu-undo-menu))) + (vm-menu-initialize-vm-mode-menu-map) + (define-key vm-mode-map [menu-bar] + (lookup-key vm-mode-menu-map [rootmenu]))))) + +(defun vm-menu-install-vm-mode-menu () + "This function strangely does nothing! USR, 2011-02-27." + ;; nothing to do here. + ;; handled in vm-mouse.el + (cond ((vm-menu-xemacs-menus-p) + t ) + ((vm-menu-fsfemacs-menus-p) + t ))) + +(defun vm-menu-install-mail-mode-menu () + (cond ((vm-menu-xemacs-menus-p) + ;; mail-mode doesn't have mode-popup-menu bound to + ;; mouse-3 by default. fix that. + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map 'button3 'popup-mode-menu)) + ;; put menu on menubar also. + (if (vm-menu-xemacs-global-menubar) + (progn + (set-buffer-menubar + (copy-sequence (vm-menu-xemacs-global-menubar))) + (add-menu nil "Mail" (cdr vm-menu-mail-menu)))) + t ) + ((vm-menu-fsfemacs-menus-p) + ;; I'd like to do this, but the result is a combination + ;; of the Emacs and VM Mail menus glued together. + ;; Poorly. + ;;(define-key vm-mail-mode-map [menu-bar mail] + ;; (cons "Mail" vm-menu-fsfemacs-mail-menu)) + (defvar mail-mode-map) + (define-key mail-mode-map [menu-bar mail] + (cons "Mail" vm-menu-fsfemacs-mail-menu)) + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map [down-mouse-3] + 'vm-menu-popup-context-menu))))) + +(defun vm-menu-install-menus () + "Install VM menus, either in the current menu bar or in a +separate dedicated menu bar, depending on the value of +`vm-use-menus'. USR, 2011-02-27" + (cond ((consp vm-use-menus) + (vm-menu-install-vm-mode-menu) + (vm-menu-install-menubar) + (vm-menu-install-known-virtual-folders-menu)) + ((eq vm-use-menus 1) + (vm-menu-install-vm-mode-menu) + (vm-menu-install-menubar-item) + (vm-menu-install-known-virtual-folders-menu)) + (t nil))) + +(defun vm-menu-install-known-virtual-folders-menu () + (let ((folders (sort (mapcar 'car vm-virtual-folder-alist) + (function string-lessp))) + (menu nil) + tail + ;; special string indicating tail of Virtual menu + (special "-------")) + (while folders + (setq menu (cons (vector " " + (list 'vm-menu-run-command + ''vm-visit-virtual-folder (car folders)) + :suffix (car folders)) + menu) + folders (cdr folders))) + (and menu (setq menu (nreverse menu) + menu (nconc (list "Visit:" "---") menu))) + (setq tail (vm-member special vm-menu-virtual-menu)) + (if (and menu tail) + (progn + (setcdr tail menu) + (vm-menu-set-menubar-dirty-flag) + (cond ((vm-menu-fsfemacs-menus-p) + (makunbound 'vm-menu-fsfemacs-virtual-menu) + (easy-menu-define vm-menu-fsfemacs-virtual-menu + (list (make-sparse-keymap)) + nil + vm-menu-virtual-menu) + (define-key vm-mode-menu-map [rootmenu vm vm-menubar-virtual] + (cons "Virtual" vm-menu-fsfemacs-virtual-menu)))))))) + +(defun vm-menu-install-visited-folders-menu () + (let ((folders (vm-delete-duplicates (copy-sequence vm-folder-history))) + (menu nil) + tail foo + spool-files + (i 0) + ;; special string indicating tail of Folder menu + (special "-------")) + (while (and folders (< i 10)) + (setq menu (cons + (vector " " + (cond + ((and (vm-pop-folder-spec-p (car folders)) + (setq foo (vm-pop-find-name-for-spec + (car folders)))) + (list 'vm-menu-run-command + ''vm-visit-pop-folder foo)) + ((and (vm-imap-folder-spec-p (car folders)) + (setq foo (vm-imap-folder-for-spec + (car folders)))) + (list 'vm-menu-run-command + 'vm'visit-imap-folder foo)) + (t + (list 'vm-menu-run-command + ''vm-visit-folder (car folders)))) + :suffix (car folders)) + menu) + folders (cdr folders) + i (1+ i))) + (and menu (setq menu (nreverse menu) + menu (nconc (list "Visit:" "---") menu))) + (setq spool-files (vm-spool-files) + folders (cond ((and (consp spool-files) + (consp (car spool-files))) + (mapcar (function car) spool-files)) + ((and (consp spool-files) + (stringp (car spool-files)) + (stringp vm-primary-inbox)) + (list vm-primary-inbox)) + (t nil))) + (if (and menu folders) + (nconc menu (list "---" "---"))) + (while folders + (setq menu (nconc menu + (list (vector " " + (list 'vm-menu-run-command + ''vm-visit-folder (car folders)) + :suffix (car folders)))) + folders (cdr folders))) + (setq tail (vm-member special vm-menu-folder-menu)) + (if (and menu tail) + (progn + (setcdr tail menu) + (vm-menu-set-menubar-dirty-flag) + (cond ((vm-menu-fsfemacs-menus-p) + (makunbound 'vm-menu-fsfemacs-folder-menu) + (easy-menu-define vm-menu-fsfemacs-folder-menu + (list (make-sparse-keymap)) + nil + vm-menu-folder-menu) + (define-key vm-mode-menu-map [rootmenu vm vm-menubar-folder] + (cons "Folder" vm-menu-fsfemacs-folder-menu)))))))) + +(defun vm-customize () + "Customize VM options." + (interactive) + (customize-group 'vm)) + +(defun vm-view-news () + "View NEWS for the current VM version." + (interactive) + (let* ((vm-dir (file-name-directory (locate-library "vm"))) + (doc-dirs (list (and vm-configure-docdir + (expand-file-name vm-configure-docdir)) + (and vm-configure-datadir + (expand-file-name vm-configure-datadir)) + (concat vm-dir "../"))) + doc-dir) + (while doc-dirs + (setq doc-dir (car doc-dirs)) + (if (and doc-dir + (file-exists-p (expand-file-name "NEWS" doc-dir))) + (setq doc-dirs nil) + (setq doc-dirs (cdr doc-dirs)))) + (view-file-other-frame (expand-file-name "NEWS" doc-dir)))) + +(defun vm-view-manual () + "View the VM manual." + (interactive) + (info "VM")) + + +;;; Muenkel Folders menu code + +(defvar vm-menu-hm-no-hidden-dirs t + "*Hidden directories are suppressed in the folder menus, if non nil.") + +(defconst vm-menu-hm-hidden-file-list '("^\\..*" ".*\\.~[0-9]+~")) + +(defun vm-menu-hm-delete-folder (folder) + "Query deletes a folder." + (interactive "fDelete folder: ") + (if (file-exists-p folder) + (if (y-or-n-p (concat "Delete the folder " folder " ? ")) + (progn + (if (file-directory-p folder) + (delete-directory folder) + (delete-file folder)) + (vm-inform 5 "Folder deleted.") + (vm-menu-hm-make-folder-menu) + (vm-menu-hm-install-menu) + ) + (vm-inform 0 "Aborted")) + (error "Folder %s does not exist." folder) + (vm-menu-hm-make-folder-menu) + (vm-menu-hm-install-menu) + )) + + +(defun vm-menu-hm-rename-folder (folder) + "Rename a folder." + (interactive "fRename folder: ") + (if (file-exists-p folder) + (rename-file folder + (read-file-name (concat "Rename " + folder + " to ") + (directory-file-name folder) + folder)) + (error "Folder %s does not exist." folder)) + (vm-menu-hm-make-folder-menu) + (vm-menu-hm-install-menu) + ) + + +(defun vm-menu-hm-create-dir (parent-dir) + "Create a subdir in PARENT-DIR." + (interactive "DCreate new directory in: ") + (setq parent-dir (or parent-dir vm-folder-directory)) + (make-directory + (expand-file-name (read-file-name + (format "Create directory in %s called: " + parent-dir) + parent-dir) + vm-folder-directory) + t) + (vm-menu-hm-make-folder-menu) + (vm-menu-hm-install-menu) + ) + + +(defun vm-menu-hm-make-folder-menu () + "Makes a menu with the mail folders of the directory `vm-folder-directory'." + (interactive) + (vm-inform 5 "Building folders menu...") + (let ((folder-list (vm-menu-hm-tree-make-file-list vm-folder-directory)) + (inbox-list (if (listp (car vm-spool-files)) + (mapcar 'car vm-spool-files) + (list vm-primary-inbox)))) + (setq vm-menu-folders-menu + (cons "Manipulate Folders" + (list (cons "Visit Inboxes " + (vm-menu-hm-tree-make-menu + inbox-list + 'vm-visit-folder + t)) + (cons "Visit Folder " + (vm-menu-hm-tree-make-menu + folder-list + 'vm-visit-folder + t + vm-menu-hm-no-hidden-dirs + vm-menu-hm-hidden-file-list)) + (cons "Save Message " + (vm-menu-hm-tree-make-menu + folder-list + 'vm-save-message + t + vm-menu-hm-no-hidden-dirs + vm-menu-hm-hidden-file-list)) + "----" + (cons "Delete Folder " + (vm-menu-hm-tree-make-menu + folder-list + 'vm-menu-hm-delete-folder + t + nil + nil + t + )) + (cons "Rename Folder " + (vm-menu-hm-tree-make-menu + folder-list + 'vm-menu-hm-rename-folder + t + nil + nil + t + )) + (cons "Make New Directory in..." + (vm-menu-hm-tree-make-menu + (cons (list vm-folder-directory) folder-list) + 'vm-menu-hm-create-dir + t + nil + '(".*") + t + )) + "----" + ["Rebuild Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory] + )))) + (vm-inform 5 "Building folders menu... done") + (vm-menu-hm-install-menu)) + +(defun vm-menu-hm-install-menu () + (cond ((vm-menu-xemacs-menus-p) + (cond ((car (find-menu-item current-menubar '("VM"))) + (add-menu '("VM") "Folders" + (cdr vm-menu-folders-menu) "Motion")) + ((car (find-menu-item current-menubar + '("Folder" "Manipulate Folders"))) + (add-menu '("Folder") "Manipulate Folders" + (cdr vm-menu-folders-menu) "Motion")))) + ((vm-menu-fsfemacs-menus-p) + (easy-menu-define vm-menu-fsfemacs-folders-menu + (list (make-sparse-keymap)) + nil + vm-menu-folders-menu) + (define-key vm-mode-menu-map [rootmenu vm folder folders] + (cons "Manipulate Folders" vm-menu-fsfemacs-folders-menu))))) + + +;;; Muenkel tree-menu code + +(defconst vm-menu-hm-tree-ls-flags "-aFLR" + "*A String with the flags used in the function +vm-menu-hm-tree-ls-in-temp-buffer for the ls command. +Be careful if you want to change this variable. +The ls command must append a / on all files which are directories. +The original flags are -aFLR.") + + +(defun vm-menu-hm-tree-ls-in-temp-buffer (dir temp-buffer) +"List the directory DIR in the TEMP-BUFFER." + (switch-to-buffer temp-buffer) + (erase-buffer) + (let ((process-connection-type nil)) + (call-process "ls" nil temp-buffer nil vm-menu-hm-tree-ls-flags dir)) + (goto-char (point-min)) + (while (search-forward "//" nil t) + (replace-match "/")) + (goto-char (point-min)) + (while (re-search-forward "\\.\\.?/\n" nil t) + (replace-match "")) + (goto-char (point-min))) + + +(defconst vm-menu-hm-tree-temp-buffername "*tree*" + "Name of the temp buffers in tree.") + + +(defun vm-menu-hm-tree-make-file-list-1 (root list) + (let ((filename (buffer-substring (point) (progn + (end-of-line) + (point))))) + (while (not (string= filename "")) + (setq + list + (append + list + (list + (cond ((char-equal (char-after (- (point) 1)) ?/) + ;; Directory + (setq filename (substring filename 0 (1- (length filename)))) + (save-excursion + (search-forward (concat root filename ":")) + (forward-line) + (vm-menu-hm-tree-make-file-list-1 (concat root filename "/") + (list (vm-menu-hm-tree-menu-file-truename + filename + root))))) + ((char-equal (char-after (- (point) 1)) ?*) + ;; Executable + (setq filename (substring filename 0 (1- (length filename)))) + (vm-menu-hm-tree-menu-file-truename filename root)) + (t (vm-menu-hm-tree-menu-file-truename filename root)))))) + (forward-line) + (setq filename (buffer-substring (point) (progn + (end-of-line) + (point))))) + list)) + + +(defun vm-menu-hm-tree-menu-file-truename (file &optional root) + (file-truename (expand-file-name file root))) + +(defun vm-menu-hm-tree-make-file-list (dir) + "Makes a list with the files and subdirectories of DIR. +The list looks like: ((dirname1 file1 file2) + file3 + (dirname2 (dirname3 file4 file5) file6))" + (save-window-excursion + (setq dir (expand-file-name dir)) + (if (not (string= (substring dir -1) "/")) + (setq dir (concat dir "/"))) +;; (while (string-match "/$" dir) +;; (setq dir (substring dir 0 -1))) + (vm-menu-hm-tree-ls-in-temp-buffer dir + (generate-new-buffer-name + vm-menu-hm-tree-temp-buffername)) + (let ((list nil)) + (setq list (vm-menu-hm-tree-make-file-list-1 dir nil)) + (kill-buffer (current-buffer)) + list))) + + +(defun vm-menu-hm-tree-hide-file-p (filename re-hidden-file-list) + "t, if one of the regexps in RE-HIDDEN-FILE-LIST matches the FILENAME." + (cond ((not re-hidden-file-list) nil) + ((string-match (car re-hidden-file-list) + (vm-menu-hm-tree-menu-file-truename filename))) + (t (vm-menu-hm-tree-hide-file-p filename (cdr re-hidden-file-list))))) + + +(defun vm-menu-hm-tree-make-menu (dirlist + function + selectable + &optional + no-hidden-dirs + re-hidden-file-list + include-current-dir) + "Returns a menu list. +Each item of the menu list has the form + [\"subdir\" (FUNCTION \"dir\") SELECTABLE]. +Hidden directories (with a leading point) are suppressed, +if NO-HIDDEN-DIRS are non nil. Also all files which are +matching a regexp in RE-HIDDEN-FILE-LIST are suppressed. +If INCLUDE-CURRENT-DIR non nil, then an additional command +for the current directory (.) is inserted." + (let ((subdir nil) + (menulist nil)) + (while (setq subdir (car dirlist)) + (setq dirlist (cdr dirlist)) + (cond ((and (stringp subdir) + (not (vm-menu-hm-tree-hide-file-p subdir re-hidden-file-list))) + (setq menulist + (append menulist + (list + (vector (file-name-nondirectory subdir) + (list function subdir) + selectable))))) + ((and (listp subdir) + (or (not no-hidden-dirs) + (not (char-equal + ?. + (string-to-char + (file-name-nondirectory (car subdir)))))) + (setq menulist + (append + menulist + (list + (cons (file-name-nondirectory (car subdir)) + (if include-current-dir + (cons + (vector "." + (list function + (car subdir)) + selectable) + (vm-menu-hm-tree-make-menu (cdr subdir) + function + selectable + no-hidden-dirs + re-hidden-file-list + include-current-dir + )) + (vm-menu-hm-tree-make-menu (cdr subdir) + function + selectable + no-hidden-dirs + re-hidden-file-list + )))))))) + (t nil)) + ) + menulist + ) + ) + +;;; vm-menu.el ends here diff --git a/lisp/vm-message-history.el b/lisp/vm-message-history.el new file mode 100755 index 0000000..aa8526f --- /dev/null +++ b/lisp/vm-message-history.el @@ -0,0 +1,248 @@ +;;; vm-message-history.el --- Move backward & forward through selected messages +;; -*-unibyte: t; coding: iso-8859-1;-*- +;; +;; This file is an add-on for VM + +;; Copyright © 2003 Kevin Rodgers, 2008 Robert Widhopf-Fenk + +;; Author: Kevin Rodgers <ihs_4664@yahoo.com> +;; Created: 6 Oct 2003 +;; Keywords: mail, history + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2 of +;; the License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be +;; useful, but WITHOUT ANY WARRANTY; without even the implied +;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. See the GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public +;; License along with this program; if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, +;; MA 02111-1307 USA + +;;; Commentary: + +;; VM defines the `vm-goto-message-last-seen' command (bound to TAB) to +;; toggle between 2 messages, but doesn't provide a general history +;; mechanism. This library allows the user to move backward and forward +;; through the messages that have already been selected in each folder. +;; It mimics a web browser in that selecting a message causes more +;; recently selected messages in the history list to be forgotten +;; (except when using `vm-goto-message-last-seen' or one of the +;; vm-message-history.el commands). + +;;; Usage: +;; +;; Add the follwoing line to your ~/.vm +;; +;; (require 'vm-message-history) +;; +;; Visit a folder, move around and the use the key bindings or menu items for +;; the moving and browsing the history. +;; C-c p, Motion -> Backward in History +;; C-c n, Motion -> Forward in History +;; C-c b, Motion -> Browse History + +;;; TODO: Handle Expunged messages in the history list? + +;;; Code: + +(provide 'vm-message-history) + +(eval-and-compile + (require 'easymenu) + (require 'vm-menu) + (require 'vm-misc) + (require 'vm-summary) + (require 'vm-page) + (require 'vm-window) + (require 'vm-motion) +) + +(defgroup vm-message-history nil + "Message history for VM folders." + :group 'vm-ext) + +(defcustom vm-message-history-max 32 + "The number of read or previewed messages in each folder's history." + :type 'integer + :group 'vm-message-history) + +(defvar vm-message-history nil + "A list of messages in the current folder.") + +(make-variable-buffer-local 'vm-message-history) + +(defvar vm-message-history-pointer nil + "The cons in `vm-message-history' whose car is the current message.") + +(make-variable-buffer-local 'vm-message-history-pointer) + +(define-key vm-mode-map "\C-cp" 'vm-message-history-backward) +(define-key vm-mode-map "\C-cn" 'vm-message-history-forward) +(define-key vm-mode-map "\C-cb" 'vm-message-history-browse) + +(setq vm-menu-motion-menu + (append vm-menu-motion-menu + '(["Backward in History" vm-message-history-backward t] + ["Forward in History" vm-message-history-forward t] + ["Browse History" vm-message-history-browse + :active (save-excursion + (vm-select-folder-buffer) + vm-message-history)]))) + +;;;###autoload +(defun vm-message-history-add () + "Add the selected message to `vm-message-history'. +\(Unless the message was selected via \\[vm-message-history-backward] or +\\[vm-message-history-forward].)" + (when (not (memq this-command '(vm-goto-message-last-seen + vm-message-history-backward + vm-message-history-forward + vm-message-history-browse-select))) + ;; remove message if it was there already + (when (memq (car vm-message-pointer) vm-message-history) + (setq vm-message-history (delq (car vm-message-pointer) + vm-message-history) + vm-message-history-pointer vm-message-history)) + ;; add new message to head + (setq vm-message-history-pointer + ;; Discard messages selected after the current message: + (setq vm-message-history + (cons (car vm-message-pointer) + vm-message-history-pointer))) + ;; Discard oldest messages: + (setcdr (or (nthcdr (1- vm-message-history-max) vm-message-history) + '(t)) ; hack! + nil))) + +;;;###autoload +(defun vm-message-history-backward (&optional arg) + "Select the previous message in the current folder's history. +With prefix ARG, select the ARG'th previous message." + (interactive "p") + (or arg (setq arg 1)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (or vm-message-history + (error "No message history")) + (cond ((> arg 0) + (setq vm-message-history-pointer + (or (nthcdr arg vm-message-history-pointer) + ;; wrap around to newest message: + vm-message-history))) + ((< arg 0) + (let ((pointer vm-message-history)) + (while (and pointer + (not (eq (nthcdr (- arg) pointer) + vm-message-history-pointer))) + (setq pointer (cdr pointer))) + (setq vm-message-history-pointer + (or pointer + ;; wrap around to oldest message: + (if (fboundp 'last) + (last vm-message-history) ; Emacs 21, or cl.el + (progn + (setq pointer vm-message-history) + (while (consp (cdr pointer)) + (setq pointer (cdr pointer))) + pointer))))))) + (if (eq (car vm-message-pointer) (car vm-message-history-pointer)) + (vm-present-current-message) + (vm-record-and-change-message-pointer + vm-message-pointer + (vm-message-position (car vm-message-history-pointer))) + (vm-present-current-message)) + (vm-message-history-browse)) + +;;;###autoload +(defun vm-message-history-forward (&optional arg) + "Select the next message in the current folder's history. +With prefix ARG, select the ARG'th next message." + (interactive "p") + (vm-message-history-backward (- arg))) + +(defvar vm-message-history-menu nil + "A popup menu of messages, generated from `vm-message-history'.") + +(defun vm-message-history-browse-select () + "Select the message below the cursor." + (interactive) + (let ((mp (get-text-property (point) 'vm-message-pointer))) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-record-and-change-message-pointer vm-message-pointer mp) + (vm-present-current-message) + (vm-display nil nil '(vm-goto-message-last-seen) + '(vm-goto-message-last-seen)) + (vm-message-history-browse))) + +(defvar vm-message-history-browse-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'vm-message-history-browse-select) + (define-key map "=" 'vm-summarize) + (define-key map "q" 'bury-buffer) + (define-key map "p" 'vm-message-history-backward) + (define-key map "n" 'vm-message-history-forward) + map)) + +;;;###autoload +(defun vm-message-history-browse () + "Select a message from a popup menu of the current folder's history." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (or vm-message-history + (error "No message history")) + (let ((history vm-message-history) + (folder (current-buffer)) + (selected-message (car vm-message-pointer)) + (buf (get-buffer-create (concat (buffer-name) " Message History"))) + mp) + ;; replace summary window if possible + (let ((window (get-buffer-window vm-summary-buffer))) + (if window (select-window window))) + ;; or existing one + (let ((window (get-buffer-window buf))) + (if window (select-window window))) + ;; now switch to new buffer and set it up + (switch-to-buffer buf) + (let ((buffer-read-only nil)) + (erase-buffer)) + (abbrev-mode 0) + (auto-fill-mode 0) + (vm-fsfemacs-nonmule-display-8bit-chars) + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (setq vm-mail-buffer folder + mode-name "VM Message History" + major-mode 'vm-message-history-mode + mode-line-format vm-mode-line-format + buffer-read-only t + truncate-lines t) + (use-local-map vm-message-history-browse-mode-map) + ;; fill in the entries for each item + (let ((buffer-read-only nil) + (selected (point-min)) + start) + (while history + (setq mp (car history) start (point)) + (if (not (eq mp selected-message)) + (insert vm-summary-no-=>) + (setq selected (point)) + (insert vm-summary-=>)) + (vm-tokenized-summary-insert mp (vm-su-summary mp)) + (set-text-properties start (point) + (list 'vm-message-pointer history)) + (setq history (cdr history))) + ;; jump to selected message or last. + (goto-char selected)))) + +(add-hook 'vm-select-message-hook 'vm-message-history-add) + +;;; vm-message-history.el ends here diff --git a/lisp/vm-message.el b/lisp/vm-message.el new file mode 100755 index 0000000..143154d --- /dev/null +++ b/lisp/vm-message.el @@ -0,0 +1,613 @@ +;;; vm-message.el --- Macros and functions dealing with accessing VM +;; message struct fields +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-message) + +(declare-function vm-mime-encode-words-in-string "vm-mime" (string)) +(declare-function vm-reencode-mime-encoded-words-in-string + "vm-mime" (string)) +(declare-function vm-reencode-mime-encoded-words-in-tokenized-summary + "vm-mime" (summary)) +(declare-function vm-mark-for-summary-update + "vm-folder" (m &optional dont-kill-cache)) +(declare-function vm-stuff-virtual-message-data + "vm-folder" (message)) +(declare-function vm-reorder-message-headers + "vm-folder" (message &optional keep-list discard-regexp)) +(declare-function vm-mark-folder-modified-p + "vm-folder" (buffer)) +(declare-function vm-clear-modification-flag-undos + "vm-undo" ()) +(declare-function vm-build-threads + "vm-undo" (message-list)) +(declare-function vm-unthread-message + "vm-thread" (message &key message-changing)) +(declare-function vm-present-current-message + "vm-page" ()) +(declare-function vm-zip-vectors "vm-misc" (v1 v2)) +(declare-function vm-zip-lists "vm-misc.el" (list1 list2) t) + + +;; current message +(defsubst vm-current-message () + "Returns the currently selected message in the VM folder. It +works in all VM buffers." + (with-current-buffer (or vm-mail-buffer (current-buffer)) + (car vm-message-pointer))) + +;; message struct +(defconst vm-location-data-vector-length 6) +(defconst vm-message-fields + [:location-data :softdata :attributes :cached-data :mirror-data]) +(defsubst vm-location-data-of (message) (aref message 0)) +(defsubst vm-softdata-of (message) (aref message 1)) +(defsubst vm-attributes-of (message) (aref message 2)) +(defsubst vm-cached-data-of (message) (aref message 3)) +(defsubst vm-mirror-data-of (message) (aref message 4)) +(defsubst vm-set-location-data-of (message vdata) (aset message 0 vdata)) +(defsubst vm-set-softdata-of (message data) (aset message 1 data)) +(defsubst vm-set-attributes-of (message attrs) (aset message 2 attrs)) +(defsubst vm-set-cached-data-of (message cache) (aset message 3 cache)) +(defsubst vm-set-mirror-data-of (message data) (aset message 4 data)) + +;; data that is always shared with virtual folders +(defconst vm-location-data-fields + [:start :headers :vheaders :text :text-end :end]) +;; where message begins starting at the message separator in the folder +(defsubst vm-start-of (message) + (aref (aref message 0) 0)) +;; where headers start (From_ line) +(defsubst vm-headers-of (message) + (aref (aref message 0) 1)) +;; where visible headers start +(defun vm-vheaders-of (message) + (or (aref (aref message 0) 2) + (progn (vm-reorder-message-headers message) + (aref (aref message 0) 2)))) +;; where text section starts +(defsubst vm-text-of (message) + (or (aref (aref message 0) 3) + (progn (vm-find-and-set-text-of message) + (aref (aref message 0) 3)))) +;; where text portion of message ends +(defsubst vm-text-end-of (message) + (aref (aref message 0) 4)) +;; where message ends +(defsubst vm-end-of (message) + (aref (aref message 0) 5)) + +;; soft data vector +(defconst vm-softdata-vector-length 23) +(defconst vm-softdata-fields + [:number :padded-number :mark :su-start :su-end :real-message-sym + :reverse-link-sym :message-type :message-id-number :buffer + :thread-indentation :thread-list + :babyl-frob-flag :saved-virtual-attributes + :saved-virtual-mirror-data :virtual-summary + :mime-layout :mime-encoded-header-flag + :su-summary-mouse-track-overlay :message-access-method + :thread-subtree :mirrored-message-sym :thread-indentation-offset]) +(defsubst vm-number-of (message) + (aref (aref message 1) 0)) +(defsubst vm-padded-number-of (message) + (aref (aref message 1) 1)) +(defsubst vm-mark-of (message) + (aref (aref message 1) 2)) +;; start of summary line +(defsubst vm-su-start-of (message) + (aref (aref message 1) 3)) +;; end of summary line +(defsubst vm-su-end-of (message) + (aref (aref message 1) 4)) +;; symbol whose value is the real message. +(defsubst vm-real-message-sym-of (message) + (aref (aref message 1) 5)) +;; real message +(defsubst vm-real-message-of (message) + (symbol-value (aref (aref message 1) 5))) +;; link to previous message in the message list +(defsubst vm-reverse-link-of (message) + (symbol-value (aref (aref message 1) 6))) +;; message type +(defsubst vm-message-type-of (message) + (aref (aref message 1) 7)) +;; number that uniquely identifies each message +;; this is for the set handling stuff +(defsubst vm-message-id-number-of (message) + (aref (aref message 1) 8)) +;; folder buffer of this message +(defsubst vm-buffer-of (message) + (aref (aref message 1) 9)) +;; cache thread indentation value +(defsubst vm-thread-indentation-of (message) + (aref (aref message 1) 10)) +;; list of symbols from vm-thread-obarray that give this message's lineage +(defsubst vm-thread-list-of (message) + (aref (aref message 1) 11)) +;; babyl header frob flag (0 or 1 at beginning of message) +(defsubst vm-babyl-frob-flag-of (message) + (aref (aref message 1) 12)) +;; saved attributes, if message was switched from unmirrored to mirrored +(defsubst vm-saved-virtual-attributes-of (message) + (aref (aref message 1) 13)) +;; saved mirror data, if message was switched from unmirrored to mirrored +(defsubst vm-saved-virtual-mirror-data-of (message) + (aref (aref message 1) 14)) +;; summary for unmirrored virtual message +(defsubst vm-virtual-summary-of (message) + (aref (aref message 1) 15)) +;; MIME layout information; types, ids, positions, etc. of all MIME entities +(defsubst vm-mime-layout-of (message) + (aref (aref message 1) 16)) +(defsubst vm-mime-encoded-header-flag-of (message) + (aref (aref message 1) 17)) +(defsubst vm-su-summary-mouse-track-overlay-of (message) + (aref (aref message 1) 18)) +(defsubst vm-message-access-method-of (message) + (aref (aref message 1) 19)) +(defsubst vm-thread-subtree-of (message) + (aref (aref message 1) 20)) +(defsubst vm-mirrored-message-sym-of (message) + (aref (aref message 1) 21)) +(defsubst vm-mirrored-message-of (message) + (symbol-value (aref (aref message 1) 21))) +(defsubst vm-thread-indentation-offset-of (message) + (aref (aref message 1) 22)) + +;; message attribute vector +(defconst vm-attributes-vector-length 16) +(defconst vm-attributes-fields + [:new-flag :unread-flag :deleted-flag :filed-flag :replied-flag + :written-flag :forwarded-flag :edited-flag + :redistributed-flag + :flagged-flag :folded-flag :watched-flag :ignored-flag + :read-receipt-flag :read-receipt-sent-flag :attachments-flag]) +(defsubst vm-new-flag (message) (aref (aref message 2) 0)) +(defsubst vm-unread-flag (message) (aref (aref message 2) 1)) +(defsubst vm-deleted-flag (message) (aref (aref message 2) 2)) +(defsubst vm-filed-flag (message) (aref (aref message 2) 3)) +(defsubst vm-replied-flag (message) (aref (aref message 2) 4)) +(defsubst vm-written-flag (message) (aref (aref message 2) 5)) +(defsubst vm-forwarded-flag (message) (aref (aref message 2) 6)) +(defsubst vm-edited-flag (message) (aref (aref message 2) 7)) +(defsubst vm-redistributed-flag (message) (aref (aref message 2) 8)) +(defsubst vm-flagged-flag (message) (aref (aref message 2) 9)) +(defsubst vm-folded-flag (message) (aref (aref message 2) 10)) +(defsubst vm-watched-flag (message) (aref (aref message 2) 11)) +(defsubst vm-ignored-flag (message) (aref (aref message 2) 12)) +(defsubst vm-read-receipt-flag (message) (aref (aref message 2) 13)) +(defsubst vm-read-receipt-sent-flag (message) (aref (aref message 2) 14)) +(defsubst vm-attachments-flag (message) (aref (aref message 2) 15)) + +;; message cached data +(defconst vm-cached-data-vector-length 26) +(defconst vm-cached-data-fields + [:byte-count :weekday :monthday :month :year :hour :zone + :full-name :from :message-id :line-count :subject + :vheaders-regexp :to :to-names :month-number + :sortable-datestring :sortable-subject + :summary :parent :references + :body-to-be-discarded + :body-to-be-retrieved + :uid :imap-uid-validity :spam-score]) +;; message size in bytes (as a string) +(defsubst vm-byte-count-of (message) (aref (aref message 3) 0)) +;; weekday sent +(defsubst vm-weekday-of (message) (aref (aref message 3) 1)) +;; month day +(defsubst vm-monthday-of (message) (aref (aref message 3) 2)) +;; month sent +(defsubst vm-month-of (message) (aref (aref message 3) 3)) +;; year sent +(defsubst vm-year-of (message) (aref (aref message 3) 4)) +;; hour sent +(defsubst vm-hour-of (message) (aref (aref message 3) 5)) +;; timezone +(defsubst vm-zone-of (message) (aref (aref message 3) 6)) +;; message author's full name (Full-Name: or gouged from From:) +(defsubst vm-full-name-of (message) (aref (aref message 3) 7)) +;; message author address (gouged from From:) +(defsubst vm-from-of (message) (aref (aref message 3) 8)) +;; message ID (Message-Id:) +(defsubst vm-message-id-of (message) (aref (aref message 3) 9)) +;; number of lines in message (as a string) +(defsubst vm-line-count-of (message) (aref (aref message 3) 10)) +;; message subject (Subject:) +(defsubst vm-subject-of (message) (aref (aref message 3) 11)) +;; Regexp that can be used to find the start of the already ordered headers. +(defsubst vm-vheaders-regexp-of (message) + (aref (aref message 3) 12)) +;; Addresses of recipients in a comma separated list +(defsubst vm-to-of (message) (aref (aref message 3) 13)) +;; Full names of recipients in a comma separated list. Addresses if +;; full names not available. +(defsubst vm-to-names-of (message) (aref (aref message 3) 14)) +;; numeric month sent +(defsubst vm-month-number-of (message) (aref (aref message 3) 15)) +;; sortable date string (used for easy sorting, naturally) +(defsubst vm-sortable-datestring-of (message) + (aref (aref message 3) 16)) +;; sortable subject, re: garbage removed +(defsubst vm-sortable-subject-of (message) + (aref (aref message 3) 17)) +;; tokenized summary entry +(defsubst vm-summary-of (message) + (aref (aref message 3) 18)) +;; parent of this message, as determined by threading +(defsubst vm-parent-of (message) + (aref (aref message 3) 19)) +;; message IDs parsed from References header +(defsubst vm-references-of (message) + (aref (aref message 3) 20)) +;; have we retrieved the headers of this message? +;; only valid for remote folder access methods +;; USR: changed the name to vm-headers-to-be-retrieved-of because all the +;; VM folders in the world already have nil's written in this field. +;; USR: changed it again to vm-body-to-be-discarded-of to allow for +;; fetched messages to be discarded before save. 2010-06-08 +(defsubst vm-headers-to-be-retrieved-of (message) + nil) +(defsubst vm-body-to-be-discarded-of (message) + (aref (aref message 3) 21)) +;; have we retrieved the body of this message? +;; only valid for remote folder access methods +;; USR: changed the name to vm-body-to-be-retrieved-of because all the +;; VM folders in the world already have nil's written in this field. +(defsubst vm-body-to-be-retrieved-of (message) + (aref (aref message 3) 22)) +(defsubst vm-body-retrieved-of (message) + (null (aref (aref message 3) 22))) +;; pop UIDL value for message +(defsubst vm-pop-uidl-of (message) + (aref (aref message 3) 23)) +;; imap UID value for message (shares same slot as pop-uidl-of) +(defsubst vm-imap-uid-of (message) + (aref (aref message 3) 23)) +;; imap UIDVALIDITY value for message +(defsubst vm-imap-uid-validity-of (message) + (aref (aref message 3) 24)) +(defsubst vm-spam-score-of (message) + (aref (aref message 3) 25)) + +;; extra data shared by virtual messages if vm-virtual-mirror is non-nil +(defconst vm-mirror-data-vector-length 6) +(defconst vm-mirror-data-fields + [:edit-buffer :virtual-messages-sym :stuff-flag :labels + :label-string :attribute-modflag]) +;; if message is being edited, this is the buffer being used. +(defsubst vm-edit-buffer-of (message) (aref (aref message 4) 0)) +;; list of virtual messages mirroring the underlying real message +(defsubst vm-virtual-messages-of (message) + (symbol-value (aref (aref message 4) 1))) +;; nil if all attribute changes have been stuffed into the folder buffer +(defsubst vm-stuff-flag-of (message) (aref (aref message 4) 2)) +;; list of labels attached to this message +(defsubst vm-labels-of (message) (aref (aref message 4) 3)) +;; comma list of labels +(defsubst vm-label-string-of (message) (aref (aref message 4) 4)) +;; attribute modification flag for this message +;; non-nil if attributes need to be saved +(defsubst vm-attribute-modflag-of (message) (aref (aref message 4) 5)) + +(defsubst vm-set-start-of (message start) + (aset (aref message 0) 0 start)) +(defsubst vm-set-headers-of (message h) + (aset (aref message 0) 1 h)) +(defsubst vm-set-vheaders-of (message vh) + (aset (aref message 0) 2 vh)) +(defsubst vm-set-text-of (message text) + (aset (aref message 0) 3 text)) +(defsubst vm-set-text-end-of (message text) + (aset (aref message 0) 4 text)) +(defsubst vm-set-end-of (message end) + (aset (aref message 0) 5 end)) +(defsubst vm-set-number-of (message n) + (aset (aref message 1) 0 n)) +(defsubst vm-set-padded-number-of (message n) + (aset (aref message 1) 1 n)) +(defsubst vm-set-mark-of (message val) + (aset (aref message 1) 2 val)) +(defsubst vm-set-su-start-of (message pos) + (aset (aref message 1) 3 pos)) +(defsubst vm-set-su-end-of (message pos) + (aset (aref message 1) 4 pos)) +(defsubst vm-set-real-message-sym-of (message sym) + (aset (aref message 1) 5 sym)) +(defsubst vm-set-reverse-link-of (message link) + (set (aref (aref message 1) 6) link)) +(defsubst vm-set-reverse-link-sym-of (message sym) + (aset (aref message 1) 6 sym)) +(defsubst vm-set-message-type-of (message type) + (aset (aref message 1) 7 type)) +(defsubst vm-set-message-id-number-of (message number) + (aset (aref message 1) 8 number)) +(defsubst vm-set-buffer-of (message buffer) + (aset (aref message 1) 9 buffer)) +(defsubst vm-set-thread-indentation-of (message val) + (aset (aref message 1) 10 val)) +(defsubst vm-set-thread-list-of (message list) + (aset (aref message 1) 11 list)) +(defsubst vm-set-babyl-frob-flag-of (message flag) + (aset (aref message 1) 12 flag)) +(defsubst vm-set-saved-virtual-attributes-of (message attrs) + (aset (aref message 1) 13 attrs)) +(defsubst vm-set-saved-virtual-mirror-data-of (message data) + (aset (aref message 1) 14 data)) +(defsubst vm-set-virtual-summary-of (message summ) + (aset (aref message 1) 15 summ)) +(defsubst vm-set-mime-layout-of (message layout) + (aset (aref message 1) 16 layout)) +(defsubst vm-set-mime-encoded-header-flag-of (message flag) + (aset (aref message 1) 17 flag)) +(defsubst vm-set-su-summary-mouse-track-overlay-of (message overlay) + (aset (aref message 1) 18 overlay)) +(defsubst vm-set-message-access-method-of (message method) + (aset (aref message 1) 19 method)) +(defsubst vm-set-thread-subtree-of (message list) + (aset (aref message 1) 20 list)) +(defsubst vm-set-mirrored-message-sym-of (message sym) + (aset (aref message 1) 21 sym)) +(defsubst vm-set-thread-indentation-offset-of (message offset) + (aset (aref message 1) 22 offset)) + +;; The other routines in attributes group are part of the undo system. +(defun vm-set-edited-flag-of (message flag) + (aset (aref message 2) 7 flag) + (vm-mark-for-summary-update message) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-message-data message) + (vm-set-stuff-flag-of message t)) + (unless (buffer-modified-p) + (vm-mark-folder-modified-p (current-buffer))) + (vm-clear-modification-flag-undos)) +(defsubst vm-set-byte-count-of (message count) + (aset (aref message 3) 0 count)) +(defsubst vm-set-weekday-of (message val) + (aset (aref message 3) 1 val)) +(defsubst vm-set-monthday-of (message val) + (aset (aref message 3) 2 val)) +(defsubst vm-set-month-of (message val) + (aset (aref message 3) 3 val)) +(defsubst vm-set-year-of (message val) + (aset (aref message 3) 4 val)) +(defsubst vm-set-hour-of (message val) + (aset (aref message 3) 5 val)) +(defsubst vm-set-zone-of (message val) + (aset (aref message 3) 6 val)) +(defsubst vm-set-full-name-of (message author) + (aset (aref message 3) 7 author)) +(defsubst vm-set-from-of (message author) + (aset (aref message 3) 8 author)) +(defsubst vm-set-message-id-of (message id) + (aset (aref message 3) 9 id)) +(defsubst vm-set-line-count-of (message count) + (aset (aref message 3) 10 count)) +(defsubst vm-set-subject-of (message subject) + (aset (aref message 3) 11 subject)) +(defsubst vm-set-vheaders-regexp-of (message regexp) + (aset (aref message 3) 12 regexp)) +(defsubst vm-set-to-of (message recips) + (aset (aref message 3) 13 recips)) +(defsubst vm-set-to-names-of (message recips) + (aset (aref message 3) 14 recips)) +(defsubst vm-set-month-number-of (message val) + (aset (aref message 3) 15 val)) +(defsubst vm-set-sortable-datestring-of (message val) + (aset (aref message 3) 16 val)) +(defsubst vm-set-sortable-subject-of (message val) + (aset (aref message 3) 17 val)) +(defsubst vm-set-summary-of (message val) + (aset (aref message 3) 18 val)) +(defsubst vm-set-parent-of (message val) + (aset (aref message 3) 19 val)) +(defsubst vm-set-references-of (message val) + (aset (aref message 3) 20 val)) +(defsubst vm-set-headers-to-be-retrieved-of (message val) + nil) +(defsubst vm-set-body-to-be-discarded-of (message val) + (aset (aref message 3) 21 val)) +(defsubst vm-set-body-to-be-retrieved-of (message val) + (aset (aref message 3) 22 val)) +(defsubst vm-set-pop-uidl-of (message val) + (aset (aref message 3) 23 val)) +(defsubst vm-set-imap-uid-of (message val) + (aset (aref message 3) 23 val)) +(defsubst vm-set-imap-uid-validity-of (message val) + (aset (aref message 3) 24 val)) +(defsubst vm-set-spam-score-of (message val) + (aset (aref message 3) 25 val)) +(defsubst vm-set-edit-buffer-of (message buf) + (aset (aref message 4) 0 buf)) +(defsubst vm-set-virtual-messages-of (message list) + (set (aref (aref message 4) 1) list)) +(defsubst vm-set-virtual-messages-sym-of (message sym) + (aset (aref message 4) 1 sym)) +(defsubst vm-set-stuff-flag-of (message val) + (aset (aref message 4) 2 val)) +(defsubst vm-set-labels-of (message labels) + (aset (aref message 4) 3 labels)) +(defsubst vm-set-label-string-of (message string) + (aset (aref message 4) 4 string)) +(defsubst vm-set-attribute-modflag-of (message flag) + (aset (aref message 4) 5 flag)) + +(defun vm-mime-encode-words-in-cache-vector (vector) + (let ((new-vector (make-vector vm-cached-data-vector-length nil))) + ;; Encode the fields of the original cache-vector as necessary. + ;; Some of the fields have been mime-decoded with text properties. + ;; And, some haven't. + ;; This is a mess. + ;; Others probably don't need any mime-encoding, but we encode + ;; them anyway for safety. + + ;; byte-count + (aset new-vector 0 (aref vector 0)) + ;; weekday + (aset new-vector 1 (vm-mime-encode-words-in-string (aref vector 1))) + ;; monthday + (aset new-vector 2 (vm-mime-encode-words-in-string (aref vector 2))) + ;; month + (aset new-vector 3 (vm-mime-encode-words-in-string (aref vector 3))) + ;; year + (aset new-vector 4 (vm-mime-encode-words-in-string (aref vector 4))) + ;; hour + (aset new-vector 5 (vm-mime-encode-words-in-string (aref vector 5))) + ;; zone + (aset new-vector 6 (vm-mime-encode-words-in-string (aref vector 6))) + ;; full-name + (aset new-vector 7 + (vm-reencode-mime-encoded-words-in-string (aref vector 7))) + ;; from + (aset new-vector 8 + (vm-reencode-mime-encoded-words-in-string (aref vector 8))) + ;; message-id + (aset new-vector 9 + (vm-reencode-mime-encoded-words-in-string (aref vector 9))) + ;; line-count + (aset new-vector 10 (vm-mime-encode-words-in-string (aref vector 10))) + ;; subject + (aset new-vector 11 + (vm-reencode-mime-encoded-words-in-string (aref vector 11))) + ;; vheaders-regexp + (aset new-vector 12 (vm-mime-encode-words-in-string (aref vector 12))) + ;; to + (aset new-vector 13 + (vm-reencode-mime-encoded-words-in-string (aref vector 13))) + ;; to-names + (aset new-vector 14 + (vm-reencode-mime-encoded-words-in-string (aref vector 14))) + ;; month-number + (aset new-vector 15 + (vm-mime-encode-words-in-string (aref vector 15))) + ;; sortable-date-string + (aset new-vector 16 + (vm-reencode-mime-encoded-words-in-string (aref vector 16))) + ;; sortable-subject + (aset new-vector 17 + (vm-reencode-mime-encoded-words-in-string (aref vector 17))) + ;; summary + (aset new-vector 18 + (vm-reencode-mime-encoded-words-in-tokenized-summary + (aref vector 18))) + ;; parent + (aset new-vector 19 + (vm-reencode-mime-encoded-words-in-string (aref vector 19))) + ;; references + (aset new-vector 20 + (mapcar (function vm-reencode-mime-encoded-words-in-string) + (aref vector 20))) + ;; body-to-be-discarded (formerly headers-to-be-retrieved) + (aset new-vector 21 (aref vector 21)) + ;; body-to-be-retrieved + (aset new-vector 22 (aref vector 22)) + ;; pop-uidl or imap-uid + (aset new-vector 23 (vm-mime-encode-words-in-string (aref vector 23))) + ;; imap-uid-validity + (aset new-vector 24 (vm-mime-encode-words-in-string (aref vector 24))) + ;; spam-score is a number. nothing to do + + new-vector)) + + +(defun vm-make-message () + "Create a new blank message struct." + (let ((mvec (make-vector 5 nil)) + sym) + (vm-set-softdata-of mvec (make-vector vm-softdata-vector-length nil)) + (vm-set-location-data-of + mvec (make-vector vm-location-data-vector-length nil)) + (vm-set-mirror-data-of + mvec (make-vector vm-mirror-data-vector-length nil)) + (vm-set-message-id-number-of mvec (int-to-string vm-message-id-number)) + (vm-increment vm-message-id-number) + (vm-set-buffer-of mvec (current-buffer)) + ;; We use an uninterned symbol here as a level of indirection + ;; from a purely self-referential structure. This is + ;; necessary so that Emacs debugger can be used on this + ;; program. + (setq sym (make-symbol "<<>>")) + (set sym mvec) + (vm-set-real-message-sym-of mvec sym) + (vm-set-mirrored-message-sym-of mvec sym) + ;; Another uninterned symbol for the virtual messages list. + (setq sym (make-symbol "<v>")) + (set sym nil) + (vm-set-virtual-messages-sym-of mvec sym) + ;; Another uninterned symbol for the reverse link + ;; into the message list. + (setq sym (make-symbol "<--")) + (vm-set-reverse-link-sym-of mvec sym) + mvec )) + +(defun vm-find-and-set-text-of (m) + (save-excursion + (set-buffer (vm-buffer-of m)) + (save-restriction + (widen) + (goto-char (vm-headers-of m)) + (search-forward "\n\n" (vm-text-end-of m) 0) + (vm-set-text-of m (point-marker))))) + +(defsubst vm-virtual-message-p (m) + (not (eq m (vm-real-message-of m)))) + +(defun* vm-update-virtual-messages (m &key message-changing) + "Update all the virtual messages of M to reflect the changes made to +the headers/body of M." + (save-excursion + (mapc (lambda (v-m) + (vm-set-mime-layout-of v-m nil) + (vm-set-mime-encoded-header-flag-of v-m nil) + (vm-set-line-count-of v-m nil) + (when (buffer-name (vm-buffer-of v-m)) + (set-buffer (vm-buffer-of v-m)) + (if (and vm-presentation-buffer + (eq (car vm-message-pointer) v-m)) + (save-excursion (vm-present-current-message))) + (when (vectorp vm-thread-obarray) + ;; this was changed from v-m to m in revision 1148, but it + ;; doesn't make sense. USR, 2011-04-28 + (vm-unthread-message v-m :message-changing message-changing) + (vm-build-threads (list v-m))) + ;; (if vm-summary-show-threads + ;; (intern (buffer-name) buffers-needing-thread-sort)) + )) + (vm-virtual-messages-of m)))) + +(defun vm-pp-message (m) + (pp + (vector + ':location-data + (vm-zip-vectors vm-location-data-fields (vm-location-data-of m)) + ':softdata + (vm-zip-vectors vm-softdata-fields (vm-softdata-of m)) + ':attributes + (vm-zip-vectors vm-attributes-fields (vm-attributes-of m)) + ':cached-data + (vm-zip-vectors vm-cached-data-fields (vm-cached-data-of m)) + ':mirror-data + (vm-zip-vectors vm-mirror-data-fields (vm-mirror-data-of m)))) + nil) + +;;; vm-message.el ends here diff --git a/lisp/vm-mime.el b/lisp/vm-mime.el new file mode 100755 index 0000000..2846b07 --- /dev/null +++ b/lisp/vm-mime.el @@ -0,0 +1,8304 @@ +;;; vm-mime.el --- MIME support functions +;; +;; This file is part of VM +;; +;; Copyright (C) 1997-2003 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-mime) + +(eval-and-compile + (require 'vm-misc)) + +(eval-when-compile + (require 'vm-minibuf) + (require 'vm-toolbar) + (require 'vm-mouse) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-menu) + (require 'vm-crypto) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-reply) + (require 'vm-digest) + (require 'vm-edit) + ) + +;; vm-xemacs.el is a fake file to fool the Emacs 23 compiler +(declare-function get-itimer "vm-xemacs" (name)) +(declare-function start-itimer "vm-xemacs" + (name function value &optional restart is-idle with-args + &rest function-arguments)) +(declare-function set-itimer-restart "vm-xemacs" (itimer restart)) +(declare-function find-coding-system "vm-xemacs" (coding-system-or-name)) +(declare-function latin-unity-representations-feasible-region + "vm-xemacs" (start end)) +(declare-function latin-unity-representations-present-region + "vm-xemacs" (start end)) +(declare-function latin-unity-massage-name "vm-xemacs" (a b)) +(declare-function latin-unity-maybe-remap "vm-xemacs" + (a1 a2 a3 a4 a5 a6)) +(declare-function device-sound-enabled-p "vm-xemacs" (&optional device)) +(declare-function device-bitplanes "vm-xemacs" (&optional device)) +(declare-function font-height "vm-xemacs" (font &optional domain charset)) +(declare-function make-glyph "vm-xemacs" (&optional spec-list type)) +(declare-function set-glyph-baseline "vm-xemacs" + (glyph spec &optional locale tag-set how-to-add)) +(declare-function set-glyph-face "vm-xemacs" (glyph face)) +(declare-function extent-list "vm-xemacs" + (&optional buffer-or-string from to flags property value)) +(declare-function extent-begin-glyph "vm-xemacs" (extent)) +(declare-function set-extent-begin-glyph "vm-xemacs" + (extent begin-glyph &optional layout)) +(declare-function extent-live-p "vm-xemacs" (object)) + +(declare-function vm-mode "vm" (&optional read-only)) + +(defvar enable-multibyte-characters) + +;; The following variables are defined in the code, depending on the +;; Emacs version being used. They should not be initialized here. + +(defvar vm-image-list) +(defvar vm-image-type) +(defvar vm-image-type-name) +(defvar vm-extent-list) +(defvar vm-overlay-list) + + +(defun vm-mime-error (&rest args) + (signal 'vm-mime-error (list (apply 'format args))) + (error "can't return from vm-mime-error")) + +(if (fboundp 'define-error) + (progn + (define-error 'vm-image-too-small "Image too small") + (define-error 'vm-mime-error "MIME error")) + (put 'vm-image-too-small 'error-conditions '(vm-image-too-small error)) + (put 'vm-image-too-small 'error-message "Image too small") + (put 'vm-mime-error 'error-conditions '(vm-mime-error error)) + (put 'vm-mime-error 'error-message "MIME error")) + +(defsubst vm-mime-handler (op type) + (intern (concat "vm-mime-" op "-" type))) + +;; A lot of the more complicated MIME character set processing is only +;; practical under MULE. +(eval-when-compile + (defvar latin-unity-ucs-list) + (defvar latin-unity-character-sets) + (defvar coding-system-list)) + +(defun vm-get-coding-system-priorities () + "Return the value of `vm-coding-system-priorities', or a reasonable +default for it if it's nil. " + (if vm-coding-system-priorities + vm-coding-system-priorities + (let ((res '(iso-8859-1 iso-8859-2 iso-8859-15 iso-8859-16 utf-8))) + (dolist (list-item res) + ;; Assumes iso-8859-1 is always available, which is reasonable. + (unless (vm-coding-system-p list-item) + (delq list-item res))) + res))) + +(defun vm-mime-charset-to-coding (charset) + "Return the Emacs coding system corresonding to the given mime CHARSET." + ;; We can depend on the fact that, in FSF Emacsen, coding systems + ;; have aliases that correspond to MIME charset names. + (let ((tmp nil)) + (cond (vm-fsfemacs-mule-p + (cond ((vm-coding-system-p (setq tmp (intern (downcase charset)))) + tmp) + ((equal charset "us-ascii") + 'raw-text) + ((equal charset "unknown") + 'iso-8859-1) + (t 'undecided))) + (t + ;; What about the case where vm-m-m-c-t-c-a doesn't have an + ;; entry for the given charset? That shouldn't happen, if + ;; vm-mime-mule-coding-to-charset-alist and + ;; vm-mime-mule-charset-to-coding-alist have complete and + ;; matching entries. Admittedly this last is not a + ;; given. Should we make it so on startup? (By setting the + ;; key for any missing entries in + ;; vm-mime-mule-coding-to-charset-alist to being (format + ;; "%s" coding-system), if necessary.) RWF, 2005-03-25 + (setq tmp (vm-string-assoc charset + vm-mime-mule-charset-to-coding-alist)) + (if tmp (cadr tmp) nil)) + ))) + + +(defun vm-get-mime-ucs-list () + "Return the value of `vm-mime-ucs-list', or a reasonable default for it if +it's nil. This is used instead of `vm-mime-ucs-list' directly in order to +allow runtime checks for optional features like `mule-ucs' or +`latin-unity'. " + (if vm-mime-ucs-list + vm-mime-ucs-list + (if (featurep 'latin-unity) + latin-unity-ucs-list + (if (vm-coding-system-p 'utf-8) + '(utf-8 iso-2022-jp ctext escape-quoted) + '(iso-2022-jp ctext escape-quoted))))) + +(defun vm-update-mime-charset-maps () + "Check for the presence of certain Mule coding systems, and add +information about the corresponding MIME character sets to VM's +configuration. " + ;; Add some extra charsets that may not have been defined onto the end + ;; of vm-mime-mule-charset-to-coding-alist. + (mapc (lambda (x) + (and (vm-coding-system-p x) + ;; Not using vm-string-assoc because of some quoting + ;; weirdness it's doing. + (if (not (assoc + (format "%s" x) + vm-mime-mule-charset-to-coding-alist)) + (add-to-list 'vm-mime-mule-charset-to-coding-alist + (list (format "%s" x) x))))) + '(utf-8 iso-8859-15 iso-8859-14 iso-8859-16 + alternativnyj iso-8859-6 iso-8859-7 koi8-c koi8-o koi8-ru koi8-t + koi8-u macintosh windows-1250 windows-1251 windows-1252 + windows-1253 windows-1256)) + + ;; And make sure that the map back from coding-systems is good for + ;; those charsets. + (mapc (lambda (x) + (or (assoc (car (cdr x)) vm-mime-mule-coding-to-charset-alist) + (add-to-list 'vm-mime-mule-coding-to-charset-alist + (list (car (cdr x)) (car x))))) + vm-mime-mule-charset-to-coding-alist) + ;; Whoops, doesn't get picked up for some reason. + (add-to-list 'vm-mime-mule-coding-to-charset-alist + '(iso-8859-1 "iso-8859-1"))) + +(eval-when-compile + (when vm-fsfemacs-p + (defvar latin-unity-character-sets nil))) + +(when vm-xemacs-mule-p + (require 'vm-vars) + (vm-update-mime-charset-maps) + ;; If the user loads Mule-UCS, re-evaluate the MIME charset maps. + (unless (vm-coding-system-p 'utf-8) + (eval-after-load "un-define" `(vm-update-mime-charset-maps))) + ;; Ditto for latin-unity. + (unless (featurep 'latin-unity) + (eval-after-load "latin-unity" `(vm-update-mime-charset-maps)))) + +;;---------------------------------------------------------------------------- +;;; MIME layout structs (vm-mm) +;;---------------------------------------------------------------------------- + +(defconst vm-mime-layout-fields + '[:type :qtype :encoding :id :description :disposition :qdisposition + :header-start :header-end :body-start :body-end + :parts :cache :message-symbol :display-error + :layout-is-converted :unconverted-layout]) + +(defun vm-pp-mime-layout (layout) + (pp (vm-zip-vectors vm-mime-layout-fields layout)) + nil) + +(defun vm-make-layout (&rest plist) + (vector + (plist-get plist 'type) + (plist-get plist 'qtype) + (plist-get plist 'encoding) + (plist-get plist 'id) + (plist-get plist 'description) + (plist-get plist 'disposition) + (plist-get plist 'qdisposition) + (plist-get plist 'header-start) + (plist-get plist 'header-end) + (plist-get plist 'body-start) + (plist-get plist 'body-end) + (plist-get plist 'parts) + (plist-get plist 'cache) + (plist-get plist 'message-symbol) + (plist-get plist 'display-error) + (plist-get plist 'layout-is-converted) + (plist-get plist 'unconverted-layout))) + +(defun vm-mime-copy-layout (from to) + "Copy a MIME layout FROM to the layout TO. The previous contents of +TO are overwritten. USR, 2011-03-27" + (let ((i (1- (length from)))) + (while (>= i 0) + (aset to i (aref from i)) + (setq i (1- i))))) + +(defun vm-mime-layouts-equal (layout1 layout2) + (catch 'return + (if (equal layout1 layout2) + (throw 'return t)) + (vm-mapc + (lambda (i) + (unless (equal (aref layout1 i) (aref layout2 i)) + (throw 'return nil))) + '(0 1 2 3 4 5 6)) ; type through q-disposition + (vm-mapc + (lambda (i) + (unless (equal (marker-position (aref layout1 i)) + (marker-position (aref layout2 i))) + (throw 'return nil))) + '(7 9 10)) ; header-start, body-start, body-end + (vm-mapc + (lambda (part1 part2) + (unless (vm-mime-layouts-equal part1 part2) + (throw 'return nil))) + (vm-mm-layout-parts layout1) + (vm-mm-layout-parts layout2)) + t)) + +(defun vm-mm-layout-type (e) (aref e 0)) +(defun vm-mm-layout-qtype (e) (aref e 1)) +(defun vm-mm-layout-encoding (e) (aref e 2)) +(defun vm-mm-layout-id (e) (aref e 3)) +(defun vm-mm-layout-description (e) (aref e 4)) +(defun vm-mm-layout-disposition (e) (aref e 5)) +(defun vm-mm-layout-qdisposition (e) (aref e 6)) +(defun vm-mm-layout-header-start (e) (aref e 7)) +(defun vm-mm-layout-header-end (e) (aref e 8)) +(defun vm-mm-layout-body-start (e) (aref e 9)) +(defun vm-mm-layout-body-end (e) (aref e 10)) +(defun vm-mm-layout-parts (e) (aref e 11)) +(defun vm-mm-layout-cache (e) (aref e 12)) +(defun vm-mm-layout-message-symbol (e) (aref e 13)) +(defun vm-mm-layout-message (e) + (symbol-value (vm-mm-layout-message-symbol e))) +;; if display of MIME part fails, error string will be here. +(defun vm-mm-layout-display-error (e) (aref e 14)) +(defun vm-mm-layout-is-converted (e) (aref e 15)) +(defun vm-mm-layout-unconverted-layout (e) (aref e 16)) + +(defun vm-set-mm-layout-type (e type) (aset e 0 type)) +(defun vm-set-mm-layout-qtype (e type) (aset e 1 type)) +(defun vm-set-mm-layout-encoding (e encoding) (aset e 2 encoding)) +(defun vm-set-mm-layout-id (e id) (aset e 3 id)) +(defun vm-set-mm-layout-description (e des) (aset e 4 des)) +(defun vm-set-mm-layout-disposition (e d) (aset e 5 d)) +(defun vm-set-mm-layout-qdisposition (e d) (aset e 6 d)) +(defun vm-set-mm-layout-header-start (e start) (aset e 7 start)) +(defun vm-set-mm-layout-header-end (e start) (aset e 8 start)) +(defun vm-set-mm-layout-body-start (e start) (aset e 9 start)) +(defun vm-set-mm-layout-body-end (e end) (aset e 10 end)) +(defun vm-set-mm-layout-parts (e parts) (aset e 11 parts)) +(defun vm-set-mm-layout-cache (e c) (aset e 12 c)) +(defun vm-set-mm-layout-message-symbol (e s) (aset e 13 s)) +(defun vm-set-mm-layout-display-error (e c) (aset e 14 c)) +(defun vm-set-mm-layout-is-converted (e c) (aset e 15 c)) +(defun vm-set-mm-layout-unconverted-layout (e l) (aset e 16 l)) + +(defun vm-mime-type-with-params (type params) + "Returns a string concatenating MIME TYPE (a string) and PARAMS (a +list of strings)." + (if params + (if vm-mime-avoid-folding-content-type + (concat type ";\n\t " (mapconcat 'identity params ";\n\t")) + (concat type "; " (mapconcat 'identity params "; "))) + type)) + +(defun vm-mime-make-message-symbol (m) + (let ((s (make-symbol "<<m>>"))) + (set s m) + s )) + +(defun vm-mime-make-cache-symbol () + (let ((s (make-symbol "<<c>>"))) + (set s s) + s )) + +(defun vm-mm-layout (m) + "Returns the mime layout of message M, either from the cache or by +freshly parsing the message contents." + (or (vm-mime-layout-of m) + (progn (vm-set-mime-layout-of m (vm-mime-parse-entity-safe m)) + (vm-mime-layout-of m)))) + +(defun vm-mm-encoded-header (m) + (or (vm-mime-encoded-header-flag-of m) + (progn (setq m (vm-real-message-of m)) + (vm-set-mime-encoded-header-flag-of + m + (save-excursion + (set-buffer (vm-buffer-of m)) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-headers-of m)) + (let ((case-fold-search t)) + (or (re-search-forward vm-mime-encoded-word-regexp + (vm-text-of m) t) + 'none)))))) + (vm-mime-encoded-header-flag-of m)))) + +;;---------------------------------------------------------------------------- +;;; MIME encoding/decoding +;;---------------------------------------------------------------------------- + +(defun vm-mime-Q-decode-region (start end) + (interactive "r") + (let ((buffer-read-only nil)) + (subst-char-in-region start end ?_ (string-to-char " ") t) + (vm-mime-qp-decode-region start end))) + +(fset 'vm-mime-B-decode-region 'vm-mime-base64-decode-region) + +(defun vm-mime-Q-encode-region (start end) + (let ((buffer-read-only nil) + (val)) + (setq val (vm-mime-qp-encode-region start end t)) ; may modify buffer + (subst-char-in-region start (min end (point-max)) + (string-to-char " ") ?_ t) + val )) + +(defun vm-mime-B-encode-region (start end) + (vm-mime-base64-encode-region start end nil t)) + +(defun vm-mime-base64-decode-string (string) + (vm-with-string-as-temp-buffer + string + (function + (lambda () (vm-mime-base64-decode-region (point-min) (point-max)))))) + +(defun vm-mime-base64-encode-string (string) + (vm-with-string-as-temp-buffer + string + (function + (lambda () (vm-mime-base64-encode-region (point-min) (point-max) + nil t))))) + +(defun vm-mime-crlf-to-lf-region (start end) + (let ((buffer-read-only nil)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (search-forward "\r\n" nil t) + (delete-char -2) + (insert "\n")))))) + +(defun vm-mime-lf-to-crlf-region (start end) + (let ((buffer-read-only nil)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (while (search-forward "\n" nil t) + (delete-char -1) + (insert "\r\n")))))) + +(defun vm-encode-coding-region (b-start b-end coding-system &rest foo) + (let ((work-buffer nil) + start end + oldsize + retval + (b (current-buffer))) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (insert-buffer-substring b b-start b-end) + (setq oldsize (buffer-size)) + (setq retval (apply 'encode-coding-region (point-min) (point-max) + coding-system foo)) + (setq start (point-min) end (point-max)) + (setq retval (buffer-size)) + (save-excursion + (set-buffer b) + (goto-char b-start) + (insert-buffer-substring work-buffer start end) + (delete-region (point) (+ (point) oldsize)) + ;; Fixup the end point. I have found no other way to + ;; let the calling function know where the region ends + ;; after encode-coding-region has scrambled the markers. + (and (markerp b-end) + (set-marker b-end (point))) + retval )) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-decode-coding-region (b-start b-end coding-system &rest foo) + "This is a wrapper for decode-coding-region, having the same effect." + (let ((work-buffer nil) + start end + oldsize + retval + (b (current-buffer))) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (setq oldsize (- b-end b-start)) + (set-buffer work-buffer) + (insert-buffer-substring b b-start b-end) + (setq retval (apply 'decode-coding-region (point-min) (point-max) + coding-system foo)) + (and vm-fsfemacs-p (set-buffer-multibyte t)) ; is this safe? + (setq start (point-min) end (point-max)) + (save-excursion + (set-buffer b) + (goto-char b-start) + (delete-region (point) (+ (point) oldsize)) + (insert-buffer-substring work-buffer start end) + ;; Fixup the end point. I have found no other way to + ;; let the calling function know where the region ends + ;; after decode-coding-region has scrambled the markers. + (and (markerp b-end) + (set-marker b-end (point))) + retval )) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-mime-charset-decode-region (charset start end) + (or (markerp end) (setq end (vm-marker end))) + (cond ((or vm-xemacs-mule-p vm-fsfemacs-mule-p) + (if (or (and vm-xemacs-p (memq (vm-device-type) '(x gtk mswindows))) + vm-fsfemacs-p + (vm-mime-tty-can-display-mime-charset charset) + nil) + (let ((buffer-read-only nil) + (coding (vm-mime-charset-to-coding charset)) + (opoint (point))) + ;; decode 8-bit indeterminate char to correct + ;; char in correct charset. + (vm-decode-coding-region start end coding) + (put-text-property start end 'vm-string t) + (put-text-property start end 'vm-charset charset) + (put-text-property start end 'vm-coding coding) + ;; In XEmacs 20.0 beta93 decode-coding-region moves point. + (goto-char opoint)))) + ((not (vm-multiple-fonts-possible-p)) nil) + ((vm-mime-default-face-charset-p charset) nil) + (t + (let ((font (cdr (vm-string-assoc + charset + vm-mime-charset-font-alist))) + (face (make-face (make-symbol "temp-face"))) + (e (vm-make-extent start end))) + (put-text-property start end 'vm-string t) + (put-text-property start end 'vm-charset charset) + (if font + (condition-case data + (progn (set-face-font face font) + (if vm-fsfemacs-p + (put-text-property start end 'face face) + (vm-set-extent-property e 'duplicable t) + (vm-set-extent-property e 'face face))) + (error nil))))))) + +(defun vm-mime-transfer-decode-region (layout start end) + "Decode the body of a mime part given by LAYOUT at positions START +to END, and replace it by the decoded content. The decoding carried +out includes base-64, quoted-printable, uuencode and CRLF conversion." + (let ((case-fold-search t) (crlf nil)) + (if (or (vm-mime-types-match "text" (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message" (car (vm-mm-layout-type layout)))) + (setq crlf t)) + (cond ((string-match "^base64$" (vm-mm-layout-encoding layout)) + (vm-mime-base64-decode-region start end crlf)) + ((string-match "^quoted-printable$" + (vm-mm-layout-encoding layout)) + (vm-mime-qp-decode-region start end)) + ((string-match "^x-uue$\\|^x-uuencode$" + (vm-mm-layout-encoding layout)) + (vm-mime-uuencode-decode-region start end crlf))))) + +(defun vm-mime-base64-decode-region (start end &optional crlf) + (or (markerp end) (setq end (vm-marker end))) + (and (> (- end start) 10000) + (vm-emit-mime-decoding-message "Decoding base64...")) + (let ((work-buffer nil) + (done nil) + (counter 0) + (bits 0) + (lim 0) inputpos + (non-data-chars (concat "^=" vm-mime-base64-alphabet))) + (unwind-protect + (save-excursion + (cond + ((and (featurep 'base64) + (fboundp 'base64-decode-region) + ;; W3 reportedly has a Lisp version of this, and + ;; there's no point running it. + (subrp (symbol-function 'base64-decode-region)) + ;; The FSF Emacs version of this is unforgiving + ;; of errors, which is not in the spirit of the + ;; MIME spec, so avoid using it. + (not vm-fsfemacs-p)) + (condition-case data + (base64-decode-region start end) + (error (vm-mime-error "%S" data))) + (and crlf (vm-mime-crlf-to-lf-region start end))) + (t + (setq work-buffer (vm-make-work-buffer)) + (if vm-mime-base64-decoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + ;; use binary coding system in FSF Emacs/MULE + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-base64-decoder-program + vm-mime-base64-decoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status)))) + (goto-char start) + (skip-chars-forward non-data-chars end) + (while (not done) + (setq inputpos (point)) + (cond + ((> (skip-chars-forward vm-mime-base64-alphabet end) 0) + (setq lim (point)) + (while (< inputpos lim) + (setq bits (+ bits + (aref vm-mime-base64-alphabet-decoding-vector + (char-after inputpos)))) + (vm-increment counter) + (vm-increment inputpos) + (cond ((= counter 4) + (vm-insert-char (lsh bits -16) 1 nil work-buffer) + (vm-insert-char (logand (lsh bits -8) 255) 1 nil + work-buffer) + (vm-insert-char (logand bits 255) 1 nil work-buffer) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 6))))))) + (cond + ((= (point) end) + (if (not (zerop counter)) + (vm-mime-error "at least %d bits missing at end of base64 encoding" + (* (- 4 counter) 6))) + (setq done t)) + ((= (char-after (point)) 61) ; 61 is ASCII equals + (setq done t) + (cond ((= counter 1) + (vm-mime-error "at least 2 bits missing at end of base64 encoding")) + ((= counter 2) + (vm-insert-char (lsh bits -10) 1 nil work-buffer)) + ((= counter 3) + (vm-insert-char (lsh bits -16) 1 nil work-buffer) + (vm-insert-char (logand (lsh bits -8) 255) + 1 nil work-buffer)) + ((= counter 0) t))) + (t (skip-chars-forward non-data-chars end))))) + (and crlf + (save-excursion + (set-buffer work-buffer) + (vm-mime-crlf-to-lf-region (point-min) (point-max)))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)))) + (and work-buffer (kill-buffer work-buffer)))) + (and (> (- end start) 10000) + (vm-emit-mime-decoding-message "Decoding base64... done"))) + +(defun vm-mime-base64-encode-region (start end &optional crlf B-encoding) + (or (markerp end) (setq end (vm-marker end))) + (and (> (- end start) 200) + (vm-inform 7 "Encoding base64...")) + (let ((work-buffer nil) + (buffer-undo-list t) + (counter 0) + (cols 0) + (bits 0) + (alphabet vm-mime-base64-alphabet) + inputpos) + (unwind-protect + (save-excursion + (and crlf (vm-mime-lf-to-crlf-region start end)) + (cond + ((and (featurep 'base64) + (fboundp 'base64-encode-region) + ;; W3 reportedly has a Lisp version of this, and + ;; there's no point running it. + (subrp (symbol-function 'base64-encode-region))) + (condition-case data + (base64-encode-region start end B-encoding) + (wrong-number-of-arguments + ;; call with two args and then strip out the + ;; newlines if we're doing B encoding. + (condition-case data + (base64-encode-region start end) + (error (vm-mime-error "%S" data))) + (if B-encoding + (save-excursion + (goto-char start) + (while (search-forward "\n" end t) + (delete-char -1))))) + (error (vm-mime-error "%S" data)))) + (t + (setq work-buffer (vm-make-work-buffer)) + (if vm-mime-base64-encoder-program + (let ((status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-base64-encoder-program + vm-mime-base64-encoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status))) + (if B-encoding + (save-excursion + (set-buffer work-buffer) + ;; if we're B encoding, strip out the line breaks + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (delete-char -1))))) + (setq inputpos start) + (while (< inputpos end) + (setq bits (+ bits (char-after inputpos))) + (vm-increment counter) + (cond ((= counter 3) + (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (vm-insert-char (aref alphabet (logand bits 63)) 1 nil + work-buffer) + (setq cols (+ cols 4)) + (cond ((= cols 72) + (setq cols 0) + (if (not B-encoding) + (vm-insert-char ?\n 1 nil work-buffer)))) + (setq bits 0 counter 0)) + (t (setq bits (lsh bits 8)))) + (vm-increment inputpos)) + ;; write out any remaining bits with appropriate padding + (if (= counter 0) + nil + (setq bits (lsh bits (- 16 (* 8 counter)))) + (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil + work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -12) 63)) + 1 nil work-buffer) + (if (= counter 1) + (vm-insert-char ?= 2 nil work-buffer) + (vm-insert-char (aref alphabet (logand (lsh bits -6) 63)) + 1 nil work-buffer) + (vm-insert-char ?= 1 nil work-buffer))) + (if (> cols 0) + (vm-insert-char ?\n 1 nil work-buffer))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end))) + (and (> (- end start) 200) + (vm-inform 7 "Encoding base64... done")) + (- end start)) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-mime-qp-decode-region (start end) + (and (> (- end start) 10000) + (vm-emit-mime-decoding-message "Decoding quoted-printable...")) + (let ((work-buffer nil) + (buf (current-buffer)) + (case-fold-search nil) + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15) + ;; some mailer uses lower-case hex + ;; digits despite this being forbidden + ;; by the MIME spec. + (?a . 10) (?b . 11) (?c . 12) (?d . 13) + (?e . 14) (?f . 15))) + inputpos stop-point copy-point) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (if vm-mime-qp-decoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + ;; use binary coding system in FSF Emacs/MULE + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-qp-decoder-program + vm-mime-qp-decoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status)))) + (goto-char start) + (setq inputpos start) + (while (< inputpos end) + (skip-chars-forward "^=\n" end) + (setq stop-point (point)) + (cond ((looking-at "\n") + ;; spaces or tabs before a hard line break must be ignored + (skip-chars-backward " \t") + (setq copy-point (point)) + (goto-char stop-point)) + (t (setq copy-point stop-point))) + (save-excursion + (set-buffer work-buffer) + (insert-buffer-substring buf inputpos copy-point)) + (cond ((= (point) end) t) + ((looking-at "\n") + (vm-insert-char ?\n 1 nil work-buffer) + (forward-char)) + (t;; looking at = + (forward-char) + ;; a-f because some mailers use lower case hex + ;; digits despite them being forbidden by the + ;; MIME spec. + (cond ((looking-at "[0-9A-Fa-f][0-9A-Fa-f]") + (vm-insert-char (+ (* (cdr (assq (char-after (point)) + hex-digit-alist)) + 16) + (cdr (assq (char-after + (1+ (point))) + hex-digit-alist))) + 1 nil work-buffer) + (forward-char 2)) + ((looking-at "\n") ; soft line break + (forward-char)) + ((looking-at "\r") + ;; assume the user's goatloving + ;; delivery software didn't convert + ;; from Internet's CRLF newline + ;; convention to the local LF + ;; convention. + (forward-char)) + ((looking-at "[ \t]") + ;; garbage added in transit + (skip-chars-forward " \t" end)) + (t (vm-mime-error "something other than line break or hex digits after = in quoted-printable encoding"))))) + (setq inputpos (point)))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)))) + (and (> (- end start) 10000) + (vm-emit-mime-decoding-message "Decoding quoted-printable... done"))) + +(defun vm-mime-qp-encode-region (start end &optional Q-encoding quote-from) + (and (> (- end start) 200) + (vm-inform 7 "Encoding quoted-printable...")) + (let ((work-buffer nil) + (buf (current-buffer)) + (cols 0) + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15))) + char inputpos) + + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (if vm-mime-qp-encoder-program + (let* ((binary-process-output t) ; any text already has CRLFs + ;; use binary coding system in FSF Emacs/MULE + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (status (apply 'vm-run-command-on-region + start end work-buffer + vm-mime-qp-encoder-program + vm-mime-qp-encoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status))) + (if quote-from + (save-excursion + (set-buffer work-buffer) + (goto-char (point-min)) + (while (re-search-forward "^From " nil t) + (replace-match "=46rom " t t)))) + (if Q-encoding + (save-excursion + (set-buffer work-buffer) + ;; strip out the line breaks + (goto-char (point-min)) + (while (search-forward "=\n" nil t) + (delete-char -2)) + ;; strip out the soft line breaks + (goto-char (point-min)) + (while (search-forward "\n" nil t) + (delete-char -1))))) + (setq inputpos start) + (while (< inputpos end) + (setq char (char-after inputpos)) + (cond ((= char ?\n) + (vm-insert-char char 1 nil work-buffer) + (setq cols 0)) + ((and (= char 32) + (not (= (1+ inputpos) end)) + (not (= ?\n (char-after (1+ inputpos))))) + (vm-insert-char char 1 nil work-buffer) + (vm-increment cols)) + ((or (< char 33) (> char 126) + ;; = + (= char 61) + ;; ? + (and Q-encoding (= char 63)) + ;; _ + (and Q-encoding (= char 95)) + (and quote-from (= cols 0) + (let ((case-fold-search nil)) + (looking-at "From "))) + (and (= cols 0) (= char ?.) + (looking-at "\\.\\(\n\\|\\'\\)"))) + (vm-insert-char ?= 1 nil work-buffer) + (vm-insert-char (car (rassq (lsh (logand char 255) -4) + hex-digit-alist)) + 1 nil work-buffer) + (vm-insert-char (car (rassq (logand char 15) + hex-digit-alist)) + 1 nil work-buffer) + (setq cols (+ cols 3))) + (t (vm-insert-char char 1 nil work-buffer) + (vm-increment cols))) + (cond ((> cols 70) + (setq cols 0) + (if Q-encoding + nil + (vm-insert-char ?= 1 nil work-buffer) + (vm-insert-char ?\n 1 nil work-buffer)))) + (vm-increment inputpos))) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end) + (and (> (- end start) 200) + (vm-inform 7 "Encoding quoted-printable... done")) + (- end start)) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-mime-uuencode-decode-region (start end &optional crlf) + (vm-emit-mime-decoding-message "Decoding uuencoded stuff...") + (let ((work-buffer nil) + (region-buffer (current-buffer)) + (case-fold-search nil) + (tempfile (vm-make-tempfile-name))) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (insert-buffer-substring region-buffer start end) + (goto-char (point-min)) + (or (re-search-forward "^begin [0-7][0-7][0-7] " nil t) + (vm-mime-error "no begin line")) + (delete-region (point) (progn (forward-line 1) (point))) + (insert tempfile "\n") + (goto-char (point-max)) + (beginning-of-line) + ;; Eudora reportedly doesn't terminate uuencoded multipart + ;; bodies with a line break. 21 June 1998. + ;; Actually it looks like Eudora doesn't understand the + ;; multipart newline boundary rule at all and can leave + ;; all types of attachments missing a line break. + (if (looking-at "^end\\'") + (progn + (goto-char (point-max)) + (insert "\n"))) + (if (stringp vm-mime-uuencode-decoder-program) + (let* ((binary-process-output t) ; any text already has CRLFs + ;; use binary coding system in FSF Emacs/MULE + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (status (apply 'vm-run-command-on-region + (point-min) (point-max) nil + vm-mime-uuencode-decoder-program + vm-mime-uuencode-decoder-switches))) + (if (not (eq status t)) + (vm-mime-error "%s" (cdr status)))) + (vm-mime-error "no uuencode decoder program defined")) + (delete-region (point-min) (point-max)) + (insert-file-contents-literally tempfile) + (and crlf + (vm-mime-crlf-to-lf-region (point-min) (point-max))) + (set-buffer region-buffer) + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + (insert-buffer-substring work-buffer) + (delete-region (point) end)) + (and work-buffer (kill-buffer work-buffer)) + (vm-error-free-call 'delete-file tempfile))) + (vm-emit-mime-decoding-message "Decoding uuencoded stuff... done")) + +(defun vm-decode-mime-message-headers (&optional m) + (vm-decode-mime-encoded-words + ;; the starting point with null m is (point) to match the + ;; previous duplicated code here. Not sure whether it's + ;; necessary. JCB, 2011-01-03 + (if m (vm-headers-of m) (point)) + (if m (vm-text-of m) (point-max)))) + +;; optional argument rstart and rend delimit the region in +;; which to decode +(defun vm-decode-mime-encoded-words (&optional rstart rend) + (let ((case-fold-search t) + (buffer-read-only nil) + charset need-conversion encoding match-start match-end start end + previous-end) + (save-excursion + (goto-char (or rstart (point-min))) + (while (re-search-forward vm-mime-encoded-word-regexp rend t) + (setq match-start (match-beginning 0) + match-end (match-end 0) + charset (buffer-substring (match-beginning 1) (match-end 1)) + need-conversion nil + encoding (buffer-substring (match-beginning 4) (match-end 4)) + start (match-beginning 5) + end (vm-marker (match-end 5))) + ;; don't change anything if we can't display the + ;; character set properly. + (if (and (not (vm-mime-charset-internally-displayable-p charset)) + (not (setq need-conversion + (vm-mime-can-convert-charset charset)))) + nil + ;; suppress whitespace between encoded words. + (and previous-end + (string-match "\\`[ \t\n]*\\'" + (buffer-substring previous-end match-start)) + (setq match-start previous-end)) + (delete-region end match-end) + (condition-case data + (cond ((string-match "B" encoding) + (vm-mime-base64-decode-region start end)) + ((string-match "Q" encoding) + (vm-mime-Q-decode-region start end)) + (t (vm-mime-error "unknown encoded word encoding, %s" + encoding))) + (vm-mime-error (apply 'message (cdr data)) + (goto-char start) + (insert "**invalid encoded word**") + (delete-region (point) end))) + (and need-conversion + (setq charset (vm-mime-charset-convert-region + charset start end))) + (vm-mime-charset-decode-region charset start end) + (goto-char end) + (setq previous-end end) + (delete-region match-start start)))))) + +(defun vm-decode-mime-encoded-words-in-string (string) + (if (and vm-display-using-mime + (let ((case-fold-search t)) + (string-match vm-mime-encoded-word-regexp string))) + (vm-with-string-as-temp-buffer string 'vm-decode-mime-encoded-words) + string )) + +(defun vm-reencode-mime-encoded-words () + "Reencode in mime the words in the current buffer that need +encoding. The words that need encoding are expected to have +text-properties set with the appropriate characte set. This would +have been done if the contents of the buffer are the result of a +previous mime decoding." + (let ((charset nil) + start coding pos q-encoding + old-size + (case-fold-search t) + (done nil)) + (save-excursion + (setq start (point-min)) + (while (not done) + (setq charset (get-text-property start 'vm-charset)) + (setq pos (next-single-property-change start 'vm-charset)) + (or pos (setq pos (point-max) done t)) + (if charset + (progn + (if (setq coding (get-text-property start 'vm-coding)) + (progn + (setq old-size (buffer-size)) + (encode-coding-region start pos coding) + (setq pos (+ pos (- (buffer-size) old-size))))) + (setq pos + (+ start + (if (setq q-encoding + (string-match "^iso-8859-\\|^us-ascii" + charset)) + (vm-mime-Q-encode-region start pos) + (vm-mime-B-encode-region start pos)))) + (goto-char pos) + (insert "?=") + (setq pos (point)) + (goto-char start) + (insert "=?" charset "?" (if q-encoding "Q" "B") "?") + (setq pos (+ pos (- (point) start))))) + (setq start pos))))) + +(defun vm-reencode-mime-encoded-words-in-string (string) + "Reencode in mime the words in STRING that need +encoding. The words that need encoding are expected to have +text-properties set with the appropriate character set. This would +have been done if the contents of the buffer are the result of a +previous mime decoding." + (if (and vm-display-using-mime + (text-property-any 0 (length string) 'vm-string t string)) + (vm-with-string-as-temp-buffer string 'vm-reencode-mime-encoded-words) + string )) + +;;---------------------------------------------------------------------------- +;;; MIME parsing +;;---------------------------------------------------------------------------- + +(fset 'vm-mime-parse-content-header 'vm-parse-structured-header) + +(defun vm-mime-get-header-contents (header-name-regexp) + (let ((contents nil) + regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^$\\)")) + (save-excursion + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (vm-matched-header-contents) + nil ))))) + +(defun* vm-mime-parse-entity (&optional m &key + (default-type nil) + (default-encoding nil) + (passing-message-only nil)) + "Parse a MIME message M and return its mime-layout. +Optional arguments: +DEFAULT-TYPE is the type to use if no Content-Type is specified. +DEFAULT-ENCODING is the default character encoding if none is + specified in the message. +PASSING-MESSAGE-ONLY is a boolean argument that says that VM is only + passing through this message. So, a full analysis is not required. + (USR, 2010-01-12)" + (catch 'return-value + (save-excursion + (if (and m (not passing-message-only)) + (progn + (setq m (vm-real-message-of m)) + (set-buffer (vm-buffer-of m)))) + (let ((case-fold-search t) version type qtype encoding id description + disposition qdisposition boundary boundary-regexp start end + multipart-list pos-list c-t c-t-e done p returnval) + (save-excursion + (save-restriction + (if (and m (not passing-message-only)) + (progn + (setq version (vm-get-header-contents m "MIME-Version:") + version (car (vm-parse-structured-header version)) + type (vm-get-header-contents m "Content-Type:") + version (if (or version + vm-mime-require-mime-version-header) + version + (if type "1.0" nil)) + qtype (vm-parse-structured-header type ?\; t) + type (vm-parse-structured-header type ?\;) + encoding (vm-get-header-contents + m "Content-Transfer-Encoding:") + version (if (or version + vm-mime-require-mime-version-header) + version + (if encoding "1.0" nil)) + encoding (or encoding "7bit") + encoding (or (car + (vm-parse-structured-header encoding)) + "7bit") + id (vm-get-header-contents m "Content-ID:") + id (car (vm-parse-structured-header id)) + description (vm-get-header-contents + m "Content-Description:") + description (and description + (if (string-match "^[ \t\n]*$" + description) + nil + description)) + disposition (vm-get-header-contents + m "Content-Disposition:") + qdisposition (and disposition + (vm-parse-structured-header + disposition ?\; t)) + disposition (and disposition + (vm-parse-structured-header + disposition ?\;))) + (widen) + (narrow-to-region (vm-headers-of m) (vm-text-end-of m))) + (goto-char (point-min)) + (setq type (vm-mime-get-header-contents "Content-Type:") + qtype (or (vm-parse-structured-header type ?\; t) + default-type) + type (or (vm-parse-structured-header type ?\;) + default-type) + encoding (or (vm-mime-get-header-contents + "Content-Transfer-Encoding:") + default-encoding) + encoding (or (car (vm-parse-structured-header encoding)) + default-encoding) + id (vm-mime-get-header-contents "Content-ID:") + id (car (vm-parse-structured-header id)) + description (vm-mime-get-header-contents + "Content-Description:") + description (and description (if (string-match "^[ \t\n]*$" + description) + nil + description)) + disposition (vm-mime-get-header-contents + "Content-Disposition:") + qdisposition (and disposition + (vm-parse-structured-header + disposition ?\; t)) + disposition (and disposition + (vm-parse-structured-header + disposition ?\;)))) + (cond ((null m) t) + (passing-message-only t) + ((null version) + (throw 'return-value 'none)) + ((or vm-mime-ignore-mime-version (string= version "1.0")) t) + (t (vm-mime-error "Unsupported MIME version: %s" version))) + ;; deal with known losers + ;; Content-Type: text + (cond ((and type (string-match "^text$" (car type))) + (setq type '("text/plain" "charset=us-ascii") + qtype '("text/plain" "charset=us-ascii")))) + (cond ((and m (not passing-message-only) (null type)) + (throw 'return-value + (vm-make-layout + 'type '("text/plain" "charset=us-ascii") + 'qtype '("text/plain" "charset=us-ascii") + 'encoding encoding + 'id id + 'description description + 'disposition disposition + 'qdisposition qdisposition + 'header-start (vm-headers-of m) + 'header-end (vm-marker (1- (vm-text-of m))) + 'body-start (vm-text-of m) + 'body-end (vm-text-end-of m) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + ))) + ((null type) + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (vm-make-layout + 'type default-type + 'qtype default-type + 'encoding encoding + 'id id + 'description description + 'disposition disposition + 'qdisposition qdisposition + 'header-start (vm-marker (point-min)) + 'header-body (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + )) + ((null (string-match "[^/ ]+/[^/ ]+" (car type))) + (vm-mime-error "Malformed MIME content type: %s" + (car type))) + ((and (string-match "^multipart/\\|^message/" (car type)) + (null (string-match "^\\(7bit\\|8bit\\|binary\\)$" + encoding)) + (if vm-mime-ignore-composite-type-opaque-transfer-encoding + (progn + ;; Some mailers declare an opaque + ;; encoding on a composite type even + ;; though it's only a subobject that + ;; uses that encoding. Deal with it + ;; by assuming a proper transfer encoding. + (setq encoding "binary") + ;; return nil so and-clause will fail + nil ) + t )) + (vm-mime-error "Opaque transfer encoding used with multipart or message type: %s, %s" (car type) encoding)) + ((and (string-match "^message/partial$" (car type)) + (null (string-match "^7bit$" encoding))) + (vm-mime-error "Non-7BIT transfer encoding used with message/partial message: %s" encoding)) + ((string-match "^multipart/digest" (car type)) + (setq c-t '("message/rfc822") + c-t-e "7bit")) + ((string-match "^multipart/" (car type)) + (setq c-t '("text/plain" "charset=us-ascii") + c-t-e "7bit")) ; below + ((string-match "^message/\\(rfc822\\|news\\|external-body\\)" + (car type)) + (setq c-t '("text/plain" "charset=us-ascii") + c-t-e "7bit") + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (throw 'return-value + (vm-make-layout + 'type type + 'qtype qtype + 'encoding encoding + 'id id + 'description description + 'disposition disposition + 'qdisposition qdisposition + 'header-start (vm-marker (point-min)) + 'header-end (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'parts (list + (save-restriction + (narrow-to-region (point) (point-max)) + (vm-mime-parse-entity-safe + m :default-type c-t + :default-encoding c-t-e + :passing-message-only t))) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + ))) + (t + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (throw 'return-value + (vm-make-layout + 'type type + 'qtype qtype + 'encoding encoding + 'id id + 'description description + 'disposition disposition + 'qdisposition qdisposition + 'header-start (vm-marker (point-min)) + 'header-end (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + )))) + (setq p (cdr type) + boundary nil) + (while p + (if (string-match "^boundary=" (car p)) + (setq boundary (car (vm-parse (car p) "=\\(.+\\)")) + p nil) + (setq p (cdr p)))) + (or boundary + (vm-mime-error + "Boundary parameter missing in %s type specification" + (car type))) + ;; the \' in the regexp is to "be liberal" in the + ;; face of broken software that does not add a line + ;; break after the final boundary of a nested + ;; multipart entity. + (setq boundary-regexp + (concat "^--" (regexp-quote boundary) + "\\(--\\)?[ \t]*\\(\n\\|\\'\\)")) + (goto-char (point-min)) + (setq start nil + multipart-list nil + done nil) + (while (and (not done) (re-search-forward boundary-regexp nil 0)) + (if (null start) + (setq start (match-end 0)) + (and (match-beginning 1) + (setq done t)) + (setq pos-list (cons start + (cons (1- (match-beginning 0)) pos-list)) + start (match-end 0)))) + (if (and (not done) + (not vm-mime-ignore-missing-multipart-boundary)) + (vm-mime-error "final %s boundary missing" boundary) + (if (and start (not done)) + (setq pos-list (cons start (cons (point) pos-list))))) + (setq pos-list (nreverse pos-list)) + (while pos-list + (setq start (car pos-list) + end (car (cdr pos-list)) + pos-list (cdr (cdr pos-list))) + (save-excursion + (save-restriction + (narrow-to-region start end) + (setq multipart-list + (cons (vm-mime-parse-entity-safe + m :default-type c-t + :default-encoding c-t-e + :passing-message-only t) + multipart-list))))) + (goto-char (point-min)) + (or (re-search-forward "^\n\\|\n\\'" nil t) + (vm-mime-error "MIME part missing header/body separator line")) + (vm-make-layout + 'type type + 'qtype qtype + 'encoding encoding + 'id id + 'description description + 'disposition disposition + 'qdisposition qdisposition + 'header-start (vm-marker (point-min)) + 'header-end (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'parts (nreverse multipart-list) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + ))))))) + +(defun* vm-mime-parse-entity-safe (&optional m &key + (default-type nil) + (default-encoding nil) + (passing-message-only nil)) + "Like vm-mime-parse-entity, but recovers from any errors. +DEFAULT-TYPE, unless specified, is assumed to be text/plain. +DEFAULT-TRANSFER-ENCODING, unless specified, is assumed to be 7bit. + (USR, 2010-01-12)" + + (or default-type (setq default-type '("text/plain" "charset=us-ascii"))) + (or default-encoding (setq default-encoding "7bit")) + ;; don't let subpart parse errors make the whole parse fail. use default + ;; type if the parse fails. + (condition-case error-data + (vm-mime-parse-entity m :default-type default-type + :default-encoding default-encoding + :passing-message-only passing-message-only) + (vm-mime-error + (vm-inform 0 "%s" (car (cdr error-data))) + ;; don't sleep, no one cares about MIME syntax errors + ;; (sleep-for 2) + (let ((header (if (and m (not passing-message-only)) + (vm-headers-of m) + (vm-marker (point-min)))) + (text (if (and m (not passing-message-only)) + (vm-text-of m) + (save-excursion + (re-search-forward "^\n\\|\n\\'" + nil 0) + (vm-marker (point))))) + (text-end (if (and m (not passing-message-only)) + (vm-text-end-of m) + (vm-marker (point-max))))) + (vm-make-layout + 'type '("error/error") + 'qtype '("error/error") + 'encoding (vm-determine-proper-content-transfer-encoding text text-end) + ;; cram the error message into the description slot + 'description (car (cdr error-data)) + ;; mark as an attachment to improve the chance that the user + ;; will see the description. + 'disposition '("attachment") + 'qdisposition '("attachment") + 'header-start header + 'header-end (vm-marker (1- text)) + 'body-start text + 'body-end text-end + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol m) + ))))) + +;;---------------------------------------------------------------------------- +;;; MIME layout operations +;;---------------------------------------------------------------------------- + +(defun vm-mime-get-xxx-parameter-internal (name param-list) + "Return the parameter NAME from PARAM-LIST." + (let ((match-end (1+ (length name))) + (name-regexp (concat (regexp-quote name) "=")) + (case-fold-search t) + (done nil)) + (while (and param-list (not done)) + (if (and (string-match name-regexp (car param-list)) + (= (match-end 0) match-end)) + (setq done t) + (setq param-list (cdr param-list)))) + (and (car param-list) + (substring (car param-list) match-end)))) + +(defun vm-mime-get-xxx-parameter (name param-list) + "Return the parameter NAME from PARAM-LIST. + +If parameter value continuations was used, i.e. the parameter was split into +shorter pieces, rebuild it from them." + (or (vm-mime-get-xxx-parameter-internal name param-list) + (let ((n 0) content p) + (while (setq p (vm-mime-get-xxx-parameter-internal + (format "%s*%d" name n) + param-list)) + (setq n (1+ n) + content (concat content p))) + content))) + +(defun vm-mime-get-parameter (layout param) + (let ((string (vm-mime-get-xxx-parameter + param (cdr (vm-mm-layout-type layout))))) + (if string (vm-decode-mime-encoded-words-in-string string)))) + +(defun vm-mime-get-disposition-parameter (layout param) + (let ((string (vm-mime-get-xxx-parameter + param (cdr (vm-mm-layout-disposition layout))))) + (if string (vm-decode-mime-encoded-words-in-string string)))) + +(defun vm-mime-set-xxx-parameter (param value param-list) + (let ((match-end (1+ (length param))) + (param-regexp (concat (regexp-quote param) "=")) + (case-fold-search t) + (done nil)) + (while (and param-list (not done)) + (if (and (string-match param-regexp (car param-list)) + (= (match-end 0) match-end)) + (setq done t) + (setq param-list (cdr param-list)))) + (and (car param-list) + (setcar param-list (concat param "=" value))))) + +(defun vm-mime-set-parameter (layout param value) + (vm-mime-set-xxx-parameter param value (cdr (vm-mm-layout-type layout)))) + +(defun vm-mime-set-qparameter (layout param value) + (setq value (concat "\"" value "\"")) + (vm-mime-set-xxx-parameter param value (cdr (vm-mm-layout-qtype layout)))) + +;;---------------------------------------------------------------------------- +;;; Working with MIME layouts +;;---------------------------------------------------------------------------- + +(defun vm-mime-insert-mime-body (layout) + "Insert in the current buffer the body of a mime part given by LAYOUT." + (vm-insert-region-from-buffer + (marker-buffer (vm-mm-layout-body-start layout)) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout))) + +(defun vm-mime-insert-mime-headers (layout) + "Insert in the current buffer the headers of a mime part given by LAYOUT." + (vm-insert-region-from-buffer + (marker-buffer (vm-mm-layout-header-start layout)) + (vm-mm-layout-header-start layout) + (vm-mm-layout-header-end layout))) + +(defvar buffer-display-table) +(defvar standard-display-table) +(defvar buffer-file-type) + +(defun vm-generate-new-presentation-buffer (folder-buffer name) + "Generate a new Presentation buffer for FOLDER-BUFFER. NAME is +a string denoting the folder name." + (let ((pres-buf (vm-generate-new-multibyte-buffer + (concat name " Presentation")))) + (save-excursion + (set-buffer pres-buf) + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (setq mode-name "VM Presentation" + major-mode 'vm-presentation-mode + vm-message-pointer (list nil) + vm-mail-buffer folder-buffer + mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu)) + ;; Default to binary file type for DOS/NT. + buffer-file-type t + ;; Tell XEmacs/MULE not to mess with the text on writes. + buffer-read-only t + mode-line-format vm-mode-line-format) + ;; scroll in place messes with scroll-up and this loses + (defvar scroll-in-place) + (make-local-variable 'scroll-in-place) + (setq scroll-in-place nil) + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system (vm-binary-coding-system) t)) + (vm-fsfemacs-nonmule-display-8bit-chars) + (if (and vm-mutable-frame-configuration vm-frame-per-folder + (vm-multiple-frames-possible-p)) + (vm-set-hooks-for-frame-deletion)) + (use-local-map vm-mode-map) + (vm-toolbar-install-or-uninstall-toolbar) + (when (vm-menu-support-possible-p) + (vm-menu-install-menus)) + (run-hooks 'vm-presentation-mode-hook)) + pres-buf)) + +(defun vm-make-presentation-copy (m) + "Create a copy of the message M in the Presentation Buffer. If +the message is external then the copy is made from the external +source of the message." + (let ((mail-buffer (current-buffer)) + pres-buf mm + (real-m (vm-real-message-of m)) + (modified (buffer-modified-p))) + (when (or (null vm-presentation-buffer-handle) + (null (buffer-name vm-presentation-buffer-handle))) + ;; Create a new Presentation buffer + (setq pres-buf (vm-generate-new-presentation-buffer + (current-buffer) (buffer-name))) + (setq vm-presentation-buffer-handle pres-buf)) + (setq pres-buf vm-presentation-buffer-handle) + (setq vm-presentation-buffer vm-presentation-buffer-handle) + (setq vm-mime-decoded nil) + ;; W3 or some other external mode might set some local colors + ;; in this buffer; remove them before displaying a different + ;; message here. + (when (fboundp 'remove-specifier) + (remove-specifier (face-foreground 'default) pres-buf) + (remove-specifier (face-background 'default) pres-buf)) + (save-excursion + (set-buffer (vm-buffer-of real-m)) + (save-restriction + (widen) + ;; must reference this now so that headers will be in + ;; their final position before the message is copied. + ;; otherwise the vheader offset computed below will be + ;; wrong. + (vm-vheaders-of real-m) + (set-buffer pres-buf) + ;; do not keep undo information in presentation buffers + (setq buffer-undo-list t) + (widen) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + ;; We don't care about the buffer-modified-p flag of the + ;; Presentation buffer. Only that of the folder matters. + ;; (setq modified (buffer-modified-p)) + (unwind-protect + (progn + (erase-buffer) + (insert-buffer-substring (vm-buffer-of real-m) + (vm-start-of real-m) + (vm-end-of real-m))) + (vm-reset-buffer-modified-p modified pres-buf))) + ;; make a modifiable copy of the message struct + (setq mm (copy-sequence m)) + ;; also a modifiable copy of the location data + ;; other data will be shared with the Folder buffer + (vm-set-location-data-of mm (vm-copy (vm-location-data-of m))) + (set-marker (vm-start-of mm) (point-min)) + (set-marker (vm-headers-of mm) (+ (vm-start-of mm) + (- (vm-headers-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-vheaders-of mm) (+ (vm-start-of mm) + (- (vm-vheaders-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-of mm) (+ (vm-start-of mm) + (- (vm-text-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-end-of mm) (+ (vm-start-of mm) + (- (vm-text-end-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-end-of mm) (+ (vm-start-of mm) + (- (vm-end-of real-m) + (vm-start-of real-m)))) + + ;; fetch the real message now + (goto-char (point-min)) + (cond ((and (vm-message-access-method-of mm) + (vm-body-to-be-retrieved-of mm)) + ;; Remember that this does process I/O and + ;; accept-process-output, allowing concurrent threads + ;; to run!!! USR, 2010-07-11 + (condition-case err + (vm-fetch-message + (list (vm-message-access-method-of mm)) mm) + (error + (vm-warn 0 0 "Cannot fetch message; %s" + (error-message-string err))))) + ((re-search-forward "^X-VM-Storage: " (vm-text-of mm) t) + (vm-fetch-message (read (current-buffer)) mm))) + ;; This might be redundant. Wasn't in revision 717. + ;; (vm-reset-buffer-modified-p modified (current-buffer)) + ;; fixup the reference to the message + (setcar vm-message-pointer mm))))) + +;; This experimental code is now discarded. USR, 2011-05-07 + +;; (defun vm-make-fetch-copy-if-necessary (m) +;; "Create a copy of the message M in the Fetch Buffer if it is +;; not already present. If it is an external message, the copy +;; is made from the external source of the message." +;; (unless (and vm-fetch-buffer +;; (eq (vm-real-message-sym-of m) +;; (with-current-buffer vm-fetch-buffer +;; (vm-real-message-sym-of (car vm-message-pointer))))) +;; (vm-make-fetch-copy m))) + + +;; (defun vm-make-fetch-copy (m) +;; "Create a copy of the message M in the Fetch Buffer. If +;; it is an external message, the copy is made from the external +;; source of the message." +;; (let ((mail-buffer (current-buffer)) +;; fetch-buf mm +;; (real-m (vm-real-message-of m)) +;; (modified (buffer-modified-p))) +;; (cond ((or (null vm-fetch-buffer) +;; (null (buffer-name vm-fetch-buffer))) +;; (setq fetch-buf (vm-generate-new-multibyte-buffer +;; (concat (buffer-name) " Fetch"))) +;; (save-excursion +;; (set-buffer fetch-buf) +;; (if (fboundp 'buffer-disable-undo) +;; (buffer-disable-undo (current-buffer)) +;; ;; obfuscation to make the v19 compiler not whine +;; ;; about obsolete functions. +;; (let ((x 'buffer-flush-undo)) +;; (funcall x (current-buffer)))) +;; (setq mode-name "VM Message" +;; major-mode 'vm-message-mode +;; vm-message-pointer (list nil) +;; vm-mail-buffer mail-buffer +;; mode-popup-menu (and vm-use-menus +;; (vm-menu-support-possible-p) +;; (vm-menu-mode-menu)) +;; ;; Default to binary file type for DOS/NT. +;; buffer-file-type t +;; ;; Tell XEmacs/MULE not to mess with the text on writes. +;; buffer-read-only t +;; mode-line-format vm-mode-line-format) +;; ;; scroll in place messes with scroll-up and this loses +;; (defvar scroll-in-place) +;; (make-local-variable 'scroll-in-place) +;; (setq scroll-in-place nil) +;; (if (fboundp 'set-buffer-file-coding-system) +;; (set-buffer-file-coding-system (vm-binary-coding-system) t)) +;; (vm-fsfemacs-nonmule-display-8bit-chars) +;; (if (and vm-mutable-frame-configuration vm-frame-per-folder +;; (vm-multiple-frames-possible-p)) +;; (vm-set-hooks-for-frame-deletion)) +;; (use-local-map vm-mode-map) +;; (vm-toolbar-install-or-uninstall-toolbar) +;; (when (vm-menu-support-possible-p) +;; (vm-menu-install-menus)) +;; (run-hooks 'vm-message-mode-hook)) +;; (setq vm-fetch-buffer fetch-buf))) +;; (setq fetch-buf vm-fetch-buffer) +;; (setq vm-mime-decoded nil) +;; ;; W3 or some other external mode might set some local colors +;; ;; in this buffer; remove them before displaying a different +;; ;; message here. +;; (if (fboundp 'remove-specifier) +;; (progn +;; (remove-specifier (face-foreground 'default) fetch-buf) +;; (remove-specifier (face-background 'default) fetch-buf))) +;; (save-excursion +;; (set-buffer (vm-buffer-of real-m)) +;; (save-restriction +;; (widen) +;; ;; must reference this now so that headers will be in +;; ;; their final position before the message is copied. +;; ;; otherwise the vheader offset computed below will be +;; ;; wrong. +;; (vm-vheaders-of real-m) +;; (set-buffer fetch-buf) +;; ;; do not keep undo information in message buffers +;; (setq buffer-undo-list t) +;; (widen) +;; (let ((buffer-read-only nil) +;; (inhibit-read-only t)) +;; ;; (setq modified (buffer-modified-p)) ; why this? USR, 2011-03-18 +;; (unwind-protect +;; (progn +;; (erase-buffer) +;; (insert-buffer-substring (vm-buffer-of real-m) +;; (vm-start-of real-m) +;; (vm-end-of real-m))) +;; (vm-restore-buffer-modified-p modified fetch-buf))) +;; (setq mm (copy-sequence m)) +;; (vm-set-location-data-of mm (vm-copy (vm-location-data-of m))) +;; (vm-set-softdata-of mm (vm-copy (vm-softdata-of m))) +;; (vm-set-message-id-number-of mm 1) +;; (vm-set-buffer-of mm (current-buffer)) +;; (set-marker (vm-start-of mm) (point-min)) +;; (set-marker (vm-headers-of mm) (+ (vm-start-of mm) +;; (- (vm-headers-of real-m) +;; (vm-start-of real-m)))) +;; (set-marker (vm-vheaders-of mm) (+ (vm-start-of mm) +;; (- (vm-vheaders-of real-m) +;; (vm-start-of real-m)))) +;; (set-marker (vm-text-of mm) (+ (vm-start-of mm) +;; (- (vm-text-of real-m) +;; (vm-start-of real-m)))) +;; (set-marker (vm-text-end-of mm) (+ (vm-start-of mm) +;; (- (vm-text-end-of real-m) +;; (vm-start-of real-m)))) +;; (set-marker (vm-end-of mm) (+ (vm-start-of mm) +;; (- (vm-end-of real-m) +;; (vm-start-of real-m)))) +;; (vm-set-mime-layout-of mm (vm-mime-parse-entity-safe)) +;; ;; fetch the real message now +;; (goto-char (point-min)) +;; (cond ((and (vm-message-access-method-of mm) +;; (vm-body-to-be-retrieved-of mm)) +;; ;; Remember that this does process I/O and +;; ;; accept-process-output, and hence allow concurrent +;; ;; threads to run!!! USR, 2010-07-11 +;; (condition-case err +;; (vm-fetch-message +;; (list (vm-message-access-method-of mm)) mm) +;; (error +;; (vm-warn 0 2 "Cannot fetch; %s" (error-message-string err))))) +;; ((re-search-forward "^X-VM-Storage: " (vm-text-of mm) t) +;; (vm-fetch-message (read (current-buffer)) mm))) +;; (vm-reset-buffer-modified-p modified fetch-buf) +;; ;; fixup the reference to the message +;; (setcar vm-message-pointer mm))))) + +(defun vm-fetch-message (storage mm) + "Fetch the real message based on the \"^X-VM-Storage:\" header. + +This allows for storing only the headers required for the summary +and maybe a small preview of the message, or keywords for search, +etc. Only when displaying it the actual message is fetched based +on the storage handler. + +The information about the actual message is stored in the +\"^X-VM-Storage:\" header and should be a lisp list of the +following format. + + \(HANDLER ARGS...\) + +HANDLER should correspond to a `vm-fetch-HANDLER-message' +function, e.g., the handler `file' corresponds to the function +`vm-fetch-file-message' which gets two arguments, the message +descriptor and the filename containing the message, and inserts the +message body from the file into the current buffer. + +For example, 'X-VM-Storage: (file \"message-11\")' will fetch +the actual message from the file \"message-11\"." + (goto-char (match-end 0)) + (save-excursion + (set-buffer (marker-buffer (vm-text-of mm))) + (let ((buffer-read-only nil) + (inhibit-read-only t) + (buffer-undo-list t) + (fetch-result nil)) + (goto-char (vm-text-of mm)) + (delete-region (point) (point-max)) + ;; Remember that this might do process I/O and accept-process-output, + ;; allowing other threads to run!!! USR, 2010-07-11 + (vm-inform 6 "Fetching message from external source...") + (setq fetch-result + (apply (intern (format "vm-fetch-%s-message" (car storage))) + mm (cdr storage))) + (when fetch-result + (vm-inform 6 "Fetching message from external source... done") + ;; delete the new headers + (delete-region (vm-text-of mm) + (or (re-search-forward "\n\n" (point-max) t) + (point-max))) + ;; fix markers now + (set-marker (vm-text-end-of mm) (point-max)) + (set-marker (vm-end-of mm) (point-max)) + ;; now care for the layout of the message, old layouts are + ;; invalid as the presentation buffer may have been used for + ;; other messages in the meantime and the marker got invalid + ;; by this. + (vm-set-mime-layout-of mm (vm-mime-parse-entity-safe)) + )))) + +(defun vm-fetch-file-message (m filename) + "Insert the message with message descriptor MM stored in the given FILENAME." + (insert-file-contents filename nil nil nil t) + t) + +(fset 'vm-fetch-mode 'vm-mode) +(put 'vm-fetch-mode 'mode-class 'special) +(fset 'vm-presentation-mode 'vm-mode) +(put 'vm-presentation-mode 'mode-class 'special) + +(defvar buffer-file-coding-system) + +(defun vm-determine-proper-charset (beg end) + "Work out what MIME character set to use for sending a message. + +Uses `us-ascii' if the message is entirely ASCII compatible. If MULE is not +available, and the message contains contains non-ASCII characters, consults +the variable `vm-mime-8bit-composition-charset' or uses `iso-8859-1.' if +that is nil. + +Under MULE, `vm-coding-system-priorities' is searched, in order, for a coding +system that will encode all the characters in the message. If none is found, +consults the variable `vm-mime-8bit-composition-charset' or uses `iso-2022-jp', +which will preserve information for all the character sets of which Emacs is +aware - at the expense of being incompatible with the recipient's software, if +that recipient is outside of East Asia." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (if (or vm-xemacs-mule-p + (and vm-fsfemacs-mule-p enable-multibyte-characters)) + ;; Okay, we're on a MULE build. + (if (and vm-fsfemacs-mule-p + (fboundp 'check-coding-systems-region)) + ;; check-coding-systems-region appeared in GNU Emacs 23. + (let* ((preapproved (vm-get-coding-system-priorities)) + (ucs-list (vm-get-mime-ucs-list)) + (cant-encode (check-coding-systems-region + (point-min) (point-max) + (cons 'us-ascii preapproved)))) + (if (not (assq 'us-ascii cant-encode)) + ;; If there are only ASCII chars, we're done. + "us-ascii" + (while (and preapproved + (assq (car preapproved) cant-encode) + (not (memq (car preapproved) ucs-list))) + (setq preapproved (cdr preapproved))) + (if preapproved + (cadr (assq (car preapproved) + vm-mime-mule-coding-to-charset-alist)) + ;; None of the entries in vm-coding-system-priorities + ;; can be used. This can only happen if no universal + ;; coding system is included. Fall back to utf-8. + "utf-8"))) + + (let ((charsets (delq 'ascii + (vm-charsets-in-region (point-min) + (point-max))))) + (cond + ;; No non-ASCII chars? Right, that makes it easy for us. + ((null charsets) "us-ascii") + + ;; Check whether the buffer can be encoded using one of the + ;; vm-coding-system-priorities coding systems. + ((catch 'done + + ;; We can't really do this intelligently unless latin-unity + ;; is available. + (if (featurep 'latin-unity) + (let ((csetzero charsets) + ;; Check what latin character sets are in the + ;; buffer. + (csets (latin-unity-representations-feasible-region + beg end)) + (psets (latin-unity-representations-present-region + beg end)) + (systems (vm-get-coding-system-priorities))) + + ;; If one of the character sets is outside of latin + ;; unity's remit, check for a universal character + ;; set in vm-coding-system-priorities, and pass back + ;; the first one. + ;; + ;; Otherwise, there's no remapping that latin unity + ;; can do for us, and we should default to something + ;; iso-2022 based. (Since we're not defaulting to + ;; Unicode, at the moment.) + + (while csetzero + (if (not (memq + (car csetzero) latin-unity-character-sets)) + (let ((ucs-list (vm-get-mime-ucs-list)) + (preapproved + (vm-get-coding-system-priorities))) + (while preapproved + (if (memq (car preapproved) ucs-list) + (throw 'done + (car (cdr (assq (car preapproved) + vm-mime-mule-coding-to-charset-alist))))) + (setq preapproved (cdr preapproved))) + ;; Nothing universal in the preapproved list. + (throw 'done nil))) + (setq csetzero (cdr csetzero))) + + ;; Okay, we're able to remap using latin-unity. Do so. + (while systems + (let ((sys (latin-unity-massage-name (car systems) + 'buffer-default))) + (when (latin-unity-maybe-remap (point-min) + (point-max) sys + csets psets t) + (throw 'done + (second (assq sys + vm-mime-mule-coding-to-charset-alist))))) + (setq systems (cdr systems))) + (throw 'done nil)) + + ;; Right, latin-unity isn't available. If there's only + ;; one non-ASCII character set in the region, and the + ;; corresponding coding system is on the preapproved + ;; list before the first universal character set, pass + ;; it back. Otherwise, if a universal character set is + ;; on the preapproved list, pass the first one of them + ;; back. Otherwise, pass back nil and use the + ;; "iso-2022-jp" entry below. + + (let ((csetzero charsets) + (preapproved (vm-get-coding-system-priorities)) + (ucs-list (vm-get-mime-ucs-list))) + (if (null (cdr csetzero)) + (while preapproved + ;; If we encounter a universal character set on + ;; the preapproved list, pass it back. + (if (memq (car preapproved) ucs-list) + (throw 'done + (second (assq (car preapproved) + vm-mime-mule-coding-to-charset-alist)))) + + ;; The preapproved entry isn't universal. Check if + ;; it's related to the single non-ASCII MULE + ;; charset in the buffer (that is, if the + ;; conceptually unordered MULE list of characters + ;; is based on a corresponding ISO character set, + ;; and thus the ordered ISO character set can + ;; encode all the characters in the MIME charset.) + ;; + ;; The string equivalence test is used because we + ;; don't have another mapping that is useful + ;; here. Nnngh. + + (if (string= + (car (cdr (assoc (car csetzero) + vm-mime-mule-charset-to-charset-alist))) + (car (cdr (assoc (car preapproved) + vm-mime-mule-coding-to-charset-alist)))) + (throw 'done + (car (cdr (assoc (car csetzero) + vm-mime-mule-charset-to-charset-alist))))) + (setq preapproved (cdr preapproved))) + + ;; Okay, there's more than one MULE character set in + ;; the buffer. Check for a universal entry in the + ;; preapproved list; if it exists pass it back, + ;; otherwise fall through to the iso-2022-jp below, + ;; because nothing on the preapproved list is + ;; appropriate. + + (while preapproved + ;; If we encounter a universal character set on + ;; the preapproved list, pass it back. + (when (memq (car preapproved) ucs-list) + (throw 'done + (second (assq (car preapproved) + vm-mime-mule-coding-to-charset-alist)))) + (setq preapproved (cdr preapproved))))) + (throw 'done nil)))) + ;; Couldn't do any magic with vm-coding-system-priorities. Pass + ;; back a Japanese iso-2022 MIME character set. + (t "iso-2022-jp") + ;; Undo the change made in revisin 493 + ;; (t (or vm-mime-8bit-composition-charset "iso-2022-jp")) + ;; -- + ))) + ;; If we're non-MULE and there are eight bit characters, use a + ;; sensible default. + (goto-char (point-min)) + (if (re-search-forward "[^\000-\177]" nil t) + (or vm-mime-8bit-composition-charset "iso-8859-1") + ;; We're non-MULE and there are purely 7bit characters in the + ;; region. Return vm-mime-7bit-c-c. + vm-mime-7bit-composition-charset))))) + +(defun vm-determine-proper-content-transfer-encoding (beg end) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (catch 'done + (goto-char (point-min)) + (and (re-search-forward "[\000\015]" nil t) + (throw 'done "binary")) + + (let ((toolong nil) bol) + (goto-char (point-min)) + (setq bol (point)) + (while (and (not (eobp)) (not toolong)) + (forward-line) + (setq toolong (> (- (point) bol) 998) + bol (point))) + (and toolong (throw 'done "binary"))) + + (goto-char (point-min)) + (and (re-search-forward "[^\000-\177]" nil t) + (throw 'done "8bit")) + + "7bit")))) + +;;---------------------------------------------------------------------------- +;;; Predicates on MIME types and layouts +;;---------------------------------------------------------------------------- + +(defun vm-mime-types-match (type type/subtype) + (let ((case-fold-search t)) + (cond ((null type/subtype) + nil) + ((string-match "/" type) + (if (and (string-match (regexp-quote type) type/subtype) + (equal 0 (match-beginning 0)) + (equal (length type/subtype) (match-end 0))) + t + nil )) + ((and (string-match (regexp-quote type) type/subtype) + (equal 0 (match-beginning 0)) + (equal (save-match-data + (string-match "/" type/subtype (match-end 0))) + (match-end 0))))))) + +(defvar native-sound-only-on-console) + +(defun vm-mime-text/html-handler () + (if (eq vm-mime-text/html-handler 'auto-select) + (setq vm-mime-text/html-handler + (cond ((locate-library "w3m") + 'emacs-w3m) + ((locate-library "w3") + 'w3) + ((executable-find "w3m") + 'w3m) + ((executable-find "lynx") + 'lynx))) + vm-mime-text/html-handler)) + +(defun vm-mime-can-display-internal (layout &optional deep) + (let ((type (car (vm-mm-layout-type layout)))) + (cond ((vm-mime-types-match "image/jpeg" type) + (and (vm-image-type-available-p 'jpeg) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/gif" type) + (and (vm-image-type-available-p 'gif) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/png" type) + (and (vm-image-type-available-p 'png) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/tiff" type) + (and (vm-image-type-available-p 'tiff) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/xpm" type) + (and (vm-image-type-available-p 'xpm) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/pbm" type) + (and (vm-image-type-available-p 'pbm) (vm-images-possible-here-p))) + ((vm-mime-types-match "image/xbm" type) + (and (vm-image-type-available-p 'xbm) (vm-images-possible-here-p))) + ((vm-mime-types-match "audio/basic" type) + (and vm-xemacs-p + (or (featurep 'native-sound) + (featurep 'nas-sound)) + (or (device-sound-enabled-p) + (and (featurep 'native-sound) + (not native-sound-only-on-console) + (memq (vm-device-type) '(x gtk)))))) + ((vm-mime-types-match "multipart" type) t) + ((vm-mime-types-match "message/external-body" type) + (or (not deep) + (vm-mime-can-display-internal + (car (vm-mm-layout-parts layout)) t))) + ((vm-mime-types-match "message" type) t) + ((vm-mime-types-match "text/html" type) + ;; Allow vm-mime-text/html-handler to decide if text/html parts are displayable: + (and (vm-mime-text/html-handler) + (let ((charset (or (vm-mime-get-parameter layout "charset") + "us-ascii"))) + (vm-mime-charset-internally-displayable-p charset)))) + ((vm-mime-types-match "text" type) + (let ((charset (or (vm-mime-get-parameter layout "charset") + "us-ascii"))) + (or (vm-mime-charset-internally-displayable-p charset) + (vm-mime-can-convert-charset charset)))) + (t nil)))) + +(defun vm-mime-can-convert (type) + "If given mime TYPE is convertible to some other type, return a +triple (source-type target-type command). Otherwise, return nil." + (or (vm-mime-can-convert-0 type vm-mime-type-converter-alist) + (vm-mime-can-convert-0 type vm-mime-image-type-converter-alist))) + +(defun vm-mime-can-convert-0 (type alist) + (let ( + ;; fake layout. make it the wrong length so an error will + ;; be signaled if vm-mime-can-display-internal ever asks + ;; for one of the other fields + (fake-layout (make-vector 1 (list nil))) + best second-best) + (while (and alist (not best)) + (cond ((and (vm-mime-types-match (car (car alist)) type) + (not (vm-mime-types-match (nth 1 (car alist)) type))) + (cond ((and (not best) + (progn + (setcar (aref fake-layout 0) (nth 1 (car alist))) + (vm-mime-can-display-internal fake-layout))) + (setq best (car alist))) + ((and (not second-best) + (vm-mime-find-external-viewer (nth 1 (car alist)))) + (setq second-best (car alist)))))) + (setq alist (cdr alist))) + (or best second-best))) + +(defun vm-mime-convert-undisplayable-layout (layout) + (catch 'done + (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout)))) + ex work-buffer) + (vm-inform 6 "Converting %s to %s..." + (car (vm-mm-layout-type layout)) + (nth 1 ooo)) + (setq work-buffer (vm-make-work-buffer " *mime object*")) + (vm-register-message-garbage 'kill-buffer work-buffer) + (with-current-buffer work-buffer + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + ;; It is annoying to use cat for conversion of a mime type which + ;; is just plain text. Therefore we do not call it ... + (setq ex 0) + (if (= (length ooo) 2) + (if (search-forward-regexp "\n\n" (point-max) t) + (delete-region (point-min) (match-beginning 0))) + ;; it is arguable that if the type to be converted is text, + ;; we should convert from the object's native encoding to + ;; the default encoding. However, converting from text is + ;; likely to be rare, so we'll have that argument another + ;; time. JCB, 2011-02-04 + (let ((coding-system-for-write (vm-binary-coding-system)) + (coding-system-for-read (vm-binary-coding-system))) + (setq ex (call-process-region + (point-min) (point-max) shell-file-name + t t nil shell-command-switch (nth 2 ooo))))) + (unless (eq ex 0) + (switch-to-buffer work-buffer) + (vm-warn 0 5 + "Conversion from %s to %s failed (exit code %s)" + (car (vm-mm-layout-type layout)) (nth 1 ooo) ex) + (throw 'done nil)) + (goto-char (point-min)) + ;; if the to-type is text, then we will assume that the conversion + ;; process outputs text in the default encoding. + ;; Really we ought to look at process-coding-system-alist etc, + ;; but I suspect that this is rarely used, and will become even + ;; less used as utf-8 becomes universal. JCB, 2011-02-04 + ;; But we will let detect-coding-region do as much work as it + ;; can. USR, 2011-02-11 + (let* ((charset (vm-mime-find-charset-for-binary-buffer))) + (insert "Content-Type: " + (vm-mime-type-with-params + (nth 1 ooo) + (and (vm-mime-types-match "text" (nth 1 ooo)) + (list (concat "charset=" charset)))) + "\n") + (insert "Content-Transfer-Encoding: binary\n\n") + (set-buffer-modified-p nil) + (vm-inform 6 "Converting %s to %s... done" + (car (vm-mm-layout-type layout)) + (nth 1 ooo)) + ;; irritatingly, we need to set the coding system here as well + (vm-make-layout + 'type + (append (list (nth 1 ooo)) + (append (cdr (vm-mm-layout-type layout)) + (if (vm-mime-types-match "text" (nth 1 ooo)) + (list (concat + "charset=" charset))))) + 'qtype + (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout))) + 'encoding "binary" + 'id (vm-mm-layout-id layout) + 'description (vm-mm-layout-description layout) + 'disposition (vm-mm-layout-disposition layout) + 'qdisposition (vm-mm-layout-qdisposition layout) + 'header-start (vm-marker (point-min)) + 'header-end (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'parts nil + 'cache (vm-mime-make-cache-symbol) + 'message-symbol + (vm-mime-make-message-symbol (vm-mm-layout-message layout)) + 'display-error nil + 'layout-is-converted t )))))) + +(defun vm-mime-find-charset-for-binary-buffer () + "Finds an appropriate MIME character set for the current buffer, +assuming that it is text." + (let ((coding-systems (detect-coding-region (point-min) (point-max))) + (coding-system nil) (n nil)) + ;; XEmacs returns a single coding-system sometimes + (unless (listp coding-systems) + (setq coding-systems (list coding-systems))) + ;; Skip over the uninformative coding-systems + (setq n + (vm-find coding-systems + (function + (lambda (coding) + (and coding + (not (memq (vm-coding-system-name-no-eol coding) + '(raw-text no-conversion)))))))) + (when n + (setq coding-system (nth n coding-systems))) + ;; If no informative coding-system detected then use the default + ;; buffer-file-coding-system + (when (or (null coding-system) + (eq (vm-coding-system-name-no-eol coding-system) 'undecided)) + (setq coding-system buffer-file-coding-system)) + (or (cadr (assq (vm-coding-system-name-no-eol coding-system) + vm-mime-mule-coding-to-charset-alist)) + "us-ascii"))) + + +(defun vm-mime-can-convert-charset (charset) + (vm-mime-can-convert-charset-0 charset vm-mime-charset-converter-alist)) + +(defun vm-mime-can-convert-charset-0 (charset alist) + (let ((done nil)) + (while (and alist (not done)) + (cond ((and (vm-string-equal-ignore-case (car (car alist)) charset) + (vm-mime-charset-internally-displayable-p + (nth 1 (car alist)))) + (setq done t)) + (t (setq alist (cdr alist))))) + (and alist (car alist)))) + +;; This function from VM 7.19 is not being used anywhere. However, +;; see vm-mime-charset-convert-region for similar functionality. +;; USR, 2011-02-11 +(defun vm-mime-convert-undisplayable-charset (layout) + (let ((charset (vm-mime-get-parameter layout "charset")) + ooo work-buffer) + (setq ooo (vm-mime-can-convert-charset charset)) + (vm-inform 6 "Converting charset %s to %s..." + charset + (nth 1 ooo)) + (save-excursion + (setq work-buffer (vm-make-work-buffer " *mime object*")) + (vm-register-message-garbage 'kill-buffer work-buffer) + (set-buffer work-buffer) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (call-process-region (point-min) (point-max) shell-file-name + t t nil shell-command-switch (nth 2 ooo)) + (setq layout + (vm-make-layout + 'type (copy-sequence (vm-mm-layout-type layout)) + 'qtype (copy-sequence (vm-mm-layout-type layout)) + 'encoding "binary" + 'id (vm-mm-layout-id layout) + 'description (vm-mm-layout-description layout) + 'disposition (vm-mm-layout-disposition layout) + 'qdisposition (vm-mm-layout-qdisposition layout) + 'header-start (vm-marker (point-min)) + 'header-body (vm-marker (1- (point))) + 'body-start (vm-marker (point)) + 'body-end (vm-marker (point-max)) + 'cache (vm-mime-make-cache-symbol) + 'message-symbol (vm-mime-make-message-symbol + (vm-mm-layout-message layout)) + 'layout-is-converted t + 'onconverted-layout layout + )) + (vm-mime-set-parameter layout "charset" (nth 1 ooo)) + (vm-mime-set-qparameter layout "charset" (nth 1 ooo)) + (goto-char (point-min)) + (let ((vm-mime-avoid-folding-content-type t)) ; maybe no need + (insert-before-markers "Content-Type: " + (vm-mime-type-with-params + (car (vm-mm-layout-type layout)) + (cdr (vm-mm-layout-type layout))) + "\n")) + (insert-before-markers "Content-Transfer-Encoding: binary\n\n") + (set-buffer-modified-p nil) + (vm-inform 6 "Converting charset %s to %s... done" + charset + (nth 1 ooo)) + layout))) + +(defun vm-mime-charset-convert-region (charset b-start b-end) + (let ((b (current-buffer)) + start end oldsize work-buffer ooo ex) + (setq ooo (vm-mime-can-convert-charset charset)) + (setq work-buffer (vm-make-work-buffer " *mime object*")) + (unwind-protect + (with-current-buffer work-buffer + (setq oldsize (- b-end b-start)) + (set-buffer work-buffer) + (insert-buffer-substring b b-start b-end) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (let ((coding-system-for-write (vm-binary-coding-system)) + (coding-system-for-read (vm-binary-coding-system))) + (setq ex (call-process-region + (point-min) (point-max) shell-file-name + t t nil shell-command-switch (nth 2 ooo)))) + (unless (eq ex 0) + (vm-warn 0 1 "Conversion from %s to %s signalled exit code %s" + (nth 0 ooo) (nth 1 ooo) ex)) + ;; This cannot possibly safe. USR, 2011-02-11 + ;; (if vm-fsfemacs-mule-p + ;; (set-buffer-multibyte t)) + (setq start (point-min) end (point-max)) + (with-current-buffer b + (save-excursion + (goto-char b-start) + (insert-buffer-substring work-buffer start end) + (delete-region (point) (+ (point) oldsize)))) + (nth 1 ooo)) + ;; unwind-protection + (when work-buffer (kill-buffer work-buffer))))) + +(defun* vm-mime-should-display-button (layout &key + (honor-content-disposition t)) + "Checks whether MIME object with LAYOUT should be displayed as +a button. Optional keyword argument HONOR-CONTENT-DISPOSITION +says whether the Content-Disposition header of the MIME object +should be honored (default t). The global setting of +`vm-mime-honor-content-disposition' also has this effect." + ;; Karnaugh map analysis shows that + ;; - attachment disposition objects should be buttons + ;; - all auto-displayed objects should not be buttons + ;; - inline objects should be displayed if honor = t or + ;; honor = internal-only and the object is internal-displayable + ;; - all other cases should be buttons + (let ((type (car (vm-mm-layout-type layout))) + (disposition (car (vm-mm-layout-disposition layout)))) + (setq disposition (and disposition (downcase disposition))) + (setq honor-content-disposition + (and honor-content-disposition vm-mime-honor-content-disposition)) + (cond ((vm-mime-types-match "multipart" type) + nil) + ((equal disposition "attachment") + t) + ((eq disposition "inline") + (cond ((eq honor-content-disposition 'internal-only) + (not (or (vm-mime-should-auto-display layout) + (vm-mime-should-display-internal layout)))) + ((eq honor-content-disposition t) + nil) + (t + (not (vm-mime-should-auto-display layout))))) + (t + (not (vm-mime-should-auto-display layout)))))) + +(defun vm-mime-should-auto-display (layout) + (let ((type (car (vm-mm-layout-type layout)))) + (and (or (eq vm-mime-auto-displayed-content-types t) + (vm-find (cons "multipart" vm-mime-auto-displayed-content-types) + (lambda (i) (vm-mime-types-match i type)))) + (not (vm-find vm-mime-auto-displayed-content-type-exceptions + (lambda (i) (vm-mime-types-match i type))))))) + +(defun vm-mime-should-display-internal (layout) + (let ((type (car (vm-mm-layout-type layout)))) + (if (or (eq vm-mime-internal-content-types t) + (vm-find (cons "multipart" vm-mime-internal-content-types) + (lambda (i) + (vm-mime-types-match i type)))) + (not (vm-find vm-mime-internal-content-type-exceptions + (lambda (i) + (vm-mime-types-match i type)))) + nil))) + +(defun vm-mime-find-external-viewer (type) + (catch 'done + (let ((list vm-mime-external-content-type-exceptions) + (matched nil)) + (while list + (if (vm-mime-types-match (car list) type) + (throw 'done nil) + (setq list (cdr list)))) + (setq list vm-mime-external-content-types-alist) + (while (and list (not matched)) + (if (and (vm-mime-types-match (car (car list)) type) + (cdr (car list))) + (setq matched (cdr (car list))) + (setq list (cdr list)))) + matched ))) +(fset 'vm-mime-can-display-external 'vm-mime-find-external-viewer) + +(defun vm-mime-delete-button-maybe (extent) + (let ((buffer-read-only)) + ;; if displayed MIME object should replace the button + ;; remove the button now. + (cond ((vm-extent-property extent 'vm-mime-disposable) + (delete-region (vm-extent-start-position extent) + (vm-extent-end-position extent)) + (vm-detach-extent extent))))) + +;;------------------------------------------------------------------------------ +;;; MIME decoding +;;------------------------------------------------------------------------------ + + +;;;###autoload +(defun vm-decode-mime-message (&optional state) + "Decode the MIME objects in the current message. + +The first time this command is run on a message, decoding is done. +The second time, buttons for all the objects are displayed instead. +The third time, the raw, undecoded data is displayed. + +The optional argument STATE can specify which decode state to display: +'decoded, 'button or 'undecoded. + +If decoding, the decoded objects might be displayed immediately, or +buttons might be displayed that you need to activate to view the +object. See the documentation for the variables + + vm-mime-auto-displayed-content-types + vm-mime-auto-displayed-content-type-exceptions + vm-mime-internal-content-types + vm-mime-internal-content-type-exceptions + vm-mime-external-content-types-alist + +to see how to control whether you see buttons or objects. + +If the variable vm-mime-display-function is set, then its value +is called as a function with no arguments, and none of the +actions mentioned in the preceding paragraphs are taken. At the +time of the call, the current buffer will be the presentation +buffer for the folder and a copy of the current message will be +in the buffer. The function is expected to make the message +`MIME presentable' to the user in whatever manner it sees fit." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (unless (or vm-display-using-mime vm-mime-display-function) + (error "MIME display disabled, set vm-display-using-mime non-nil to enable.")) + (if vm-mime-display-function + (progn + (vm-make-presentation-copy (car vm-message-pointer)) + (set-buffer vm-presentation-buffer) + (funcall vm-mime-display-function) + ;; We are done here + ) + (when (null state) + (cond ((null vm-mime-decoded) + (setq state 'decoded)) + ((eq vm-mime-decoded 'decoded) + (setq state 'buttons)) + ((eq vm-mime-decoded 'buttons) + (setq state 'undecoded)))) + (if vm-mime-decoded + (cond ((eq state 'buttons) + (let ((vm-preview-lines nil) + (vm-auto-decode-mime-messages t) + (vm-mime-honor-content-disposition nil) + (vm-mime-auto-displayed-content-types '("multipart")) + (vm-mime-auto-displayed-content-type-exceptions nil)) + (setq vm-mime-decoded nil) + (intern (buffer-name) vm-buffers-needing-display-update) + (save-excursion + (vm-present-current-message)) + (setq vm-mime-decoded 'buttons))) + ((eq state 'undecoded) + (let ((vm-preview-lines nil) + (vm-auto-decode-mime-messages nil)) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-present-current-message)))) + (let ((layout (vm-mm-layout (car vm-message-pointer))) + (m (car vm-message-pointer))) + (vm-emit-mime-decoding-message "Decoding MIME message...") + (when (stringp layout) + (error "Invalid MIME message: %s" layout)) + (when (vm-mime-plain-message-p m) + (error "Message needs no decoding.")) + (if (not vm-presentation-buffer) + ;; maybe user killed it - make a new one + (progn + (vm-make-presentation-copy (car vm-message-pointer)) + (vm-expose-hidden-headers)) + (set-buffer vm-presentation-buffer)) + ;; Are we now in the Presentation buffer? Why? USR, 2010-05-08 + (when (and (vm-interactive-p) (eq vm-system-state 'previewing)) + (let ((vm-display-using-mime nil)) + (vm-show-current-message))) + (setq m (car vm-message-pointer)) + (vm-save-restriction + (widen) + (goto-char (vm-text-of m)) + (let ((buffer-read-only nil) + (modified (buffer-modified-p))) + (unwind-protect + (save-excursion + (unless (eq (vm-mm-encoded-header m) 'none) + (vm-decode-mime-message-headers m)) + (when (vectorp layout) + (vm-decode-mime-layout layout) + ;; Delete the original presentation copy + (delete-region (point) (point-max))) + (vm-energize-urls) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)) + (set-buffer-modified-p modified)))) + (save-excursion (set-buffer vm-mail-buffer) + (setq vm-mime-decoded 'decoded)) + (intern (buffer-name vm-mail-buffer) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (vm-emit-mime-decoding-message "Decoding MIME message... done")))) + (vm-display nil nil '(vm-decode-mime-message) + '(vm-decode-mime-message reading-message))) + +(defun vm-mime-get-disposition-filename (layout) + (let ((filename nil) + (case-fold-search t)) + (setq filename (or (vm-mime-get-disposition-parameter layout "filename") + (vm-mime-get-disposition-parameter layout "name"))) + (when (not filename) + (setq filename (or (vm-mime-get-disposition-parameter layout "filename*") + (vm-mime-get-disposition-parameter layout "name*"))) + ;; decode encoded filenames + (when (and filename + (string-match "^\\([^']+\\)'\\([^']*\\)'\\(.*%[0-9A-F][0-9A-F].*\\)$" + filename)) + ;; transform it to something we are already able to decode + (let ((charset (match-string 1 filename)) + (f (match-string 3 filename))) + (setq f (vm-replace-in-string f "%\\([0-9A-F][0-9A-F]\\)" "=\\1")) + (setq filename (concat "=?" charset "?Q?" f "?=")) + (setq filename (vm-decode-mime-encoded-words-in-string filename))))) + filename)) + +(defun vm-mime-rewrite-with-inferred-type (layout type2) + (vm-set-mm-layout-type layout (list type2)) + (vm-set-mm-layout-qtype layout (list (concat "\"" type2 "\"")))) + +(defun vm-decode-mime-layout (layout &optional dont-honor-c-d) + "Decode the MIME part in the current buffer using LAYOUT. +If DONT-HONOR-C-D non-Nil, then don't honor the Content-Disposition +declarations in the attachments and make a decision independently. + +LAYOUT can be a mime layout vector. It can also be a button +extent in the current buffer, in which case the 'vm-mime-layout +property of the overlay will be extracted. The button may be +deleted. + +Returns t if the display was successful. Not clear what happens if it +is not successful. USR, 2011-03-25" + (let ((modified (buffer-modified-p)) + handler new-layout file type inf-type type-no-subtype inf-type-no-subtype + (extent nil)) + (unless (vectorp layout) + ;; handle a button extent + (setq extent layout + layout (vm-extent-property extent 'vm-mime-layout)) + (goto-char (vm-extent-start-position extent)) + ;; if the button is for external-body, use the external-body + (setq type (downcase (car (vm-mm-layout-type layout)))) + (when (vm-mime-types-match "message/external-body" type) + (setq layout (car (vm-mm-layout-parts layout))))) + (unwind-protect + (progn + (setq type (downcase (car (vm-mm-layout-type layout))) + type-no-subtype (car (vm-parse type "\\([^/]+\\)")) + file (vm-mime-get-disposition-filename layout) + inf-type (when (and vm-infer-mime-types file) + (vm-mime-default-type-from-filename file))) + (when inf-type + (setq inf-type (downcase inf-type) + inf-type-no-subtype (car (vm-parse inf-type "\\([^/]+\\)")))) + (cond ((and vm-infer-mime-types inf-type + (or (and vm-infer-mime-types-for-text + (vm-mime-types-match "text/plain" type)) + (vm-mime-types-match "application/octet-stream" type)) + (not (vm-mime-types-match type inf-type))) + (vm-mime-rewrite-with-inferred-type layout inf-type) + (setq type (downcase (car (vm-mm-layout-type layout))) + type-no-subtype (car (vm-parse type "\\([^/]+\\)"))))) + (cond + ((and (vm-mime-should-display-button + layout :honor-content-disposition (not dont-honor-c-d)) + ;; original conditional-cases changed to fboundp + ;; checks. USR, 2011-03-25 + (or (fboundp + (setq handler (vm-mime-handler + "display-button" type))) + (fboundp + (setq handler (vm-mime-handler + "display-button" type-no-subtype))) + + (setq handler 'vm-mime-display-button-application)) + + (funcall handler layout)) + ;; if the handler returns t, we are done + ) + ((and vm-infer-mime-types inf-type + (vm-mime-should-display-button + layout :honor-content-disposition (not dont-honor-c-d)) + (or (fboundp + (setq handler (vm-mime-handler + "display-button" inf-type))) + (fboundp + (setq handler (vm-mime-handler + "display-button" + inf-type-no-subtype)))) + (funcall handler layout)) + ;; if the handler returns t, overwrite the layout type + (vm-mime-rewrite-with-inferred-type layout inf-type)) + ((and (vm-mime-should-display-internal layout) + (or (fboundp + (setq handler (vm-mime-handler + "display-internal" type))) + (fboundp + (setq handler (vm-mime-handler + "display-internal" type-no-subtype)))) + (funcall handler layout)) + ;; if the handler returns t, we are done + ) + ((and vm-infer-mime-types inf-type + (vm-mime-should-display-internal layout) + (or (fboundp + (setq handler (vm-mime-handler + "display-internal" inf-type))) + (fboundp + (setq handler (vm-mime-handler + "display-internal" + inf-type-no-subtype)))) + (funcall handler layout)) + ;; if the handler returns t, overwrite the layout type + (vm-mime-rewrite-with-inferred-type layout inf-type)) + ((vm-mime-types-match "multipart" type) + (if (fboundp + (setq handler (vm-mime-handler "display-internal" type))) + (funcall handler layout) + (vm-mime-display-internal-multipart/mixed layout)) + ) + ((and (vm-mime-find-external-viewer type) + (vm-mime-display-external-generic layout)) + ;; external viewer worked. the button should go away. + (when extent (vm-set-extent-property + extent 'vm-mime-disposable nil)) + ) + ((and (not (vm-mm-layout-is-converted layout)) + (vm-mime-can-convert type) + (setq new-layout + (vm-mime-convert-undisplayable-layout layout))) + ;; conversion worked. the button should go away. + (when extent + (vm-set-extent-property extent 'vm-mime-disposable t)) + (vm-decode-mime-layout new-layout) + ) + (t + (when extent (vm-mime-rewrite-failed-button + extent + (or (vm-mm-layout-display-error layout) + "no external viewer defined for type"))) + (cond ((vm-mime-types-match "message/external-body" type) + (if (null extent) + (vm-mime-display-button-xxxx layout t) + (setq extent nil))) + ((vm-mime-types-match "application/octet-stream" type) + (vm-mime-display-internal-application/octet-stream + (or extent layout))) + ;; if everything else fails, just display a button + (t + (vm-set-mm-layout-display-error + layout "Unknown MIME type") + (vm-mime-display-button-application layout)) + ) + )) + (when extent (vm-mime-delete-button-maybe extent))) + ;; unwind-protection + (set-buffer-modified-p modified))) + t ) + +(defun vm-mime-display-button-text (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-internal-text (layout) + (vm-mime-display-internal-text/plain layout)) + +(defun vm-mime-cid-retrieve (url message) + "Insert a content pointed by URL if it has the cid: scheme." + (if (string-match "\\`cid:" url) + (setq url (concat "<" (substring url (match-end 0)) ">")) + (error "%S is not a cid url" url)) + (let ((part-list (vm-mm-layout-parts (vm-mm-layout message))) + part) + (while part-list + (setq part (car part-list)) + (if (vm-mime-composite-type-p (car (vm-mm-layout-type part))) + (setq part-list (nconc (copy-sequence (vm-mm-layout-parts part)) + (cdr part-list)))) + (setq part-list (cdr part-list)) + (if (not (equal url (vm-mm-layout-id part))) + (setq part nil) + (vm-mime-insert-mime-body part) + (setq part-list nil))) + (unless part + (vm-inform 5 "No data for cid %S" url)) + part)) + +(defun vm-mime-display-internal-w3m-text/html (start end layout) + (let ((charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) + (shell-command-on-region + start (1- end) + (format "w3m -dump -T text/html -I %s -O %s" charset charset) + nil t))) + +(defun vm-mime-display-internal-lynx-text/html (start end layout) + (shell-command-on-region start (1- end) +;; "lynx -force_html /dev/stdin" + "lynx -force_html -dump -pseudo_inlines -stdin" + nil t)) + +(defun vm-mime-display-internal-text/html (layout) + "Dispatch handling of html to the actual html handler." + ;; If the user has set the vm-mime-text/html-handler _variable_ to + ;; 'auto-select, and it is left set that way in this function, we will get a + ;; failure because there is no function called + ;; "vm-mime-display-internal-auto-select-text/html". But, the + ;; vm-mime-text/html-handler _function_ sets the corresponding _variable_ + ;; based upon a heuristic about available packages, so call it for its + ;; side-effect now. -- Brent Goodrick, 2008-12-08 + (vm-mime-text/html-handler) + (if vm-mime-text/html-handler + (condition-case error-data + (let ((buffer-read-only nil) + (start (point)) + (charset (or (vm-mime-get-parameter layout "charset") + "us-ascii")) + end buffer-size) + (vm-emit-mime-decoding-message + "Inlining text/html by %s..." vm-mime-text/html-handler) + (vm-mime-insert-mime-body layout) + (unless (bolp) (insert "\n")) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (vm-mime-charset-decode-region charset start end) + ;; block remote images by prefixing the link + (goto-char start) + (let ((case-fold-search t)) + (while (re-search-forward vm-mime-text/html-blocker end t) + (goto-char (match-end 0)) + (if (or t + (and vm-mime-text/html-blocker-exceptions + (looking-at vm-mime-text/html-blocker-exceptions)) + (looking-at "cid:")) + (progn + ;; TODO: write the image to a file and replace the link + ) + (insert "blocked:")))) + ;; w3-region apparently deletes all the text in the + ;; region and then insert new text. This makes the + ;; end == start. The fix is to move the end marker + ;; forward with a placeholder character so that when + ;; w3-region delete all the text, end will still be + ;; ahead of the insertion point and so will be moved + ;; forward when the new text is inserted. We'll + ;; delete the placeholder afterward. + (goto-char end) + (insert-before-markers "z") + ;; the view port (scrollbar) is sometimes messed up, try to avoid it + (save-window-excursion + ;; dispatch to actual handler + (funcall (intern (format "vm-mime-display-internal-%s-text/html" + vm-mime-text/html-handler)) + start end layout)) + ;; do clean up + (goto-char end) + (delete-char -1) + (vm-inform 6 "Inlining text/html by %s... done." + vm-mime-text/html-handler) + t) + (error (vm-set-mm-layout-display-error + layout + (format "Inline text/html by %s display failed: %s" + vm-mime-text/html-handler + (error-message-string error-data))) + (vm-warn 0 2 "%s" (vm-mm-layout-display-error layout)) + nil)) + ;; no handler + (vm-warn 0 2 "No handler available for internal display of text/html") + nil)) + + +(defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) + "Display a text/plain mime part given by LAYOUT, carrying out +any necessary MIME-decoding, CRLF-conversion, charset-conversion +and word-wrapping/filling. The original text is replaced by the +converted content. Unless NO-HIGHLIGHTING is non-nil, the URL's +in the text are highlighted and energized." + (let ((start (point)) end need-conversion + (buffer-read-only nil) + (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) + (if (and (not (vm-mime-charset-internally-displayable-p charset)) + (not (setq need-conversion (vm-mime-can-convert-charset charset)))) + (progn + (vm-set-mm-layout-display-error + layout (concat "Undisplayable charset: " charset)) + (vm-warn 0 2 "%s" (vm-mm-layout-display-error layout)) + nil) + (vm-mime-insert-mime-body layout) + (unless (bolp) (insert "\n")) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (when need-conversion + (setq charset (vm-mime-charset-convert-region charset start end))) + (vm-mime-charset-decode-region charset start end) + (unless no-highlighting (vm-energize-urls-in-message-region start end)) + (when (and (or vm-word-wrap-paragraphs + vm-fill-paragraphs-containing-long-lines) + (not no-highlighting)) + (vm-fill-paragraphs-containing-long-lines + vm-fill-paragraphs-containing-long-lines start end)) + (goto-char end) + t ))) + +(defun vm-mime-display-internal-text/enriched (layout) + (require 'enriched) + (let ((start (point)) end + (buffer-read-only nil) + (enriched-verbose t) + (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) + (vm-emit-mime-decoding-message "Decoding text/enriched...") + (vm-mime-insert-mime-body layout) + (unless (bolp) (insert "\n")) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (vm-mime-charset-decode-region charset start end) + ;; enriched-decode expects a couple of headers at the top of + ;; the region and will remove anything that looks like a + ;; header. Put a header section here for it to eat so it + ;; won't eat message text instead. + (goto-char start) + (insert "Comment: You should not see this header\n\n") + (condition-case errdata + (enriched-decode start end) + (error (vm-set-mm-layout-display-error + layout (format "enriched-decode signaled %s" errdata)) + (vm-warn 0 2 "%s" (vm-mm-layout-display-error layout)) + nil )) + (vm-energize-urls-in-message-region start end) + (goto-char end) + (vm-emit-mime-decoding-message "Decoding text/enriched... done") + t )) + +(defun vm-mime-display-external-generic (layout) + "Display mime object with LAYOUT in an external viewer, as +determined by `vm-mime-external-content-types-alist'." + ;; Optional argument FILE indicates that the content should be + ;; taken from it. + (let ((program-list (copy-sequence + (vm-mime-find-external-viewer + (car (vm-mm-layout-type layout))))) + (buffer-read-only nil) + start + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (append-file t) + process tempfile cache end suffix basename) + (setq cache (get (vm-mm-layout-cache layout) + 'vm-mime-display-external-generic) + process (nth 0 cache) + tempfile (nth 1 cache)) + (if (and (processp process) (eq (process-status process) 'run)) + t + (cond ((or (null tempfile) (null (file-exists-p tempfile))) + (setq suffix (vm-mime-extract-filename-suffix layout) + suffix (or suffix + (vm-mime-find-filename-suffix-for-type layout))) + (setq basename (vm-mime-get-disposition-filename layout)) + (setq tempfile (vm-make-tempfile suffix basename)) + (vm-register-message-garbage-files (list tempfile)) + (vm-mime-send-body-to-file layout nil tempfile t))) + + (if (symbolp (car program-list)) + ;; use internal function if provided + (apply (car program-list) + (append (cdr program-list) (list tempfile))) + + ;; quote file name for shell command only + (or (cdr program-list) + (setq tempfile (shell-quote-argument tempfile))) + + ;; expand % specs + (let ((p program-list) + (vm-mf-attachment-file tempfile)) + (while p + (if (string-match "\\([^%]\\|^\\)%f" (car p)) + (setq append-file nil)) + (setcar p (vm-mime-sprintf (car p) layout)) + (setq p (cdr p)))) + + (vm-inform 6 "Launching %s..." (mapconcat 'identity program-list " ")) + (setq process + (if (cdr program-list) + (apply 'start-process + (format "view %25s" + (vm-mime-sprintf + (vm-mime-find-format-for-layout layout) + layout)) + nil (if append-file + (append program-list (list tempfile)) + program-list)) + (apply 'start-process + (format "view %25s" + (vm-mime-sprintf + (vm-mime-find-format-for-layout layout) + layout)) + nil + (or shell-file-name "sh") + shell-command-switch + (if append-file + (list (concat (car program-list) " " tempfile)) + program-list)))) + (vm-process-kill-without-query process t) + (vm-inform 6 "Launching %s... done" (mapconcat 'identity + program-list + " ")) + (if vm-mime-delete-viewer-processes + (vm-register-message-garbage 'delete-process process)) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-external-generic + (list process tempfile))))) + t ) + +(defun vm-mime-display-internal-application/octet-stream (layout) + "Display a button for the MIME LAYOUT. If a button extent is +given as the argument instead, then nothing is done. USR, 2011-03-25" + (if (vectorp layout) + (let ((buffer-read-only nil) + (vm-mf-default-action "save")) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action + (function + (lambda (layout) + (save-excursion + (vm-mime-save-application/octet-stream layout)))) + :layout layout))) + t) + +(defun vm-mime-save-application/octet-stream (layout) + "Save an application/octet-stream object with LAYOUT to the +stated filename. A button extent with a layout can also be given as +the argument. USR, 2011-03-25" + (unless (vectorp layout) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + ;; support old "name" paramater for application/octet-stream + ;; but don't override the "filename" parameter extracted from + ;; Content-Disposition, if any. + (let ((default-filename (vm-mime-get-disposition-filename layout)) + (file nil)) + (setq file (vm-mime-send-body-to-file layout default-filename)) + (when (and file vm-mime-delete-after-saving) + (let ((vm-mime-confirm-delete nil)) + ;; we don't care if the delete fails + (condition-case nil + (vm-delete-mime-object (expand-file-name file)) + (error nil))))) + t ) +(fset 'vm-mime-display-button-application/octet-stream + 'vm-mime-display-internal-application/octet-stream) + +(defun vm-mime-display-button-application (layout) + "Display button for an application type object described by LAYOUT." + (vm-mime-display-button-xxxx layout nil)) + + +(defun vm-mime-display-button-audio (layout) + (vm-mime-display-button-xxxx layout nil)) + +(defun vm-mime-display-button-video (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-button-message (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-button-multipart (layout) + (vm-mime-display-button-xxxx layout t)) + +(defun vm-mime-display-internal-multipart/mixed (layout) + (let ((part-list (vm-mm-layout-parts layout))) + (while part-list + (let ((part (car part-list))) + (vm-decode-mime-layout part) + (setq part-list (cdr part-list)) + ;; we always put separator because it is cleaner, and buttons + ;; may get expanded to documents in any case. USR, 2011-02-09 + (when part-list + (insert vm-mime-parts-display-separator)))) + t)) + + +(defun vm-mime-display-internal-multipart/alternative (layout) + (if (eq vm-mime-alternative-show-method 'all) + (vm-mime-display-internal-multipart/mixed layout) + (vm-mime-display-internal-show-multipart/alternative layout))) + +(defun vm-mime-display-internal-show-multipart/alternative (layout) + (let (best-layout) + (cond ((eq vm-mime-alternative-show-method 'best) + (let ((done nil) + (best nil) + part-list type) + (setq part-list (vm-mm-layout-parts layout) + part-list (nreverse (copy-sequence part-list))) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (if (or (vm-mime-can-display-internal (car part-list) t) + (vm-mime-find-external-viewer type)) + (setq best (car part-list) + done t) + (setq part-list (cdr part-list)))) + (setq best-layout (or best (car (vm-mm-layout-parts layout)))))) + ((eq vm-mime-alternative-show-method 'best-internal) + (let ((done nil) + (best nil) + (second-best nil) + part-list type) + (setq part-list (vm-mm-layout-parts layout) + part-list (nreverse (copy-sequence part-list))) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (cond ((and (vm-mime-can-display-internal (car part-list) t) + (vm-mime-should-display-internal (car part-list))) + (setq best (car part-list) + done t)) + ((and (null second-best) + (vm-mime-find-external-viewer type)) + (setq second-best (car part-list)))) + (setq part-list (cdr part-list))) + (setq best-layout (or best second-best + (car (vm-mm-layout-parts layout)))))) + ((and (consp vm-mime-alternative-show-method) + (eq (car vm-mime-alternative-show-method) + 'favorite-internal)) + (let ((done nil) + (best nil) + (saved-part-list + (nreverse (copy-sequence (vm-mm-layout-parts layout)))) + (favs (cdr vm-mime-alternative-show-method)) + (second-best nil) + part-list type) + (while (and favs (not done)) + (setq part-list saved-part-list) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (cond ((or (vm-mime-can-display-internal (car part-list) t) + (vm-mime-find-external-viewer type)) + (if (vm-mime-types-match (car favs) type) + (setq best (car part-list) + done t) + (or second-best + (setq second-best (car part-list)))))) + (setq part-list (cdr part-list))) + (setq favs (cdr favs))) + (setq best-layout (or best second-best + (car (vm-mm-layout-parts layout)))))) + ((and (consp vm-mime-alternative-show-method) + (eq (car vm-mime-alternative-show-method) 'favorite)) + (let ((done nil) + (best nil) + (saved-part-list + (nreverse (copy-sequence (vm-mm-layout-parts layout)))) + (favs (cdr vm-mime-alternative-show-method)) + (second-best nil) + part-list type) + (while (and favs (not done)) + (setq part-list saved-part-list) + (while (and part-list (not done)) + (setq type (car (vm-mm-layout-type (car part-list)))) + (cond ((and (vm-mime-can-display-internal (car part-list) t) + (vm-mime-should-display-internal (car part-list))) + (if (vm-mime-types-match (car favs) type) + (setq best (car part-list) + done t) + (or second-best + (setq second-best (car part-list)))))) + (setq part-list (cdr part-list))) + (setq favs (cdr favs))) + (setq best-layout (or best second-best + (car (vm-mm-layout-parts layout))))))) + (when best-layout + (vm-decode-mime-layout best-layout)))) + +(defun vm-mime-display-internal-multipart/related (layout) + "Decode multipart/related body parts. +This function decodes the ``start'' part (see RFC2387) only. The +other parts will be decoded by the other VM functions through +emacs-w3m." + (let* ((part-list (vm-mm-layout-parts layout)) + (start-part (car part-list)) + (start-id (vm-mime-get-parameter layout "start")) + layout) + ;; Look for the start part. + (if start-id + (while part-list + (setq layout (car part-list)) + (if (equal start-id (vm-mm-layout-id layout)) + (setq start-part layout + part-list nil) + (setq part-list (cdr part-list))))) + (if start-part (vm-decode-mime-layout start-part)))) + +(defun vm-mime-display-button-multipart/parallel (layout) + (vm-mime-insert-button + :caption + (concat + ;; display the file name or disposition + (let ((file (vm-mime-get-disposition-filename layout))) + (if file (format " %s " file) "")) + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) ) + :action + (function + (lambda (layout) + (save-excursion + (let ((vm-mime-auto-displayed-content-types t) + (vm-mime-auto-displayed-content-type-exceptions nil)) + (vm-decode-mime-layout layout t))))) + :layout layout + :disposable t)) + +(fset 'vm-mime-display-internal-multipart/parallel + 'vm-mime-display-internal-multipart/mixed) + +(defun vm-mime-display-internal-multipart/digest (layout) + (if (vectorp layout) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-multipart/digest layout)))) + :layout layout)) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout)) + (set-buffer (generate-new-buffer (format "digest from %s/%s" + (buffer-name vm-mail-buffer) + (vm-number-of + (car vm-message-pointer))))) + (setq vm-folder-type vm-default-folder-type) + (let ((ident-header nil)) + (if vm-digest-identifier-header-format + (setq ident-header (vm-summary-sprintf + vm-digest-identifier-header-format + (vm-mm-layout-message layout)))) + (vm-mime-burst-layout layout ident-header)) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode) + (if (vm-should-generate-summary) + (progn + (vm-goto-new-summary-frame-maybe) + (vm-summarize)))) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + t ) + +(fset 'vm-mime-display-button-multipart/digest + 'vm-mime-display-internal-multipart/digest) + +(defun vm-mime-display-button-message/rfc822 (layout) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-message/rfc822 layout)))) + :layout layout))) + +(fset 'vm-mime-display-button-message/news + 'vm-mime-display-button-message/rfc822) + +(defun vm-mime-display-internal-message/rfc822 (layout) + (if (vectorp layout) + (let ((start (point)) + (buffer-read-only nil)) + (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout))) + (insert ?\n) + (save-excursion + (goto-char start) + (vm-reorder-message-headers + nil :keep-list vm-visible-headers + :discard-regexp vm-invisible-header-regexp)) + (save-restriction + (narrow-to-region start (point)) + (vm-decode-mime-encoded-words)) + (vm-mime-display-internal-multipart/mixed layout)) + (goto-char (vm-extent-start-position layout)) + (setq layout (vm-extent-property layout 'vm-mime-layout)) + (set-buffer (vm-generate-new-unibyte-buffer + (format "message from %s/%s" + (buffer-name vm-mail-buffer) + (vm-number-of + (car vm-message-pointer))))) + (setq vm-folder-type vm-default-folder-type) + (vm-mime-burst-layout layout nil) + (set-buffer-modified-p nil) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode) + (if (vm-should-generate-summary) + (progn + (vm-goto-new-summary-frame-maybe) + (vm-summarize)))) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + t ) +(fset 'vm-mime-display-internal-message/news + 'vm-mime-display-internal-message/rfc822) + +(defun vm-mime-display-internal-message/delivery-status (layout) + (vm-mime-display-internal-text/plain layout t)) + +(defun vm-mime-retrieve-external-body (layout) + "Fetch an external body into the current buffer. +LAYOUT is the MIME layout struct for the message/external-body object." + (let ((access-method (downcase (vm-mime-get-parameter layout "access-type"))) + (work-buffer (current-buffer))) + (cond ((string= access-method "local-file") + (let ((name (vm-mime-get-parameter layout "name"))) + (if (null name) + (vm-mime-error + "%s access type missing `name' parameter" + access-method)) + (if (not (file-exists-p name)) + (vm-mime-error "file %s does not exist" name)) + (condition-case data + (insert-file-contents-literally name) + (error (signal 'vm-mime-error (cdr data)))))) + ((and (string= access-method "url") + vm-url-retrieval-methods) + (defvar w3-configuration-directory) ; for bytecompiler + (let ((url (vm-mime-get-parameter layout "url")) + ;; needed or url-retrieve will bitch + (w3-configuration-directory + (if (boundp 'w3-configuration-directory) + w3-configuration-directory + "~"))) + (if (null url) + (vm-mime-error + "%s access type missing `url' parameter" + access-method)) + (setq url (vm-with-string-as-temp-buffer + url + (function + (lambda () + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]" nil t) + (delete-char -1)))))) + (vm-mime-fetch-url-with-programs url work-buffer))) + ((and (or (string= access-method "ftp") + (string= access-method "anon-ftp")) + (or (fboundp 'efs-file-handler-function) + (fboundp 'ange-ftp-hook-function))) + (let ((name (vm-mime-get-parameter layout "name")) + (directory (vm-mime-get-parameter layout "directory")) + (site (vm-mime-get-parameter layout "site")) + user) + (if (null name) + (vm-mime-error + "%s access type missing `name' parameter" + access-method)) + (if (null site) + (vm-mime-error + "%s access type missing `site' parameter" + access-method)) + (cond ((string= access-method "ftp") + (setq user (read-string + (format "User name to access %s: " + site) + (user-login-name)))) + (t (setq user "anonymous"))) + (if (and (string= access-method "ftp") + vm-url-retrieval-methods + (vm-mime-fetch-url-with-programs + (if directory + (concat "ftp:////" site "/" + directory "/" name) + (concat "ftp:////" site "/" name)) + work-buffer)) + t + (cond (directory + (setq directory + (concat "/" user "@" site ":" directory)) + (setq name (expand-file-name name directory))) + (t + (setq name (concat "/" user "@" site ":" + name)))) + (condition-case data + (insert-file-contents-literally name) + (error (signal 'vm-mime-error + (format "%s" (cdr data))))))))))) + +(defun vm-mime-fetch-message/external-body (layout) + "Fetch the external-body content described by LAYOUT and store +it in an internal buffer. Update the LAYOUT so that it refers to the +fetched content." + (let ((child-layout (car (vm-mm-layout-parts layout))) + (access-method (downcase (vm-mime-get-parameter layout "access-type"))) + ob + (work-buffer nil)) + (unwind-protect + (cond + ((and (string= access-method "mail-server") + (vm-mm-layout-id child-layout) + (setq ob (vm-mime-find-leaf-content-id-in-layout-folder + layout (vm-mm-layout-id child-layout)))) + (setq child-layout ob)) + ((eq (marker-buffer (vm-mm-layout-header-start child-layout)) + (marker-buffer (vm-mm-layout-body-start child-layout))) + ;; if the "body" is in the same buffer, that means that the + ;; external-body has not been retrieved yet + (setq work-buffer + (vm-make-multibyte-work-buffer + (format "*%s mime object*" + (car (vm-mm-layout-type child-layout))))) + (condition-case data + (with-current-buffer work-buffer + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system + (vm-binary-coding-system) t)) + (cond + ((or (string= access-method "ftp") + (string= access-method "anon-ftp") + (string= access-method "local-file") + (string= access-method "url")) + (vm-mime-retrieve-external-body layout)) + ((string= access-method "mail-server") + (let ((server (vm-mime-get-parameter layout "server")) + (subject (vm-mime-get-parameter layout "subject"))) + (if (null server) + (vm-mime-error + "%s access type missing `server' parameter" + access-method)) + (if (not + (y-or-n-p + (format + "Send message to %s to retrieve external body? " + server))) + (error "Aborted")) + (vm-mail-internal + :buffer-name (format "mail to MIME mail server %s" server) + :to server :subject subject) + (mail-text) + (vm-mime-insert-mime-body child-layout) + (let ((vm-confirm-mail-send nil)) + (vm-mail-send)) + (vm-warn 0 2 + (concat "Retrieval message sent. " + "Retry viewing this object after " + "the response arrives.")))) + (t + (vm-mime-error "unsupported access method: %s" + access-method)) + ) + (when child-layout + (vm-set-mm-layout-body-end + child-layout (vm-marker (point-max))) + (vm-set-mm-layout-body-start + child-layout (vm-marker (point-min))))) + (vm-mime-error ; handler + ;; (vm-warn 0 2 (format "Error in retrieving: %s" (cdr data))) + (vm-set-mm-layout-display-error layout (cdr data)) + (setq child-layout nil))))) + ;; unwind-protections + (when work-buffer + (if child-layout ; refers to work-buffer + (vm-register-folder-garbage 'kill-buffer work-buffer) + (kill-buffer work-buffer)))))) + +(defun vm-mime-display-external-message/external-body (layout) + "Display the external-body content described by LAYOUT." + (vm-mime-fetch-message/external-body layout) + (let ((child-layout (car (vm-mm-layout-parts layout)))) + (when child-layout + (vm-mime-display-external-generic child-layout)))) + +(defun vm-mime-display-internal-message/external-body (layout + &optional extent) + "Display the external-body content described by LAYOUT. The +optional argument EXTENT, if present, gives the extent of the MIME +button that this LAYOUT comes from." + (vm-mime-fetch-message/external-body layout) + (let ((child-layout (car (vm-mm-layout-parts layout)))) + (when child-layout + (vm-decode-mime-layout (or extent child-layout))))) + +(defun vm-mime-display-button-message/external-body (layout) + "Return a button usable for viewing message/external-body MIME parts." + (let ((buffer-read-only nil) + (tmplayout (copy-tree (car (vm-mm-layout-parts layout)) t)) + (filename "external: ") + format) + (when (vm-mime-get-parameter layout "name") + (setq filename + (concat filename + (file-name-nondirectory + (vm-mime-get-parameter layout "name"))))) + (vm-mime-set-parameter tmplayout "name" filename) + (vm-mime-set-xxx-parameter "filename" filename + (vm-mm-layout-disposition tmplayout)) + (setq format (vm-mime-find-format-for-layout tmplayout)) + (vm-mime-insert-button + :caption + (vm-replace-in-string + (vm-mime-sprintf format tmplayout) + "save\\]" + "display]") + :action + (function + (lambda (extent) + ;; reuse the internal display code, but make sure that no new + ;; buttons should be created for the external-body content. + (let ((layout (if vm-xemacs-p + (vm-extent-property extent 'vm-mime-layout) + (overlay-get extent 'vm-mime-layout))) + (vm-mime-auto-displayed-content-types t) + (vm-mime-auto-displayed-content-type-exceptions nil)) + (vm-mime-display-internal-message/external-body + layout extent)))) + :layout layout))) + + +(defun vm-mime-fetch-url-with-programs (url buffer) + (when + (eq t (cond ((if (and (memq 'wget vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region + (point) (point) buffer + vm-wget-program "-q" "-O" "-" url) + (error nil))) + t + (save-excursion + (set-buffer buffer) + (erase-buffer) + nil ))) + ((if (and (memq 'w3m vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region + (point) (point) buffer + vm-w3m-program "-dump_source" url) + (error nil))) + t + (save-excursion + (set-buffer buffer) + (erase-buffer) + nil ))) + ((if (and (memq 'fetch vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region + (point) (point) buffer + vm-fetch-program "-o" "-" url) + (error nil))) + t + (save-excursion + (set-buffer buffer) + (erase-buffer) + nil ))) + ((if (and (memq 'curl vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region + (point) (point) buffer + vm-curl-program url) + (error nil))) + t + (save-excursion + (set-buffer buffer) + (erase-buffer) + nil ))) + ((if (and (memq 'lynx vm-url-retrieval-methods) + (condition-case data + (vm-run-command-on-region + (point) (point) buffer + vm-lynx-program "-source" url) + (error nil))) + t + (save-excursion + (set-buffer buffer) + (erase-buffer) + nil ))))) + (save-excursion + (set-buffer buffer) + (not (zerop (buffer-size)))))) + +(defun vm-mime-internalize-local-external-bodies (layout) + "Given a LAYOUT representing a message/external-body object, convert +it to an internal object by retrieving the body. USR, 2011-03-28" + (cond ((vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (when (string= (downcase + (vm-mime-get-parameter layout "access-type")) + "local-file") + (let* ((child-layout + (car (vm-mm-layout-parts layout))) + (work-buffer + (vm-make-multibyte-work-buffer + (format "*%s mime object*" + (car (vm-mm-layout-type child-layout)))))) + (unwind-protect + (let (oldsize) + (with-current-buffer work-buffer + (vm-mime-retrieve-external-body layout)) + (goto-char (vm-mm-layout-body-start child-layout)) + (setq oldsize (buffer-size)) + (condition-case data + (insert-buffer-substring work-buffer) + (error (signal 'vm-mime-error (cdr data)))) + ;; This is redundant because insertion moves point + ;; (goto-char (+ (point) (- (buffer-size) oldsize))) + (if (< (point) (vm-mm-layout-body-end child-layout)) + (delete-region (point) + (vm-mm-layout-body-end child-layout)) + (vm-set-mm-layout-body-end child-layout (point-marker))) + (delete-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout)) + (vm-mime-copy-layout child-layout layout))) + (when work-buffer (kill-buffer work-buffer))))) + ((vm-mime-composite-type-p (car (vm-mm-layout-type layout))) + (let ((p (vm-mm-layout-parts layout))) + (while p + (vm-mime-internalize-local-external-bodies (car p)) + (setq p (cdr p))))) + (t nil))) + +(defun vm-mime-display-internal-message/partial (layout) + (if (vectorp layout) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action + (function + (lambda (layout) + (save-excursion + (vm-mime-display-internal-message/partial layout)))) + :layout layout)) + (vm-inform 6 "Assembling message...") + (let ((parts nil) + (missing nil) + (work-buffer nil) + extent id o number total m i prev part-header-pos + p-id p-number p-total p-list) + (setq extent layout + layout (vm-extent-property extent 'vm-mime-layout) + id (vm-mime-get-parameter layout "id")) + (if (null id) + (vm-mime-error + "message/partial message missing id parameter")) + (save-excursion + (set-buffer (marker-buffer (vm-mm-layout-body-start layout))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (and (search-forward id nil t) + (setq m (vm-message-at-point))) + (setq o (vm-mm-layout m)) + (if (not (vectorp o)) + nil + (setq p-list (vm-mime-find-message/partials o id)) + (while p-list + (setq p-id (vm-mime-get-parameter (car p-list) "id")) + (setq p-total (vm-mime-get-parameter (car p-list) "total")) + (if (null p-total) + nil + (setq p-total (string-to-number p-total)) + (when (< p-total 1) + (vm-mime-error + "message/partial specified part total < 1, %d" + p-total)) + (if total + (unless (= total p-total) + (vm-mime-error + (concat "message/partial specified total differs " + "between parts, (%d != %d)") + p-total total)) + (setq total p-total))) + (setq p-number (vm-mime-get-parameter (car p-list) "number")) + (when (null p-number) + (vm-mime-error + "message/partial message missing number parameter")) + (setq p-number (string-to-number p-number)) + (when (< p-number 1) + (vm-mime-error + "message/partial part number < 1, %d" p-number)) + (when (and total (> p-number total)) + (vm-mime-error + (concat "message/partial part number greater than " + " expected number of parts, (%d > %d)") + p-number total)) + (setq parts (cons (list p-number (car p-list)) parts)) + (setq p-list (cdr p-list)))) + (goto-char (vm-mm-layout-body-end o)))))) + (when (null total) + (vm-mime-error + "total number of parts not specified in any message/partial part")) + (setq parts (sort parts + (function + (lambda (p q) (< (car p) (car q)))))) + (setq i 0) + (setq p-list parts) + (while p-list + (cond ((< i (car (car p-list))) + (vm-increment i) + (cond ((not (= i (car (car p-list)))) + (setq missing (cons i missing))) + (t (setq prev p-list + p-list (cdr p-list))))) + (t + ;; remove duplicate part + (setcdr prev (cdr p-list)) + (setq p-list (cdr p-list))))) + (while (< i total) + (vm-increment i) + (setq missing (cons i missing))) + (if missing + (vm-mime-error + "part%s %s%s missing" + (if (cdr missing) "s" "") + (mapconcat + (function identity) + (nreverse (mapcar 'int-to-string (or (cdr missing) missing))) + ", ") + (if (cdr missing) (concat " and " (car missing)) ""))) + (set-buffer (vm-generate-new-unibyte-buffer "assembled message")) + (setq vm-folder-type vm-default-folder-type) + (vm-mime-insert-mime-headers (car (cdr (car parts)))) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp +"\\(Encrypted\\|Content-\\|MIME-Version\\|Message-ID\\|Subject\\|X-VM-\\|Status\\)") + (goto-char (point-max)) + (setq part-header-pos (point)) + (while parts + (vm-mime-insert-mime-body (car (cdr (car parts)))) + (setq parts (cdr parts))) + (goto-char part-header-pos) + (vm-reorder-message-headers + nil + :keep-list '("Subject" "MIME-Version" "Content-" "Message-ID" "Encrypted") + :discard-regexp nil) + (vm-munge-message-separators vm-folder-type (point-min) (point-max)) + (goto-char (point-min)) + (insert (vm-leading-message-separator)) + (goto-char (point-max)) + (insert (vm-trailing-message-separator)) + (set-buffer-modified-p nil) + (vm-inform 6 "Assembling message... done") + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode) + (if (vm-should-generate-summary) + (progn + (vm-goto-new-summary-frame-maybe) + (vm-summarize)))) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + t )) +(fset 'vm-mime-display-button-message/partial + 'vm-mime-display-internal-message/partial) + +(defun vm-mime-display-internal-image-xxxx (layout image-type name) + "Display the image object described by LAYOUT internally. +IMAGE-TYPE is its image type (png, jpeg etc.). NAME is a string +describing the image type. USR, 2011-03-25" + (cond + (vm-xemacs-p + (vm-mime-display-internal-image-xemacs-xxxx layout image-type name)) + ((and vm-fsfemacs-p (fboundp 'image-type-available-p)) + (vm-mime-display-internal-image-fsfemacs-xxxx layout image-type name)) + (t + (vm-inform 0 "Unsupported Emacs version")) + )) + +(defun vm-mime-display-internal-image-xemacs-xxxx (layout image-type name) + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p image-type)) + (let ((start (point-marker)) end tempfile g e + (selective-display nil) + (incremental vm-mime-display-image-strips-incrementally) + do-strips + (keymap (make-sparse-keymap)) + (buffer-read-only nil)) + (if (and (setq tempfile (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + (file-readable-p tempfile)) + nil + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile)) + (vm-register-folder-garbage-files (list tempfile)) + ;; coding system for presentation buffer is binary so + ;; we don't need to set it here. + (write-region start end tempfile nil 0) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + tempfile) + (delete-region start end)) + (if (not (bolp)) + (insert "\n")) + (setq do-strips (and (stringp vm-imagemagick-convert-program) + vm-mime-use-image-strips)) + (cond (do-strips + (condition-case error-data + (let ((strips (vm-make-image-strips tempfile + (* 2 (font-height + (face-font 'default))) + image-type + t incremental)) + process image-list extent-list + start + (first t)) + (define-key keymap 'button3 'vm-menu-popup-image-menu) + (setq process (car strips) + strips (cdr strips) + image-list strips) + (vm-register-message-garbage-files strips) + (setq start (point)) + (while strips + (setq g (make-glyph + (list + (cons nil + (vector 'string + ':data + (if (or first + (null (cdr strips))) + (progn + (setq first nil) + "+-----+") + "|image|")))))) + (insert " \n") + (setq e (vm-make-extent (- (point) 2) (1- (point)))) + (vm-set-extent-property e 'begin-glyph g) + (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'keymap keymap) + (setq extent-list (cons e extent-list)) + (setq strips (cdr strips))) + (setq e (vm-make-extent start (point))) + (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-disposable t) + (vm-set-extent-property e 'keymap keymap) + (save-excursion + (set-buffer (process-buffer process)) + (set (make-local-variable 'vm-image-list) image-list) + (set (make-local-variable 'vm-image-type) image-type) + (set (make-local-variable 'vm-image-type-name) + name) + (set (make-local-variable 'vm-extent-list) + (nreverse extent-list))) + (if incremental + (set-process-filter + process + 'vm-process-filter-display-some-image-strips)) + (set-process-sentinel + process + 'vm-process-sentinel-display-image-strips)) + (vm-image-too-small + (setq do-strips nil)) + (error + (vm-warn 0 0 "Failed making image strips: %s" error-data) + ;; fallback to the non-strips way + (setq do-strips nil))))) + (cond ((not do-strips) + (vm-inform 6 "Creating %s glyph..." name) + (setq g (make-glyph + (list + (cons (list 'win) + (vector image-type ':file tempfile)) + (cons (list 'win) + (vector 'string + ':data + (format "[Unknown/Bad %s image encoding]" + name))) + (cons nil + (vector 'string + ':data + (format "[%s image]\n" name)))))) + (vm-inform 6 "") + ;; XEmacs 21.2 can pixel scroll images (sort of) + ;; if the entire image is above the baseline. + (set-glyph-baseline g 100) + (if (memq image-type '(xbm)) + (set-glyph-face g 'vm-monochrome-image)) + (insert " \n") + (define-key keymap 'button3 'vm-menu-popup-image-menu) + (setq e (vm-make-extent (- (point) 2) (1- (point)))) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'begin-glyph g) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-disposable t) + (vm-set-extent-property e 'start-open t))) + t ))) + +(defvar vm-menu-fsfemacs-image-menu) + +(defun vm-mime-display-internal-image-fsfemacs-xxxx (layout image-type name) + "Display the image object described by LAYOUT internally. +IMAGE-TYPE is its image type (png, jpeg etc.). NAME is a string +describing the image type. USR, 2011-03-25" + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p image-type)) + (let (start end tempfile image work-buffer + (selective-display nil) + (incremental vm-mime-display-image-strips-incrementally) + do-strips + (buffer-read-only nil)) + (if (and (setq tempfile (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + (file-readable-p tempfile)) + nil + (unwind-protect + (progn + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (setq start (point)) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile)) + (let ((coding-system-for-write (vm-binary-coding-system))) + (write-region start end tempfile nil 0)) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + tempfile)) + (vm-register-folder-garbage-files (list tempfile))) + (and work-buffer (kill-buffer work-buffer)))) + (if (not (bolp)) + (insert-char ?\n 1)) + (setq do-strips (and (stringp vm-imagemagick-convert-program) + vm-mime-use-image-strips)) + (cond (do-strips + (condition-case error-data + (let ((strips (vm-make-image-strips + tempfile + (* 2 (frame-char-height)) + image-type t incremental)) + (first t) + start o process image-list overlay-list) + (setq process (car strips) + strips (cdr strips) + image-list strips) + (if (null (process-buffer process)) + (error "ImageMagick conversion failed")) + (vm-register-message-garbage-files strips) + (setq start (point)) + (while strips + (if (or first (null (cdr strips))) + (progn + (setq first nil) + (insert "+-----+")) + (insert "|image|")) + (setq o (make-overlay (- (point) 7) (point))) + (overlay-put o 'evaporate t) + (setq overlay-list (cons o overlay-list)) + (insert "\n") + (setq strips (cdr strips))) + (setq o (make-overlay start (point) nil t nil)) + (overlay-put o 'vm-mime-layout layout) + (overlay-put o 'vm-mime-disposable t) + (if vm-use-menus + (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu)) + (save-excursion + (set-buffer (process-buffer process)) + (set (make-local-variable 'vm-image-list) image-list) + (set (make-local-variable 'vm-image-type) image-type) + (set (make-local-variable 'vm-image-type-name) + name) + (set (make-local-variable 'vm-overlay-list) + (nreverse overlay-list))) + (if incremental + (set-process-filter + process + 'vm-process-filter-display-some-image-strips)) + (set-process-sentinel + process + 'vm-process-sentinel-display-image-strips)) + (vm-image-too-small + (setq do-strips nil)) + (error + (vm-warn 0 0 "Failed making image strips: %s" error-data) + ;; fallback to the non-strips way + (setq do-strips nil))))) + (cond ((not do-strips) + (setq image (list 'image ':type image-type ':file tempfile)) + ;; insert one char so we can attach the image to it. + (insert "z") + (put-text-property (1- (point)) (point) 'display image) + (clear-image-cache t) + (let (o) + (setq o (make-overlay (- (point) 1) (point) nil t nil)) + (overlay-put o 'evaporate t) + (overlay-put o 'vm-mime-layout layout) + (overlay-put o 'vm-mime-disposable t) + (if vm-use-menus + (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu))))) + t ) + ;; otherwise, image-type not available here + nil )) + +;; FSF Emacs 19 is not supported any more. USR, 2011-02-23 +;; (defun vm-mime-display-internal-image-fsfemacs-19-xxxx (layout image-type name) +;; (if (and (vm-images-possible-here-p) +;; (vm-image-type-available-p image-type)) +;; (catch 'done +;; (let ((selective-display nil) +;; start end origfile workfile image work-buffer +;; (hroll (if vm-fsfemacs-mule-p +;; (+ (cdr (assq 'internal-border-width +;; (frame-parameters))) +;; (if (memq (cdr (assq 'vertical-scroll-bars +;; (frame-parameters))) +;; '(t left)) +;; (vm-fsfemacs-scroll-bar-width) +;; 0)) +;; (cdr (assq 'internal-border-width +;; (frame-parameters))))) +;; (vroll (cdr (assq 'internal-border-width (frame-parameters)))) +;; (reverse (eq (cdr (assq 'background-mode (frame-parameters))) +;; 'dark)) +;; blob strips +;; dims width height char-width char-height +;; horiz-pad vert-pad trash-list +;; (buffer-read-only nil)) +;; (if (and (setq blob (get (vm-mm-layout-cache layout) +;; 'vm-mime-display-internal-image-xxxx)) +;; (file-exists-p (car blob)) +;; (progn +;; (setq origfile (car blob) +;; workfile (nth 1 blob) +;; width (nth 2 blob) +;; height (nth 3 blob) +;; char-width (nth 4 blob) +;; char-height (nth 5 blob)) +;; (and (= char-width (frame-char-width)) +;; (= char-height (frame-char-height))))) +;; (setq strips (nth 6 blob)) +;; (unwind-protect +;; (progn +;; (save-excursion +;; (setq work-buffer (vm-make-work-buffer)) +;; (set-buffer work-buffer) +;; (if (and origfile (file-exists-p origfile)) +;; (progn +;; (insert-file-contents origfile) +;; (setq start (point-min) +;; end (vm-marker (point-max)))) +;; (setq start (point)) +;; (vm-mime-insert-mime-body layout) +;; (setq end (point-marker)) +;; (vm-mime-transfer-decode-region layout start end) +;; (setq origfile (vm-make-tempfile)) +;; (setq trash-list (cons origfile trash-list)) +;; (let ((coding-system-for-write (vm-binary-coding-system))) +;; (write-region start end origfile nil 0))) +;; (setq dims (condition-case error-data +;; (vm-get-image-dimensions origfile) +;; (error +;; (vm-warn 0 0 "Failed getting image dimensions: %s" +;; error-data) +;; (throw 'done nil))) +;; width (nth 0 dims) +;; height (nth 1 dims) +;; char-width (frame-char-width) +;; char-height (frame-char-height) +;; horiz-pad (if (< width char-width) +;; (- char-width width) +;; (% width char-width)) +;; horiz-pad (if (zerop horiz-pad) +;; horiz-pad +;; (- char-width horiz-pad)) +;; vert-pad (if (< height char-height) +;; (- char-height height) +;; (% height char-height)) +;; vert-pad (if (zerop vert-pad) +;; vert-pad +;; (- char-height vert-pad))) +;; ;; crop one line from the bottom of the image +;; ;; if vertical padding needed is odd so that +;; ;; the image height plus the padding will be an +;; ;; exact multiple of the char height. +;; (if (not (zerop (% vert-pad 2))) +;; (setq height (1- height) +;; vert-pad (1+ vert-pad))) +;; (call-process-region start end +;; vm-imagemagick-convert-program +;; t t nil +;; (if reverse "-negate" "-matte") +;; "-crop" +;; (format "%dx%d+0+0" width height) +;; "-page" +;; (format "%dx%d+0+0" width height) +;; "-mattecolor" "white" +;; "-frame" +;; (format "%dx%d+0+0" +;; (/ (1+ horiz-pad) 2) +;; (/ vert-pad 2)) +;; "-" +;; "-") +;; (setq width (+ width (* 2 (/ (1+ horiz-pad) 2))) +;; height (+ height (* 2 (/ vert-pad 2)))) +;; (if (null workfile) +;; (setq workfile (vm-make-tempfile) +;; trash-list (cons workfile trash-list))) +;; (let ((coding-system-for-write (vm-binary-coding-system))) +;; (write-region (point-min) (point-max) workfile nil 0)) +;; (put (vm-mm-layout-cache layout) +;; 'vm-mime-display-internal-image-xxxx +;; (list origfile workfile width height +;; char-width char-height))) +;; (when trash-list +;; (vm-register-folder-garbage-files trash-list))) +;; (and work-buffer (kill-buffer work-buffer)))) +;; (if (not (bolp)) +;; (insert-char ?\n 1)) +;; (condition-case error-data +;; (let (o i-start start process image-list overlay-list) +;; (if (and strips (file-exists-p (car strips))) +;; (setq image-list strips) +;; (setq strips (vm-make-image-strips workfile char-height +;; image-type t nil +;; hroll vroll) +;; process (car strips) +;; strips (cdr strips) +;; image-list strips) +;; (put (vm-mm-layout-cache layout) +;; 'vm-mime-display-internal-image-xxxx +;; (list origfile workfile width height +;; char-width char-height +;; strips)) +;; (vm-register-message-garbage-files strips)) +;; (setq i-start (point)) +;; (while strips +;; (setq start (point)) +;; (insert-char ?\ (/ width char-width)) +;; (put-text-property start (point) 'face 'vm-image-placeholder) +;; (setq o (make-overlay start (point) nil t)) +;; (overlay-put o 'evaporate t) +;; (setq overlay-list (cons o overlay-list)) +;; (insert "\n") +;; (setq strips (cdr strips))) +;; (setq o (make-overlay i-start (point) nil t nil)) +;; (overlay-put o 'vm-mime-layout layout) +;; (overlay-put o 'vm-mime-disposable t) +;; (if vm-use-menus +;; (overlay-put o 'vm-image vm-menu-fsfemacs-image-menu)) +;; (if process +;; (save-excursion +;; (set-buffer (process-buffer process)) +;; (set (make-local-variable 'vm-image-list) image-list) +;; (set (make-local-variable 'vm-image-type) image-type) +;; (set (make-local-variable 'vm-image-type-name) +;; name) +;; (set (make-local-variable 'vm-overlay-list) +;; (nreverse overlay-list)) +;; ;; incremental strip display intentionally +;; ;; omitted because it makes the Emacs 19 +;; ;; display completely repaint for each new +;; ;; strip. +;; (set-process-sentinel +;; process +;; 'vm-process-sentinel-display-image-strips)) +;; (vm-display-image-strips-on-overlay-regions image-list +;; (nreverse +;; overlay-list) +;; image-type))) +;; (error +;; (vm-warn 0 0 "Failed making image strips: %s" error-data))) +;; t )) +;; nil )) + +(defun vm-get-image-dimensions (file) + (let (work-buffer width height) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (call-process vm-imagemagick-identify-program nil t nil file) + (goto-char (point-min)) + (or (search-forward " " nil t) + (error "no spaces in 'identify' output: %s" + (buffer-string))) + (if (not (re-search-forward "\\b\\([0-9]+\\)x\\([0-9]+\\)\\b" nil t)) + (error "file dimensions missing from 'identify' output: %s" + (buffer-string))) + (setq width (string-to-number (match-string 1)) + height (string-to-number (match-string 2)))) + (and work-buffer (kill-buffer work-buffer))) + (list width height))) + +(defun vm-imagemagick-type-indicator-for (image-type) + (cond ((eq image-type 'jpeg) "jpeg:") + ((eq image-type 'gif) "gif:") + ((eq image-type 'png) "png:") + ((eq image-type 'tiff) "tiff:") + ((eq image-type 'xpm) "xpm:") + ((eq image-type 'pbm) "pbm:") + ((eq image-type 'xbm) "xbm:") + (t ""))) + +(defun vm-make-image-strips (file min-height image-type async incremental + &optional hroll vroll) + (or hroll (setq hroll 0)) + (or vroll (setq vroll 0)) + (let ((process-connection-type nil) + (i 0) + (output-type (vm-imagemagick-type-indicator-for image-type)) + image-list dimensions width height starty newfile work-buffer + quotient remainder adjustment process) + (setq dimensions (vm-get-image-dimensions file) + width (car dimensions) + height (car (cdr dimensions))) + (if (< height min-height) + (signal 'vm-image-too-small nil)) + (setq quotient (/ height min-height) + remainder (% height min-height) + adjustment (/ remainder quotient) + remainder (% remainder quotient) + starty 0) + (unwind-protect + (save-excursion + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (goto-char (point-min)) + (while (< starty height) + (setq newfile (vm-make-tempfile)) + (if async + (progn + ;; Problem - we have no way of knowing whether these + ;; calls succeed or not. USR, 2011-02-23 + (insert vm-imagemagick-convert-program + " -crop" + (format " %dx%d+0+%d" + width + (+ min-height adjustment + (if (zerop remainder) 0 1)) + starty) + " -page" + (format " %dx%d+0+0" + width + (+ min-height adjustment + (if (zerop remainder) 0 1))) + (format " -roll +%d+%d" hroll vroll) + " \"" file "\" \"" output-type newfile "\"\n") + (when incremental + (insert "echo XZXX" (int-to-string i) "XZXX\n")) + (setq i (1+ i))) + (call-process vm-imagemagick-convert-program nil nil nil + "-crop" + (format "%dx%d+0+%d" + width + (+ min-height adjustment + (if (zerop remainder) 0 1)) + starty) + "-page" + (format "%dx%d+0+0" + width + (+ min-height adjustment + (if (zerop remainder) 0 1))) + "-roll" + (format "+%d+%d" hroll vroll) + file (concat output-type newfile))) + (setq image-list (cons newfile image-list) + starty (+ starty min-height adjustment + (if (zerop remainder) 0 1)) + remainder (if (= 0 remainder) 0 (1- remainder)))) + (when async + (goto-char (point-max)) + (insert "exit\n") + (setq process + (start-process (format "image strip maker for %s" file) + (current-buffer) + shell-file-name)) + (process-send-string process (buffer-string)) + (setq work-buffer nil)) + (if async + (cons process (nreverse image-list)) + (nreverse image-list))) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-process-sentinel-display-image-strips (process what-happened) + (save-excursion + (set-buffer (process-buffer process)) + (cond ((and (boundp 'vm-extent-list) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (extents vm-extent-list) + (image-type vm-image-type) + (type-name vm-image-type-name)) + (vm-display-image-strips-on-extents strips extents image-type + type-name))) + ((and (boundp 'vm-overlay-list) + (overlay-buffer (car vm-overlay-list)) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (overlays vm-overlay-list) + (image-type vm-image-type)) + (vm-display-image-strips-on-overlay-regions strips overlays + image-type)))) + (kill-buffer (current-buffer)))) + +(defun vm-display-image-strips-on-extents (strips extents image-type type-name) + (let (g) + (while (and strips + (file-exists-p (car strips)) + (extent-live-p (car extents)) + (vm-extent-object (car extents))) + (setq g (make-glyph + (list + (cons (list 'win) + (vector image-type ':file (car strips))) + (cons (list 'win) + (vector + 'string + ':data + (format "[Unknown/Bad %s image encoding]" + type-name))) + (cons nil + (vector 'string + ':data + (format "[%s image]\n" type-name)))))) + (set-glyph-baseline g 50) + (if (memq image-type '(xbm)) + (set-glyph-face g 'vm-monochrome-image)) + (set-extent-begin-glyph (car extents) g) + (setq strips (cdr strips) + extents (cdr extents))))) + +(defun vm-display-image-strips-on-overlay-regions (strips overlays image-type) + (let (prop value omodified) + (save-excursion + (set-buffer (overlay-buffer (car vm-overlay-list))) + (setq omodified (buffer-modified-p)) + (save-restriction + (widen) + (unwind-protect + (let ((buffer-read-only nil)) + (if (fboundp 'image-type-available-p) + (setq prop 'display) + (setq prop 'face)) + (while (and strips + (file-exists-p (car strips)) + (overlay-end (car overlays))) + (if (fboundp 'image-type-available-p) + (setq value (list 'image ':type image-type + ':file (car strips) + ':ascent 50)) + (setq value (make-face (make-symbol "<vm-image-face>"))) + (set-face-stipple value (car strips))) + (put-text-property (overlay-start (car overlays)) + (overlay-end (car overlays)) + prop value) + (setq strips (cdr strips) + overlays (cdr overlays)))) + (set-buffer-modified-p omodified)))))) + +(defun vm-process-filter-display-some-image-strips (process output) + (let (which-strips (i 0)) + (while (string-match "XZXX\\([0-9]+\\)XZXX" output i) + (setq which-strips (cons (string-to-number (match-string 1 output)) + which-strips) + i (match-end 0))) + (save-excursion + (set-buffer (process-buffer process)) + (cond ((and (boundp 'vm-extent-list) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (extents vm-extent-list) + (image-type vm-image-type) + (type-name vm-image-type-name)) + (vm-display-some-image-strips-on-extents strips extents + image-type + type-name + which-strips))) + ((and (boundp 'vm-overlay-list) + (overlay-buffer (car vm-overlay-list)) + (boundp 'vm-image-list)) + (let ((strips vm-image-list) + (overlays vm-overlay-list) + (image-type vm-image-type)) + (vm-display-some-image-strips-on-overlay-regions + strips overlays image-type which-strips))))))) + +(defun vm-display-some-image-strips-on-extents + (strips extents image-type type-name which-strips) + (let (g sss eee) + (while which-strips + (setq sss (nthcdr (car which-strips) strips) + eee (nthcdr (car which-strips) extents)) + (cond ((and sss + (file-exists-p (car sss)) + (extent-live-p (car eee)) + (vm-extent-object (car eee))) + (setq g (make-glyph + (list + (cons (list 'win) + (vector image-type ':file (car sss))) + (cons (list 'win) + (vector + 'string + ':data + (format "[Unknown/Bad %s image encoding]" + type-name))) + (cons nil + (vector 'string + ':data + (format "[%s image]\n" type-name)))))) + (set-glyph-baseline g 50) + (if (memq image-type '(xbm)) + (set-glyph-face g 'vm-monochrome-image)) + (set-extent-begin-glyph (car eee) g))) + (setq which-strips (cdr which-strips))))) + +(defun vm-display-some-image-strips-on-overlay-regions + (strips overlays image-type which-strips) + (let (sss ooo prop value omodified) + (save-excursion + (set-buffer (overlay-buffer (car vm-overlay-list))) + (setq omodified (buffer-modified-p)) + (save-restriction + (widen) + (unwind-protect + (let ((buffer-read-only nil)) + (if (fboundp 'image-type-available-p) + (setq prop 'display) + (setq prop 'face)) + (while which-strips + (setq sss (nthcdr (car which-strips) strips) + ooo (nthcdr (car which-strips) overlays)) + (cond ((and sss + (file-exists-p (car sss)) + (overlay-end (car ooo))) + (if (fboundp 'image-type-available-p) + (setq value (list 'image ':type image-type + ':file (car sss) + ':ascent 50)) + (setq value (make-face (make-symbol + "<vm-image-face>"))) + (set-face-stipple value (car sss))) + (put-text-property (overlay-start (car ooo)) + (overlay-end (car ooo)) + prop value))) + (setq which-strips (cdr which-strips)))) + (set-buffer-modified-p omodified)))))) + +(defun vm-mime-display-internal-image/gif (layout) + (vm-mime-display-internal-image-xxxx layout 'gif "GIF")) + +(defun vm-mime-display-internal-image/jpeg (layout) + (vm-mime-display-internal-image-xxxx layout 'jpeg "JPEG")) + +(defun vm-mime-display-internal-image/png (layout) + (vm-mime-display-internal-image-xxxx layout 'png "PNG")) + +(defun vm-mime-display-internal-image/tiff (layout) + (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF")) + +(defun vm-mime-display-internal-image/xpm (layout) + (vm-mime-display-internal-image-xxxx layout 'xpm "XPM")) + +(defun vm-mime-display-internal-image/pbm (layout) + (vm-mime-display-internal-image-xxxx layout 'pbm "PBM")) + +(defun vm-mime-display-internal-image/xbm (layout) + (vm-mime-display-internal-image-xxxx layout 'xbm "XBM")) + +(defun vm-mime-frob-image-xxxx (extent &rest convert-args) + "Create and display a thumbnail (a PNG image) for the MIME +object described by EXTENT. The thumbnail is stored in a file +whose identity is saved in the MIME layout cache of the object. + +The remaining arguments CONVERT-ARGS are passed to the ImageMagick +convert program during the creation of the thumbnail image. + +The return value does not seem to be meaningful. USR, 2011-03-25" + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + (saved-type (vm-mm-layout-type layout)) + success tempfile + (work-buffer nil)) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq work-buffer (vm-make-work-buffer)) + (unwind-protect + (with-current-buffer work-buffer + (set-buffer-file-coding-system (vm-binary-coding-system)) + ;; convert just the first page "[0]" and enforce PNG output by "png:" + (let ((coding-system-for-read (vm-binary-coding-system))) + (setq success + (eq 0 (apply 'call-process vm-imagemagick-convert-program + tempfile t nil + (append convert-args (list "-[0]" "png:-")))))) + (when success + (write-region (point-min) (point-max) tempfile nil 0) + (when (consp blob) + (setcar (nthcdr 5 blob) 0)) + (put (vm-mm-layout-cache layout) 'vm-image-modified t))) + ;; unwind-protection + (when work-buffer (kill-buffer work-buffer))) + (unwind-protect + (when success + ;; the output is always PNG now, so fix it for displaying, but restore + ;; it for the layout afterwards + (vm-set-mm-layout-type layout '("image/png")) + (vm-set-mm-layout-disposition layout '("inline")) + (vm-mark-image-tempfile-as-message-garbage-once layout tempfile) + (vm-mime-display-internal-generic extent)) + (vm-set-mm-layout-type layout saved-type)))) + +(defun vm-mark-image-tempfile-as-message-garbage-once (layout tempfile) + (if (get (vm-mm-layout-cache layout) 'vm-message-garbage) + nil + (vm-register-message-garbage-files (list tempfile)) + (put (vm-mm-layout-cache layout) 'vm-message-garbage t))) + +(defun vm-mime-rotate-image-left (extent) + (vm-mime-frob-image-xxxx extent "-rotate" "-90")) + +(defun vm-mime-rotate-image-right (extent) + (vm-mime-frob-image-xxxx extent "-rotate" "90")) + +(defun vm-mime-mirror-image (extent) + (vm-mime-frob-image-xxxx extent "-flop")) + +(defun vm-mime-brighten-image (extent) + (vm-mime-frob-image-xxxx extent "-modulate" "115")) + +(defun vm-mime-dim-image (extent) + (vm-mime-frob-image-xxxx extent "-modulate" "85")) + +(defun vm-mime-monochrome-image (extent) + (vm-mime-frob-image-xxxx extent "-monochrome")) + +(defun vm-mime-revert-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (and (stringp tempfile) + (vm-error-free-call 'delete-file tempfile)) + (put (vm-mm-layout-cache layout) 'vm-image-modified nil) + (vm-mime-display-generic extent))) + +(defun vm-mime-larger-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + dims tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq dims (vm-get-image-dimensions tempfile)) + (vm-mime-frob-image-xxxx extent + "-scale" + (concat (int-to-string (* 2 (car dims))) + "x" + (int-to-string (* 2 (nth 1 dims))))))) + +(defun vm-mime-smaller-image (extent) + (let* ((layout (vm-extent-property extent 'vm-mime-layout)) + (blob (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx)) + dims tempfile) + ;; Emacs 19 uses a different layout cache than XEmacs or Emacs 21+. + ;; The cache blob is a list in that case. + (if (consp blob) + (setq tempfile (car blob)) + (setq tempfile blob)) + (setq dims (vm-get-image-dimensions tempfile)) + (vm-mime-frob-image-xxxx extent + "-scale" + (concat (int-to-string (/ (car dims) 2)) + "x" + (int-to-string (/ (nth 1 dims) 2)))))) + +(defcustom vm-mime-thumbnail-max-geometry "80x80" + "If thumbnails should be displayed as part of MIME buttons, then set +this variable to a string describing the geometry, e.g., \"80x80\". +Otherwise, set it to nil. USR, 2011-03-25" + :group 'vm-mime + :type '(choice string + (const :tag "Disable thumbnails." nil))) + +(defun vm-mime-display-button-image (layout) + "Displays a button for the MIME LAYOUT and includes a thumbnail +image when possible." + (if (and vm-imagemagick-convert-program + vm-mime-thumbnail-max-geometry + (vm-images-possible-here-p)) + ;; create a thumbnail and display it + (let (tempfile start end thumb-extent glyph) + ;; fake an extent to display the image as thumb + (setq start (point)) + (insert " ") + (setq thumb-extent (vm-make-extent start (point))) + (vm-set-extent-property thumb-extent 'vm-mime-layout layout) + (vm-set-extent-property thumb-extent 'vm-mime-disposable nil) + (vm-set-extent-property thumb-extent 'start-open t) + ;; write out the image data + (with-current-buffer (vm-make-work-buffer) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (setq tempfile (vm-make-tempfile)) + (let ((coding-system-for-write (vm-binary-coding-system))) + (write-region (point-min) (point-max) tempfile nil 0)) + (kill-buffer (current-buffer))) + ;; store the temp filename + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + tempfile) + (vm-register-folder-garbage-files (list tempfile)) + ;; display a thumbnail over the fake extent + (let ((vm-mime-internal-content-types '("image")) + (vm-mime-internal-content-type-exceptions nil) + (vm-mime-auto-displayed-content-types '("image")) + (vm-mime-auto-displayed-content-type-exceptions nil) + (vm-mime-use-image-strips nil)) + (vm-mime-frob-image-xxxx thumb-extent + "-thumbnail" + vm-mime-thumbnail-max-geometry)) + ;; extract image data, don't need the image itself! + ;; if the display was not successful, glyph will be nil + (setq glyph (if vm-xemacs-p + (let ((e1 (vm-extent-at start)) + (e2 (vm-extent-at (1+ start)))) + (or (and e1 (extent-begin-glyph e1)) + (and e2 (extent-begin-glyph e2)))) + (get-text-property start 'display))) + (delete-region start (point)) + ;; insert the button and replace the image + (setq start (point)) + (vm-mime-display-button-xxxx layout t) + (when glyph + (if vm-xemacs-p + (set-extent-begin-glyph (vm-extent-at start) glyph) + (put-text-property start (1+ start) 'display glyph))) + ;; remove the cached thumb so that full sized image will be shown + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-image-xxxx + nil) + t) + ;; just display the normal button + (vm-mime-display-button-xxxx layout t))) + +(defun vm-mime-display-button-application/pdf (layout) + (vm-mime-display-button-image layout)) + +(defun vm-mime-display-internal-audio/basic (layout) + (if (and vm-xemacs-p + (or (featurep 'native-sound) + (featurep 'nas-sound)) + (or (device-sound-enabled-p) + (and (featurep 'native-sound) + (not native-sound-only-on-console) + (memq (vm-device-type) '(x gtk))))) + (let ((start (point-marker)) end tempfile + (selective-display nil) + (buffer-read-only nil)) + (if (setq tempfile (get (vm-mm-layout-cache layout) + 'vm-mime-display-internal-audio/basic)) + nil + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (setq tempfile (vm-make-tempfile)) + (vm-register-folder-garbage-files (list tempfile)) + ;; coding system for presentation buffer is binary, so + ;; we don't need to set it here. + (write-region start end tempfile nil 0) + (put (vm-mm-layout-cache layout) + 'vm-mime-display-internal-audio/basic + tempfile) + (delete-region start end)) + (start-itimer "audioplayer" + (list 'lambda nil (list 'play-sound-file tempfile)) + 1) + t ) + nil )) + +(defun vm-mime-display-generic (layout) + "Display the mime object described by LAYOUT, irrespective of +whether it is meant to be to be displayed automatically." + (save-excursion + (let ((vm-mime-auto-displayed-content-types t) + (vm-mime-auto-displayed-content-type-exceptions nil)) + (vm-decode-mime-layout layout t)))) + +(defun vm-mime-display-internal-generic (layout) + "Display the mime object described by LAYOUT internally, +irrespective of whether it is meant to be to be displayed +automatically. No external viewers are tried. USR, 2011-03-25" + (save-excursion + (let ((vm-mime-auto-displayed-content-types t) + (vm-mime-auto-displayed-content-type-exceptions nil) + (vm-mime-external-content-types-alist nil)) + (vm-decode-mime-layout layout t)))) + +(defun vm-mime-display-button-xxxx (layout disposable) + "Display a button for the mime object described by LAYOUT. If +DISPOSABLE is true, then the button will be removed when it is +expanded to display the mime object." + (vm-mime-insert-button + :caption (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action (function vm-mime-display-generic) + :layout layout :disposable disposable)) + +;;---------------------------------------------------------------------------- +;;; MIME buttons +;; +;; vm-find-layout-extent-at-point: () -> extent +;; vm-mime-run-display-funciton-at-point: (layout -> 'a) -> 'a +;; vm-mime-reader-map-save-file: () -> file +;; vm-mime-reader-map-save-message: () -> file +;; vm-mime-reader-map-pipe-to-command: () -> void +;; vm-mime-reader-map-pipe-to-command-discard-output: () -> void +;; vm-mime-reader-map-pipe-to-printer: () -> void +;; vm-mime-reader-map-display-using-external-viewer: () -> void +;; vm-mime-reader-map-display-using-default: () -> void +;; vm-mime-reader-map-display-object-as-type: () -> void +;; vm-mime-reader-map-attach-to-composition: () -> void +;;---------------------------------------------------------------------------- + +(defun vm-find-layout-extent-at-point () + "Return the MIME layout of the MIME button at point." + (vm-extent-at (point) 'vm-mime-layout)) + +;;;###autoload +(defun vm-mime-run-display-function-at-point (&optional function) + "Run the 'vm-mime-function for the MIME button at point. +If optional argument FUNCTION is given, run it instead. + USR, 2011-03-07" + (interactive) + (if (and (memq major-mode '(vm-mode vm-virtual-mode)) + (vm-body-to-be-retrieved-of (car vm-message-pointer))) + (error "Message must be loaded to view attachments" )) + + ;; save excursion to keep point from moving. its motion would + ;; drag window point along, to a place arbitrarily far from + ;; where it was when the user triggered the button. + (save-excursion + (let ((extent (vm-find-layout-extent-at-point)) + retval ) + (and extent + (funcall + (or function (vm-extent-property extent 'vm-mime-function)) + extent))))) + +;;;###autoload +(defun vm-mime-reader-map-save-file () + "Write the MIME object at point to a file." + (interactive) + ;; make sure point doesn't move, we need it to stay on the tag + ;; if the user wants to delete after saving. + (let (file) + (save-excursion + (setq file (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-file))) + (when (and file vm-mime-delete-after-saving) + (let ((extent (vm-find-layout-extent-at-point))) + (vm-mime-delete-body-after-saving extent file))) + file )) + +;;;###autoload +(defun vm-mime-reader-map-save-message () + "Save the MIME object at point to a folder." + (interactive) + ;; make sure point doesn't move, we need it to stay on the tag + ;; if the user wants to delete after saving. + (let (folder) + (save-excursion + (setq folder (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-folder))) + (when (and folder vm-mime-delete-after-saving) + (let ((extent (vm-find-layout-extent-at-point))) + (vm-mime-delete-body-after-saving extent folder))) + folder )) + +;;;###autoload +(defun vm-mime-reader-map-pipe-to-command () + "Pipe the MIME object at point to a shell command." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-queried-command)) + +;;;###autoload +(defun vm-mime-reader-map-pipe-to-command-discard-output () + "Pipe the MIME object at point to a shell command." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-queried-command-discard-output)) + +;;;###autoload +(defun vm-mime-reader-map-pipe-to-printer () + "Print the MIME object at point." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-printer)) + +;;;###autoload +(defun vm-mime-reader-map-display-using-external-viewer () + "Display the MIME object at point with an external viewer." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-display-body-using-external-viewer)) + +;;;###autoload +(defun vm-mime-reader-map-display-using-default () + "Display the MIME object at point using the `default' face." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-display-body-as-text)) + +;;;###autoload +(defun vm-mime-reader-map-display-object-as-type () + "Display the MIME object at point as some other type." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-display-object-as-type)) + +;;;###autoload +(defun vm-mime-reader-map-convert-then-display () + "Convert the MIME object at point to text and display it." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-convert-body-then-display)) + +;;;###autoload +(defun vm-mime-reader-map-attach-to-composition () + "Attach the MIME object at point to a message being composed. The +buffer for message composition is queried from the minibufer." + (interactive) + (vm-mime-run-display-function-at-point + 'vm-mime-attach-body-to-composition)) + +;;---------------------------------------------------------------------------- +;;; MIME-related commands +;; +;; vm-mime-action-on-all-attachments : +;; (int, ((message, layout, type, filename) -> void), +;; &optional type list, type list, message list, bool) +;; -> void +;; This function is replaced by the following, but interface retained +;; for backward-compatibility. +;; +;; vm-mime-operate-on-attachments : +;; (int, :action ((message, layout, type, filename) -> void), +;; :included type list, :excluded type list, +;; :messages message list, :name string) +;; -> void +;;---------------------------------------------------------------------------- + +;;;###autoload +(defun* vm-mime-operate-on-attachments (count &key + ((:name action-name)) + ((:action action)) + ((:included types)) + ((:excluded exceptions)) + ((:messages mlist))) + "On the next COUNT messages or marked messages, call the +function ACTION on all \"attachments\". + +For the purpose of this function, an \"attachment\" is a mime +part part which has \"attachment\" as its disposition, or simply +has an associated filename, or has a type that matches a regexp +in TYPES but doesn't match one in EXCEPTIONS. + +ACTION-NAME should be a human-readable string describing the +action in minibuffer messages. Or it can be nil to suppress +messages. + +ACTION will get called with four arguments: MSG LAYOUT TYPE FILENAME." + (unless mlist + (unless count (setq count 1)) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-and-validate 1 nil)) + + (let ((mlist (or mlist (vm-select-operable-messages + count (vm-interactive-p) "Action on")))) + (vm-retrieve-operable-messages count mlist) + (save-excursion + (while mlist + (let (m parts layout filename type disposition o) + (setq o (vm-mm-layout (car mlist))) + (when (stringp o) + (setq o 'none) + (backtrace) + (vm-inform 0 "There is a bug, please report it with *backtrace*")) + (unless (eq o 'none) + (setq type (car (vm-mm-layout-type o))) + + (cond ((or (vm-mime-types-match "multipart/alternative" type) + (vm-mime-types-match "multipart/mixed" type) + (vm-mime-types-match "multipart/report" type) + (vm-mime-types-match "message/rfc822" type) + ) + (setq parts (copy-sequence (vm-mm-layout-parts o)))) + (t (setq parts (list o)))) + + (while parts + (while (vm-mime-composite-type-p + (car (vm-mm-layout-type (car parts)))) + (setq parts + (nconc (copy-sequence (vm-mm-layout-parts (car parts))) + (cdr parts)))) + + (setq layout (car parts) + type (car (vm-mm-layout-type layout)) + disposition (car (vm-mm-layout-disposition layout)) + filename (vm-mime-get-disposition-filename layout) ) + + (cond ((or filename + (and disposition (string= disposition "attachment")) + (and (not (vm-mime-types-match + "message/external-body" type)) + types + (vm-mime-is-type-valid type types exceptions))) + (when action-name + (vm-inform 10 + "%s part type=%s filename=%s disposition=%s" + action-name type filename disposition)) + (funcall action (car mlist) layout type filename)) + (action-name + (vm-inform 10 + "No %s on part type=%s filename=%s disposition=%s" + action-name type filename disposition))) + (setq parts (cdr parts))))) + (setq mlist (cdr mlist)))))) + +;;;###autoload +(defun vm-mime-action-on-all-attachments + (count action &optional types exceptions mlist quiet) + "On the next COUNT messages or marked messages, call the +function ACTION on all \"attachments\". For the purpose of this +function, an \"attachment\" is a mime part part which has +\"attachment\" as its disposition, or simply has an associated +filename, or has a type that matches a regexp in TYPES but +doesn't match one in EXCEPTIONS. + +If QUIET is true no messages are generated. + +ACTION will get called with four arguments: MSG LAYOUT TYPE FILENAME." + (vm-mime-operate-on-attachments + count :action action :included types :excluded exceptions :messages mlist + :name (if quiet nil "action on"))) + +(defun vm-mime-is-type-valid (type types-alist type-exceptions) + (catch 'done + (let ((list type-exceptions) + (matched nil)) + (while list + (if (vm-mime-types-match (car list) type) + (throw 'done nil) + (setq list (cdr list)))) + (setq list types-alist) + (while (and list (not matched)) + (if (vm-mime-types-match (car list) type) + (setq matched t) + (setq list (cdr list)))) + matched ))) + +;;;###autoload +(defun vm-delete-all-attachments (&optional count) + "Delete all attachments from the next COUNT messages or marked +messages. For the purpose of this function, an \"attachment\" is +a mime part part which has \"attachment\" as its disposition or +simply has an associated filename. Any mime types that match +`vm-mime-deleteable-types' but not `vm-mime-deleteable-type-exceptions' +are also included." + (interactive "p") + (vm-check-for-killed-summary) + (if (vm-interactive-p) (vm-follow-summary-cursor)) + + (let ((successes 0)) + (vm-mime-operate-on-attachments + count + :name "deleting" + :action + (lambda (msg layout type file) + (vm-inform 7 "Deleting `%s%s" type (if file (format " (%s)" file) "")) + (vm-mime-discard-layout-contents layout) + (setq successes (+ 1 successes))) + :included vm-mime-deleteable-types + :excluded vm-mime-deleteable-type-exceptions) + (when (vm-interactive-p) + (vm-discard-cached-data count) + (let ((vm-preview-lines nil)) + (vm-present-current-message))) + (if (> successes 0) + (vm-inform 5 "%d attachment%s deleted" successes (if (= successes 1) "" "s")) + (vm-inform 5 "No attachments deleted"))) + (vm-update-summary-and-mode-line)) + +;; (define-obsolete-function-alias 'vm-mime-delete-all-attachments +;; 'vm-delete-all-attachments "8.2.0") +(defalias 'vm-mime-delete-all-attachments + 'vm-delete-all-attachments) +(make-obsolete 'vm-mime-delete-all-attachments + 'vm-delete-all-attachments "8.2.0") + +;;;###autoload +(defun vm-save-all-attachments (&optional count + directory + no-delete-after-saving) + "Save all attachments in the next COUNT messages or marked +messages. For the purpose of this function, an \"attachment\" is +a mime part part which has \"attachment\" as its disposition or +simply has an associated filename. Any mime types that match +`vm-mime-saveable-types' but not `vm-mime-saveable-type-exceptions' +are also included. + +The attachments are saved to the specified DIRECTORY. The +variables `vm-all-attachments-directory' or +`vm-mime-attachment-save-directory' can be used to set the +default location. When directory does not exist it will be +created." + (interactive + (list current-prefix-arg + (vm-read-file-name + "Attachment directory: " + (or vm-mime-all-attachments-directory + vm-mime-attachment-save-directory + default-directory) + (or vm-mime-all-attachments-directory + vm-mime-attachment-save-directory + default-directory) + nil nil + vm-mime-save-all-attachments-history))) + + (vm-check-for-killed-summary) + (if (vm-interactive-p) (vm-follow-summary-cursor)) + + (let ((successes 0) + (failures 0) + (result nil)) + (vm-mime-operate-on-attachments + count + :name "saving" + :included vm-mime-saveable-types + :excluded vm-mime-saveable-type-exceptions + :action + (lambda (msg layout type file) + (let ((directory (if (functionp directory) + (funcall directory msg) + directory))) + (setq file + (if file + (expand-file-name (file-name-nondirectory file) directory) + (vm-read-file-name + (format "Save %s to file: " type) + (or directory + vm-mime-all-attachments-directory + vm-mime-attachment-save-directory) + (or directory + vm-mime-all-attachments-directory + vm-mime-attachment-save-directory) + nil nil + vm-mime-save-all-attachments-history) + )) + + (if (and file (file-exists-p file)) + (if (y-or-n-p (format "Overwrite `%s'? " file)) + (delete-file file) + (setq file nil))) + + (if (null file) + (setq failures (+ 1 failures)) + (vm-inform 5 "Saving %s" (if file (format " (%s)" file) "")) + (make-directory (file-name-directory file) t) + (setq result (vm-mime-send-body-to-file layout file file)) + (when result + (when vm-mime-delete-after-saving + (let ((vm-mime-confirm-delete nil)) + (vm-mime-discard-layout-contents + layout (expand-file-name file)))) + (setq successes (+ 1 successes)))))) + ) + + (when (vm-interactive-p) + (vm-discard-cached-data count) + (let ((vm-preview-lines nil)) + (vm-present-current-message))) + + (if (> failures 0) + (if (> successes 0) + (vm-inform 5 "%d attachment%s saved; %s failed" + successes (if (= successes 1) "" "s") failures) + (vm-inform 5 "No attachments saved; %s failed" failures)) + (if (> successes 0) + (vm-inform 5 "%d attachment%s saved" + successes (if (= successes 1) "" "s")) + (vm-inform 5 "No attachments saved"))))) + +;; (define-obsolete-function-alias 'vm-mime-save-all-attachments +;; 'vm-save-all-attachments "8.2.0") +(defalias 'vm-mime-save-all-attachments + 'vm-save-all-attachments) +(make-obsolete 'vm-mime-save-all-attachments + 'vm-save-all-attachments "8.2.0") + +(defun vm-save-attachments (&optional count + no-delete-after-saving) + "Save all attachments in the next COUNT messages or marked +messages. For the purpose of this function, an \"attachment\" is +a mime part part which has \"attachment\" as its disposition or +simply has an associated filename. Any mime types that match +`vm-mime-saveable-types' but not `vm-mime-saveable-type-exceptions' +are also included. + +The attachments are saved in file names input from the +minibuffer. (This is the main difference from +`vm-save-all-attachments'.) + +The variables `vm-all-attachments-directory' or +`vm-mime-attachment-save-directory' can be used to set the +default location. When directory does not exist it will be +confirmed before creating a new directory." + (interactive "p") + + (vm-check-for-killed-summary) + (if (vm-interactive-p) (vm-follow-summary-cursor)) + + (let ((successes 0) + (failures 0) + (directory nil)) + (vm-mime-operate-on-attachments + count + :included vm-mime-saveable-types + :excluded vm-mime-saveable-type-exceptions + :name "saving" + :action + (lambda (msg layout type file-name) + (let ((file (vm-read-file-name + (if file-name ; prompt + (format "Save (default %s): " file-name) + (format "Save %s: " type)) + (file-name-as-directory ; directory + (or directory + vm-mime-attachment-save-directory + vm-mime-all-attachments-directory)) + (and file-name ; default-filename + (concat + (file-name-as-directory + (or directory + vm-mime-attachment-save-directory + vm-mime-all-attachments-directory)) + (or file-name ""))) + nil nil ; mustmatch initial + vm-mime-save-all-attachments-history ; predicate + ))) + (setq directory (file-name-directory file)) + (when (file-exists-p file) + (if (y-or-n-p (format "Overwrite `%s'? " file)) + nil ; (delete-file file) + (setq file nil))) + (unless (file-exists-p directory) + (if (y-or-n-p + (format "Directory %s does not exist; create it?" directory)) + (make-directory directory t) + (setq file nil))) + (if (null file) + (setq failures (+ 1 failures)) + (vm-inform 5 "Saving %s" (if file (format " (%s)" file) "")) + (vm-mime-send-body-to-file layout file file) + (if vm-mime-delete-after-saving + (let ((vm-mime-confirm-delete nil)) + (vm-mime-discard-layout-contents + layout (expand-file-name file)))) + (setq successes (+ 1 successes))))) + ) + + (when (vm-interactive-p) + (vm-discard-cached-data count) + (vm-present-current-message)) + + (if (> failures 0) + (if (> successes 0) + (vm-inform 5 "%d attachment%s saved; %s failed" + successes (if (= successes 1) "" "s") failures) + (vm-inform 5 "No attachments saved; %s failed" failures)) + (if (> successes 0) + (vm-inform 5 "%d attachment%s saved" + successes (if (= successes 1) "" "s")) + (vm-inform 5 "No attachments saved"))))) +;; for the karking compiler +(defvar vm-menu-mime-dispose-menu) + +(defun vm-mime-set-image-stamp-for-type (e type) + "Set an image stamp for MIME button extent E as appropriate for +TYPE. USR, 2011-03-25" + (cond + (vm-xemacs-p + (vm-mime-xemacs-set-image-stamp-for-type e type)) + (vm-fsfemacs-p + (vm-mime-fsfemacs-set-image-stamp-for-type e type)))) + +(defconst vm-mime-type-images + '(("text" "text.xpm") + ("image" "image.xpm") + ("audio" "audio.xpm") + ("video" "video.xpm") + ("message" "message.xpm") + ("application" "application.xpm") + ("multipart" "multipart.xpm"))) + +(defun vm-mime-xemacs-set-image-stamp-for-type (e type) + "Set an image stamp for MIME button extent E as appropriate for +TYPE. USR, 2011-03-25" + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p 'xpm) + (> (device-bitplanes) 7)) + (let ((dir (vm-image-directory)) + (tuples vm-mime-type-images) + glyph file sym p) + (setq file (catch 'done + (while tuples + (if (vm-mime-types-match (car (car tuples)) type) + (throw 'done (car tuples)) + (setq tuples (cdr tuples)))) + nil) + file (and file (nth 1 file)) + sym (and file (intern file vm-image-obarray)) + glyph (and sym (boundp sym) (symbol-value sym)) + glyph (or glyph + (and file + (make-glyph + (list + (vector 'xpm ':file + (expand-file-name file dir)) + [nothing]))))) + (and sym (not (boundp sym)) (set sym glyph)) + (and glyph (set-extent-begin-glyph e glyph))))) + +(defun vm-mime-fsfemacs-set-image-stamp-for-type (e type) + "Set an image stamp for MIME button extent E as appropriate for +TYPE. + +This is done by extending the extent with one character position at +the front and placing the image there as the display text property. + USR, 2011-03-25" + (if (and (vm-images-possible-here-p) + (vm-image-type-available-p 'xpm)) + (let ((dir (vm-image-directory)) + (tuples vm-mime-type-images) + file) + (setq file (catch 'done + (while tuples + (if (vm-mime-types-match (car (car tuples)) type) + (throw 'done (car tuples)) + (setq tuples (cdr tuples)))) + nil) + file (and file (nth 1 file)) + file (and file (expand-file-name file dir))) + (if file + (save-excursion + (let ((buffer-read-only nil)) + (set-buffer (overlay-buffer e)) + (goto-char (overlay-start e)) + (insert "x") + (move-overlay e (1- (point)) (overlay-end e)) + (put-text-property (1- (point)) (point) 'display + (list 'image + ':ascent 80 + ':color-symbols + (list + (cons "background" + (cdr (assq + 'background-color + (frame-parameters))))) + ':type 'xpm + ':file file)))))))) + +(defun* vm-mime-insert-button (&key caption action layout (disposable nil)) + "Display a button for a mime object, using CAPTION as the label (a +string) and ACTION as the default action (a function). The mime object +is described by LAYOUT. If DISPOSABLE is true, then the button will +be removed when it is expanded to display the mime object." + (let ((start (point)) e + (keymap vm-mime-reader-map) + (buffer-read-only nil)) + (if (fboundp 'set-keymap-parents) + (if (current-local-map) + (set-keymap-parents keymap (list (current-local-map)))) + (setq keymap (append keymap (current-local-map)))) + (if (not (bolp)) + (insert "\n")) + (insert caption "\n") + ;; we must use the same interface that the vm-extent functions + ;; use. if they use overlays, then we call make-overlay. + (if vm-fsfemacs-p + ;; we MUST have the five arg make-overlay. overlays must + ;; advance when text is inserted at their start position or + ;; inline text and graphics will seep into the button + ;; overlay and then be removed when the button is removed. + (setq e (vm-make-extent start (point) nil t nil)) + (setq e (vm-make-extent start (point))) + (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'end-open t)) + (vm-mime-set-image-stamp-for-type e (car (vm-mm-layout-type layout))) + (when vm-fsfemacs-p + (vm-set-extent-property e 'local-map keymap)) + (when vm-xemacs-p + (vm-set-extent-property e 'highlight t) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'balloon-help 'vm-mouse-3-help)) + ;; for all + (vm-set-extent-property e 'vm-button t) + (vm-set-extent-property e 'vm-mime-disposable disposable) + (vm-set-extent-property e 'face vm-mime-button-face) + (vm-set-extent-property e 'mouse-face vm-mime-button-mouse-face) + (vm-set-extent-property e 'vm-mime-layout layout) + (vm-set-extent-property e 'vm-mime-function action) + ;; for vm-continue-postponed-message + (when vm-xemacs-p + (vm-set-extent-property e 'duplicable t)) + (when vm-fsfemacs-p + (put-text-property (overlay-start e) + (overlay-end e) + 'vm-mime-layout layout)) + ;; return t as decoding worked + t)) + +(defun vm-mime-rewrite-failed-button (button error-string) + (let* ((buffer-read-only nil) + (start (point))) + (goto-char (vm-extent-start-position button)) + (insert (format "DISPLAY FAILED -- %s\n" error-string)) + (vm-set-extent-endpoints button start (vm-extent-end-position button)) + (delete-region (point) (vm-extent-end-position button)))) + + +;;--------------------------------------------------------------------------- +;;; MIME button operations +;; +;; vm-mime-send-body-to-file: (extent-or-layout +;; &optional filename filepath bool) -> filename +;; vm-mime-send-body-to-folder: (extent-or-layout +;; &optional filename) -> filename +;; vm-mime-delete-body-after-saving: (extent) -> void +;; vm-mime-pipe-body-to-queried-command: (extent &optional bool) -> bool +;; vm-mime-pipe-body-to-queried-command-discard-output: (extent) -> bool +;; vm-mime-send-body-to-printer: (extent) -> bool +;; vm-mime-display-body-as-text: (extent) -> ? +;; vm-mime-display-object-as-type: (extent) -> ? +;; vm-mime-display-body-using-external-viewer: (extent) -> ? +;; vm-mime-convert-body-then-display: (extent) -> ? +;; vm-mime-attach-body-to-composition: (extent) -> ? +;;--------------------------------------------------------------------------- + +;; From: Eric E. Dors +;; Date: 1999/04/01 +;; Newsgroups: gnu.emacs.vm.info +;; example filter-alist variable +(defvar vm-mime-write-file-filter-alist + '(("application/mac-binhex40" . "hexbin -s ")) + "*A list of filter used when writing attachements to files." + ) + +;; function to parse vm-mime-write-file-filter-alist +(defun vm-mime-find-write-filter (type) + (let ((e-alist vm-mime-write-file-filter-alist) + (matched nil)) + (while (and e-alist (not matched)) + (if (and (vm-mime-types-match (car (car e-alist)) type) + (cdr (car e-alist))) + (setq matched (cdr (car e-alist))) + (setq e-alist (cdr e-alist)))) + matched)) + +(defun vm-mime-delete-body-after-saving (layout file) + (unless (vectorp layout) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (unless (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (let ((vm-mime-confirm-delete nil)) + ;; we don't care if the delete fails + (condition-case nil + (vm-delete-mime-object (expand-file-name file)) + (error nil))))) + +(defun vm-mime-send-body-to-file (layout &optional default-filename file + overwrite) + "Writes the body of MIME object given by LAYOUT to FILE. Returns +boolean value indicating success or failure. +The optional argument DEFAULT-FILENAME gives the default filename to +be used if FILE is not specified. OVERWRITE says whether any existing +file with the name should be overwritten." + (unless (vectorp layout) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (setq layout (car (vm-mm-layout-parts layout)))) + (unless default-filename + (setq default-filename (vm-mime-get-disposition-filename layout))) + (when default-filename + (setq default-filename (file-name-nondirectory default-filename))) + (let (;; evade the XEmacs dialog box, yeccch. + (use-dialog-box nil) + (dir vm-mime-attachment-save-directory) + (done nil)) + (unless file + (while (not done) + (setq file + (read-file-name + (if default-filename + (format "Write MIME body to file (default %s): " + default-filename) + "Write MIME body to file: ") + dir default-filename) + file (expand-file-name file dir)) + (if (not (file-directory-p file)) + (setq done t) + (unless default-filename + (error "%s is a directory" file)) + (setq file (expand-file-name default-filename file) + done t)))) + (let ((work-buffer (vm-make-work-buffer)) + (coding-system-for-read (vm-binary-coding-system))) + (unwind-protect + (condition-case err + (with-current-buffer work-buffer + (setq selective-display nil) + ;; Tell DOS/Windows NT whether the file is binary + (setq buffer-file-type (not (vm-mime-text-type-layout-p layout))) + ;; Tell XEmacs/MULE not to mess with the bits unless + ;; this is a text type. + (if (fboundp 'set-buffer-file-coding-system) + (if (vm-mime-text-type-layout-p layout) + (set-buffer-file-coding-system + (vm-line-ending-coding-system) nil) + (set-buffer-file-coding-system (vm-binary-coding-system) t))) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (unless (or overwrite (not (file-exists-p file))) + (or (y-or-n-p "File exists, overwrite? ") + (error "Aborted"))) + ;; Bind the jka-compr-compression-info-list to nil so + ;; that jka-compr won't compress already compressed + ;; data. This is a crock, but as usual I'm getting + ;; the bug reports for somebody else's bad code. + (let ((jka-compr-compression-info-list nil) + (command (vm-mime-find-write-filter + (car (vm-mm-layout-type layout))))) + (if command + (shell-command-on-region + (point-min) (point-max) (concat command " > " file)) + (write-region (point-min) (point-max) file nil nil))) + file ) + (error (vm-warn 1 2 "Error in writing %s: %s" file err) + nil)) + (when work-buffer (kill-buffer work-buffer)))))) + +(defun vm-mime-send-body-to-folder (layout &optional default-filename) + (unless (vectorp layout) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (setq layout (car (vm-mm-layout-parts layout)))) + (let ((type (car (vm-mm-layout-type layout))) + file) + (if (not (or (vm-mime-types-match type "message/rfc822") + (vm-mime-types-match type "message/news"))) + (vm-mime-send-body-to-file layout default-filename) + (let ((work-buffer (vm-make-work-buffer)) + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system))) + (unwind-protect + (with-current-buffer work-buffer + (setq selective-display nil) + ;; Tell DOS/Windows NT whether the file is binary + (setq buffer-file-type t) + ;; Tell XEmacs/MULE not to mess with the bits unless + ;; this is a text type. + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system + (vm-line-ending-coding-system) nil)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (goto-char (point-min)) + (insert (vm-leading-message-separator 'mmdf)) + (goto-char (point-max)) + (insert (vm-trailing-message-separator 'mmdf)) + (set-buffer-modified-p nil) + (vm-mode t) + (let ((vm-check-folder-types t) + (vm-convert-folder-types t)) + (setq file (call-interactively 'vm-save-message))) + (vm-quit-no-change) + file ) + (when work-buffer (kill-buffer work-buffer))))))) + +(defun vm-mime-pipe-body-to-command (command layout &optional discard-output) + (unless (vectorp layout) + (setq layout (vm-extent-property layout 'vm-mime-layout))) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (setq layout (car (vm-mm-layout-parts layout)))) + (let ((output-buffer (if discard-output + 0 + (get-buffer-create "*Shell Command Output*")))) + (when (bufferp output-buffer) + (with-current-buffer output-buffer + (erase-buffer))) + (let ((work-buffer (vm-make-work-buffer))) + (unwind-protect + (with-current-buffer work-buffer + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (setq selective-display nil) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-window-configuration t))) + (process-coding-system-alist + (if (vm-mime-text-type-layout-p layout) + nil + (list (cons "." (vm-binary-coding-system))))) + ;; Tell DOS/Windows NT whether the input is binary + (binary-process-input + (not + (vm-mime-text-type-layout-p layout)))) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil output-buffer nil + shell-command-switch command))) + (when work-buffer (kill-buffer work-buffer)))) + (when (bufferp output-buffer) + (if (not (zerop (with-current-buffer output-buffer (buffer-size)))) + (vm-display output-buffer t (list this-command) + '(vm-pipe-message-to-command)) + (vm-display nil nil (list this-command) + '(vm-pipe-message-to-command)))) + t )) + +(defun vm-mime-pipe-body-to-queried-command (button &optional discard-output) + (let ((command (read-string "Pipe object to command: "))) + (vm-mime-pipe-body-to-command command button discard-output))) + +(defun vm-mime-pipe-body-to-queried-command-discard-output (button) + (vm-mime-pipe-body-to-queried-command button t)) + +(defun vm-mime-send-body-to-printer (button) + (vm-mime-pipe-body-to-command (mapconcat (function identity) + (nconc (list vm-print-command) + vm-print-command-switches) + " ") + button)) + +(defun vm-mime-display-body-as-text (button) + (let ((vm-mime-auto-displayed-content-types '("text/plain")) + (vm-mime-auto-displayed-content-type-exceptions nil) + (layout (copy-sequence (vm-extent-property button 'vm-mime-layout)))) + (vm-set-extent-property button 'vm-mime-disposable t) + (vm-set-extent-property button 'vm-mime-layout layout) + ;; not universally correct, but close enough. + (vm-set-mm-layout-type layout '("text/plain" "charset=us-ascii")) + (goto-char (vm-extent-start-position button)) + (vm-decode-mime-layout button t))) + +(defun vm-mime-display-object-as-type (button) + (let ((vm-mime-auto-displayed-content-types t) + (vm-mime-auto-displayed-content-type-exceptions nil) + (old-layout (vm-extent-property button 'vm-mime-layout)) + layout + (type (read-string "View as MIME type: "))) + (setq layout (copy-sequence old-layout)) + (vm-set-extent-property button 'vm-mime-layout layout) + ;; not universally correct, but close enough. + (setcar (vm-mm-layout-type layout) type) + (goto-char (vm-extent-start-position button)) + (vm-decode-mime-layout button t))) + +(defun vm-mime-display-body-using-external-viewer (button) + (let ((layout (vm-extent-property button 'vm-mime-layout)) + (vm-mime-external-content-type-exceptions nil)) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (if (vm-mm-layout-display-error layout) + (apply 'error (vm-mm-layout-display-error layout))) + ;; Use the child layout for external viewer + (setq layout (car (vm-mm-layout-parts layout)))) + (if (vm-mime-find-external-viewer (car (vm-mm-layout-type layout))) + (vm-mime-display-external-generic layout) + (error "No viewer defined for type %s" + (car (vm-mm-layout-type layout)))))) + +(defun vm-mime-convert-body-then-display (button) + (let ((layout (vm-extent-property button 'vm-mime-layout))) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (if (vm-mm-layout-display-error layout) + (apply 'error (vm-mm-layout-display-error layout))) + (setq layout (car (vm-mm-layout-parts layout)))) + (setq layout (vm-mime-convert-undisplayable-layout layout)) + (if (vm-mm-layout-display-error layout) + (apply 'error (vm-mm-layout-display-error layout))) + (if (null layout) + nil + (vm-set-extent-property button 'vm-mime-disposable t) + (vm-set-extent-property button 'vm-mime-layout layout) + (goto-char (vm-extent-start-position button)) + (vm-decode-mime-layout button t)))) + + +(defun vm-mime-attach-body-to-composition (button) + (let ((layout (vm-extent-property button 'vm-mime-layout)) + (vm-mime-external-content-type-exceptions nil)) + (goto-char (vm-extent-start-position button)) + (when (vm-mime-types-match "message/external-body" + (car (vm-mm-layout-type layout))) + (vm-mime-fetch-message/external-body layout) + (setq layout (car (vm-mm-layout-parts layout)))) + (vm-attach-object-to-composition layout))) + +(defun vm-mime-get-button-layout () + "Return the MIME layout of the MIME button at point. USR, 2011-03-07" + (vm-mime-run-display-function-at-point + (function + (lambda (extent) + (vm-extent-property extent 'vm-mime-layout))))) + +(defun vm-mime-scrub-description (string) + (let ((work-buffer nil)) + (save-excursion + (unwind-protect + (progn + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (insert string) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match " ")) + (buffer-string)) + (and work-buffer (kill-buffer work-buffer)))))) + +;; unused +;;(defun vm-mime-layout-description (layout) +;; (let ((type (car (vm-mm-layout-type layout))) +;; description name) +;; (setq description +;; (if (vm-mm-layout-description layout) +;; (vm-mime-scrub-description (vm-mm-layout-description layout)))) +;; (concat +;; (if description description "") +;; (if description ", " "") +;; (cond ((vm-mime-types-match "multipart/digest" type) +;; (let ((n (length (vm-mm-layout-parts layout)))) +;; (format "digest (%d message%s)" n (if (= n 1) "" "s")))) +;; ((vm-mime-types-match "multipart/alternative" type) +;; "multipart alternative") +;; ((vm-mime-types-match "multipart" type) +;; (let ((n (length (vm-mm-layout-parts layout)))) +;; (format "multipart message (%d part%s)" n (if (= n 1) "" "s")))) +;; ((vm-mime-types-match "text/plain" type) +;; (format "plain text%s" +;; (let ((charset (vm-mime-get-parameter layout "charset"))) +;; (if charset +;; (concat ", " charset) +;; "")))) +;; ((vm-mime-types-match "text/enriched" type) +;; "enriched text") +;; ((vm-mime-types-match "text/html" type) +;; "HTML") +;; ((vm-mime-types-match "image/gif" type) +;; "GIF image") +;; ((vm-mime-types-match "image/jpeg" type) +;; "JPEG image") +;; ((and (vm-mime-types-match "application/octet-stream" type) +;; (setq name (vm-mime-get-parameter layout "name")) +;; (save-match-data (not (string-match "^[ \t]*$" name)))) +;; name) +;; (t type))))) + +(defun vm-mime-layout-contains-type (layout type) + (if (vm-mime-types-match type (car (vm-mm-layout-type layout))) + layout + (let ((p (vm-mm-layout-parts layout)) + (result nil) + (done nil)) + (while (and p (not done)) + (if (setq result (vm-mime-layout-contains-type (car p) type)) + (setq done t) + (setq p (cdr p)))) + result ))) + +;; breadth first traversal +(defun vm-mime-find-digests-in-layout (layout) + (let ((layout-list (list layout)) + layout-type + (result nil)) + (while layout-list + (setq layout-type (car (vm-mm-layout-type (car layout-list)))) + (cond ((string-match "^multipart/digest\\|message/\\(rfc822\\|news\\)" + layout-type) + (setq result (nconc result (list (car layout-list))))) + ((vm-mime-composite-type-p layout-type) + (setq layout-list (nconc layout-list + (copy-sequence + (vm-mm-layout-parts + (car layout-list))))))) + (setq layout-list (cdr layout-list))) + result )) + +(defun vm-mime-plain-message-p (m) + "A message M is considered plain if + - it does not have encoded headers, and + - - it does not have a MIME layout, or + - - it has a text/plain component as its first element with ASCII + - - character set and unibyte encoding (7bit, 8bit or binary). +Returns non-NIL value M is a plain message." + (save-match-data + (let ((o (vm-mm-layout m)) + (case-fold-search t)) + (and (eq (vm-mm-encoded-header m) 'none) + (or (not (vectorp o)) + (and (vm-mime-types-match "text/plain" + (car (vm-mm-layout-type o))) + (string-match "^us-ascii$" + (or (vm-mime-get-parameter o "charset") + "us-ascii")) + (string-match "^\\(7bit\\|8bit\\|binary\\)$" + (vm-mm-layout-encoding o)))))))) + +(defun vm-mime-text-type-p (type) + (let ((case-fold-search t)) + (or (string-match "^text/" type) (string-match "^message/" type)))) + +(defun vm-mime-text-type-layout-p (layout) + (or (vm-mime-types-match "text" (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message" (car (vm-mm-layout-type layout))))) + + +(defun vm-mime-tty-can-display-mime-charset (name) + "Can the current TTY correctly display the given MIME character set?" + (and (fboundp 'console-tty-output-coding-system) + ;; Is this check too paranoid? + (vm-coding-system-p (console-tty-output-coding-system)) + (fboundp 'coding-system-get) + (let + ;; Nnngh, latin-unity-base-name isn't doing the right thing for + ;; me with MULE-UCS and UTF-8 as the terminal coding system. Of + ;; course, it's not evident that it _can_ do the right thing. + ;; + ;; The intention is that ourtermcs is the version of the + ;; coding-system without line-ending information attached to its + ;; end. + ((ourtermcs (vm-coding-system-name + (or (car + (coding-system-get + (console-tty-output-coding-system) + 'alias-coding-systems)) + (coding-system-base + (console-tty-output-coding-system)))))) + (or (eq ourtermcs (vm-mime-charset-to-coding name)) + ;; The vm-mime-mule-charset-to-coding-alist check is to make + ;; sure it does the right thing with a nonsense MIME character + ;; set name. + (and (memq ourtermcs (vm-get-mime-ucs-list)) + (vm-mime-charset-to-coding name) + t) + (vm-mime-default-face-charset-p name))))) + +(defun vm-mime-charset-internally-displayable-p (name) + "Can the given MIME charset be displayed within emacs by VM?" + (cond ((and vm-xemacs-mule-p (memq (vm-device-type) '(x gtk mswindows))) + (or (vm-mime-charset-to-coding name) + (vm-mime-default-face-charset-p name))) + + ;; vm-mime-tty-can-display-mime-charset (called below) fails + ;; for GNU Emacs. So keep things simple, since there's no harm + ;; if replacement characters are displayed. + (vm-fsfemacs-mule-p) + ((vm-multiple-fonts-possible-p) + (or (vm-mime-default-face-charset-p name) + (vm-string-assoc name vm-mime-charset-font-alist))) + + ;; If the terminal-coding-system variable is set to something that + ;; can encode all the characters of the given MIME character set, + ;; then we can display any message in the given MIME character set + ;; internally. + + ((vm-mime-tty-can-display-mime-charset name)) + (t + (vm-mime-default-face-charset-p name)))) + +(defun vm-mime-default-face-charset-p (charset) + (and (or (eq vm-mime-default-face-charsets t) + (and (consp vm-mime-default-face-charsets) + (vm-string-member charset vm-mime-default-face-charsets))) + (not (vm-string-member charset + vm-mime-default-face-charset-exceptions)))) + + +(defun vm-mime-find-message/partials (layout id) + (let ((list nil) + (type (vm-mm-layout-type layout))) + (cond ((vm-mime-composite-type-p (car (vm-mm-layout-type layout))) + (let ((parts (vm-mm-layout-parts layout)) o) + (while parts + (setq o (vm-mime-find-message/partials (car parts) id)) + (if o + (setq list (nconc o list))) + (setq parts (cdr parts))))) + ((vm-mime-types-match "message/partial" (car type)) + (if (equal (vm-mime-get-parameter layout "id") id) + (setq list (cons layout list))))) + list )) + +(defun vm-mime-find-leaf-content-id-in-layout-folder (layout id) + (save-excursion + (save-restriction + (let (m (o nil)) + (set-buffer (vm-buffer-of + (vm-real-message-of + (vm-mm-layout-message layout)))) + (widen) + (goto-char (point-min)) + (while (and (search-forward id nil t) + (setq m (vm-message-at-point))) + (setq o (vm-mm-layout m)) + (if (not (vectorp o)) + nil + (setq o (vm-mime-find-leaf-content-id o id)) + (if (null o) + nil + ;; if we found it, end the search loop + (goto-char (point-max))))) + o )))) + +(defun vm-mime-find-leaf-content-id (layout id) + (let ((list nil) + (type (vm-mm-layout-type layout))) + (catch 'done + (cond ((vm-mime-composite-type-p (car (vm-mm-layout-type layout))) + (let ((parts (vm-mm-layout-parts layout)) o) + (while parts + (setq o (vm-mime-find-leaf-content-id (car parts) id)) + (if o + (throw 'done o)) + (setq parts (cdr parts))))) + (t + (if (equal (vm-mm-layout-id layout) id) + (throw 'done layout))))))) + +(defun vm-message-at-point () + (let ((mp vm-message-list) + (point (point)) + (done nil)) + (while (and mp (not done)) + (if (and (>= point (vm-start-of (car mp))) + (<= point (vm-end-of (car mp)))) + (setq done t) + (setq mp (cdr mp)))) + (car mp))) + +(defun vm-mime-make-multipart-boundary () + (let ((boundary (make-string 10 ?a)) + (i 0)) + (random t) + (while (< i (length boundary)) + (aset boundary i (aref vm-mime-base64-alphabet + (% (vm-abs (lsh (random) -8)) + (length vm-mime-base64-alphabet)))) + (vm-increment i)) + boundary )) + +(defun vm-mime-extract-filename-suffix (layout) + (let ((filename (vm-mime-get-disposition-filename layout)) + (suffix nil) i) + (if (and filename (string-match "\\.[^.]+$" filename)) + (setq suffix (substring filename (match-beginning 0) (match-end 0)))) + suffix )) + +(defun vm-mime-find-filename-suffix-for-type (layout) + (let ((type (car (vm-mm-layout-type layout))) + suffix + (alist vm-mime-attachment-auto-suffix-alist)) + (while alist + (if (vm-mime-types-match (car (car alist)) type) + (setq suffix (cdr (car alist)) + alist nil) + (setq alist (cdr alist)))) + suffix )) + +;;;###autoload + + +(defun vm-attach-file (file type &optional charset description + no-suggested-filename) + "Attach a file to a VM composition buffer to be sent along with the message. +The file is not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. A visible tag +indicating the existence of the attachment is placed in the +composition buffer. You can move the attachment around or remove +it entirely with normal text editing commands. If you remove the +attachment tag, the attachment will not be sent. + +First argument, FILE, is the name of the file to attach. Second +argument, TYPE, is the MIME Content-Type of the file. Optional +third argument CHARSET is the character set of the attached +document. This argument is only used for text types, and it is +ignored for other types. Optional fourth argument DESCRIPTION +should be a one line description of the file. Nil means include +no description. Optional fifth argument NO-SUGGESTED-FILENAME non-nil +means that VM should not add a filename to the Content-Disposition +header created for the object. + +When called interactively all arguments are read from the +minibuffer. + +This command is for attaching files that do not have a MIME +header section at the top. For files with MIME headers, you +should use `vm-attach-mime-file' to attach such a file. VM +will extract the content type information from the headers in +this case and not prompt you for it in the minibuffer." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + (completion-ignored-extensions nil) + (charset nil) + description file default-type type) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (setq file (vm-read-file-name "Attach file: " + vm-mime-attachment-source-directory + nil t) + default-type (or (vm-mime-default-type-from-filename file) + "application/octet-stream") + type (completing-read + (format "Content type (default %s): " + default-type) + vm-mime-type-completion-alist) + type (if (> (length type) 0) type default-type)) + (when (vm-mime-types-match "text" type) + (setq charset (completing-read "Character set (default US-ASCII): " + vm-mime-charset-completion-alist) + charset (if (> (length charset) 0) charset))) + (setq description (read-string "One line description: ")) + (when (string-match "^[ \t]*$" description) + (setq description nil)) + (list file type charset description nil))) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (unless (file-exists-p file) + (error "No such file: %s" file)) + (unless (file-readable-p file) + (error "You don't have permission to read %s" file)) + (when charset + (setq charset (list (concat "charset=" charset)))) + (when description + (setq description (vm-mime-scrub-description description))) + (vm-attach-object file :type type :params charset + :description description :mimed nil)) +(defalias 'vm-mime-attach-file 'vm-attach-file) + +;;;###autoload +(defun vm-attach-mime-file (file type) + "Attach a MIME encoded file to a VM composition buffer to be sent +along with the message. + +The file is not inserted into the buffer until you execute +`vm-mail-send' or `vm-mail-send-and-exit'. A visible tag indicating +the existence of the attachment is placed in the composition +buffer. You can move the attachment around or remove it entirely +with normal text editing commands. If you remove the attachment +tag, the attachment will not be sent. + +The first argument, FILE, is the name of the file to attach. +When called interactively the FILE argument is read from the +minibuffer. + +The second argument, TYPE, is the MIME Content-Type of the object. + +This command is for attaching files that have a MIME +header section at the top. For files without MIME headers, you +should use `vm-attach-file' to attach the file." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + file type default-type) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (setq file (vm-read-file-name "Attach file: " + vm-mime-attachment-source-directory + nil t) + default-type (or (vm-mime-default-type-from-filename file) + "application/octet-stream") + type (completing-read + (format "Content type (default %s): " + default-type) + vm-mime-type-completion-alist) + type (if (> (length type) 0) type default-type)) + (list file type))) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when (file-directory-p file) + (error "%s is a directory, cannot attach" file)) + (unless (file-exists-p file) + (error "No such file: %s" file)) + (unless (file-readable-p file) + (error "You don't have permission to read %s" file)) + (vm-attach-object file :type type :params nil + :description nil :mimed t)) +(defalias 'vm-mime-attach-mime-file 'vm-attach-mime-file) + +;;;###autoload +(defun vm-attach-buffer (buffer type &optional charset description) + "Attach a buffer to a VM composition buffer to be sent along with +the message. + +The buffer contents are not inserted into the composition +buffer and MIME encoded until you execute `vm-mail-send' or +`vm-mail-send-and-exit'. A visible tag indicating the existence +of the attachment is placed in the composition buffer. You +can move the attachment around or remove it entirely with +normal text editing commands. If you remove the attachment +tag, the attachment will not be sent. + +First argument, BUFFER, is the buffer or name of the buffer to +attach. Second argument, TYPE, is the MIME Content-Type of the +file. Optional third argument CHARSET is the character set of +the attached document. This argument is only used for text +types, and it is ignored for other types. Optional fourth +argument DESCRIPTION should be a one line description of the +file. Nil means include no description. + +When called interactively all arguments are read from the +minibuffer. + +This command is for attaching files that do not have a MIME +header section at the top. For files with MIME headers, you +should use `vm-attach-mime-file' to attach such a file. VM +will extract the content type information from the headers in +this case and not prompt you for it in the minibuffer." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + (charset nil) + description file default-type type buffer buffer-name) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (setq buffer-name (read-buffer "Attach buffer: " nil t) + default-type (or (vm-mime-default-type-from-filename buffer-name) + "application/octet-stream") + type (completing-read + (format "Content type (default %s): " + default-type) + vm-mime-type-completion-alist) + type (if (> (length type) 0) type default-type)) + (when (vm-mime-types-match "text" type) + (setq charset (completing-read "Character set (default US-ASCII): " + vm-mime-charset-completion-alist) + charset (if (> (length charset) 0) charset))) + (setq description (read-string "One line description: ")) + (when (string-match "^[ \t]*$" description) + (setq description nil)) + (list buffer-name type charset description))) + (unless (setq buffer (get-buffer buffer)) + (error "Buffer %s does not exist." buffer)) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when charset + (setq charset (list (concat "charset=" charset)))) + (when description + (setq description (vm-mime-scrub-description description))) + (vm-attach-object buffer :type type :params charset + :description description :mimed nil)) +(defalias 'vm-mime-attach-buffer 'vm-attach-buffer) + + +;;;###autoload +(defun vm-attach-message (message &optional description) + "Attach a message from a VM folder to the current VM +composition. + +The message is not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. A visible tag +indicating the existence of the attachment is placed in the +composition buffer. You can move the attachment around or remove +it entirely with normal text editing commands. If you remove the +attachment tag, the attachment will not be sent. + +First argument, MESSAGE, is either a VM message struct or a list +of message structs. When called interactively a message number is read +from the minibuffer. The message will come from the parent +folder of this composition. If the composition has no parent, +the name of a folder will be read from the minibuffer before the +message number is read. + +If this command is invoked with a prefix argument, the name of a +folder is read and that folder is used instead of the parent +folder of the composition. + +If this command is invoked on marked message (via +`vm-next-command-uses-marks') the marked messages in the selected +folder will be attached as a MIME message digest. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are attached. + +Optional second argument DESCRIPTION is a one-line description of +the message being attached. This is also read from the +minibuffer if the command is run interactively." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + (result 0) + mlist mp default prompt description folder) + (unless (eq major-mode 'mail-mode) + (error "Command must be used in a VM Mail mode buffer.")) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when current-prefix-arg + (setq vm-mail-buffer (vm-read-folder-name) + vm-mail-buffer (if (string= vm-mail-buffer "") nil + (setq current-prefix-arg nil) + (get-buffer vm-mail-buffer)))) + (cond ((or current-prefix-arg (null vm-mail-buffer) + (not (buffer-live-p vm-mail-buffer))) + (let ((dir (if vm-folder-directory + (expand-file-name vm-folder-directory) + default-directory)) + file) + (let ((last-command last-command) + (this-command this-command)) + (setq file (read-file-name "Attach message from folder: " + dir nil t))) + (let ((coding-system-for-read (vm-binary-coding-system))) + (setq folder (find-file-noselect file))) + (with-current-buffer folder + (vm-mode) + (setq mlist (vm-select-operable-messages 1 t "Attach"))))) + (t + (setq folder vm-mail-buffer) + (with-current-buffer folder + (setq mlist (vm-select-operable-messages 1 t "Attach"))))) + (when (null mlist) + (with-current-buffer folder + (setq default (and vm-message-pointer + (vm-number-of (car vm-message-pointer))) + prompt (if default + (format "Attach message number: (default %s) " + default) + "Attach message number: ")) + (while (zerop result) + (setq result (read-string prompt)) + (and (string= result "") default (setq result default)) + (setq result (string-to-number result))) + (when (null (setq mp (nthcdr (1- result) vm-message-list))) + (error "No such message.")))) + (setq description (read-string "Description: ")) + (when (string-match "^[ \t]*$" description) + (setq description nil)) + (list (or mlist (car mp)) description))) + + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (cond ((not (consp message)) + (vm-attach-message-internal message description)) + ((null (cdr message)) + (vm-attach-message-internal (car message) description)) + (t + (vm-attach-message-digest-internal message description)))) +(defalias 'vm-mime-attach-message 'vm-attach-message) + + +(defun vm-attach-message-internal (message description) + "Attach MESSAGE as a mime object to the current composition. Use +DESCRIPTION." + (let* ((work-buffer (vm-generate-new-unibyte-buffer "*attached message*")) + (m (vm-real-message-of message)) + (folder (vm-buffer-of m))) + (with-current-buffer work-buffer + (vm-insert-region-from-buffer folder (vm-headers-of m) (vm-text-end-of m)) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp vm-internal-unforwarded-header-regexp)) + (when description + (setq description (vm-mime-scrub-description description))) + (vm-attach-object work-buffer + :type "message/rfc822" :params nil + :disposition '("inline") + :description description) + (make-local-variable 'vm-forward-list) + (setq vm-system-state 'forwarding + vm-forward-list (list message)) + ;; move window point forward so that if this command + ;; is used consecutively, the insertions will be in + ;; the correct order in the composition buffer. + (let ((w (vm-get-buffer-window (current-buffer)))) + (when w (set-window-point w (point)))) + (add-hook 'kill-buffer-hook + `(lambda () + (if (eq (current-buffer) ,(current-buffer)) + (kill-buffer ,work-buffer)))))) + +(defun vm-attach-message-digest-internal (mlist description) + "Attach MLIST as a mail digest object to the current composition. Use +DESCRIPTION." + (let ((work-buffer (vm-generate-new-unibyte-buffer "*attached messages*")) + boundary) + (with-current-buffer work-buffer + (setq boundary (vm-mime-encapsulate-messages + mlist :keep-list vm-mime-digest-headers + :discard-regexp vm-mime-digest-discard-header-regexp + :always-use-digest t)) + (goto-char (point-min)) + (insert "MIME-Version: 1.0\n") + (insert "Content-Type: " + (vm-mime-type-with-params + "multipart/digest" (list (concat "boundary=\"" boundary "\""))) + "\n") + (insert "Content-Transfer-Encoding: " + (vm-determine-proper-content-transfer-encoding + (point) (point-max)) + "\n\n")) + (when description + (setq description (vm-mime-scrub-description description))) + (vm-attach-object work-buffer :type "multipart/digest" + :params (list (concat "boundary=\"" boundary "\"")) + :disposition '("inline") + :description description :mimed t) + (make-local-variable 'vm-forward-list) + (setq vm-system-state 'forwarding + vm-forward-list (copy-sequence mlist)) + ;; move window point forward so that if this command + ;; is used consecutively, the insertions will be in + ;; the correct order in the composition buffer. + (let ((w (vm-get-buffer-window (current-buffer)))) + (when w (set-window-point w (point)))) + (add-hook 'kill-buffer-hook + `(lambda () + (if (eq (current-buffer) ,(current-buffer)) + (kill-buffer ,work-buffer)))))) +;;;###autoload +(defun vm-attach-message-to-composition (composition &optional description) + "Attach the current message from the current VM folder to a VM +composition. + +The message is not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. A visible tag +indicating the existence of the attachment is placed in the +composition buffer. You can move the attachment around or remove +it entirely with normal text editing commands. If you remove the +attachment tag, the attachment will not be sent. + +First argument COMPOSITION is the buffer into which the object +will be inserted. When this function is called interactively +COMPOSITION's name will be read from the minibuffer. + +If this command is invoked on marked message (via +`vm-next-command-uses-marks') the marked messages in the selected +folder will be attached as a MIME message digest. If +applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are attached. + +Optional second argument DESCRIPTION is a one-line description of +the message being attached. This is also read from the +minibuffer if the command is run interactively." + (interactive + ;; protect value of last-command and this-command + (let ((last-command last-command) + (this-command this-command) + description) + (save-current-buffer + (vm-select-folder-buffer-and-validate 1 t) + (unless (memq major-mode '(vm-mode vm-virtual-mode)) + (error "Command must be used in a VM buffer.")) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (list + (read-buffer "Attach object to buffer: " (vm-find-composition-buffer) t) + (progn (setq description (read-string "Description: ")) + (when (string-match "^[ \t]*$" description) + (setq description nil)) + description))))) + + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (vm-follow-summary-cursor) + + (let ((mlist (vm-select-operable-messages 1 t "Attach"))) + (when (null mlist) + (setq mlist (list (vm-current-message)))) + + (with-current-buffer composition + (if (null (cdr mlist)) ; single message + (vm-attach-message-internal (car mlist) description) + (vm-attach-message-digest-internal mlist description))))) +(defalias 'vm-mime-attach-message-to-composition + 'vm-attach-message-to-composition) + +;;;###autoload +(defun vm-attach-object-to-composition (layout &optional composition) + "Attach the mime object described by LAYOUT to a VM composition buffer. + +The object is not inserted into the buffer and MIME encoded until +you execute `vm-mail-send' or `vm-mail-send-and-exit'. A visible tag +indicating the existence of the object is placed in the +composition buffer. You can move the object around or remove +it entirely with normal text editing commands. If you remove the +object tag, the object will not be sent. + +The optional argument COMPOSITION is the buffer into which the object +will be inserted. When this function is called interactively +COMPOSITION's name will be read from the minibuffer." + (unless composition + (setq composition (read-buffer "Attach object to buffer: " + (vm-find-composition-buffer) t))) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + + (let ((work-buffer (vm-make-work-buffer)) + buf start w) + (unwind-protect + (with-current-buffer work-buffer + (vm-mime-insert-mime-headers layout) + (insert "\n") + (setq start (point)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout start (point-max)) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil :discard-regexp "Content-Transfer-Encoding:") + (insert "Content-Transfer-Encoding: binary\n") + (set-buffer composition) + ;; FIXME need to copy the disposition from the original + (vm-attach-object work-buffer + :type (car (vm-mm-layout-type layout)) + :params (cdr (vm-mm-layout-type layout)) + :description (vm-mm-layout-description + layout) + :mimed t) + ;; move window point forward so that if this command + ;; is used consecutively, the insertions will be in + ;; the correct order in the composition buffer. + (setq w (vm-get-buffer-window composition)) + (and w (set-window-point w (point))) + (setq buf work-buffer + work-buffer nil) ; schedule to be killed later + (add-hook 'kill-buffer-hook + `(lambda () + (if (eq (current-buffer) ,(current-buffer)) + (kill-buffer ,buf)))) + ) + ;; unwind-protection + (when work-buffer (kill-buffer work-buffer))))) +(defalias 'vm-mime-attach-object-to-composition + 'vm-attach-object-to-composition) +(defalias 'vm-mime-attach-object-from-message + 'vm-attach-object-to-composition) +(make-obsolete 'vm-mime-attach-object-from-message + 'vm-attach-object-to-composition "8.2.0") + + +(defun* vm-attach-object (object &key type params description + (mimed nil) + (disposition '("unspecified")) + (no-suggested-filename nil)) + "Attach a MIME OBJECT to the mail composition in the current +buffer. The OBJECT could be: + - the full path name of a file + - a buffer, or + - a list with the elements: buffer, start position, end position, + disposition and optional file name. +TYPE, PARAMS and DESCRIPTION and DISPOSITION are the standard MIME +properties. +MIMED says whether the OBJECT already has MIME headers. +Optional argument NO-SUGGESTED-FILENAME is a boolean indicating that +there is no file name for this object. USR, 2011-03-07" + (unless (eq major-mode 'mail-mode) + (error "VM internal error: vm-attach-object not in Mail mode buffer.")) + (when (vm-mail-mode-get-header-contents "MIME-Version") + (error "Can't attach MIME object to already encoded MIME buffer.")) + (let (start end e tag-string file-name + (fb (list vm-mime-forward-local-external-bodies))) + (cond ((and (stringp object) (not mimed)) + (if (or (vm-mime-types-match "application" type) + (vm-mime-types-match "model" type)) + (setq disposition (list "attachment")) + (setq disposition (list "inline"))) + (unless no-suggested-filename + (setq file-name (file-name-nondirectory object)) + ;; why fuse things together? USR, 2011-03-17 +;; (setq type +;; (concat type "; name=\"" file-name "\"")) + (setq params + (list (concat "name=\"" file-name "\""))) + (setq disposition + (nconc disposition + (list (concat "filename=\"" file-name "\"")))))) + ((listp object) + (setq file-name (nth 4 object)) + (setq disposition (nth 3 object))) + (t + (setq file-name + (or (vm-mime-get-xxx-parameter "name" params) + (vm-mime-get-xxx-parameter "filename" params))))) + (when (< (point) (save-excursion (mail-text) (point))) + (mail-text)) + (setq start (point)) + (setq tag-string (format "[ATTACHMENT %s, %s]" + (or file-name description "") + (or type "MIME file"))) +;; (if (listp object) +;; (setq tag-string (format "[ATTACHMENT %s, %s]" +;; (or (nth 4 object) "") type)) +;; (setq tag-string (format "[ATTACHMENT %s, %s]" object +;; (or type "MIME file")))) + (insert tag-string "\n") + (setq end (1- (point))) + + + (cond (vm-fsfemacs-p + (put-text-property start end 'front-sticky nil) + (put-text-property start end 'rear-nonsticky t) + ;; can't be intangible because menu clicking at a position + ;; needs to set point inside the tag so that a command can + ;; access the text properties there. + ;; (put-text-property start end 'intangible object) + (put-text-property start end 'face vm-attachment-button-face) + (put-text-property start end 'font-lock-face + vm-attachment-button-face) + (put-text-property start end 'mouse-face + vm-attachment-button-mouse-face) + (put-text-property start end 'vm-mime-forward-local-refs fb) + (put-text-property start end 'vm-mime-type type) + (put-text-property start end 'vm-mime-object object) + (put-text-property start end 'vm-mime-parameters params) + (put-text-property start end 'vm-mime-description description) + (put-text-property start end 'vm-mime-disposition disposition) + (put-text-property start end 'vm-mime-encoding nil) + (put-text-property start end 'vm-mime-encoded mimed) + ;; (put-text-property start end 'duplicable t) + ) + (vm-xemacs-p + (setq e (vm-make-extent start end)) + (vm-mime-set-image-stamp-for-type e (or type "text/plain")) + (vm-set-extent-property e 'start-open t) + (vm-set-extent-property e 'face vm-mime-button-face) + (vm-set-extent-property e 'mouse-face vm-mime-button-mouse-face) + (vm-set-extent-property e 'duplicable t) + (let ((keymap (make-sparse-keymap))) + (when vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 + 'vm-menu-popup-attachment-menu)) + (define-key keymap [return] 'vm-mime-change-content-disposition) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'balloon-help 'vm-mouse-3-help)) + (vm-set-extent-property e 'vm-mime-forward-local-refs fb) + (vm-set-extent-property e 'vm-mime-type type) + (vm-set-extent-property e 'vm-mime-object object) + (vm-set-extent-property e 'vm-mime-parameters params) + (vm-set-extent-property e 'vm-mime-description description) + (vm-set-extent-property e 'vm-mime-disposition disposition) + (vm-set-extent-property e 'vm-mime-encoding nil) + (vm-set-extent-property e 'vm-mime-encoded mimed))))) +(defalias 'vm-mime-attach-object 'vm-attach-object) + +(defun vm-mime-attachment-forward-local-refs-at-point () + (cond (vm-fsfemacs-p + (let ((fb (get-text-property (point) 'vm-mime-forward-local-refs))) + (car fb) )) + (vm-xemacs-p + (let* ((e (vm-extent-at (point) 'vm-mime-type)) + (fb (vm-extent-property e 'vm-mime-forward-local-refs))) + (car fb) )))) + +(defun vm-mime-set-attachment-forward-local-refs-at-point (val) + (cond (vm-fsfemacs-p + (let ((fb (get-text-property (point) 'vm-mime-forward-local-refs))) + (setcar fb val) )) + (vm-xemacs-p + (let* ((e (vm-extent-at (point) 'vm-mime-type)) + (fb (vm-extent-property e 'vm-mime-forward-local-refs))) + (setcar fb val) )))) + +(defun vm-mime-delete-attachment-button () + (cond (vm-fsfemacs-p + ;; TODO + ) + (vm-xemacs-p + (let ((e (vm-extent-at (point) 'vm-mime-type))) + (delete-region (vm-extent-start-position e) + (vm-extent-end-position e)))))) + +(defun vm-mime-delete-attachment-button-keep-infos () + (cond (vm-fsfemacs-p + ;; TODO + ) + (vm-xemacs-p + (let ((e (vm-extent-at (point) 'vm-mime-type))) + (save-excursion + (goto-char (1+ (vm-extent-start-position e))) + (insert " --- DELETED ") + (goto-char (vm-extent-end-position e)) + (insert " ---") + (vm-delete-extent e)))))) + +;;;###autoload +(defun vm-mime-change-content-disposition () + (interactive) + (vm-mime-set-attachment-disposition-at-point + (intern + (completing-read "Disposition-type: " + '(("unspecified") ("inline") ("attachment")) + nil + t)))) + +(defun vm-mime-attachment-disposition-at-point () + (cond (vm-fsfemacs-p + (let ((disp (get-text-property (point) 'vm-mime-disposition))) + (intern (car disp)))) + (vm-xemacs-p + (let* ((e (vm-extent-at (point) 'vm-mime-disposition)) + (disp (vm-extent-property e 'vm-mime-disposition))) + (intern (car disp)))))) + +(defun vm-mime-set-attachment-disposition-at-point (sym) + (cond (vm-fsfemacs-p + (let ((disp (get-text-property (point) 'vm-mime-disposition))) + (setcar disp (symbol-name sym)))) + (vm-xemacs-p + (let* ((e (vm-extent-at (point) 'vm-mime-disposition)) + (disp (vm-extent-property e 'vm-mime-disposition))) + (setcar disp (symbol-name sym)))))) + + +(defun vm-mime-attachment-encoding-at-point () + (cond (vm-fsfemacs-p + (get-text-property (point) 'vm-mime-encoding)) + (vm-xemacs-p + (let ((e (vm-extent-at (point) 'vm-mime-encoding))) + (if e (vm-extent-property e 'vm-mime-encoding)))))) + +(defun vm-mime-set-attachment-encoding-at-point (sym) + (cond (vm-fsfemacs-p + ;; (set-text-property (point) 'vm-mime-encoding sym) + (put-text-property (point) (point) 'vm-mime-encoding sym) + ) + (vm-xemacs-p + (let ((e (vm-extent-at (point) 'vm-mime-disposition))) + (vm-set-extent-property e 'vm-mime-encoding sym))))) + +(defun vm-disallow-overlay-endpoint-insertion + (overlay after start end &optional old-size) + "Hook function called before and after text is inserted at the +endpoint of an OVERLAY. AFTER is true if the call is being made after +insertion. Otherwise, it is being made before insertion. START and +END denote the range of the text inserted. Optional argument +OLD-SIZE is ignored. + +This hook does nothing when called before insertion. When it is +called after insertion, it moves the overlay so that the inserted is +excluded from the overlay." + (when after + (cond ((= start (overlay-start overlay)) + (move-overlay overlay end (overlay-end overlay))) + ((= start (overlay-end overlay)) + (move-overlay overlay (overlay-start overlay) start))))) + +(defun vm-mime-attachment-button-extents (start end &optional prop) + "Return the extents of all attachment buttons in the region. Optional +argument PROP can specify an extent property, in which case only those +extents that have the property are returned. + +In GNU Emacs version of this function, attachment buttons are expected +to be denoted by text-properties rather than extents. \"Fake\" +extents are created for the purpose of this function. USR, 2011-03-27" + (let ((e-list (if vm-xemacs-p + (vm-extent-list start end prop) + (vm-mime-fake-attachment-overlays start end prop)))) + (sort e-list (function + (lambda (e1 e2) + (< (vm-extent-end-position e1) + (vm-extent-end-position e2))))))) + +(defun vm-mime-fake-attachment-overlays (start end &optional prop) + "For all attachment buttons in the region, i.e., pieces of text +with the given text property PROP, create \"fake\" attachment +overlays with the 'vm-mime-object property. The list of these +overlays is returned. + +This function is only used with GNU Emacs, not XEmacs. USR, 2011-02-19" + ;; This round about method is being used because in GNU Emacs, + ;; only text properties are preserved under killing and yanking. + ;; So, text properties are normally used for attachment buttons and + ;; converted to overlays just before MIME encoding. USR, 2011-02-19 + (when (null prop) (setq prop 'vm-mime-object)) + (let ((o-list nil) + (done nil) + (pos start) + object props o) + (save-excursion + (save-restriction + (narrow-to-region start end) + (while (not done) + (setq object (get-text-property pos prop)) + (setq pos (next-single-property-change pos prop)) + (unless pos + (setq pos (point-max) + done t)) + (when object + (setq o (make-overlay start pos nil t nil)) + ;; (overlay-put o 'insert-in-front-hooks + ;; '(vm-disallow-overlay-endpoint-insertion)) + ;; (overlay-put o 'insert-behind-hooks + ;; '(vm-disallow-overlay-endpoint-insertion)) + (setq props (text-properties-at start)) + (unless (eq prop 'vm-mime-object) + (setq props (append (list 'vm-mime-object t) props))) + (while props + (overlay-put o (car props) (cadr props)) + (setq props (cddr props))) + (setq o-list (cons o o-list))) + (setq start pos)) + o-list )))) + +(defun vm-mime-default-type-from-filename (file) + (let ((alist vm-mime-attachment-auto-type-alist) + (case-fold-search t) + (done nil)) + (while (and alist (not done)) + (if (string-match (car (car alist)) file) + (setq done t) + (setq alist (cdr alist)))) + (and alist (cdr (car alist))))) + +(defun vm-remove-mail-mode-header-separator () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" mail-header-separator "$") nil t) + (progn + (delete-region (match-beginning 0) (match-end 0)) + t ) + nil ))) + +(defun vm-add-mail-mode-header-separator () + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (replace-match mail-header-separator t t)))) + +(defun vm-mime-transfer-encode-region (encoding beg end crlf) + "Encode region between BEG and END using transfer ENCODING (base64, +quoted-printable or binary). CRLF says whether carriage returns +should be included (?) USR, 2011-03-27" + (let ((case-fold-search t) + (armor-from (and vm-mime-composition-armor-from-lines + (let ((case-fold-search nil)) + (save-excursion + (goto-char beg) + (re-search-forward "^From " nil t))))) + (armor-dot (let ((case-fold-search nil)) + (save-excursion + (goto-char beg) + (re-search-forward "^\\.\n" nil t))))) + (cond ((string-match "^binary$" encoding) + (vm-mime-base64-encode-region beg end crlf) + (setq encoding "base64")) + ((and (not armor-from) (not armor-dot) + (string-match "^7bit$" encoding)) t) + ((string-match "^base64$" encoding) t) + ((string-match "^quoted-printable$" encoding) t) + ((eq vm-mime-8bit-text-transfer-encoding 'quoted-printable) + (vm-mime-qp-encode-region beg end nil armor-from) + (setq encoding "quoted-printable")) + ((eq vm-mime-8bit-text-transfer-encoding 'base64) + (vm-mime-base64-encode-region beg end crlf) + (setq encoding "base64")) + ((or armor-from armor-dot) + (vm-mime-qp-encode-region beg end nil armor-from) + (setq encoding "quoted-printable"))) + (downcase encoding) )) + +(defun vm-mime-transfer-encode-layout (layout) + "Encode a MIME object described by LAYOUT in transfer encoding (base64, +quoted-printable or binary). USR, 2011-03-27" + (let ((list (vm-mm-layout-parts layout)) + (type (car (vm-mm-layout-type layout))) + (encoding "7bit") + (vm-mime-8bit-text-transfer-encoding + vm-mime-8bit-text-transfer-encoding)) + (cond ((vm-mime-composite-type-p type) + ;; MIME messages of type "message" and + ;; "multipart" are required to have a non-opaque + ;; content transfer encoding. This means that + ;; if the user only wants to send out 7bit data, + ;; then any subpart that contains 8bit data must + ;; have an opaque (qp or base64) 8->7bit + ;; conversion performed on it so that the + ;; enclosing entity can use a non-opaque + ;; encoding. + ;; + ;; message/partial requires a "7bit" encoding so + ;; force 8->7 conversion in that case. + (cond ((memq vm-mime-8bit-text-transfer-encoding + '(quoted-printable base64)) + t) + ((vm-mime-types-match "message/partial" type) + (setq vm-mime-8bit-text-transfer-encoding + 'quoted-printable))) + (while list + (if (equal (vm-mime-transfer-encode-layout (car list)) "8bit") + (setq encoding "8bit")) + (setq list (cdr list)))) + (t + (when (and (vm-mime-types-match "message/partial" type) + (not (memq vm-mime-8bit-text-transfer-encoding + '(quoted-printable base64)))) + (setq vm-mime-8bit-text-transfer-encoding 'quoted-printable)) + (setq encoding + (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout) + (vm-mime-text-type-layout-p + layout))))) + ;; seems redundant because an encoding can never be equal to a type. + ;; but it wasn't meant to be encoding becuase it woundn't be a list. + ;; who knows that is supposed to be? USR, 2011-03-27 + (unless (equal encoding (downcase (car (vm-mm-layout-type layout)))) + (save-excursion + (save-restriction + (goto-char (vm-mm-layout-header-start layout)) + (narrow-to-region (point) (vm-mm-layout-header-end layout)) + (vm-reorder-message-headers + nil :keep-list nil :discard-regexp "Content-Transfer-Encoding:") + (if (not (equal encoding "7bit")) + (insert "CONTENT-TRANSFER-ENCODING: " encoding "\n")) + encoding ))))) + +(defun vm-mime-text-description (start end) + (save-excursion + (goto-char start) + (if (looking-at "[ \t\n]*-- \n") + ".signature" + (if (re-search-forward "^-- \n" nil t) + "message body and .signature" + "message body text")))) +;; tried this but random text in the object tag does't look right. +;; (skip-chars-forward " \t\n") +;; (let ((description (buffer-substring (point) (min (+ (point) 20) end))) +;; (ellipsis (< (+ (point) 20) end)) +;; (i nil)) +;; (while (setq i (string-match "[\t\r\n]" description i)) +;; (aset description i " ")) +;; (cond ((= 0 (length description)) nil) +;; (ellipsis (concat description "...")) +;; (t description)))))) + +;;;###autoload +(defun vm-delete-mime-object (&optional saved-file) + "Delete the contents of the MIME object at point. +The MIME object is replaced by a text/plain object that briefly +describes what was deleted." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (when (and (vm-virtual-message-p (car vm-message-pointer)) + (null (vm-virtual-messages-of (car vm-message-pointer)))) + (error "Can't edit unmirrored virtual messages.")) + (when vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (let (layout label) + (let ((e (vm-extent-at (point) 'vm-mime-layout))) + (if (null e) + (error "No MIME button found at point.") + (setq layout (vm-extent-property e 'vm-mime-layout)) + (when (and (vm-mm-layout-message layout) + (eq layout (vm-mime-layout-of + (vm-mm-layout-message layout)))) + (error (concat "Can't delete the only MIME object; " + "use vm-delete-message instead."))) + (when vm-mime-confirm-delete + (unless (y-or-n-p (vm-mime-sprintf "Delete %t? " layout)) + (error "Aborted"))) + (let ((inhibit-read-only t) + opos + (buffer-read-only nil)) + (save-excursion + (vm-save-restriction + (goto-char (vm-extent-start-position e)) + (setq opos (point)) + (setq label (vm-mime-sprintf + vm-mime-deleted-object-label layout)) + (insert label) + (delete-region (point) (vm-extent-end-position e)) + (vm-set-extent-endpoints e opos (point))))) + (vm-mime-discard-layout-contents layout saved-file))) + (when (vm-interactive-p) + ;; make the change visible and place the cursor behind the removed object + (vm-discard-cached-data) + (when vm-presentation-buffer + (set-buffer vm-presentation-buffer) + (re-search-forward (regexp-quote label) (point-max) t))))) + +(defun vm-mime-discard-layout-contents (layout &optional file) + (save-excursion + (let ((inhibit-read-only t) + (buffer-read-only nil) + (m (vm-mm-layout-message layout)) + newid new-layout) + (if (null m) + (error "Message body not loaded")) + (set-buffer (vm-buffer-of m)) + (vm-save-restriction + (widen) + (if (vm-mm-layout-is-converted layout) + (setq layout (vm-mm-layout-unconverted-layout layout))) + (goto-char (vm-mm-layout-header-start layout)) + (cond ((null file) + (insert "Content-Type: text/plain; charset=us-ascii\n\n") + (vm-set-mm-layout-body-start layout (point-marker)) + (insert (vm-mime-sprintf vm-mime-deleted-object-label layout))) + (t + (insert "Content-Type: message/external-body; access-type=local-file; name=\"" file "\"\n") + (insert "Content-Transfer-Encoding: 7bit\n\n") + (insert "Content-Type: " + (vm-mime-type-with-params + (car (vm-mm-layout-qtype layout)) + (cdr (vm-mm-layout-qtype layout))) + "\n") + (if (vm-mm-layout-qdisposition layout) + (let ((p (vm-mm-layout-qdisposition layout))) + (insert "Content-Disposition: " + (mapconcat 'identity p "; ") + "\n"))) + (if (vm-mm-layout-id layout) + (insert "Content-ID: " (vm-mm-layout-id layout) "\n") + (setq newid (vm-make-message-id)) + (insert "Content-ID: " newid "\n")) + (insert "Content-Transfer-Encoding: binary\n\n") + (insert "[Deleted " (vm-mime-sprintf "%d]\n" layout)) + (insert "[Saved to " file " on " (system-name) "]\n"))) + (delete-region (point) (vm-mm-layout-body-end layout)) + (vm-set-edited-flag-of m t) + (vm-set-byte-count-of m nil) + (vm-set-line-count-of m nil) + (vm-set-stuff-flag-of m t) + ;; For the dreaded From_-with-Content-Length folders recompute + ;; the message length and make a new Content-Length header. + (if (eq (vm-message-type-of m) 'From_-with-Content-Length) + (let (length) + (goto-char (vm-headers-of m)) + ;; first delete all copies of Content-Length + (while (and (re-search-forward vm-content-length-search-regexp + (vm-text-of m) t) + (null (match-beginning 1)) + (progn (goto-char (match-beginning 0)) + (vm-match-header vm-content-length-header))) + (delete-region (vm-matched-header-start) + (vm-matched-header-end))) + ;; now compute the message body length + (setq length (- (vm-end-of m) (vm-text-of m))) + ;; insert the header + (goto-char (vm-headers-of m)) + (insert vm-content-length-header " " + (int-to-string length) "\n"))) + ;; make sure we get the summary updated. The 'edited' + ;; flag might already be set and therefore trying to set + ;; it again might not have triggered an update. We need + ;; the update because the message size has changed. + (vm-mark-for-summary-update (vm-mm-layout-message layout)) + (cond (file + (save-restriction + (narrow-to-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-end layout)) + (setq new-layout (vm-mime-parse-entity-safe)) + (vm-set-mm-layout-message-symbol + new-layout (vm-mm-layout-message-symbol layout)) + (vm-mime-copy-layout new-layout layout))) + (t + (vm-set-mm-layout-type layout '("text/plain")) + (vm-set-mm-layout-qtype layout '("text/plain")) + (vm-set-mm-layout-encoding layout "7bit") + (vm-set-mm-layout-id layout nil) + (vm-set-mm-layout-description + layout + (vm-mime-sprintf "Deleted %d" layout)) + (vm-set-mm-layout-disposition layout nil) + (vm-set-mm-layout-qdisposition layout nil) + (vm-set-mm-layout-parts layout nil) + (vm-set-mm-layout-display-error layout nil))))))) + +(defun vm-mime-encode-words (&optional encoding) + (goto-char (point-min)) + + ;; find right encoding + (setq encoding (or encoding vm-mime-encode-headers-type)) + (save-excursion + (when (stringp encoding) + (setq encoding + (if (re-search-forward encoding (point-max) t) + 'B + 'Q)))) + ;; now encode the words + (let ((case-fold-search nil) + start end charset coding) + (while (re-search-forward vm-mime-encode-headers-words-regexp (point-max) t) + (setq start (match-beginning 1) + end (vm-marker (match-end 0)) + charset (or (vm-determine-proper-charset start end) + vm-mime-8bit-composition-charset) + coding (vm-mime-charset-to-coding charset)) + ;; encode coding system body + (when (and coding (not (eq coding 'no-conversion))) + (if vm-xemacs-p + (vm-encode-coding-region start end coding) + ;; using vm-encode-coding-region causes wrong encoding in GNU Emacs + (encode-coding-region start end coding))) + ;; encode + (if (eq encoding 'Q) + (vm-mime-Q-encode-region start end) + (vm-mime-base64-encode-region start end)) + ;; insert start and end markers + (goto-char start) + (insert "=?" charset "?" (format "%s" encoding) "?") + (setq start (point)) + (goto-char end) + (insert "?=") + ;; goto end for next round + (goto-char end)))) + +;;;###autoload +(defun vm-mime-encode-words-in-string (string &optional encoding) + (and string + (vm-with-string-as-temp-buffer + (vm-substring-no-properties string 0) + 'vm-mime-encode-words))) + +(defun vm-mime-encode-headers () + "Encodes the headers of a message. + +Only the words containing a non 7bit ASCII char are encoded, but not the whole +header as this will cause trouble for the recipients and authors headers. + +Whitespace between encoded words is trimmed during decoding and thus those +should be encoded together." + (interactive) + (save-excursion + (let ((headers (concat "^\\(" vm-mime-encode-headers-regexp "\\):")) + (case-fold-search nil) + (encoding vm-mime-encode-headers-type) + body-start + start end) + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (setq body-start (vm-marker (match-beginning 0))) + (goto-char (point-min)) + + (while (let ((case-fold-search t)) + (re-search-forward headers body-start t)) + (goto-char (match-end 0)) + (setq start (point)) + (when (not (looking-at "\\s-")) + (insert " ") + (backward-char 1)) + (save-excursion + (setq end (or (and (re-search-forward "^[^ \t:]+:" body-start t) + (match-beginning 0)) + body-start))) + (vm-save-restriction + (narrow-to-region start end) + (vm-mime-encode-words)) + (goto-char end))))) + +;;;###autoload +(defun vm-mime-encode-composition (&optional attachments-only) + "MIME encode the current mail composition buffer. + +This function chooses the MIME character set(s) to use, and transforms the +message content from the Emacs-internal encoding to the corresponding +octets in that MIME character set. + +It then applies some transfer encoding to the message. For details of the +transfer encodings available, see the documentation for +`vm-mime-8bit-text-transfer-encoding.' + +Finally, it creates the headers that are necessary to identify the message +as one that uses MIME. + +Under MULE, it explicitly sets `buffer-file-coding-system' to a binary + (no-transformation) coding system, to avoid further transformation of the +message content when it's passed to the MTA (that is, the mail transfer +agent; under Unix, normally sendmail.) + +Attachment tags added to the buffer with `vm-attach-file' are expanded +and the approriate content-type and boundary markup information is added." + + (interactive) + + (vm-mail-mode-show-headers) + + (vm-disable-modes vm-disable-modes-before-encoding) + + (vm-mime-encode-headers) + + (if vm-mail-reorder-message-headers + (vm-reorder-message-headers + nil :keep-list vm-mail-header-order :discard-regexp 'none)) + + (buffer-enable-undo) + (let ((unwind-needed t) + (mybuffer (current-buffer))) + (unwind-protect + (progn + (vm-mime-encode-composition-internal attachments-only) + (setq unwind-needed nil)) + (and unwind-needed (consp buffer-undo-list) + (eq mybuffer (current-buffer)) + (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))))) + +(defvar enriched-mode) + +;; This function was originally XEmacs-specific. It has now been +;; generalized to both XEmacs and GNU Emacs. USR, 2011-03-27 + +(defun vm-mime-encode-composition-internal (&optional attachments-only) + "MIME encode the message composition in the current buffer." + (save-restriction + (widen) + (unless (eq major-mode 'mail-mode) + (error "Command must be used in a VM Mail mode buffer.")) + (when (vm-mail-mode-get-header-contents "MIME-Version:") + (error "Message is already MIME encoded.")) + (let ((8bit nil) + (multipart t) ; start off asuming multipart + (boundary-positions nil) ; position markers for the parts + text-result ; results from text encodings + forward-local-refs already-mimed layout e e-list boundary + type encoding charset params description disposition object + opoint-min encoded-attachment) + (when vm-xemacs-p + ;;Make sure we don't double encode UTF-8 (for example) text. + (setq buffer-file-coding-system (vm-binary-coding-system))) + (goto-char (mail-text-start)) + (setq e-list (vm-mime-attachment-button-extents + (point) (point-max) 'vm-mime-object)) + ;; We have a multipart message unless there's just one + ;; attachment and no other readable text in the buffer. + (when (and (= (length e-list) 1) + (looking-at "[ \t\n]*") + (= (match-end 0) + (vm-extent-start-position (car e-list))) + (save-excursion + (goto-char (vm-extent-end-position (car e-list))) + (looking-at "[ \t\n]*\\'"))) + (setq multipart nil)) + ;; 1. Insert the text parts and attachments + (if (null e-list) + ;; no attachments + (vm-mime-encode-text-part (point) (point-max) t) + ;; attachments to be handled + (while e-list + (setq e (car e-list)) + ;; 1a. Insert the text part + (if (or (not multipart) + (save-excursion + (eq (vm-extent-start-position e) + (re-search-forward + "[ \t\n]*" (vm-extent-start-position e) t)))) + ;; found an attachment + (delete-region (point) (vm-extent-start-position e)) + ;; found text + (setq text-result + (vm-mime-encode-text-part + (point) (vm-extent-start-position e) nil)) + (setq boundary-positions + (cons (car text-result) boundary-positions)) + (setq 8bit (or 8bit (equal (cdr text-result) "8bit")))) + + ;; 1b. Prepare for the object + (goto-char (vm-extent-start-position e)) + (narrow-to-region (point) (point)) + (setq object (vm-extent-property e 'vm-mime-object)) + + ;; 1c. Insert the object + (cond ((bufferp object) + (vm-mime-insert-buffer-substring + object (vm-extent-property e 'vm-mime-type))) + ;; insert attachment from another folder + ((listp object) + (save-restriction + (with-current-buffer (nth 0 object) + (widen)) + (setq boundary-positions + (cons (point-marker) boundary-positions)) + (insert-buffer-substring + (nth 0 object) (nth 1 object) (nth 2 object)) + (setq encoded-attachment t))) + ;; insert file + ((stringp object) + (vm-mime-insert-file-contents + object (vm-extent-property e 'vm-mime-type)))) + + ;; 1d. Gather information about the object from the extent. + (if (setq already-mimed (vm-extent-property e 'vm-mime-encoded)) + (setq layout + (vm-mime-parse-entity + nil :default-type (list "text/plain" "charset=us-ascii") + :default-encoding "7bit") + type (or (vm-extent-property e 'vm-mime-type) + (car (vm-mm-layout-type layout))) + params (or (vm-extent-property e 'vm-mime-parameters) + (cdr (vm-mm-layout-qtype layout))) + forward-local-refs + (car (vm-extent-property e 'vm-mime-forward-local-refs)) + description (vm-extent-property e 'vm-mime-description) + disposition + (if (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified") + (vm-mm-layout-qdisposition layout) + (vm-extent-property e 'vm-mime-disposition))) + (setq type (vm-extent-property e 'vm-mime-type) + params (vm-extent-property e 'vm-mime-parameters) + forward-local-refs + (car (vm-extent-property e 'vm-mime-forward-local-refs)) + description (vm-extent-property e 'vm-mime-description) + disposition + (if (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified") + (if attachments-only '("attachment") nil) + (if attachments-only + (cons "attachment" + (cdr (vm-extent-property e 'vm-mime-disposition))) + (vm-extent-property e 'vm-mime-disposition))))) + ;; 1e. Encode the object if necessary + (cond ((vm-mime-types-match "text" type) + (setq encoding + (or (vm-extent-property e 'vm-mime-encoding) + (vm-determine-proper-content-transfer-encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max))) + encoding (vm-mime-transfer-encode-region + encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max) + t)) + (setq 8bit (or 8bit (equal encoding "8bit")))) + + ((vm-mime-composite-type-p type) + (setq opoint-min (point-min)) + (unless already-mimed + (goto-char (point-min)) + (insert "Content-Type: " type "\n") + ;; vm-mime-transfer-encode-layout will replace + ;; this if the transfer encoding changes. + (insert "Content-Transfer-Encoding: 7bit\n\n") + (setq layout + (vm-mime-parse-entity + nil + :default-type (list "text/plain" "charset=us-ascii") + :default-encoding "7bit")) + (setq already-mimed t)) + (when (and layout (not forward-local-refs)) + (vm-mime-internalize-local-external-bodies layout) + ; update the cached data for the new layout + (setq type (car (vm-mm-layout-type layout)) + params (cdr (vm-mm-layout-qtype layout)) + disposition (vm-mm-layout-qdisposition layout))) + (setq encoding (vm-mime-transfer-encode-layout layout)) + (setq 8bit (or 8bit (equal encoding "8bit"))) + (goto-char (point-max)) + (widen) + (narrow-to-region opoint-min (point))) + + ((not encoded-attachment) + (when (and layout (not forward-local-refs)) + (vm-mime-internalize-local-external-bodies layout) + ; update the cached data that might now be stale + ; but retain the disposition if nothing new + (setq type (car (vm-mm-layout-type layout)) + params (cdr (vm-mm-layout-qtype layout)) + disposition (or (vm-mm-layout-qdisposition layout) + disposition))) + (if already-mimed + (setq encoding (vm-mime-transfer-encode-layout layout)) + (vm-mime-base64-encode-region (point-min) (point-max)) + (setq encoding "base64")))) + + ;; 1f. Add the required MIME headers + (unless (or (not multipart) encoded-attachment) + (goto-char (point-min)) + (setq boundary-positions (cons (point-marker) boundary-positions)) + (when already-mimed + ;; trim headers + (vm-reorder-message-headers + nil :keep-list '("Content-ID:") :discard-regexp nil) + ;; remove header/text separator + (goto-char (1- (vm-mm-layout-body-start layout))) + (when (looking-at "\n") + (delete-char 1))) + (insert "Content-Type: " + (vm-mime-type-with-params type params) + "\n") + (when description + (insert "Content-Description: " description "\n")) + (when disposition + (insert "Content-Disposition: " + (vm-mime-type-with-params + (car disposition) (cdr disposition)) + "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n\n")) + (goto-char (point-max)) + (widen) + + ;; 1g. Delete the original attachment button + (save-excursion + (goto-char (vm-extent-start-position e)) + (vm-assert (looking-at "\\[ATTACHMENT"))) + (delete-region (vm-extent-start-position e) + (vm-extent-end-position e)) + (vm-detach-extent e) + (when (looking-at "\n") (delete-char 1)) + (setq e-list (cdr e-list))) + + ;; 2. Handle the remaining chunk of text after the last + ;; extent, if any. + (if (and multipart (not (looking-at "[ \t\n]*\\'"))) + (progn + (setq text-result + (vm-mime-encode-text-part (point) (point-max) nil)) + (setq boundary-positions + (cons (car text-result) boundary-positions)) + (setq 8bit (or 8bit (equal (cdr text-result) "8bit"))) + (goto-char (point-max))) + (delete-region (point) (point-max))) + + ;; 3. Create and insert boundary lines + (when multipart + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text) + (while (re-search-forward + (concat "^--" (regexp-quote boundary) "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text)) + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n") + (setq boundary-positions (cdr boundary-positions)))) + + ;; 4. Add MIME headers to the message + (when (and (not multipart) already-mimed) + (goto-char (vm-mm-layout-header-start layout)) + ;; trim headers + (vm-reorder-message-headers + nil :keep-list '("Content-ID:") :discard-regexp nil) + ;; remove header/text separator + (goto-char (vm-mm-layout-header-end layout)) + (when (looking-at "\n") (delete-char 1)) + ;; copy remainder to enclosing entity's header section + (goto-char (point-max)) + (when multipart + (insert-buffer-substring (current-buffer) + (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout))) + (delete-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout))) + (goto-char (point-min)) + (vm-remove-mail-mode-header-separator) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp + "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") + (vm-add-mail-mode-header-separator) + (insert "MIME-Version: 1.0\n") + (if multipart + (progn + (insert "Content-Type: " + (vm-mime-type-with-params + "multipart/mixed" + (list (format "boundary=\"%s\"" boundary))) + "\n") + (insert "Content-Transfer-Encoding: " + (if 8bit "8bit" "7bit") "\n")) + (insert "Content-Type: " (vm-mime-type-with-params type params) "\n") + (when disposition + (insert "Content-Disposition: " + (vm-mime-type-with-params + (car disposition) (cdr disposition)) + "\n")) + (when description + (insert "Content-Description: " description "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n")))))) + +(defun vm-mime-encode-text-part (beg end whole-message) + "Encode the text from BEG to END in a composition buffer +as MIME part and add appropriate MIME headers. If WHOLE-MESSAGE is +true, then encode it as the entire message. + +Returns a pair consisting of a marker pointing to the start of the +encoded MIME part and the transfer-encoding used. But if +WHOLE-MESSAGE is true then nil is returned." + (let ((enriched (and (boundp 'enriched-mode) enriched-mode)) + type encoding charset params description marker) + (narrow-to-region beg end) + ;; support enriched-mode for text/enriched composition + (when enriched + (let ((enriched-initial-annotation "")) + (if vm-fsfemacs-p + (save-excursion + ;; insert/delete trick needed to avoid + ;; enriched-mode tags from seeping into the + ;; attachment overlays. I really wish + ;; front-advance / rear-advance overlay + ;; endpoint properties actually worked. + (goto-char (point-max)) + (insert-before-markers "\n") + (enriched-encode (point-min) (1- (point))) + (goto-char (point-max)) + (delete-char -1)) + (enriched-encode (point-min) (point-max))))) + + (setq charset (vm-determine-proper-charset (point-min) (point-max))) + (when (vm-emacs-mule-p) + (let ((coding-system + (vm-mime-charset-to-coding charset))) + (unless coding-system + (error "Can't find a coding system for charset %s" charset)) + (encode-coding-region (point-min) (point-max) + ;; What about the case where vm-m-m-c-t-c-a doesn't have an + ;; entry for the given charset? That shouldn't happen, if + ;; vm-mime-mule-coding-to-charset-alist and + ;; vm-mime-mule-charset-to-coding-alist have complete and + ;; matching entries. Admittedly this last is not a + ;; given. Should we make it so on startup? (By setting the + ;; key for any missing entries in + ;; vm-mime-mule-coding-to-charset-alist to being (format "%s" + ;; coding-system), if necessary.) RWF, 2005-03-25 + coding-system))) + + ;; not clear why this is needed. USR, 2011-03-27 + (when vm-xemacs-p + (when whole-message (enriched-mode -1))) + (setq encoding (vm-determine-proper-content-transfer-encoding + (point-min) (point-max)) + encoding (vm-mime-transfer-encode-region + encoding (point-min) (point-max) t) + description (vm-mime-text-description + (point-min) (point-max))) + (if whole-message + (progn + (widen) + (vm-remove-mail-mode-header-separator) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp + "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)") + (insert "MIME-Version: 1.0\n") + (if enriched + (insert "Content-Type: text/enriched; charset=" charset "\n") + (insert "Content-Type: text/plain; charset=" charset "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n") + (vm-add-mail-mode-header-separator) + nil) + + (setq marker (point-marker)) + (if enriched + (insert "Content-Type: text/enriched; charset=" charset "\n") + (insert "Content-Type: text/plain; charset=" charset "\n")) + (when description + (insert "Content-Description: " description "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n\n") + (widen) + (cons marker encoding)))) + + +;; This function is now defunct. Use vm-mime-encode-composition. +;; USR, 2011-03-27 +(defun vm-mime-fsfemacs-encode-composition () + "MIME encode the message composition in the current buffer." + (save-restriction + (widen) + (unless (eq major-mode 'mail-mode) + (error "Command must be used in a VM Mail mode buffer.")) + (when (vm-mail-mode-get-header-contents "MIME-Version:") + (error "Message is already MIME encoded.")) + (let ((8bit nil) + (just-one nil) + (boundary-positions nil) ; markers for the start of parts + marker + forward-local-refs already-mimed layout e e-list boundary + type encoding charset params description disposition object + opoint-min postponed-attachment) + (goto-char (mail-text-start)) + (setq e-list (vm-mime-attachment-button-extents + (point) (point-max) 'vm-mime-object)) + ;; If there's just one attachment and no other readable + ;; text in the buffer then make the message type just be + ;; the attachment type rather than sending a multipart + ;; message with one attachment + (setq just-one (and (= (length e-list) 1) + (looking-at "[ \t\n]*") + (= (match-end 0) + (vm-extent-start-position (car e-list))) + (save-excursion + (goto-char (vm-extent-end-position (car e-list))) + (looking-at "[ \t\n]*\\'")))) + (if (null e-list) + ;; no attachments + (vm-mime-encode-text-part (point) (point-max) t) + ;; attachments to be handled + (while e-list + (setq e (car e-list)) + (if (or just-one + (save-excursion + (eq (vm-extent-start-position e) + (re-search-forward + "[ \t\n]*" (vm-extent-start-position e) t)))) + ;; found an attachment + (delete-region (point) (vm-extent-start-position e)) + ;; found text + (setq marker (vm-mime-encode-text-part + (point) (vm-extent-start-position e) nil)) + (setq boundary-positions (cons marker boundary-positions))) + (goto-char (vm-extent-start-position e)) + (narrow-to-region (point) (point)) + (setq object (vm-extent-property e 'vm-mime-object)) + + ;; insert the object + (cond ((bufferp object) + (vm-mime-insert-buffer-substring + object (vm-extent-property e 'vm-mime-type))) + ;; insert attachment from another folder + ((listp object) + (save-restriction + (with-current-buffer (nth 0 object) + (widen)) + (setq boundary-positions + (cons (point-marker) boundary-positions)) + (insert-buffer-substring + (nth 0 object) (nth 1 object) (nth 2 object)) + (setq postponed-attachment t))) + ;; insert file + ((stringp object) + (vm-mime-insert-file-contents + object (vm-extent-property e 'vm-mime-type)))) + ;; gather information about the object from the extent. + (if (setq already-mimed (vm-extent-property e 'vm-mime-encoded)) + (setq layout + (vm-mime-parse-entity + nil :default-type (list "text/plain" "charset=us-ascii") + :default-encoding "7bit") + type (or (vm-extent-property e 'vm-mime-type) + (car (vm-mm-layout-type layout))) + params (or (vm-extent-property e 'vm-mime-parameters) + (cdr (vm-mm-layout-qtype layout))) + forward-local-refs + (car (vm-extent-property e 'vm-mime-forward-local-refs)) + description (vm-extent-property e 'vm-mime-description) + disposition + (if (not (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified")) + (vm-extent-property e 'vm-mime-disposition) + (vm-mm-layout-qdisposition layout))) + (setq type (vm-extent-property e 'vm-mime-type) + params (vm-extent-property e 'vm-mime-parameters) + forward-local-refs + (car (vm-extent-property e 'vm-mime-forward-local-refs)) + description (vm-extent-property e 'vm-mime-description) + disposition + (if (not (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified")) + (vm-extent-property e 'vm-mime-disposition) + nil))) + (cond ((vm-mime-types-match "text" type) + (setq encoding + (or (vm-extent-property e 'vm-mime-encoding) + (vm-determine-proper-content-transfer-encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max))) + encoding (vm-mime-transfer-encode-region + encoding + (if already-mimed + (vm-mm-layout-body-start layout) + (point-min)) + (point-max) + t)) + (setq 8bit (or 8bit (equal encoding "8bit")))) + ((vm-mime-composite-type-p type) + (setq opoint-min (point-min)) + (unless already-mimed + (goto-char (point-min)) + (insert "Content-Type: " type "\n") + ;; vm-mime-transfer-encode-layout will replace + ;; this if the transfer encoding changes. + (insert "Content-Transfer-Encoding: 7bit\n\n") + (setq layout + (vm-mime-parse-entity + nil + :default-type (list "text/plain" "charset=us-ascii") + :default-encoding "7bit")) + (setq already-mimed t)) + (when (and layout (not forward-local-refs)) + (vm-mime-internalize-local-external-bodies layout) + ; update the cached data that might now be stale + (setq type (car (vm-mm-layout-type layout)) + params (cdr (vm-mm-layout-qtype layout)) + disposition (vm-mm-layout-qdisposition layout))) + (setq encoding (vm-mime-transfer-encode-layout layout)) + (setq 8bit (or 8bit (equal encoding "8bit"))) + (goto-char (point-max)) + (widen) + (narrow-to-region opoint-min (point))) + ((not postponed-attachment) + (when (and layout (not forward-local-refs)) + (vm-mime-internalize-local-external-bodies layout) + ; update the cached data that might now be stale + (setq type (car (vm-mm-layout-type layout)) + params (cdr (vm-mm-layout-qtype layout)) + disposition (vm-mm-layout-qdisposition layout))) + (if already-mimed + (setq encoding (vm-mime-transfer-encode-layout layout)) + (vm-mime-base64-encode-region (point-min) (point-max)) + (setq encoding "base64")))) + (unless (or just-one postponed-attachment) + (goto-char (point-min)) + (setq boundary-positions (cons (point-marker) boundary-positions)) + (when already-mimed + ;; trim headers - why remove perfectly good headers? USR + (vm-reorder-message-headers + nil :keep-list '("Content-ID:") :discard-regexp nil) + ;; remove header/text separator + (goto-char (1- (vm-mm-layout-body-start layout))) + (when (looking-at "\n") + (delete-char 1))) + (insert "Content-Type: " + (vm-mime-type-with-params type params) + "\n") + (when description + (insert "Content-Description: " description "\n")) + (when disposition + (insert "Content-Disposition: " (car disposition)) + (when (cdr disposition) + (insert ";\n\t" (mapconcat 'identity + (cdr disposition) + ";\n\t"))) + (insert "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n\n")) + (goto-char (point-max)) + (widen) + (save-excursion + (goto-char (vm-extent-start-position e)) + (vm-assert (looking-at "\\[ATTACHMENT"))) + (delete-region (vm-extent-start-position e) + (vm-extent-end-position e)) + (vm-detach-extent e) + (if (looking-at "\n") + (delete-char 1)) + (setq e-list (cdr e-list))) + ;; handle the remaining chunk of text after the last + ;; extent, if any. + (if (or just-one (looking-at "[ \t\n]*\\'")) + (delete-region (point) (point-max)) + (setq marker (vm-mime-encode-text-part (point) (point-max) nil)) + (setq boundary-positions (cons marker boundary-positions)) + ;; FIXME is this needed? + ;; (setq 8bit (or 8bit (equal encoding "8bit"))) + (goto-char (point-max))) + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text) + (while (re-search-forward (concat "^--" + (regexp-quote boundary) + "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (mail-text)) + (goto-char (point-max)) + (or just-one (insert "\n--" boundary "--\n")) + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n") + (setq boundary-positions (cdr boundary-positions))) + (when (and just-one already-mimed) + (goto-char (vm-mm-layout-header-start layout)) + ;; trim headers + (vm-reorder-message-headers + nil :keep-list '("Content-ID:") :discard-regexp nil) + ;; remove header/text separator + (goto-char (vm-mm-layout-header-end layout)) + (if (looking-at "\n") + (delete-char 1)) + ;; copy remainder to enclosing entity's header section + (goto-char (point-max)) + (unless just-one + (insert-buffer-substring (current-buffer) + (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout))) + (delete-region (vm-mm-layout-header-start layout) + (vm-mm-layout-body-start layout))) + (goto-char (point-min)) + (vm-remove-mail-mode-header-separator) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp + "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") + (vm-add-mail-mode-header-separator) + (insert "MIME-Version: 1.0\n") + (if just-one + (insert "Content-Type: " + (vm-mime-type-with-params type params) + "\n") + (insert "Content-Type: " + (vm-mime-type-with-params + "multipart/mixed" + (list (concat "boundary=\"" boundary "\""))) + "\n")) + (when (and just-one description) + (insert "Content-Description: " description "\n")) + (when (and just-one disposition) + (insert "Content-Disposition: " + (vm-mime-type-with-params (car disposition) (cdr disposition)) + "\n")) + (if just-one + (insert "Content-Transfer-Encoding: " encoding "\n") + (if 8bit + (insert "Content-Transfer-Encoding: 8bit\n") + (insert "Content-Transfer-Encoding: 7bit\n"))))))) +(make-obsolete 'vm-mime-fsfemacs-encode-composition + 'vm-mime-encode-composition-internal "8.2.0") + +(defun vm-mime-fsfemacs-encode-text-part (beg end whole-message) + "Encode the text from BEG to END in a composition buffer +as MIME part and add appropriate MIME headers. If WHOLE-MESSAGE is +true, then encode it as the entire message. + +Returns marker pointing to the start of the encoded MIME part." + (let ((enriched (and (boundp 'enriched-mode) enriched-mode)) + type encoding charset params description marker) + (narrow-to-region beg end) + ;; support enriched-mode for text/enriched composition + (when enriched + (let ((enriched-initial-annotation "")) + (save-excursion + ;; insert/delete trick needed to avoid + ;; enriched-mode tags from seeping into the + ;; attachment overlays. I really wish + ;; front-advance / rear-advance overlay + ;; endpoint properties actually worked. + (goto-char (point-max)) + (insert-before-markers "\n") + (enriched-encode (point-min) (1- (point))) + (goto-char (point-max)) + (delete-char -1)))) + + (setq charset (vm-determine-proper-charset (point-min) (point-max))) + (when vm-fsfemacs-mule-p + (let ((coding-system + (vm-mime-charset-to-coding charset))) + (unless coding-system + (error "Can't find a coding system for charset %s" charset)) + (encode-coding-region (point-min) (point-max) coding-system))) + + (setq encoding (vm-determine-proper-content-transfer-encoding + (point-min) (point-max)) + encoding (vm-mime-transfer-encode-region + encoding (point-min) (point-max) t) + description (vm-mime-text-description + (point-min) (point-max))) + (if whole-message + (progn + (widen) + (vm-remove-mail-mode-header-separator) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regexp + "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)") + (insert "MIME-Version: 1.0\n") + (if enriched + (insert "Content-Type: text/enriched; charset=" charset "\n") + (insert "Content-Type: text/plain; charset=" charset "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n") + (vm-add-mail-mode-header-separator)) + + (setq marker (point-marker)) + (if enriched + (insert "Content-Type: text/enriched; charset=" charset "\n") + (insert "Content-Type: text/plain; charset=" charset "\n")) + (when description + (insert "Content-Description: " description "\n")) + (insert "Content-Transfer-Encoding: " encoding "\n\n") + (widen) + marker))) +(make-obsolete 'vm-mime-fsfemacs-encode-text-part + 'vm-mime-encode-text-part "8.2.0") + + +(defun vm-mime-fragment-composition (size) + (save-restriction + (widen) + (vm-inform 5 "Fragmenting message...") + (let ((buffers nil) + (total-markers nil) + (id (vm-mime-make-multipart-boundary)) + (n 1) + b header-start header-end master-buffer start end) + (vm-remove-mail-mode-header-separator) + ;; message/partial must have "7bit" content transfer + ;; encoding, so force everything to be encoded for + ;; 7bit transmission. + (let ((vm-mime-8bit-text-transfer-encoding + (if (eq vm-mime-8bit-text-transfer-encoding '8bit) + 'quoted-printable + vm-mime-8bit-text-transfer-encoding))) + (vm-mime-transfer-encode-layout + (vm-mime-parse-entity + nil + :default-type (list "text/plain" "charset=us-ascii") + :default-encoding "7bit"))) + (goto-char (point-min)) + (setq header-start (point)) + (search-forward "\n\n") + (setq header-end (1- (point))) + (setq master-buffer (current-buffer)) + (goto-char (point-min)) + (setq start (point)) + (while (not (eobp)) + (condition-case nil + (progn + (forward-char (max (- size 150) 2000)) + (beginning-of-line)) + (end-of-buffer nil)) + (setq end (point)) + (setq b (generate-new-buffer (concat (buffer-name) " part " + (int-to-string n)))) + (setq buffers (cons b buffers)) + (set-buffer b) + (make-local-variable 'vm-send-using-mime) + (setq vm-send-using-mime nil) + (insert-buffer-substring master-buffer header-start header-end) + (goto-char (point-min)) + (vm-reorder-message-headers + nil :keep-list nil + :discard-regedp + "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)") + (insert "MIME-Version: 1.0\n") + (insert (format + (if vm-mime-avoid-folding-content-type + "Content-Type: message/partial; id=%s; number=%d" + "Content-Type: message/partial;\n\tid=%s;\n\tnumber=%d") + id n)) + (if vm-mime-avoid-folding-content-type + (insert (format "; total=%d" n)) + (insert (format ";\n\ttotal=%d" n))) + (setq total-markers (cons (point) total-markers)) + (insert "\nContent-Transfer-Encoding: 7bit\n") + (goto-char (point-max)) + (insert mail-header-separator "\n") + (insert-buffer-substring master-buffer start end) + (vm-increment n) + (set-buffer master-buffer) + (setq start (point))) + (vm-decrement n) + (vm-add-mail-mode-header-separator) + (let ((bufs buffers)) + (while bufs + (set-buffer (car bufs)) + (goto-char (car total-markers)) + (prin1 n (current-buffer)) + (setq bufs (cdr bufs) + total-markers (cdr total-markers))) + (set-buffer master-buffer)) + (vm-inform 5 "Fragmenting message... done") + (nreverse buffers)))) + +;; moved to vm-reply.el, not MIME-specific. +(fset 'vm-mime-preview-composition 'vm-preview-composition) + +(defun vm-mime-composite-type-p (type) + "Check if TYPE is a MIME type that might have subparts." + (or (vm-mime-types-match "message/rfc822" type) + (vm-mime-types-match "message/news" type) + (vm-mime-types-match "multipart" type))) + +;; Unused currrently. +;; +;;(defun vm-mime-map-atomic-layouts (function list) +;; (while list +;; (if (vm-mime-composite-type-p (car (vm-mm-layout-type (car list)))) +;; (vm-mime-map-atomic-layouts function (vm-mm-layout-parts (car list))) +;; (funcall function (car list))) +;; (setq list (cdr list)))) + +(defun vm-mime-sprintf (format layout) + ;; compile the format into an eval'able s-expression + ;; if it hasn't been compiled already. + (let ((match (assoc format vm-mime-compiled-format-alist))) + (if (null match) + (progn + (vm-mime-compile-format format) + (setq match (assoc format vm-mime-compiled-format-alist)))) + ;; The local variable name `vm-mime-layout' is mandatory here for + ;; the format s-expression to work. + (let ((vm-mime-layout layout)) + (eval (cdr match))))) + +(defun vm-mime-compile-format (format) + (let ((return-value (vm-mime-compile-format-1 format 0))) + (setq vm-mime-compiled-format-alist + (cons (cons format (nth 1 return-value)) + vm-mime-compiled-format-alist)))) + +(defun vm-mime-compile-format-1 (format start-index) + (or start-index (setq start-index 0)) + (let ((case-fold-search nil) + (done nil) + (sexp nil) + (sexp-fmt nil) + (last-match-end start-index) + new-match-end conv-spec) + (store-match-data nil) + (while (not done) + (while + (and (not done) + (string-match + "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()acdefknNstTx%]\\)" + format last-match-end)) + (setq conv-spec (aref format (match-beginning 5))) + (setq new-match-end (match-end 0)) + (if (memq conv-spec '(?\( ?a ?c ?d ?e ?f ?k ?n ?N ?s ?t ?T ?x)) + (progn + (cond ((= conv-spec ?\() + (save-match-data + (let ((retval (vm-mime-compile-format-1 format + (match-end 5)))) + (setq sexp (cons (nth 1 retval) sexp) + new-match-end (car retval))))) + ((= conv-spec ?a) + (setq sexp (cons (list 'vm-mf-default-action + 'vm-mime-layout) sexp))) + ((= conv-spec ?c) + (setq sexp (cons (list 'vm-mf-text-charset + 'vm-mime-layout) sexp))) + ((= conv-spec ?d) + (setq sexp (cons (list 'vm-mf-content-description + 'vm-mime-layout) sexp))) + ((= conv-spec ?e) + (setq sexp (cons (list 'vm-mf-content-transfer-encoding + 'vm-mime-layout) sexp))) + ((= conv-spec ?f) + (setq sexp (cons (list 'vm-mf-attachment-file + 'vm-mime-layout) sexp))) + ((= conv-spec ?k) + (setq sexp (cons (list 'vm-mf-event-for-default-action + 'vm-mime-layout) sexp))) + ((= conv-spec ?n) + (setq sexp (cons (list 'vm-mf-parts-count + 'vm-mime-layout) sexp))) + ((= conv-spec ?N) + (setq sexp (cons (list 'vm-mf-partial-number + 'vm-mime-layout) sexp))) + ((= conv-spec ?s) + (setq sexp (cons (list 'vm-mf-parts-count-pluralizer + 'vm-mime-layout) sexp))) + ((= conv-spec ?t) + (setq sexp (cons (list 'vm-mf-content-type-description + 'vm-mime-layout) sexp))) + ((= conv-spec ?T) + (setq sexp (cons (list 'vm-mf-partial-total + 'vm-mime-layout) sexp))) + ((= conv-spec ?x) + (setq sexp (cons (list 'vm-mf-external-body-content-type + 'vm-mime-layout) sexp)))) + (cond ((and (match-beginning 1) (match-beginning 2)) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-left-justify-string + 'vm-left-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2)))))) + ((match-beginning 2) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-right-justify-string + 'vm-right-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2))))))) + (cond ((match-beginning 3) + (setcar sexp + (list 'vm-truncate-string (car sexp) + (string-to-number + (substring format + (match-beginning 4) + (match-end 4))))))) + (setq sexp-fmt + (cons "%s" + (cons (substring format + last-match-end + (match-beginning 0)) + sexp-fmt)))) + (setq sexp-fmt + (cons (if (eq conv-spec ?\)) + (prog1 "" (setq done t)) + "%%") + (cons (substring format + (or last-match-end 0) + (match-beginning 0)) + sexp-fmt)))) + (setq last-match-end new-match-end)) + (unless done + (setq sexp-fmt + (cons (substring format last-match-end (length format)) + sexp-fmt) + done t)) + (setq sexp-fmt (apply 'concat (nreverse sexp-fmt))) + (if sexp + (setq sexp (cons 'format (cons sexp-fmt (nreverse sexp)))) + (setq sexp sexp-fmt))) + (list last-match-end sexp))) + +(defun vm-mime-find-format-for-layout (layout) + (let ((p vm-mime-button-format-alist) + (type (car (vm-mm-layout-type layout)))) + (catch 'done + (cond ((vm-mime-types-match "error/error" type) + (throw 'done "%d")) + ((vm-mime-types-match "text/x-vm-deleted" type) + (throw 'done "%d"))) + (while p + (if (vm-mime-types-match (car (car p)) type) + (throw 'done (cdr (car p))) + (setq p (cdr p)))) + "%-25.25t [%k to %a]" ))) + +(defun vm-mf-content-type (layout) + (car (vm-mm-layout-type layout))) + +(defun vm-mf-external-body-content-type (layout) + (car (vm-mm-layout-type (car (vm-mm-layout-parts layout))))) + +(defun vm-mf-content-transfer-encoding (layout) + (vm-mm-layout-encoding layout)) + +(defun vm-mf-content-description (layout) + (or (vm-mm-layout-description layout) + (vm-mf-content-type-description layout))) + +(defun vm-mf-content-type-description (layout) + (let ((p vm-mime-type-description-alist) + (type (car (vm-mm-layout-type layout)))) + (catch 'done + (while p + (if (vm-mime-types-match (car (car p)) type) + (throw 'done (cdr (car p))) + (setq p (cdr p)))) + (vm-mf-content-type layout) ))) + +(defun vm-mf-text-charset (layout) + (or (vm-mime-get-parameter layout "charset") + "us-ascii")) + +(defun vm-mf-parts-count (layout) + (int-to-string (length (vm-mm-layout-parts layout)))) + +(defun vm-mf-parts-count-pluralizer (layout) + (if (= 1 (length (vm-mm-layout-parts layout))) "" "s")) + +(defun vm-mf-partial-number (layout) + (or (vm-mime-get-parameter layout "number") + "?")) + +(defun vm-mf-partial-total (layout) + (or (vm-mime-get-parameter layout "total") + "?")) + +(defun vm-mf-attachment-file (layout) + (or vm-mf-attachment-file ;; for %f expansion in external viewer arg lists + (vm-mime-get-disposition-filename layout) + (vm-mime-get-parameter layout "name") + "<no suggested filename>")) + +(defun vm-mf-event-for-default-action (layout) + (if (vm-mouse-support-possible-here-p) + "Click mouse-2" + "Press RETURN")) + +;; This puts "alternative" on all attachments. Silly. USR, 2011-11-24 +;; (defun vm-mf-default-action (layout) +;; (if (eq vm-mime-alternative-show-method 'all) +;; (concat (vm-mf-default-action-orig layout) " alternative") +;; (vm-mf-default-action-orig layout))) + +(defun vm-mf-default-action (layout) + (or vm-mf-default-action + (let (cons) + (cond ((or (vm-mime-can-display-internal layout) + (vm-mime-find-external-viewer + (car (vm-mm-layout-type layout)))) + (let ((p vm-mime-default-action-string-alist) + (type (car (vm-mm-layout-type layout)))) + (catch 'done + (while p + (if (vm-mime-types-match (car (car p)) type) + (throw 'done (cdr (car p))) + (setq p (cdr p)))) + nil ))) + ((setq cons (vm-mime-can-convert + (car (vm-mm-layout-type layout)))) + "convert") + (t "save"))) + ;; should not be reached + "burn in the raging fires of hell forever")) + +(defun vm-mime-map-layout-parts (m function &optional layout path) + "Apply FUNCTION to each part of the message M. +This function will call itself recursively with the currently processed LAYOUT +and the PATH to it. PATH is a list of parent layouts where the root is at the +end of the path." + (unless layout + (setq layout (vm-mm-layout m))) + (when (vectorp layout) + (funcall function m layout path) + (let ((parts (copy-sequence (vm-mm-layout-parts layout)))) + (while parts + (vm-mime-map-layout-parts m function (car parts) (cons layout path)) + (setq parts (cdr parts)))))) + +(defun vm-list-mime-part-structure (&optional verbose) + "List mime part structure of the current message." + (interactive "P") + (vm-check-for-killed-summary) + (if (vm-interactive-p) (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (let ((m (car vm-message-pointer)) + (buffer (get-buffer-create "*VM mime part layout*"))) + ;; (switch-to-buffer "*VM mime part layout*") + ;; (erase-buffer) + (with-current-buffer buffer (setq truncate-lines t)) + (with-electric-help + (lambda () + (princ (format "%s\n" (vm-decode-mime-encoded-words-in-string + (vm-su-subject m)))) + (vm-mime-map-layout-parts + m + (lambda (m layout path) + (if verbose + (princ (format "%s%S\n" (make-string (length path) ? ) layout)) + (princ (format "%s%S%s%s%s\n" (make-string (length path) ? ) + (vm-mm-layout-type layout) + (let ((id (vm-mm-layout-id layout))) + (if id (format " id=%S" id) "")) + (let ((desc (vm-mm-layout-description layout))) + (if desc (format " desc=%S" desc) "")) + (let ((dispo (vm-mm-layout-disposition layout))) + (if dispo (format " %S" dispo) "")))))))) + buffer) + )) +(defalias 'vm-mime-list-part-structure + 'vm-list-mime-part-structure) + +;;;###autoload +(defun vm-nuke-alternative-text/html-internal (m) + "Delete all text/html parts of multipart/alternative parts of message M. +Returns the number of deleted parts. text/html parts are only deleted iff +the first sub part of a multipart/alternative is a text/plain part." + (let ((deleted-count 0) + prev-type this-type parent-types + nuke-html) + (vm-mime-map-layout-parts + m + (lambda (m layout path) + (setq this-type (car (vm-mm-layout-type layout)) + parent-types (mapcar (lambda (layout) + (car (vm-mm-layout-type layout))) + path)) + (when (and nuke-html + (member "multipart/alternative" parent-types) + (vm-mime-types-match "text/html" this-type)) + (save-excursion + (set-buffer (vm-buffer-of m)) + (let ((inhibit-read-only t) + (buffer-read-only nil)) + (vm-save-restriction + (widen) + (if (vm-mm-layout-is-converted layout) + (setq layout (vm-mm-layout-unconverted-layout layout))) + (goto-char (vm-mm-layout-header-start layout)) + (forward-line -1) + (delete-region (point) (vm-mm-layout-body-end layout)) + (vm-set-edited-flag-of m t) + (vm-set-byte-count-of m nil) + (vm-set-line-count-of m nil) + (vm-set-stuff-flag-of m t) + (vm-mark-for-summary-update m))) + (setq deleted-count (1+ deleted-count)))) + (if (and (vm-mime-types-match "multipart/alternative" prev-type) + (vm-mime-types-match "text/plain" this-type)) + (setq nuke-html t)) + (setq prev-type this-type))) + deleted-count)) + +;;;###autoload +(defun vm-nuke-alternative-text/html (&optional count mlist) + "Removes the text/html part of all multipart/alternative message parts. + +This is a destructive operation and cannot be undone!" + (interactive "p") + (when (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (let ((mlist (or mlist + (vm-select-operable-messages + count (vm-interactive-p) "Nuke html of")))) + (vm-retrieve-operable-messages count mlist) + (save-excursion + (while mlist + (let ((count (vm-nuke-alternative-text/html-internal (car mlist)))) + (when (vm-interactive-p) + (if (= count 0) + (vm-inform 5 "No text/html parts found.") + (vm-inform 5 "%d text/html part%s deleted." + count (if (> count 1) "s" "")))) + (setq mlist (cdr mlist)))))) + (when (vm-interactive-p) + (vm-discard-cached-data count) + (vm-present-current-message))) +(defalias 'vm-mime-nuke-alternative-text/html + 'vm-nuke-alterantive-text/html) +(make-obsolete 'vm-mime-nuke-alternative-text/html + 'vm-nuke-alternative-text/html "8.2.0") + +;;----------------------------------------------------------------------------- +;; The following functions are taken from vm-pine.el +;; Copyright (C) Robert Widhopf-Fenk +;; Copyright (C) Uday S. Reddy, 2010-2011 + +;;;###autoload +(defun vm-mime-convert-to-attachment-buttons () + "Replace all mime buttons in the current buffer by attachment buttons." + ;; called vm-mime-encode-mime-attachments in vm-pine.el + (interactive) + (cond (vm-xemacs-p + (let ((e-list (vm-extent-list + (point-min) (point-max) 'vm-mime-layout))) + (setq e-list + (sort e-list + (function (lambda (e1 e2) + (< (vm-extent-end-position e1) + (vm-extent-end-position e2)))))) + ;; Then replace the buttons, because doing it at once will result in + ;; problems since the new buttons are from the same extent. + (while e-list + (vm-mime-replace-by-attachment-button (car e-list)) + (setq e-list (cdr e-list))))) + (vm-fsfemacs-p + (let ((e-list (vm-mime-attachment-button-extents + (point-min) (point-max) 'vm-mime-layout))) + (while e-list + (vm-mime-replace-by-attachment-button (car e-list)) + (setq e-list (cdr e-list))) + (goto-char (point-max)))) + (t + (error "don't know how to MIME encode composition for %s" + (emacs-version))))) + +;; The function vm-mime-re-fake-attachment-overlays from vm-pine.el is +;; now unused. USR, 2011-02-14 + +(defun vm-mime-replace-by-attachment-button (x) + "Replace the MIME button specified by extent X by an attachment button." + ;; This was called vm-mime-encode-mime-button in vm-pine.el + (save-excursion + (let* ((layout (vm-extent-property x 'vm-mime-layout)) + (xstart (vm-extent-start-position x)) + (xend (vm-extent-end-position x)) + (hstart (vm-mm-layout-header-start layout)) + (bstart (vm-mm-layout-body-start layout)) + (end (vm-mm-layout-body-end layout)) + (hbuf (marker-buffer hstart)) + (bbuf (marker-buffer bstart)) + (type (vm-mm-layout-type layout)) + (desc (or (vm-mm-layout-description layout) + (vm-mime-get-parameter layout "name") + "attachment")) + (disp (or (vm-mm-layout-disposition layout) + '("inline"))) + (file (vm-mime-get-disposition-parameter layout "filename")) + (ext-file nil)) + + ;; special case of message/external-body + ;; seems to be unused now. USR, 2011-12-06 + (when (and type + (string= (car type) "message/external-body") + (string= (cadr type) "access-type=local-file")) + (save-excursion + (setq ext-file (substring (caddr type) 5)) + (vm-select-folder-buffer) + (save-restriction + (let ((start (vm-mm-layout-body-start layout)) + (end (vm-mm-layout-body-end layout))) + (set-buffer (marker-buffer (vm-mm-layout-body-start layout))) + (widen) + (goto-char start) + (if (not (re-search-forward + "Content-Type: \"?\\([^ ;\" \n\t]+\\)\"?;?" + end t)) + (error "No `Content-Type' header found in: %s" + (buffer-substring start end)) + (setq type (list (match-string 1)))))))) + + ;; insert an attached-object-button + (goto-char xstart) + (cond (ext-file + (vm-attach-file ext-file (car type))) + ((eq hbuf bbuf) + (vm-attach-object + (if file + (list hbuf hstart end disp file) + (list hbuf hstart end disp)) + :type (car type) :params (cdr type) + :disposition disp :description desc :mimed t)) + (t + (vm-attach-object + bbuf + :type (car type) :params (cdr type) + :disposition disp :description desc :mimed nil))) + ;; delete the mime-button + (delete-region (vm-extent-start-position x) (vm-extent-end-position x)) + (vm-detach-extent x)))) + + +;; This code was originally part of +;; vm-mime-xemacs/fsfemacs-encode-composition functions. + +(defun vm-mime-insert-file-contents (file type) + "Safely insert the contents of FILE of TYPE into the current +buffer." + (if vm-xemacs-p + (let ((coding-system-for-read + (if (vm-mime-text-type-p type) + (vm-line-ending-coding-system) + (vm-binary-coding-system))) + ;; keep no undos + (buffer-undo-list t) + ;; no transformations! + (format-alist nil) + ;; no decompression! + (jka-compr-compression-info-list nil) + ;; don't let buffer-file-coding-system be changed + ;; by insert-file-contents. The + ;; value we bind to it to here isn't important. + (buffer-file-coding-system (vm-binary-coding-system))) + (insert-file-contents file)) + ;; as of FSF Emacs 19.34, even with the hooks + ;; we've attached to the attachment overlays, + ;; text STILL can be inserted into them when + ;; font-lock is enabled. Explaining why is + ;; beyond the scope of this comment and I + ;; don't know the answer anyway. This + ;; insertion dance works to prevent it. + (insert-before-markers " ") + (forward-char -1) + (let ((coding-system-for-read + (if (vm-mime-text-type-p type) + (vm-line-ending-coding-system) + (vm-binary-coding-system))) + ;; keep no undos + (buffer-undo-list t) + ;; no transformations! + (format-alist nil) + ;; no decompression! + (jka-compr-compression-info-list nil) + ;; don't let buffer-file-coding-system be + ;; changed by insert-file-contents. The + ;; value we bind to it to here isn't + ;; important. + (buffer-file-coding-system (vm-binary-coding-system)) + ;; For NTEmacs 19: need to do this to make + ;; sure CRs aren't eaten. + (file-name-buffer-file-type-alist '(("." . t)))) + (condition-case data + (insert-file-contents file) + (error + ;; font-lock could signal this error in FSF + ;; Emacs versions prior to 21.0. Catch it + ;; and ignore it. + (if (equal data '(error "Invalid search bound (wrong side of point)")) + nil + (signal (car data) (cdr data))))) + (goto-char (point-max)) + (delete-char -1)))) + +(defun vm-mime-insert-buffer-substring (buffer type) + "Safe insert the contents of BUFFER of TYPE into the current buffer." + (if vm-xemacs-p + (insert-buffer-substring buffer) + ;; Under Emacs 20.7 inserting a unibyte buffer + ;; contents that contain 8-bit characters into a + ;; multibyte buffer causes the inserted data to be + ;; corrupted with the dreaded \201 corruption. So + ;; we write the data out to disk and let the file + ;; be inserted, which gets aoround the problem. + (let ((tempfile (vm-make-tempfile))) + ;; make note to delete the tempfile after insertion + (with-current-buffer buffer + (let ((buffer-file-coding-system + (vm-binary-coding-system))) + (write-region (point-min) (point-max) tempfile nil 0))) + (unwind-protect + (vm-mime-insert-file-contents + tempfile type) + (vm-error-free-call 'delete-file tempfile))))) + + +;;; vm-mime.el ends here diff --git a/lisp/vm-minibuf.el b/lisp/vm-minibuf.el new file mode 100755 index 0000000..6fe5c81 --- /dev/null +++ b/lisp/vm-minibuf.el @@ -0,0 +1,377 @@ +;;; vm-minibuf.el --- Minibuffer read functions for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1993, 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-minibuf) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-mouse) + ) + +(declare-function button-press-event-p "vm-xemacs" (object)) +(declare-function button-release-event-p "vm-xemacs" (object)) +(declare-function menu-event-p "vm-xemacs" (object)) +(declare-function vm-folder-buffers "vm" (&optional non-virtual)) + +(defun vm-minibuffer-complete-word (&optional exiting) + (interactive) + (let ((opoint (point)) + ;; In Emacs 21, during a minibuffer read the minibuffer + ;; contains the prompt as buffer text and that text is + ;; read only. So we can no longer assume that (point-min) + ;; is where the user-entered text starts and we must avoid + ;; modifying that prompt text. The value we want instead + ;; of (point-min) is (minibuffer-prompt-end). + (point-min (if (fboundp 'minibuffer-prompt-end) + (minibuffer-prompt-end) + (point-min))) + (case-fold-search completion-ignore-case) + trimmed-c-list c-list beg end diff word word-prefix-regexp completion) + ;; find the beginning and end of the word we're trying to complete + (if (or (eobp) (memq (following-char) '(?\t ?\n ?\ ))) + (progn + (skip-chars-backward " \t\n") + (and (not (eobp)) (forward-char)) + (setq end (point))) + (skip-chars-forward "^ \t\n") + (setq end (point))) + ;; if there can't be multiple words in the input the beginning + ;; of the word must be at point-min. + (if (not vm-completion-auto-space) + (setq beg point-min) + (skip-chars-backward "^ \t\n") + (setq beg (point))) + (goto-char opoint) + ;; copy the word into a string + (setq word (buffer-substring beg end)) + ;; trim the completion list down to just likely candidates + ;; then convert it to an alist. + (setq word-prefix-regexp (concat "^" (regexp-quote word)) + trimmed-c-list (vm-delete-non-matching-strings + word-prefix-regexp + vm-minibuffer-completion-table) + trimmed-c-list (sort trimmed-c-list (function string-lessp)) + trimmed-c-list (mapcar 'list trimmed-c-list) + c-list (mapcar 'list vm-minibuffer-completion-table)) + ;; Try the word against the completion list. + (and trimmed-c-list + (setq completion (try-completion word trimmed-c-list))) + ;; If completion is nil, figure out what prefix of the word would prefix + ;; something in the completion list... but only if the user is interested. + (if (and (null completion) vm-completion-auto-correct c-list) + (let ((i -1)) + (while (null (setq completion + (try-completion (substring word 0 i) c-list))) + (vm-decrement i)) + (setq completion (substring word 0 i)))) + ;; If completion is t, we had a perfect match already. + (if (eq completion t) + (cond (vm-completion-auto-space + (goto-char end) + (insert " ")) + (t + (and (not exiting) + (vm-minibuffer-completion-message "[Sole completion]")))) + ;; Compute the difference in length between the completion and the + ;; word. A negative difference means no match and the magnitude + ;; indicates the number of chars that need to be shaved off the end + ;; before a match will occur. A positive difference means a match + ;; occurred and the magnitude specifies the number of new chars that + ;; can be appended to the word as a completion. + ;; + ;; `completion' can be nil here, but the code works anyway because + ;; (length nil) still equals 0! + (setq diff (- (length completion) (length word))) + (cond + ;; We have some completion chars. Insert them. + ((or (> diff 0) + (and completion (zerop diff) (not (string-equal completion word)))) + (goto-char end) + (delete-char (- (length word))) + (insert completion) + (if (and vm-completion-auto-space + (null (cdr trimmed-c-list))) + (insert " "))) + ((null completion) + (vm-minibuffer-completion-message "[No completion available]")) + ;; The word prefixed more than one string, but we can't complete + ;; any further. Either give help or say "Ambiguous". + ((zerop diff) + (and (not exiting) + (cond ((> (length (car (car trimmed-c-list))) (length word)) + (if (null completion-auto-help) + (vm-minibuffer-completion-message "[Ambiguous]") + (vm-minibuffer-show-completions (sort + (mapcar 'car + trimmed-c-list) + 'string-lessp)))) + ((not (eq last-command 'vm-minibuffer-complete-word)) + (vm-minibuffer-completion-message + "[Complete, but not unique]")) + (vm-completion-auto-space + (insert " "))))) + ;; The word didn't prefix anything... if vm-completion-auto-correct is + ;; non-nil strip the offending characters and try again. + (vm-completion-auto-correct + (goto-char end) + (delete-char diff) + (vm-minibuffer-complete-word exiting)) + ;; if we're not auto-correcting and we're doing + ;; multi-word, just let the user insert a space. + (vm-completion-auto-space + (insert " ")) + ;; completion utterly failed, tell the user so. + (t + (and (not exiting) + (vm-minibuffer-completion-message "[No match]"))))))) + +(defun vm-minibuffer-complete-word-and-exit () + (interactive) + (vm-minibuffer-complete-word t) + (exit-minibuffer)) + +(defun vm-minibuffer-completion-message (string &optional seconds) + "Briefly display STRING to the right of the current minibuffer input. +Optional second arg SECONDS specifies how long to keep the message visible; +the default is 2 seconds. + +A keypress causes the immediate erasure of the STRING, and return of control +to the calling program." + (let (omax (inhibit-quit t)) + (save-excursion + (goto-char (point-max)) + (setq omax (point)) + (insert " " string)) + (sit-for (or seconds 2)) + (delete-region omax (point-max)))) + +(defun vm-minibuffer-replace-word (word) + (goto-char (point-max)) + (skip-chars-backward "^ \t\n") + (delete-region (point) (point-max)) + (insert word)) + +(defun vm-minibuffer-show-completions (list) + "Display LIST in a multi-column listing in the \" *Completions*\" buffer. +LIST should be a list of strings." + (save-excursion + (set-buffer (get-buffer-create " *Completions*")) + (setq buffer-read-only nil) + (use-local-map (make-sparse-keymap)) + ;; ignore vm-mutable-* here. the user shouldn't mind + ;; because when they exit the minibuffer the windows will be + ;; set right again. + (display-buffer (current-buffer)) + (erase-buffer) + (insert "Possible completions are:\n") + (setq buffer-read-only t) + (vm-show-list list 'vm-minibuffer-replace-word + (list (current-local-map) minibuffer-local-map)) + (goto-char (point-min)))) + +(defun vm-show-list (list &optional function keymaps) + "Display LIST in a multi-column listing in the current buffer at point. +The current buffer must be displayed in some window at the time +this function is called. + +LIST should be a list of strings. + +Optional second argument FUNCTION will be called if the mouse is +clicked on one of the strings in the current buffer. The string +clicked upon will be passed to FUNCTION as its sole argument. + +Optional third argument KEYMAPS specifies a lists of keymaps +where the FUNCTION should be bound to the mouse clicks. By +default the local keymap of the current buffer is used." + (or keymaps (setq keymaps (and (current-local-map) + (list (current-local-map))))) + (save-excursion + (let ((buffer-read-only nil) + (separation 3) + tabs longest positions columns list-length q i w start command + keymap) + (cond ((and function keymaps (vm-mouse-support-possible-p)) + (setq command + (list 'lambda '(e) '(interactive "e") + (list 'let + '((string (vm-mouse-get-mouse-track-string e))) + (list 'and 'string (list function 'string))))) + (while keymaps + (setq keymap (car keymaps)) + (cond ((vm-mouse-xemacs-mouse-p) + (define-key keymap 'button1 command) + (define-key keymap 'button2 command)) + ((vm-mouse-fsfemacs-mouse-p) + (define-key keymap [down-mouse-1] 'ignore) + (define-key keymap [drag-mouse-1] 'ignore) + (define-key keymap [mouse-1] command) + (define-key keymap [drag-mouse-2] 'ignore) + (define-key keymap [down-mouse-2] 'ignore) + (define-key keymap [mouse-2] command))) + (setq keymaps (cdr keymaps))))) + (setq list (sort (copy-sequence list) (function string-lessp)) + w (vm-get-buffer-window (current-buffer)) + q list + list-length 0 + longest 0 + positions (1- (window-width w))) + (while q + (setq longest (max longest (length (car q))) + list-length (1+ list-length) + q (cdr q))) + (setq columns (if (< positions (+ longest separation)) + 1 + (/ positions (+ longest separation)))) + (setq tabs (/ list-length columns) + tabs (+ tabs + (if (zerop (% list-length columns)) + 0 + 1))) + (setq i 0) + (while (< i tabs) + (setq q (nthcdr i list)) + (while q + (setq start (point)) + (insert (car q)) + (when function + (vm-mouse-set-mouse-track-highlight start (point))) + (insert-char ? (+ separation (- longest (length (car q))))) + (setq q (nthcdr tabs q))) + (setq i (1+ i)) + (insert "\n"))))) + +(defun vm-minibuffer-completion-help () + (interactive) + (let ((opoint (point)) + c-list beg end word word-prefix-regexp) + ;; find the beginning and end of the word we're trying to complete + (if (or (eobp) (memq (following-char) '(?\t ?\n ?\ ))) + (progn + (skip-chars-backward " \t\n") + (and (not (eobp)) (forward-char)) + (setq end (point))) + (skip-chars-forward "^ \t\n") + (setq end (point))) + (skip-chars-backward "^ \t\n") + (setq beg (point)) + (goto-char opoint) + ;; copy the word into a string + (setq word (buffer-substring beg end)) + ;; trim the completion list down to just likely candidates + ;; then convert it to an alist. + (setq word-prefix-regexp (concat "^" (regexp-quote word)) + c-list (vm-delete-non-matching-strings + word-prefix-regexp + vm-minibuffer-completion-table) + c-list (sort c-list (function string-lessp))) + (if c-list + (vm-minibuffer-show-completions c-list) + (vm-minibuffer-completion-message " [No match]")))) + +(defun vm-keyboard-read-string (prompt completion-list &optional multi-word) + (let ((minibuffer-local-map (copy-keymap minibuffer-local-map)) + (vm-completion-auto-space multi-word) + (vm-minibuffer-completion-table completion-list)) + (define-key minibuffer-local-map "\t" 'vm-minibuffer-complete-word) + (define-key minibuffer-local-map " " 'vm-minibuffer-complete-word) + (define-key minibuffer-local-map "?" 'vm-minibuffer-completion-help) + (if (not multi-word) + (define-key minibuffer-local-map "\r" + 'vm-minibuffer-complete-word-and-exit)) + ;; evade the XEmacs dialog box, yeccch. + (let ((use-dialog-box nil)) + (read-string prompt)))) + +(defvar last-nonmenu-event) + +(defun vm-read-string (prompt completion-list &optional multi-word) + ;; handle alist + (if (consp (car completion-list)) + (setq completion-list (nreverse (mapcar 'car completion-list)))) + (if (and completion-list (vm-mouse-support-possible-here-p)) + (cond ((and (vm-mouse-xemacs-mouse-p) + (or (button-press-event-p last-command-event) + (button-release-event-p last-command-event) + (menu-event-p last-command-event))) + (vm-mouse-read-string prompt completion-list multi-word)) + ((and (vm-mouse-fsfemacs-mouse-p) + (listp last-nonmenu-event)) + (vm-mouse-read-string prompt completion-list multi-word)) + (t + (vm-keyboard-read-string prompt completion-list multi-word))) + (vm-keyboard-read-string prompt completion-list multi-word))) + +(defun vm-read-number (prompt) + (let (result) + (while + (null + (string-match "^[ \t]*-?[0-9]+" (setq result (read-string prompt))))) + (string-to-number result))) + +(defun vm-keyboard-read-file-name (prompt &optional dir default + must-match initial history) + "Like `read-file-name', except HISTORY's value is unaltered." + (let ((oldvalue (symbol-value history)) + ;; evade the XEmacs dialog box, yeccch. + (use-dialog-box nil)) + (unwind-protect + (condition-case nil + (read-file-name prompt dir default must-match initial history) + ((wrong-number-of-arguments void-function) + (if history + (let ((file-name-history (symbol-value history)) + file) + (setq file + (read-file-name prompt dir default must-match initial)) + file ) + (read-file-name prompt dir default must-match initial)))) + (and history (set history oldvalue))))) + +(defun vm-read-file-name (prompt &optional dir default + must-match initial history) + "Like `read-file-name', except a mouse interface is used if a mouse +click mouse triggered the current command." + (if (vm-mouse-support-possible-here-p) + (cond ((and (vm-mouse-xemacs-mouse-p) + (or (button-press-event-p last-command-event) + (button-release-event-p last-command-event) + (menu-event-p last-command-event))) + (vm-mouse-read-file-name prompt dir default + must-match initial history)) + ((and (vm-mouse-fsfemacs-mouse-p) + (listp last-nonmenu-event)) + (vm-mouse-read-file-name prompt dir default + must-match initial history)) + (t + (vm-keyboard-read-file-name prompt dir default + must-match initial history))) + (vm-keyboard-read-file-name prompt dir default + must-match initial history))) + +(defun vm-read-folder-name () + (completing-read + "VM Folder: " + (mapcar (lambda (f) (list f)) (vm-folder-buffers)) + nil t nil nil)) + +;;; vm-minibuf.el ends here diff --git a/lisp/vm-misc.el b/lisp/vm-misc.el new file mode 100755 index 0000000..d92cd91 --- /dev/null +++ b/lisp/vm-misc.el @@ -0,0 +1,1661 @@ +;;; vm-misc.el --- Miscellaneous functions for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-misc) + +;; (eval-when-compile +;; (require 'vm-misc)) + +;; vm-xemacs.el is a fake file to fool the Emacs 23 compiler +(declare-function find-coding-system "vm-xemacs" (coding-system-or-name)) + +;; Aliases for xemacs functions +(declare-function xemacs-abbreviate-file-name "vm-misc.el" + (filename &optional hack-homedir)) +(declare-function xemacs-insert-char "vm-misc.el" + (char &optional count ignored buffer)) +;; Aliases for xemacs/fsfemacs functions with different arguments +(declare-function emacs-find-file-name-handler "vm-misc.el" + (filename &optional operation)) +(declare-function emacs-focus-frame "vm-misc.el" + (&rest ignore)) +(declare-function emacs-get-buffer-window "vm-misc.el" + (&optional buffer-or-name frame devices)) + +(declare-function vm-interactive-p "vm-misc.el" + ()) +(declare-function vm-device-type "vm-misc.el" + (&optional device)) +(declare-function vm-buffer-substring-no-properties "vm-misc.el" + (start end)) +(declare-function substring-no-properties "vm-misc.el" + (string from &optional to)) +(declare-function vm-extent-property "vm-misc.el" (overlay prop) t) +(declare-function vm-extent-object "vm-misc.el" (overlay) t) +(declare-function vm-set-extent-property "vm-misc.el" (overlay prop value) t) +(declare-function vm-set-extent-endpoints "vm-misc.el" + (overlay beg end &optional buffer) t) +(declare-function vm-make-extent "vm-misc.el" + (beg end &optional buffer front-advance rear-advance) t) +(declare-function vm-extent-end-position "vm-misc.el" (overlay) t) +(declare-function vm-extent-start-position "vm-misc.el" (overlay) t) +(declare-function vm-detach-extent "vm-misc.el" (overlay) t) +(declare-function vm-delete-extent "vm-misc.el" (overlay) t) +(declare-function vm-disable-extents "vm-misc.el" + (&optional beg end name val) t) +(declare-function vm-extent-properties "vm-misc.el" (overlay) t) + +(declare-function timezone-make-date-sortable "ext:timezone" + (date &optional local timezone)) +(declare-function longlines-decode-region "ext:longlines" + (start end)) +(declare-function longlines-wrap-region "ext:longlines" + (start end)) +(declare-function vm-decode-mime-encoded-words "vm-mime" ()) +(declare-function vm-decode-mime-encoded-words-in-string "vm-mime" (string)) +(declare-function vm-su-subject "vm-summary" (message)) + + +;; This file contains various low-level operations that address +;; incomaptibilities between Gnu and XEmacs. Expect compiler warnings. + +;; messages in the minibuffer + +;; the chattiness levels are: +;; 0 - extremely quiet +;; 5 - medium +;; 7 - normal level +;; 10 - heavy debugging info + +(defun vm-inform (level &rest args) + (when (<= level vm-verbosity) + (apply 'message args))) + +(defun vm-warn (l secs &rest args) + "Give a warning at level L and display it for SECS seconds. The +remaining arguments are passed to `message' to generate the warning +message." + (when (<= l vm-verbosity) + (apply 'message args) + (sleep-for secs))) + +;; garbage-collector result +(defconst gc-fields '(:conses :syms :miscs + :chars :vector + :floats :intervals :strings)) + +(defsubst vm-garbage-collect () + (pp (vm-zip-lists gc-fields (garbage-collect)))) + +;; Make sure that interprogram-cut-function is defined +(unless (boundp 'interprogram-cut-function) + (defvar interprogram-cut-function nil)) + +(defun vm-substring (string from &optional to) + (let ((work-buffer nil)) + (set-buffer work-buffer) + (unwind-protect + (with-current-buffer work-buffer + (insert string) + (if (null to) + (setq to (length string)) + (if (< to 0) + (setq to (+ (length string) to)))) + ;; string indices start at 0, buffers start at 1. + (setq from (1+ from) + to (1+ to)) + (if (> from (point-min)) + (delete-region (point-min) from)) + (if (< to (point-max)) + (delete-region to (point-max))) + (buffer-string)) + (when work-buffer (kill-buffer work-buffer))))) + +;; Taken from XEmacs as GNU Emacs is missing `replace-in-string' and defining +;; it may cause clashes with other packages defining it differently, in fact +;; we could also call the function `replace-regexp-in-string' as Roland +;; Winkler pointed out. +(defun vm-replace-in-string (str regexp newtext &optional literal) + "Replace all matches in STR for REGEXP with NEWTEXT string, + and returns the new string. +Optional LITERAL non-nil means do a literal replacement. +Otherwise treat `\\' in NEWTEXT as special: + `\\&' in NEWTEXT means substitute original matched text. + `\\N' means substitute what matched the Nth `\\(...\\)'. + If Nth parens didn't match, substitute nothing. + `\\\\' means insert one `\\'. + `\\u' means upcase the next character. + `\\l' means downcase the next character. + `\\U' means begin upcasing all following characters. + `\\L' means begin downcasing all following characters. + `\\E' means terminate the effect of any `\\U' or `\\L'." + (if (> (length str) 50) + (let ((cfs case-fold-search)) + (with-temp-buffer + (setq case-fold-search cfs) + (insert str) + (goto-char 1) + (while (re-search-forward regexp nil t) + (replace-match newtext t literal)) + (buffer-string))) + (let ((start 0) newstr) + (while (string-match regexp str start) + (setq newstr (replace-match newtext t literal str) + start (+ (match-end 0) (- (length newstr) (length str))) + str newstr)) + str))) + +(defun vm-delete-non-matching-strings (regexp list &optional destructively) + "Delete strings matching REGEXP from LIST. +Optional third arg non-nil means to destructively alter LIST, instead of +working on a copy. + +The new version of the list, minus the deleted strings, is returned." + (or destructively (setq list (copy-sequence list))) + (let ((curr list) (prev nil)) + (while curr + (if (string-match regexp (car curr)) + (setq prev curr + curr (cdr curr)) + (if (null prev) + (setq list (cdr list) + curr list) + (setcdr prev (cdr curr)) + (setq curr (cdr curr))))) + list )) + +(defun vm-parse (string regexp &optional matchn matches) + "Returns list of string by splitting STRING with REGEXP matches. +REGEXP must match one item and MATCHN can be used to select a match +group (default is 1). MATCHES is the number of time the match is +applied (default until it does not match anymore). + +This function is similar to a spring-split, but a bit more complex +and flexible." + (or matchn (setq matchn 1)) + (let (list tem) + (store-match-data nil) + (while (and (not (eq matches 0)) + (not (eq (match-end 0) (length string))) + (string-match regexp string (match-end 0))) + (and (integerp matches) (setq matches (1- matches))) + (if (not (consp matchn)) + (setq list (cons (substring string (match-beginning matchn) + (match-end matchn)) list)) + (setq tem matchn) + (while tem + (if (match-beginning (car tem)) + (setq list (cons (substring string + (match-beginning (car tem)) + (match-end (car tem))) list) + tem nil) + (setq tem (cdr tem)))))) + (if (and (integerp matches) (match-end 0) + (not (eq (match-end 0) (length string)))) + (setq list (cons (substring string (match-end 0) (length string)) + list))) + (nreverse list))) + +(defun vm-parse-addresses (string) + "Given a STRING containing email addresses extracted from a header +field, parse it and return a list of individual email addresses." + (if (null string) + () + (let ((work-buffer (vm-make-multibyte-work-buffer))) + (with-current-buffer work-buffer + (unwind-protect + (let (list start s char) + (insert string) + (goto-char (point-min)) + ;; Remove useless white space TX + (while (re-search-forward "[\t\f\n\r]\\{1,\\}" nil t) + (replace-match " ")) + (goto-char (point-min)) + (skip-chars-forward " \t\f\n\r") + (setq start (point)) + (while (not (eobp)) + (skip-chars-forward "^\"\\\\,(") + (setq char (following-char)) + (cond ((= char ?\\) + (forward-char 1) + (if (not (eobp)) + (forward-char 1))) + ((= char ?,) + (setq s (buffer-substring start (point))) + (if (or (null (string-match "^[ \t\f\n\r]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (skip-chars-forward ", \t\f\n\r") + (setq start (point))) + ((= char ?\") + (re-search-forward "[^\\\\]\"" nil 0)) + ((= char ?\() + (let ((parens 1)) + (forward-char 1) + (while (and (not (eobp)) (not (zerop parens))) + (re-search-forward "[()]" nil 0) + (cond ((or (eobp) + (= (char-after (- (point) 2)) ?\\))) + ((= (preceding-char) ?\() + (setq parens (1+ parens))) + (t + (setq parens (1- parens))))))))) + (setq s (buffer-substring start (point))) + (if (and (null (string-match "^[ \t\f\n\r]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (mapcar 'vm-fix-quoted-address (reverse list))) + (and work-buffer (kill-buffer work-buffer))))))) + +(defun vm-fix-quoted-address (a) + "Sometimes there are qp-encoded addresses not quoted by \" and thus we +need to add quotes or leave them undecoded. RWF" + (let ((da (vm-decode-mime-encoded-words-in-string a))) + (if (string= da a) + a + (if (or (string-match "^\\s-*\\([^\"']*,[^\"']*\\)\\b\\s-*\\(<.*\\)" da) + (string-match "^\\s-*\"'\\([^\"']+\\)'\"\\(.*\\)" da)) + (concat "\"" (match-string 1 da) "\" " (match-string 2 da)) + da)))) + +(make-obsolete 'vmrf-fix-quoted-address 'vm-quoted-address "8.2.0") + +(defun vm-parse-structured-header (string &optional sepchar keep-quotes) + (if (null string) + () + (let ((work-buffer (vm-make-work-buffer))) + (buffer-disable-undo work-buffer) + (with-current-buffer work-buffer + (unwind-protect + (let ((list nil) + (nonspecials "^\"\\\\( \t\n\r\f") + start s char sp+sepchar) + (if sepchar + (setq nonspecials (concat nonspecials (list sepchar)) + sp+sepchar (concat "\t\f\n\r " (list sepchar)))) + (insert string) + (goto-char (point-min)) + (skip-chars-forward "\t\f\n\r ") + (setq start (point)) + (while (not (eobp)) + (skip-chars-forward nonspecials) + (setq char (following-char)) + (cond ((looking-at "[ \t\n\r\f]") + (delete-char 1)) + ((= char ?\\) + (forward-char 1) + (if (not (eobp)) + (forward-char 1))) + ((and sepchar (= char sepchar)) + (setq s (buffer-substring start (point))) + (if (or (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (skip-chars-forward sp+sepchar) + (setq start (point))) + ((looking-at " \t\n\r\f") + (skip-chars-forward " \t\n\r\f")) + ((= char ?\") + (let ((done nil)) + (if keep-quotes + (forward-char 1) + (delete-char 1)) + (while (not done) + (if (null (re-search-forward "[\\\\\"]" nil t)) + (setq done t) + (setq char (char-after (1- (point)))) + (cond ((char-equal char ?\\) + (delete-char -1) + (if (eobp) + (setq done t) + (forward-char 1))) + (t (if (not keep-quotes) + (delete-char -1)) + (setq done t))))))) + ((= char ?\() + (let ((done nil) + (pos (point)) + (parens 1)) + (forward-char 1) + (while (not done) + (if (null (re-search-forward "[\\\\()]" nil t)) + (setq done t) + (setq char (char-after (1- (point)))) + (cond ((char-equal char ?\\) + (if (eobp) + (setq done t) + (forward-char 1))) + ((char-equal char ?\() + (setq parens (1+ parens))) + (t + (setq parens (1- parens) + done (zerop parens)))))) + (delete-region pos (point)))))) + (setq s (buffer-substring start (point))) + (if (and (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (nreverse list)) + (and work-buffer (kill-buffer work-buffer))))))) + +(defvar buffer-file-type) + +(defun vm-write-string (where string) + (if (bufferp where) + (vm-save-buffer-excursion + (set-buffer where) + (goto-char (point-max)) + (let ((buffer-read-only nil)) + (insert string))) + (let ((temp-buffer (generate-new-buffer "*vm-work*"))) + (unwind-protect + (with-current-buffer temp-buffer + (setq selective-display nil) + (insert string) + ;; correct for VM's uses of this function--- + ;; writing out message separators + (setq buffer-file-type nil) + (write-region (point-min) (point-max) where t 'quiet)) + (and temp-buffer (kill-buffer temp-buffer)))))) + +(defun vm-check-for-killed-summary () + "If the current folder's summary buffer has been killed, reset +the vm-summary-buffer variable and all the summary markers in the +folder so that it remains a valid folder. Take care of +vm-folders-summary-buffer in a similar way." + (and (bufferp vm-summary-buffer) (null (buffer-name vm-summary-buffer)) + (let ((mp vm-message-list)) + (setq vm-summary-buffer nil) + (while mp + (vm-set-su-start-of (car mp) nil) + (vm-set-su-end-of (car mp) nil) + (setq mp (cdr mp))))) + (and (bufferp vm-folders-summary-buffer) + (null (buffer-name vm-folders-summary-buffer)) + (setq vm-folders-summary-buffer nil))) + +(defun vm-check-for-killed-presentation () + "If the current folder's Presentation buffer has been killed, reset +the vm-presentation-buffer variable." + (and (bufferp vm-presentation-buffer-handle) + (null (buffer-name vm-presentation-buffer-handle)) + (progn + (setq vm-presentation-buffer-handle nil + vm-presentation-buffer nil)))) + +;;;###autoload +(defun vm-check-for-killed-folder () + "If the current buffer's Folder buffer has been killed, reset the +vm-mail-buffer variable." + (and (bufferp vm-mail-buffer) (null (buffer-name vm-mail-buffer)) + (setq vm-mail-buffer nil))) + +(put 'folder-read-only 'error-conditions '(folder-read-only error)) +(put 'folder-read-only 'error-message "Folder is read-only") + +(defun vm-abs (n) (if (< n 0) (- n) n)) + +(defun vm-last (list) + "Return the last cons-cell of LIST." + (while (cdr-safe list) (setq list (cdr list))) + list) + +(defun vm-last-elem (list) + "Return the last element of LIST." + (while (cdr-safe list) (setq list (cdr list))) + (car list)) + +(defun vm-vector-to-list (vector) + (let ((i (1- (length vector))) + list) + (while (>= i 0) + (setq list (cons (aref vector i) list)) + (vm-decrement i)) + list )) + +(defun vm-extend-vector (vector length &optional fill) + (let ((vlength (length vector))) + (if (< vlength length) + (apply 'vector (nconc (vm-vector-to-list vector) + (make-list (- length vlength) fill))) + vector ))) + +(defun vm-obarray-to-string-list (blobarray) + (let ((list nil)) + (mapatoms (function (lambda (s) (setq list (cons (symbol-name s) list)))) + blobarray) + list )) + +(defun vm-zip-vectors (v1 v2) + (if (= (length v1) (length v2)) + (let ((l1 (append v1 nil)) + (l2 (append v2 nil))) + (vconcat (vm-zip-lists l1 l2))) + (error "Attempt to zip vectors of differing length: %s and %s" + (length v1) (length v2)))) + +(defun vm-zip-lists (l1 l2) + (cond ((or (null l1) (null l2)) + (if (and (null l1) (null l2)) + nil + (error "Attempt to zip lists of differing length"))) + (t + (cons (car l1) (cons (car l2) (vm-zip-lists (cdr l1) (cdr l2))))) + )) + +(defun vm-mapvector (proc vec) + (let ((new-vec (make-vector (length vec) nil)) + (i 0) + (n (length vec))) + (while (< i n) + (aset new-vec i (apply proc (aref vec i) nil)) + (setq i (1+ i))) + new-vec)) + +(defun vm-mapcar (function &rest lists) + "Apply function to all the curresponding elements of the remaining +argument lists. The results are gathered into a list and returned. + +All the argument lists should be of the same length for this to be +well-behaved." + (let (arglist result) + (while (car lists) + (setq arglist (mapcar 'car lists)) + (setq result (cons (apply function arglist) result)) + (setq lists (mapcar 'cdr lists))) + (nreverse result))) + +(defun vm-mapc (proc &rest lists) + "Apply PROC to all the corresponding elements of the remaining +argument lists. Discard any results. + +All the argument lists should be of the same length for this to be +well-behaved." + (let (arglist) + (while (car lists) + (setq arglist (mapcar 'car lists)) + (apply proc arglist) + (setq lists (mapcar 'cdr lists))))) + +(defun vm-delete (predicate list &optional retain) + "Delete all elements satisfying PREDICATE from LIST and return +the resulting list. If optional argument RETAIN is t, then +retain all elements that satisfy PREDICATE rather than deleting +them. The original LIST is permanently modified." + (let ((p list) + (retain (if retain 'not 'identity)) + prev) + (while p + (if (funcall retain (funcall predicate (car p))) + (if (null prev) + (setq list (cdr list) p list) + (setcdr prev (cdr p)) + (setq p (cdr p))) + (setq prev p p (cdr p)))) + list )) + +(defun vm-elems (n list) + "Select the first N elements of LIST and return them as a list." + (let (res) + (while (and list (> n 0)) + (setq res (cons (car list) res)) + (setq list (cdr list)) + (setq n (1- n))) + (nreverse res))) + +(defun vm-find (list pred) + "Find the first element of LIST satisfying PRED and return the position" + (let ((n 0)) + (while (and list (not (apply pred (car list) nil))) + (setq list (cdr list)) + (setq n (1+ n))) + (if list n nil))) + +(defun vm-find-all (list pred) + "Find all the elements of LIST satisfying PRED" + (let ((n 0) (res nil)) + (while list + (when (apply pred (car list) nil) + (setq res (cons (car list) res))) + (setq list (cdr list)) + (setq n (1+ n))) + (nreverse res))) + +(defun vm-find2 (list1 list2 pred) + "Find the first pair of elements of LIST1 and LIST2 satisfying +PRED and return the position" + (let ((n 0)) + (while (and list1 list2 (not (apply pred (car list1) (car list2) nil))) + (setq list1 (cdr list2) + list2 (cdr list2)) + (setq n (1+ n))) + (if (and list1 list2) n nil))) + +(defun vm-elems-of (list) + "Return the set of elements of LIST as a list." + (let ((res nil)) + (while list + (unless (member (car list) res) + (setq res (cons (car list) res))) + (setq list (cdr list))) + (nreverse res))) + +(defun vm-for-all (list pred) + (catch 'fail + (progn + (while list + (if (apply pred (car list) nil) + (setq list (cdr list)) + (throw 'fail nil))) + t))) + +(fset 'vm-interactive-p + (if (fboundp 'interactive-p) ; Xemacs or Gnu Emacs under obsolescence + 'interactive-p + (lambda () (called-interactively-p 'any)))) + +(fset 'vm-device-type + (cond (vm-xemacs-p 'device-type) + (vm-fsfemacs-p 'vm-fsfemacs-device-type))) + +(defun vm-fsfemacs-device-type (&optional device) + "An FSF Emacs emulation for XEmacs `device-type' function. Returns +the type of the current screen device: one of 'x, 'gtk, 'w32, 'ns and +'pc. The optional argument DEVICE is ignored." + (if (eq window-system 'x) + (if (featurep 'gtk) 'gtk) + window-system)) + +(defun vm-generate-new-unibyte-buffer (name) + (if vm-xemacs-p + (generate-new-buffer name) + (let* (;; (default-enable-multibyte-characters nil) + ;; don't need this because of set-buffer-multibyte below + (buffer (generate-new-buffer name))) + (when (fboundp 'set-buffer-multibyte) + (with-current-buffer buffer + (set-buffer-multibyte nil))) + buffer))) + +(defun vm-generate-new-multibyte-buffer (name) + (if vm-xemacs-p + (generate-new-buffer name) + (let* (;; (default-enable-multibyte-characters t) + ;; don't need this because of set-buffer-multibyte below + (buffer (generate-new-buffer name))) + (if (fboundp 'set-buffer-multibyte) + (with-current-buffer buffer + (set-buffer-multibyte t)) + ;; This error checking only works on FSF + (with-current-buffer buffer + (unless enable-multibyte-characters + (error "VM internal error #1922: buffer is not multibyte")))) + buffer))) + +(defun vm-make-local-hook (hook) + (if (fboundp 'make-local-hook) ; Emacs/XEmacs 21 + (make-local-hook hook))) + +(fset 'xemacs-abbreviate-file-name 'abbreviate-file-name) + +(defun vm-abbreviate-file-name (path) + (if vm-xemacs-p + (xemacs-abbreviate-file-name path t) + (abbreviate-file-name path))) + +(fset 'emacs-find-file-name-handler 'find-file-name-handler) +(defun vm-find-file-name-handler (filename operation) + (if (fboundp 'find-file-name-handler) + (condition-case () + (emacs-find-file-name-handler filename operation) + (wrong-number-of-arguments + (emacs-find-file-name-handler filename))) + nil)) + +(fset 'emacs-focus-frame 'focus-frame) +(defun vm-select-frame-set-input-focus (frame) + (if (fboundp 'select-frame-set-input-focus) + ;; defined in FSF Emacs 22.1 + (select-frame-set-input-focus frame) + (select-frame frame) + (emacs-focus-frame frame) + (raise-frame frame))) + +(fset 'emacs-get-buffer-window 'get-buffer-window) +(defun vm-get-buffer-window (buffer &optional which-frames which-devices) + (condition-case nil ; try XEmacs + (or (emacs-get-buffer-window buffer which-frames which-devices) + (and vm-search-other-frames + (emacs-get-buffer-window buffer t t))) + (wrong-number-of-arguments + (condition-case nil ; try recent Gnu Emacs + (or (emacs-get-buffer-window buffer which-frames) + (and vm-search-other-frames + (emacs-get-buffer-window buffer t))) + (wrong-number-of-arguments ; baseline old Emacs + (emacs-get-buffer-window buffer)))))) + +(defun vm-get-visible-buffer-window (buffer &optional + which-frames which-devices) + (condition-case nil + (or (emacs-get-buffer-window buffer which-frames which-devices) + (and vm-search-other-frames + (emacs-get-buffer-window buffer t which-devices))) + (wrong-number-of-arguments + (condition-case nil + (or (emacs-get-buffer-window buffer which-frames) + (and vm-search-other-frames + (get-buffer-window buffer 'visible))) + (wrong-number-of-arguments + (emacs-get-buffer-window buffer)))))) + +(defun vm-force-mode-line-update () + "Force a mode line update in all frames." + (if (fboundp 'force-mode-line-update) + (force-mode-line-update t) + (with-current-buffer (other-buffer) + (set-buffer-modified-p (buffer-modified-p))))) + +(defun vm-delete-directory-file-names (list) + (vm-delete 'file-directory-p list)) + +(defun vm-delete-backup-file-names (list) + (vm-delete 'backup-file-name-p list)) + +(defun vm-delete-auto-save-file-names (list) + (vm-delete 'auto-save-file-name-p list)) + +(defun vm-delete-index-file-names (list) + (vm-delete 'vm-index-file-name-p list)) + +(defun vm-delete-directory-names (list) + (vm-delete 'file-directory-p list)) + +(defun vm-index-file-name-p (file) + (and (file-regular-p file) + (stringp vm-index-file-suffix) + (let ((str (concat (regexp-quote vm-index-file-suffix) "$"))) + (string-match str file)) + t )) + +(defun vm-delete-duplicates (list &optional all hack-addresses) + "Delete duplicate equivalent strings from the list. +If ALL is t, then if there is more than one occurrence of a string in the list, + then all occurrences of it are removed instead of just the subsequent ones. +If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, + and only the address part is compared (so that \"Name <foo>\" and \"foo\" + would be considered to be equivalent.)" + (let ((hashtable vm-delete-duplicates-obarray) + (new-list nil) + sym-string sym) + (fillarray hashtable 0) + (while list + (setq sym-string + (if hack-addresses + (nth 1 (funcall vm-chop-full-name-function (car list))) + (car list)) + sym-string (or sym-string "-unparseable-garbage-") + sym (intern (if hack-addresses (downcase sym-string) sym-string) + hashtable)) + (if (boundp sym) + (and all (setcar (symbol-value sym) nil)) + (setq new-list (cons (car list) new-list)) + (set sym new-list)) + (setq list (cdr list))) + (delq nil (nreverse new-list)))) + +(defun vm-member-0 (thing list) + (catch 'done + (while list + (and (equal (car list) thing) + (throw 'done list)) + (setq list (cdr list))) + nil )) + +(fset 'vm-member + (symbol-function + (if (fboundp 'member) 'member 'vm-member-0))) + +(defun vm-delqual (ob list) + (let ((prev nil) + (curr list)) + (while curr + (if (not (equal ob (car curr))) + (setq prev curr + curr (cdr curr)) + (if (null prev) + (setq list (cdr list) + curr list) + (setq curr (cdr curr)) + (setcdr prev curr)))) + list )) + +(defun vm-copy-local-variables (buffer &rest variables) + (let ((values (mapcar 'symbol-value variables))) + (with-current-buffer buffer + (vm-mapc 'set variables values)))) + +(put 'folder-empty 'error-conditions '(folder-empty error)) +(put 'folder-empty 'error-message "Folder is empty") +(put 'unrecognized-folder-type 'error-conditions + '(unrecognized-folder-type error)) +(put 'unrecognized-folder-type 'error-message "Unrecognized folder type") + +(defun vm-error-if-folder-empty () + (while (null vm-message-list) + (if vm-folder-type + (signal 'unrecognized-folder-type nil) + (signal 'folder-empty nil)))) + +(defun vm-copy (object) + "Make a copy of OBJECT, which could be a list, vector, string or marker." + (cond ((consp object) + (let (return-value cons) + (setq return-value (cons (vm-copy (car object)) nil) + cons return-value + object (cdr object)) + (while (consp object) + (setcdr cons (cons (vm-copy (car object)) nil)) + (setq cons (cdr cons) + object (cdr object))) + (setcdr cons object) + return-value )) + ((vectorp object) (apply 'vector (mapcar 'vm-copy object))) + ((stringp object) (copy-sequence object)) + ((markerp object) (copy-marker object)) + (t object))) + +(defun vm-run-hook-on-message (hook-variable message) + (with-current-buffer (vm-buffer-of message) + (vm-save-restriction + (widen) + (save-excursion + (narrow-to-region (vm-headers-of message) (vm-text-end-of message)) + (run-hooks hook-variable))))) + +(defun vm-run-message-hook (message hook-variable) + (vm-run-hook-on-message hook-variable message)) +(make-obsolete 'vm-run-message-hook 'vm-run-hook-on-message "8.2.0") + +(defun vm-run-hook-on-message-with-args (hook-variable message &rest args) + (with-current-buffer (vm-buffer-of message) + (vm-save-restriction + (widen) + (save-excursion + (narrow-to-region (vm-headers-of message) (vm-text-end-of message)) + (apply 'run-hook-with-args hook-variable args))))) + +(defun vm-run-message-hook-with-args (message hook-variable &rest args) + (apply 'vm-run-hook-on-message-with-args hook-variable message args)) +(make-obsolete 'vm-run-message-hook-with-args + 'vm-run-hook-on-message-with-args "8.2.0") + +(defun vm-error-free-call (function &rest args) + (condition-case nil + (apply function args) + (error nil))) + +(put 'beginning-of-folder 'error-conditions '(beginning-of-folder error)) +(put 'beginning-of-folder 'error-message "Beginning of folder") +(put 'end-of-folder 'error-conditions '(end-of-folder error)) +(put 'end-of-folder 'error-message "End of folder") + +(defun vm-trace (&rest args) + (with-current-buffer (get-buffer-create "*vm-trace*") + (apply 'insert args))) + +(defun vm-timezone-make-date-sortable (string) + (or (cdr (assq string vm-sortable-date-alist)) + (let ((vect (vm-parse-date string)) + (date (vm-parse (current-time-string) " *\\([^ ]+\\)"))) + ;; if specified date is incomplete fill in the holes + ;; with useful information, defaulting to the current + ;; date and timezone for everything except hh:mm:ss which + ;; defaults to midnight. + (if (equal (aref vect 1) "") + (aset vect 1 (nth 2 date))) + (if (equal (aref vect 2) "") + (aset vect 2 (nth 1 date))) + (if (equal (aref vect 3) "") + (aset vect 3 (nth 4 date))) + (if (equal (aref vect 4) "") + (aset vect 4 "00:00:00")) + (if (equal (aref vect 5) "") + (aset vect 5 (vm-current-time-zone))) + ;; save this work so we won't have to do it again + (setq vm-sortable-date-alist + (cons (cons string + (condition-case nil + (timezone-make-date-sortable + (format "%s %s %s %s %s" + (aref vect 1) + (aref vect 2) + (aref vect 3) + (aref vect 4) + (aref vect 5))) + (error "1970010100:00:00"))) + vm-sortable-date-alist)) + ;; return result + (cdr (car vm-sortable-date-alist))))) + +(defun vm-current-time-zone () + (or (condition-case nil + (let* ((zone (car (current-time-zone))) + (absmin (/ (vm-abs zone) 60))) + (format "%c%02d%02d" (if (< zone 0) ?- ?+) + (/ absmin 60) (% absmin 60))) + (error nil)) + (let ((temp-buffer (vm-make-work-buffer))) + (condition-case nil + (unwind-protect + (with-current-buffer temp-buffer + (call-process "date" nil temp-buffer nil) + (nth 4 (vm-parse (vm-buffer-string-no-properties) + " *\\([^ ]+\\)"))) + (and temp-buffer (kill-buffer temp-buffer))) + (error nil))) + "")) + +(defun vm-parse-date (date) + (let ((weekday "") + (monthday "") + (month "") + (year "") + (hour "") + (timezone "") + (start nil) + string + (case-fold-search t)) + (if (string-match "sun\\|mon\\|tue\\|wed\\|thu\\|fri\\|sat" date) + (setq weekday (substring date (match-beginning 0) (match-end 0)))) + (if (string-match "jan\\|feb\\|mar\\|apr\\|may\\|jun\\|jul\\|aug\\|sep\\|oct\\|nov\\|dec" date) + (setq month (substring date (match-beginning 0) (match-end 0)))) + (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(:[0-9][0-9]\\)?" date) + (setq hour (substring date (match-beginning 0) (match-end 0)))) + (cond ((string-match "[^a-z][+---][0-9][0-9][0-9][0-9]" date) + (setq timezone (substring date (1+ (match-beginning 0)) + (match-end 0)))) + ((or (string-match "e[ds]t\\|c[ds]t\\|p[ds]t\\|m[ds]t" date) + (string-match "ast\\|nst\\|met\\|eet\\|jst\\|bst\\|ut" date) + (string-match "gmt\\([+---][0-9]+\\)?" date)) + (setq timezone (substring date (match-beginning 0) (match-end 0))))) + (while (and (or (zerop (length monthday)) + (zerop (length year))) + (string-match "\\(^\\| \\)\\([0-9]+\\)\\($\\| \\)" date start)) + (setq string (substring date (match-beginning 2) (match-end 2)) + start (match-end 0)) + (cond ((and (zerop (length monthday)) + (<= (length string) 2)) + (setq monthday string)) + ((= (length string) 2) + (if (< (string-to-number string) 70) + (setq year (concat "20" string)) + (setq year (concat "19" string)))) + (t (setq year string)))) + + (aset vm-parse-date-workspace 0 weekday) + (aset vm-parse-date-workspace 1 monthday) + (aset vm-parse-date-workspace 2 month) + (aset vm-parse-date-workspace 3 year) + (aset vm-parse-date-workspace 4 hour) + (aset vm-parse-date-workspace 5 timezone) + vm-parse-date-workspace)) + +(defun vm-should-generate-summary () + (cond ((eq vm-startup-with-summary t) t) + ((integerp vm-startup-with-summary) + (let ((n vm-startup-with-summary)) + (cond ((< n 0) (null (nth (vm-abs n) vm-message-list))) + ((= n 0) nil) + (t (nth (1- n) vm-message-list))))) + (vm-startup-with-summary t) + (t nil))) + +(defun vm-find-composition-buffer (&optional not-picky) + (let ((b-list (buffer-list)) choice alternate) + (save-excursion + (while b-list + (set-buffer (car b-list)) + (if (eq major-mode 'mail-mode) + (if (buffer-modified-p) + (setq choice (current-buffer) + b-list nil) + (and not-picky (null alternate) + (setq alternate (current-buffer))) + (setq b-list (cdr b-list))) + (setq b-list (cdr b-list)))) + (or choice alternate)))) + +(defun vm-get-file-buffer (file) + "Like get-file-buffer, but also checks buffers against FILE's truename" + (or (get-file-buffer file) + (and (fboundp 'file-truename) + (get-file-buffer (file-truename file))) + (and (fboundp 'find-buffer-visiting) + (find-buffer-visiting file)))) + +;; The following function is not working correctly on Gnu Emacs 23. +;; So we do it ourselves. +(defun vm-delete-auto-save-file-if-necessary () + (if vm-xemacs-p + (delete-auto-save-file-if-necessary) + (when (and buffer-auto-save-file-name delete-auto-save-files + (not (string= buffer-file-name buffer-auto-save-file-name)) + (file-newer-than-file-p + buffer-auto-save-file-name buffer-file-name)) + (condition-case () + (if (save-window-excursion + (with-output-to-temp-buffer "*Directory*" + (buffer-disable-undo standard-output) + (save-excursion + (let ((switches dired-listing-switches) + (file buffer-file-name) + (save-file buffer-auto-save-file-name)) + (if (file-symlink-p buffer-file-name) + (setq switches (concat switches "L"))) + (set-buffer standard-output) + ;; Use insert-directory-safely, not insert-directory, + ;; because these files might not exist. In particular, + ;; FILE might not exist if the auto-save file was for + ;; a buffer that didn't visit a file, such as "*mail*". + ;; The code in v20.x called `ls' directly, so we need + ;; to emulate what `ls' did in that case. + (insert-directory-safely save-file switches) + (insert-directory-safely file switches)))) + (yes-or-no-p + (format "Delete auto save file %s? " + buffer-auto-save-file-name))) + (delete-file buffer-auto-save-file-name)) + (file-error nil)) + (set-buffer-auto-saved)))) + +(defun vm-set-region-face (start end face) + (let ((e (vm-make-extent start end))) + (vm-set-extent-property e 'face face))) + +(fset 'vm-xemacs-set-face-foreground (function set-face-foreground)) +(fset 'vm-fsfemacs-set-face-foreground (function set-face-foreground)) +(fset 'vm-xemacs-set-face-background (function set-face-background)) +(fset 'vm-fsfemacs-set-face-background (function set-face-background)) + + +(defun vm-default-buffer-substring-no-properties (beg end &optional buffer) + (let ((s (if buffer + (with-current-buffer buffer + (buffer-substring beg end)) + (buffer-substring beg end)))) + (set-text-properties 0 (length s) nil s) + (copy-sequence s))) + +(fset 'vm-buffer-substring-no-properties + (cond ((fboundp 'buffer-substring-no-properties) + (function buffer-substring-no-properties)) + (vm-xemacs-p + (function buffer-substring)) + (t (function vm-default-buffer-substring-no-properties)))) + +(defun vm-buffer-string-no-properties () + (vm-buffer-substring-no-properties (point-min) (point-max))) + +(fset 'vm-substring-no-properties + (cond ((fboundp 'substring-no-properties) + (function substring-no-properties)) + (t (function substring)))) + +(defun vm-insert-region-from-buffer (buffer &optional start end) + (let ((target-buffer (current-buffer))) + (set-buffer buffer) + (save-restriction + (widen) + (or start (setq start (point-min))) + (or end (setq end (point-max))) + (set-buffer target-buffer) + (insert-buffer-substring buffer start end) + (set-buffer buffer)) + (set-buffer target-buffer))) + +(if (not (fboundp 'vm-extent-property)) + (if vm-fsfemacs-p + (fset 'vm-extent-property 'overlay-get) + (fset 'vm-extent-property 'extent-property))) + +(if (not (fboundp 'vm-extent-object)) + (if vm-fsfemacs-p + (fset 'vm-extent-object 'overlay-buffer) + (fset 'vm-extent-object 'extent-object))) + +(if (not (fboundp 'vm-set-extent-property)) + (if vm-fsfemacs-p + (fset 'vm-set-extent-property 'overlay-put) + (fset 'vm-set-extent-property 'set-extent-property))) + +(if (not (fboundp 'vm-set-extent-endpoints)) + (if vm-fsfemacs-p + (fset 'vm-set-extent-endpoints 'move-overlay) + (fset 'vm-set-extent-endpoints 'set-extent-endpoints))) + +(if (not (fboundp 'vm-make-extent)) + (if vm-fsfemacs-p + (fset 'vm-make-extent 'make-overlay) + (fset 'vm-make-extent 'make-extent))) + +(if (not (fboundp 'vm-extent-end-position)) + (if vm-fsfemacs-p + (fset 'vm-extent-end-position 'overlay-end) + (fset 'vm-extent-end-position 'extent-end-position))) + +(if (not (fboundp 'vm-extent-start-position)) + (if vm-fsfemacs-p + (fset 'vm-extent-start-position 'overlay-start) + (fset 'vm-extent-start-position 'extent-start-position))) + +(if (not (fboundp 'vm-detach-extent)) + (if vm-fsfemacs-p + (fset 'vm-detach-extent 'delete-overlay) + (fset 'vm-detach-extent 'detach-extent))) + +(if (not (fboundp 'vm-delete-extent)) + (if vm-fsfemacs-p + ;; This doesn't actually destroy the overlay, but it is the + ;; best there is. + (fset 'vm-delete-extent 'delete-overlay) + (fset 'vm-delete-extent 'delete-extent))) + +(if (not (fboundp 'vm-disable-extents)) + (if (and vm-fsfemacs-p (fboundp 'remove-overlays)) + (fset 'vm-disable-extents 'remove-overlays) + ;; XEamcs doesn't need to disable extents because they don't + ;; slow things down + (fset 'vm-disable-extents (lambda (&optional beg end name val) nil)))) + +(if (not (fboundp 'vm-extent-properties)) + (if vm-fsfemacs-p + (fset 'vm-extent-properties 'overlay-properties) + (fset 'vm-extent-properties 'extent-properties))) + +(defun vm-extent-at (pos &optional property) + "Find an extent at POS in the current buffer having PROPERTY. +PROPERTY defaults nil, meaning any extent will do. + +In XEmacs, the extent is the \"smallest\" extent at POS. In FSF Emacs, +this may not be the case." + (if (fboundp 'extent-at) + (extent-at pos nil property) + (let ((o-list (overlays-at pos)) + (o nil)) + (if (null property) + (car o-list) + (while o-list + (if (overlay-get (car o-list) property) + (setq o (car o-list) + o-list nil) + (setq o-list (cdr o-list)))) + o )))) + +(defun vm-extent-list (beg end &optional property) + "Returns a list of the extents that overlap the positions BEG to END. +If PROPERTY is given, then only the extents have PROPERTY are returned." + (if (fboundp 'extent-list) + (extent-list nil beg end nil property) + (let ((o-list (overlays-in beg end))) + (if property + (vm-delete (function (lambda (e) + (vm-extent-property e property))) + o-list t) + o-list)))) + +(defun vm-copy-extent (e) + (let ((props (vm-extent-properties e)) + (ee (vm-make-extent (vm-extent-start-position e) + (vm-extent-end-position e)))) + (while props + (vm-set-extent-property ee (car props) (car (cdr props))) + (setq props (cdr (cdr props)))))) + +(defun vm-make-tempfile (&optional filename-suffix proposed-filename) + (let ((modes (default-file-modes)) + (file (vm-make-tempfile-name filename-suffix proposed-filename))) + (unwind-protect + (progn + (set-default-file-modes (vm-octal 600)) + (vm-error-free-call 'delete-file file) + (write-region (point) (point) file nil 0)) + (set-default-file-modes modes)) + file )) + +(defun vm-make-tempfile-name (&optional filename-suffix proposed-filename) + (if (stringp proposed-filename) + (setq proposed-filename (file-name-nondirectory proposed-filename))) + (let (filename) + (cond ((and (stringp proposed-filename) + (not (file-exists-p + (setq filename (convert-standard-filename + (expand-file-name + proposed-filename + vm-temp-file-directory)))))) + t ) + ((stringp proposed-filename) + (let ((done nil)) + (while (not done) + (setq filename (convert-standard-filename + (expand-file-name + (format "%d-%s" + vm-tempfile-counter + proposed-filename) + vm-temp-file-directory)) + vm-tempfile-counter (1+ vm-tempfile-counter) + done (not (file-exists-p filename)))))) + (t + (let ((done nil)) + (while (not done) + (setq filename (convert-standard-filename + (expand-file-name + (format "vm%d%d%s" + vm-tempfile-counter + (random 100000000) + (or filename-suffix "")) + vm-temp-file-directory)) + vm-tempfile-counter (1+ vm-tempfile-counter) + done (not (file-exists-p filename))))))) + filename )) + +(defun vm-make-work-buffer (&optional name) + "Create a unibyte buffer with NAME for VM to do its work in +encoding/decoding, conversions, subprocess communication etc." + (let ((work-buffer (vm-generate-new-unibyte-buffer + (or name "*vm-workbuf*")))) + (buffer-disable-undo work-buffer) +;; probably not worth doing since no one sets buffer-offer-save +;; non-nil globally, do they? +;; (with-current-buffer work-buffer +;; (setq buffer-offer-save nil)) + work-buffer )) + +(defun vm-make-multibyte-work-buffer (&optional name) + (let ((work-buffer (vm-generate-new-multibyte-buffer + (or name "*vm-workbuf*")))) + (buffer-disable-undo work-buffer) +;; probably not worth doing since no one sets buffer-offer-save +;; non-nil globally, do they? +;; (with-current-buffer work-buffer +;; (setq buffer-offer-save nil)) + work-buffer )) + +(fset 'xemacs-insert-char 'insert-char) +(defun vm-insert-char (char &optional count ignored buffer) + (condition-case nil + (progn + (xemacs-insert-char char count ignored buffer) + (fset 'vm-insert-char 'insert-char)) + (wrong-number-of-arguments + (fset 'vm-insert-char 'vm-xemacs-compatible-insert-char) + (vm-insert-char char count ignored buffer)))) + +(defun vm-xemacs-compatible-insert-char (char &optional count ignored buffer) + (if (and buffer (eq buffer (current-buffer))) + (insert-char char count) + (with-current-buffer buffer + (insert-char char count)))) + +(defun vm-symbol-lists-intersect-p (list1 list2) + (catch 'done + (while list1 + (and (memq (car list1) list2) + (throw 'done t)) + (setq list1 (cdr list1))) + nil )) + +(defun vm-folder-buffer-value (var) + (if vm-mail-buffer + (with-current-buffer + vm-mail-buffer + (symbol-value var)) + (symbol-value var))) + +(defsubst vm-with-string-as-temp-buffer (string function) + (let ((work-buffer (vm-make-multibyte-work-buffer))) + (unwind-protect + (with-current-buffer work-buffer + (insert string) + (funcall function) + (buffer-string)) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-string-assoc (elt list) + (let ((case-fold-search t) + (found nil) + (elt (regexp-quote elt))) + (while (and list (not found)) + (if (and (equal 0 (string-match elt (car (car list)))) + (= (match-end 0) (length (car (car list))))) + (setq found t) + (setq list (cdr list)))) + (car list))) + +(defun vm-nonneg-string (n) + (if (< n 0) + "?" + (int-to-string n))) + +(defun vm-string-member (elt list) + (let ((case-fold-search t) + (found nil) + (elt (regexp-quote elt))) + (while (and list (not found)) + (if (and (equal 0 (string-match elt (car list))) + (= (match-end 0) (length (car list)))) + (setq found t) + (setq list (cdr list)))) + list)) + +(defun vm-string-equal-ignore-case (str1 str2) + (let ((case-fold-search t) + (reg (regexp-quote str1))) + (and (equal 0 (string-match reg str2)) + (= (match-end 0) (length str2))))) + +(defun vm-match-data () + (let ((n (1- (/ (length (match-data)) 2))) + (list nil)) + (while (>= n 0) + (setq list (cons (match-beginning n) + (cons (match-end n) list)) + n (1- n))) + list)) + +(defun vm-time-difference (t1 t2) + (let (usecs secs 65536-secs carry) + (setq usecs (- (nth 2 t1) (nth 2 t2))) + (if (< usecs 0) + (setq carry 1 + usecs (+ usecs 1000000)) + (setq carry 0)) + (setq secs (- (nth 1 t1) (nth 1 t2) carry)) + (if (< secs 0) + (setq carry 1 + secs (+ secs 65536)) + (setq carry 0)) + (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) + (+ (* 65536-secs 65536) + secs + (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) + +(if (fboundp 'char-to-int) + (fset 'vm-char-to-int 'char-to-int) + (fset 'vm-char-to-int 'identity)) + +(cond ((fboundp 'charsets-in-region) + (fset 'vm-charsets-in-region 'charsets-in-region)) + ((fboundp 'find-charset-region) + (fset 'vm-charsets-in-region 'find-charset-region))) + +;; Wrapper for coding-system-p: +;; The XEmacs function expects a coding-system object as its argument, +;; the GNU Emacs function expects a symbol. +;; In the non-MULE case, return nil (is this the right fallback?). +(defun vm-coding-system-p (name) + (cond (vm-xemacs-mule-p + (coding-system-p (find-coding-system name))) + (vm-fsfemacs-mule-p + (coding-system-p name)))) + +(cond ((fboundp 'coding-system-name) + (fset 'vm-coding-system-name 'coding-system-name)) + (t + (fset 'vm-coding-system-name 'identity))) + +(if (fboundp 'coding-system-name) + (defun vm-coding-system-name-no-eol (coding-system) + (coding-system-name + (coding-system-change-eol-conversion coding-system nil))) + (defun vm-coding-system-name-no-eol (coding-system) + (coding-system-change-eol-conversion coding-system nil))) + +(defun vm-get-file-line-ending-coding-system (file) + (if (not (or vm-fsfemacs-mule-p vm-xemacs-mule-p vm-xemacs-file-coding-p)) + nil + (let ((coding-system-for-read (vm-binary-coding-system)) + (work-buffer (vm-make-work-buffer))) + (unwind-protect + (with-current-buffer work-buffer + (condition-case nil + (insert-file-contents file nil 0 4096) + (error nil)) + (goto-char (point-min)) + (cond ((re-search-forward "[^\r]\n" nil t) + (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix)) + ((re-search-forward "\r[^\n]" nil t) + (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac)) + ((search-forward "\r\n" nil t) + (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos)) + (t (vm-line-ending-coding-system)))) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-new-folder-line-ending-coding-system () + (cond ((eq vm-default-new-folder-line-ending-type nil) + (vm-line-ending-coding-system)) + ((eq vm-default-new-folder-line-ending-type 'lf) + (if vm-fsfemacs-mule-p 'raw-text-unix 'no-conversion-unix)) + ((eq vm-default-new-folder-line-ending-type 'crlf) + (if vm-fsfemacs-mule-p 'raw-text-dos 'no-conversion-dos)) + ((eq vm-default-new-folder-line-ending-type 'cr) + (if vm-fsfemacs-mule-p 'raw-text-mac 'no-conversion-mac)) + (t + (vm-line-ending-coding-system)))) + +(defun vm-collapse-whitespace () + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]+" nil 0) + (replace-match " " t t))) + +(defvar vm-paragraph-prefix-regexp "^[ >]*" + "A regexp used by `vm-forward-paragraph' to match paragraph prefixes.") + +(defvar vm-empty-line-regexp "^[ \t>]*$" + "A regexp used by `vm-forward-paragraph' to match paragraph prefixes.") + +(defun vm-skip-empty-lines () + "Move forward as long as current line matches `vm-empty-line-regexp'." + (while (and (not (eobp)) + (looking-at vm-empty-line-regexp)) + (forward-line 1))) + +(defun vm-forward-paragraph () + "Move forward to end of paragraph and do it also right for quoted text. +As a side-effect set `fill-prefix' to the paragraphs prefix. +Returns t if there was a line longer than `fill-column'." + (let ((long-line) + (line-no 1) + len-fill-prefix) + (forward-line 0) ; cover for bad fill-region fns + (setq fill-prefix nil) + (while (and + ;; stop at end of buffer + (not (eobp)) + ;; empty lines break paragraphs + (not (looking-at "^[ \t]*$")) + ;; do we see a prefix + (looking-at vm-paragraph-prefix-regexp) + (let ((m (match-string 0)) + lenm) + (or (and (null fill-prefix) + ;; save prefix for next line + (setq fill-prefix m len-fill-prefix (length m))) + ;; is it still the same prefix? + (string= fill-prefix m) + ;; or is it just shorter by whitespace on the second line + (and + (= line-no 2) + (< (setq lenm (length m)) len-fill-prefix) + (string-match "^[ \t]+$" (substring fill-prefix lenm)) + ;; then save new shorter prefix + (setq fill-prefix m len-fill-prefix lenm))))) + (end-of-line) + (setq line-no (1+ line-no)) + (setq long-line (or long-line (> (current-column) fill-column))) + (forward-line 1)) + long-line)) + +(defun vm-fill-paragraphs-containing-long-lines (width start end) + "Fill paragraphs spanning more than WIDTH columns in region +START to END. If WIDTH is 'window-width, the current width of +the Emacs window is used. If vm-word-wrap-paragraphs is set +non-nil, then the longlines package is used to word-wrap long +lines without removing any existing line breaks. + +In order to fill also quoted text you will need `filladapt.el' as the adaptive +filling of GNU Emacs does not work correctly here." + (if (and vm-word-wrap-paragraphs (locate-library "longlines")) + (vm-fill-paragraphs-by-longlines start end) + (if (eq width 'window-width) + (setq width (- (window-width (get-buffer-window (current-buffer))) 1))) + (save-excursion + (let ((buffer-read-only nil) + (fill-column vm-paragraph-fill-column) + (adaptive-fill-mode nil) + (abbrev-mode nil) + (fill-prefix nil) + ;; (use-hard-newlines t) + (filled 0) + (message (if (car vm-message-pointer) + (vm-su-subject (car vm-message-pointer)) + (buffer-name))) + (needmsg (> (- end start) 12000))) + + (if needmsg + (vm-inform 5 "Filling message to column %d" fill-column)) + + ;; we need a marker for the end since this position might change + (or (markerp end) (setq end (vm-marker end))) + (goto-char start) + + (while (< (point) end) + (setq start (point)) + (vm-skip-empty-lines) + (when (and (< (point) end) ; if no newline at the end + (let ((fill-column width)) (vm-forward-paragraph))) + (fill-region start (point)) + (setq filled (1+ filled)))) + + ;; Turning off these messages because they go by too fast and + ;; are not particularly enlightening. USR, 2010-01-26 + ;; (if (= filled 0) + ;; (vm-inform 7 "Nothing to fill") + ;; (vm-inform 7 "Filled %s paragraph%s" + ;; (if (> filled 1) (format "%d" filled) "one") + ;; (if (> filled 1) "s" ""))) + )))) + +(defun vm-fill-paragraphs-by-longlines (start end) + "Uses longlines.el for filling the region." + ;; prepare for longlines.el in XEmacs + (require 'overlay) + (require 'longlines) + (defvar fill-nobreak-predicate nil) + (defvar undo-in-progress nil) + (defvar longlines-mode-hook nil) + (defvar longlines-mode-on-hook nil) + (defvar longlines-mode-off-hook nil) + (unless (functionp 'replace-regexp-in-string) + (defun replace-regexp-in-string (regexp rep string + &optional fixedcase literal) + (vm-replace-in-string string regexp rep literal))) + (unless (functionp 'line-end-position) + (defun line-end-position () + (save-excursion (end-of-line) (point)))) + (unless (functionp 'line-beginning-position) + (defun line-beginning-position (&optional n) + (save-excursion + (if n (forward-line n)) + (beginning-of-line) + (point))) + (unless (functionp 'replace-regexp-in-string) + (defun replace-regexp-in-string (regexp rep string + &optional fixedcase literal) + (vm-replace-in-string string regexp rep literal)))) + ;; now do the filling + (let ((buffer-read-only nil) + (fill-column + (if (numberp vm-fill-paragraphs-containing-long-lines) + vm-fill-paragraphs-containing-long-lines + (- (window-width (get-buffer-window (current-buffer))) 1))) + ) + (save-excursion + (vm-save-restriction + ;; longlines-wrap-region contains a (forward-line -1) which is causing + ;; wrapping of headers which is wrong, so we restrict it here! + (narrow-to-region start end) + (longlines-decode-region start end) ; make linebreaks hard + (longlines-wrap-region start end) ; wrap, adding soft linebreaks + (widen))))) + + +(defun vm-make-message-id () + (let (hostname + (time (current-time))) + (setq hostname (cond ((string-match "\\." (system-name)) + (system-name)) + ((and (stringp mail-host-address) + (string-match "\\." mail-host-address)) + mail-host-address) + (t "gargle.gargle.HOWL"))) + (format "<%d.%d.%d.%d@%s>" + (car time) (nth 1 time) (nth 2 time) + (random 1000000) + hostname))) + +(defun vm-keep-some-buffers (buffer ring-variable number-to-keep + &optional rename-prefix) + "Keep the BUFFER in the variable RING-VARIABLE, with NUMBER-TO-KEEP +being the maximum number of buffers kept. If necessary, the +RING-VARIABLE is pruned. If the optional argument string +RENAME-PREFIX is given BUFFER is renamed by adding the prefix at the +front before adding it to the RING-VARIABLE." + (if (memq buffer (symbol-value ring-variable)) + (set ring-variable (delq buffer (symbol-value ring-variable))) + (with-current-buffer buffer + (rename-buffer (concat "saved " (buffer-name)) t))) + (set ring-variable (cons buffer (symbol-value ring-variable))) + (set ring-variable (vm-delete 'buffer-name + (symbol-value ring-variable) t)) + (if (not (eq number-to-keep t)) + (let ((extras (nthcdr (or number-to-keep 0) + (symbol-value ring-variable)))) + (mapc (function + (lambda (b) + (when (and (buffer-name b) + (or (not (buffer-modified-p b)) + (not (with-current-buffer b + buffer-offer-save)))) + (kill-buffer b)))) + extras) + (and (symbol-value ring-variable) extras + (setcdr (memq (car extras) (symbol-value ring-variable)) + nil))))) + +(defvar enable-multibyte-characters) +(defvar buffer-display-table) +(defun vm-fsfemacs-nonmule-display-8bit-chars () + (cond ((and vm-fsfemacs-p + (or (not vm-fsfemacs-mule-p) + (and (boundp 'enable-multibyte-characters) + (not enable-multibyte-characters)))) + (let* (tab (i 160)) + ;; We need the function make-display-table, but it is + ;; in disp-table.el, which overwrites the value of + ;; standard-display-table when it is loaded, which + ;; sucks. So here we cruftily copy just enough goop + ;; out of disp-table.el so that a display table can be + ;; created, and thereby avoid loading disp-table. + (put 'display-table 'char-table-extra-slots 6) + (setq tab (make-char-table 'display-table nil)) + (while (< i 256) + (aset tab i (vector i)) + (setq i (1+ i))) + (setq buffer-display-table tab))))) + +(defun vm-url-decode-string (string) + (vm-with-string-as-temp-buffer string 'vm-url-decode-buffer)) + +(defun vm-url-decode-buffer () + (let ((case-fold-search t) + (hex-digit-alist '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?A . 10) (?B . 11) + (?C . 12) (?D . 13) (?E . 14) (?F . 15) + (?a . 10) (?b . 11) (?c . 12) (?d . 13) + (?e . 14) (?f . 15))) + char) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "%[0-9A-F][0-9A-F]" nil t) + (insert-char (+ (* (cdr (assq (char-after (- (point) 2)) + hex-digit-alist)) + 16) + (cdr (assq (char-after (- (point) 1)) + hex-digit-alist))) + 1) + (delete-region (- (point) 1) (- (point) 4)))))) + +(defun vm-process-kill-without-query (process &optional flag) + (if (fboundp 'process-kill-without-query) + (process-kill-without-query process flag) + (set-process-query-on-exit-flag process flag))) + +(defun vm-process-sentinel-kill-buffer (process what-happened) + (kill-buffer (process-buffer process))) + +(defun vm-fsfemacs-scroll-bar-width () + (or vm-fsfemacs-cached-scroll-bar-width + (let (size) + (setq size (frame-pixel-width)) + (scroll-bar-mode nil) + (setq size (- size (frame-pixel-width))) + (scroll-bar-mode nil) + (setq vm-fsfemacs-cached-scroll-bar-width size)))) + +(defvar vm-disable-modes-ignore nil + "List of modes ignored by `vm-disable-modes'. +Any mode causing an error while trying to disable it will be added to this +list. It still will try to diable it, but no error messages are generated +anymore for it.") + +(defun vm-disable-modes (&optional modes) + "Disable the given minor modes. +If MODES is nil the take the modes from the variable +`vm-disable-modes-before-encoding'." + (let (m) + (while modes + (setq m (car modes) modes (cdr modes)) + (condition-case errmsg + (if (functionp m) + (funcall m -1)) + (error + (when (not (member m vm-disable-modes-ignore)) + (vm-warn 0 2 "Could not disable mode `%S': %S" m errmsg) + (setq vm-disable-modes-ignore (cons m vm-disable-modes-ignore))) + nil))))) + +(defun vm-add-write-file-hook (vm-hook-fn) + "Add a function to the hook called during write-file. + +Emacs changed the name of write-file-hooks to write-file-functions as of +Emacs 22.1. This function is used to supress compiler warnings." + (if (boundp 'write-file-functions) + (add-hook 'write-file-functions vm-hook-fn) + (add-hook 'write-file-hooks vm-hook-fn))) + +(defun vm-add-find-file-hook (vm-hook-fn) + "Add a function to the hook called during find-file. + +Emacs changed the name of the hook find-file-hooks to find-file-hook in +Emacs 22.1. This function used to supress compiler warnings." + (if (boundp 'find-file-hook) + (add-hook 'find-file-hook vm-hook-fn) + (add-hook 'find-file-hooks vm-hook-fn))) + +;; Aliases for VM functions + + + +;;; vm-misc.el ends here diff --git a/lisp/vm-motion.el b/lisp/vm-motion.el new file mode 100755 index 0000000..3eb23c2 --- /dev/null +++ b/lisp/vm-motion.el @@ -0,0 +1,578 @@ +;;; vm-motion.el --- Commands to move around in a VM folder +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-motion) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-thread) + (require 'vm-window) + (require 'vm-page) + ) + +(declare-function vm-so-sortable-subject "vm-sort" (message)) + +(defun vm-record-and-change-message-pointer (old new) + "Change the `vm-message-pointer' of the folder from OLD to NEW, both +of which must be pointers into the `vm-message-list'." + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-garbage-collect-message) + (setq vm-last-message-pointer old + vm-message-pointer new + vm-need-summary-pointer-update t)) + +;;;###autoload +(defun vm-goto-message (n) + "Go to the message numbered N. +Interactively N is the prefix argument. If no prefix arg is provided +N is prompted for in the minibuffer. + +If vm-follow-summary-cursor is non-nil this command will go to +the message under the cursor in the summary buffer if the summary +window is selected. This only happens if no prefix argument is +given." + (interactive + (list + (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) + ((vm-follow-summary-cursor) nil) + ((vm-follow-folders-summary-cursor) nil) + (t + (let ((last-command last-command) + (this-command this-command)) + (vm-read-number "Go to message: ")))))) + (if (null n) + () ; nil means work has been done already + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-goto-message) '(vm-goto-message)) + (let ((cons (nthcdr (1- n) vm-message-list))) + (if (null cons) + (error "No such message.")) + (if (eq vm-message-pointer cons) + (vm-present-current-message) + (vm-record-and-change-message-pointer vm-message-pointer cons) + (vm-present-current-message) + ;;(vm-warn 0 0 "start of message you want is: %s" + ;; (vm-su-start-of (car vm-message-pointer))) + (if (and (vm-summary-operation-p) + vm-summary-show-threads + (get-text-property + (+ (vm-su-start-of (car vm-message-pointer)) 2) + 'invisible vm-summary-buffer)) + (vm-expand-thread (vm-thread-root (car vm-message-pointer)))) + )))) + +;;;###autoload +(defun vm-goto-message-last-seen () + "Go to the message last previewed." + (interactive) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-goto-message-last-seen) + '(vm-goto-message-last-seen)) + (if vm-last-message-pointer + (progn + (vm-record-and-change-message-pointer vm-message-pointer + vm-last-message-pointer) + (vm-present-current-message)))) +(defalias 'vm-goto-last-message-seen 'vm-goto-message-last-seen) + +;;;###autoload +(defun vm-goto-parent-message () + "Go to the parent of the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-build-threads-if-unbuilt) + (vm-display nil nil '(vm-goto-parent-message) + '(vm-goto-parent-message)) + (let ((lineage (cdr (reverse (vm-thread-list (car vm-message-pointer))))) + (message nil)) + (cond ((null lineage) + (vm-inform 5 "Message has no parent listed.")) + ((vm-th-messages-of (car lineage)) + (setq message (car lineage))) + ((y-or-n-p (concat "Parent message is not in this folder. " + "Go to the next ancestor? ")) + (while (and lineage (null (vm-th-messages-of (car lineage)))) + (setq lineage (cdr lineage))) + (if (null lineage) + (vm-inform 5 "Message has no ancestors in this folder") + (setq message (car lineage))))) + (when message + (setq message (car (vm-th-messages-of (car lineage)))) + (vm-record-and-change-message-pointer vm-message-pointer + (vm-message-position message)) + (vm-present-current-message)))) + +(defun vm-check-count (count) + (if (>= count 0) + (if (< (length vm-message-pointer) count) + (signal 'end-of-folder nil)) + (if (< (1+ (- (length vm-message-list) (length vm-message-pointer))) + (vm-abs count)) + (signal 'beginning-of-folder nil)))) + +(defun vm-move-message-pointer (direction) + "Move vm-message-pointer along DIRECTION by one position. DIRECTION +is one of 'forward and 'backward. USR, 2011-01-18" + (let ((mp vm-message-pointer)) + (if (eq direction 'forward) + (progn + (setq mp (cdr mp)) + (if (null mp) + (if vm-circular-folders + (setq mp vm-message-list) + (signal 'end-of-folder nil)))) + (setq mp (vm-reverse-link-of (car mp))) + (if (null mp) + (if vm-circular-folders + (setq mp (vm-last vm-message-list)) + (signal 'beginning-of-folder nil)))) + (setq vm-message-pointer mp))) + +(defun vm-should-skip-message (mp &optional skip-dogmatically) + "Checks various preference settings and message attributes to +determine whether the current message should be skipped during +movement. The first argument MP is a pointer into the message-list. +The optional argument SKIP-DOGMATICALLY asks it to follow a strong +interpretation of the preferences. USR, 2011-01-18" + (or (and (if skip-dogmatically + vm-skip-deleted-messages + (eq vm-skip-deleted-messages t)) + (vm-deleted-flag (car mp))) + (vm-should-skip-hidden-message mp) + (and (if skip-dogmatically + vm-skip-read-messages + (eq vm-skip-read-messages t)) + (or (vm-deleted-flag (car mp)) + (not (or (vm-new-flag (car mp)) + (vm-unread-flag (car mp)))))) + (and (eq last-command 'vm-next-command-uses-marks) + (null (vm-mark-of (car mp)))))) + +(defun vm-should-skip-hidden-message (mp) + "Checks if the current message in MP should be skipped as a hidden +message in the summary buffer." + (and vm-summary-buffer + (with-current-buffer vm-summary-buffer + (and vm-skip-collapsed-sub-threads + vm-summary-enable-thread-folding + vm-summary-show-threads + (> (vm-thread-indentation (car mp)) 0) + (vm-collapsed-root-p (vm-thread-root (car mp))) + (get-text-property (vm-su-start-of (car mp)) 'invisible))))) + +;;;###autoload +(defun vm-next-message (&optional count retry signal-errors) + "Go forward one message and preview it. +With prefix arg (optional first argument) COUNT, go forward COUNT +messages. A negative COUNT means go backward. If the absolute +value of COUNT is greater than 1, then the values of the variables +vm-skip-deleted-messages and vm-skip-read-messages are ignored. + +When invoked on marked messages (via `vm-next-command-uses-marks') +this command 'sees' marked messages as it moves." + ;; second arg RETRY non-nil means retry a failed move, giving + ;; not nil-or-t values of the vm-skip variables a chance to + ;; work. + ;; + ;; third arg SIGNAL-ERRORS non-nil means that if after + ;; everything we still have bashed into the end or beginning of + ;; folder before completing the move, signal + ;; beginning-of-folder or end-of-folder. Otherwise no error + ;; will be signaled. + ;; + ;; Note that interactively all args are 1, so error signaling + ;; and retries apply to all interactive moves. + (interactive "p\np\np") + ;;(vm-inform 8 "running vm next message") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate (if signal-errors 1 0) (vm-interactive-p)) + ;; include other commands that call vm-next-message so that the + ;; correct window configuration is applied for these particular + ;; non-interactive calls. + (vm-display nil nil '(vm-next-message + vm-delete-message + vm-undelete-message + vm-scroll-forward) + (list this-command)) + (or count (setq count 1)) + (let ((oldmp vm-message-pointer) + (use-marks (eq last-command 'vm-next-command-uses-marks)) + (error) + (direction (if (> count 0) 'forward 'backward)) + (count (vm-abs count))) + (cond + ((null vm-message-pointer) + (setq vm-message-pointer vm-message-list)) + ((/= count 1) + (condition-case () + (let ((oldmp oldmp)) + (while (not (zerop count)) + (vm-move-message-pointer direction) + (if (and use-marks (null (vm-mark-of (car vm-message-pointer)))) + (progn + (while (and (not (eq vm-message-pointer oldmp)) + (null (vm-mark-of (car vm-message-pointer)))) + (vm-move-message-pointer direction)) + (if (eq vm-message-pointer oldmp) + ;; terminate the loop + (setq count 1) + ;; reset for next pass + (setq oldmp vm-message-pointer)))) + (if (not (vm-should-skip-hidden-message vm-message-pointer)) + (vm-decrement count)))) + (beginning-of-folder (setq error 'beginning-of-folder)) + (end-of-folder (setq error 'end-of-folder)))) + (t + (condition-case () + (progn + (vm-move-message-pointer direction) + (while (and (not (eq oldmp vm-message-pointer)) + (vm-should-skip-message vm-message-pointer t)) + (vm-move-message-pointer direction)) + ;; Retry the move if we've gone a complete circle and + ;; retries are allowed and there are other messages + ;; besides this one. + (and (eq vm-message-pointer oldmp) retry (cdr vm-message-list) + (progn + (vm-move-message-pointer direction) + (while (and (not (eq oldmp vm-message-pointer)) + (vm-should-skip-message vm-message-pointer)) + (vm-move-message-pointer direction))))) + (beginning-of-folder + ;; we bumped into the beginning of the folder without finding + ;; a suitable stopping point; retry the move if we're allowed. + (setq vm-message-pointer oldmp) + ;; if the retry fails, we make sure the message pointer + ;; is restored to its old value. + (if retry + (setq vm-message-pointer + (condition-case () + (let ((vm-message-pointer vm-message-pointer)) + (vm-move-message-pointer direction) + (while (vm-should-skip-message vm-message-pointer) + (vm-move-message-pointer direction)) + vm-message-pointer ) + (beginning-of-folder + (setq error 'beginning-of-folder) + oldmp ))) + (setq error 'beginning-of-folder))) + (end-of-folder + ;; we bumped into the end of the folder without finding + ;; a suitable stopping point; retry the move if we're allowed. + (when (and (vm-summary-operation-p) + (get-text-property + (vm-su-start-of (car vm-message-pointer)) + 'invisible vm-summary-buffer)) + (setq error 'end-of-folder) + (setq retry nil)) + + (setq vm-message-pointer oldmp) + ;; if the retry fails, we make sure the message pointer + ;; is restored to its old value. + (if retry + (setq vm-message-pointer + (condition-case () + (let ((vm-message-pointer vm-message-pointer)) + (vm-move-message-pointer direction) + (while (vm-should-skip-message vm-message-pointer) + (vm-move-message-pointer direction)) + vm-message-pointer ) + (end-of-folder + (setq error 'end-of-folder) + oldmp ))) + (setq error 'end-of-folder)))))) + (unless (eq vm-message-pointer oldmp) + (vm-record-and-change-message-pointer oldmp vm-message-pointer) + (vm-present-current-message)) + (when (and error signal-errors) + (signal error nil)))) + +;;;###autoload +(defun vm-previous-message (&optional count retry signal-errors) + "Go back one message and preview it. +With prefix arg COUNT, go backward COUNT messages. A negative COUNT +means go forward. If the absolute value of COUNT > 1 the values of the +variables vm-skip-deleted-messages and vm-skip-read-messages are +ignored." + (interactive "p\np\np") + (or count (setq count 1)) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 t) + (vm-display nil nil '(vm-previous-message) '(vm-previous-message)) + (vm-next-message (- count) retry signal-errors)) + +;;;###autoload +(defun vm-next-message-no-skip (&optional count) + "Like vm-next-message but will not skip deleted or read messages." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-next-message-no-skip) + '(vm-next-message-no-skip)) + (when (and vm-summary-enable-thread-folding + vm-summary-show-threads + vm-summary-thread-folding-on-motion) + (with-current-buffer vm-summary-buffer + (let ((msg (vm-summary-message-at-point)) + (root (vm-thread-root (vm-summary-message-at-point)))) + ;; if last message collapse (and do not move) + (if (= (string-to-number (vm-number-of msg)) + (+ (string-to-number (vm-number-of root)) + (- (vm-thread-count root) 1))) + (vm-collapse-thread t))))) + (let ((vm-skip-deleted-messages nil) + (vm-skip-read-messages nil) + (vm-skip-collapsed-sub-threads + (not vm-summary-thread-folding-on-motion))) + (vm-next-message count nil t))) + +;; backward compatibility +(fset 'vm-Next-message 'vm-next-message-no-skip) + +;;;###autoload +(defun vm-previous-message-no-skip (&optional count) + "Like vm-previous-message but will not skip deleted or read messages." + (interactive "p") + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-previous-message-no-skip) + '(vm-previous-message-no-skip)) + (when (and vm-summary-enable-thread-folding + vm-summary-show-threads + vm-summary-thread-folding-on-motion) + (with-current-buffer vm-summary-buffer + (let ((msg (vm-summary-message-at-point)) + (root (vm-thread-root (vm-summary-message-at-point)))) + ;; if root message collapse (moving up) + (if (eq msg root) + (vm-collapse-thread t))))) + (let ((vm-skip-deleted-messages nil) + (vm-skip-read-messages nil) + (vm-skip-collapsed-sub-threads + (not vm-summary-thread-folding-on-motion))) + (vm-previous-message count))) + +;; backward compatibility +(fset 'vm-Previous-message 'vm-previous-message-no-skip) + +;;;###autoload +(defun vm-next-unread-message () + "Move forward to the nearest new or unread message, if there is one." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-next-unread-message) '(vm-next-unread-message)) + (condition-case () + (let ((vm-skip-read-messages t) + (oldmp vm-message-pointer)) + (vm-next-message 1 nil t) + ;; in case vm-circular-folders is non-nil + (and (eq vm-message-pointer oldmp) (signal 'end-of-folder nil))) + (end-of-folder (vm-inform 5 "No next unread message")))) + +;;;###autoload +(defun vm-previous-unread-message () + "Move backward to the nearest new or unread message, if there is one." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-previous-unread-message) + '(vm-previous-unread-message)) + (condition-case () + (let ((vm-skip-read-messages t) + (oldmp vm-message-pointer)) + (vm-previous-message) + ;; in case vm-circular-folders is non-nil + (and (eq vm-message-pointer oldmp) (signal 'beginning-of-folder nil))) + (beginning-of-folder (vm-inform 5 "No previous unread message")))) + +;;;###autoload +(defun vm-next-message-same-subject () + "Move forward to the nearest message with the same subject. +vm-subject-ignored-prefix and vm-subject-ignored-suffix will apply +to the subject comparisons." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-next-message-same-subject) + '(vm-next-message-same-subject)) + (let ((oldmp vm-message-pointer) + (done nil) + (subject (vm-so-sortable-subject (car vm-message-pointer)))) + (condition-case () + (progn + (while (not done) + (vm-move-message-pointer 'forward) + (if (eq oldmp vm-message-pointer) + (signal 'end-of-folder nil)) + (if (equal subject + (vm-so-sortable-subject (car vm-message-pointer))) + (setq done t))) + (vm-record-and-change-message-pointer oldmp vm-message-pointer) + (vm-present-current-message)) + (end-of-folder + (setq vm-message-pointer oldmp) + (vm-inform 5 "No next message with the same subject"))))) + +;;;###autoload +(defun vm-previous-message-same-subject () + "Move backward to the nearest message with the same subject. +vm-subject-ignored-prefix and vm-subject-ignored-suffix will apply +to the subject comparisons." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-display nil nil '(vm-previous-message-same-subject) + '(vm-previous-message-same-subject)) + (let ((oldmp vm-message-pointer) + (done nil) + (subject (vm-so-sortable-subject (car vm-message-pointer)))) + (condition-case () + (progn + (while (not done) + (vm-move-message-pointer 'backward) + (if (eq oldmp vm-message-pointer) + (signal 'beginning-of-folder nil)) + (if (equal subject + (vm-so-sortable-subject (car vm-message-pointer))) + (setq done t))) + (vm-record-and-change-message-pointer oldmp vm-message-pointer) + (vm-present-current-message)) + (beginning-of-folder + (setq vm-message-pointer oldmp) + (vm-inform 5 "No previous message with the same subject"))))) + +(defun vm-find-first-unread-message (new) + (let (mp unread-mp) + (setq mp vm-message-list) + (if new + (while mp + (if (and (vm-new-flag (car mp)) (not (vm-deleted-flag (car mp)))) + (setq unread-mp mp mp nil) + (setq mp (cdr mp)))) + (while mp + (if (and (or (vm-new-flag (car mp)) (vm-unread-flag (car mp))) + (not (vm-deleted-flag (car mp)))) + (setq unread-mp mp mp nil) + (setq mp (cdr mp))))) + unread-mp )) + +(defun vm-thoughtfully-select-message () + "Select a message in the current folder for the cursor position, +which should be the first new message, if there is any, the first +unread message, if there is any, or the position the cursor was at +the last time the folder was visited. USR, 2010-03-08" + (let ((new (and vm-jump-to-new-messages (vm-find-first-unread-message t))) + (unread (and vm-jump-to-unread-messages + (vm-find-first-unread-message nil))) + fix mp) + (if (null vm-message-pointer) + (setq fix (vm-last vm-message-list))) + (setq mp (or new unread fix)) + (if (and mp (not (eq mp vm-message-pointer))) + (progn + (vm-record-and-change-message-pointer vm-message-pointer mp) + mp ) + nil ))) + +;;;###autoload +(defun vm-follow-summary-cursor () + "Select the message under the cursor in the summary window before +executing commands that operate on the current message. This occurs +only when the summary buffer window is the selected window. + +If a new message is selected then return t, otherwise nil. USR, 2010-03-08" + (and vm-follow-summary-cursor (eq major-mode 'vm-summary-mode) + (let ((point (point)) + message-pointer message-list mp) + (save-excursion + (set-buffer vm-mail-buffer) + (setq message-pointer vm-message-pointer + message-list vm-message-list)) + (cond ((or (null message-pointer) + (and (>= point (vm-su-start-of (car message-pointer))) + (< point (vm-su-end-of (car message-pointer))))) + nil ) + ;; the position at eob belongs to the last message + ((and (eobp) (= (vm-su-end-of (car message-pointer)) point)) + nil ) + ((eobp) + (save-excursion + (while (get-text-property (- (point) 3) 'invisible) + (goto-char + (- (vm-su-start-of (get-text-property + (- (point) 3) 'vm-message)) + 3))) + (vm-goto-message + (string-to-number + (vm-number-of + (get-text-property (- (point) 3) 'vm-message))))) + t) + ;; make the position at eob belong to the last message + ;; ((eobp) + ;; (while (get-text-property (point) 'invisible) + ;; (goto-char (1- (point))) + ;; setq mp + ;; ;;(setq mp (vm-last message-pointer)) + ;; (save-excursion + ;; (set-buffer vm-mail-buffer) + ;; (vm-record-and-change-message-pointer + ;; vm-message-pointer mp) + ;; (vm-present-current-message) + ;; ;; return non-nil so the caller will know that + ;; ;; a new message was selected. + ;; t )) + (t + (if (< point (vm-su-start-of (car message-pointer))) + (setq mp message-list) + (setq mp (cdr message-pointer) message-pointer nil)) + (while (or (and (not (eq mp message-pointer)) + (>= point (vm-su-end-of (car mp)))) + (get-text-property + (+ (vm-su-start-of (car mp)) 3) 'invisible)) + (setq mp (cdr mp))) + (if (not (eq mp message-pointer)) + (save-excursion + (set-buffer vm-mail-buffer) + (vm-record-and-change-message-pointer + vm-message-pointer mp) + ;; preview disabled to avoid message + ;; loading. USR, 2010-09-30 + ;; (vm-present-current-message) + ;; return non-nil so the caller will know that + ;; a new message was selected. + t ))))))) + +;;; vm-motion.el ends here diff --git a/lisp/vm-mouse.el b/lisp/vm-mouse.el new file mode 100755 index 0000000..ed75241 --- /dev/null +++ b/lisp/vm-mouse.el @@ -0,0 +1,691 @@ +;;; vm-mouse.el --- Mouse related functions and commands +;; +;; This file is part of VM +;; +;; Copyright (C) 1995-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-mouse) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-thread) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-menu) + ) + +(declare-function vm-mail-to-mailto-url "vm-reply" (url)) +(declare-function event-window "vm-xemacs" (event)) +(declare-function event-point "vm-xemacs" (event)) + +(defun vm-mouse-set-mouse-track-highlight (start end &optional overlay) + "Create and return an overlay for mouse selection from START to +END. If the optional argument OVERLAY is provided then that that +overlay is moved to cover START to END. No new overlay is created in +that case. USR, 2010-08-01" + (if (null overlay) + (cond (vm-fsfemacs-p + (let ((o (make-overlay start end))) + (overlay-put o 'mouse-face 'highlight) + o )) + (vm-xemacs-p + (let ((o (vm-make-extent start end))) + (vm-set-extent-property o 'start-open t) + (vm-set-extent-property o 'priority 10) + (vm-set-extent-property o 'highlight t) + o ))) + (cond (vm-fsfemacs-p + (move-overlay overlay start end)) + (vm-xemacs-p + (vm-set-extent-endpoints overlay start end))))) + +;;;###autoload +(defun vm-mouse-button-2 (event) + "The immediate action event in VM buffers, depending on where the +mouse is clicked. See Info node `(VM) Using the Mouse'." + (interactive "e") + ;; go to where the event occurred + (cond ((vm-mouse-xemacs-mouse-p) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event)))) + ((vm-mouse-fsfemacs-mouse-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))))) + ;; now dispatch depending on where we are + (cond ((eq major-mode 'vm-summary-mode) + (mouse-set-point event) + (beginning-of-line) + (if (let ((vm-follow-summary-cursor t)) + (vm-follow-summary-cursor)) + nil + (setq this-command 'vm-scroll-forward) + (call-interactively 'vm-scroll-forward))) + ((eq major-mode 'vm-folders-summary-mode) + (mouse-set-point event) + (beginning-of-line) + (vm-follow-folders-summary-cursor)) + ((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode)) + (vm-mouse-popup-or-select event)))) + +;;;###autoload +(defun vm-mouse-button-3 (event) + "Brings up the context-sensitive menu in VM buffers, depending +on where the mouse is clicked. See Info node `(VM) Using the +Mouse'." + (interactive "e") + (if vm-use-menus + (progn + ;; go to where the event occurred + (cond ((vm-mouse-xemacs-mouse-p) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event)))) + ((vm-mouse-fsfemacs-mouse-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))))) + ;; now dispatch depending on where we are + (cond ((eq major-mode 'vm-summary-mode) + (vm-menu-popup-mode-menu event)) + ((eq major-mode 'vm-mode) + (vm-menu-popup-context-menu event)) + ((eq major-mode 'vm-presentation-mode) + (vm-menu-popup-context-menu event)) + ((eq major-mode 'vm-virtual-mode) + (vm-menu-popup-context-menu event)) + ((eq major-mode 'mail-mode) + (vm-menu-popup-context-menu event)))))) + +(defun vm-mouse-3-help (object) + nil + "Use mouse button 3 to see a menu of options.") + +(defun vm-mouse-get-mouse-track-string (event) + (save-excursion + ;; go to where the event occurred + (cond ((vm-mouse-xemacs-mouse-p) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event)))) + ((vm-mouse-fsfemacs-mouse-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))))) + (cond (vm-fsfemacs-p + (let ((o-list (overlays-at (point))) + (string nil)) + (while o-list + (if (overlay-get (car o-list) 'mouse-face) + (setq string (vm-buffer-substring-no-properties + (overlay-start (car o-list)) + (overlay-end (car o-list))) + o-list nil) + (setq o-list (cdr o-list)))) + string )) + (vm-xemacs-p + (let ((e (vm-extent-at (point) 'highlight))) + (if e + (buffer-substring (vm-extent-start-position e) + (vm-extent-end-position e)) + nil))) + (t nil)))) + +;;;###autoload +(defun vm-mouse-popup-or-select (event) + (interactive "e") + (cond ((vm-mouse-fsfemacs-mouse-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (let (o-list (found nil)) + (setq o-list (overlays-at (point))) + (while (and o-list (not found)) + (cond ((overlay-get (car o-list) 'vm-url) + (setq found t) + (vm-mouse-send-url-at-event event)) + ((overlay-get (car o-list) 'vm-mime-function) + (setq found t) + (funcall (overlay-get (car o-list) 'vm-mime-function) + (car o-list)))) + (setq o-list (cdr o-list))) + (and (not found) (vm-menu-popup-context-menu event)))) + ;; The XEmacs code is not actually used now, since all + ;; selectable objects are handled by an extent keymap + ;; binding that points to a more specific function. But + ;; this might come in handy later if I want selectable + ;; objects that don't have an extent keymap attached. + ((vm-mouse-xemacs-mouse-p) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event))) + (let (e) + (cond ((vm-extent-at (point) 'vm-url) + (vm-mouse-send-url-at-event event)) + ((setq e (vm-extent-at (point) 'vm-mime-function)) + (funcall (vm-extent-property e 'vm-mime-function) e)) + (t (vm-menu-popup-context-menu event))))))) + +;;;###autoload +(defun vm-mouse-send-url-at-event (event) + (interactive "e") + (cond ((vm-mouse-xemacs-mouse-p) + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event))) + (vm-mouse-send-url-at-position (event-point event))) + ((vm-mouse-fsfemacs-mouse-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (vm-mouse-send-url-at-position (posn-point (event-start event)))))) + +(defun vm-mouse-send-url-at-position (pos &optional browser) + (save-restriction + (widen) + (cond ((vm-mouse-xemacs-mouse-p) + (let ((e (vm-extent-at pos 'vm-url)) + url) + (if (null e) + nil + (setq url (buffer-substring (vm-extent-start-position e) + (vm-extent-end-position e))) + (vm-mouse-send-url url browser)))) + ((vm-mouse-fsfemacs-mouse-p) + (let (o-list url o) + (setq o-list (overlays-at pos)) + (while (and o-list (null (overlay-get (car o-list) 'vm-url))) + (setq o-list (cdr o-list))) + (if (null o-list) + nil + (setq o (car o-list)) + (setq url (vm-buffer-substring-no-properties + (overlay-start o) + (overlay-end o))) + (vm-mouse-send-url url browser))))))) + +(defun vm-mouse-send-url (url &optional browser switches) + (if (string-match "^[A-Za-z0-9._-]+@[A-Za-z0-9._-]+$" url) + (setq url (concat "mailto:" url))) + (if (string-match "^mailto:" url) + (vm-mail-to-mailto-url url) + (let ((browser (or browser vm-url-browser)) + (switches (or switches vm-url-browser-switches))) + (cond ((symbolp browser) + (funcall browser url)) + ((stringp browser) + (vm-inform 5 "Sending URL to %s..." browser) + (apply 'vm-run-background-command browser + (append switches (list url))) + (vm-inform 5 "Sending URL to %s... done" browser)))))) + +(defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) + ;; Change commas to %2C to avoid confusing Netscape -remote. + (while (string-match "," url) + (setq url (replace-match "%2C" nil t url))) + (vm-inform 5 "Sending URL to Netscape...") + (if new-netscape + (apply 'vm-run-background-command vm-netscape-program + (append vm-netscape-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-netscape-program + (append vm-netscape-program-switches + (list "-remote" + (concat "openURL(" url + (if new-window ",new-window" "") + ")"))))) + (vm-mouse-send-url-to-netscape url t new-window))) + (vm-inform 5 "Sending URL to Netscape... done")) + +(defun vm-mouse-send-url-to-opera (url &optional new-opera new-window) + ;; Change commas to %2C to avoid confusing Netscape -remote. + (while (string-match "," url) + (setq url (replace-match "%2C" nil t url))) + (vm-inform 5 "Sending URL to Opera...") + (if new-opera + (apply 'vm-run-background-command vm-opera-program + (append vm-opera-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-opera-program + (append vm-opera-program-switches + (list "-remote" + (concat "openURL(" url + ")"))))) + (vm-mouse-send-url-to-opera url t new-window))) + (vm-inform 5 "Sending URL to Opera... done")) + + +(defun vm-mouse-send-url-to-mozilla (url &optional new-mozilla new-window) + ;; Change commas to %2C to avoid confusing Netscape -remote. + (while (string-match "," url) + (setq url (replace-match "%2C" nil t url))) + (vm-inform 5 "Sending URL to Mozilla...") + (if new-mozilla + (apply 'vm-run-background-command vm-mozilla-program + (append vm-mozilla-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-mozilla-program + (append vm-mozilla-program-switches + (list "-remote" + (concat "openURL(" url + (if new-window ",new-window" "") + ")"))))) + (vm-mouse-send-url-to-mozilla url t new-window))) + (vm-inform 5 "Sending URL to Mozilla... done")) + +(defun vm-mouse-send-url-to-netscape-new-window (url) + (vm-mouse-send-url-to-netscape url nil t)) + +(defun vm-mouse-send-url-to-opera-new-window (url) + (vm-mouse-send-url-to-opera url nil t)) + +(defun vm-mouse-send-url-to-mozilla-new-window (url) + (vm-mouse-send-url-to-mozilla url nil t)) + +(defvar buffer-file-type) + +(defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window) + (vm-mouse-send-url-to-xxxx-mosaic 'mosaic url new-mosaic new-window)) + +(defun vm-mouse-send-url-to-mmosaic (url &optional new-mosaic new-window) + (vm-mouse-send-url-to-xxxx-mosaic 'mmosaic url new-mosaic new-window)) + +(defun vm-mouse-send-url-to-xxxx-mosaic (m-type url &optional + new-mosaic new-window) + (let ((what (cond ((eq m-type 'mmosaic) "mMosaic") + (t "Mosaic")))) + (vm-inform 5 "Sending URL to %s..." what) + (if (null new-mosaic) + (let ((pid-file (cond ((eq m-type 'mmosaic) + "~/.mMosaic/.mosaicpid") + (t "~/.mosaicpid"))) + (work-buffer " *mosaic work*") + (coding-system-for-read (vm-line-ending-coding-system)) + (coding-system-for-write (vm-line-ending-coding-system)) + pid) + (cond ((file-exists-p pid-file) + (set-buffer (get-buffer-create work-buffer)) + (setq selective-display nil) + (erase-buffer) + (insert-file-contents pid-file) + (setq pid (int-to-string (string-to-number (buffer-string)))) + (erase-buffer) + (insert (if new-window "newwin" "goto") ?\n) + (insert url ?\n) + ;; newline convention used should be the local + ;; one, whatever that is. + (setq buffer-file-type nil) + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system + (vm-line-ending-coding-system) nil)) + (write-region (point-min) (point-max) + (concat "/tmp/Mosaic." pid) + nil 0) + (set-buffer-modified-p nil) + (kill-buffer work-buffer))) + (cond ((or (null pid) + (not (equal 0 (vm-run-command "kill" "-USR1" pid)))) + (setq new-mosaic t))))) + (if new-mosaic + (apply 'vm-run-background-command + (cond ((eq m-type 'mmosaic) vm-mmosaic-program) + (t vm-mosaic-program)) + (append (cond ((eq m-type 'mmosaic) vm-mmosaic-program-switches) + (t vm-mosaic-program-switches)) + (list url)))) + (vm-inform 5 "Sending URL to %s... done" what))) + +(defun vm-mouse-send-url-to-mosaic-new-window (url) + (vm-mouse-send-url-to-mosaic url nil t)) + +(defun vm-mouse-send-url-to-konqueror (url &optional new-konqueror) + (vm-inform 5 "Sending URL to Konqueror...") + (if new-konqueror + (apply 'vm-run-background-command vm-konqueror-program + (append vm-konqueror-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-konqueror-client-program + (append vm-konqueror-client-program-switches + (list "openURL" url)))) + (vm-mouse-send-url-to-konqueror url t))) + (vm-inform 5 "Sending URL to Konqueror... done")) + +(defun vm-mouse-send-url-to-firefox (url &optional new-window) + (vm-inform 5 "Sending URL to Mozilla Firefox...") + (if new-window + (apply 'vm-run-background-command vm-firefox-program + (append vm-firefox-program-switches (list url))) + (or (equal 0 (apply 'vm-run-command vm-firefox-client-program + (append vm-firefox-client-program-switches + (list (format "openURL(%s)" url))))) + (vm-mouse-send-url-to-firefox url t))) + (vm-inform 5 "Sending URL to Mozilla Firefox... done")) + +(defun vm-mouse-send-url-to-konqueror-new-window (url) + (vm-mouse-send-url-to-konqueror url t)) + +(defvar vm-warn-for-interprogram-cut-function t) + +(defun vm-mouse-send-url-to-window-system (url) + (unless interprogram-cut-function + (when vm-warn-for-interprogram-cut-function + (vm-warn 1 2 + (concat "Copying to kill ring only; " + "Customize interprogram-cut-function to copy to Window system")) + (setq vm-warn-for-interprogram-cut-function nil))) + (kill-new url)) + +(defun vm-mouse-send-url-to-clipboard (url &optional type) + (unless type (setq type 'CLIPBOARD)) + (vm-inform 5 "Sending URL to %s..." type) + (cond ((fboundp 'own-selection) ; XEmacs + (own-selection url type)) + ((fboundp 'x-set-selection) ; Gnu Emacs + (x-set-selection type url)) + ((fboundp 'x-own-selection) ; lselect for Emacs21? + (x-own-selection url type))) + (vm-inform 5 "Sending URL to %s... done" type)) + +;;;###autoload +(defun vm-mouse-install-mouse () + (cond ((vm-mouse-xemacs-mouse-p) + (if (null (lookup-key vm-mode-map 'button2)) + (define-key vm-mode-map 'button2 'vm-mouse-button-2))) + ((vm-mouse-fsfemacs-mouse-p) + (if (null (lookup-key vm-mode-map [mouse-2])) + (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2)) + (if vm-popup-menu-on-mouse-3 + (progn + (define-key vm-mode-map [mouse-3] 'ignore) + (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3)))))) + +(defun vm-run-background-command (command &rest arg-list) + (vm-inform 5 "vm-run-background-command: %S %S" command arg-list) + (apply (function call-process) command + nil + 0 + nil arg-list)) + +(defun vm-run-command (command &rest arg-list) + (vm-inform 5 "vm-run-command: %S %S" command arg-list) + (apply (function call-process) command + nil + (get-buffer-create (concat " *" command "*")) + nil arg-list)) + +;; return t on zero exit status +;; return (exit-status . stderr-string) on nonzero exit status +(defun vm-run-command-on-region (start end output-buffer command + &rest arg-list) + (let ((tempfile nil) + ;; use binary coding system in FSF Emacs/MULE + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (buffer-file-format nil) + ;; for DOS/Windows command to tell it that its input is + ;; binary. + (binary-process-input t) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (selective-display nil) + status errstring) + (unwind-protect + (progn + (setq tempfile (vm-make-tempfile-name)) + (setq status + (apply 'call-process-region + start end command nil + (list output-buffer tempfile) + nil arg-list)) + (cond ((equal status 0) t) + ;; even if exit status non-zero, if there was no + ;; diagnostic output the command probably + ;; succeeded. I have tried to just use exit status + ;; as the failure criterion and users complained. + ((equal (nth 7 (file-attributes tempfile)) 0) + (vm-warn 0 0 "%s exited non-zero (code %s)" command status) + t) + (t (save-excursion + (vm-warn 0 0 "%s exited non-zero (code %s)" command status) + (set-buffer (find-file-noselect tempfile)) + (setq errstring (buffer-string)) + (kill-buffer nil) + (cons status errstring))))) + (vm-error-free-call 'delete-file tempfile)))) + +;; stupid yammering compiler +(defvar vm-mouse-read-file-name-prompt) +(defvar vm-mouse-read-file-name-dir) +(defvar vm-mouse-read-file-name-default) +(defvar vm-mouse-read-file-name-must-match) +(defvar vm-mouse-read-file-name-initial) +(defvar vm-mouse-read-file-name-history) +(defvar vm-mouse-read-file-name-return-value) +(defvar vm-mouse-read-file-name-should-delete-frame) + +(defun vm-mouse-read-file-name (prompt &optional dir default + must-match initial history) + "Like read-file-name, except uses a mouse driven interface. +HISTORY argument is ignored." + (save-excursion + (or dir (setq dir default-directory)) + (set-buffer (vm-make-work-buffer " *Files*")) + (use-local-map (make-sparse-keymap)) + (setq buffer-read-only t + default-directory dir) + (make-local-variable 'vm-mouse-read-file-name-prompt) + (make-local-variable 'vm-mouse-read-file-name-dir) + (make-local-variable 'vm-mouse-read-file-name-default) + (make-local-variable 'vm-mouse-read-file-name-must-match) + (make-local-variable 'vm-mouse-read-file-name-initial) + (make-local-variable 'vm-mouse-read-file-name-history) + (make-local-variable 'vm-mouse-read-file-name-return-value) + (make-local-variable 'vm-mouse-read-file-name-should-delete-frame) + (setq vm-mouse-read-file-name-prompt prompt) + (setq vm-mouse-read-file-name-dir dir) + (setq vm-mouse-read-file-name-default default) + (setq vm-mouse-read-file-name-must-match must-match) + (setq vm-mouse-read-file-name-initial initial) + (setq vm-mouse-read-file-name-history history) + (setq vm-mouse-read-file-name-prompt prompt) + (setq vm-mouse-read-file-name-return-value nil) + (setq vm-mouse-read-file-name-should-delete-frame nil) + (if (and vm-mutable-frame-configuration vm-frame-per-completion + (vm-multiple-frames-possible-p)) + (save-excursion + (setq vm-mouse-read-file-name-should-delete-frame t) + (vm-goto-new-frame 'completion))) + (switch-to-buffer (current-buffer)) + (vm-mouse-read-file-name-event-handler) + (save-excursion + (local-set-key "\C-g" 'vm-mouse-read-file-name-quit-handler) + (recursive-edit)) + ;; buffer could have been killed + (and (boundp 'vm-mouse-read-file-name-return-value) + (prog1 + vm-mouse-read-file-name-return-value + (kill-buffer (current-buffer)))))) + +(defun vm-mouse-read-file-name-event-handler (&optional string) + (let ((key-doc "Click here for keyboard interface.") + start list) + (if string + (cond ((equal string key-doc) + (condition-case nil + (save-excursion + (setq vm-mouse-read-file-name-return-value + (save-excursion + (vm-keyboard-read-file-name + vm-mouse-read-file-name-prompt + vm-mouse-read-file-name-dir + vm-mouse-read-file-name-default + vm-mouse-read-file-name-must-match + vm-mouse-read-file-name-initial + vm-mouse-read-file-name-history))) + (vm-mouse-read-file-name-quit-handler t)) + (quit (vm-mouse-read-file-name-quit-handler)))) + ((file-directory-p string) + (setq default-directory (expand-file-name string))) + (t (setq vm-mouse-read-file-name-return-value + (expand-file-name string)) + (vm-mouse-read-file-name-quit-handler t)))) + (setq buffer-read-only nil) + (erase-buffer) + (setq start (point)) + (insert vm-mouse-read-file-name-prompt) + (vm-set-region-face start (point) 'bold) + (cond ((and (not string) vm-mouse-read-file-name-default) + (setq start (point)) + (insert vm-mouse-read-file-name-default) + (vm-mouse-set-mouse-track-highlight start (point)) + ) + ((not string) nil) + (t (insert default-directory))) + (insert ?\n ?\n) + (setq start (point)) + (insert key-doc) + (vm-mouse-set-mouse-track-highlight start (point)) + (vm-set-region-face start (point) 'italic) + (insert ?\n ?\n) + (setq list (vm-delete-backup-file-names + (vm-delete-auto-save-file-names + (vm-delete-index-file-names + (directory-files default-directory))))) + + ;; delete dot files + (setq list (vm-delete (lambda (file) + (string-match "^\\.\\([^.].*\\)?$" file)) + list)) + ;; append a "/" to directories + (setq list (mapcar (lambda (file) + (if (file-directory-p file) + (concat file "/") + file)) + list)) + + (vm-show-list list 'vm-mouse-read-file-name-event-handler) + (setq buffer-read-only t))) + +;;;###autoload +(defun vm-mouse-read-file-name-quit-handler (&optional normal-exit) + (interactive) + (if vm-mouse-read-file-name-should-delete-frame + (vm-maybe-delete-windows-or-frames-on (current-buffer))) + (if normal-exit + (throw 'exit nil) + (throw 'exit t))) + +(defvar vm-mouse-read-string-prompt) +(defvar vm-mouse-read-string-completion-list) +(defvar vm-mouse-read-string-multi-word) +(defvar vm-mouse-read-string-return-value) +(defvar vm-mouse-read-string-should-delete-frame) + +(defun vm-mouse-read-string (prompt completion-list &optional multi-word) + (save-excursion + (set-buffer (vm-make-work-buffer " *Choices*")) + (use-local-map (make-sparse-keymap)) + (setq buffer-read-only t) + (make-local-variable 'vm-mouse-read-string-prompt) + (make-local-variable 'vm-mouse-read-string-completion-list) + (make-local-variable 'vm-mouse-read-string-multi-word) + (make-local-variable 'vm-mouse-read-string-return-value) + (make-local-variable 'vm-mouse-read-string-should-delete-frame) + (setq vm-mouse-read-string-prompt prompt) + (setq vm-mouse-read-string-completion-list completion-list) + (setq vm-mouse-read-string-multi-word multi-word) + (setq vm-mouse-read-string-return-value nil) + (setq vm-mouse-read-string-should-delete-frame nil) + (if (and vm-mutable-frame-configuration vm-frame-per-completion + (vm-multiple-frames-possible-p)) + (save-excursion + (setq vm-mouse-read-string-should-delete-frame t) + (vm-goto-new-frame 'completion))) + (switch-to-buffer (current-buffer)) + (vm-mouse-read-string-event-handler) + (save-excursion + (local-set-key "\C-g" 'vm-mouse-read-string-quit-handler) + (recursive-edit)) + ;; buffer could have been killed + (and (boundp 'vm-mouse-read-string-return-value) + (prog1 + (if (listp vm-mouse-read-string-return-value) + (mapconcat 'identity vm-mouse-read-string-return-value " ") + vm-mouse-read-string-return-value) + (kill-buffer (current-buffer)))))) + +(defun vm-mouse-read-string-event-handler (&optional string) + (let ((key-doc "Click here for keyboard interface.") + (bs-doc " .... to go back one word.") + (done-doc " .... when you're done.") + start list) + (if string + (cond ((equal string key-doc) + (condition-case nil + (save-excursion + (setq vm-mouse-read-string-return-value + (vm-keyboard-read-string + vm-mouse-read-string-prompt + vm-mouse-read-string-completion-list + vm-mouse-read-string-multi-word)) + (vm-mouse-read-string-quit-handler t)) + (quit (vm-mouse-read-string-quit-handler)))) + ((equal string bs-doc) + (setq vm-mouse-read-string-return-value + (nreverse + (cdr + (nreverse vm-mouse-read-string-return-value))))) + ((equal string done-doc) + (vm-mouse-read-string-quit-handler t)) + (t (setq vm-mouse-read-string-return-value + (nconc vm-mouse-read-string-return-value + (list string))) + (if (null vm-mouse-read-string-multi-word) + (vm-mouse-read-string-quit-handler t))))) + (setq buffer-read-only nil) + (erase-buffer) + (setq start (point)) + (insert vm-mouse-read-string-prompt) + (vm-set-region-face start (point) 'bold) + (insert (mapconcat 'identity vm-mouse-read-string-return-value " ")) + (insert ?\n ?\n) + (setq start (point)) + (insert key-doc) + (vm-mouse-set-mouse-track-highlight start (point)) + (vm-set-region-face start (point) 'italic) + (insert ?\n) + (if vm-mouse-read-string-multi-word + (progn + (setq start (point)) + (insert bs-doc) + (vm-mouse-set-mouse-track-highlight start (point)) + (vm-set-region-face start (point) 'italic) + (insert ?\n) + (setq start (point)) + (insert done-doc) + (vm-mouse-set-mouse-track-highlight start (point)) + (vm-set-region-face start (point) 'italic) + (insert ?\n))) + (insert ?\n) + (vm-show-list vm-mouse-read-string-completion-list + 'vm-mouse-read-string-event-handler) + (setq buffer-read-only t))) + +;;;###autoload +(defun vm-mouse-read-string-quit-handler (&optional normal-exit) + (interactive) + (if vm-mouse-read-string-should-delete-frame + (vm-maybe-delete-windows-or-frames-on (current-buffer))) + (if normal-exit + (throw 'exit nil) + (throw 'exit t))) + +;;; vm-mouse.el ends here diff --git a/lisp/vm-page.el b/lisp/vm-page.el new file mode 100755 index 0000000..0ad0d1d --- /dev/null +++ b/lisp/vm-page.el @@ -0,0 +1,1199 @@ +;;; vm-page.el --- Commands to move around within a VM message +;; +;; This file is part of VM +; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-page) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-thread) + (require 'vm-window) + (require 'vm-motion) + (require 'vm-menu) + (require 'vm-mouse) + (require 'vm-mime) + (require 'vm-undo) + ) + +(declare-function vm-make-virtual-copy "vm-virtual" (message)) +(declare-function vm-make-presentation-copy "vm-mime" (message)) +(declare-function vm-decode-mime-message "vm-mime" (&optional state)) +(declare-function vm-mime-plain-message-p "vm-mime" (message)) +;; (declare-funciton vm-mm-layout "vm-mime" (message)) + +(declare-function map-extents "vm-xemacs" + (function &optional object from to maparg + flags property value)) +(declare-function find-face "vm-xemacs" (face-or-name)) +(declare-function make-glyph "vm-xemacs" (&optional spec-list type)) +(declare-function set-glyph-face "vm-xemacs" (glyph face)) +(declare-function glyphp "vm-xemacs" (object)) +(declare-function set-extent-begin-glyph "vm-xemacs" + (extent begin-glyph &optional layout)) +(declare-function highlight-headers "vm-xemacs" (start end hack-sig)) + +;;;###autoload +(defun vm-scroll-forward (&optional arg) + "Scrolls forward a screenful of text. +If the current message is being previewed, the message body is revealed. +If at the end of the current message, moves to the next message iff the +value of vm-auto-next-message is non-nil. +Prefix argument N means scroll forward N lines." + (interactive "P") + (let (mp-changed + needs-decoding + (was-invisible nil)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (setq mp-changed + (or (null vm-presentation-buffer) + (not (equal (vm-number-of (car vm-message-pointer)) + (with-current-buffer vm-presentation-buffer + (vm-number-of (car vm-message-pointer))))))) + ;; the following vodoo was added by USR for fixing the jumping + ;; cursor problem in the summary window, reported on May 4, 2008 + ;; in gnu.emacs.vm.info, title "Re: synchronization of vm buffers" + ;; (if mp-changed (sit-for 0)) + (when mp-changed + (vm-present-current-message) + (sit-for 0)) + + (setq needs-decoding (and vm-display-using-mime + (not vm-mime-decoded) + (not (vm-mime-plain-message-p + (car vm-message-pointer))) + vm-auto-decode-mime-messages + (eq vm-system-state 'previewing))) + (when vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + ;; We are either in the Presentation buffer or the Folder buffer + (let ((point (point)) + (w (vm-get-visible-buffer-window (current-buffer)))) + (unless (and w (vm-frame-totally-visible-p (vm-window-frame w))) + (vm-display (current-buffer) t + '(vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + ;; window start sticks to end of clip region when clip + ;; region moves back past it in the buffer. fix it. + (setq w (vm-get-visible-buffer-window (current-buffer))) + (if (= (window-start w) (point-max)) + (set-window-start w (point-min))) + (setq was-invisible t))) + (if (or mp-changed was-invisible needs-decoding + (and (eq vm-system-state 'previewing) + (pos-visible-in-window-p + (point-max) + (vm-get-visible-buffer-window (current-buffer))))) + (progn + (unless was-invisible + (let ((w (vm-get-visible-buffer-window (current-buffer))) + old-w-start) + (setq old-w-start (window-start w)) + ;; save-excursion to avoid possible buffer change + (save-excursion (vm-select-frame (window-frame w))) + (vm-raise-frame (window-frame w)) + (vm-display nil nil '(vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + (setq w (vm-get-visible-buffer-window (current-buffer))) + (and w (set-window-start w old-w-start)))) + (cond ((eq vm-system-state 'previewing) + (vm-show-current-message) + ;; The window start marker sometimes drifts forward + ;; because of something that vm-show-current-message + ;; does. In Emacs 20, replacing ASCII chars with + ;; multibyte chars seems to cause it, but I _think_ + ;; the drift can happen in Emacs 19 and even + ;; XEmacs for different reasons. So we reset the + ;; start marker here, since it is an easy fix. + (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (set-window-start w (point-min))))) + (vm-howl-if-eom)) + (let ((vmp vm-message-pointer) + (msg-buf (current-buffer)) + (h-diff 0) + w old-w old-w-height old-w-start result) + (when (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (setq old-w (vm-get-visible-buffer-window msg-buf) + old-w-height (window-height old-w) + old-w-start (window-start old-w)) + (setq w (vm-get-visible-buffer-window msg-buf)) + (vm-select-frame (window-frame w)) + (vm-raise-frame (window-frame w)) + (vm-display nil nil '(vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + (setq w (vm-get-visible-buffer-window msg-buf)) + (if (null w) + (error "current window configuration hides the message buffer.") + (setq h-diff (- (window-height w) old-w-height))) + ;; must restore this since it gets clobbered by window + ;; teardown and rebuild done by the window config stuff. + (set-window-start w old-w-start) + (setq old-w (selected-window)) + (unwind-protect + (progn + (select-window w) + (let ((next-screen-context-lines + (+ next-screen-context-lines h-diff))) + (while (eq (setq result (vm-scroll-forward-internal arg)) + 'tryagain)) + (cond ((and (not (eq result 'next-message)) + vm-honor-page-delimiters) + (vm-narrow-to-page) + (goto-char (max (window-start w) + (vm-text-of (car vmp)))) + ;; This is needed because in some cases + ;; the scroll-up call in vm-howl-if-emo + ;; does not signal end-of-buffer when + ;; it should unless we do this. This + ;; sit-for most likely removes the need + ;; for the (scroll-up 0) below, but + ;; since the voodoo has worked this + ;; long, it's probably best to let it + ;; be. + (sit-for 0) + ;; This voodoo is required! For some + ;; reason the 18.52 emacs display + ;; doesn't immediately reflect the + ;; clip region change that occurs + ;; above without this mantra. + (scroll-up 0))))) + (select-window old-w)) + (set-buffer msg-buf) + (cond ((eq result 'next-message) + (vm-next-message)) + ((eq result 'end-of-message) + (let ((vm-message-pointer vmp)) + (vm-emit-eom-blurb))) + (t + (and (> (prefix-numeric-value arg) 0) + (vm-howl-if-eom))))))) + (unless vm-startup-message-displayed + (vm-display-startup-message))) + +(defun vm-scroll-forward-internal (arg) + (let ((direction (prefix-numeric-value arg)) + (w (selected-window))) + (condition-case error-data + (progn (scroll-up arg) nil) +;; this looks like it should work, but doesn't because the +;; redisplay code is schizophrenic when it comes to updates. A +;; window position may no longer be visible but +;; pos-visible-in-window-p will still say it is because it was +;; visible before some window size change happened. +;; (progn +;; (if (and (> direction 0) +;; (pos-visible-in-window-p +;; (vm-text-end-of (car vm-message-pointer)))) +;; (signal 'end-of-buffer nil) +;; (scroll-up arg)) +;; nil ) + (error + (if (or (and (< direction 0) + (> (point-min) (vm-text-of (car vm-message-pointer)))) + (and (>= direction 0) + (/= (point-max) + (vm-text-end-of (car vm-message-pointer))))) + (progn + (vm-widen-page) + (if (>= direction 0) + (progn + (forward-page 1) + (set-window-start w (point)) + nil ) + (if (or (bolp) + (not (save-excursion + (beginning-of-line) + (looking-at page-delimiter)))) + (forward-page -1)) + (beginning-of-line) + (set-window-start w (point)) + 'tryagain)) + (if (eq (car error-data) 'end-of-buffer) + (if vm-auto-next-message + 'next-message + (set-window-point w (point)) + 'end-of-message))))))) + +;; exploratory scrolling, what a concept. +;; +;; we do this because pos-visible-in-window-p checks the current +;; window configuration, while this exploratory scrolling forces +;; Emacs to recompute the display, giving us an up to the moment +;; answer about where the end of the message is going to be +;; visible when redisplay finally does occur. +(defun vm-howl-if-eom () + (let ((w (get-buffer-window (current-buffer)))) + (and w + (save-excursion + (save-window-excursion + (condition-case () + (let ((next-screen-context-lines 0)) + (select-window w) + (save-excursion + (save-window-excursion + ;; scroll-fix.el replaces scroll-up and + ;; doesn't behave properly when it hits + ;; end of buffer. It does this! + ;; (ding) + ;; (message (get 'beginning-of-buffer 'error-message)) + (let ((scroll-in-place-replace-original nil)) + (scroll-up nil)))) + nil) + (error t)))) + (= (vm-text-end-of (car vm-message-pointer)) (point-max)) + (vm-emit-eom-blurb)))) + +(defun vm-emit-eom-blurb () + "Prints a minibuffer message when the end of message is reached, but +it is suppressed if the variable `vm-auto-next-message' is nil." + (interactive) + (if vm-auto-next-message + (let ((vm-summary-uninteresting-senders-arrow "") + (case-fold-search nil)) + (vm-inform 6 (if (and (stringp vm-summary-uninteresting-senders) + (string-match vm-summary-uninteresting-senders + (vm-su-from (car vm-message-pointer)))) + "End of message %s to %.50s..." + "End of message %s from %.50s...") + (vm-number-of (car vm-message-pointer)) + (vm-summary-sprintf "%F" (car vm-message-pointer)))))) + +(defun vm-emit-mime-decoding-message (&rest args) + (interactive) + (when vm-emit-messages-for-mime-decoding + (apply 'message args))) + +;;;###autoload +(defun vm-scroll-backward (&optional arg) + "Scroll backward a screenful of text. +Prefix N scrolls backward N lines." + (interactive "P") + (vm-scroll-forward (cond ((null arg) '-) + ((consp arg) (list (- (car arg)))) + ((numberp arg) (- arg)) + ((symbolp arg) nil) + (t arg)))) + +;;;###autoload +(defun vm-scroll-forward-one-line (&optional count) + "Scroll forward one line. +Prefix arg N means scroll forward N lines. +Negative arg means scroll backward." + (interactive "p") + (vm-scroll-forward count)) + +;;;###autoload +(defun vm-scroll-backward-one-line (&optional count) + "Scroll backward one line. +Prefix arg N means scroll backward N lines. +Negative arg means scroll forward." + (interactive "p") + (vm-scroll-forward (- count))) + +(defun vm-highlight-headers () + (cond + ((and vm-xemacs-p vm-use-lucid-highlighting) + (require 'highlight-headers) + ;; disable the url marking stuff, since VM has its own interface. + (let ((highlight-headers-mark-urls nil) + (highlight-headers-regexp (or vm-highlighted-header-regexp + highlight-headers-regexp))) + (highlight-headers (point-min) (point-max) t))) + (vm-xemacs-p + (let (e) + (map-extents (function + (lambda (e ignore) + (when (vm-extent-property e 'vm-highlight) + (vm-delete-extent e)) + nil)) + (current-buffer) (point-min) (point-max)) + (goto-char (point-min)) + (while (vm-match-header) + (cond ((vm-match-header vm-highlighted-header-regexp) + (setq e (vm-make-extent (vm-matched-header-contents-start) + (vm-matched-header-contents-end))) + (vm-set-extent-property e 'face vm-highlighted-header-face) + (vm-set-extent-property e 'vm-highlight t))) + (goto-char (vm-matched-header-end))))) + (vm-fsfemacs-p + (let (o-lists p) + (setq o-lists (overlay-lists) + p (car o-lists)) + (while p + (when (overlay-get (car p) 'vm-highlight) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (setq p (cdr o-lists)) + (while p + (when (overlay-get (car p) 'vm-highlight) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (goto-char (point-min)) + (while (vm-match-header) + (cond ((vm-match-header vm-highlighted-header-regexp) + (setq p (make-overlay (vm-matched-header-contents-start) + (vm-matched-header-contents-end))) + (overlay-put p 'face vm-highlighted-header-face) + (overlay-put p 'vm-highlight t))) + (goto-char (vm-matched-header-end))))))) + +;;;###autoload +(defun vm-energize-urls (&optional clean-only) + (interactive "P") + ;; Don't search too long in large regions. If the region is + ;; large, search just the head and the tail of the region since + ;; they tend to contain the interesting text. + (let ((search-limit vm-url-search-limit) + search-pairs n) + (if (and search-limit (> (- (point-max) (point-min)) search-limit)) + (setq search-pairs (list (cons (point-min) + (+ (point-min) (/ search-limit 2))) + (cons (- (point-max) (/ search-limit 2)) + (point-max)))) + (setq search-pairs (list (cons (point-min) (point-max))))) + (cond + (vm-xemacs-p + (let (e) + (map-extents (function + (lambda (e ignore) + (when (vm-extent-property e 'vm-url) + (vm-delete-extent e)) + nil)) + (current-buffer) (point-min) (point-max)) + (if clean-only (vm-inform 1 "Energy from urls removed!") + (while search-pairs + (goto-char (car (car search-pairs))) + (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) + (setq n 1) + (while (null (match-beginning n)) + (vm-increment n)) + (setq e (vm-make-extent (match-beginning n) (match-end n))) + (vm-set-extent-property e 'vm-url t) + (if vm-highlight-url-face + (vm-set-extent-property e 'face vm-highlight-url-face)) + (if vm-url-browser + (let ((keymap (make-sparse-keymap)) + (popup-function + (if (save-excursion + (goto-char (match-beginning n)) + (looking-at "mailto:")) + 'vm-menu-popup-mailto-url-browser-menu + 'vm-menu-popup-url-browser-menu))) + (define-key keymap 'button2 'vm-mouse-send-url-at-event) + (if vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 popup-function)) + (define-key keymap "\r" + (function (lambda () (interactive) + (vm-mouse-send-url-at-position (point))))) + (vm-set-extent-property e 'vm-button t) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'balloon-help 'vm-url-help) + (vm-set-extent-property e 'highlight t) + ;; for vm-continue-postponed-message + (vm-set-extent-property e 'duplicable t) + ))) + (setq search-pairs (cdr search-pairs)))))) + ((and vm-fsfemacs-p + (fboundp 'overlay-put)) + (let (o-lists o p) + (setq o-lists (overlay-lists) + p (car o-lists)) + (while p + (when (overlay-get (car p) 'vm-url) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (setq p (cdr o-lists)) + (while p + (when (overlay-get (car p) 'vm-url) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (while search-pairs + (goto-char (car (car search-pairs))) + (while (re-search-forward vm-url-regexp (cdr (car search-pairs)) t) + (setq n 1) + (while (null (match-beginning n)) + (vm-increment n)) + (setq o (make-overlay (match-beginning n) (match-end n))) + (overlay-put o 'vm-url t) + (if (facep vm-highlight-url-face) + (overlay-put o 'face vm-highlight-url-face)) + (if vm-url-browser + (let ((keymap (make-sparse-keymap)) + (popup-function + (if (save-excursion + (goto-char (match-beginning n)) + (looking-at "mailto:")) + 'vm-menu-popup-mailto-url-browser-menu + 'vm-menu-popup-url-browser-menu))) + (overlay-put o 'vm-button t) + (overlay-put o 'mouse-face 'highlight) + (setq keymap (nconc keymap (current-local-map))) + (if vm-popup-menu-on-mouse-3 + (define-key keymap [mouse-3] popup-function)) + (define-key keymap "\r" + (function (lambda () (interactive) + (vm-mouse-send-url-at-position (point))))) + (overlay-put o 'local-map keymap)))) + (setq search-pairs (cdr search-pairs)))))))) + +(defun vm-energize-headers () + (cond + (vm-xemacs-p + (let ((search-tuples '(("^From:" vm-menu-author-menu) + ("^Subject:" vm-menu-subject-menu))) + regexp menu keymap e) + (map-extents (function + (lambda (e ignore) + (when (vm-extent-property e 'vm-header) + (vm-delete-extent e)) + nil)) + (current-buffer) (point-min) (point-max)) + (while search-tuples + (goto-char (point-min)) + (setq regexp (nth 0 (car search-tuples)) + menu (symbol-value (nth 1 (car search-tuples)))) + (while (re-search-forward regexp nil t) + (save-excursion (goto-char (match-beginning 0)) (vm-match-header)) + (setq e (vm-make-extent (vm-matched-header-contents-start) + (vm-matched-header-contents-end))) + (vm-set-extent-property e 'vm-header t) + (setq keymap (make-sparse-keymap)) + ;; Might as well make button2 do what button3 does in + ;; this case, since there is no default 'select' + ;; action. + (define-key keymap 'button2 + (list 'lambda () '(interactive) + (list 'popup-menu (list 'quote menu)))) + (if vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 + (list 'lambda () '(interactive) + (list 'popup-menu (list 'quote menu))))) + (vm-set-extent-property e 'keymap keymap) + (vm-set-extent-property e 'balloon-help 'vm-mouse-3-help) + (vm-set-extent-property e 'highlight t)) + (setq search-tuples (cdr search-tuples))))) + ((and vm-fsfemacs-p + (fboundp 'overlay-put)) + (let ((search-tuples '(("^From:" vm-menu-fsfemacs-author-menu) + ("^Subject:" vm-menu-fsfemacs-subject-menu))) + regexp menu + o-lists o p) + (setq o-lists (overlay-lists) + p (car o-lists)) + (while p + (when (overlay-get (car p) 'vm-header) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (setq p (cdr o-lists)) + (while p + (when (overlay-get (car p) 'vm-header) + (vm-delete-extent (car p))) + (setq p (cdr p))) + (while search-tuples + (goto-char (point-min)) + (setq regexp (nth 0 (car search-tuples)) + menu (symbol-value (nth 1 (car search-tuples)))) + (while (re-search-forward regexp nil t) + (goto-char (match-end 0)) + (save-excursion (goto-char (match-beginning 0)) (vm-match-header)) + (setq o (make-overlay (vm-matched-header-contents-start) + (vm-matched-header-contents-end))) + (overlay-put o 'vm-header menu) + (overlay-put o 'mouse-face 'highlight)) + (setq search-tuples (cdr search-tuples))))))) + +(defun vm-display-xface () + (cond (vm-xemacs-p (vm-display-xface-xemacs)) + ((and vm-fsfemacs-p + (and (stringp vm-uncompface-program) + (fboundp 'create-image))) + (vm-display-xface-fsfemacs)))) + +(defun vm-display-xface-xemacs () + (let ((case-fold-search t) e g h) + (if (map-extents (function + (lambda (e ignore) + (if (vm-extent-property e 'vm-xface) + t + nil))) + (current-buffer) (point-min) (point-max)) + nil + (goto-char (point-min)) + (if (find-face 'vm-xface) + nil + (make-face 'vm-xface) + (set-face-background 'vm-xface "white") + (set-face-foreground 'vm-xface "black")) + (if (re-search-forward "^X-Face:" nil t) + (progn + (goto-char (match-beginning 0)) + (vm-match-header) + (setq h (concat "X-Face: " (vm-matched-header-contents))) + (setq g (intern h vm-xface-cache)) + (if (boundp g) + (setq g (symbol-value g)) + (set g (make-glyph + (list + (list 'global (cons '(tty) [nothing])) + (list 'global (cons '(win) (vector 'xface ':data h)))))) + (setq g (symbol-value g)) + ;; XXX broken. Gives extra pixel lines at the + ;; bottom of the glyph in 19.12 + ;;(set-glyph-baseline g 100) + (set-glyph-face g 'vm-xface)) + (setq e (vm-make-extent (vm-vheaders-of (car vm-message-pointer)) + (vm-vheaders-of (car vm-message-pointer)))) + (vm-set-extent-property e 'vm-xface t) + (set-extent-begin-glyph e g)))))) + +(defun vm-display-xface-fsfemacs () + (catch 'done + (let ((case-fold-search t) i g h ooo) + (setq ooo (overlays-in (point-min) (point-max))) + (while ooo + (when (overlay-get (car ooo) 'vm-xface) + (vm-delete-extent (car ooo))) + (setq ooo (cdr ooo))) + (goto-char (point-min)) + (if (re-search-forward "^X-Face:" nil t) + (progn + (goto-char (match-beginning 0)) + (vm-match-header) + (setq h (vm-matched-header-contents)) + (setq g (intern h vm-xface-cache)) + (if (boundp g) + (setq g (symbol-value g)) + (setq i (vm-convert-xface-to-fsfemacs-image-instantiator h)) + (cond (i + (set g i) + (setq g (symbol-value g))) + (t (throw 'done nil)))) + (let ((pos (vm-vheaders-of (car vm-message-pointer))) + o ) + ;; An image must replace the normal display of at + ;; least one character. Since we want to put the + ;; image at the beginning of the visible headers + ;; section, it will obscure the first character of + ;; that section. To display that character we add + ;; an after-string that contains the character. + ;; Kludge city, but it works. + (setq o (make-overlay (+ 0 pos) (+ 1 pos))) + (overlay-put o 'vm-xface t) + (overlay-put o 'evaporate t) + (overlay-put o 'after-string + (char-to-string (char-after pos))) + (overlay-put o 'display g))))))) + +(defun vm-convert-xface-to-fsfemacs-image-instantiator (data) + (let ((work-buffer nil) + retval) + (catch 'done + (unwind-protect + (save-excursion + (if (not (stringp vm-uncompface-program)) + (throw 'done nil)) + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (insert data) + (setq retval + (apply 'call-process-region + (point-min) (point-max) + vm-uncompface-program t t nil + (if vm-uncompface-accepts-dash-x '("-X") nil))) + (if (not (eq retval 0)) + (throw 'done nil)) + (if vm-uncompface-accepts-dash-x + (throw 'done + (list 'image ':type 'xbm + ':ascent 80 + ':foreground "black" + ':background "white" + ':data (buffer-string)))) + (if (not (stringp vm-icontopbm-program)) + (throw 'done nil)) + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n"); + (setq retval + (call-process-region + (point-min) (point-max) + vm-icontopbm-program t t nil)) + (if (not (eq retval 0)) + nil + (list 'image ':type 'pbm + ':ascent 80 + ':foreground "black" + ':background "white" + ':data (buffer-string)))) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-url-help (object) + (format + "Use mouse button 2 to send the URL to %s. +Use mouse button 3 to choose a Web browser for the URL." + (cond ((stringp vm-url-browser) vm-url-browser) + ((eq vm-url-browser 'w3-fetch) + "Emacs W3") + ((eq vm-url-browser 'w3-fetch-other-frame) + "Emacs W3") + ((eq vm-url-browser 'vm-mouse-send-url-to-mosaic) + "Mosaic") + ((eq vm-url-browser 'vm-mouse-send-url-to-netscape) + "Netscape") + (t (symbol-name vm-url-browser))))) + +;;;###autoload +(defun vm-energize-urls-in-message-region (&optional start end) + (interactive "r") + (save-excursion + (or start (setq start (vm-headers-of (car vm-message-pointer)))) + (or end (setq end (vm-text-end-of (car vm-message-pointer)))) + ;; energize the URLs + (if (or (facep vm-highlight-url-face) vm-url-browser) + (save-restriction + (widen) + (narrow-to-region start end) + (vm-energize-urls))))) + +(defun vm-highlight-headers-maybe () + ;; highlight the headers + (if (or vm-highlighted-header-regexp + (and vm-xemacs-p vm-use-lucid-highlighting)) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-end-of (car vm-message-pointer))) + (vm-highlight-headers)))) + +(defun vm-energize-headers-and-xfaces () + ;; energize certain headers + (if (and vm-use-menus (vm-menu-support-possible-p)) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-of (car vm-message-pointer))) + (vm-energize-headers))) + ;; display xfaces, if we can + (if (and vm-display-xfaces + (or (and vm-xemacs-p (featurep 'xface)) + (and vm-fsfemacs-p (fboundp 'create-image) + (stringp vm-uncompface-program)))) + (save-restriction + (widen) + (narrow-to-region (vm-headers-of (car vm-message-pointer)) + (vm-text-of (car vm-message-pointer))) + (vm-display-xface)))) + +(defun vm-narrow-for-preview (&optional just-passing-through) + "Hide as much of the message body as vm-preview-lines specifies. +Optional argument JUST-PASSING-THROUGH says that no real preview +is necessary." + (widen) + (narrow-to-region + (vm-vheaders-of (car vm-message-pointer)) + (cond ((not (eq vm-preview-lines t)) + (min + (vm-text-end-of (car vm-message-pointer)) + (save-excursion + (goto-char (vm-text-of (car vm-message-pointer))) + (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0)) + ;; KLUDGE CITY: Under XEmacs, an extent's begin-glyph + ;; will be displayed even if the extent is at the end + ;; of a narrowed region. Thus a message containing + ;; only an image will have the image displayed at + ;; preview time even if vm-preview-lines is 0 provided + ;; vm-mime-decode-for-preview is non-nil. We kludge + ;; a fix for this by moving everything on the preview + ;; cutoff line one character forward, but only if + ;; we're doing MIME decode for preview. + (if (and (not just-passing-through) + vm-xemacs-p + vm-mail-buffer ; in presentation buffer + vm-auto-decode-mime-messages + vm-mime-decode-for-preview + ;; can't do the kludge unless we know that + ;; when the message is exposed it will be + ;; decoded and thereby remove the kludge. + (not (vm-mime-plain-message-p (car vm-message-pointer)))) + (let ((buffer-read-only nil)) + (insert " ") + (forward-char -1))) + (point)))) + (t (vm-text-end-of (car vm-message-pointer)))))) + +;; This function was originally famous as `vm-preview-current-buffer', +;; but it was a misnomer because it does both previewing and showing. + +;;;###autoload +(defun vm-present-current-message () + "Display the current message in the Presentation Buffer. A +copy of the message is made in the Presentation Buffer and MIME +decoding is done if necessary. The displayed content might be a +preview or the full message, governed by the the variables +`vm-preview-lines' and `vm-preview-read-messages'. USR,2010-01-14" + + ;; Set need-preview if the user needs to see the + ;; message in the previewed state. Save some time later by not + ;; doing preview action that the user will never see anyway. + (let ((need-preview + (and vm-preview-lines + (or (vm-new-flag (car vm-message-pointer)) + (vm-unread-flag (car vm-message-pointer)) + vm-preview-read-messages)))) +;; (when vm-enable-external-messages +;; (when (not need-preview) +;; (vm-inform 1 "External messages cannot be previewed") +;; (setq need-preview nil))) + (vm-save-buffer-excursion + (setq vm-system-state 'previewing) + (setq vm-mime-decoded nil) + + ;; 1. make sure that the message body is present + (when (vm-body-to-be-retrieved-of (car vm-message-pointer)) + (let ((mm (vm-real-message-of (car vm-message-pointer)))) + (vm-retrieve-real-message-body mm :fetch t :register t))) + (when vm-real-buffers + (vm-make-virtual-copy (car vm-message-pointer))) + + ;; 2. run the message select hooks. + (save-excursion + (vm-select-folder-buffer) + (when (and vm-select-new-message-hook + (vm-new-flag (car vm-message-pointer))) + (vm-run-hook-on-message 'vm-select-new-message-hook + (car vm-message-pointer))) + (when (and vm-select-unread-message-hook + (vm-unread-flag (car vm-message-pointer))) + (vm-run-hook-on-message 'vm-select-unread-message-hook + (car vm-message-pointer)))) + + ;; 3. prepare the Presentation buffer + (vm-narrow-for-preview (not need-preview)) + (if (or vm-always-use-presentation + vm-mime-display-function + vm-fill-paragraphs-containing-long-lines + (and vm-display-using-mime + (not (vm-mime-plain-message-p (car vm-message-pointer))))) + (let ((layout (vm-mm-layout (car vm-message-pointer)))) + ;; This check is for Bug Report 740755. USR, 2011-12-24 + (let ((new-layout (vm-mime-parse-entity-safe + (car vm-message-pointer)))) + (unless (vm-mime-layouts-equal layout new-layout) + (when vm-debug + (debug 'vm-present-message + "Corruption of cached MIME layout (Bug 740755)?")))) + (vm-make-presentation-copy (car vm-message-pointer)) + (vm-save-buffer-excursion + (vm-replace-buffer-in-windows (current-buffer) + vm-presentation-buffer)) + (set-buffer vm-presentation-buffer) + (setq vm-system-state 'previewing) + (vm-narrow-for-preview)) + ;; never used because vm-always-use-presentation is t. + ;; USR 2010-05-07 + (setq vm-presentation-buffer nil) + (and vm-presentation-buffer-handle + (vm-replace-buffer-in-windows vm-presentation-buffer-handle + (current-buffer)))) + + ;; at this point the current buffer is the presentation buffer + ;; if we're using one for this message. + (vm-unbury-buffer (current-buffer)) + +;; (let ((real-m (car vm-message-pointer))) +;; (if (= (1+ (marker-position (vm-text-of real-m))) +;; (marker-position (vm-text-end-of real-m))) +;; (vm-inform 1 "must fetch the body of %s ..." (vm-imap-uid-of real-m)) +;; (vm-inform 1 "must NOT fetch the body of %s ..." (vm-imap-uid-of real-m)) +;; (let ((vm-message-pointer nil)) +;; (vm-discard-cached-data))) +;; )) + + ;; 4. decode MIME + (if (and vm-display-using-mime + vm-auto-decode-mime-messages + vm-mime-decode-for-preview + need-preview + (if vm-mail-buffer + (not (with-current-buffer vm-mail-buffer + vm-mime-decoded)) + (not vm-mime-decoded)) + (not (vm-mime-plain-message-p (car vm-message-pointer)))) + (if (eq vm-preview-lines 0) + (progn + (vm-decode-mime-message-headers (car vm-message-pointer)) + (vm-energize-urls) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)) + ;; restrict the things that are auto-displayed, since + ;; decode-for-preview is meant to allow a numeric + ;; vm-preview-lines to be useful in the face of multipart + ;; messages. + ;; But why restrict the external viewers? USR, 2011-02-08 + (let ((vm-mime-auto-displayed-content-type-exceptions + (cons "message/external-body" + vm-mime-auto-displayed-content-type-exceptions)) + ;; (vm-mime-external-content-types-alist nil) + ) + (condition-case data + (progn + (vm-decode-mime-message) + ;; reset vm-mime-decoded so that when the user + ;; opens the message completely, the full MIME + ;; display will happen. + ;; As an experiment, we turn off the double + ;; decoding and see what happens. USR, 2010-02-01 + (if (and vm-mime-decode-for-show + vm-mail-buffer + (vm-body-retrieved-of (car vm-message-pointer))) + (with-current-buffer vm-mail-buffer + (setq vm-mime-decoded nil))) + ) + (vm-mime-error (vm-set-mm-layout-display-error + (vm-mime-layout-of (car vm-message-pointer)) + (car (cdr data))) + (vm-warn 0 2 "%s" (car (cdr data))))) + (vm-narrow-for-preview))) + ;; if no MIME decoding is needed + (vm-energize-urls-in-message-region) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)) + + ;; 6. Go to the text of message + (if (and vm-honor-page-delimiters need-preview) + (vm-narrow-to-page)) + (goto-char (vm-text-of (car vm-message-pointer))) + + ;; 7. If we have a window, set window start appropriately. + (let ((w (vm-get-visible-buffer-window (current-buffer)))) + (when w + (set-window-start w (point-min)) + (set-window-point w (vm-text-of (car vm-message-pointer))))) + + ;; 8. Show the full message if necessary + (if need-preview + (vm-update-summary-and-mode-line) + (vm-show-current-message)))) + + (vm-run-hook-on-message 'vm-select-message-hook (car vm-message-pointer))) + +(defalias 'vm-preview-current-message 'vm-present-current-message) + +(defun vm-show-current-message () + "Show the current message in the Presentation Buffer. MIME decoding +is done if necessary. (USR, 2010-01-14)" + ;; It looks like this function can be invoked in both the folder + ;; buffer as well the presentation buffer, but we need to arrange + ;; things so that it is always called in a presentation buffer. + ;; (USR, 2010-05-04) + (if (and vm-display-using-mime + vm-auto-decode-mime-messages + (not (vm-folder-buffer-value 'vm-mime-decoded)) + (not (vm-mime-plain-message-p (car vm-message-pointer)))) + + (condition-case data + (vm-decode-mime-message) + (vm-mime-error (vm-set-mm-layout-display-error + (vm-mime-layout-of (car vm-message-pointer)) + (car (cdr data))) + (vm-warn 0 2 "%s" (car (cdr data)))))) + ;; FIXME this probably cause folder corruption by filling the folder instead + ;; of the presentation copy ..., RWF, 2008-07 + ;; Well, so, we will check if we are in a presentation buffer! + ;; USR, 2010-01-07 + (when (and (or vm-word-wrap-paragraphs + vm-fill-paragraphs-containing-long-lines) + (vm-mime-plain-message-p (car vm-message-pointer))) + (if (null vm-mail-buffer) ; this can't be presentation then + (if vm-always-use-presentation + (progn + (vm-make-presentation-copy (car vm-message-pointer)) + (set-buffer vm-presentation-buffer)) + ;; FIXME at this point, the folder buffer is being used for + ;; display. Filling will corrupt the folder. + (debug "VM internal error #2010. Please report it"))) + (vm-save-restriction + (widen) + (vm-fill-paragraphs-containing-long-lines + vm-fill-paragraphs-containing-long-lines + (vm-text-of (car vm-message-pointer)) + (vm-text-end-of (car vm-message-pointer))))) + (vm-save-buffer-excursion + (save-excursion + (save-excursion + (goto-char (point-min)) + (widen) + (narrow-to-region (point) (vm-text-end-of (car vm-message-pointer)))) + (if vm-honor-page-delimiters + (progn + (if (looking-at page-delimiter) + (forward-page 1)) + (vm-narrow-to-page)))) + ;; don't mark the message as read if the user can't see it! + (if (vm-get-visible-buffer-window (current-buffer)) + (progn + (save-excursion + (setq vm-system-state 'showing) + (if vm-mail-buffer + (with-current-buffer vm-mail-buffer + (setq vm-system-state 'showing))) + ;; We could be in the presentation buffer here. Since + ;; the presentation buffer's message pointer and sole + ;; message are a mockup, they will cause trouble if + ;; passed into the undo/update system. So we switch + ;; into the real message buffer to do attribute + ;; updates. + (vm-select-folder-buffer) + (vm-run-hook-on-message 'vm-showing-message-hook + (car vm-message-pointer)) + (vm-set-new-flag (car vm-message-pointer) nil) + (vm-set-unread-flag (car vm-message-pointer) nil)) + (vm-update-summary-and-mode-line) + (vm-howl-if-eom)) + (vm-update-summary-and-mode-line))) + ;; (if vm-summary-enable-thread-folding + ;; (vm-toggle-thread 1)) + ) + +;;;###autoload +(defun vm-expose-hidden-headers () + "Toggle exposing and hiding message headers that are normally not visible." + (interactive) + (vm-follow-summary-cursor) + (save-excursion + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-expose-hidden-headers) + '(vm-expose-hidden-headers)) + (vm-save-buffer-excursion + (vm-replace-buffer-in-windows (current-buffer) + vm-presentation-buffer)) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (let* ((exposed (= (point-min) (vm-start-of (car vm-message-pointer))))) + (vm-widen-page) + (goto-char (point-max)) + (widen) + (if exposed + (narrow-to-region (point) (vm-vheaders-of (car vm-message-pointer))) + (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))) + (goto-char (point-min)) + (let (w) + (setq w (vm-get-visible-buffer-window (current-buffer))) + (and w (set-window-point w (point-min))) + (and w + (= (window-start w) (vm-vheaders-of (car vm-message-pointer))) + (not exposed) + (set-window-start w (vm-start-of (car vm-message-pointer))))) + (if vm-honor-page-delimiters + (vm-narrow-to-page)))) + ) + +(defun vm-widen-page () + (if (or (> (point-min) (vm-text-of (car vm-message-pointer))) + (/= (point-max) (vm-text-end-of (car vm-message-pointer)))) + (narrow-to-region (vm-vheaders-of (car vm-message-pointer)) + (if (or (vm-new-flag (car vm-message-pointer)) + (vm-unread-flag (car vm-message-pointer))) + (vm-text-of (car vm-message-pointer)) + (vm-text-end-of (car vm-message-pointer)))))) + +(defun vm-narrow-to-page () + (cond (vm-fsfemacs-p + (if (not (and vm-page-end-overlay + (overlay-buffer vm-page-end-overlay))) + (let ((g vm-page-continuation-glyph)) + (setq vm-page-end-overlay (make-overlay (point) (point))) + (vm-set-extent-property vm-page-end-overlay 'vm-glyph g) + (vm-set-extent-property vm-page-end-overlay 'before-string g) + (overlay-put vm-page-end-overlay 'evaporate nil)))) + (vm-xemacs-p + (if (not (and vm-page-end-overlay + (vm-extent-end-position vm-page-end-overlay))) + (let ((g vm-page-continuation-glyph)) + (cond ((not (glyphp g)) + (setq g (make-glyph g)) + (set-glyph-face g 'italic))) + (setq vm-page-end-overlay (vm-make-extent (point) (point))) + (vm-set-extent-property vm-page-end-overlay 'vm-glyph g) + (vm-set-extent-property vm-page-end-overlay 'begin-glyph g) + (vm-set-extent-property vm-page-end-overlay 'detachable nil))))) + (save-excursion + (let (min max (e vm-page-end-overlay)) + (if (or (bolp) (not (save-excursion + (beginning-of-line) + (looking-at page-delimiter)))) + (forward-page -1)) + (setq min (point)) + (forward-page 1) + (if (not (eobp)) + (beginning-of-line)) + (cond ((/= (point) (vm-text-end-of (car vm-message-pointer))) + (vm-set-extent-property e vm-begin-glyph-property + (vm-extent-property e 'vm-glyph)) + (vm-set-extent-endpoints e (point) (point))) + (t + (vm-set-extent-property e vm-begin-glyph-property nil))) + (setq max (point)) + (narrow-to-region min max)))) + +;;;###autoload +(defun vm-beginning-of-message () + "Moves to the beginning of the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (vm-widen-page) + (push-mark) + (vm-display (current-buffer) t '(vm-beginning-of-message) + '(vm-beginning-of-message reading-message)) + (vm-save-buffer-excursion + (let ((osw (selected-window))) + (unwind-protect + (progn + (select-window (vm-get-visible-buffer-window (current-buffer))) + (goto-char (point-min))) + (if (not (eq osw (selected-window))) + (select-window osw))))) + (if vm-honor-page-delimiters + (vm-narrow-to-page))) + +;;;###autoload +(defun vm-end-of-message () + "Moves to the end of the current message, exposing and flagging it read +as necessary." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (vm-widen-page) + (push-mark) + (vm-display (current-buffer) t '(vm-end-of-message) + '(vm-end-of-message reading-message)) + (vm-save-buffer-excursion + (let ((osw (selected-window))) + (unwind-protect + (progn + (select-window (vm-get-visible-buffer-window (current-buffer))) + (goto-char (point-max))) + (if (not (eq osw (selected-window))) + (select-window osw))))) + (if vm-honor-page-delimiters + (vm-narrow-to-page))) + +;;;###autoload +(defun vm-next-button (count) + "Moves to the next button in the current message. +Prefix argument N means move to the Nth next button. +Negative N means move to the Nth previous button. +If there is no next button, an error is signaled and point is not moved. + +A button is a highlighted region of text where pressing RETURN +will produce an action. If the message is being previewed, it is +exposed and marked as read." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (vm-widen-page) + (vm-display (current-buffer) t '(vm-move-to-next-button) + '(vm-move-to-next-button reading-message)) + (select-window (vm-get-visible-buffer-window (current-buffer))) + (unwind-protect + (vm-move-to-xxxx-button (vm-abs count) (>= count 0)) + (if vm-honor-page-delimiters + (vm-narrow-to-page)))) +(defalias 'vm-move-to-next-button 'vm-next-button) + +;;;###autoload +(defun vm-previous-button (count) + "Moves to the previous button in the current message. +Prefix argument N means move to the Nth previous button. +Negative N means move to the Nth next button. +If there is no previous button, an error is signaled and point is not moved. + +A button is a highlighted region of text where pressing RETURN +will produce an action. If the message is being previewed, it is +exposed and marked as read." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (and vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + (setq vm-system-state 'reading) + (vm-widen-page) + (vm-display (current-buffer) t '(vm-move-to-previous-button) + '(vm-move-to-previous-button reading-message)) + (select-window (vm-get-visible-buffer-window (current-buffer))) + (unwind-protect + (vm-move-to-xxxx-button (vm-abs count) (< count 0)) + (if vm-honor-page-delimiters + (vm-narrow-to-page)))) +(defalias 'vm-move-to-previous-button 'vm-previous-button) + +(defun vm-move-to-xxxx-button (count next) + (let ((old-point (point)) + (endp (if next 'eobp 'bobp)) + (extent-end-position (if vm-xemacs-p + (if next + 'extent-end-position + 'extent-start-position) + (if next + 'overlay-end + 'overlay-start))) + (next-extent-change (if vm-xemacs-p + (if next + 'next-extent-change + 'previous-extent-change) + (if next + 'next-overlay-change + 'previous-overlay-change))) + e) + (while (and (> count 0) (not (funcall endp))) + (goto-char (funcall next-extent-change (+ (point) (if next 0 -1)))) + (setq e (vm-extent-at (point))) + (if e + (progn + (if (vm-extent-property e 'vm-button) + (vm-decrement count)) + (goto-char (funcall extent-end-position e))))) + (if e + (goto-char (vm-extent-start-position e)) + (goto-char old-point) + (error "No more buttons")))) + +;;; vm-page.el ends here diff --git a/lisp/vm-pcrisis.el b/lisp/vm-pcrisis.el new file mode 100755 index 0000000..17f2193 --- /dev/null +++ b/lisp/vm-pcrisis.el @@ -0,0 +1,1588 @@ +;;; vm-pcrisis.el --- wide-ranging auto-setup for personalities in VM +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 1999 Rob Hodges, +;; 2006 Robert Widhopf, Robert P. Goldman +;; 2011 Uday S. Reddy +;; +;; Package: Personality Crisis for VM +;; Author: Rob Hodges +;; +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + + +;; DOCUMENTATION: +;; ------------- +;; +;; Documentation is now in Texinfo format, included +;; in the standard VM distribution. + +;;; Code: + +(provide 'vm-pcrisis) + +(eval-and-compile + (require 'timezone) + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-motion) + (require 'vm-reply)) +(eval-when-compile + ;; get the macros we need. + (require 'cl) + (require 'advice) + (condition-case e + (progn + (require 'regexp-opt) + (require 'bbdb) + (require 'bbdb-com)) + (error + (message "%S" e) + (message "Could not load bbdb.el. Related functions may not work correctly!") + ;; (vm-sit-for 5) + ))) + +(declare-function set-extent-face "vm-xemacs" (extent face)) +(declare-function timezone-absolute-from-gregorian "ext:timezone" + (month day year)) +(declare-function bbdb-buffer "ext:bbdb" ()) +(declare-function vm-imap-account-name-for-spec "vm-imap" (maildrop-spec)) +(declare-function vm-pop-find-name-for-spec "vm-pop" (maildrop-spec)) + + +;; Dummy declarations for variables that are defined in bbdb + +(defvar bbdb-records) +(defvar bbdb-file) +(defvar bbdb-records) + +;; ------------------------------------------------------------------- +;; Variables: +;; ------------------------------------------------------------------- +(defconst vmpc-version "0.9.1" + "Version of pcrisis.") + +(defgroup vmpc nil + "Manage personalities and more in VM." + :group 'vm-ext) + +(defcustom vmpc-conditions () + "*List of conditions which will be checked by pcrisis." + :group 'vmpc) + +(defcustom vmpc-actions () + "*List of actions. +Actions are associated with conditions from `vmpc-conditions' by one of +`vmpc-actions-alist', `vmpc-reply-alist', `', `vmpc-forward-alist', +`vmpc-resend-alist', `vmpc-newmail-alist' or `vmpc-automorph-alist'. + +These are also the actions from which you can choose when using the newmail +features of Personality Crisis, or the `vmpc-prompt-for-profile' action. + +You may also define an action without associated commands, e.g. \"none\"." + :type '(repeat (list (string :tag "Action name") + (sexp :tag "Commands"))) + :group 'vmpc) + +(defun vmpc-alist-set (symbol value) + "Used as :set for vmpc-*-alist variables. +Checks if the condition and all the actions exist." + (while value + (let ((condition (caar value)) + (actions (cdar value))) + (if (and condition (not (assoc condition vmpc-conditions))) + (error "Condition '%s' does not exist!" condition)) + (while actions + (if (not (assoc (car actions) vmpc-actions)) + (error "Action '%s' does not exist!" (car actions))) + (setq actions (cdr actions)))) + (setq value (cdr value))) + (set symbol value)) + +(defun vmpc-defcustom-alist-type () + "Generate :type for vmpc-*-alist variables." + (list 'repeat + (list 'list + (append '(choice :tag "Condition") + (mapcar (lambda (c) (list 'const (car c))) vmpc-conditions) + '((string))) + (list 'repeat :tag "Actions to run" + (append '(choice :tag "Action") + (mapcar (lambda (a) (list 'const (car a))) vmpc-actions) + '(string)))))) + +(defcustom vmpc-actions-alist () + "*An alist associating conditions with actions from `vmpc-actions'. +If you do not want to map actions for each state, e.g. for replying, forwarding, +resending, composing or automorphing, then set this one." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-reply-alist () + "*An alist associating conditions with actions from `vmpc-actions' when replying." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-forward-alist () + "*An alist associating conditions with actions from `vmpc-actions' when forwarding." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-automorph-alist () + "*An alist associating conditions with actions from `vmpc-actions' when automorphing." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-newmail-alist () + "*An alist associating conditions with actions from `vmpc-actions' when composing." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-resend-alist () + "*An alist associating conditions with actions from `vmpc-actions' when resending." + :type (vmpc-defcustom-alist-type) +; :set 'vmpc-alist-set + :group 'vmpc) + +(defcustom vmpc-default-profile "default" + "*The default profile to select if no profile was found." + :type '(choice (const :tag "None" nil) + (string)) + :group 'vmpc) + +(defcustom vmpc-auto-profiles-file "~/.vmpc-auto-profiles" + "*File in which to save information used by `vmpc-prompt-for-profile'. +When set to the symbol 'BBDB, profiles will be stored there." + :type '(choice (file) + (const BBDB)) + :group 'vmpc) + +(defcustom vmpc-auto-profiles-expunge-days 100 + "*Number of days after which to expunge old address-profile associations. +Performance may suffer noticeably if this file becomes enormous, but in other +respects it is preferable for this value to be fairly high. The value that is +right for you will depend on how often you send email to new addresses using +`vmpc-prompt-for-profile'." + :type 'integer + :group 'vmpc) + +(defvar vmpc-current-state nil + "The current state of pcrisis. +It is one of 'reply, 'forward, 'resend, 'automorph or 'newmail. +It controls which actions/functions can/will be run.") + +(defvar vmpc-current-buffer nil + "The current buffer, i.e. 'none or 'composition. +It is 'none before running an adviced VM function and 'composition afterward, +i.e. when within the composition buffer.") + +(defvar vmpc-saved-headers-alist nil + "Alist of headers from the original message saved for later use.") + +(defvar vmpc-actions-to-run nil + "The actions to run.") + +(defvar vmpc-true-conditions nil + "The true conditions.") + +(defvar vmpc-auto-profiles nil + "The auto profiles as stored in `vmpc-auto-profiles-file'.") + +;; An "exerlay" is an overlay in FSF Emacs and an extent in XEmacs. +;; It's not a real type; it's just the way I'm dealing with the damn +;; things to produce containers for the signature and pre-signature +;; which can be highlighted etc. and work on both platforms. + +(defvar vmpc-pre-sig-exerlay () + "Don't mess with this.") + +(make-variable-buffer-local 'vmpc-pre-sig-exerlay) + +(defvar vmpc-sig-exerlay () + "Don't mess with this.") + +(make-variable-buffer-local 'vmpc-sig-exerlay) + +(defvar vmpc-pre-sig-face (progn (make-face 'vmpc-pre-sig-face + "Face used for highlighting the pre-signature.") + (set-face-foreground + 'vmpc-pre-sig-face "forestgreen") + 'vmpc-pre-sig-face) + "Face used for highlighting the pre-signature.") + +(defvar vmpc-sig-face (progn (make-face 'vmpc-sig-face + "Face used for highlighting the signature.") + (set-face-foreground 'vmpc-sig-face + "steelblue") + 'vmpc-sig-face) + "Face used for highlighting the signature.") + +(defvar vmpc-intangible-pre-sig 'nil + "Whether to forbid the cursor from entering the pre-signature.") + +(defvar vmpc-intangible-sig 'nil + "Whether to forbid the cursor from entering the signature.") + +(defvar vmpc-expect-default-signature 'nil + "*Set this to 't if you have a signature-inserting function. +It will ensure that pcrisis correctly handles the signature .") + + +;; ------------------------------------------------------------------- +;; Some easter-egg functionality: +;; ------------------------------------------------------------------- + +(defun vmpc-my-identities (&rest identities) + "Setup pcrisis with the given IDENTITIES." + (setq vmpc-conditions '(("always true" t)) + vmpc-actions-alist '(("always true" "prompt for a profile")) + vmpc-actions '(("prompt for a profile" + (vmpc-prompt-for-profile t t)))) + (setq vmpc-actions + (append (mapcar + (lambda (identity) + `(,identity + (vmpc-substitute-header "From" ,identity))) + identities) + vmpc-actions))) + +(defun vmpc-header-field-for-point () + "*Return a string indicating the mail header field point is in. +If point is not in a header field, returns nil." + (save-excursion + (unless (save-excursion + (re-search-backward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-min) t)) + (re-search-backward "^\\([^ \t\n:]+\\):") + (match-string 1)))) + +(defun vmpc-tab-header-or-tab-stop (&optional backward) + "*If in a mail header field, moves to next useful header or body. +When moving to the message body, calls the `vmpc-automorph' function. +If within the message body, runs `tab-to-tab-stop'. +If BACKWARD is specified and non-nil, moves to previous useful header +field, whether point is in the body or the headers. +\"Useful header fields\" are currently, in order, \"To\" and +\"Subject\"." + (interactive) + (let ((curfield) (nextfield) (useful-headers '("To" "Subject"))) + (if (or (setq curfield (vmpc-header-field-for-point)) + backward) + (progn + (setq nextfield + (- (length useful-headers) + (length (member curfield useful-headers)))) + (if backward + (setq nextfield (nth (1- nextfield) useful-headers)) + (setq nextfield (nth (1+ nextfield) useful-headers))) + (if nextfield + (mail-position-on-field nextfield) + (mail-text) + (vmpc-automorph)) + ) + (tab-to-tab-stop) + ))) + +(defun vmpc-backward-tab-header-or-tab-stop () + "*Wrapper for `vmpc-tab-header-or-tab-stop' with BACKWARD set." + (interactive) + (vmpc-tab-header-or-tab-stop t)) + + +;; ------------------------------------------------------------------- +;; Stuff for dealing with exerlays: +;; ------------------------------------------------------------------- + +(defun vmpc-set-overlay-insertion-types (overlay start end) + "Set insertion types for OVERLAY from START to END. +In fact a new copy of OVERLAY with different insertion types at START and END +is created and returned. + +START and END should be nil or t -- the marker insertion types at the start +and end. This seems to be the only way you of changing the insertion types +for an overlay -- save the overlay properties that we care about, create a new +overlay with the new insertion types, set its properties to the saved ones. +Overlays suck. Extents rule. XEmacs got this right." + (let* ((useful-props (list 'face 'intangible 'evaporate)) (saved-props) + (i 0) (len (length useful-props)) (startpos) (endpos) (new-ovl)) + (while (< i len) + (setq saved-props (append saved-props (cons + (overlay-get overlay (nth i useful-props)) ()))) + (setq i (1+ i))) + (setq startpos (overlay-start overlay)) + (setq endpos (overlay-end overlay)) + (delete-overlay overlay) + (if (and startpos endpos) + (setq new-ovl (make-overlay startpos endpos (current-buffer) + start end)) + (setq new-ovl (make-overlay 1 1 (current-buffer) start end)) + (vmpc-forcefully-detach-exerlay new-ovl)) + (setq i 0) + (while (< i len) + (overlay-put new-ovl (nth i useful-props) (nth i saved-props)) + (setq i (1+ i))) + new-ovl)) + + +(defun vmpc-set-extent-insertion-types (extent start end) + "Set the insertion types of EXTENT from START to END. +START and END should be either nil or t, indicating the desired value +of the 'start-open and 'end-closed properties of the extent +respectively. +This is the XEmacs version of `vmpc-set-overlay-insertion-types'." + ;; pretty simple huh? + (vm-set-extent-property extent 'start-open start) + (vm-set-extent-property extent 'end-closed end)) + + +(defun vmpc-set-exerlay-insertion-types (exerlay start end) + "Set the insertion types for EXERLAY from START to END. +In other words, EXERLAY is the name of the overlay or extent with a quote in +front. START and END are the equivalent of the marker insertion types for the +start and end of the overlay/extent." + (if vm-xemacs-p + (vmpc-set-extent-insertion-types (symbol-value exerlay) start end) + (set exerlay (vmpc-set-overlay-insertion-types (symbol-value exerlay) + start end)))) + + +(defun vmpc-exerlay-start (exerlay) + "Return buffer position of the start of EXERLAY." + (if vm-xemacs-p + (vm-extent-start-position exerlay) + (overlay-start exerlay))) + + +(defun vmpc-exerlay-end (exerlay) + "Return buffer position of the end of EXERLAY." + (if vm-xemacs-p + (vm-extent-end-position exerlay) + (overlay-end exerlay))) + + +(defun vmpc-move-exerlay (exerlay new-start new-end) + "Change EXERLAY to cover region from NEW-START to NEW-END." + (if vm-xemacs-p + (vm-set-extent-endpoints exerlay new-start new-end (current-buffer)) + (move-overlay exerlay new-start new-end (current-buffer)))) + + +(defun vmpc-set-exerlay-detachable-property (exerlay newval) + "Set the 'detachable or 'evaporate property for EXERLAY to NEWVAL." + (if vm-xemacs-p + (vm-set-extent-property exerlay 'detachable newval) + (overlay-put exerlay 'evaporate newval))) + + +(defun vmpc-set-exerlay-intangible-property (exerlay newval) + "Set the 'intangible or 'atomic property for EXERLAY to NEWVAL." + (if vm-xemacs-p + (progn + (require 'atomic-extents) + (vm-set-extent-property exerlay 'atomic newval)) + (overlay-put exerlay 'intangible newval))) + + +(defun vmpc-set-exerlay-face (exerlay newface) + "Set the face used by EXERLAY to NEWFACE." + (if vm-xemacs-p + (set-extent-face exerlay newface) + (overlay-put exerlay 'face newface))) + + +(defun vmpc-forcefully-detach-exerlay (exerlay) + "Leave EXERLAY in memory but detaches it from the buffer." + (if vm-xemacs-p + (vm-detach-extent exerlay) + (delete-overlay exerlay))) + + +(defun vmpc-make-exerlay (startpos endpos) + "Create a new exerlay spanning from STARTPOS to ENDPOS." + (vm-make-extent startpos endpos)) + + +(defun vmpc-create-sig-and-pre-sig-exerlays () + "Create the extents in which the pre-sig and sig can reside. +Or overlays, in the case of GNU Emacs. Thus, exerlays." + (setq vmpc-pre-sig-exerlay (vmpc-make-exerlay 1 2)) + (setq vmpc-sig-exerlay (vmpc-make-exerlay 3 4)) + + (vmpc-set-exerlay-detachable-property vmpc-pre-sig-exerlay t) + (vmpc-set-exerlay-detachable-property vmpc-sig-exerlay t) + (vmpc-forcefully-detach-exerlay vmpc-pre-sig-exerlay) + (vmpc-forcefully-detach-exerlay vmpc-sig-exerlay) + + (vmpc-set-exerlay-face vmpc-pre-sig-exerlay 'vmpc-pre-sig-face) + (vmpc-set-exerlay-face vmpc-sig-exerlay 'vmpc-sig-face) + + (vmpc-set-exerlay-intangible-property vmpc-pre-sig-exerlay + vmpc-intangible-pre-sig) + (vmpc-set-exerlay-intangible-property vmpc-sig-exerlay + vmpc-intangible-sig) + + (vmpc-set-exerlay-insertion-types 'vmpc-pre-sig-exerlay t nil) + (vmpc-set-exerlay-insertion-types 'vmpc-sig-exerlay t nil) + + ;; deal with signatures inserted by other things than vm-pcrisis: + (if vmpc-expect-default-signature + (save-excursion + (let ((p-max (point-max)) + (body-start (save-excursion (mail-text) (point))) + (sig-start nil)) + (goto-char p-max) + (setq sig-start (re-search-backward "\n-- \n" body-start t)) + (if sig-start + (vmpc-move-exerlay vmpc-sig-exerlay sig-start p-max)))))) + + +;; ------------------------------------------------------------------- +;; Functions for vmpc-actions: +;; ------------------------------------------------------------------- + +(defmacro vmpc-composition-buffer (&rest form) + "Evaluate FORM if in the composition buffer. +That is to say, evaluates the form if you are really in a composition +buffer. This function should not be called directly, only from within +the `vmpc-actions' list." + (list 'if '(eq vmpc-current-buffer 'composition) + (list 'eval (cons 'progn form)))) + +(put 'vmpc-composition-buffer 'lisp-indent-hook 'defun) + +(defmacro vmpc-pre-function (&rest form) + "Evaluate FORM if in pre-function state. +That is to say, evaluates the FORM before VM does its thing, whether +that be creating a new mail or a reply. This function should not be +called directly, only from within the `vmpc-actions' list." + (list 'if '(and (eq vmpc-current-buffer 'none) + (not (eq vmpc-current-state 'automorph))) + (list 'eval (cons 'progn form)))) + +(put 'vmpc-pre-function 'lisp-indent-hook 'defun) + +(defun vmpc-delete-header (hdrfield &optional entire) + "Delete the contents of a HDRFIELD in the current mail message. +If ENTIRE is specified and non-nil, deletes the header field as well." + (if (eq vmpc-current-buffer 'composition) + (save-excursion + (let ((start) (end)) + (mail-position-on-field hdrfield) + (if entire + (setq end (+ (point) 1)) + (setq end (point))) + (re-search-backward ": ") + (if entire + (setq start (progn (beginning-of-line) (point))) + (setq start (+ (point) 2))) + (delete-region start end))))) + + +(defun vmpc-insert-header (hdrfield content) + "Insert to HDRFIELD the new CONTENT. +Both arguments are strings. The field can either be present or not, +but if present, HDRCONT will be appended to the current header +contents." + (if (eq vmpc-current-buffer 'composition) + (save-excursion + (mail-position-on-field hdrfield) + (insert content)))) + +(defun vmpc-substitute-header (hdrfield content) + "Substitute HDRFIELD with new CONTENT. +Both arguments are strings. The field can either be present or not. +If the header field is present and already contains something, the +contents will be replaced, otherwise a new header is created." + (if (eq vmpc-current-buffer 'composition) + (save-excursion + (vmpc-delete-header hdrfield) + (vmpc-insert-header hdrfield content)))) + +(defun vmpc-add-header (hdrfield content) + "Add HDRFIELD with CONTENT if it is not present already. +Both arguments are strings. +If a header field with the same CONTENT is present already nothing will be +done, otherwise a new field with the same name and the new CONTENT will be +added to the message. + +This is suitable for FCC, which can be specified multiple times." + (unless (eq vmpc-current-buffer 'composition) + (error "attempting to insert a header into a non-composition buffer.")) + (let ((prev-contents (vmpc-get-header-contents hdrfield "\n"))) + (setq prev-contents (vmpc-split prev-contents "\n")) + ;; don't add this new header if it's already there + (unless (member content prev-contents) + (save-excursion + (or (mail-position-on-field hdrfield t) ; Put new field after existing one + (mail-position-on-field "to")) + (unless (eq (aref hdrfield (1- (length hdrfield))) ?:) + (setq hdrfield (concat hdrfield ":"))) + (insert "\n" hdrfield " ") + (insert content))))) + +(defun vmpc-get-current-header-contents (hdrfield &optional clump-sep) + "Return the contents of HDRFIELD in the current mail message. +Returns an empty string if the header doesn't exist. HDRFIELD should +be a string. If the string CLUMP-SEP is specified, it means to return +the contents of all headers matching the regexp HDRFIELD, separated by +CLUMP-SEP." + ;; This code is based heavily on vm-get-header-contents and vm-match-header. + ;; Thanks Kyle :) + (if (eq vmpc-current-state 'automorph) + (save-excursion + (let ((contents nil) (header-name-regexp "\\([^ \t\n:]+\\):") + (case-fold-search t) (temp-contents) (end-of-headers) (regexp)) + (if (not (listp hdrfield)) + (setq hdrfield (list hdrfield))) + ;; find the end of the headers: + (goto-char (point-min)) + (or (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + nil t) + (error "Cannot find mail-header-separator %S in buffer %S" + mail-header-separator (current-buffer))) + (setq end-of-headers (match-beginning 0)) + ;; now rip through finding all the ones we want: + (while hdrfield + (setq regexp (concat "^\\(" (car hdrfield) "\\)")) + (goto-char (point-min)) + (while (and (or (null contents) clump-sep) + (re-search-forward regexp end-of-headers t) + (save-excursion + (goto-char (match-beginning 0)) + (let (header-cont-start header-cont-end) + (if (if (not clump-sep) + (and (looking-at (car hdrfield)) + (looking-at header-name-regexp)) + (looking-at header-name-regexp)) + (save-excursion + (goto-char (match-end 0)) + ;; skip leading whitespace + (skip-chars-forward " \t") + (setq header-cont-start (point)) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + ;; drop the trailing newline + (setq header-cont-end (1- (point))))) + (setq temp-contents + (buffer-substring header-cont-start + header-cont-end))))) + (if contents + (setq contents + (concat contents clump-sep temp-contents)) + (setq contents temp-contents))) + (setq hdrfield (cdr hdrfield))) + + (if (null contents) + (setq contents "")) + contents )))) + +(defun vmpc-get-current-body-text () + "Return the body text of the mail message in the current buffer." + (if (eq vmpc-current-state 'automorph) + (save-excursion + (goto-char (point-min)) + (let ((start (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$"))) + (end (point-max))) + (buffer-substring start end))))) + + +(defun vmpc-get-replied-header-contents (hdrfield &optional clump-sep) + "Return the contents of HDRFIELD in the message being replied to. +If that header does not exist, returns an empty string. If the string +CLUMP-SEP is specified, treat HDRFIELD as a regular expression and +return the contents of all header fields which match that regexp, +separated from each other by CLUMP-SEP." + (if (and (eq vmpc-current-buffer 'none) + (memq vmpc-current-state '(reply forward resend))) + (let ((mp (car (vm-select-operable-messages + 1 (vm-interactive-p) "Operate on"))) + content c) + (if (not (listp hdrfield)) + (setq hdrfield (list hdrfield))) + (while hdrfield + (setq c (vm-get-header-contents mp (car hdrfield) clump-sep)) + (if c (setq content (cons c content))) + (setq hdrfield (cdr hdrfield))) + (or (mapconcat 'identity content "\n") "")))) + +(defun vmpc-get-header-contents (hdrfield &optional clump-sep) + "Return the contents of HDRFIELD." + (cond ((and (eq vmpc-current-buffer 'none) + (memq vmpc-current-state '(reply forward resend))) + (vmpc-get-replied-header-contents hdrfield clump-sep)) + ((eq vmpc-current-state 'automorph) + (vmpc-get-current-header-contents hdrfield clump-sep)))) + +(defun vmpc-get-replied-body-text () + "Return the body text of the message being replied to." + (if (and (eq vmpc-current-buffer 'none) + (memq vmpc-current-state '(reply forward resend))) + (save-excursion + (let* ((mp (car (vm-select-operable-messages + 1 (vm-interactive-p) "Operate on"))) + (message (vm-real-message-of mp)) + start end) + (set-buffer (vm-buffer-of message)) + (save-restriction + (widen) + (setq start (vm-text-of message)) + (setq end (vm-end-of message)) + (buffer-substring start end)))))) + +(defun vmpc-save-replied-header (hdrfield) + "Save the contents of HDRFIELD in `vmpc-saved-headers-alist'. +Does nothing if that header doesn't exist." + (let ((hdrcont (vmpc-get-replied-header-contents hdrfield))) + (if (and (eq vmpc-current-buffer 'none) + (memq vmpc-current-state '(reply forward resend)) + (not (equal hdrcont ""))) + (add-to-list 'vmpc-saved-headers-alist (cons hdrfield hdrcont))))) + +(defun vmpc-get-saved-header (hdrfield) + "Return the contents of HDRFIELD from `vmpc-saved-headers-alist'. +The alist in question is created by `vmpc-save-replied-header'." + (if (and (eq vmpc-current-buffer 'composition) + (memq vmpc-current-state '(reply forward resend))) + (cdr (assoc hdrfield vmpc-saved-headers-alist)))) + +(defun vmpc-substitute-replied-header (dest src) + "Substitute header DEST with content from SRC. +For example, if the address you want to send your reply to is the same +as the contents of the \"From\" header in the message you are replying +to, use (vmpc-substitute-replied-header \"To\" \"From\"." + (if (memq vmpc-current-state '(reply forward resend)) + (progn + (if (eq vmpc-current-buffer 'none) + (vmpc-save-replied-header src)) + (if (eq vmpc-current-buffer 'composition) + (vmpc-substitute-header dest (vmpc-get-saved-header src)))))) + +(defun vmpc-get-header-extents (hdrfield) + "Return buffer positions (START . END) for the contents of HDRFIELD. +If HDRFIELD does not exist, return nil." + (if (eq vmpc-current-buffer 'composition) + (save-excursion + (let ((header-name-regexp "^\\([^ \t\n:]+\\):") (start) (end)) + (setq end + (if (mail-position-on-field hdrfield t) + (point) + nil)) + (setq start + (if (re-search-backward header-name-regexp (point-min) t) + (match-end 0) + nil)) + (and start end (<= start end) (cons start end)))))) + +(defun vmpc-substitute-within-header + (hdrfield regexp to-string &optional append-if-no-match sep) + "Replace in HDRFIELD strings matched by REGEXP with TO-STRING. +HDRFIELD need not exist. TO-STRING may contain references to groups +within REGEXP, in the same manner as `replace-regexp'. If REGEXP is +not found in the header contents, and APPEND-IF-NO-MATCH is t, +TO-STRING will be appended to the header contents (with HDRFIELD being +created if it does not exist). In this case, if the string SEP is +specified, it will be used to separate the previous header contents +from TO-STRING, unless HDRFIELD has just been created or was +previously empty." + (if (eq vmpc-current-buffer 'composition) + (save-excursion + (let ((se (vmpc-get-header-extents hdrfield)) (found)) + (if se + ;; HDRFIELD exists + (save-restriction + (narrow-to-region (car se) (cdr se)) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (setq found t) + (replace-match to-string)) + (if (and (not found) append-if-no-match) + (progn + (goto-char (cdr se)) + (if (and sep (not (equal (car se) (cdr se)))) + (insert sep)) + (insert to-string)))) + ;; HDRFIELD does not exist + (if append-if-no-match + (progn + (mail-position-on-field hdrfield) + (insert to-string)))))))) + + +(defun vmpc-replace-or-add-in-header (hdrfield regexp hdrcont &optional sep) + "Replace in HDRFIELD the match of REGEXP with HDRCONT. +All arguments are strings. The field can either be present or not. +If the header field is present and already contains something, HDRCONT +will be appended and if SEP is none nil it will be used as separator. + +I use this function to modify recipients in the TO-header. +e.g. + (vmpc-replace-or-add-in-header \"To\" \"[Rr]obert Fenk[^,]*\" + \"Robert Fenk\" \", \"))" + (if (eq vmpc-current-buffer 'composition) + (let ((hdr (vmpc-get-current-header-contents hdrfield)) + (old-point (point))) + (if hdr + (progn + (vmpc-delete-header hdrfield) + (if (string-match regexp hdr) + (setq hdr (vm-replace-in-string hdr regexp hdrcont)) + (setq hdr (if sep (concat hdr sep hdrcont) + (concat hdr hdrcont)))) + (vmpc-insert-header hdrfield hdr) + (goto-char old-point)) + )))) + +(defun vmpc-insert-signature (sig &optional pos) + "Insert SIG at the end of `vmpc-sig-exerlay'. +SIG is a string. If it is the name of a file, its contents is inserted -- +otherwise the string itself is inserted. Optional parameter POS means insert +the signature at POS if `vmpc-sig-exerlay' is detached." + (if (eq vmpc-current-buffer 'composition) + (progn + (let ((end (or (vmpc-exerlay-end vmpc-sig-exerlay) pos))) + (save-excursion + (vmpc-set-exerlay-insertion-types 'vmpc-sig-exerlay nil t) + (vmpc-set-exerlay-detachable-property vmpc-sig-exerlay nil) + (vmpc-set-exerlay-intangible-property vmpc-sig-exerlay nil) + (unless end + (setq end (point-max)) + (vmpc-move-exerlay vmpc-sig-exerlay end end)) + (if (and pos (not (vmpc-exerlay-end vmpc-sig-exerlay))) + (vmpc-move-exerlay vmpc-sig-exerlay pos pos)) + (goto-char end) + (insert "\n-- \n") + (if (and (file-exists-p sig) + (file-readable-p sig) + (not (equal sig ""))) + (insert-file-contents sig) + (insert sig))) + (vmpc-set-exerlay-intangible-property vmpc-sig-exerlay + vmpc-intangible-sig) + (vmpc-set-exerlay-detachable-property vmpc-sig-exerlay t) + (vmpc-set-exerlay-insertion-types 'vmpc-sig-exerlay t nil))))) + + +(defun vmpc-delete-signature () + "Deletes the contents of `vmpc-sig-exerlay'." + (when (and (eq vmpc-current-buffer 'composition) + ;; make sure it's not detached first: + (vmpc-exerlay-start vmpc-sig-exerlay)) + (delete-region (vmpc-exerlay-start vmpc-sig-exerlay) + (vmpc-exerlay-end vmpc-sig-exerlay)) + (vmpc-forcefully-detach-exerlay vmpc-sig-exerlay))) + + +(defun vmpc-signature (sig) + "Remove a current signature if present, and replace it with SIG. +If the string SIG is the name of a readable file, its contents are +inserted as the signature; otherwise SIG is inserted literally. If +SIG is the empty string (\"\"), the current signature is deleted if +present, and that's all." + (if (eq vmpc-current-buffer 'composition) + (let ((pos (vmpc-exerlay-start vmpc-sig-exerlay))) + (save-excursion + (vmpc-delete-signature) + (if (not (equal sig "")) + (vmpc-insert-signature sig pos)))))) + + +(defun vmpc-insert-pre-signature (pre-sig &optional pos) + "Insert PRE-SIG at the end of `vmpc-pre-sig-exerlay'. +PRE-SIG is a string. If it's the name of a file, the file's contents +are inserted; otherwise the string itself is inserted. Optional +parameter POS means insert the pre-signature at position POS if +`vmpc-pre-sig-exerlay' is detached." + (if (eq vmpc-current-buffer 'composition) + (progn + (let ((end (or (vmpc-exerlay-end vmpc-pre-sig-exerlay) pos)) + (sigstart (vmpc-exerlay-start vmpc-sig-exerlay))) + (save-excursion + (vmpc-set-exerlay-insertion-types 'vmpc-pre-sig-exerlay nil t) + (vmpc-set-exerlay-detachable-property vmpc-pre-sig-exerlay nil) + (vmpc-set-exerlay-intangible-property vmpc-pre-sig-exerlay nil) + (unless end + (if sigstart + (setq end sigstart) + (setq end (point-max))) + (vmpc-move-exerlay vmpc-pre-sig-exerlay end end)) + (if (and pos (not (vmpc-exerlay-end vmpc-pre-sig-exerlay))) + (vmpc-move-exerlay vmpc-pre-sig-exerlay pos pos)) + (goto-char end) + (insert "\n") + (if (and (file-exists-p pre-sig) + (file-readable-p pre-sig) + (not (equal pre-sig ""))) + (insert-file-contents pre-sig) + (insert pre-sig)))) + (vmpc-set-exerlay-intangible-property vmpc-pre-sig-exerlay + vmpc-intangible-pre-sig) + (vmpc-set-exerlay-detachable-property vmpc-pre-sig-exerlay t) + (vmpc-set-exerlay-insertion-types 'vmpc-pre-sig-exerlay t nil)))) + + +(defun vmpc-delete-pre-signature () + "Deletes the contents of `vmpc-pre-sig-exerlay'." + ;; make sure it's not detached first: + (if (eq vmpc-current-buffer 'composition) + (if (vmpc-exerlay-start vmpc-pre-sig-exerlay) + (progn + (delete-region (vmpc-exerlay-start vmpc-pre-sig-exerlay) + (vmpc-exerlay-end vmpc-pre-sig-exerlay)) + (vmpc-forcefully-detach-exerlay vmpc-pre-sig-exerlay))))) + + +(defun vmpc-pre-signature (pre-sig) + "Insert PRE-SIG at the end of `vmpc-pre-sig-exerlay' removing last pre-sig." + (if (eq vmpc-current-buffer 'composition) + (let ((pos (vmpc-exerlay-start vmpc-pre-sig-exerlay))) + (save-excursion + (vmpc-delete-pre-signature) + (if (not (equal pre-sig "")) + (vmpc-insert-pre-signature pre-sig pos)))))) + + +(defun vmpc-gregorian-days () + "Return the number of days elapsed since December 31, 1 B.C." + ;; this code stolen from gnus-util.el :) + (let ((tim (decode-time (current-time)))) + (timezone-absolute-from-gregorian + (nth 4 tim) (nth 3 tim) (nth 5 tim)))) + + +(defun vmpc-load-auto-profiles () + "Initialise `vmpc-auto-profiles' from `vmpc-auto-profiles-file'." + (interactive) + (setq vmpc-auto-profiles nil) + (if (eq vmpc-auto-profiles-file 'BBDB) + (let ((records (bbdb-with-db-buffer bbdb-records)) + profile rec nets) + (while records + (setq rec (car records) + profile (bbdb-get-field rec 'vmpc-profile)) + (when (and profile (> (length profile) 0)) + (setq nets (bbdb-record-net rec)) + (while nets + (setq vmpc-auto-profiles (cons (cons (car nets) (read profile)) + vmpc-auto-profiles) + nets (cdr nets)))) + (setq records (cdr records))) + (setq vmpc-auto-profiles (reverse vmpc-auto-profiles))) + (when (and (file-exists-p vmpc-auto-profiles-file) ; + (file-readable-p vmpc-auto-profiles-file)) + (save-excursion + (set-buffer (get-buffer-create "*pcrisis-temp*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-file-contents vmpc-auto-profiles-file) + (goto-char (point-min)) + (setq vmpc-auto-profiles (read (current-buffer))) + (kill-buffer (current-buffer)))))) + + +(defun vmpc-save-auto-profiles () + "Save `vmpc-auto-profiles' to `vmpc-auto-profiles-file'." + (when (not (eq vmpc-auto-profiles-file 'BBDB)) + (if (not (file-writable-p vmpc-auto-profiles-file)) + ;; if file is not writable, signal an error: + (error "Error: P-Crisis could not write to file %s" + vmpc-auto-profiles-file)) + (save-excursion + (set-buffer (get-buffer-create "*pcrisis-temp*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (goto-char (point-min)) +; (prin1 vmpc-auto-profiles (current-buffer)) + (pp vmpc-auto-profiles (current-buffer)) + (write-region (point-min) (point-max) + vmpc-auto-profiles-file nil 'quietly) + (kill-buffer (current-buffer))))) + +(defun vmpc-fix-auto-profiles-file () + "Change `vmpc-auto-profiles-file' to the format used by v0.82+." + (interactive) + (vmpc-load-auto-profiles) + (let ((len (length vmpc-auto-profiles)) (i 0) (day)) + (while (< i len) + (setq day (cddr (nth i vmpc-auto-profiles))) + (if (consp day) + (setcdr (cdr (nth i vmpc-auto-profiles)) (car day))) + (setq i (1+ i)))) + (vmpc-save-auto-profiles) + (setq vmpc-auto-profiles ())) + + +(defun vmpc-migrate-profiles-to-BBDB () + "Migrate the profiles stored in `vmpc-auto-profiles-file' to the BBDB. + +This will automatically create records if they do not exist and add the new +field `vmpc-profile' to the records which is a sexp not meant to be edited." + (interactive) + (if (eq vmpc-auto-profiles-file 'BBDB) + (error "`vmpc-auto-profiles-file' has been migrated already.")) + (unless vmpc-auto-profiles + (vmpc-load-auto-profiles)) + ;; create a BBDB backup + (bbdb-save-db) + (copy-file (expand-file-name bbdb-file) + (concat (expand-file-name bbdb-file) "-vmpc-profile-migration-backup")) + ;; now migrate the profiles + (let ((profiles vmpc-auto-profiles) + (records (bbdb-with-db-buffer bbdb-records)) + p addr rec) + (while profiles + (setq p (car profiles) + addr (car p) + rec (car (bbdb-search records nil nil addr))) + (when (not rec) + (setq rec (bbdb-create-internal "?" nil addr nil nil nil))) + (bbdb-record-putprop rec 'vmpc-profile (format "%S" (cdr p))) + (setq profiles (cdr profiles)))) + ;; move old profiles file out of the way + (rename-file vmpc-auto-profiles-file + (concat vmpc-auto-profiles-file "-migrated-to-BBDB")) + ;; switch to BBDB mode + (customize-save-variable 'vmpc-auto-profiles-file 'BBDB) + (message "`vmpc-auto-profiles-file' has been set to 'BBDB")) + +(defun vmpc-get-profile-for-address (addr) + "Return profile for ADDR." + (unless vmpc-auto-profiles + (vmpc-load-auto-profiles)) + ;; TODO: BBDB "normalizes" email addresses, i.e. before we had a one-to-one + ;; mapping of address=>actions, now multiple actions may point to the same + ;; list of actions. So either we should update vmpc-auto-profiles upon + ;; storing a new profile or directly search BBDB for it, which might be + ;; slower! + (let ((prof (cadr (assoc addr vmpc-auto-profiles)))) + (when prof + ;; we found a profile for this address and we are still + ;; using it -- so "touch" the record to ensure it stays + ;; newer than vmpc-auto-profiles-expunge-days + (setcdr (cdr (assoc addr vmpc-auto-profiles)) (vmpc-gregorian-days)) + (vmpc-save-auto-profiles)) + prof)) + + +(defun vmpc-save-profile-for-address (addr actions) + "Save the association ADDR => ACTIONS." + (let ((today (vmpc-gregorian-days)) + (old-association (assoc addr vmpc-auto-profiles)) + profile) + + ;; we store the actions list and the durrent date + (setq profile (append (list addr actions) today)) + + ;; remove old profile + (when old-association + ;; now possibly delete it from the BBDB + (setq vmpc-auto-profiles (delete old-association vmpc-auto-profiles)) + (when (and (eq vmpc-auto-profiles-file 'BBDB) (not actions)) + (let ((records (bbdb-with-db-buffer bbdb-records)) rec) + (setq rec (bbdb-search records nil nil addr)) + (when rec + (bbdb-record-putprop (car rec) 'vmpc-profile nil))))) + + ;; add new profile + (when actions + (setq vmpc-auto-profiles (cons profile vmpc-auto-profiles)) + ;; now possibly add it to the BBDB + (when (eq vmpc-auto-profiles-file 'BBDB) + (let ((records (bbdb-with-db-buffer bbdb-records)) rec) + (setq rec (car (bbdb-search records nil nil addr))) + (when (not rec) + (setq rec (bbdb-create-internal "?" nil addr nil nil nil))) + (bbdb-record-putprop rec 'vmpc-profile (format "%S" (cdr profile)))))) + + ;; expunge old stuff from the list: + (when vmpc-auto-profiles-expunge-days + (setq vmpc-auto-profiles + (mapcar (lambda (p) + (if (> (- today (cddr p)) + vmpc-auto-profiles-expunge-days) + nil + p)) + vmpc-auto-profiles)) + (setq vmpc-auto-profiles (delete nil vmpc-auto-profiles))) + + ;; save the file + (vmpc-save-auto-profiles))) + + +(defun vmpc-string-extract-address (str) + "Find the first email address in the string STR and return it. +If no email address in found in STR, returns nil." + (if (string-match "[^ \t,<]+@[^ \t,>]+" str) + (match-string 0 str))) + +(defun vmpc-split (string separators) + "Return a list by splitting STRING at SEPARATORS and trimming all +whitespace." + (let (result + (not-separators (concat "^" separators))) + (save-excursion + (set-buffer (get-buffer-create " *split*")) + (erase-buffer) + (insert string) + (goto-char (point-min)) + (while (progn + (skip-chars-forward separators) + (skip-chars-forward " \t\n\r") + (not (eobp))) + (let ((begin (point)) + p) + (skip-chars-forward not-separators) + (setq p (point)) + (skip-chars-backward " \t\n\r") + (setq result (cons (buffer-substring begin (point)) result)) + (goto-char p))) + (erase-buffer)) + (nreverse result))) + +(defun vmpc-read-actions (prompt &optional default) + "Read a list of actions to run and store it in `vmpc-actions-to-run'. +The special action \"none\" will result in an empty action list." + (interactive (list "VMPC actions%s: ")) + (let ((actions ()) (read-count 0) a) + (setq actions (vm-read-string + (format prompt (if default (format " %s" default) "")) + (append '(("none")) vmpc-actions) + t)) + (if (string= actions "none") + (setq actions nil) + (if (string= actions "") + (setq actions default) + (setq actions (vmpc-split actions " ")) + (setq actions (reverse actions)))) + (when (vm-interactive-p) + (setq vmpc-actions-to-run actions) + (message "VMPC actions to run: %S" actions)) + actions)) + +(defcustom vmpc-prompt-for-profile-headers + '((composition ("To" "CC" "BCC")) + (default ("From" "Sender" "Reply-To" "From" "Resent-From"))) + "*List of headers to check for email addresses. + +`vmpc-prompt-for-profile' will scan the given headers in the given order." + :type '(repeat (list (choice (const default) + (const composition) + (const reply) + (const forward) + (const resent) + (const newmail)) + (repeat (string :tag "Header")))) + :group 'vmpc) + +(defvar vmpc-profiles-history nil + "History of profiles prompted for.") + +(defun vmpc-read-profile (&optional require-match initial-contents default) + "Read a profile and return it." + (unless default + (setq default (car vmpc-profiles-history))) + (completing-read (format "VMPC profile%s: " + (if vmpc-profiles-history + (concat " (" default ")") + "")) + vmpc-auto-profiles + nil + require-match + initial-contents + 'vmpc-profiles-history + default)) + +(defun vmpc-prompt-for-profile (&optional remember prompt) + "Find a profile or prompt for it and add its actions to the list of actions. + +A profile is an association between a recipient address and a set of the +actions named in `vmpc-actions'. When entering the list of actions, one has +to press ENTER after each action and finish adding action by pressing ENTER +without an action. + +The association is stored in `vmpc-auto-profiles-file' and in the future the +stored actions will automatically run for messages to that address. + +REMEMBER can be set to t or 'prompt. When set to 'prompt you will be asked if +you want to store the association. When set to t a new profile will be stored +without asking. + +Set PROMPT to t and you will be prompted each time, i.e. not only for unknown +profiles. If you want to change the profile only explicitly, then omit the +PROMPT argument and call this function interactively in the composition buffer." + (interactive (progn (setq vmpc-current-state 'automorph) + (list 'prompt t))) + + (if (or (and (eq vmpc-current-buffer 'none) + (not (eq vmpc-current-state 'automorph))) + (eq vmpc-current-state 'automorph)) + (let ((headers + (or (assoc vmpc-current-buffer vmpc-prompt-for-profile-headers) + (assoc vmpc-current-state vmpc-prompt-for-profile-headers) + (assoc 'default vmpc-prompt-for-profile-headers))) + addrs a old-actions actions dest) + (setq headers (cadr headers)) + ;; search also other headers for known addresses + (while (and headers (not actions)) + (setq addrs (vmpc-get-header-contents (car headers))) + (if addrs (setq addrs (vmpc-split addrs ","))) + (while addrs + (setq a (vmpc-string-extract-address (car addrs))) + (if (vm-ignored-reply-to a) + (setq a nil)) + (setq actions (append (vmpc-get-profile-for-address a) actions)) + (if (not dest) (setq dest a)) + (setq addrs (cdr addrs))) + (setq headers (cdr headers))) + + (setq dest + (or dest vmpc-default-profile (if prompt (vmpc-read-profile)))) + + (unless actions + (setq actions (vmpc-get-profile-for-address dest))) + + ;; save action to detect a change + (setq old-actions actions) + + (when dest + ;; figure out which actions to run + (when (or prompt (not actions)) + (setq actions (vmpc-read-actions + (format "Actions for \"%s\"%%s: " dest) + actions))) + + ;; fixed old style format where there was only a single action + (unless (listp actions) + (setq remember t) + (setq actions (list actions))) + + ;; save the association of this profile with these actions + ;; if applicable + (if (and (not (equal old-actions actions)) + (or (eq remember t) + (and (eq remember 'prompt) + (if actions + (y-or-n-p + (format "Always run %s for \"%s\"? " + actions dest)) + (if (vmpc-get-profile-for-address dest) + (yes-or-no-p + (format "Delete profile for \"%s\"? " + dest))))))) + (vmpc-save-profile-for-address dest actions)) + + ;; TODO: understand when vmpc-prompt-for-profile has to run actions + ;; if we are in automorph (actually being called from within + ;; an action) + (if (eq vmpc-current-state 'automorph) + (let ((vmpc-actions-to-run actions)) + (vmpc-run-actions)) + ;; otherwise add the actions to the end of the list as a + ;; side effect + (setq vmpc-actions-to-run (append vmpc-actions-to-run actions))) + + ;; return the actions, which makes the condition true if a + ;; profile exists + actions)))) + +;; ------------------------------------------------------------------- +;; Functions for vmpc-conditions: +;; ------------------------------------------------------------------- + +(defun vmpc-none-true-yet (&optional &rest exceptions) + "True if none of the previous evaluated conditions was true. +This is a condition that can appear in `vmpc-conditions'. If EXCEPTIONS are +specified, it means none were true except those. For example, if you wanted +to check whether no conditions had yet matched with the exception of the two +conditions named \"default\" and \"blah\", you would make the call like this: + (vmpc-none-true-yet \"default\" \"blah\") +Then it will return true regardless of whether \"default\" and \"blah\" had +matched." + (let ((lenex (length exceptions)) (lentc (length vmpc-true-conditions))) + (cond + ((> lentc lenex) + 'nil) + ((<= lentc lenex) + (let ((i 0) (j 0) (k 0)) + (while (< i lenex) + (setq k 0) + (while (< k lentc) + (if (equal (nth i exceptions) (nth k vmpc-true-conditions)) + (setq j (1+ j))) + (setq k (1+ k))) + (setq i (1+ i))) + (if (equal j lentc) + 't + 'nil)))))) + +(defun vmpc-other-cond (condition) + "Return true if the specified CONDITION in `vmpc-conditions' matched. +CONDITION can only be the name of a condition specified earlier in +`vmpc-conditions' -- that is to say, any conditions which follow the one +containing `vmpc-other-cond' will show up as not having matched, because they +haven't yet been checked when this one is checked." + (member condition vmpc-true-conditions)) + +(defun vmpc-folder-match (regexp) + "Return true if the current folder name matches REGEXP." + (string-match regexp (buffer-name))) + +(defun vmpc-folder-account-match (account-regexp) + "Return true if the current folder's POP/IMAP account name matches REGEXP." + (let ((account + (cond ((eq vm-folder-access-method 'imap) + (vm-imap-account-name-for-spec (vm-folder-imap-maildrop-spec))) + ((eq vm-folder-access-method 'pop) + (vm-pop-find-name-for-spec (vm-folder-pop-maildrop-spec))) + (t "") + ))) + (string-match account-regexp account))) + +(defun vmpc-header-match (hdrfield regexp &optional clump-sep num) + "Return true if the contents of specified header HDRFIELD match REGEXP. +For automorph, this means the header in your message, when replying it means +the header in the message being replied to. + +CLUMP-SEP is specified, treat HDRFIELD as a regular expression and +return the contents of all header fields which match that regexp, +separated from each other by CLUMP-SEP. + +If NUM is specified return the match string NUM." + (cond ((memq vmpc-current-state '(reply forward resend)) + (let ((hdr (vmpc-get-replied-header-contents hdrfield clump-sep))) + (and hdr (string-match regexp hdr) + (if num (match-string num hdr) t)))) + ((eq vmpc-current-state 'automorph) + (let ((hdr (vmpc-get-current-header-contents hdrfield clump-sep))) + (and (string-match regexp hdr) + (if num (match-string num hdr) t)))))) + +(defun vmpc-only-from-match (hdrfield regexp &optional clump-sep) + "Return non-nil if all emails from the given HDRFIELD are matched by +REGEXP." + (let* ((content (vmpc-get-header-contents hdrfield clump-sep)) + (case-fold-search t) + (pos 0) + (len (length content)) + (only-from (not (null content)))) + (while (and only-from (< pos len) + (setq pos (string-match "[a-z0-9._-]+@[a-z0-9._-]+" + content pos))) + (if (not (string-match regexp (match-string 0 content))) + (setq only-from nil)) + (setq pos (1+ pos))) + only-from)) + +(defun vmpc-body-match (regexp) + "Return non-nil if the contents of the message body match REGEXP. +For automorph, this means the body of your message; when replying it +means the body of the message being replied to." + (cond ((and (memq vmpc-current-state '(reply forward resend)) + (eq vmpc-current-buffer 'none)) + (string-match regexp (vmpc-get-replied-body-text))) + ((eq vmpc-current-state 'automorph) + (string-match regexp (vmpc-get-current-body-text))))) + + +(defun vmpc-xor (&rest args) + "Return true if one and only one argument in ARGS is true." + (= 1 (length (delete nil args)))) + +;; ------------------------------------------------------------------- +;; Support functions for the advices: +;; ------------------------------------------------------------------- + +(defun vmpc-true-conditions () + "Return a list of all true conditions. +Run this function in order to test/check your conditions." + (interactive) + (let (vmpc-true-conditions + vmpc-current-state + vmpc-current-buffer) + (if (eq major-mode 'vm-mail-mode) + (setq vmpc-current-state 'automorph + vmpc-current-buffer 'composition) + (setq vmpc-current-state (intern (completing-read + "VMPC state (default is 'reply): " + '(("reply") ("forward") ("resend") + ("newmail") ("automorph")) + nil t nil nil "reply")) + vmpc-current-buffer 'none)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vmpc-build-true-conditions-list) + (message "VMPC true conditions: %S" vmpc-true-conditions) + vmpc-true-conditions)) + +(defun vmpc-build-true-conditions-list () + "Build list of true conditions and store it in the variable +`vmpc-true-conditions'." + (interactive) + (setq vmpc-true-conditions nil) + (mapc + (lambda (c) + (if (save-excursion (eval (cons 'progn (cdr c)))) + (setq vmpc-true-conditions (cons (car c) vmpc-true-conditions)))) + vmpc-conditions) + (setq vmpc-true-conditions (reverse vmpc-true-conditions))) + +(defun vmpc-build-actions-to-run-list () + "Build a list of the actions to run. +These are the true conditions mapped to actions. Duplicates will be +eliminated. You may run it in a composition buffer in order to see what +actions will be run." + (interactive) + (if (and (vm-interactive-p) + (not (member major-mode '(vm-mail-mode mail-mode)))) + (error "Run `vmpc-build-actions-to-run-list' in a composition buffer!")) + (let ((alist (or (symbol-value (intern (format "vmpc-%s-alist" + vmpc-current-state))) + vmpc-actions-alist)) + (old-vmpc-actions-to-run vmpc-actions-to-run) + actions) + (setq vmpc-actions-to-run nil) + (mapc + (lambda (c) + (setq actions (cdr (assoc c alist))) + ;; TODO: warn about unbound conditions? + (while actions + (if (not (member (car actions) vmpc-actions-to-run)) + (setq vmpc-actions-to-run + (cons (car actions) vmpc-actions-to-run))) + (setq actions (cdr actions)))) + vmpc-true-conditions) + (setq vmpc-actions-to-run (reverse vmpc-actions-to-run)) + (setq vmpc-actions-to-run + (append vmpc-actions-to-run old-vmpc-actions-to-run))) + (if (vm-interactive-p) + (message "VMPC actions to run: %S" vmpc-actions-to-run)) + vmpc-actions-to-run) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vmpc-run-action (&optional action-regexp) + "Run all actions with names matching the ACTION-REGEXP. +If called interactivly it promts for the regexp. You may also use +completion." + (interactive) + (let ((action-names (mapcar (lambda (a) + (list (regexp-quote (car a)) 1)) + vmpc-actions))) + (if (not action-regexp) + (setq action-regexp (completing-read "VMPC action-regexp: " + action-names))) + (mapcar (lambda (action) + (if (string-match action-regexp (car action)) + (mapcar (lambda (action-command) + (eval action-command)) + (cdr action)))) + vmpc-actions))) + + +(defun vmpc-run-actions (&optional actions verbose) + "Run the argument actions, or the actions stored in `vmpc-actions-to-run'. +If verbose is supplied, it should be a STRING, indicating the name of a +buffer to which to write diagnostic output." + (interactive) + + (if (and (not vmpc-actions-to-run) (not actions) (vm-interactive-p)) + (setq vmpc-actions-to-run (vmpc-read-actions "Actions: "))) + + (let ((actions (or actions vmpc-actions-to-run)) form) + (while actions + (setq form (or (assoc (car actions) vmpc-actions) + (error "Action %S does not exist!" (car actions))) + actions (cdr actions)) + (let ((form (cons 'progn (cdr form))) + (results (eval (cons 'progn (cdr form))))) + (when verbose + (save-excursion + (set-buffer verbose) + (insert (format "Action form is:\n%S\nResults are:\n%S\n" + form results)))))))) + +;; ------------------------------------------------------------------------ +;; The main functions and advices -- these are the entry points to pcrisis: +;; ------------------------------------------------------------------------ +(defun vmpc-init-vars (&optional state buffer) + "Initialize pcrisis variables and optionally set STATE and BUFFER." + (setq vmpc-saved-headers-alist nil + vmpc-actions-to-run nil + vmpc-true-conditions nil + vmpc-current-state state + vmpc-current-buffer (or buffer 'none))) + +(defun vmpc-make-vars-local () + "Make the pcrisis vars buffer local. + +When the vars are first set they cannot be made buffer local as we are not in +the composition buffer then. + +Unfortunately making them buffer local while they are bound by a `let' does +not work, see the info for `make-local-variable'. So we are using the global +ones and make them buffer local when in the composition buffer. At least for +`saved-headers-alist' this should fix the bug that another composition +overwrites the stored headers for subsequent morphs. + +The current solution is not reentrant save, but there also should be no +recursion nor concurrent calls." + ;; make the variables buffer local + (let ((tc vmpc-true-conditions) + (sha vmpc-saved-headers-alist) + (atr vmpc-actions-to-run) + (cs vmpc-current-state)) + (make-local-variable 'vmpc-true-conditions) + (make-local-variable 'vmpc-saved-headers-alist) + (make-local-variable 'vmpc-actions-to-run) + (make-local-variable 'vmpc-current-state) + (make-local-variable 'vmpc-current-buffer) + ;; now set them again to make sure the contain the right value + (setq vmpc-true-conditions tc) + (setq vmpc-saved-headers-alist sha) + (setq vmpc-actions-to-run atr) + (setq vmpc-current-state cs)) + ;; mark, that we are in the composition buffer now + (setq vmpc-current-buffer 'composition) + ;; BUGME why is the global value resurrected after making the variable + ;; buffer local? Is this related to defadvice? I have no idea what is + ;; going on here! Thus we clear it afterwards now! + (save-excursion + (set-buffer (get-buffer-create " *vmpc-cleanup*")) + (vmpc-init-vars) + (setq vmpc-current-buffer nil))) + +(defadvice vm-do-reply (around vmpc-reply activate) + "*Reply to a message with pcrisis voodoo." + (vmpc-init-vars 'reply) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defadvice vm-mail (around vmpc-newmail activate) + "*Start a new message with pcrisis voodoo." + (vmpc-init-vars 'newmail) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defadvice vm-compose-mail (around vmpc-compose-newmail activate) + "*Start a new message with pcrisis voodoo." + (vmpc-init-vars 'newmail) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defadvice vm-forward-message (around vmpc-forward activate) + "*Forward a message with pcrisis voodoo." + ;; this stuff is already done when replying, but not here: + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + ;; the rest is almost exactly the same as replying: + (vmpc-init-vars 'forward) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defadvice vm-forward-message-plain (around vmpc-forward activate) + "*Forward a message in plain text with pcrisis voodoo." + ;; this stuff is already done when replying, but not here: + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + ;; the rest is almost exactly the same as replying: + (vmpc-init-vars 'forward) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defadvice vm-resend-message (around vmpc-resend activate) + "*Resent a message with pcrisis voodoo." + ;; this stuff is already done when replying, but not here: + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + ;; the rest is almost exactly the same as replying: + (vmpc-init-vars 'resend) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions) + ad-do-it + (vmpc-create-sig-and-pre-sig-exerlays) + (vmpc-make-vars-local) + (vmpc-run-actions)) + +(defvar vmpc-no-automorph nil + "When true automorphing will be disabled.") + +(make-variable-buffer-local 'vmpc-no-automorph) + +;;;###autoload +(defun vmpc-toggle-no-automorph () + "Disable automorph for the current buffer. +When automorph is not doing the right thing and you want to disable it for the +current composition, then call this function." + (interactive) + (setq vmpc-no-automorph (not vmpc-no-automorph)) + (message (if vmpc-no-automorph + "Automorphing has been enabled" + "Automorphing has been disabled"))) + +;;;###autoload +(defun vmpc-automorph () + "*Change contents of the current mail message based on its own headers. +Unless `vmpc-current-state' is 'no-automorph, headers and signatures can be +changed; pre-signatures added; functions called. + +Call `vmpc-no-automorph' to disable it for the current buffer." + (interactive) + (unless vmpc-no-automorph + (vmpc-make-vars-local) + (vmpc-init-vars 'automorph 'composition) + (vmpc-build-true-conditions-list) + (vmpc-build-actions-to-run-list) + (vmpc-run-actions))) + +;;; vm-pcrisis.el ends here diff --git a/lisp/vm-pgg.el b/lisp/vm-pgg.el new file mode 100755 index 0000000..bc813b3 --- /dev/null +++ b/lisp/vm-pgg.el @@ -0,0 +1,1308 @@ +;;; vm-pgg.el --- PGP/MIME support for VM by pgg.el +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 2006 Robert Widhopf-Fenk +;; +;; Author: Robert Widhopf-Fenk, Jens Gustedt +;; Status: Tested with XEmacs 21.4.19 & VM 7.19 +;; Keywords: VM helpers +;; X-URL: http://www.robf.de/Hacking/elisp + +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; +;; This is a replacement for mailcrypt adding PGP/MIME support to VM. +;; +;; It requires PGG which is a standard package for XEmacs and is a part +;; of Gnus for GNU Emacs. On Debian "apt-get install gnus" should do the +;; trick. +;; +;; It is still in BETA state thus you must explicitly load it by +;; +;; (and (locate-library "vm-pgg") (require 'vm-pgg)) +;; +;; If you set `vm-mime-auto-displayed-content-types' and/or +;; `vm-mime-internal-content-types' make sure that they contain +;; "application/pgp-keys" or set them before loading vm-pgg. +;; Otherwise public keys are not detected automatically . +;; +;; To customize vm-pgg use: M-x customize-group RET vm-pgg RET +;; +;; Displaying of messages in the PGP(/MIME) format will automatically trigger: +;; * decrypted of encrypted MIME parts +;; * verification of signed MIME parts +;; * snarfing of public keys +;; +;; The status of the current message will also be displayed in the modeline. +;; +;; To create messages according to PGP/MIME you should use: +;; * M-x vm-pgg-encrypt for encrypting +;; * M-x vm-pgg-sign for signing +;; * C-u M-x vm-pgg-encrypt for encrypting + signing +;; +;; All these commands are also available in the menu PGP/MIME which is +;; activated by the minor mode `vm-pgg-compose-mode'. There are also +;; commands for the old style clear text format as MC had them. +;; +;; If you get annoyed by answering password prompts you might want to set the +;; variable `pgg-cache-passphrase' to t and `pgg-passphrase-cache-expiry' to a +;; higher value or nil! +;; + +;;; References: +;; +;; Code partially stems from the sources: +;; * mml2015.el (Gnus) +;; * mc-toplev.el (Mailcrypt) +;; +;; For PGP/MIME see: +;; * http://www.faqs.org/rfcs/rfc2015.html +;; * http://www.faqs.org/rfcs/rfc2440.html +;; * http://www.faqs.org/rfcs/rfc3156.html +;; + +;;; TODO: +;; +;; * add annotation see to signed/encrypted regions. XEmacs has annotations +;; and GNU Emacs? Maybe I simply use overlays at the line start without eys +;; candy. +;; * allow attaching of other keys from key-ring +;; + +;;; Code: + +;; handle missing pgg.el gracefully +(eval-and-compile + (if (and (boundp 'byte-compile-current-file) byte-compile-current-file) + (condition-case nil + (require 'pgg) + (error (message "WARNING: Cannot load pgg.el, related functions may not work!"))) + (require 'pgg)) + + (require 'easymenu) + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-page) + (require 'vm-mime) + (require 'vm-reply) + (require 'vm-motion) + + (require 'advice)) + +(declare-function rfc822-addresses "ext:rfc822" (header-text)) + +(eval-when-compile + (require 'cl) + ;; avoid warnings + (defvar vm-mode-line-format) + (defvar vm-message-pointer) + (defvar vm-presentation-buffer) + (defvar vm-summary-buffer) + ;; avoid bytecompile warnings + (defvar vm-pgg-cleartext-state nil "For interfunction communication.") +) + +; group already defined in vm-vars.el +;(defgroup vm nil +; "VM" +; :group 'mail) + +(defgroup vm-pgg nil + "PGP and PGP/MIME support for VM by PGG." + :group 'vm-ext) + +(defface vm-pgg-bad-signature + '((((type tty) (class color)) + (:foreground "red" :bold t)) + (((type tty)) + (:bold t)) + (((background light)) + (:foreground "red" :bold t)) + (((background dark)) + (:foreground "red" :bold t))) + "The face used to highlight bad signature messages." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-good-signature + '((((type tty) (class color)) + (:foreground "green" :bold t)) + (((type tty)) + (:bold t)) + (((background light)) + (:foreground "green4")) + (((background dark)) + (:foreground "green"))) + "The face used to highlight good signature messages." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-unknown-signature-type + '((((type tty) (class color)) + (:bold t)) + (((type tty)) + (:bold t))) + "The face used to highlight unknown signature types." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-error + '((((type tty) (class color)) + (:foreground "red" :bold t)) + (((type tty)) + (:bold t)) + (((background light)) + (:foreground "red" :bold t)) + (((background dark)) + (:foreground "red" :bold t))) + "The face used to highlight error messages." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-bad-signature-modeline + '((((type tty) (class color)) + (:inherit modeline :foreground "red" :bold t)) + (((type tty)) + (:inherit modeline :bold t)) + (((background light)) + (:inherit modeline :foreground "red" :bold t)) + (((background dark)) + (:inherit modeline :foreground "red" :bold t))) + "The face used to highlight bad signature messages." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-good-signature-modeline + '((((type tty) (class color)) + (:inherit modeline :foreground "green" :bold t)) + (((type tty)) + (:inherit modeline :bold t)) + (((background light)) + (:inherit modeline :foreground "green4")) + (((background dark)) + (:inherit modeline :foreground "green"))) + "The face used to highlight good signature messages." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-unknown-signature-type-modeline + '((((type tty) (class color)) + (:inherit modeline :bold t)) + (((type tty)) + (:inherit modeline :bold t))) + "The face used to highlight unknown signature types." + :group 'vm-pgg + :group 'faces) + +(defface vm-pgg-error-modeline + '((((type tty) (class color)) + (:inherit modeline :foreground "red" :bold t)) + (((type tty)) + (:inherit modeline :bold t)) + (((background light)) + (:inherit modeline :foreground "red")) + (((background dark)) + (:inherit modeline :foreground "red"))) + "The face used to highlight error messages." + :group 'vm-pgg + :group 'faces) + +;; hack to work around the missing support for :inherit in XEmacs +(when (featurep 'xemacs) + (let ((faces '(vm-pgg-bad-signature-modeline + vm-pgg-good-signature-modeline + vm-pgg-unknown-signature-type-modeline + vm-pgg-error-modeline)) + (faces-list (face-list)) + f) + (while faces + (setq f (car faces)) + (set-face-parent f 'modeline) + (face-display-set f (custom-face-get-spec f) nil '(custom)) + (setq faces (cdr faces))))) + +(defcustom vm-pgg-fetch-missing-keys t + "*If t, PGP will try to fetch missing keys from `pgg-default-keyserver-address'." + :group 'vm-pgg + :type 'boolean) + +(defcustom vm-pgg-auto-snarf t + "*If t, snarfing of keys will happen automatically." + :group 'vm-pgg + :type 'boolean) + +(defcustom vm-pgg-auto-decrypt t + "*If t, decrypting will happen automatically." + :group 'vm-pgg + :type 'boolean) + +(defcustom vm-pgg-get-author-headers '("From:" "Sender:") + "*The list of headers to get the author of a mail that is to be send. +If nil, `pgg-default-user-id' is used as a fallback." + :group 'vm-pgg + :type '(repeat string)) + +(defcustom vm-pgg-sign-text-transfer-encoding 'quoted-printable + "*The encoding used for signed MIME parts of type text. +See `vm-pgg-sign' for details." + :group 'vm-pgg + :type '(choice (const quoted-printable) (const base64))) + +(defvar vm-pgg-compose-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c#s" 'vm-pgg-sign) + (define-key map "\C-c#e" 'vm-pgg-encrypt) + (define-key map "\C-c#E" 'vm-pgg-sign-and-encrypt) + (define-key map "\C-c#a" 'vm-pgg-ask-hook) + (define-key map "\C-c#k" 'vm-pgg-attach-public-key) + map)) + +(defvar vm-pgg-compose-mode-menu nil + "The composition menu of vm-pgg.") + +(easy-menu-define + vm-pgg-compose-mode-menu (if (featurep 'xemacs) nil (list vm-pgg-compose-mode-map)) + "PGP/MIME compose mode menu." + '("PGP/MIME" + ["Sign" vm-pgg-sign t] + ["Encrypt" vm-pgg-encrypt t] + ["Sign+Encrypt" vm-pgg-sign-and-encrypt t] + ["Ask For An Action" vm-pgg-ask-hook t] + "----" + ["Attach Public Key" vm-pgg-attach-public-key t] + ["Insert Public Key" pgg-insert-key t])) + +(defvar vm-pgg-compose-mode nil + "None-nil means PGP/MIME composition mode key bindings and menu are available.") + +(make-variable-buffer-local 'vm-pgg-compose-mode) + +(defun vm-pgg-compose-mode (&optional arg) + "\nMinor mode for interfacing with cryptographic functions. + +Switch mode on/off according to ARG. + +\\<vm-pgg-compose-mode-map>" + (interactive) + (setq vm-pgg-compose-mode + (if (null arg) (not vm-pgg-compose-mode) + (> (prefix-numeric-value arg) 0))) + (if vm-pgg-compose-mode + (easy-menu-add vm-pgg-compose-mode-menu) + (easy-menu-remove vm-pgg-compose-mode-menu))) + +(defvar vm-pgg-compose-mode-string " vm-pgg" + "*String to put in mode line when function `vm-pgg-compose-mode' is active.") + +(defcustom vm-pgg-ask-function 'vm-pgg-prompt-for-action + "*The function to use in `vm-pgg-ask-hook'." + :group 'vm-pgg + :type '(choice + (const + :tag "do nothing" + :doc "Disable `vm-pgg-ask-hook'" + nil) + (const + :tag "sign" + :doc "Ask whether to sign the message before sending" + sign) + (const + :tag "encrypt" + :doc "Ask whether to encryt the message before sending" + encrypt) + (const + :tag "encrypt and sign" + :doc "Ask whether to encrypt and sign the message before sending" + encrypt-and-sign) + (function + :tag "ask for the action" + :doc "Will prompt for an action by calling `vm-pgg-prompt-for-action'" + vm-pgg-prompt-for-action) + (function + :tag "your own function" + :doc "It should returning one of the other const values."))) + + +(if (not (assq 'vm-pgg-compose-mode minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons (cons 'vm-pgg-compose-mode vm-pgg-compose-mode-map) + minor-mode-map-alist))) + +(if (not (assq 'vm-pgg-compose-mode minor-mode-alist)) + (setq minor-mode-alist + (cons '(vm-pgg-compose-mode vm-pgg-compose-mode-string) minor-mode-alist))) + +(defun vm-pgg-compose-mode-activate () + "Activate function `vm-pgg-compose-mode'." + (vm-pgg-compose-mode 1)) + +(add-hook 'vm-mail-mode-hook 'vm-pgg-compose-mode-activate t) + +(defun vm-pgg-get-emails (headers) + "Return email addresses found in the given HEADERS." + (let (content recipients) + (while headers + (setq content (vm-mail-mode-get-header-contents (car headers))) + (when content + (setq recipients (append (rfc822-addresses content) recipients))) + (setq headers (cdr headers))) + recipients)) + +(defvar vm-pgg-get-recipients-headers '("To:" "CC:" "BCC:") + "The list of headers to get recipients from.") + +(defun vm-pgg-get-recipients () + "Return a list of recipients." + (vm-pgg-get-emails vm-pgg-get-recipients-headers)) + +(defun vm-pgg-get-author () + "Return the author of the message." + (car (vm-pgg-get-emails vm-pgg-get-author-headers))) + +(defun vm-pgp-goto-body-start () + "Goto the start of the body and return point." + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (goto-char (match-end 0)) + (point)) + +(defun vm-pgp-prepare-composition () + "Prepare the composition for encrypting or signing." + ;; encode message + (unless (vm-mail-mode-get-header-contents "MIME-Version:") + (if vm-do-fcc-before-mime-encode + (vm-do-fcc-before-mime-encode)) + (vm-mime-encode-composition)) + (vm-mail-mode-show-headers) + ;; ensure newline at the end + (goto-char (point-max)) + (skip-chars-backward " \t\r\n\f") + (delete-region (point) (point-max)) + (insert "\n") + ;; skip headers + (vm-pgp-goto-body-start) + ;; guess the author + (make-local-variable 'pgg-default-user-id) + (setq pgg-default-user-id + (or + (and vm-pgg-get-author-headers (vm-pgg-get-author)) + pgg-default-user-id))) + +;;; ###autoload +(defun vm-pgg-cleartext-encrypt (sign) + "*Encrypt the composition as cleartext and with a prefix also SIGN it." + (interactive "P") + (save-excursion + (vm-pgp-prepare-composition) + (let ((start (point)) (end (point-max))) + (unless (pgg-encrypt-region start end (vm-pgg-get-recipients) sign) + (pop-to-buffer pgg-errors-buffer) + (error "Encrypt error")) + (delete-region start end) + (insert-buffer-substring pgg-output-buffer)))) + +(defun vm-pgg-make-presentation-copy () + "Make a presentation copy also for cleartext PGP messages." + (let* ((m (car vm-message-pointer)) + (layout (vm-mm-layout m))) + ;; make a presentation copy + (vm-make-presentation-copy m) + (vm-save-buffer-excursion + (vm-replace-buffer-in-windows (current-buffer) + vm-presentation-buffer)) + (set-buffer vm-presentation-buffer) + + ;; remove From line + (goto-char (point-min)) + (forward-line 1) + (let ((buffer-read-only nil)) + (delete-region (point-min) (point)) + (vm-reorder-message-headers + nil :keep-list vm-visible-headers + :discard-regexp vm-invisible-header-regexp) + (vm-decode-mime-message-headers m) + (when (vectorp layout) + ;; skip headers otherwise they get removed + (goto-char (point-min)) + (search-forward "\n\n") + (vm-decode-mime-layout layout) + (delete-region (point) (point-max))) + (vm-energize-urls-in-message-region) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)))) + +(defvar vm-pgg-state nil + "State of the currently viewed message.") + +(make-variable-buffer-local 'vm-pgg-state) + +(defvar vm-pgg-state-message nil + "The message for `vm-pgg-state'.") + +(make-variable-buffer-local 'vm-pgg-state-message) + +(defvar vm-pgg-mode-line-items + (let ((items '((error " ERROR" vm-pgg-error-modeline) + (unknown " unknown" vm-pgg-unknown-signature-type-modeline) + (verified " verified" vm-pgg-good-signature-modeline))) + mode-line-items + x i s f) + (while (and (featurep 'xemacs) items) + (setq x (car items) + i (car x) + s (cadr x) + f (caddr x) + x (vm-make-extent 0 (length s) s)) + (vm-set-extent-property x 'face f) + (setq items (cdr items)) + (setq mode-line-items (append mode-line-items (list (list i x s))))) + mode-line-items) + "An alist mapping states to modeline strings.") + +(if (not (member 'vm-pgg-state vm-mode-line-format)) + (setq vm-mode-line-format (append '("" vm-pgg-state) vm-mode-line-format))) + +(defun vm-pgg-state-set (&rest states) + "Set the message state displayed in the modeline acording to STATES. +If STATES is nil, clear it." + ;; clear state for a new message + (save-excursion + (vm-select-folder-buffer-if-possible) + (when (not (equal (car vm-message-pointer) vm-pgg-state-message)) + (setq vm-pgg-state-message (car vm-message-pointer)) + (setq vm-pgg-state nil) + (when vm-presentation-buffer + (save-excursion + (set-buffer vm-presentation-buffer) + (setq vm-pgg-state nil))) + (when vm-summary-buffer + (save-excursion + (set-buffer vm-summary-buffer) + (setq vm-pgg-state nil)))) + ;; add prefix + (if (and states (not vm-pgg-state)) + (setq vm-pgg-state '("PGP:"))) + ;; add new states + (let (s) + (while states + (setq s (car states) + vm-pgg-state (append vm-pgg-state + (list (or (cdr (assoc s vm-pgg-mode-line-items)) + (format " %s" s)))) + states (cdr states)))) + ;; propagate state + (setq states vm-pgg-state) + (when vm-presentation-buffer + (save-excursion + (set-buffer vm-presentation-buffer) + (setq vm-pgg-state states))) + (when vm-summary-buffer + (save-excursion + (set-buffer vm-summary-buffer) + (setq vm-pgg-state states))))) + +(defvar vm-pgg-cleartext-begin-regexp + "^-----BEGIN PGP \\(\\(SIGNED \\)?MESSAGE\\|PUBLIC KEY BLOCK\\)-----$" + "Regexp used to match PGP armor.") + +(defvar vm-pgg-cleartext-end-regexp + "^-----END PGP %s-----$" + "Regexp used to match PGP armor.") + +(defcustom vm-pgg-cleartext-search-limit 4096 + "Number of bytes to peek into the message for a PGP clear text armor." + :group 'vm-pgg + :group 'faces) + +(defun vm-pgg-cleartext-automode-button (label action) + "Cleartext thing by a button with text LABEL and associate ACTION with it. +When the button is pressed ACTION is called." + (save-excursion + (unless (eq major-mode 'vm-presentation-mode) + (vm-pgg-make-presentation-copy)) + (goto-char (match-beginning 0)) + (let ((buffer-read-only nil) + (start (point)) + o) + (if (re-search-forward (format vm-pgg-cleartext-end-regexp + (match-string 0)) + (point-max) t) + (delete-region start (match-end 0))) + (insert label) + (setq o (make-overlay start (point))) + (overlay-put o 'vm-pgg t) + (overlay-put o 'face vm-mime-button-face) + (overlay-put o 'vm-button t) + (overlay-put o 'mouse-face 'vm-mime-button-mouse-face) + (let ((keymap (make-sparse-keymap))) + (define-key keymap [mouse-2] action) + (define-key keymap "\r" action) + (overlay-put o 'local-map keymap))))) + +(defvar vm-pgg-cleartext-decoded nil + "State of the cleartext message.") +(make-variable-buffer-local 'vm-pgg-cleartext-decoded) + +(defun vm-pgg-set-cleartext-decoded () + (save-excursion + (vm-select-folder-buffer) + (setq vm-pgg-cleartext-decoded (car vm-message-pointer)))) + +(defun vm-pgg-cleartext-automode () + "Check for PGP ASCII armor and triggers automatic verification/decryption." + (save-excursion + (vm-select-folder-buffer-if-possible) + (if (equal vm-pgg-cleartext-decoded (car vm-message-pointer)) + (setq vm-pgg-cleartext-decoded nil) + (setq vm-pgg-cleartext-decoded nil) + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (goto-char (point-min)) + (when (and (vm-mime-plain-message-p (car vm-message-pointer)) + (re-search-forward vm-pgg-cleartext-begin-regexp + (+ (point) vm-pgg-cleartext-search-limit) + t)) + (cond ((string= (match-string 1) "SIGNED MESSAGE") + (vm-pgg-set-cleartext-decoded) + (vm-pgg-cleartext-verify)) + ((string= (match-string 1) "MESSAGE") + (vm-pgg-set-cleartext-decoded) + (if vm-pgg-auto-decrypt + (vm-pgg-cleartext-decrypt) + (vm-pgg-cleartext-automode-button + "Decrypt PGP message\n" + (lambda () + (interactive) + (let ((vm-pgg-auto-decrypt t)) + (vm-pgg-cleartext-decrypt)))))) + ((string= (match-string 1) "PUBLIC KEY BLOCK") + (vm-pgg-set-cleartext-decoded) + (if vm-pgg-auto-snarf + (vm-pgg-snarf-keys) + (vm-pgg-cleartext-automode-button + "Snarf PGP key\n" + (lambda () + (interactive) + (let ((vm-pgg-auto-snarf t)) + (vm-pgg-snarf-keys)))))) + (t + (error "This should never happen!"))))))) + +(defadvice vm-present-current-message (after vm-pgg-cleartext-automode activate) + "Decode or check signature on clear text messages." + (vm-pgg-state-set) + (when (and vm-pgg-cleartext-decoded + (not (equal vm-pgg-cleartext-decoded (car vm-message-pointer)))) + (setq vm-pgg-cleartext-decoded nil)) + (when (and (not (eq vm-system-state 'previewing)) + (not vm-mime-decoded)) + (vm-pgg-cleartext-automode))) + +(defadvice vm-scroll-forward (around vm-pgg-cleartext-automode activate) + "Decode or check signature on clear text messages." + (let ((vm-system-state-was + (save-excursion + (vm-select-folder-buffer-if-possible) + vm-system-state))) + ad-do-it + (vm-pgg-state-set) + (when (and (eq vm-system-state-was 'previewing) + (not vm-mime-decoded)) + (vm-pgg-cleartext-automode)))) + +;;; ###autoload +(defun vm-pgg-cleartext-sign () + "*Sign the message." + (interactive) + (save-excursion + (vm-pgp-prepare-composition) + (let ((start (point)) (end (point-max))) + (unless (pgg-sign-region start end t) + (pop-to-buffer pgg-errors-buffer) + (error "Signing error")) + (delete-region start end) + (insert-buffer-substring pgg-output-buffer)))) + +(defun vm-pgg-cleartext-cleanup (status) + "Removed ASCII armor and insert PGG output depending on STATUS." + (let (start end) + (setq start (and (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----$") + (match-beginning 0)) + end (and (search-forward "\n\n") + (match-end 0))) + (delete-region start end) + (setq start (and (re-search-forward "^-----BEGIN PGP SIGNATURE-----$") + (match-beginning 0)) + end (and (re-search-forward "^-----END PGP SIGNATURE-----$") + (match-end 0))) + (delete-region start end) + ;; add output from PGP + (insert "\n") + (let ((start (point)) end) + (if (eq status 'error) + (insert-buffer-substring pgg-errors-buffer) + (insert-buffer-substring pgg-output-buffer) + (vm-pgg-crlf-cleanup start (point))) + (setq end (point)) + (put-text-property start end 'face + (if (eq status 'error) + 'vm-pgg-bad-signature + 'vm-pgg-good-signature))))) + +(defadvice vm-mime-transfer-decode-region (around vm-pgg-cleartext-automode activate) + "Decode or check signature on clear text messages parts." + (let ((vm-pgg-part-start (point))) + ad-do-it + ;; BUGME should we use marks here? + (when (and (vm-mime-text-type-layout-p (ad-get-arg 0)) + (< vm-pgg-part-start (point))) + (save-excursion + (save-restriction + (narrow-to-region vm-pgg-part-start (point)) + (vm-pgg-cleartext-automode) + (widen) +; (set-window-start (selected-window) 0) + ;(scroll-down 1000) + ))))) + +(defadvice vm-mime-display-internal-text/plain (around vm-pgg-cleartext-automode activate) + "Decode or check signature on clear text messages parts. +We use the advice here in order to avoid overwriting VMs internal text display +function. Faces will get lost if a charset conversion happens thus we do the +cleanup here after verification and decoding took place." + (let ((vm-pgg-cleartext-state nil) + (start (point)) + end) + ad-do-it + (when vm-pgg-cleartext-state + (setq end (point)) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (vm-pgg-cleartext-cleanup vm-pgg-cleartext-state) + (widen))))) + +;;; ###autoload +(defun vm-pgg-cleartext-verify () + "*Verify the signature in the current message." + (interactive) + (message "Verifying PGP cleartext message...") + (when (vm-interactive-p) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p))) + + ;; make a presentation copy + (unless (eq major-mode 'vm-presentation-mode) + (vm-pgg-make-presentation-copy)) + + ;; verify + (save-excursion + (goto-char (point-min)) + (let ((buffer-read-only nil) + (status (pgg-verify-region (point) (point-max) nil + vm-pgg-fetch-missing-keys))) + + (vm-pgg-state-set 'signed) + (setq status (if (not status) 'error 'verified)) + (vm-pgg-state-set status) + (if (boundp 'vm-pgg-cleartext-state) + (setq vm-pgg-cleartext-state status) + (vm-pgg-cleartext-cleanup status))))) + +;;; ###autoload +(defun vm-pgg-cleartext-decrypt () + "*Decrypt the contents of the current message." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + + ;; make a presentation copy + (unless (eq major-mode 'vm-presentation-mode) + (vm-pgg-make-presentation-copy)) + (goto-char (point-min)) + + ;; decrypt + (let (state start end) + (setq start (and (re-search-forward "^-----BEGIN PGP MESSAGE-----$") + (match-beginning 0)) + end (and (re-search-forward "^-----END PGP MESSAGE-----$") + (match-end 0)) + state (condition-case nil + (pgg-decrypt-region start end) + (error nil))) + + (vm-pgg-state-set 'encrypted) + + (if (not state) + ;; insert the error message + (let ((buffer-read-only nil)) + (vm-pgg-state-set 'error) + (goto-char start) + (insert-buffer-substring pgg-errors-buffer) + (put-text-property start (point) 'face 'vm-pgg-error)) + ;; replace it with decrypted message + (let ((buffer-read-only nil)) + (delete-region start end) + (insert-buffer-substring pgg-output-buffer)) + ;; if it signed then also verify it + (goto-char start) + (if (looking-at "^-----BEGIN PGP \\(SIGNED \\)?MESSAGE-----$") + (vm-pgg-cleartext-verify))))) + +(defun vm-pgg-crlf-cleanup (start end) + "Convert CRLF to LF in region from START to END." + (save-excursion + (goto-char start) + (while (search-forward "\r\n" end t) + (replace-match "\n" t t)))) + +(defun vm-pgg-make-crlf (start end) + "Convert CRLF to LF in region from START to END." + (save-excursion + (goto-char end) + (while (search-backward "\n" start t) + (replace-match "\r\n" t t) + (backward-char)))) + +(defvar vm-pgg-mime-decoded nil + "Saves decoded state for later use, i.e. decoding to buttons.") +(make-variable-buffer-local 'vm-pgg-mime-decoded) + +(defun vm-pgg-get-mime-decoded () + "Return `vm-pgg-mime-decoded'." + (save-excursion + (vm-select-folder-buffer) + vm-pgg-mime-decoded)) + +(defvar vm-pgg-recursion nil + "Detect recursive calles.") + +(defadvice vm-decode-mime-message (around vm-pgg-clear-state activate) + "Clear the modeline state before decoding." + (vm-select-folder-buffer) + (when (not vm-pgg-recursion) + (setq vm-pgg-mime-decoded vm-mime-decoded)) + (setq vm-pgg-state-message nil) + (setq vm-pgg-state nil) + (if (vm-mime-plain-message-p (car vm-message-pointer)) + (if vm-pgg-cleartext-decoded + (vm-present-current-message)) + (let ((vm-pgg-recursion t)) + ad-do-it))) + +(defun vm-pgg-mime-decrypt (button) + "Replace the BUTTON with the output from `pgg-snarf-keys'." + (let ((vm-pgg-auto-decrypt t) + (layout (copy-sequence (vm-extent-property button 'vm-mime-layout)))) + (vm-set-extent-property button 'vm-mime-disposable t) + (vm-set-extent-property button 'vm-mime-layout layout) + (goto-char (vm-extent-start-position button)) + (let ((buffer-read-only nil)) + (vm-decode-mime-layout button t)))) + +;;; ###autoload +(defun vm-mime-display-internal-multipart/encrypted (layout) + "Display multipart/encrypted LAYOUT." + (vm-pgg-state-set 'encrypted) + (let* ((part-list (vm-mm-layout-parts layout)) + (header (car part-list)) + (message (car (cdr part-list))) + status) + (cond ((eq (vm-pgg-get-mime-decoded) 'decoded) + ;; after decode the state of vm-mime-decoded is 'buttons + nil) + ((not (and (= (length part-list) 2) + (vm-mime-types-match (car (vm-mm-layout-type header)) + "application/pgp-encrypted") + ;; TODO: check version and protocol here? + (vm-mime-types-match (car (vm-mm-layout-type message)) + "application/octet-stream"))) + (insert "Unknown multipart/encrypted format.")) + ((not vm-pgg-auto-decrypt) + ;; add a button + (let ((buffer-read-only nil)) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action 'vm-pgg-mime-decrypt + :layout layout))) + (t + ;; decode the message now + (save-excursion + (set-buffer (vm-buffer-of (vm-mm-layout-message message))) + (save-restriction + (widen) + (setq status (pgg-decrypt-region (vm-mm-layout-body-start message) + (vm-mm-layout-body-end message))))) + (if (not status) + (let ((start (point))) + (vm-pgg-state-set 'error) + (insert-buffer-substring pgg-errors-buffer) + (put-text-property start (point) 'face 'vm-pgg-error)) + (save-excursion + (set-buffer pgg-output-buffer) + (vm-pgg-crlf-cleanup (point-min) (point-max)) + (setq message (vm-mime-parse-entity-safe + nil :passing-message-only t))) + (if message + (vm-decode-mime-layout message) + (insert-buffer-substring pgg-output-buffer)) + (setq status (save-excursion + (set-buffer pgg-errors-buffer) + (goto-char (point-min)) + ;; TODO: care for BADSIG + (when (re-search-forward "GOODSIG [^\n\r]+" (point-max) t) + (vm-pgg-state-set 'signed 'verified) + (buffer-substring (match-beginning 0) (match-end 0))))) + (if status + (let ((start (point))) + (insert "\n" status "\n") + (put-text-property start (point) 'face 'vm-pgg-good-signature)))) + t)))) + +;;; ###autoload +(defun vm-mime-display-internal-multipart/signed (layout) + "Display multipart/signed LAYOUT." + (vm-pgg-state-set 'signed) + (let* ((part-list (vm-mm-layout-parts layout)) + (message (car part-list)) + (signature (car (cdr part-list))) + status signature-file start end) + (cond ((eq (vm-pgg-get-mime-decoded) 'decoded) + ;; after decode the state of vm-mime-decoded is 'buttons + nil) + ((not (and (= (length part-list) 2) + signature + ;; TODO: check version and protocol here? + (vm-mime-types-match (car (vm-mm-layout-type signature)) + "application/pgp-signature"))) + ;; insert the message + (vm-decode-mime-layout message) + (let (start end) + (vm-pgg-state-set 'unknown) + (setq start (point)) + (insert + (format + "******* unknown signature type %s *******\n" + (car (and signature (vm-mm-layout-type signature))))) + (setq end (point)) + (when signature + (vm-decode-mime-layout signature)) + (put-text-property start end 'face 'vm-pgg-unknown-signature-type)) + t) + (t + ;; insert the message + (vm-decode-mime-layout message) + ;; write signature to a temp file + (setq start (point)) + (vm-mime-insert-mime-body signature) + (setq end (point)) + (write-region start end + (setq signature-file (pgg-make-temp-file "vm-pgg-signature"))) + (delete-region start end) + (setq start (point)) + (vm-insert-region-from-buffer (marker-buffer (vm-mm-layout-header-start + message)) + (vm-mm-layout-header-start message) + (vm-mm-layout-body-end message)) + (setq end (point-marker)) + (vm-pgg-make-crlf start end) + (setq status (pgg-verify-region start end signature-file + vm-pgg-fetch-missing-keys)) + (delete-file signature-file) + (delete-region start end) + ;; now insert the content + (insert "\n") + (let ((start (point)) end) + (if (not status) + (progn + (vm-pgg-state-set 'error) + (insert-buffer-substring pgg-errors-buffer)) + (vm-pgg-state-set 'verified) + (insert-buffer-substring + (if vm-fsfemacs-p pgg-errors-buffer pgg-output-buffer)) + (vm-pgg-crlf-cleanup start (point))) + (setq end (point)) + (put-text-property start end 'face + (if status 'vm-pgg-good-signature + 'vm-pgg-bad-signature))) + t)))) + +;; we must add these in order to force VM to call our handler +(eval-and-compile +;; (if (listp vm-mime-auto-displayed-content-types) +;; (add-to-list 'vm-mime-auto-displayed-content-types "application/pgp-keys")) + (if (listp vm-mime-internal-content-types) + (add-to-list 'vm-mime-internal-content-types "application/pgp-keys")) + (add-to-list 'vm-mime-button-format-alist + '("application/pgp-keys" . "Snarf %d")) + (add-to-list 'vm-mime-button-format-alist + '("multipart/encrypted" . "Decrypt PGP/MIME message"))) + +(defun vm-pgg-mime-snarf-keys (button) + "Replace the BUTTON with the output from `pgg-snarf-keys'." + (let ((vm-pgg-auto-snarf t) + (layout (copy-sequence (vm-extent-property button 'vm-mime-layout)))) + (vm-set-extent-property button 'vm-mime-disposable t) + (vm-set-extent-property button 'vm-mime-layout layout) + (goto-char (vm-extent-start-position button)) + (let ((buffer-read-only nil)) + (vm-decode-mime-layout button t)))) + +;;; ###autoload +(defun vm-mime-display-internal-application/pgp-keys (layout) + "Snarf keys in LAYOUT and display result of snarfing." + (vm-pgg-state-set 'public-key) + ;; insert the keys + (if vm-pgg-auto-snarf + (let ((start (point)) end status) + (vm-mime-insert-mime-body layout) + (setq end (point-marker)) + (vm-mime-transfer-decode-region layout start end) + (save-excursion + (setq status (pgg-snarf-keys-region start end))) + (delete-region start end) + ;; now insert the result of snafing + (if status + (insert-buffer-substring pgg-output-buffer) + (insert-buffer-substring pgg-errors-buffer))) + (let ((buffer-read-only nil)) + (vm-mime-insert-button + :caption + (vm-mime-sprintf (vm-mime-find-format-for-layout layout) layout) + :action 'vm-pgg-mime-snarf-keys + :layout layout))) + t) + +;;; ###autoload +(defun vm-pgg-snarf-keys () + "*Snarf keys from the current message." + (interactive) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (save-restriction + ;; ensure we are in the right buffer + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + ;; skip headers + (goto-char (point-min)) + (search-forward "\n\n") + (goto-char (match-end 0)) + ;; verify + (unless (pgg-snarf-keys) + (error "Snarfing failed")) + (save-excursion + (set-buffer (if vm-fsfemacs-p pgg-errors-buffer pgg-output-buffer)) + (message (buffer-substring (point-min) (point-max)))))) + +;;; ###autoload +(defun vm-pgg-attach-public-key () + "Attach your public key to a composition." + (interactive) + (let* ((pgg-default-user-id + (or + (and vm-pgg-get-author-headers (vm-pgg-get-author)) + pgg-default-user-id)) + (description (concat "public key of " pgg-default-user-id)) + (buffer (get-buffer-create (concat " *" description "*"))) + start) + (save-excursion + (set-buffer buffer) + (erase-buffer) + (setq start (point)) + (pgg-insert-key) + (if (= start (point)) + (error "%s has no public key!" pgg-default-user-id))) + (save-excursion + (goto-char (point-max)) + (insert "\n") + (setq start (point)) + (vm-attach-object buffer + :type "application/pgp-keys" + :params (list (concat "name=\"" + pgg-default-user-id + ".asc\"")) + :description description) + ;; a crude hack to set the disposition + (let ((disposition (list "attachment" + (concat "filename=\"" + pgg-default-user-id ".asc\""))) + (end (point))) + (if (featurep 'xemacs) + (vm-set-extent-property (vm-extent-at start 'vm-mime-disposition) + 'vm-mime-disposition disposition) + (put-text-property start end 'vm-mime-disposition disposition)))))) + +(defun vm-pgg-make-multipart-boundary (word) + "Create a mime part boundery starting with WORD and return it. + +We cannot use `vm-mime-make-multipart-boundary' as it uses the current time as +seed and thus creates the same boundery when called twice in a short period." + (if word (setq word (concat word "+"))) + (let ((boundary (concat word (make-string 15 ?a))) + (i (length word))) + (random) + (while (< i (length boundary)) + (aset boundary i (aref vm-mime-base64-alphabet + (% (vm-abs (lsh (random) -8)) + (length vm-mime-base64-alphabet)))) + (vm-increment i)) + boundary)) + +(defun vm-pgg-save-work (function &rest args) + "Call FUNCTION with ARGS without messing up the composition in case of an error." + (let ((composition-buffer (current-buffer)) + (undo-list-backup buffer-undo-list) + (work-buffer (get-buffer-create " *VM-PGG-WORK*"))) + (save-excursion + (set-buffer work-buffer) + (buffer-disable-undo) + (erase-buffer) + (insert-buffer-substring composition-buffer) + (setq major-mode 'mail-mode) + (apply function args)) + (vm-mail-mode-show-headers) + (erase-buffer) + (insert-buffer-substring work-buffer) + (kill-buffer work-buffer))) + +;;; ###autoload +(defun vm-pgg-sign () + "Sign the composition with PGP/MIME. + +If the composition is not encoded so far, it is encoded before signing. +Signing of already encoded messages is discouraged. + +RFC 2015 and its successor 3156 forbid the use of 8bit encoding for signed +messages, but require to use quoted-printable or base64 instead. Also lines +starting with \"From \" cause trouble and should be quoted. + +Thus signing of encoded messages may cause an error. To avoid this you must +set `vm-mime-8bit-text-transfer-encoding' to something different than 8bit and +`vm-mime-composition-armor-from-lines' to t. + +The transfer encoding done by `vm-pgg-sign' can be controlled by the variable +`vm-pgg-sign-text-transfer-encoding'." + (interactive) + + (when (vm-mail-mode-get-header-contents "MIME-Version:") + ;; do a simple sanity check ... too simple as we should walk the MIME part + ;; hierarchy and only check the MIME headers ... + (goto-char (point-min)) + (when (re-search-forward "Content-Transfer-Encoding:\\s-*8bit" nil t) + (describe-function 'vm-pgg-sign) + (error "Signing is broken for 8bit encoding!")) + (goto-char (point-min)) + (when (re-search-forward "^From\\s-+" nil t) + (describe-function 'vm-pgg-sign) + (error "Signing is broken for lines starting with \"From \"!"))) + + (vm-pgg-save-work 'vm-pgg-sign-internal)) + +(defun vm-pgg-sign-internal () + "Do the signing." + ;; prepare composition + (let ((vm-mime-8bit-text-transfer-encoding + vm-pgg-sign-text-transfer-encoding) + (vm-mime-composition-armor-from-lines t)) + (vm-pgp-prepare-composition)) + + (let ((content-type (vm-mail-mode-get-header-contents "Content-Type:")) + (encoding (vm-mail-mode-get-header-contents "Content-Transfer-Encoding:")) + (boundary (vm-pgg-make-multipart-boundary "pgp+signed")) + (pgg-text-mode t) ;; For GNU Emacs PGG + (micalg "sha1") + entry + body-start) + ;; fix the body + (setq body-start (vm-marker (vm-pgp-goto-body-start))) + (insert "Content-Type: " (or content-type "text/plain") "\n") + (insert "Content-Transfer-Encoding: " (or encoding "7bit") "\n") + (if (not (looking-at "\n")) + (insert "\n")) + ;; now create the signature + (save-excursion + ;; BUGME do we need the CRLF conversion? +; (vm-pgg-make-crlf (point) (point-max)) + (unless (pgg-sign-region body-start (point-max) nil) + (pop-to-buffer pgg-errors-buffer) + (error "Signing error")) + (and (setq entry (assq 2 (pgg-parse-armor + (with-current-buffer pgg-output-buffer + (buffer-string))))) + (setq entry (assq 'hash-algorithm (cdr entry))) + (if (cdr entry) + (setq micalg (downcase (format "%s" (cdr entry))))))) + ;; insert mime part bounderies + (goto-char body-start) + (insert "This is an OpenPGP/MIME signed message (RFC 2440 and 3156)\n") + (insert "--" boundary "\n") + (goto-char (point-max)) + (insert "\n--" boundary "\n") + ;; insert the signature + (insert "Content-Type: application/pgp-signature\n\n") + (goto-char (point-max)) + (insert-buffer-substring pgg-output-buffer) + (insert "\n--" boundary "--\n") + ;; fix the headers + (vm-mail-mode-remove-header "MIME-Version:") + (vm-mail-mode-remove-header "Content-Type:") + (vm-mail-mode-remove-header "Content-Transfer-Encoding:") + (mail-position-on-field "MIME-Version") + (insert "1.0") + (mail-position-on-field "Content-Type") + (insert "multipart/signed; boundary=\"" boundary "\";\n" + "\tmicalg=pgp-" micalg "; protocol=\"application/pgp-signature\""))) + +;;; ###autoload +(defun vm-pgg-encrypt (&optional sign) + "Encrypt the composition as PGP/MIME. With a prefix arg SIGN also sign it." + (interactive "P") + (vm-pgg-save-work 'vm-pgg-encrypt-internal sign)) + +(defun vm-pgg-encrypt-internal (sign) + "Do the encrypting, if SIGN is t also sign it." + (unless (vm-mail-mode-get-header-contents "MIME-Version:") + (if vm-do-fcc-before-mime-encode + (vm-do-fcc-before-mime-encode)) + (vm-mime-encode-composition)) + (let ((content-type (vm-mail-mode-get-header-contents "Content-Type:")) + (encoding (vm-mail-mode-get-header-contents "Content-Transfer-Encoding:")) + (boundary (vm-pgg-make-multipart-boundary "pgp+encrypted")) + (pgg-text-mode t) ;; For GNU Emacs PGG + body-start) + ;; fix the body + (setq body-start (vm-marker (vm-pgp-goto-body-start))) + (insert "Content-Type: " (or content-type "text/plain") "\n") + (insert "Content-Transfer-Encoding: " (or encoding "7bit") "\n") + (insert "\n") + (goto-char (point-max)) + (insert "\n") + (vm-pgg-cleartext-encrypt sign) + (goto-char body-start) + (insert "This is an OpenPGP/MIME encrypted message (RFC 2440 and 3156)\n") + (insert "--" boundary "\n") + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert "--" boundary "\n") + (insert "Content-Type: application/octet-stream\n\n") + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + ;; fix the headers + (vm-mail-mode-remove-header "MIME-Version:") + (vm-mail-mode-remove-header "Content-Type:") + (vm-mail-mode-remove-header "Content-Transfer-Encoding:") + (mail-position-on-field "MIME-Version") + (insert "1.0") + (mail-position-on-field "Content-Type") + (insert "multipart/encrypted; boundary=\"" boundary "\";\n" + "\tprotocol=\"application/pgp-encrypted\""))) + +(defun vm-pgg-sign-and-encrypt () + "*Sign and encrypt the composition as PGP/MIME." + (interactive) + (vm-pgg-encrypt t)) + +(defvar vm-pgg-prompt-last-action nil + "The action last taken in `vm-pgg-prompt-for-action'.") + +(defvar vm-pgg-prompt-action-alist + '((?s sign "Sign") + (?e encrypt "encrypt") + (?E sign-and-encrypt "both") + (?n nil "nothing") + (?q quit "quit")) + "Alist of (KEY ACTION LABEL) elements.") + +(defun vm-pgg-prompt-for-action () + "Prompt for an action and return it. See also `vm-pgg-prompt-action-alist'." + (interactive) + (let (prompt event action) + (setq prompt (mapconcat (lambda (a) + (format "%s (%c)" (nth 2 a) (car a))) + vm-pgg-prompt-action-alist ", ") + action (mapcar (lambda (a) + (if (eq (nth 1 a) + vm-pgg-prompt-last-action) + (downcase (nth 2 a)))) + vm-pgg-prompt-action-alist) + prompt (format "%s (default %s)?" + prompt + (car (delete nil action))) + action nil) + (while (not event) + (setq event (read-key-sequence prompt)) + (if (featurep 'xemacs) + (setq event (event-to-character (aref event 0))) + (setq event (if (stringp event) (aref event 0)))) + (if (eq event ?\r) + (setq action vm-pgg-prompt-last-action) + (setq action (assoc event vm-pgg-prompt-action-alist)) + (if action + (setq action (nth 1 action)) + (setq event nil)))) + (when (eq action 'quit) + (error "Sending aborted!")) + (if action + (message "Action is %s." action) + (message "No action selected.")) + (setq vm-pgg-prompt-last-action action) + action)) + +;;; ###autoload +(defun vm-pgg-ask-hook () + "Hook to automatically ask for signing or encrypting outgoing messages with PGP/MIME. + +Put this function into `vm-mail-send-hook' to be asked each time you +send a message whether or not you want to sign or encrypt the +message. See `vm-pgg-ask-function' to determine which function is +proposed. + +This hook should probably be the last of your hooks if you have several +other functions there. Signing crucially relies on the fact that the +message is not altered afterwards. To put it into `vm-mail-send-hook' +put something like + + (add-hook 'vm-mail-send-hook 'vm-pgg-ask-hook t) + +into your VM init file." + (interactive) + + ;; ensure we are the last hook + (when (and (member 'vm-pgg-ask-hook vm-mail-send-hook) + (cdr (member 'vm-pgg-ask-hook vm-mail-send-hook))) + (describe-function 'vm-pgg-ask-hook) + (error "`vm-pgg-ask-function' must be the last hook in `vm-mail-send-hook'!")) + + (let ((handler vm-pgg-ask-function) + action) + (when handler + (setq action (if (fboundp handler) + (funcall handler) + (if (y-or-n-p (format "%s the composition? " handler)) + handler))) + (when action + (funcall (intern (format "vm-pgg-%s" action))))))) + +(provide 'vm-pgg) + +;;; vm-pgg.el ends here diff --git a/lisp/vm-pine.el b/lisp/vm-pine.el new file mode 100755 index 0000000..f74c3f4 --- /dev/null +++ b/lisp/vm-pine.el @@ -0,0 +1,1115 @@ +;;; vm-pine.el --- draft handling and other neat functions for VM +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 1998-2006 Robert Fenk +;; +;; Author: Robert Fenk +;; Status: Tested with XEmacs 21.4.19 & VM 7.19 +;; Keywords: vm draft handling +;; X-URL: http://www.robf.de/Hacking/elisp + +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; +;; This package provides the following new features for VM: +;; +;; A Pine-like postpone message function and folder. There are two new +;; functions. `vm-postpone-message' bound to [C-c C-d] in +;; the `vm-mail-mode' and the function `vm-continue-postponed-message' +;; is bound to [C] in a folder buffer. +;; +;; Typical usage: If you are writing a mail message, and you wish to +;; postpone it for a while, hit C-c C-d. The message will be saved in +;; a folder called "postponed" by default. Later, when you wish to +;; resume editing that file, visit the "postponed" folder, find the +;; message you wish to continue editing, and then hit C to resume +;; editing. +;; +;; Furthermore, this facility can be configured, using +;; `vm-continue-what-message' to imitate Pine's message composing. +;; You can set `vm-mode-map' in the following way to get Pine-like +;; behaviour: +;; +;; (define-key vm-mode-map "m" 'vm-continue-what-message) +;; (setq vm-zero-drafts-start-compose t) +;; +;; If you have postponed messages you will be asked if you want to continue +;; composing them, if you say "yes" you will visit the `vm-postponed-folder' +;; and you can select the message you would like to continue and press "m" +;; again! However be aware this works currently only if you expunge all +;; messages marked for deletion and save the postponed folder. +;; +;; You can also bind it to "C-x m" in order to check for postponed messages +;; when composing a message without starting VM. +;; +;; (autoload 'vm-continue-what-message-other-window "vm-pine" "" t) +;; (global-set-key "\C-xm" 'vm-continue-what-message-other-window) +;; +;; +;; Three new mail header insertion functions make life easier. The +;; bindings and names are: +;; "\C-c\C-f\C-a" vm-mail-return-receipt-to +;; "\C-c\C-f\C-p" vm-mail-priority +;; "\C-c\C-f\C-f" vm-mail-fcc +;; The variables `vm-mail-return-receipt-to' and `vm-mail-priority' +;; can be used to configure the inserted headers. +;; `vm-mail-fcc' can be configured by setting the variable +;; `vm-mail-folder-alist' which has the same syntax and default +;; value as `vm-auto-folder-alist'. +;; You may also add `vm-mail-auto-fcc' to `vm-reply-hook' in order to +;; automatically setup the FCC header according to the variable +;; `vm-mail-folder-alist'. +;; There is another fcc-function `vm-mail-to-fcc' which set the FCC +;; according to the recipients email-address. +;; +;;; Bug reports and feature requests: +;; Please send a backtrace and the version number of vm-pine.el! +;; Feature requests are welcome! + +;;; Code: + +(provide 'vm-pine) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-minibuf) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-mime) + (require 'vm-reply) + ) + +(declare-function deiconify-frame "vm-xemacs" (&optional frame)) +(declare-function frames-of-buffer "vm-xemacs" + (&optional buffer visible-only)) +(declare-function user-mail-address "vm-xemacs" ()) + +(declare-function vm-session-initialization "vm" ()) +(declare-function vm-visit-folder "vm" (folder &optional read-only)) + +(declare-function bbdb-extract-address-components + "ext:bbdb" (adstring &optional ignore-errors)) +(declare-function bbdb/vm-alternate-full-name "ext:bbdb-vm" (address)) + +(if (not (boundp 'user-mail-address)) + (if (functionp 'user-mail-address) + (setq user-mail-address (user-mail-address)) + (setq user-mail-address "unknown") + (message "Please set the variable `user-mail-address'") + (sit-for 2))) + +; Group already defined in vm-vars.el +;; (defgroup vm nil +;; "VM" +;; :group 'mail) + +(defgroup vm-pine nil + "Pine inspired extensions to VM." + :group 'vm-ext) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defun vm-summary-function-f (m) + "Return the recipient or newsgroup for uninteresting senders. +If the \"From:\" header contains the user login or full name then +this function returns the \"To:\" or \"Newsgroups:\" header field with a +\"To:\" as prefix. + +For example the outgoing message box will now list to whom you sent the +messages. Use `vm-fix-summary' to update the summary of a folder! With +loaded BBDB it uses `vm-summary-function-B' to obtain the full name of the +sender. The only difference to VMs default behavior is the honoring of +messages sent to news groups. ;c) + +See also: `vm-summary-uninteresting-senders'" + (interactive) + (let ((case-fold-search t) + (headers '(("From:" "") + ("Newsgroups:" "News:") + "To:" "CC:" "BCC:" + "Resent-To:" "Resent-CC:" "Resent-BCC:" + ("Sender:" "") ("Resent-From:" "Resent:"))) + header-name arrow + addresses + address + first) + + (while (and (not address) headers) + (if (listp (car headers)) + (setq header-name (caar headers) arrow (cadar headers)) + (setq header-name (car headers) arrow (concat header-name " "))) + (setq addresses (vm-get-header-contents m header-name)) + (if addresses + (setq addresses (vm-decode-mime-encoded-words-in-string addresses) + addresses + (or (if (functionp 'bbdb-extract-address-components) + (bbdb-extract-address-components addresses t)) + (list (mail-extract-address-components addresses)) + addresses))) + (if (not first) (setq first (car addresses))) + (while addresses + (if (or (not vm-summary-uninteresting-senders) + (and vm-summary-uninteresting-senders + (not (string-match vm-summary-uninteresting-senders + (format "%s" (car addresses)))))) + (setq address (car addresses) addresses nil)) + (setq addresses (cdr addresses))) + (setq headers (cdr headers))) + + (if (and (null address) (null first)) + "" + (if (and (null address) first) + (setq address first)) + (concat arrow + (cond ((functionp 'bbdb/vm-alternate-full-name) + (or (bbdb/vm-alternate-full-name (cadr address)) + (car address) + (cadr address))) + (t (or (car address) (cadr address)))))))) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defcustom vm-postponed-header "X-VM-postponed-data: " + "Additional header which is inserted to postponed messages. +It is used for internal things and should not be modified. +It is a lisp list which currently contains the following items: + <date of the postponing> + <reply references list> + <forward references list> + <redistribute references list> +while the last three are set by `vm-get-persistent-message-ids-for'." + :type 'string + :group 'vm-pine) + +;;----------------------------------------------------------------------------- +;; A Pine-like postponed folder handling +;;;###autoload +(defcustom vm-postponed-folder "postponed" + "The name of the folder where postponed messages are saved." + :type 'string + :group 'vm-pine) + +;;;###autoload +(defcustom vm-postponed-message-headers '("From:" "Organization:" + "Reply-To:" + "To:" "Newsgroups:" + "CC:" "BCC:" "FCC:" + "In-Reply-To:" + "References:" + "Subject:" + "X-Priority:" "Priority:") + "Similar to `vm-forwarded-headers'. +A list of headers that should be kept, when continuing a postponed message. + +The following mime headers should not be kept, since this breaks things: +Mime-Version, Content-Type, Content-Transfer-Encoding." + :type '(repeat (string)) + :group 'vm-pine) + +;;;###autoload +(defcustom vm-postponed-message-discard-header-regexp nil + "Similar to `vm-unforwarded-header-regexp'. +A regular expression matching all headers that should be discard when +when continuing a postponed message." + :type 'regexp + :group 'vm-pine) + +;;;###autoload +(defcustom vm-continue-postponed-message-hook nil + "List of hook functions to be run after continuing a postponed message." + :type 'hook + :group 'vm-pine) + +;;;###autoload +(defcustom vm-postpone-message-hook nil + "List of hook functions to be run before postponing a message." + :type 'hook + :group 'vm-pine) + +(defvar vm-postponed-message-folder-buffer nil + "Buffer of source folder. +This is only for internal use of vm-pine.el!!!") + +;;----------------------------------------------------------------------------- +;; (define-key vm-mode-map "C" 'vm-continue-what-message) + +;;----------------------------------------------------------------------------- +(defun vm-get-persistent-message-ids-for (mlist) + "Return a list of message id and folder name of all messages in MLIST." + (let (mp midlist folder mid f) + (while mlist + (setq mp (car mlist) + folder (buffer-file-name (vm-buffer-of (vm-real-message-of mp))) + mid (vm-message-id-of mp) + f (assoc folder midlist)) + (if mid + (if f + (setcdr f (cons mid (cdr f))) + (add-to-list 'midlist (list folder mid)))) + (setq mlist (cdr mlist))) + midlist)) + +(defun vm-get-message-pointers-for (msgidlist) + "Return the message pointers belonging to the messages listed in MSGIDLIST. +MSGIDLIST is a list as returned by `vm-get-persistent-message-ids-for'." + (let (folder vm-message-pointers) + (while msgidlist + (setq folder (caar msgidlist)) + (save-excursion + (when (cond ((get-buffer folder) + (set-buffer (get-buffer folder))) + ((get-file-buffer folder) + (set-buffer (get-file-buffer folder))) + ((file-exists-p folder) + (vm-visit-folder folder)) + (t + (message "The folder '%s' does not exist anymore. Maybe it was virtual or closed before postponing." folder) + nil)) + (vm-select-folder-buffer) + (save-restriction + (widen) + (goto-char (point-min)) + (let ((msgid-regexp (concat "^Message-Id:\\s-*" + (regexp-opt (cdar msgidlist)))) + (point-max (point-max)) + (case-fold-search t)) + + (while (re-search-forward msgid-regexp point-max t) + (let ((point (point)) + (mp vm-message-list)) + (while mp + (if (and (>= point (vm-start-of (car mp))) + (<= point (vm-end-of (car mp)))) + (setq vm-message-pointers (cons (car mp) + vm-message-pointers) + mp nil) + (setq mp (cdr mp))))))))) + (setq msgidlist (cdr msgidlist)))) + vm-message-pointers)) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defun vm-continue-postponed-message (&optional silent) + "Continue composing of the currently selected message. +Before continuing the composition you may decode the presentation as +you like, by pressing [D] and viewing part of the message! +Then current message is copied to a new buffer and the vm-mail-mode is +entered. When every thing is finished the hook functions in +`vm-mail-mode-hook' and `vm-continue-postponed-message-hook' are +executed. When called with a prefix argument it will not switch to +the composition buffer, this may be used for automatic editing of +messages. + +The variables `vm-postponed-message-headers' and +`vm-postponed-message-discard-header-regexp' control which +headers are copied to the composition buffer. + +If optional argument SILENT is positive then act in background (no frame +creation)." + (interactive "P") + + (vm-session-initialization) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + + (if (eq vm-system-state 'previewing) + (vm-show-current-message)) + + (save-restriction + (widen) + (let* ((folder-buffer (current-buffer)) + (presentation-buffer vm-presentation-buffer) + (vmp vm-message-pointer) + (is-decoded vm-mime-decoded) + (hstart (vm-headers-of (car vmp))) + (tstart (vm-text-of (car vmp))) + (tend (- (vm-end-of (car vmp)) 1)) + (to (format "mail to %s" (vm-get-header-contents (car vmp) + "To:" ","))) + (vm-pp-data (vm-get-header-contents (car vmp) + vm-postponed-header))) + + ;; Prepare the composition buffer + (if (and to (string-match "[^,\n<(]+" to)) + (setq to (match-string 0 to))) + + (if (not silent) + (let ((vm-mail-hook nil) + (vm-mail-mode-hook nil) + (this-command 'vm-mail)) + (vm-mail-internal :to to)) + (set-buffer (generate-new-buffer to)) + (setq default-directory (expand-file-name + (or vm-folder-directory "~/"))) + (auto-save-mode (if auto-save-default 1 -1)) + (let ((mail-mode-hook nil) + (mail-setup-hook nil)) + (mail-mode)) + (setq vm-mail-buffer folder-buffer)) + + (make-local-variable 'vm-postponed-message-folder-buffer) + (setq vm-postponed-message-folder-buffer + (vm-buffer-of (vm-real-message-of (car vmp)))) + (make-local-variable 'vm-message-pointer) + (setq vm-message-pointer vmp) + (vm-make-local-hook 'mail-send-hook) + (add-hook 'mail-send-hook 'vm-delete-postponed-message t t) + (erase-buffer) + + ;; set the VM variables for setting source message attributes + (when vm-pp-data + (make-local-variable 'vm-reply-list) + (make-local-variable 'vm-forward-list) + (make-local-variable 'vm-redistribute-list) + (setq vm-pp-data (read vm-pp-data) + vm-reply-list + (and (nth 1 vm-pp-data) (vm-get-message-pointers-for (nth 1 vm-pp-data))) + vm-forward-list + (and (nth 2 vm-pp-data) (vm-get-message-pointers-for (nth 2 vm-pp-data))) + vm-redistribute-list + (and (nth 3 vm-pp-data) (vm-get-message-pointers-for (nth 3 vm-pp-data)))) + (if vm-reply-list (setq vm-system-state 'replying)) + (if vm-forward-list (setq vm-system-state 'forwarding)) + (if vm-redistribute-list (setq vm-system-state 'redistributing))) + + ;; Prepare headers + (insert-buffer-substring folder-buffer hstart tstart) + (goto-char (point-min)) + (cond ((or (vm-mime-plain-message-p (car vmp)) is-decoded) + (vm-reorder-message-headers + nil :keep-list vm-postponed-message-headers + :discard-regexp vm-postponed-message-discard-header-regexp)) + (t ; copy undecoded messages with mime headers + (vm-reorder-message-headers + nil + :keep-list (append '("MIME-Version:" "Content-type:") + vm-postponed-message-headers) + :discard-regexp vm-postponed-message-discard-header-regexp))) + (vm-decode-mime-encoded-words) + (search-forward-regexp "\n\n") + (replace-match (concat "\n" mail-header-separator "\n") t t) + + ;; Add message body as previewed + (goto-char (point-max)) + (if presentation-buffer + ;; when using presentation buffer we have to + (save-excursion + (set-buffer presentation-buffer) + (goto-char (point-min)) + (search-forward-regexp "\n\n") + (setq tstart (match-end 0) + tend (point-max))) + (setq presentation-buffer folder-buffer)) + + (insert-buffer-substring presentation-buffer tstart tend) + ;; in order to show headers hidden by vm-shrunken-headers + (put-text-property (point-min) (point-max) 'invisible nil) + + ;; and add the buttons for attachments + (vm-mime-convert-to-attachment-buttons))) + + (when (not silent) + (run-hooks 'mail-setup-hook) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook)) + + (run-hooks 'vm-continue-postponed-message-hook)) + +;;----------------------------------------------------------------------------- +;;;###autoload +(defun vm-reply-by-continue-postponed-message () + "Like `vm-reply' but preserves attachments." + (interactive) + (let ((vm-continue-postponed-message-hook) + (vm-reply-hook nil) + (vm-mail-mode-hook nil) + (mail-setup-hook nil) + (mail-signature nil) + reply-buffer + start end) + (vm-reply 1) + (save-excursion + (vm-continue-postponed-message t) + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max)) + (forward-char 1) + (setq reply-buffer (current-buffer) + start (point) + end (point-max))) + (goto-char (point-max)) + (insert-buffer-substring reply-buffer start end) + (vm-add-reply-subject-prefix (car vm-message-pointer))) + (run-hooks 'mail-setup-hook) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook) + (run-hooks 'vm-reply-hook)) + +;;----------------------------------------------------------------------------- +(defun vm-delete-postponed-message () + "Delete the source message belonging to the continued composition." + (interactive) + (if vm-message-pointer + (condition-case nil + (let* ((msg (car vm-message-pointer)) + (buffer (vm-buffer-of msg))) + ;; only delete messages which have been postponed by us before + (when (vm-get-header-contents msg vm-postponed-header) + (vm-set-deleted-flag msg t) + (vm-update-summary-and-mode-line)) + ;; in the postponded folder expunge them right now + (when (string= (buffer-name buffer) + (file-name-nondirectory vm-postponed-folder)) + (if (frames-of-buffer buffer t) + (iconify-frame (car (frames-of-buffer buffer)))) + (save-excursion + (switch-to-buffer buffer) + (vm-expunge-folder) + (vm-save-folder) + (when (not vm-message-list) + (let ((this-command 'vm-quit)) + (vm-quit)))))) + (error "Folder buffer closed before deletion of source message.")))) + +;;----------------------------------------------------------------------------- + +;; The following functions have been integrated into vm-mime.el +;; USR, 2011-01-25 + +(defalias 'vm-decode-postponed-mime-message + 'vm-mime-convert-to-attachment-buttons) +(make-obsolete 'vm-decode-postponed-mime-message + 'vm-mime-convert-to-attachment-buttons "8.2.0") + +(defalias 'vm-pine-fake-attachment-overlays + 'vm-mime-re-fake-attachment-overlays) +(make-obsolete 'vm-pine-fake-attachment-overlays + 'vm-mime-re-fake-attachment-overlays "8.2.0") + +(defalias 'vm-decode-postponed-mime-button + 'vm-mime-replace-by-attachment-button) +(make-obsolete 'vm-decode-postponed-mime-button + 'vm-mime-replace-by-attachment-button "8.2.0") + +;;----------------------------------------------------------------------------- +(define-key vm-mail-mode-map "\C-c\C-d" 'vm-postpone-message) + +(defvar vm-postpone-message-modes-to-disable + '(font-lock-mode ispell-minor-mode filladapt-mode auto-fill-mode) + "A list of modes to disable before postponing a message.") + +;;----------------------------------------------------------------------------- +;;;###autoload +(defun vm-postpone-message (&optional folder dont-kill no-postpone-header) + "Save the current composition as a draft. +Before saving the composition the `vm-postpone-message-hook' functions +are executed and it is written into the FOLDER `vm-postponed-folder'. +When called with a prefix argument you will be asked for +the folder. +Optional argument DONT-KILL is positive, then do not kill source message." + (interactive "P") + + (let ((message-buffer (current-buffer)) + folder-buffer + target-type) + + (let (m (modes vm-postpone-message-modes-to-disable)) + (while modes + (setq m (car modes) modes (cdr modes)) + (if (and (boundp m) (symbol-value m)) + (funcall m 0)))) + + (if (and folder (not (stringp folder))) + (setq folder (vm-read-file-name + (format "Postpone to folder (%s): " vm-postponed-folder) + (or vm-folder-directory default-directory) + vm-postponed-folder nil nil + 'vm-folder-history))) + + ;; there is no explicit folder given ... + (if (not folder) + (if vm-postponed-message-folder-buffer + (setq folder (buffer-file-name vm-postponed-message-folder-buffer)) + (setq folder (expand-file-name vm-postponed-folder + (or vm-folder-directory + default-directory))))) + + (if (not folder) + (error "I could not find a folder for postponing messages!")) + + ;; if it is no absolute folder path then prepend the folder directory + (if (not (file-name-absolute-p folder)) + (setq folder (expand-file-name folder + (or vm-folder-directory + default-directory)))) + + ;; Now add possibly missing headers + (goto-char (point-min)) + (vm-mail-mode-show-headers) + (if (not (vm-mail-mode-get-header-contents "From:")) + (let* ((login user-mail-address) + (fullname (user-full-name))) + (cond ((and (eq mail-from-style 'angles) login fullname) + (insert (format "From: %s <%s>\n" fullname login))) + ((and (eq mail-from-style 'parens) login fullname) + (insert (format "From: %s (%s)\n" login fullname))) + (t + (insert (format "From: %s\n" login)))))) + + ;; mime-encode the message if necessary and add "attachment" disposition + (condition-case nil (vm-mime-encode-composition t) (error t)) + + ;; add the current date + (if (not (vm-mail-mode-get-header-contents "Date:")) + (insert "Date: " + (format-time-string "%a, %d %b %Y %H:%M:%S %Z" + (current-time)) + "\n")) + ;; add the postponed header + (vm-mail-mode-remove-header vm-postponed-header) + + (if no-postpone-header nil + (insert vm-postponed-header " " + (format + "(\"%s\" %S %S %S)\n" + (format-time-string "%a, %d %b %Y %T %Z" (current-time)) + (vm-get-persistent-message-ids-for vm-reply-list) + (vm-get-persistent-message-ids-for vm-forward-list) + (vm-get-persistent-message-ids-for vm-redistribute-list)))) + + ;; ensure that the message ends with an empty line! + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (insert "\n\n\n") + + ;; run the hooks + (run-hooks 'vm-postpone-message-hook) + + ;; delete mail header separator + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + nil t) + (delete-region (match-beginning 0) (match-end 0))) + + + (setq folder-buffer (vm-get-file-buffer folder)) + (if folder-buffer + ;; o.k. the folder is already opened + (save-excursion + (set-buffer folder-buffer) + (vm-error-if-folder-read-only) + (let ((buffer-read-only nil)) + (vm-save-restriction + (widen) + (goto-char (point-max)) + (vm-write-string (current-buffer) (vm-leading-message-separator)) + (insert-buffer-substring message-buffer) + (vm-write-string (current-buffer) (vm-trailing-message-separator)) + + (cond ((eq major-mode 'vm-mode) + (vm-increment vm-messages-not-on-disk) + (vm-clear-modification-flag-undos))) + + (vm-check-for-killed-summary) + (vm-assimilate-new-messages) + (vm-update-summary-and-mode-line)))) + ;; well the folder is not visited, so we write to the file + (setq target-type (or (vm-get-folder-type folder) + vm-default-folder-type)) + + (if (eq target-type 'unknown) + (error "Folder `%s' type is unrecognized" folder)) + + (vm-write-string folder (vm-leading-message-separator target-type)) + (write-region (point-min) (point-max) folder t 'quiet) + (vm-write-string folder (vm-trailing-message-separator target-type))) + + ;; delete source message + (vm-delete-postponed-message) + + ;; mess around with the window configuration + (let ((b (current-buffer)) + (this-command 'vm-mail-send-and-exit)) + (cond ((null (buffer-name b));; dead buffer + ;; This improves window configuration behavior in + ;; XEmacs. It avoids taking the folder buffer from + ;; one frame and attaching it to the selected frame. + (set-buffer (window-buffer (selected-window))) + (vm-display nil nil '(vm-mail-send-and-exit) + '(vm-mail-send-and-exit + reading-message + startup))) + (t + (vm-display b nil '(vm-mail-send-and-exit) + '(vm-mail-send-and-exit reading-message startup))))) + + ;; and kill this buffer? + (if dont-kill + (insert (concat "FCC: " folder "\n" mail-header-separator)) + (kill-this-buffer)) + + (if (vm-interactive-p) + (message "Message postponed to folder `%s'" folder)))) + +;;----------------------------------------------------------------------------- +(defun vm-buffer-in-vm-mode () + (member major-mode '(vm-mode vm-virtual-mode + vm-presentation-mode + vm-summary-mode + vm-mail-mode))) + +(defcustom vm-continue-what-message 'ask + "Whether to never continue, ask or always continue postponed messages." + :type '(choice (const :tag "never" nil) + (const ask) + (const continue)) + :group 'vm-pine) + +(defcustom vm-zero-drafts-start-compose nil + "When t and there are no drafts, `vm-continue-what-message' call `vm-mail'." + :type '(choice (const :tag "do nothing" nil) + (const :tag "start new message" t)) + :group 'vm-pine) + +(defun vm-continue-what-message-composing () + "Decide whether to compose a new message or continue a draft. +This checks if the postponed folder contains drafts. +Drafts in other folders are not recognized!" + (save-excursion + (vm-session-initialization) + + (let* ((ppfolder (and vm-postponed-folder + (expand-file-name vm-postponed-folder + (or vm-folder-directory + default-directory)))) + action + buffer) + + (when current-prefix-arg + (setq action 'force-continue)) + + (when (vm-find-composition-buffer) + (setq action 'continue)) + + ;; postponed message in current folder + (when (vm-buffer-in-vm-mode) + (vm-check-for-killed-folder) + (vm-select-folder-buffer) + + (if (and vm-message-pointer + (vm-get-header-contents (vm-real-message-of + (car vm-message-pointer)) + (regexp-quote vm-postponed-header)) + (not (vm-deleted-flag (car vm-message-pointer)))) + (setq action 'continue))) + + ;; postponed message in postponed folder + (when (and (not action) (setq buffer (vm-get-file-buffer ppfolder))) + (if (and (get-buffer-window-list buffer nil 0)) + (when (save-excursion + (set-buffer buffer) + (not (vm-deleted-flag (car vm-message-pointer)))) + (message "Please select a draft!") + (select-window (car (get-buffer-window-list buffer nil 0))) + (if (and vm-xemacs-p (frames-of-buffer buffer)) + (deiconify-frame (car (frames-of-buffer buffer)))) + (setq action 'none)) + (setq action 'visit))) + + ;; visit postponed folder + (when (and (not action) (file-exists-p ppfolder) + (> (nth 7 (file-attributes ppfolder)) 0)) + (setq action 'visit)) + + (if (not action) (setq action 'new)) + + ;; decide what to do + (setq action + (cond ((eq vm-continue-what-message nil) + 'new) + ((eq vm-continue-what-message 'ask) + (if (equal action 'visit) + (if (y-or-n-p + "Continue composition of postponed messages? ") + 'visit + 'new) + action)) + ((eq vm-continue-what-message 'continue) + action) + (t + action)))))) + +;;;###autoload +(defun vm-continue-what-message (&optional where) + "Continue compositions or postponed messages if there are some. + +With a prefix arg, call `vm-continue-postponed-message', i.e. continue the +currently selected message. + +See `vm-continue-what-message' and `vm-zero-drafts-start-compose' for +configuration." + (interactive) + (if where (setq where (concat "-" where))) + (let ((action (vm-continue-what-message-composing)) + (visit (intern (concat "vm-visit-folder" (or where "")))) + (mail (intern (concat "vm-mail" (or where ""))))) + (cond ((equal action 'force-continue) + (vm-continue-postponed-message)) + ((equal action 'continue) + (if (vm-find-composition-buffer) + (vm-continue-composing-message) + (vm-continue-postponed-message))) + ((equal action 'visit) + (funcall visit vm-postponed-folder) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-make-local-hook 'vm-quit-hook) + (add-hook 'vm-quit-hook 'vm-expunge-folder nil t) + (vm-expunge-folder) + (cond ((= (length vm-message-list) 0) + (let ((this-command 'vm-quit)) + (vm-quit)) + (let ((this-command mail)) + (funcall mail))) + ((= (length vm-message-list) 1) + (vm-continue-postponed-message)))) + ((and vm-zero-drafts-start-compose (equal action 'new)) + (let ((this-command mail)) + (funcall mail))) + (t + (message "There are no known drafts."))))) + +;;;###autoload +(defun vm-continue-what-message-other-window () + "Ask for continuing of postponed messages if there are some." + (interactive) + (vm-continue-what-message "other-window")) + +;;;###autoload +(defun vm-continue-what-message-other-frame () + "Ask for continuing of postponed messages if there are some." + (interactive) + (vm-continue-what-message "other-frame")) + +;;----------------------------------------------------------------------------- +;; And now do some cool stuff when killing a mail buffer +;; This was inspired by Uwe Brauer +(defcustom vm-save-killed-message + 'ask + "How `vm-save-killed-message-hook' handles saving of a mail as a draft. +If set to 'ask it will ask whether to save the mail as draft or not. +If set to 'always it will save without asking. +If set to nil it will never save them nor it will ask." + :type '(choice (const ask) + (const always) + (const :tag "never" nil)) + :group 'vm-pine) + +(defcustom vm-save-killed-messages-folder + vm-postponed-folder + "The name of the folder where killed messages are saved." + :type 'string + :group 'vm-pine) + +(defun vm-add-save-killed-message-hook () + (vm-make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'vm-save-killed-message-hook nil t)) + +(defun vm-remove-save-killed-message-hook () + (remove-hook 'kill-buffer-hook 'vm-save-killed-message-hook t)) + +(defun vm-save-killed-message-hook () + (if (or (and (equal vm-save-killed-message 'ask) + (y-or-n-p (format "Save `%s' as draft in folder `%s'? " + (buffer-name) + vm-save-killed-messages-folder))) + (equal vm-save-killed-message 'always)) + (vm-postpone-message vm-save-killed-messages-folder t) + (message "`%s' is gone forever!" (buffer-name)))) + +(add-hook 'vm-mail-mode-hook 'vm-add-save-killed-message-hook) +(add-hook 'mail-send-hook 'vm-remove-save-killed-message-hook) +(add-hook 'vm-postpone-message-hook 'vm-remove-save-killed-message-hook) + +;;----------------------------------------------------------------------------- +;; New header fields +(define-key vm-mail-mode-map "\C-c\C-f\C-a" 'vm-mail-return-receipt-to) +(define-key vm-mail-mode-map "\C-c\C-f\C-p" 'vm-mail-priority) +(define-key vm-mail-mode-map "\C-c\C-f\C-f" 'vm-mail-fcc) +(define-key vm-mail-mode-map "\C-c\C-f\C-n" 'vm-mail-notice-requested-upon-delivery-to) + +;;;###autoload +(defcustom vm-mail-return-receipt-to + (concat (user-full-name) " <" user-mail-address ">") + "The address where return receipts should be sent to." + :type 'string + :group 'vm-pine) + +;;;###autoload +(defun vm-mail-return-receipt-to () + "Insert the \"Return-Receipt-To\" header into a `vm-mail-mode' buffer. +See the variable `vm-mail-return-receipt-to'." + (interactive) + (expand-abbrev) + (save-excursion + (or (mail-position-on-field "Return-Receipt-To" t) + (progn (mail-position-on-field "Subject") + (insert "\nReturn-Receipt-To: " vm-mail-return-receipt-to + "\nRead-Receipt-To: " vm-mail-return-receipt-to + "\nDelivery-Receipt-To: " vm-mail-return-receipt-to)))) + (message "Remove those headers you do not require!")) + +;;;###autoload +(defun vm-mail-notice-requested-upon-delivery-to () + "Notice-Requested-Upon-Delivery-To:" + (interactive) + (expand-abbrev) + (save-excursion + (or (mail-position-on-field "Notice-Requested-Upon-Delivery-To" t) + (progn (mail-position-on-field "Subject") + (insert "\nNotice-Requested-Upon-Delivery-To: " + (let ((to (vm-mail-get-header-contents + "\\(.*-\\)?To:"))) + (if to to ""))))))) + +;;;###autoload +(defcustom vm-mail-priority + "Priority: urgent\nImportance: High\nX-Priority: 1" + "The priority headers." + :type 'string + :group 'vm-pine) + +;;;###autoload +(defun vm-mail-priority () + "Insert priority headers into a `vm-mail-mode' buffer. +See the variable `vm-mail-priority'." + (interactive) + (expand-abbrev) + (save-excursion + (or (mail-position-on-field "Priority" t) + (progn (mail-position-on-field "Subject") + (insert "\n" vm-mail-priority))))) + +;;----------------------------------------------------------------------------- +(if (not vm-xemacs-p) + (defun user-home-directory () + (getenv "HOME"))) + +(defun vm-mail-fcc-file-join (dir file) + "Returns a nice path to a folder." + (let* ((path (expand-file-name file dir))) + (if path + (vm-abbreviate-file-name path) + dir))) + +;;;###autoload +(defcustom vm-mail-folder-alist (if (boundp 'vm-auto-folder-alist) + vm-auto-folder-alist) + "Like `vm-auto-folder-alist' but for outgoing messages. +It should be fed to `vm-mail-select-folder'." + :type 'list + :group 'vm-pine) + +;;;###autoload +(defcustom vm-mail-fcc-default + '(or (vm-mail-select-folder vm-mail-folder-alist) + (vm-mail-to-fcc nil t) + mail-archive-file-name) + "A list which is evaluated to return a folder name. +By reordering the elements of this list or adding own functions you +can control the behavior of vm-mail-fcc and `vm-mail-auto-fcc'. +You may allow a sophisticated decision for the right folder for your +outgoing message." + :type 'list + :group 'vm-pine) + +;;;###autoload +(defun vm-mail-fcc (&optional arg) + "Insert the FCC-header into a `vm-mail-mode' buffer. +Like `mail-fcc', but honors VM variables and offers a default folder +according to `vm-mail-folder-alist'. +Called with prefix ARG it just removes the FCC-header." + (interactive "P") + (expand-abbrev) + + (let ((dir (or vm-folder-directory default-directory)) + (fcc nil) + (folder (vm-mail-mode-get-header-contents "FCC:")) + (prompt nil)) + + (if arg (progn (vm-mail-mode-remove-header "FCC:") + (message "FCC header removed!")) + (save-excursion + (setq fcc (eval vm-mail-fcc-default)) + + ;; cleanup the name + (setq fcc (if fcc (vm-mail-fcc-file-join dir fcc))) + + (setq prompt (if fcc + (format "FCC to folder (%s): " fcc) + "FCC to folder: ")) + + (setq folder (if (and folder (not (file-directory-p folder))) + (file-relative-name folder dir))) + + ;; we got the name so insert it + (vm-mail-mode-remove-header "FCC:") + (setq fcc (vm-read-file-name prompt + dir fcc + nil folder + 'vm-folder-history)) + (setq fcc (vm-mail-fcc-file-join dir fcc)) + (if (file-directory-p fcc) + (error "Folder `%s' in no file, but a directory!" fcc) + (mail-position-on-field "FCC") + (insert fcc)))))) + +;;;###autoload +(defun vm-mail-auto-fcc () + "Add a new FCC field, with file name guessed by `vm-mail-folder-alist'. +You likely want to add it to `vm-reply-hook' by + (add-hook 'vm-reply-hook 'vm-mail-auto-fcc) +or if sure about what you are doing you can add it to mail-send-hook." + (interactive "") + (expand-abbrev) + (save-excursion + (let ((dir (or vm-folder-directory default-directory)) + (fcc nil)) + + (vm-mail-mode-remove-header "FCC:") + (setq fcc (eval vm-mail-fcc-default)) + (if fcc + (if (file-directory-p fcc) + (error "Folder `%s' in no file, but a directory!" fcc) + (progn (mail-position-on-field "FCC") + (insert (vm-mail-fcc-file-join dir fcc)))))))) + +;;;###autoload +(defun vm-mail-select-folder (folder-alist) + "Return a folder according to FOLDER-ALIST for the current message. +This function is a slightly changed version of `vm-auto-select-folder'." + (interactive) + (condition-case error-data + (catch 'match + (let (header tuple-list) + (while folder-alist + (setq header (vm-mail-get-header-contents + (car (car folder-alist)) ", ")) + (if (null header) + () + (setq tuple-list (cdr (car folder-alist))) + (while tuple-list + (if (let ((case-fold-search vm-auto-folder-case-fold-search)) + (string-match (car (car tuple-list)) header)) + ;; Don't waste time eval'ing an atom. + (if (stringp (cdr (car tuple-list))) + (throw 'match (cdr (car tuple-list))) + (let* ((match-data (vm-match-data)) + ;; allow this buffer to live forever + (buf (get-buffer-create " *vm-auto-folder*")) + (result)) + ;; Set up a buffer that matches our cached + ;; match data. + (save-excursion + (set-buffer buf) + (if vm-fsfemacs-mule-p + (set-buffer-multibyte nil)) ; for empty buffer + (widen) + (erase-buffer) + (insert header) + ;; It appears that get-buffer-create clobbers the + ;; match-data. + ;; + ;; The match data is off by one because we matched + ;; a string and Emacs indexes strings from 0 and + ;; buffers from 1. + ;; + ;; Also store-match-data only accepts MARKERS!! + ;; AUGHGHGH!! + (store-match-data + (mapcar + (function (lambda (n) (and n (vm-marker n)))) + (mapcar + (function (lambda (n) (and n (1+ n)))) + match-data))) + (setq result (eval (cdr (car tuple-list)))) + (while (consp result) + (setq result (vm-mail-select-folder result))) + (if result + (throw 'match result)))))) + (setq tuple-list (cdr tuple-list)))) + (setq folder-alist (cdr folder-alist))) + nil )) + (error "Error processing folder-alist: %s" + (prin1-to-string error-data)))) + +;;;###autoload +(defcustom vm-mail-to-regexp "\\([^<\t\n ]+\\)@" + "A regexp matching the part of an email address to use as FCC-folder. +The string enclosed in \"\\\\(\\\\)\" is used as folder name." + :type 'regexp + :group 'vm-pine) + +;;;###autoload +(defcustom vm-mail-to-headers '("To:" "CC:" "BCC:") + "A list of headers for finding the email address to use as FCC-folder." + :type '(repeat (string)) + :group 'vm-pine) + +;;;###autoload +(defun vm-mail-to-fcc (&optional arg return-only) + "Insert a FCC-header into a `vm-mail-mode' buffer. +Like `mail-fcc', but honors VM variables and inserts the first email +address (or the like matched by `vm-mail-to-regexp') found in the headers +listed in `vm-mail-to-headers'. +Called with prefix ARG it just removes the FCC-header. +If optional argument RETURN-ONLY is t just returns FCC." + (interactive "P") + (expand-abbrev) + (let ((fcc nil) + (headers vm-mail-to-headers)) + (if arg (progn (vm-mail-mode-remove-header "FCC:") + (message "FCC header removed!")) + (progn + (while (and (not fcc) headers) + (setq fcc (vm-mail-get-header-contents (car headers))) + (if (and fcc (string-match vm-mail-to-regexp fcc)) + (setq fcc (match-string 1 fcc)) + (setq fcc nil)) + (setq headers (cdr headers))) + (setq fcc (or fcc mail-archive-file-name)) + (if return-only + fcc + (if fcc + (if (file-directory-p fcc) + (error "Folder `%s' in no file, but a directory!" fcc) + (vm-mail-mode-remove-header "FCC:") + (mail-position-on-field "FCC") + (insert (vm-mail-fcc-file-join (or vm-folder-directory + default-directory) + fcc))))))))) + +;;----------------------------------------------------------------------------- +;;; vm-pine.el ends here diff --git a/lisp/vm-pop.el b/lisp/vm-pop.el new file mode 100755 index 0000000..7955cbc --- /dev/null +++ b/lisp/vm-pop.el @@ -0,0 +1,1296 @@ +;;; vm-pop.el --- Simple POP (RFC 1939) client for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1993, 1994, 1997, 1998 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-pop) + +;; For function declarations +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-crypto) + (require 'vm-mime) +) + +(declare-function vm-submit-bug-report + "vm.el" (&optional pre-hooks post-hooks)) +(declare-function open-network-stream + "subr.el" (name buffer host service &rest parameters)) + +(if (fboundp 'define-error) + (progn + (define-error 'vm-cant-uidl "Can't use UIDL") + (define-error 'vm-dele-failed "DELE command failed") + (define-error 'vm-uidl-failed "UIDL command failed")) + (put 'vm-cant-uidl 'error-conditions '(vm-cant-uidl error)) + (put 'vm-cant-uidl 'error-message "Can't use UIDL") + (put 'vm-dele-failed 'error-conditions '(vm-dele-failed error)) + (put 'vm-dele-failed 'error-message "DELE command failed") + (put 'vm-uidl-failed 'error-conditions '(vm-uidl-failed error)) + (put 'vm-uidl-failed 'error-message "UIDL command failed")) + +(defun vm-pop-find-cache-file-for-spec (remote-spec) + "Given REMOTE-SPEC, which is a maildrop specification of a folder on +a POP server, find its cache file on the file system" + ;; Prior to VM 7.11, we computed the cache filename + ;; based on the full POP spec including the password + ;; if it was in the spec. This meant that every + ;; time the user changed his password, we'd start + ;; visiting the wrong (and probably nonexistent) + ;; cache file. + ;; + ;; To fix this we do two things. First, migrate the + ;; user's caches to the filenames based in the POP + ;; sepc without the password. Second, we visit the + ;; old password based filename if it still exists + ;; after trying to migrate it. + ;; + ;; For VM 7.16 we apply the same logic to the access + ;; methods, pop, pop-ssh and pop-ssl and to + ;; authentication method and service port, which can + ;; also change and lead us to visit a nonexistent + ;; cache file. The assumption is that these + ;; properties of the connection can change and we'll + ;; still be accessing the same mailbox on the + ;; server. + + (let ((f-pass (vm-pop-make-filename-for-spec remote-spec)) + (f-nopass (vm-pop-make-filename-for-spec remote-spec t)) + (f-nospec (vm-pop-make-filename-for-spec remote-spec t t))) + (cond ((or (string= f-pass f-nospec) + (file-exists-p f-nospec)) + nil ) + ((file-exists-p f-pass) + ;; try to migrate + (condition-case nil + (rename-file f-pass f-nospec) + (error nil))) + ((file-exists-p f-nopass) + ;; try to migrate + (condition-case nil + (rename-file f-nopass f-nospec) + (error nil)))) + ;; choose the one that exists, password version, + ;; nopass version and finally nopass+nospec + ;; version. + (cond ((file-exists-p f-pass) + f-pass) + ((file-exists-p f-nopass) + f-nopass) + (t + f-nospec)))) + + +;; Our goal is to drag the mail from the POP maildrop to the crash box. +;; just as if we were using movemail on a spool file. +;; We remember which messages we have retrieved so that we can +;; leave the message in the mailbox, and yet not retrieve the +;; same messages again and again. + +;;;###autoload +(defun vm-pop-move-mail (source destination) + (let ((process nil) + (m-per-session vm-pop-messages-per-session) + (b-per-session vm-pop-bytes-per-session) + (handler (vm-find-file-name-handler source 'vm-pop-move-mail)) + (popdrop (or (vm-pop-find-name-for-spec source) + (vm-safe-popdrop-string source))) + (statblob nil) + (can-uidl t) + (msgid (list nil (vm-popdrop-sans-password source) 'uidl)) + (pop-retrieved-messages vm-pop-retrieved-messages) + auto-expunge x + mailbox-count mailbox-size message-size response + n (retrieved 0) retrieved-bytes process-buffer uidl) + (setq auto-expunge + (cond ((setq x (assoc source vm-pop-auto-expunge-alist)) + (cdr x)) + ((setq x (assoc (vm-popdrop-sans-password source) + vm-pop-auto-expunge-alist)) + (cdr x)) + (vm-pop-expunge-after-retrieving + t) + ((member source vm-pop-auto-expunge-warned) + nil) + (t + (vm-warn 1 1 + "Warning: POP folder is not set to auto-expunge") + (setq vm-pop-auto-expunge-warned + (cons source vm-pop-auto-expunge-warned)) + nil))) + (unwind-protect + (catch 'done + (if handler + (throw 'done + (funcall handler 'vm-pop-move-mail source destination))) + (setq process (vm-pop-make-session source)) + (or process (throw 'done nil)) + (setq process-buffer (process-buffer process)) + (save-excursion + (set-buffer process-buffer) + ;; find out how many messages are in the box. + (vm-pop-send-command process "STAT") + (setq response (vm-pop-read-stat-response process) + mailbox-count (nth 0 response) + mailbox-size (nth 1 response)) + ;; forget it if the command fails + ;; or if there are no messages present. + (if (or (null mailbox-count) + (< mailbox-count 1)) + (throw 'done nil)) + ;; loop through the maildrop retrieving and deleting + ;; messages as we go. + (setq n 1 retrieved-bytes 0) + (setq statblob (vm-pop-start-status-timer)) + (vm-set-pop-stat-x-box statblob popdrop) + (vm-set-pop-stat-x-maxmsg statblob mailbox-count) + (while (and (<= n mailbox-count) + (or (not (natnump m-per-session)) + (< retrieved m-per-session)) + (or (not (natnump b-per-session)) + (< retrieved-bytes b-per-session))) + (catch 'skip + (vm-set-pop-stat-x-currmsg statblob n) + (if can-uidl + (condition-case nil + (let (list) + (vm-pop-send-command process (format "UIDL %d" n)) + (setq response (vm-pop-read-response process t)) + (if (null response) + (signal 'vm-cant-uidl nil)) + (setq list (vm-parse response "\\([\041-\176]+\\) *") + uidl (nth 2 list)) + (if (null uidl) + (signal 'vm-cant-uidl nil)) + (setcar msgid uidl) + (when (member msgid pop-retrieved-messages) + (if vm-pop-ok-to-ask + (vm-inform + 6 + "Skipping message %d (of %d) from %s (retrieved already)..." + n mailbox-count popdrop)) + (throw 'skip t))) + (vm-cant-uidl + ;; something failed, so UIDL must not be working. + (if (and (not auto-expunge) + (or (not vm-pop-ok-to-ask) + (not (vm-pop-ask-about-no-uidl popdrop)))) + (progn + (vm-inform 0 "Skipping mailbox %s (no UIDL support)" + popdrop) + (throw 'done (not (equal retrieved 0)))) + ;; user doesn't care, so go ahead and + ;; expunge from the server + (setq can-uidl nil + msgid nil))))) + (vm-pop-send-command process (format "LIST %d" n)) + (setq message-size (vm-pop-read-list-response process)) + (vm-set-pop-stat-x-need statblob message-size) + (if (and (integerp vm-pop-max-message-size) + (> message-size vm-pop-max-message-size) + (progn + (setq response + (if vm-pop-ok-to-ask + (vm-pop-ask-about-large-message + process popdrop message-size n) + 'skip)) + (not (eq response 'retrieve)))) + (progn + (if (eq response 'delete) + (progn + (vm-inform 6 "Deleting message %d..." n) + (vm-pop-send-command process (format "DELE %d" n)) + (and (null (vm-pop-read-response process)) + (throw 'done (not (equal retrieved 0))))) + (if vm-pop-ok-to-ask + (vm-inform 6 "Skipping message %d..." n) + (vm-inform + 5 + "Skipping message %d in %s, too large (%d > %d)..." + n popdrop message-size vm-pop-max-message-size))) + (throw 'skip t))) + (vm-inform 6 "Retrieving message %d (of %d) from %s..." + n mailbox-count popdrop) + (vm-pop-send-command process (format "RETR %d" n)) + (and (null (vm-pop-read-response process)) + (throw 'done (not (equal retrieved 0)))) + (and (null (vm-pop-retrieve-to-target process destination + statblob)) + (throw 'done (not (equal retrieved 0)))) + (vm-inform 6 "Retrieving message %d (of %d) from %s...done" + n mailbox-count popdrop) + (vm-increment retrieved) + (and b-per-session + (setq retrieved-bytes (+ retrieved-bytes message-size))) + (if (and (not auto-expunge) msgid) + (setq pop-retrieved-messages + (cons (copy-sequence msgid) + pop-retrieved-messages)) + ;; Either the user doesn't want the messages + ;; kept in the mailbox or there's no UIDL + ;; support so there's no way to remember what + ;; messages we've retrieved. Delete the + ;; message now. + (vm-pop-send-command process (format "DELE %d" n)) + ;; DELE can't fail but Emacs or this code might + ;; blow a gasket and spew filth down the + ;; connection, so... + (and (null (vm-pop-read-response process)) + (throw 'done (not (equal retrieved 0)))))) + (vm-increment n)) + (not (equal retrieved 0)) )) + (setq vm-pop-retrieved-messages pop-retrieved-messages) + (if (and (eq vm-flush-interval t) (not (equal retrieved 0))) + (vm-stuff-pop-retrieved)) + (and statblob (vm-pop-stop-status-timer statblob)) + (if process + (vm-pop-end-session process))))) + +(defun vm-pop-check-mail (source) + (let ((process nil) + (handler (vm-find-file-name-handler source 'vm-pop-check-mail)) + (retrieved vm-pop-retrieved-messages) + (popdrop (vm-popdrop-sans-password source)) + (count 0) + x response) + (unwind-protect + (save-excursion + (catch 'done + (if handler + (throw 'done + (funcall handler 'vm-pop-check-mail source))) + (setq process (vm-pop-make-session source)) + (or process (throw 'done nil)) + (set-buffer (process-buffer process)) + (vm-pop-send-command process "UIDL") + (setq response (vm-pop-read-uidl-long-response process)) + (if (null response) + ;; server doesn't understand UIDL + nil + (if (null (car response)) + ;; (nil . nil) is returned if there are no + ;; messages in the mailbox. + (progn + (vm-store-folder-totals source '(0 0 0 0)) + (throw 'done nil)) + (while response + (if (not (and (setq x (assoc (cdr (car response)) retrieved)) + (equal (nth 1 x) popdrop) + (eq (nth 2 x) 'uidl))) + (vm-increment count)) + (setq response (cdr response)))) + (vm-store-folder-totals source (list count 0 0 0)) + (throw 'done (not (eq count 0)))) + (vm-pop-send-command process "STAT") + (setq response (vm-pop-read-stat-response process)) + (if (null response) + nil + (vm-store-folder-totals source (list (car response) 0 0 0)) + (not (equal 0 (car response)))))) + (and process (vm-pop-end-session process nil vm-pop-ok-to-ask))))) + +;;;###autoload +(defun vm-expunge-pop-messages () + "Deletes all messages from POP mailbox that have already been retrieved +into the current folder. VM sends POP DELE commands to all the +relevant POP servers to remove the messages." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (if (and (vm-interactive-p) (eq vm-folder-access-method 'pop)) + (error "This command is not meant for POP folders. Use the normal folder expunge instead.")) + (let ((process nil) + (source nil) + (trouble nil) + (delete-count 0) + (vm-global-block-new-mail t) + (vm-pop-ok-to-ask t) + popdrop uidl-alist data mp match) + (unwind-protect + (save-excursion + (setq vm-pop-retrieved-messages + (delq nil vm-pop-retrieved-messages)) + (setq vm-pop-retrieved-messages + (sort vm-pop-retrieved-messages + (function (lambda (a b) + (cond ((string-lessp (nth 1 a) (nth 1 b)) t) + ((string-lessp (nth 1 b) + (nth 1 a)) + nil) + ((string-lessp (car a) (car b)) t) + (t nil)))))) + (setq mp vm-pop-retrieved-messages) + (while mp + (condition-case nil + (catch 'replay + (setq data (car mp)) + (if (not (equal source (nth 1 data))) + (progn + (if process + (progn + (vm-pop-end-session process) + (setq process nil))) + (setq source (nth 1 data)) + (setq popdrop (or (vm-pop-find-name-for-spec source) + (vm-safe-popdrop-string source))) + (condition-case nil + (progn + (vm-inform 6 + "Opening POP session to %s..." popdrop) + (setq process (vm-pop-make-session source)) + (if (null process) + (signal 'error nil)) + (vm-inform 6 + "Expunging messages in %s..." popdrop)) + (error + (vm-warn 0 2 + "Couldn't open POP session to %s, skipping..." + popdrop) + (setq trouble (cons popdrop trouble)) + (while (equal (nth 1 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t))) + (set-buffer (process-buffer process)) + (vm-pop-send-command process "UIDL") + (setq uidl-alist + (vm-pop-read-uidl-long-response process)) + (if (null uidl-alist) + (signal 'vm-uidl-failed nil)))) + (if (setq match (rassoc (car data) uidl-alist)) + (progn + (vm-pop-send-command process + (format "DELE %s" (car match))) + (if (null (vm-pop-read-response process)) + (signal 'vm-dele-failed nil)) + (setcar mp nil) ; side effect!! + (vm-increment delete-count))) + (setq mp (cdr mp))) + (vm-dele-failed + (vm-warn + 0 2 "DELE %s failed on %s, skipping rest of mailbox..." + (car match) popdrop) + (setq trouble (cons popdrop trouble)) + (while (equal (nth 1 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t)) + (vm-uidl-failed + (vm-warn + 0 2 "UIDL %s failed on %s, skipping this mailbox..." + (car match) popdrop) + (setq trouble (cons popdrop trouble)) + (while (equal (nth 1 (car mp)) source) + (setq mp (cdr mp))) + (throw 'replay t)))) + (if trouble + (progn + (set-buffer (get-buffer-create "*POP Expunge Trouble*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert (format "%s POP message%s expunged.\n\n" + (if (zerop delete-count) "No" delete-count) + (if (= delete-count 1) "" "s"))) + (insert "VM had problems expunging messages from:\n") + (nreverse trouble) + (setq mp trouble) + (while mp + (insert " " (car mp) "\n") + (setq mp (cdr mp))) + (setq buffer-read-only t) + (display-buffer (current-buffer))) + (vm-inform 5 "%s POP message%s expunged." + (if (zerop delete-count) "No" delete-count) + (if (= delete-count 1) "" "s")))) + (and process (vm-pop-end-session process))) + (setq vm-pop-retrieved-messages + (delq nil vm-pop-retrieved-messages)))) + +(defun vm-pop-make-session (source) + (let ((process-to-shutdown nil) + process use-ssl use-ssh success + (folder-type vm-folder-type) + (popdrop (or (vm-pop-find-name-for-spec source) + (vm-safe-popdrop-string source))) + (coding-system-for-read (vm-binary-coding-system)) + (coding-system-for-write (vm-binary-coding-system)) + (session-name "POP") + (process-connection-type nil) + greeting timestamp ssh-process + host port auth user pass authinfo + source-list process-buffer source-nopwd) + (unwind-protect + (catch 'done + ;; parse the maildrop + (setq source-list (vm-pop-parse-spec-to-list source)) + ;; remove pop or pop-ssl from beginning of list if + ;; present. + (when (= 6 (length source-list)) + (cond + ((equal "pop-ssl" (car source-list)) + (setq use-ssl t + session-name "POP over SSL") + ;; (when (null vm-stunnel-program) + ;; (error + ;; "vm-stunnel-program must be non-nil to use POP over SSL.")) + ) + ((equal "pop-ssh" (car source-list)) + (setq use-ssh t + session-name "POP over SSH") + (when (null vm-ssh-program) + (error "vm-ssh-program must be non-nil to use POP over SSH.")))) + (setq source-list (cdr source-list))) + (setq host (nth 0 source-list) + port (nth 1 source-list) + auth (nth 2 source-list) + user (nth 3 source-list) + pass (nth 4 source-list) + source-nopwd (vm-popdrop-sans-password source)) + ;; carp if parts are missing + (when (null host) + (error "No host in POP maildrop specification, \"%s\"" + source)) + (when (null port) + (error "No port in POP maildrop specification, \"%s\"" + source)) + (when (string-match "^[0-9]+$" port) + (setq port (string-to-number port))) + (when (null auth) + (error + "No authentication method in POP maildrop specification, \"%s\"" + source)) + (when (null user) + (error "No user in POP maildrop specification, \"%s\"" + source)) + (when (null pass) + (error "No password in POP maildrop specification, \"%s\"" + source)) + (when (equal pass "*") + (setq pass (car (cdr (assoc source-nopwd vm-pop-passwords)))) + (when (and (null pass) + (boundp 'auth-sources) + (fboundp 'auth-source-user-or-password)) + (cond ((and (setq authinfo + (auth-source-user-or-password + '("login" "password") + (vm-pop-find-name-for-spec source) + port)) + (equal user (car authinfo))) + (setq pass (cadr authinfo))) + ((and (setq authinfo + (auth-source-user-or-password + '("login" "password") + host port)) + (equal user (car authinfo))) + (setq pass (cadr authinfo))))) + (while (and (null pass) vm-pop-ok-to-ask) + (setq pass + (read-passwd + (format "POP password for %s: " popdrop))) + (when (equal pass "") + (vm-warn 0 2 "Password cannot be empty") + (setq pass nil))) + (when (null pass) + (vm-inform 0 "Need password for %s" popdrop) + (throw 'done nil)) + ;; get the trace buffer + (setq process-buffer + (vm-make-work-buffer + (vm-make-trace-buffer-name session-name host))) + (save-excursion + (set-buffer process-buffer) + (setq vm-folder-type (or folder-type vm-default-folder-type)) + (buffer-disable-undo process-buffer) + (make-local-variable 'vm-pop-read-point) + ;; clear the trace buffer of old output + (erase-buffer) + ;; Tell MULE not to mess with the text. + (when (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system (vm-binary-coding-system) t)) + (insert "starting " session-name + " session " (current-time-string) "\n") + (insert (format "connecting to %s:%s\n" host port)) + ;; open the connection to the server + (cond (use-ssl + (if (null vm-stunnel-program) + (setq process + (open-network-stream session-name + process-buffer + host port + :type 'tls)) + (vm-setup-stunnel-random-data-if-needed) + (setq process + (apply 'start-process session-name process-buffer + vm-stunnel-program + (nconc (vm-stunnel-configuration-args host + port) + vm-stunnel-program-switches))))) + (use-ssh + (setq process (open-network-stream + session-name process-buffer + "127.0.0.1" + (vm-setup-ssh-tunnel host port)))) + (t + (setq process (open-network-stream session-name + process-buffer + host port)))) + (and (null process) (throw 'done nil)) + (insert-before-markers "connected\n") + (setq vm-pop-read-point (point)) + (vm-process-kill-without-query process) + (when (null (setq greeting (vm-pop-read-response process t))) + (delete-process process) + (throw 'done nil)) + (setq process-to-shutdown process) + ;; authentication + (cond ((equal auth "pass") + (vm-pop-send-command process (format "USER %s" user)) + (and (null (vm-pop-read-response process)) + (throw 'done nil)) + (vm-pop-send-command process (format "PASS %s" pass)) + (unless (vm-pop-read-response process) + + (vm-warn 0 0 "POP password for %s incorrect" popdrop) + (setq vm-pop-passwords + (vm-delete (lambda (pair) + (equal (car pair) source-nopwd)) + vm-pop-passwords)) + ;; don't sleep unless we're running synchronously. + (when vm-pop-ok-to-ask + (sleep-for 2)) + (throw 'done nil)) + (unless (assoc source-nopwd vm-pop-passwords) + (setq vm-pop-passwords (cons (list source-nopwd pass) + vm-pop-passwords))) + (setq success t)) + ((equal auth "rpop") + (vm-pop-send-command process (format "USER %s" user)) + (when (null (vm-pop-read-response process)) + (throw 'done nil)) + (vm-pop-send-command process (format "RPOP %s" pass)) + (when (null (vm-pop-read-response process)) + (throw 'done nil))) + ((equal auth "apop") + (setq timestamp (vm-parse greeting "[^<]+\\(<[^>]+>\\)") + timestamp (car timestamp)) + (when (null timestamp) + (goto-char (point-max)) + (insert-before-markers "<<< ooops, no timestamp found in greeting! >>>\n") + (vm-warn 0 0 "Server of %s does not support APOP" popdrop) + ;; don't sleep unless we're running synchronously + (if vm-pop-ok-to-ask + (sleep-for 2)) + (throw 'done nil)) + (vm-pop-send-command + process + (format "APOP %s %s" + user + (vm-pop-md5 (concat timestamp pass)))) + (unless (vm-pop-read-response process) + (vm-warn 0 0 "POP password for %s incorrect" popdrop) + (when vm-pop-ok-to-ask + (sleep-for 2)) + (throw 'done nil)) + (unless (assoc source-nopwd vm-pop-passwords) + (setq vm-pop-passwords (cons (list source-nopwd pass) + vm-pop-passwords))) + (setq success t)) + (t (error "Don't know how to authenticate using %s" auth))) + (setq process-to-shutdown nil) ))) + ;; unwind-protection + (if process-to-shutdown + (vm-pop-end-session process-to-shutdown t)) + (vm-tear-down-stunnel-random-data)) + (if success + process + ;; try again if possible + (when vm-pop-ok-to-ask + (vm-pop-make-session source))))) + +(defun vm-pop-end-session (process &optional keep-buffer verbose) + "Kill the POP session represented by PROCESS. PROCESS could be +nil or be already closed. If the optional argument KEEP-BUFFER +is non-nil, the process buffer is retained, otherwise it is +killed as well." + (if (and process (memq (process-status process) '(open run)) + (buffer-live-p (process-buffer process))) + (save-excursion + (set-buffer (process-buffer process)) + (vm-pop-send-command process "QUIT") + ;; Previously we did not read the QUIT response because of + ;; TCP shutdown problems (under Windows?) that made it + ;; better if we just closed the connection. Microsoft + ;; Exchange apparently fails to expunge messages if we shut + ;; down the connection without reading the QUIT response. + ;; So we provide an option and let the user decide what + ;; works best for them. + (if vm-pop-read-quit-response + (progn + (and verbose + (vm-inform 5 "Waiting for response to POP QUIT command...")) + (vm-pop-read-response process) + (and verbose + (vm-inform 5 + "Waiting for response to POP QUIT command... done")))))) + (if (and (process-buffer process) + (buffer-live-p (process-buffer process))) + (if (and (null vm-pop-keep-trace-buffer) (not keep-buffer)) + (kill-buffer (process-buffer process)) + (vm-keep-some-buffers (process-buffer process) 'vm-kept-pop-buffers + vm-pop-keep-trace-buffer + "saved "))) + (if (fboundp 'add-async-timeout) + (add-async-timeout 2 'delete-process process) + (run-at-time 2 nil 'delete-process process))) + +(defun vm-pop-stat-timer (o) (aref o 0)) +(defun vm-pop-stat-did-report (o) (aref o 1)) +(defun vm-pop-stat-x-box (o) (aref o 2)) +(defun vm-pop-stat-x-currmsg (o) (aref o 3)) +(defun vm-pop-stat-x-maxmsg (o) (aref o 4)) +(defun vm-pop-stat-x-got (o) (aref o 5)) +(defun vm-pop-stat-x-need (o) (aref o 6)) +(defun vm-pop-stat-y-box (o) (aref o 7)) +(defun vm-pop-stat-y-currmsg (o) (aref o 8)) +(defun vm-pop-stat-y-maxmsg (o) (aref o 9)) +(defun vm-pop-stat-y-got (o) (aref o 10)) +(defun vm-pop-stat-y-need (o) (aref o 11)) + +(defun vm-set-pop-stat-timer (o val) (aset o 0 val)) +(defun vm-set-pop-stat-did-report (o val) (aset o 1 val)) +(defun vm-set-pop-stat-x-box (o val) (aset o 2 val)) +(defun vm-set-pop-stat-x-currmsg (o val) (aset o 3 val)) +(defun vm-set-pop-stat-x-maxmsg (o val) (aset o 4 val)) +(defun vm-set-pop-stat-x-got (o val) (aset o 5 val)) +(defun vm-set-pop-stat-x-need (o val) (aset o 6 val)) +(defun vm-set-pop-stat-y-box (o val) (aset o 7 val)) +(defun vm-set-pop-stat-y-currmsg (o val) (aset o 8 val)) +(defun vm-set-pop-stat-y-maxmsg (o val) (aset o 9 val)) +(defun vm-set-pop-stat-y-got (o val) (aset o 10 val)) +(defun vm-set-pop-stat-y-need (o val) (aset o 11 val)) + +(defun vm-pop-start-status-timer () + (let ((blob (make-vector 12 nil)) + timer) + (setq timer (add-timeout 5 'vm-pop-report-retrieval-status blob 5)) + (vm-set-pop-stat-timer blob timer) + blob )) + +(defun vm-pop-stop-status-timer (status-blob) + (if (vm-pop-stat-did-report status-blob) + (vm-inform 5 "")) + (if (fboundp 'disable-timeout) + (disable-timeout (vm-pop-stat-timer status-blob)) + (cancel-timer (vm-pop-stat-timer status-blob)))) + +(defun vm-pop-report-retrieval-status (o) + (vm-set-pop-stat-did-report o t) + (cond ((null (vm-pop-stat-x-got o)) t) + ;; should not be possible, but better safe... + ((not (eq (vm-pop-stat-x-box o) (vm-pop-stat-y-box o))) t) + ((not (eq (vm-pop-stat-x-currmsg o) (vm-pop-stat-y-currmsg o))) t) + (t (vm-inform 6 "Retrieving message %d (of %d) from %s, %s..." + (vm-pop-stat-x-currmsg o) + (vm-pop-stat-x-maxmsg o) + (vm-pop-stat-x-box o) + (if (vm-pop-stat-x-need o) + (format "%d%s of %d%s" + (vm-pop-stat-x-got o) + (if (> (vm-pop-stat-x-got o) + (vm-pop-stat-x-need o)) + "!" + "") + (vm-pop-stat-x-need o) + (if (eq (vm-pop-stat-x-got o) + (vm-pop-stat-y-got o)) + " (stalled)" + "")) + "post processing")))) + (vm-set-pop-stat-y-box o (vm-pop-stat-x-box o)) + (vm-set-pop-stat-y-currmsg o (vm-pop-stat-x-currmsg o)) + (vm-set-pop-stat-y-maxmsg o (vm-pop-stat-x-maxmsg o)) + (vm-set-pop-stat-y-got o (vm-pop-stat-x-got o)) + (vm-set-pop-stat-y-need o (vm-pop-stat-x-need o))) + +(defun vm-pop-check-connection (process) + (cond ((not (memq (process-status process) '(open run))) + (error "POP connection not open: %s" process)) + ((not (buffer-live-p (process-buffer process))) + (error "POP process %s's buffer has been killed" process)))) + +(defun vm-pop-send-command (process command) + (vm-pop-check-connection process) + (goto-char (point-max)) + (if (= (aref command 0) ?P) + (insert-before-markers "PASS <omitted>\r\n") + (insert-before-markers command "\r\n")) + (setq vm-pop-read-point (point)) + (process-send-string process (format "%s\r\n" command))) + +(defun vm-pop-read-response (process &optional return-response-string) + (vm-pop-check-connection process) + (let ((case-fold-search nil) + match-end) + (goto-char vm-pop-read-point) + (while (not (search-forward "\r\n" nil t)) + (vm-pop-check-connection process) + (accept-process-output process) + (goto-char vm-pop-read-point)) + (setq match-end (point)) + (goto-char vm-pop-read-point) + (if (not (looking-at "+OK")) + (progn (setq vm-pop-read-point match-end) nil) + (setq vm-pop-read-point match-end) + (if return-response-string + (buffer-substring (point) match-end) + t )))) + +(defun vm-pop-read-past-dot-sentinel-line (process) + (vm-pop-check-connection process) + (let ((case-fold-search nil)) + (goto-char vm-pop-read-point) + (while (not (re-search-forward "^\\.\r\n" nil 0)) + (beginning-of-line) + ;; save-excursion doesn't work right + (let ((opoint (point))) + (vm-pop-check-connection process) + (accept-process-output process) + (goto-char opoint))) + (setq vm-pop-read-point (point)))) + +(defun vm-pop-read-stat-response (process) + (let ((response (vm-pop-read-response process t)) + list) + (if (null response) + nil + (setq list (vm-parse response "\\([^ ]+\\) *")) + (list (string-to-number (nth 1 list)) (string-to-number (nth 2 list)))))) + +(defun vm-pop-read-list-response (process) + (let ((response (vm-pop-read-response process t))) + (and response + (string-to-number (nth 2 (vm-parse response "\\([^ ]+\\) *")))))) + +(defun vm-pop-read-uidl-long-response (process) + (vm-pop-check-connection process) + (let ((start vm-pop-read-point) + (list nil) + n uidl) + (catch 'done + (goto-char start) + (while (not (re-search-forward "^\\.\r\n\\|^-ERR .*$" nil 0)) + (beginning-of-line) + ;; save-excursion doesn't work right + (let ((opoint (point))) + (vm-pop-check-connection process) + (accept-process-output process) + (goto-char opoint))) + (setq vm-pop-read-point (point-marker)) + (goto-char start) + ;; no uidl support, bail. + (if (not (looking-at "\\+OK")) + (throw 'done nil)) + (forward-line 1) + (while (not (eq (char-after (point)) ?.)) + ;; not loking at a number, bail. + (if (not (looking-at "[0-9]")) + (throw 'done nil)) + (setq n (int-to-string (read (current-buffer)))) + (skip-chars-forward " ") + (setq start (point)) + (skip-chars-forward "\041-\176") + ;; no tag after the message number, bail. + (if (= start (point)) + (throw 'done nil)) + (setq uidl (buffer-substring start (point))) + (setq list (cons (cons n uidl) list)) + (forward-line 1)) + ;; returning nil means the uidl command failed so don't + ;; return nil if there aren't any messages. + (if (null list) + (cons nil nil) + list )))) + +(defun vm-pop-ask-about-large-message (process popdrop size n) + (let ((work-buffer nil) + (pop-buffer (current-buffer)) + start end) + (unwind-protect + (save-excursion + (save-window-excursion + (vm-pop-send-command process (format "TOP %d %d" n 0)) + (if (vm-pop-read-response process) + (progn + (setq start vm-pop-read-point) + (vm-pop-read-past-dot-sentinel-line process) + (setq end vm-pop-read-point) + (setq work-buffer (generate-new-buffer + (format "*headers of %s message %d*" + popdrop n))) + (set-buffer work-buffer) + (insert-buffer-substring pop-buffer start end) + (forward-line -1) + (delete-region (point) (point-max)) + (vm-pop-cleanup-region (point-min) (point-max)) + (vm-display-buffer work-buffer) + (setq minibuffer-scroll-window (selected-window)) + (goto-char (point-min)) + (if (re-search-forward "^Received:" nil t) + (progn + (goto-char (match-beginning 0)) + (vm-reorder-message-headers + nil :keep-list vm-visible-headers + :discard-regexp vm-invisible-header-regexp))) + (set-window-point (selected-window) (point)))) + (if (y-or-n-p (format "Retrieve message %d (size = %d)? " n size)) + 'retrieve + (if (y-or-n-p (format "Delete message %d from popdrop? " n)) + 'delete + 'skip)))) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-pop-ask-about-no-uidl (popdrop) + (let ((work-buffer nil) + (pop-buffer (current-buffer)) + start end) + (unwind-protect + (save-excursion + (save-window-excursion + (setq work-buffer (generate-new-buffer + (format "*trouble with %s*" popdrop))) + (set-buffer work-buffer) + (insert +"You have asked VM to leave messages on the server for the POP mailbox " +popdrop +". VM cannot do so because the server does not seem to support the POP UIDL command.\n\nYou can either continue to retrieve messages from this mailbox with VM deleting the messages from the server, or you can skip this mailbox, leaving messages on the server and not retrieving any messages.") + (fill-individual-paragraphs (point-min) (point-max)) + (vm-display-buffer work-buffer) + (setq minibuffer-scroll-window (selected-window)) + (yes-or-no-p "Continue retrieving anyway? "))) + (and work-buffer (kill-buffer work-buffer))))) + +(defun vm-pop-retrieve-to-target (process target statblob) + (vm-pop-check-connection process) + (let ((start vm-pop-read-point) end) + (goto-char start) + (vm-set-pop-stat-x-got statblob 0) + (while (not (re-search-forward "^\\.\r\n" nil 0)) + (beginning-of-line) + ;; save-excursion doesn't work right + (let* ((opoint (point)) + (func + (function + (lambda (beg end len) + (if vm-pop-read-point + (progn + (vm-set-pop-stat-x-got statblob (- end start)) + (if (zerop (% (random) 10)) + (vm-pop-report-retrieval-status statblob))))))) + (after-change-functions (cons func after-change-functions))) + (vm-pop-check-connection process) + (accept-process-output process) + (goto-char opoint))) + (vm-set-pop-stat-x-need statblob nil) + (setq vm-pop-read-point (point-marker)) + (goto-char (match-beginning 0)) + (setq end (point-marker)) + (vm-pop-cleanup-region start end) + (vm-set-pop-stat-x-got statblob nil) + ;; Some POP servers strip leading and trailing message + ;; separators, some don't. Figure out what kind we're + ;; talking to and do the right thing. + (if (eq (vm-get-folder-type nil start end) 'unknown) + (progn + (vm-munge-message-separators vm-folder-type start end) + (goto-char start) + ;; avoid the consing and stat() call for all but babyl + ;; files, since this will probably slow things down. + ;; only babyl files have the folder header, and we + ;; should only insert it if the target folder is empty. + (if (and (eq vm-folder-type 'babyl) + (cond ((stringp target) + (let ((attrs (file-attributes target))) + (or (null attrs) (equal 0 (nth 7 attrs))))) + ((bufferp target) + (save-excursion + (set-buffer target) + (zerop (buffer-size)))))) + (let ((opoint (point))) + (vm-convert-folder-header nil vm-folder-type) + ;; if start is a marker, then it was moved + ;; forward by the insertion. restore it. + (setq start opoint) + (goto-char start) + (vm-skip-past-folder-header))) + (insert (vm-leading-message-separator)) + (save-restriction + (narrow-to-region (point) end) + (vm-convert-folder-type-headers 'baremessage vm-folder-type)) + (goto-char end) + (insert-before-markers (vm-trailing-message-separator)))) + (if (stringp target) + ;; Set file type to binary for DOS/Windows. I don't know if + ;; this is correct to do or not; it depends on whether the + ;; the CRLF or the LF newline convention is used on the inbox + ;; associated with this crashbox. This setting assumes the LF + ;; newline convention is used. + (let ((buffer-file-type t) + (selective-display nil)) + (write-region start end target t 0)) + (let ((b (current-buffer))) + (save-excursion + (set-buffer target) + (let ((buffer-read-only nil)) + (insert-buffer-substring b start end))))) + (delete-region start end) + t )) + +(defun vm-pop-cleanup-region (start end) + (setq end (vm-marker end)) + (save-excursion + ;; CRLF -> LF + (if vm-xemacs-mule-p + (progn + ;; we need this otherwise the end marker gets corrupt and + ;; unfortunately decode-coding-region does not return the + ;; length to the decoded region + (decode-coding-region start (1- end) 'undecided-dos) + (goto-char (- end 2)) + (delete-char 1)) + (goto-char start) + (while (and (< (point) end) (search-forward "\r\n" end t)) + (replace-match "\n" t t))) + ;; chop leading dots + (goto-char start) + (while (and (< (point) end) (re-search-forward "^\\." end t)) + (replace-match "" t t) + (forward-char))) + (set-marker end nil)) + +(defun vm-establish-new-folder-pop-session (&optional interactive) + (let ((process (vm-folder-pop-process)) + (vm-pop-ok-to-ask interactive)) + (if (processp process) + (vm-pop-end-session process)) + (setq process (vm-pop-make-session (vm-folder-pop-maildrop-spec))) + (vm-set-folder-pop-process process) + process )) + +(defun vm-pop-get-uidl-data () + (let ((there (make-vector 67 0)) + (process (vm-folder-pop-process))) + (save-excursion + (set-buffer (process-buffer process)) + (vm-pop-send-command process "UIDL") + (let ((start vm-pop-read-point) + n uidl) + (catch 'done + (goto-char start) + (while (not (re-search-forward "^\\.\r\n\\|^-ERR .*$" nil 0)) + (beginning-of-line) + ;; save-excursion doesn't work right + (let ((opoint (point))) + (vm-pop-check-connection process) + (accept-process-output process) + (goto-char opoint))) + (setq vm-pop-read-point (point-marker)) + (goto-char start) + ;; no uidl support, bail. + (if (not (looking-at "\\+OK")) + (throw 'done nil)) + (forward-line 1) + (while (not (eq (char-after (point)) ?.)) + ;; not loking at a number, bail. + (if (not (looking-at "[0-9]")) + (throw 'done nil)) + (setq n (int-to-string (read (current-buffer)))) + (skip-chars-forward " ") + (setq start (point)) + (skip-chars-forward "\041-\176") + ;; no tag after the message number, bail. + (if (= start (point)) + (throw 'done nil)) + (setq uidl (buffer-substring start (point))) + (set (intern uidl there) n) + (forward-line 1)) + there ))))) + +(defun vm-pop-get-synchronization-data () + (let ((here (make-vector 67 0)) + (there (vm-pop-get-uidl-data)) + (process (vm-folder-pop-process)) + retrieve-list expunge-list + mp) + (setq mp vm-message-list) + (while mp + (if (null (vm-pop-uidl-of (car mp))) + nil + (set (intern (vm-pop-uidl-of (car mp)) here) (car mp)) + (if (not (boundp (intern (vm-pop-uidl-of (car mp)) there))) + (setq expunge-list (cons (car mp) expunge-list)))) + (setq mp (cdr mp))) + (mapatoms (function + (lambda (sym) + (if (and (not (boundp (intern (symbol-name sym) here))) + (not (assoc (symbol-name sym) + vm-pop-retrieved-messages))) + (setq retrieve-list (cons + (cons (symbol-name sym) + (symbol-value sym)) + retrieve-list))))) + there) + (list retrieve-list expunge-list))) + +;;;###autoload +(defun* vm-pop-synchronize-folder (&optional + &key (interactive nil) + (do-remote-expunges nil) + (do-local-expunges nil) + (do-retrieves nil)) + (if (and do-retrieves vm-block-new-mail) + (error "Can't get new mail until you save this folder.")) + (if (or vm-global-block-new-mail + (null (vm-establish-new-folder-pop-session interactive))) + nil + (if do-retrieves + (vm-assimilate-new-messages)) + (let* ((sync-data (vm-pop-get-synchronization-data)) + (retrieve-list (car sync-data)) + (local-expunge-list (nth 1 sync-data)) + (process (vm-folder-pop-process)) + (n 1) + (statblob nil) + (popdrop (vm-folder-pop-maildrop-spec)) + (safe-popdrop (or (vm-pop-find-name-for-spec popdrop) + (vm-safe-popdrop-string popdrop))) + r-list mp got-some message-size + (folder-buffer (current-buffer))) + (if (and do-retrieves retrieve-list) + (save-excursion + (vm-save-restriction + (widen) + (goto-char (point-max)) + (condition-case error-data + (save-excursion + (set-buffer (process-buffer process)) + (setq statblob (vm-pop-start-status-timer)) + (vm-set-pop-stat-x-box statblob safe-popdrop) + (vm-set-pop-stat-x-maxmsg statblob + (length retrieve-list)) + (setq r-list retrieve-list) + (while r-list + (vm-set-pop-stat-x-currmsg statblob n) + (vm-pop-send-command process (format "LIST %s" + (cdr (car r-list)))) + (setq message-size (vm-pop-read-list-response process)) + (vm-set-pop-stat-x-need statblob message-size) + (vm-pop-send-command process + (format "RETR %s" + (cdr (car r-list)))) + (and (null (vm-pop-read-response process)) + (error "server didn't say +OK to RETR %s command" + (cdr (car r-list)))) + (vm-pop-retrieve-to-target process folder-buffer + statblob) + (setq r-list (cdr r-list) + n (1+ n)))) + (error + (vm-warn 0 2 "Retrieval from %s signaled: %s" safe-popdrop + error-data)) + (quit + (vm-inform 0 "Quit received during retrieval from %s" + safe-popdrop))) + (and statblob (vm-pop-stop-status-timer statblob)) + ;; to make the "Mail" indicator go away + (setq vm-spooled-mail-waiting nil) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line) + (setq mp (vm-assimilate-new-messages :read-attributes nil)) + (setq got-some mp) + (if got-some + (vm-increment vm-modification-counter)) + (setq r-list retrieve-list) + (while mp + (vm-set-pop-uidl-of (car mp) (car (car r-list))) + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp) + r-list (cdr r-list)))))) + (if do-local-expunges + (vm-expunge-folder :quiet t :just-these-messages local-expunge-list)) + (if (and do-remote-expunges + vm-pop-messages-to-expunge) + (let ((process (vm-folder-pop-process))) + ;; POP servers usually allow only one remote accessor + ;; at a time vm-expunge-pop-messages will set up its + ;; own connection so we get out of its way by closing + ;; our connection. + (if (and (processp process) + (memq (process-status process) '(open run))) + (vm-pop-end-session process)) + (setq vm-pop-retrieved-messages + (mapcar (function (lambda (x) (list x popdrop 'uidl))) + vm-pop-messages-to-expunge)) + (vm-expunge-pop-messages) + ;; Any messages that could not be expunged will be + ;; remembered for future + (setq vm-pop-messages-to-expunge + (mapcar (function (lambda (x) (car x))) + vm-pop-retrieved-messages)))) + got-some))) + +;;;###autoload +(defun vm-pop-folder-check-mail (&optional interactive) + "Check if there is new mail on the POP server for the current POP +folder. + +Optional argument INTERACTIVE says whether this function is being +called from an interactive use of a command." + (if (or vm-global-block-new-mail + (null (vm-establish-new-folder-pop-session interactive))) + nil + (let ((result (car (vm-pop-get-synchronization-data)))) + (vm-pop-end-session (vm-folder-pop-process)) + result ))) +(defalias 'vm-pop-folder-check-for-mail 'vm-pop-folder-check-mail) +(make-obsolete 'vm-pop-folder-check-for-mail + 'vm-pop-folder-check-mail "8.2.0") + + +;;;###autoload +(defun vm-pop-find-spec-for-name (name) + "Returns the full maildrop specification of a short name NAME." + (let ((list vm-pop-folder-alist) + (done nil)) + (while (and (not done) list) + (if (equal name (nth 1 (car list))) + (setq done t) + (setq list (cdr list)))) + (and list (car (car list))))) + +;;;###autoload +(defun vm-pop-find-name-for-spec (spec) + "Returns the short name of a POP maildrop specification SPEC." + (let ((list vm-pop-folder-alist) + (done nil)) + (while (and (not done) list) + (if (equal spec (car (car list))) + (setq done t) + (setq list (cdr list)))) + (and list (nth 1 (car list))))) + +;;;###autoload +(defun vm-pop-find-name-for-buffer (buffer) + (let ((list vm-pop-folder-alist) + (done nil)) + (while (and (not done) list) + (if (eq buffer (vm-get-file-buffer (vm-pop-make-filename-for-spec + (car (car list))))) + (setq done t) + (setq list (cdr list)))) + (and list (nth 1 (car list))))) + +;;;###autoload +(defun vm-pop-make-filename-for-spec (spec &optional scrub-password scrub-spec) + "Returns a cache file name appropriate for the POP maildrop +specification SPEC." + (let (md5 list) + (if (and (null scrub-password) (null scrub-spec)) + nil + (setq list (vm-pop-parse-spec-to-list spec)) + (setcar (vm-last list) "*") ; scrub password + (if scrub-spec + (progn + (cond ((= (length list) 6) + (setcar list "pop") ; standardise protocol name + (setcar (nthcdr 2 list) "*") ; scrub port number + (setcar (nthcdr 3 list) "*")) ; scrub auth method + (t + (setq list (cons "pop" list)) + (setcar (nthcdr 2 list) "*") + (setcar (nthcdr 3 list) "*"))))) + (setq spec (mapconcat (function identity) list ":"))) + (setq md5 (vm-md5-string spec)) + (expand-file-name (concat "pop-cache-" md5) + (or vm-pop-folder-cache-directory + vm-folder-directory + (getenv "HOME"))))) + +(defun vm-pop-parse-spec-to-list (spec) + (if (string-match "\\(pop\\|pop-ssh\\|pop-ssl\\)" spec) + (vm-parse spec "\\([^:]+\\):?" 1 5) + (vm-parse spec "\\([^:]+\\):?" 1 4))) + + +(defun vm-pop-start-bug-report () + "Begin to compose a bug report for POP support functionality." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (setq vm-kept-pop-buffers nil) + (setq vm-pop-keep-trace-buffer 20)) + +(defun vm-pop-submit-bug-report () + "Submit a bug report for VM's POP support functionality. +It is necessary to run vm-pop-start-bug-report before the problem +occurrence and this command after the problem occurrence, in +order to capture the trace of POP sessions during the occurrence." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (or vm-pop-keep-trace-buffer + (y-or-n-p "Did you run vm-pop-start-bug-report earlier? ")) + (vm-inform 5 "Thank you. Preparing the bug report... ") + (vm-inform 1 "Consider running vm-pop-start-bug-report before the problem occurrence")) + (let ((process (vm-folder-pop-process))) + (if process + (vm-pop-end-session process))) + (let ((trace-buffer-hook + (lambda () + (let ((bufs vm-kept-pop-buffers) + buf) + (insert "\n\n") + (insert "POP Trace buffers - most recent first\n\n") + (while bufs + (setq buf (car bufs)) + (insert "----") + (insert (format "%s" buf)) + (insert "----------\n") + (insert (save-excursion + (set-buffer buf) + (buffer-string))) + (setq bufs (cdr bufs))) + (insert "--------------------------------------------------\n")) + ))) + (vm-submit-bug-report nil (list trace-buffer-hook)) + )) + +(defun vm-pop-set-default-attributes (m) + (vm-set-headers-to-be-retrieved-of m nil) + (vm-set-body-to-be-retrieved-of m nil) + (vm-set-body-to-be-discarded-of m nil)) + + +;;; vm-pop.el ends here diff --git a/lisp/vm-ps-print.el b/lisp/vm-ps-print.el new file mode 100755 index 0000000..3f04bd4 --- /dev/null +++ b/lisp/vm-ps-print.el @@ -0,0 +1,449 @@ +;;; vm-ps-print.el --- PS-printing functions for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1999 Robert Fenk +;; +;; Author: Robert Fenk +;; Status: Tested with XEmacs 21.4.15 & VM 7.18 +;; Keywords: extensions, vm, ps-print +;; X-URL: http://www.robf.de/Hacking/elisp +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; +;; There are three new user functions for generating postscript output: +;; vm-ps-print-message +;; vm-ps-print-each-message +;; vm-ps-print-message-preview +;; The first one prints like vm-ps-print, but multiple messages are +;; concatenated to one printout. In contrast to this the second +;; function creates one print job for each message. Finally the the +;; third one prints the current message as displayed in the +;; presentation buffer -- the other two functions do their own MIME +;; decoding therefore messages are always display in their default +;; appearance. +;; +;; To use these functions you should put this file into your load-path +;; and add the following lines to your .vm file: +;; +;; (require 'vm-ps-print) +;; +;; To redefine the default VM settings for the tool bar and menu add +;; the following line. The default is to use `vm-ps-print-message', +;; but if you use an optional non nil argument you will get +;; `vm-ps-print-each-message' as print function. +;; +;; (vm-ps-print-message-infect-vm) +;; +;; This will refine the default VM settings and from now on you should +;; be able to print to your postscript printer by using the usual VM +;; commands. +;; Of course you still have to set `lpr-command' and `lpr-switches' or +;; `ps-lpr-command' and `ps-lpr-switches' to reasonable values! +;; +;;; Code: + +(provide 'vm-ps-print) + +(eval-when-compile + (require 'ps-print) + + (require 'vm-save) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-mime)) + +(declare-function vm-marked-messages "vm-mark" ()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; group already defined in vm-vars.el +;; (defgroup vm nil +;; "VM" +;; :group 'mail) + +;; (defgroup vm-psprint nil +;; "The VM ps-print lib" +;; :group 'vm) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defcustom vm-ps-print-message-function 'ps-print-buffer-with-faces + "*This should point to the function which is used for ps-printing. +The function should accept one optional argument which is a filename." + :group 'vm-print + :type 'function) + +;;;###autoload +(defcustom vm-ps-print-message-separater "\n" + "*The separator between messages when printing multiple messages." + :group 'vm-print + :type 'string) + +;;;###autoload +(defcustom vm-ps-print-message-font-size 10 + "*The font size for the PS-output of the message text." + :group 'vm-print + :type 'integer) + +;;---------------------------------------------------------------------------- + +;;;###autoload +(defcustom vm-ps-print-message-header-lines 2 + "*See `ps-header-lines'." + :group 'vm-print + :type 'integer) + +;;;###autoload +(defcustom vm-ps-print-message-left-header + '(list (format "(Folder `%s')" folder-name) + (format "(%d message%s printed)" mcount (if (= mcount 1) "" "s"))) + "*This variable should contain a command returning a valid `ps-left-header'." + :group 'vm-print + :type 'sexp) + +;;;###autoload +(defcustom vm-ps-print-message-right-header + '(list"/pagenumberstring load" 'dd-mon-yyyy) + "*This variable should contain a command returning a valid `ps-right-header'. +The defaults to the number of pages and the date of the printout." + :group 'vm-print + :type 'sexp) + +;;;###autoload +(defcustom vm-ps-print-message-summary-format + (concat "******************************************************************************\n" + (if (boundp 'vm-summary-format) + vm-summary-format + "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c %I\"%s\"\n") + "******************************************************************************\n") + "*The summary line before a message. +See `vm-summary-format' for a description of the conversion specifiers." + :group 'vm-print + :type 'string) + +;;---------------------------------------------------------------------------- +;;;###autoload +(defcustom vm-ps-print-each-message-header-lines 2 + "*See `ps-header-lines'." + :group 'vm-print + :type 'integer) + +;;;###autoload +(defcustom vm-ps-print-each-message-left-header + '(list (format "(Folder `%s')" folder-name) + (format "(%s)" (vm-ps-print-tokenized-summary msg (vm-summary-sprintf vm-ps-print-each-message-summary-format msg t)))) + "*This command should return a valid `ps-left-header'. +The default is to have the folder name and a summary according to the +variable `vm-ps-print-each-message-summary-format' in the left header." + :group 'vm-print + :type 'sexp) + +;;;###autoload +(defcustom vm-ps-print-each-message-right-header + '(list "/pagenumberstring load" 'dd-mon-yyyy) + "*This variable should contain a command returning a valid `ps-right-header'. +The defaults to the number of pages and the date of the printout." + :group 'vm-print + :type 'sexp) + +;;;###autoload +(defcustom vm-ps-print-each-message-summary-format + "Message# %n, Lines %l, Characters %c" + "*The summary line for the postscript header. +See `vm-summary-format' for a description of the conversion specifiers." + :group 'vm-print + :type 'string) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-ps-print-message-internal (filename each folder-name mcount msg) + "This function does the actual call to the ps-printing function. +This is not a function to call interactively! + +If the customization of headers is insufficient, then you may want +to modify this function. If FILENAME is a string, then the output is +written to that file. If EACH is t then create a new johb for each +message. FOLDER-NAME specifies the folder name which is displayed in +the header line and MCOUNT is the number of messages to print, while +MSG is a VM message pointer. + +See: `vm-ps-print-message-function'" + (let* ((dd-mon-yyyy (format-time-string "%d %b %Y %T" (current-time))) + (ps-left-header (if each (eval vm-ps-print-each-message-left-header) + (eval vm-ps-print-message-left-header))) + (ps-right-header (if each (eval vm-ps-print-each-message-right-header) + (eval vm-ps-print-message-right-header))) + (ps-header-lines (if each vm-ps-print-each-message-header-lines + vm-ps-print-each-message-header-lines)) + (ps-print-header-frame t) + (ps-font-size vm-ps-print-message-font-size)) +; (setq filename (expand-file-name "~/mail.ps")) + (funcall vm-ps-print-message-function filename) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-ps-print-tokenized-summary (message tokens) + "Return the summary string for MESSAGE according to the format in TOKENS. +Like `vm-tokenized-summary-insert'." + (if (stringp tokens) + tokens + (let (token summary) + (while tokens + (setq token (car tokens)) + (cond ((stringp token) + (if vm-display-using-mime + (setq summary + (concat summary + (vm-decode-mime-encoded-words-in-string token))) + (setq summary (concat summary token)))) + ((eq token 'number) + (setq summary (concat summary (vm-padded-number-of message)))) + ((eq token 'mark) + (setq summary (concat summary (vm-su-mark message)))) + ((eq token 'thread-indent) + (if (and vm-summary-show-threads + (natnump vm-summary-thread-indent-level)) + (setq summary (concat summary + ?\ (* vm-summary-thread-indent-level + (vm-thread-indentation message))))))) + (setq tokens (cdr tokens))) + summary))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-ps-print-message-folder-name () + "Return a nice folder name, without complete path." + (let* ((folder-name (or (buffer-file-name) (buffer-name))) + (folder-name + (if (and vm-folder-directory + (string-match (concat (regexp-quote (expand-file-name + vm-folder-directory)) + "/?\\(.+\\)") + folder-name)) + (substring folder-name (match-beginning 1) (match-end 2)) + folder-name))) + folder-name)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-ps-print-message (&optional count filename each) + "PS-Print the current message. + +A positive COUNT arg N means print the current message and the next +N-1 messages and a negative one print the current message and the +previous N-1 messages. + +If FILENAME is specified then write PS into that file. + +When printing a single message it acts like `vm-ps-print-each-message'. +When printing multiple messages it will insert a summary line according +to the variable `vm-ps-print-message-summary-format' and a separator +according to the variable `vm-ps-print-message-separater' between +messages. You might force the printing of one job per message, by +giving a t EACH argument. + +See: `vm-ps-print-message-function' + `vm-ps-print-message-font-size' + `vm-ps-print-message-summary-format' + `vm-ps-print-message-separater' + `vm-ps-print-message-left-header' + `vm-ps-print-message-right-header' +for customization of the output." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (or count (setq count 1)) + + (let* ((vm-summary-enable-faces nil) + (folder-name (vm-ps-print-message-folder-name)) + (mstart nil) + (m nil) + (mlist (vm-select-operable-messages + count (vm-interactive-p) "Print")) + (mcount (length mlist)) + (tmpbuf (get-buffer-create "*vm-ps-print*"))) + (vm-retrieve-operable-messages count mlist) + + (set-buffer tmpbuf) + (setq major-mode 'vm-mode) + (erase-buffer) + (if (= mcount 1) (setq each 1)) + + (while mlist + (setq m (vm-real-message-of (car mlist))) + (if (not each) + (vm-tokenized-summary-insert + m (vm-summary-sprintf vm-ps-print-message-summary-format m t))) + (setq mstart (point-max)) + (vm-insert-region-from-buffer + (vm-buffer-of m) (vm-vheaders-of m) (vm-end-of m)) + (vm-reorder-message-headers + nil :keep-list vm-visible-headers + :discard-regexp vm-invisible-header-regexp) + (vm-decode-mime-encoded-words) + (goto-char mstart) + (re-search-forward "\n\n") ;; skip headers + (if (not (vm-mime-plain-message-p m)) + (progn (vm-decode-mime-layout (vm-mm-layout m)) + (delete-region (point) (point-max)))) + (narrow-to-region mstart (point-max)) + (vm-energize-urls) + (vm-highlight-headers) + (widen) + (goto-char (point-max)) + (if each + (progn (save-excursion + (vm-ps-print-message-internal filename t folder-name + mcount m)) + (set-buffer tmpbuf) + (erase-buffer)) + (if (> (length mlist) 1) (insert vm-ps-print-message-separater))) + (setq mlist (cdr mlist))) + + (if (not each) + (vm-ps-print-message-internal filename nil folder-name mcount nil)) + (kill-buffer tmpbuf) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-ps-print-each-message (&optional count filename) + "PS-Print the current message. +A positive COUNT arg N means print the current message and the next +N-1 messages and a negative one print the current message and the +previous N-1 messages. + +If FILENAME is specified then write PS into that file. + +This function acts like `vm-ps-print-message', but it will generate a +separate print job for each message and it does not generate the +summary lines between messages. + +See: `vm-ps-print-message-function' + `vm-ps-print-message-font-size' + `vm-ps-print-each-message-separater' + `vm-ps-print-each-message-left-header' + `vm-ps-print-each-message-right-header' + `vm-ps-print-each-message-summary-format' +for customization of the output." + (interactive "p") + (vm-ps-print-message count filename t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-ps-print-message-presentation (&optional filename) + "PS-Print the currently presented message. +When called with a numeric prefix argument, prompts the user for the +name of a file to save the PostScript image in, instead of sending it +to the printer. + +More specifically, the FILENAME argument is treated as follows: if it +is nil, send the image to the printer. If FILENAME is a string, save +the PostScript image in a file with that name. If FILENAME is a +number, prompt the user for the name of the file to save in. + +See: `vm-ps-print-message-function' + `vm-ps-print-message-font-size' + `vm-ps-print-each-message-separater' + `vm-ps-print-each-message-left-header' + `vm-ps-print-each-message-right-header' + `vm-ps-print-each-message-summary-format' +for customization of the output." + (interactive (list (ps-print-preprint current-prefix-arg))) + (save-excursion + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + + (let ((folder-name (vm-ps-print-message-folder-name)) + (mcount 1) + (msg (car vm-message-pointer))) + + (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer)) + (set-buffer (symbol-value 'vm-mail-buffer))) + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (vm-ps-print-message-internal filename t folder-name mcount msg) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-ps-print-message-fix-menu (menu each) + "Fix VM-menu MENU. +If EACH it t, then replace `vm-print-message' by +'vm-ps-print-each-message', otherwise by `vm-ps-print-message'." + (let ((tmpbuf (get-buffer-create "*vm-ps-print*"))) + (save-excursion + (set-buffer tmpbuf) + (erase-buffer) + (insert (format "(setq %s '%S)" (symbol-name menu) (symbol-value menu))) + (if (re-search-backward "vm-\\(ps-\\)?print-\\(each-\\)?message" + (point-min) t) + (if each (replace-match "vm-print-each-message") + (replace-match "vm-ps-print-message"))) + (eval-buffer) + (kill-buffer tmpbuf) + ))) + +;;;###autoload +(defun vm-ps-print-message-infect-vm (&optional each) + "Call this function to hook the ps-printing functions into VM. +Arranges that the usual VM printing commands in menus and the toolbar +use `vm-ps-print-message' or `vm-ps-print-each-message' (when EACH is +t) instead of `vm-print-message'." + (interactive) + (if each (fset 'vm-toolbar-print-command 'vm-ps-print-each-message) + (fset 'vm-toolbar-print-command 'vm-ps-print-message)) + (require 'vm-version) + (require 'vm-menu) + (vm-ps-print-message-fix-menu 'vm-menu-dispose-menu each) + (vm-ps-print-message-fix-menu 'vm-menu-vm-menu each) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; From: "Jeffrey J. Kosowsky" <jeff.kosowsky_ATsign_verizon_DOTsymbol_net> +;;;###autoload +(defun vm-ps-print-marked (&optional filename seperate nup color) + "Postscript print all marked emails in mail Summary. If no messages marked, +print just the current message. +Optionally write postscript output to FILENAME (default is to spool +to printer). +Optionally force SEPERATE printing of each message by setting to 't'. +Optionally also print NUP pages per sheet. +Optionally also print in COLOR by setting to non-nil. + +Note when run interactively setting a positive prefix number prints +NUP pages per sheet to the printer, while negative number prints NUP +pages per sheet to queried FILENAME. No prefix prints 1 page per sheet +to printer while prefix without numerical argument simply queries for +filename and formats 1 page per sheet. (JJK)" + (interactive + (if (and (integerp current-prefix-arg) (plusp current-prefix-arg)) + nil + (list (ps-print-preprint current-prefix-arg)))) + (let ((last-command) + (ps-print-color-p color) + (ps-n-up-printing + (cond + (nup nup) + ((integerp current-prefix-arg) (abs current-prefix-arg)) + (t 1))) ; default 1 page per sheet + ) + (and (vm-marked-messages) + (setq last-command 'vm-next-command-uses-marks)) + (vm-ps-print-message nil filename seperate))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; vm-ps-print.el ends here diff --git a/lisp/vm-reply.el b/lisp/vm-reply.el new file mode 100755 index 0000000..add837f --- /dev/null +++ b/lisp/vm-reply.el @@ -0,0 +1,2164 @@ +;;; vm-reply.el --- Mailing, forwarding, and replying commands +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: + +;;; Interface: +;; Interactive commands: +;; +;; vm-yank-message: (message) -> unit +;; vm-yank-message-other-folder: (folder) -> unit +;; vm-mail-send-and-exit: () -> unit +;; vm-mail-send: () -> unit +;; vm-do-fcc-before-mime-encode: () -> unit +;; vm-reply: (count) -> unit +;; vm-reply-other-frame: (count) -> unit +;; vm-reply-include-text: (count) -> unit +;; vm-reply-include-text-other-frame: (count) -> unit +;; vm-followup: (count) -> unit +;; vm-followup-other-frame: (count) -> unit +;; vm-followup-include-text: (count) -> unit +;; vm-followup-include-text-other-frame: (count) -> unit +;; vm-forward-message: (&optional bool message-list) -> unit +;; vm-forward-message-plain: () -> unit +;; vm-forward-message-other-frame: () -> unit +;; vm-forward-message-plain-other-frame: () -> unit +;; vm-forward-message-all-headers: () -> unit +;; vm-forward-message-all-headers-other-frame: () -> unit +;; vm-resend-message: () -> unit +;; vm-resend-message-other-frame: () -> unit +;; vm-resend-bounced-message: () -> unit +;; vm-resend-bounced-message-other-frame: () -> unit +;; vm-send-digest: (&optional preamble-line list) -> unit +;; vm-send-digest-other-frame: (&optional preamble-line list) -> unit +;; vm-send-rfc934-digest: (&optional preamble-line list) -> unit +;; vm-send-rfc934-digest-other-frame: (&optional preamble-line list) -> unit +;; vm-send-rfc1153-digest: (&optional preamble-line list) -> unit +;; vm-send-rfc1153-digest-other-frame: (&optional preamble-line list) -> unit +;; vm-send-mime-digest: (&optional preamble-line list) -> unit +;; vm-send-mime-digest-other-frame: (&optional preamble-line list) -> unit +;; vm-continue-composing-message () -> unit +;; vm-mail-to-mailto-url: (url) -> unit +;; vm-preview-composition: () -> unit +;; +;; vm-mail-mode-show-headers: () -> unit +;; vm-mail-mode-hide-headers: () -> unit + +;;; Code: + +(provide 'vm-reply) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-mime) + (require 'vm-digest) + (require 'vm-undo) + ;; (require 'vm-delete) + ;; (require 'vm-imap) + ) + +(declare-function vm-mode "vm" (&optional read-only)) +(declare-function vm-session-initialization "vm" ()) +(declare-function get-itimer "vm-xemacs.el" (name)) + +(declare-function mail-strip-quoted-names "ext:mail-utils" (address)) +(declare-function mail-fetch-field "ext:mail-utils" + (field-name &optional last all list)) +(declare-function mail-send "ext:sendmail" ()) +(declare-function mail-do-fcc "ext:sendmail" (header-end)) +(declare-function mail-text "ext:sendmail" ()) +(declare-function mail-position-on-field "ext:sendmail" + (field &optional soft)) +(declare-function mail-mode "ext:sendmail" ()) +(declare-function build-mail-aliases "ext:mailalias" (&optional file)) + +(defun vm-add-reply-subject-prefix (message &optional start) + (when (not start) + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max)) + (forward-char 1) + (setq start (point))) + (goto-char start) + (if (and message vm-included-text-attribution-format) + (let ((vm-summary-uninteresting-senders nil)) + (insert (vm-summary-sprintf + vm-included-text-attribution-format + message)))) + (while (re-search-forward "^" (point-max) t) + (insert vm-included-text-prefix))) + +;;;###autoload +(defun vm-fill-long-lines-in-reply () + (interactive) + (let ((vm-word-wrap-paragraphs vm-word-wrap-paragraphs-in-reply) + ; doesn't work well with fill-prefixes + (vm-paragraph-fill-column vm-fill-long-lines-in-reply-column)) + (vm-fill-paragraphs-containing-long-lines + vm-fill-paragraphs-containing-long-lines-in-reply + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max)) + (forward-line 1) + (point)) + (point-max)))) + +;;;###autoload +(defun vm-do-reply (to-all include-text count) + "Set up a VM composition buffer for sending a reply (and switch the +focus to that buffer?). The reply is sent to the current message in +the folder buffer or other selected messages. The dynamically bound +variable `vm-enable-thread-operations' should be bound to nil before +calling this function in order to avoid surprises for the user. + +The argument TO-ALL says whether the reply should go to all the +recipients of the original messages. INCLUDE-TEXT says whether +the body of those messages should be included in the reply. +COUNT is the prefix argument indicating how many consecutive +messages of the folder are involved in this reply." + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Reply to")) + (dir default-directory) + (message-pointer vm-message-pointer) + (case-fold-search t) + to cc subject in-reply-to references + mp tmp tmp2 newsgroups) + (vm-retrieve-operable-messages count mlist) + (when (and include-text vm-include-text-from-presentation + (> (length mlist) 1)) + (error "Including presentation is possible for only a single message")) + (setq mp mlist) + (while mp + (cond ((setq tmp (vm-get-header-contents (car mp) "Reply-To:" ", ")) + (unless (vm-ignored-reply-to tmp) + (add-to-list 'to tmp))) + ((setq tmp (vm-get-header-contents (car mp) "From:" ", ")) + (add-to-list 'to tmp)) + ;; bad, but better than nothing for some + ((setq tmp (vm-grok-From_-author (car mp))) + (add-to-list 'to tmp)) + (t (error "No From: or Reply-To: header in message"))) + (let ((this-subject (vm-get-header-contents (car mp) "Subject:")) + (this-reply-to (and vm-in-reply-to-format + (let ((vm-summary-uninteresting-senders nil)) + (vm-summary-sprintf vm-in-reply-to-format + (car mp)))))) + (if (and this-subject vm-reply-subject-prefix + (not (string-match vm-reply-subject-prefix this-subject))) + (setq this-subject (concat vm-reply-subject-prefix + this-subject))) + (unless subject + (setq subject (concat this-subject + (if (cdr mlist) + (format " [and %d more messages]" + (length (cdr mlist))))))) + (setq in-reply-to (if in-reply-to + (concat in-reply-to ",\n\t" this-reply-to) + this-reply-to))) + (when to-all + (setq tmp (vm-get-header-contents (car mp) "To:" ", ")) + (setq tmp2 (vm-get-header-contents (car mp) "Cc:" ", ")) + (when tmp + (if cc + (setq cc (concat cc "," tmp)) + (setq cc tmp))) + (when tmp2 + (if cc + (setq cc (concat cc "," tmp2)) + (setq cc tmp2)))) + (setq references + (cons (or (vm-get-header-contents (car mp) "References:" " ") + (vm-get-header-contents (car mp) "In-reply-to:" " ")) + (cons (vm-get-header-contents (car mp) "Message-ID:" " ") + references))) + (setq newsgroups + (cons (or (and to-all + (vm-get-header-contents + (car mp) "Followup-To:" ",")) + (vm-get-header-contents (car mp) "Newsgroups:" ",")) + newsgroups)) + (setq mp (cdr mp))) + + (when to + (setq tmp (car to)) + (setq to (cdr to)) + (while to + (setq tmp (concat tmp ", " (car to))) + (setq to (cdr to))) + (setq to tmp)) + + (when vm-strip-reply-headers + (let ((mail-use-rfc822 t)) + (and to (setq to (mail-strip-quoted-names to))) + (and cc (setq cc (mail-strip-quoted-names cc))))) + (setq to (vm-parse-addresses to) + cc (vm-parse-addresses cc)) + (when vm-reply-ignored-addresses + (setq to (vm-strip-ignored-addresses to) + cc (vm-strip-ignored-addresses cc))) + (setq to (vm-delete-duplicates to nil t)) + (setq cc (vm-delete-duplicates + (append (vm-delete-duplicates cc nil t) + to (copy-sequence to)) + t t)) + (when to (setq to (mapconcat 'identity to ",\n "))) + (when cc (setq cc (mapconcat 'identity cc ",\n "))) + (when (null to) (setq to cc cc nil)) + (setq references (delq nil references) + references (mapconcat 'identity references " ") + references (vm-parse references "[^<]*\\(<[^>]+>\\)") + references (vm-delete-duplicates references) + references (if references (mapconcat 'identity references "\n\t"))) + (setq newsgroups (delq nil newsgroups) + newsgroups (mapconcat 'identity newsgroups ",") + newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)") + newsgroups (vm-delete-duplicates newsgroups) + newsgroups (if newsgroups (mapconcat 'identity newsgroups ","))) + (vm-mail-internal + :buffer-name (format "reply to %s%s" (vm-su-full-name (car mlist)) + (if (cdr mlist) ", ..." "")) + :to to :subject subject :in-reply-to in-reply-to :cc cc + :references references :newsgroups newsgroups) + (make-local-variable 'vm-reply-list) + (setq vm-system-state 'replying + vm-reply-list mlist + default-directory dir) + (when include-text + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search nil)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$") nil 0)) + (forward-char 1) + (while mlist + (save-restriction + (narrow-to-region (point) (point)) + (vm-yank-message (car mlist)) + (goto-char (point-max))) + (setq mlist (cdr mlist)))) + ;; Set window-start to the top because the yanks processed by + ;; emacs-w3m are somehow clobbering the buffer in Emacs 24 + (set-window-start nil (point-min))) + (when vm-fill-paragraphs-containing-long-lines-in-reply + (vm-fill-long-lines-in-reply)) + (run-hooks 'vm-reply-hook) + (run-hooks 'vm-mail-mode-hook))) + +(defun vm-strip-ignored-addresses (addresses) + (setq addresses (copy-sequence addresses)) + (let (re-list list addr-list) + (setq re-list vm-reply-ignored-addresses) + (while re-list + (setq addr-list addresses) + (while addr-list + (when (string-match (car re-list) (car addr-list)) + (setq addresses (delq (car addr-list) addresses))) + (setq addr-list (cdr addr-list))) + (setq re-list (cdr re-list)))) + addresses ) + +(defun vm-ignored-reply-to (reply-to) + (if (and reply-to (not (string= reply-to ""))) + (let (re-list result) + (setq re-list vm-reply-ignored-reply-tos) + (while re-list + (if (string-match (car re-list) reply-to) + (setq result t re-list nil) + (setq re-list (cdr re-list)))) + result))) + +;;;###autoload +(defun vm-mail-yank-default (&optional message) + "The default message yank handler when `mail-citation-hook' is set to nil." + (save-excursion + (vm-reorder-message-headers + nil :keep-list vm-included-text-headers + :discard-regexp vm-included-text-discard-header-regexp) + ;; if all the headers are gone, delete the trailing blank line, too. + (when (eq (following-char) ?\n) + (delete-char 1)) + (when (and message vm-included-text-attribution-format) + (let ((vm-summary-uninteresting-senders nil)) + (insert (vm-summary-sprintf vm-included-text-attribution-format + message)))) + ;; turn off zmacs-regions for Lucid Emacs 19 + ;; and get around transient-mark-mode in FSF Emacs 19 + ;; all this so that (mark) does what it did in v18, sheesh. + (let* ((zmacs-regions nil) + (mark-even-if-inactive t) + (end (mark-marker))) + (while (< (point) end) + (insert vm-included-text-prefix) + (forward-line 1))))) + +;;;###autoload +(defun vm-yank-message-other-folder (folder) + "Like vm-yank-message except the message is yanked from a folder other +than the one that spawned the current Mail mode buffer. The name of the +folder is read from the minibuffer. + +Don't call this function from a program." + (interactive + (list + (let ((dir (if vm-folder-directory + (expand-file-name vm-folder-directory) + default-directory)) + (last-command last-command) + (this-command this-command)) + (read-file-name "Yank from folder: " dir nil t)))) + (let ((b (current-buffer)) newbuf sumbuf default result prompt mp) + (set-buffer (or (vm-get-file-buffer folder) (find-file-noselect folder))) + (setq newbuf (current-buffer)) + (unless (eq major-mode 'vm-mode) + (vm-mode)) + (when vm-presentation-buffer-handle + (vm-bury-buffer vm-presentation-buffer-handle)) + (when (null vm-message-pointer) + (error "No messages in folder %s" folder)) + (setq default (vm-number-of (car vm-message-pointer))) + (save-excursion + (save-window-excursion + (save-window-excursion + (vm-summarize)) + (vm-display vm-summary-buffer t '(vm-yank-message-other-folder) + '(vm-yank-message-other-folder composing-message)) + (setq sumbuf (current-buffer)) + (setq prompt (format "Yank message number: (default %s) " default) + result 0) + (while (zerop result) + (setq result (read-string prompt)) + (and (string= result "") default (setq result default)) + (setq result (string-to-number result))) + (when (null (setq mp (nthcdr (1- result) vm-message-list))) + (error "No such message.")))) + (set-buffer b) + (unwind-protect + (let ((vm-mail-buffer newbuf)) + (vm-yank-message (car mp))) + (vm-bury-buffer newbuf) + (vm-bury-buffer sumbuf)))) + +;;;###autoload +(defun vm-yank-message (message) + "Yank message number N into the current buffer at point. +When called interactively N is always read from the minibuffer. When +called non-interactively the first argument is expected to be a +message struct. + +This command is meant to be used in VM created Mail mode buffers; the +yanked message comes from the mail buffer containing the message you +are replying to, forwarding, or invoked VM's mail command from. + +All message headers are yanked along with the text. Point is +left before the inserted text, the mark after. Any hook +functions bound to `mail-citation-hook' are run, after inserting +the text and setting point and mark. For backward compatibility, +if mail-citation-hook is set to nil, `mail-yank-hooks' is run +instead. + +If mail-citation-hook and mail-yank-hooks are both nil, this +default action is taken: the yanked headers are trimmed as +specified by `vm-included-text-headers' and +`vm-included-text-discard-header-regexp', and the value of +`vm-included-text-prefix' is prepended to every yanked line." + (interactive + (list + ;; What we really want for the first argument is a message struct, + ;; but if called interactively, we let the user type in a message + ;; number instead. + (let (mp default + (result 0) + prompt + (last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-select-folder-buffer) + (setq default (and vm-message-pointer + (vm-number-of (car vm-message-pointer))) + prompt (if default + (format "Yank message number: (default %s) " + default) + "Yank message number: ")) + (while (zerop result) + (setq result (read-string prompt)) + (and (string= result "") default (setq result default)) + (setq result (string-to-number result))) + (when (null (setq mp (nthcdr (1- result) vm-message-list))) + (error "No such message."))) + (car mp)))) + (unless (bufferp vm-mail-buffer) + (error "This is not a VM Mail mode buffer.")) + (unless (buffer-name vm-mail-buffer) + (error "The folder buffer containing message %d has been killed." + (vm-number-of message))) + (vm-display nil nil '(vm-yank-message) '(vm-yank-message composing-message)) + (vm-retrieve-operable-messages 1 (list message)) + (setq message (vm-real-message-of message)) + (let ((layout (vm-mm-layout message)) + (start (point)) + (end (point-marker))) + (save-excursion + (cond ((and vm-include-text-from-presentation + (not (vm-mime-plain-message-p message)) + (or (eq message (car vm-message-pointer)) + (progn + (message + (concat "Can yank presentation for only the " + "current message. Using default yank.")) + (sit-for 2) + nil))) + (vm-yank-message-presentation) + (setq end (point-marker))) + (vm-include-text-basic + (vm-yank-message-text message layout) + (setq end (point-marker))) + (t + (vm-yank-message-mime message layout) + (setq end (point-marker))) + ) + ;; decode MIME encoded words so supercite and other + ;; mail-citation-hook denizens won't have to eat 'em. + (when vm-display-using-mime + (save-restriction + (narrow-to-region start end) + (vm-decode-mime-encoded-words)))) + ;; get rid of read-only text properties on the text, as + ;; they will only cause trouble. + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(read-only nil invisible nil) + (current-buffer))) + (push-mark end) + (save-excursion + ;; Move point above the headers which should be at the top of + ;; the buffer by this point, and given the push-mark above, mark + ;; should now be after the message text. This is the invariant + ;; needed by the hook functions called by mail-citation-hook + ;; whose doc string states "Each hook function can find the + ;; citation between (point) and (mark t)." The upshot of that is + ;; that if point equals mark at the end of the buffer, some + ;; citation functions will fail with messages similar to + ;; "doesn't conform to RFC 822." -- Brent Goodrick, 2009-01-24 + ;; But this yanks wrongly! The following line reverted by Uday + ;; Reddy, 2009-12-07 + ;; (goto-char (point-min)) + (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) + (mail-yank-hooks (run-hooks 'mail-yank-hooks)) + (t (vm-mail-yank-default message)))))) + +(defun vm-yank-message-presentation () + ;; This function is the same as Rob's vm-insert-presentation. + ;; It has been reported that it includes the entire mail box on + ;; occasion. See Bug #498477. It should not be used until that + ;; problem resolved. + (let ((start (point))) + (vm-insert-region-from-buffer + (save-excursion + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + ;; ensure the current message is presented + (vm-present-current-message) + (vm-show-current-message) + (vm-select-folder-buffer) + (when vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (current-buffer))) + (save-excursion + (goto-char start) + (when (looking-at "From ") + (delete-region start (1+ (line-end-position))))))) + +(defconst vm-mime-yanked-button-format-alist + '( + ("text" . "[DELETED ATTACHMENT %f, %t]") + ("message" . "[DELETED ATTACHMENT %f, %t]") + ("audio" . "[DELETED ATTACHMENT %f, %t]") + ("video" . "[DELETED ATTACHMENT %f, %t]") + ("image" . "[DELETED ATTACHMENT %f, %t]") + ("application" . "[DELETED ATTACHMENT %f, %t]") + )) + +(defun vm-yank-message-mime (message layout) + ;; This is Rob's new code that uses vm-decode-mime-layout for + ;; creating the yanked text, but use the reply-specific settings for + ;; filling etc. + (let ((vm-word-wrap-paragraphs + vm-word-wrap-paragraphs-in-reply) + ; doesn't work well with fill-prefixes + (vm-fill-paragraphs-containing-long-lines + vm-fill-paragraphs-containing-long-lines-in-reply) + (vm-paragraph-fill-column + vm-fill-long-lines-in-reply-column)) + (if (eq layout 'none) + (vm-insert-region-from-buffer (vm-buffer-of message) + (vm-headers-of message) + (vm-text-end-of message)) + (vm-insert-region-from-buffer (vm-buffer-of message) + (vm-headers-of message) + (vm-text-of message)) + (save-excursion + (goto-char (point-min)) + (vm-decode-mime-message-headers)) + + ;; Use normal MIME decoding but override normal parameter settings + (let (;; override the alternative-select-method + (vm-mime-alternative-show-method vm-mime-alternative-yank-method) + ;; include only text and message/rfc822 types + ;; message/external-body should not be included + (vm-auto-displayed-mime-content-types '("text" "message/rfc822")) + ;; don't include separator for multipart + (vm-mime-parts-display-separator "") + ;; make MIME buttons look like text unless they are included + (vm-mime-button-face (if vm-include-mime-attachments + vm-mime-button-face + 'default)) + (vm-mime-button-mouse-face (if vm-include-mime-attachments + vm-mime-button-mouse-face + nil)) + ;; use different labels + (vm-mime-button-format-alist vm-mime-yanked-button-format-alist) + ) + (vm-decode-mime-layout layout)) + + ;; Make the MIME buttons attachment buttons + (if vm-include-mime-attachments + (vm-mime-convert-to-attachment-buttons))))) + +(defun vm-yank-message-text (message layout) + ;; This is the original code for included text + (let (new-layout type alternatives parts res insert-start) + (if (null (vectorp (vm-mm-layout message))) + (let ((b (current-buffer))) + (set-buffer (vm-buffer-of message)) + (save-restriction + (widen) + ;; decode MIME encoded words so supercite and other + ;; mail-citation-hook denizens won't have to eat 'em. + (append-to-buffer b (vm-headers-of message) + (vm-text-end-of message)) + (set-buffer b))) + (setq type (car (vm-mm-layout-type layout))) + (setq parts (list layout)) + (setq alternatives 0) + + (vm-insert-region-from-buffer + (vm-buffer-of message) (vm-headers-of message) (vm-text-of message)) + (while parts + (setq layout (car parts)) + (cond ((vm-mime-text-type-layout-p layout) + (cond ((vm-mime-types-match + "text/plain" (car (vm-mm-layout-type layout))) + (setq res (vm-mime-display-internal-text/plain + layout t))) + ((vm-mime-types-match + "text/enriched" (car (vm-mm-layout-type layout))) + (setq res (vm-mime-display-internal-text/enriched + layout))) + ((vm-mime-types-match + "message/rfc822" (car (vm-mm-layout-type layout))) + (setq res (vm-mime-display-internal-message/rfc822 + layout))) + ;; no text/html for now + ;; ((vm-mime-types-match + ;; "text/html" + ;; (car (vm-mm-layout-type layout))) + ;; (setq res (vm-mime-display-internal-text/html + ;; layout))) + ((member (downcase (car (vm-mm-layout-type layout))) + vm-included-mime-types-list) + (if (and (not (vm-mm-layout-is-converted layout)) + (vm-mime-can-convert + (car (vm-mm-layout-type layout))) + (setq new-layout + (vm-mime-convert-undisplayable-layout + layout))) + (setq res (vm-decode-mime-layout new-layout)) + (setq res (vm-mime-display-internal-text/plain + layout t))))) + (if res + (while (> alternatives 1) + (setq parts (cdr parts)) + (setq alternatives (1- alternatives))) + (when (member (downcase (car (vm-mm-layout-type layout))) + vm-included-mime-types-list) + ;; charset problems probably + ;; just dump the raw bits + (setq insert-start (point)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region + layout insert-start (point)))) + (setq parts (cdr parts))) + ((vm-mime-composite-type-p (car (vm-mm-layout-type layout))) + (when (vm-mime-types-match + "multipart/alternative" (car (vm-mm-layout-type layout))) + (setq alternatives (length (vm-mm-layout-parts (car parts))))) + (setq parts (nconc (copy-sequence + (vm-mm-layout-parts + (car parts))) + (cdr parts)))) + (t + (setq alternatives (1- alternatives)) + (setq parts (cdr parts)))))))) + +;;;###autoload +(defun vm-mail-send-and-exit (&rest ignored) + "Send message and maybe delete the composition buffer. +The value of `vm-keep-sent-mesages' determines whether the composition buffer +is deleted. If the composition is a reply to a message in a currently visited +folder, that message is marked as having been replied to." + (interactive "P") + (vm-check-for-killed-folder) + (when (and (boundp 'mail-alias-file) + mail-alias-file + (not (eq (user-uid) 0))) + (error "Must be superuser to use mail-alias-file. Please set mail-alias-file to nil.")) + (let ((b (current-buffer))) + (vm-mail-send) + (cond ((null (buffer-name b)) ;; dead buffer + ;; This improves window configuration behavior in + ;; XEmacs. It avoids taking the folder buffer from + ;; one frame and attaching it to the selected frame. + (set-buffer (window-buffer (selected-window))) + (vm-display nil nil '(vm-mail-send-and-exit) + '(vm-mail-send-and-exit + reading-message + startup))) + (t + (vm-display b nil '(vm-mail-send-and-exit) + '(vm-mail-send-and-exit reading-message startup)) + (vm-bury-buffer b))))) + +(defun vm-keep-mail-buffer (buffer) + (vm-keep-some-buffers buffer 'vm-kept-mail-buffers vm-keep-sent-messages)) + +(defun vm-help-tale () + (save-excursion + (goto-char (point-min)) + (while (vm-match-header) + (if (not (vm-match-header "To:\\|Resent-To:\\|Cc:\\|Resent-Cc:")) + (goto-char (vm-matched-header-end)) + (goto-char (vm-matched-header-contents-start)) + (if (re-search-forward "[^, \t][ \t]*\n[ \t\n]+[^ \t\n]" + (vm-matched-header-contents-end) + t) + (error "tale is an idiot, and so are you. :-)")) + (goto-char (vm-matched-header-end)))))) + +(defun vm-mail-mode-insert-message-id-maybe () + (when vm-mail-header-insert-message-id + (save-restriction + (save-excursion + (let ((resent nil)) + (if (or (vm-mail-mode-get-header-contents "Resent-To:") + (vm-mail-mode-get-header-contents "Resent-Cc:") + (vm-mail-mode-get-header-contents "Resent-Bcc:")) + (progn + (vm-mail-mode-remove-header "Resent-Message-ID:") + (setq resent t)) + (vm-mail-mode-remove-header "Message-ID:")) + (widen) + (goto-char (point-min)) + (insert (format "%sMessage-ID: %s\n" + (if resent "Resent-" "") + (vm-make-message-id)))))))) + +(defun vm-mail-mode-insert-date-maybe () + (if (not vm-mail-header-insert-date) + nil + (save-restriction + (save-excursion + (let* ((timezone (car (current-time-zone))) + (hour (/ timezone 3600)) + (min (/ (- timezone (* hour 3600)) 60)) + (time (current-time)) + (resent nil)) + (if (or (vm-mail-mode-get-header-contents "Resent-To:") + (vm-mail-mode-get-header-contents "Resent-Cc:") + (vm-mail-mode-get-header-contents "Resent-Bcc:")) + (progn + (vm-mail-mode-remove-header "Resent-Date:") + (setq resent t)) + (vm-mail-mode-remove-header "Date:")) + (widen) + (goto-char (point-min)) + (insert (format "%sDate: " (if resent "Resent-" "")) + (capitalize + (car (nth (string-to-number (format-time-string "%w" time)) + vm-weekday-alist))) + ", " + ;; %e generated " 2". Go from string to int + ;; to string to get rid of the blank. + (int-to-string + (string-to-number + (format-time-string "%e" time))) + " " + (capitalize + (car (nth + (1- (string-to-number (format-time-string "%m" time))) + vm-month-alist))) + (format-time-string " %Y %H:%M:%S" time) + (format " %s%02d%02d" + (if (< timezone 0) "-" "+") + (abs hour) + (abs min)) +;; localization in Europe and elsewhere can cause %Z to return +;; 8-bit chars, which are forbidden in headers. +;; (format-time-string " (%Z)" time) + "\n")))))) + +(defun vm-mail-mode-remove-message-id-maybe () + (if vm-mail-header-insert-message-id + (let ((resent nil)) + (if (or (vm-mail-mode-get-header-contents "Resent-To:") + (vm-mail-mode-get-header-contents "Resent-Cc:") + (vm-mail-mode-get-header-contents "Resent-Bcc:")) + (progn + (vm-mail-mode-remove-header "Resent-Message-ID:") + (setq resent t)) + (vm-mail-mode-remove-header "Message-ID:"))))) + +(defun vm-mail-mode-remove-date-maybe () + (if vm-mail-header-insert-date + (let ((resent nil)) + (if (or (vm-mail-mode-get-header-contents "Resent-To:") + (vm-mail-mode-get-header-contents "Resent-Cc:") + (vm-mail-mode-get-header-contents "Resent-Bcc:")) + (progn + (vm-mail-mode-remove-header "Resent-Date:") + (setq resent t)) + (vm-mail-mode-remove-header "Date:"))))) + +;;;###autoload +(defun vm-mail-get-header-contents (header-name-regexp &optional clump-sep) + "Return the contents of the header(s) matching HEADER-NAME-REGEXP +for the message in the current-buffer. The result will be a string that is +mime-encoded. The optional argument CLUMP-SEP, if present, should be +a string, which can be used as a separator to concatenate the fields +of multiple header lines which might match HEADER-NAME-REGEXP. + +This function is a variant of `vm-get-header-contents'." + (let ((contents nil) + (text-of-message 0) + (regexp (concat "^\\(" header-name-regexp "\\)"))) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max) t) + (setq text-of-message (match-end 0)) + (error "No mail header separator found!")) + + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (and (or (null contents) clump-sep) + (re-search-forward regexp text-of-message t) + (save-excursion (goto-char (match-beginning 0)) + (vm-match-header))) + (if contents + (setq contents + (concat contents clump-sep (vm-matched-header-contents))) + (setq contents (vm-matched-header-contents))))) + contents))) + +(defvar vm-dont-ask-coding-system-question nil) + +(cond ((and vm-fsfemacs-mule-p + (fboundp 'select-message-coding-system) + (not (fboundp 'vm-old-select-message-coding-system))) + (fset 'vm-old-select-message-coding-system + (symbol-function 'select-message-coding-system)) + (defun select-message-coding-system (&rest ignored) + (if vm-dont-ask-coding-system-question + nil + (apply 'vm-old-select-message-coding-system ignored))))) + +(defvar select-safe-coding-system-function) + +(defvar coding-system-for-write) + +;;;###autoload +(defun vm-mail-send () + "Just like mail-send except that VM flags the appropriate message(s) +as replied to, forwarded, etc, if appropriate." + (interactive) + (if vm-tale-is-an-idiot + (vm-help-tale)) + ;; protect value of this-command from minibuffer read + (let ((this-command this-command)) + (when (and vm-confirm-mail-send + (not (y-or-n-p "Send the message? "))) + (error "Message not sent."))) + (vm-mail-mode-show-headers) + (save-excursion (run-hooks 'vm-mail-send-hook)) + (vm-mail-mode-insert-date-maybe) + (vm-mail-mode-insert-message-id-maybe) + ;; send mail using MIME if user requests it and if the buffer + ;; has not already been MIME encoded. + (when (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:"))) + (when vm-do-fcc-before-mime-encode + (vm-do-fcc-before-mime-encode)) + (vm-mime-encode-composition)) + (when vm-mail-reorder-message-headers + (vm-reorder-message-headers + nil :keep-list vm-mail-header-order :discard-regexp 'none)) + ;; this to prevent Emacs 19 from asking whether a message that + ;; has already been sent should be sent again. VM renames mail + ;; buffers after the message has been sent, so the user should + ;; already know that the message has been sent. + (set-buffer-modified-p t) + (let ((composition-buffer (current-buffer)) + ;; preserve these in case the composition buffer gets + ;; killed. + (vm-reply-list vm-reply-list) + (vm-forward-list vm-forward-list) + (vm-redistribute-list vm-redistribute-list)) + ;; fragment message using message/partial if it is too big. + (if (and vm-send-using-mime + (integerp vm-mime-max-message-size) + (> (buffer-size) vm-mime-max-message-size)) + (let (list) + (setq list (vm-mime-fragment-composition vm-mime-max-message-size)) + (while list + (save-excursion + (set-buffer (car list)) + (vm-mail-send) + (kill-buffer (car list))) + (setq list (cdr list))) + ;; what mail-send would have done + (set-buffer-modified-p nil)) + ;; don't want a buffer change to occur here + ;; save-excursion to be sure. + ;; + ;; also protect value of this-command from minibuffer reads + (let ((this-command this-command) + ;; set up coding-system-for-write so that FCC uses + ;; the correct coding system to save the message into + ;; a folder. + (coding-system-for-write + (if (stringp mail-archive-file-name) + (vm-get-file-line-ending-coding-system + mail-archive-file-name) + (and (boundp 'coding-system-for-write) + coding-system-for-write))) + ;; For Emacs 21. + (mail-send-nonascii t) + (sendmail-coding-system (vm-binary-coding-system)) + (vm-dont-ask-coding-system-question t) + (select-safe-coding-system-function nil)) + (save-excursion + (mail-send)))) + ;; be careful, something could have killed the composition + ;; buffer inside mail-send. + (when (eq (current-buffer) composition-buffer) + (cond ((eq vm-system-state 'replying) + (vm-mail-mark-replied)) + ((eq vm-system-state 'forwarding) + (vm-mail-mark-forwarded)) + ((eq vm-system-state 'redistributing) + (vm-mail-mark-redistributed))) + (vm-rename-current-mail-buffer) + (vm-keep-mail-buffer (current-buffer))) + (vm-display nil nil '(vm-mail-send) '(vm-mail-send)))) + +;;;###autoload +(defun vm-do-fcc-before-mime-encode () + "The name says it all. +Sometimes you may want to save a message unencoded, specifically not to waste +storage for attachments which are stored on disk anyway." + (interactive) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max)) + (delete-region (match-beginning 0) (match-end 0)) + (let ((header-end (point-marker))) + (unwind-protect + (mail-do-fcc header-end) + (goto-char header-end) + (insert mail-header-separator))))) + +;;;###autoload +(defun vm-mail-mode-get-header-contents (header-name-regexp) + (let (regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^" + (regexp-quote mail-header-separator) "$\\)")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (vm-matched-header-contents) + nil )))))) + +;;;###autoload +(defun vm-mail-mode-remove-header (header-name-regexp) + (let (regexp) + (setq regexp (concat "^\\(" header-name-regexp "\\)\\|\\(^" + (regexp-quote mail-header-separator) "$\\)")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (and (re-search-forward regexp nil t) + (match-beginning 1) + (progn (goto-char (match-beginning 0)) + (vm-match-header))) + (delete-region (vm-matched-header-start) (vm-matched-header-end)) + nil )))))) + +(defun vm-rename-current-mail-buffer () + (if vm-rename-current-buffer-function + (funcall vm-rename-current-buffer-function) + (let ((case-fold-search nil)) + (if (not (string-match "^sent " (buffer-name))) + (let (prefix name n) + (if (not (string-match "^mail to \\?" (buffer-name))) + (setq prefix (format "sent %s" (buffer-name))) + (let (recipients) + (cond ((not (zerop (length (setq recipients + (mail-fetch-field "To")))))) + ((not (zerop (length (setq recipients + (mail-fetch-field "Cc")))))) + ((not (zerop (length (setq recipients + (mail-fetch-field "Bcc")))))) + ; can't happen?!? + (t (setq recipients "the horse with no name"))) + (setq prefix (format "sent mail to %s" recipients)))) + (if (> (length prefix) 44) + (setq prefix (concat (substring prefix 0 40) " ..."))) + (setq name prefix n 2) + (while (get-buffer name) + (setq name (format "%s<%d>" prefix n)) + (vm-increment n)) + (rename-buffer name)))))) + +(defun vm-mail-mark-replied () + (save-excursion + (let ((mp vm-reply-list)) + (while mp + (if (null (buffer-name (vm-buffer-of (car mp)))) + () + (set-buffer (vm-buffer-of (car mp))) + (cond ((and (memq (car mp) vm-message-list) + (null (vm-replied-flag (car mp)))) + (vm-set-replied-flag (car mp) t)))) + (setq mp (cdr mp))) + (vm-update-summary-and-mode-line)))) + +(defun vm-mail-mark-forwarded () + (save-excursion + (let ((mp vm-forward-list)) + (while mp + (if (null (buffer-name (vm-buffer-of (car mp)))) + () + (set-buffer (vm-buffer-of (car mp))) + (cond ((and (memq (car mp) vm-message-list) + (null (vm-forwarded-flag (car mp)))) + (vm-set-forwarded-flag (car mp) t)))) + (setq mp (cdr mp))) + (vm-update-summary-and-mode-line)))) + +(defun vm-mail-mark-redistributed () + (save-excursion + (let ((mp vm-redistribute-list)) + (while mp + (if (null (buffer-name (vm-buffer-of (car mp)))) + () + (set-buffer (vm-buffer-of (car mp))) + (cond ((and (memq (car mp) vm-message-list) + (null (vm-redistributed-flag (car mp)))) + (vm-set-redistributed-flag (car mp) t)))) + (setq mp (cdr mp))) + (vm-update-summary-and-mode-line)))) + +;;;###autoload +(defun vm-reply (count) + "Reply to the sender of the current message. +Numeric prefix argument N means to reply to the current message plus the +next N-1 messages. A negative N means reply to the current message and +the previous N-1 messages. + +If invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages will be replied to. + +You will be placed into a standard Emacs Mail mode buffer to compose and +send your message. See the documentation for the function `mail' for +more info. + +Note that the normal binding of C-c C-y in the reply buffer is +automatically changed to `vm-yank-message' during a reply. This +allows you to yank any message from the current folder into a +reply. + +Normal VM commands may be accessed in the reply buffer by prefixing them +with C-c C-v." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vm-enable-thread-operations nil)) + (vm-do-reply nil nil count))) + +;;;###autoload +(defun vm-reply-include-text (count) + "Reply to the sender (only) of the current message and include text +from the message. See the documentation for function vm-reply for details." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vm-enable-thread-operations nil)) + (vm-do-reply nil t count))) + +;;;###autoload +(defun vm-followup (count) + "Reply to all recipients of the current message. +See the documentation for the function vm-reply for details." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vm-enable-thread-operations nil)) + (vm-do-reply t nil count))) + +;;;###autoload +(defun vm-followup-include-text (count) + "Reply to all recipients of the current message and include text from +the message. See the documentation for the function vm-reply for details." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vm-enable-thread-operations nil)) + (vm-do-reply t t count))) + +;;;###autoload +(defun vm-forward-message-all-headers () + "Like `vm-forward-message' but forwards all the headers." + (interactive) + (let ((vm-forwarded-headers nil) + (vm-unforwarded-header-regexp "only-drop-this-header") + ;; set these because vm-forward-message calls vm-send-digest + ;; if there is more than one message to be forwarded. + (vm-rfc934-digest-headers nil) + (vm-rfc934-digest-discard-header-regexp "only-drop-this-header") + (vm-rfc1153-digest-headers nil) + (vm-rfc1153-digest-discard-header-regexp "only-drop-this-header") + (vm-mime-digest-headers nil) + (vm-mime-digest-discard-header-regexp "only-drop-this-header")) + (vm-forward-message))) + +;;;###autoload +(defun vm-forward-message-plain () + "Forward the current message in plain text to one or more +recipients. You will be placed in a Mail mode buffer as you +would with a reply, but you must fill in the \"To:\" header and +perhaps the \"Subject:\" header manually. + +Any MIME attachments in the forwarded message will be attached +to the outgoing message. + +See `vm-forward-message' for other forms of forwarding." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vm-forwarded-headers vm-forwarded-headers-plain) + (vm-unforwarded-header-regexp vm-unforwarded-header-regexp-plain)) + (vm-forward-message t (vm-select-operable-messages + 1 (vm-interactive-p) "Forward")))) + +;;;###autoload +(defun vm-forward-message (&optional plain mlist) + "Forward the current message to one or more recipients. +You will be placed in a Mail mode buffer as you would with a +reply, but you must fill in the \"To:\" header and perhaps the +\"Subject:\" header manually. + +See `vm-forward-message-plain' for forwarding messages in plain text." + ;; The optional argument PLAIN says that the forwarding should be + ;; done as plain text, irrespective of the value of + ;; `vm-forwarding-digest-type'. + ;; The optional argument MLIST is the list of messages to be + ;; forwarded. + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((dir default-directory) + (miming (and vm-send-using-mime + (not plain) + (equal vm-forwarding-digest-type "mime"))) + reply-buffer + header-end) + (unless mlist + (setq mlist (vm-select-operable-messages + 1 (vm-interactive-p) "Forward"))) + (if (cdr mlist) + ;; multiple message forwarding + (progn + ;; (unless (or (not plain) + ;; (y-or-n-p + ;; "Use encapsulated forwarding for multiple messages? ")) + ;; (error "Aborted")) + ;; (setq plain nil) + (let ((vm-digest-send-type (if plain nil + vm-forwarding-digest-type))) + ;; (setq this-command 'vm-next-command-uses-marks) + ;; (command-execute 'vm-send-digest) + (vm-send-digest nil mlist))) + ;; single message forwarding + (vm-retrieve-operable-messages 1 mlist) + (save-restriction + (widen) + (vm-mail-internal + :buffer-name (format "forward of %s's note re: %s" + (vm-su-full-name (car vm-message-pointer)) + (vm-su-subject (car vm-message-pointer))) + :subject (when vm-forwarding-subject-format + (let ((vm-summary-uninteresting-senders nil)) + (vm-summary-sprintf vm-forwarding-subject-format + (car mlist))))) + (make-local-variable 'vm-forward-list) + (setq vm-system-state 'forwarding + vm-forward-list mlist + default-directory dir) + ;; current-buffer is now the reply buffer + (if miming + (progn + (setq reply-buffer (current-buffer)) + (set-buffer (vm-make-work-buffer "*vm-forward-buffer*")) + (setq header-end (point)) + (insert "\n")) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) + "\n")) + (goto-char (match-end 0)) + (setq header-end (match-beginning 0))) + (cond ((or plain (null vm-forwarding-digest-type)) + (vm-no-frills-encapsulate-message + (car mlist) + (append vm-forwarded-headers vm-forwarded-mime-headers) + vm-unforwarded-header-regexp)) + ((equal vm-forwarding-digest-type "mime") + (vm-mime-encapsulate-messages + mlist + ;; :keep-list nil :discard-regexp "none" + :keep-list vm-forwarded-headers + :discard-regexp vm-unforwarded-header-regexp + :always-use-digest nil) + (goto-char header-end) + (insert "MIME-Version: 1.0\n") + (insert "Content-Type: message/rfc822\n") + (insert "Content-Transfer-Encoding: " + (vm-determine-proper-content-transfer-encoding + (point) + (point-max)) + "\n") + (insert "Content-Description: forwarded message\n") + ;; eight bit chars will get \201 prepended if we + ;; don't do this. + (when vm-fsfemacs-mule-p + (set-buffer-multibyte t))) ; is this safe? + ((equal vm-forwarding-digest-type "rfc934") + (vm-rfc934-encapsulate-messages + vm-forward-list + (append vm-forwarded-headers vm-forwarded-mime-headers) + vm-unforwarded-header-regexp)) + ((equal vm-forwarding-digest-type "rfc1153") + (vm-rfc1153-encapsulate-messages + vm-forward-list + (append vm-forwarded-headers vm-forwarded-mime-headers) + vm-unforwarded-header-regexp))) + (when miming + (let ((work-buffer (current-buffer))) + (set-buffer reply-buffer) ; intended buffer change + (mail-text) + (vm-attach-object work-buffer + :type "message/rfc822" :params nil + :disposition '("inline") + :description "forwarded message" :mimed t) + (add-hook 'kill-buffer-hook + `(lambda () + (if (eq ,reply-buffer (current-buffer)) + (kill-buffer ,work-buffer))) + ))) + (mail-position-on-field "To")) + (run-hooks 'vm-forward-message-hook) + (run-hooks 'vm-mail-mode-hook)))) + +;;;###autoload +(defun vm-resend-bounced-message () + "Extract the original text from a bounced message and resend it. +You will be placed in a Mail mode buffer with the extracted message and +you can change the recipient address before resending the message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((b (current-buffer)) start + (dir default-directory) + (layout (vm-mm-layout (car vm-message-pointer))) + (lim (vm-text-end-of (car vm-message-pointer)))) + ;; We only want to select one message here + (vm-retrieve-operable-messages 1 (list (car vm-message-pointer))) + (save-restriction + (widen) + (if (or (not (vectorp layout)) + (not (setq layout (vm-mime-layout-contains-type + layout "message/rfc822")))) + (save-excursion + (goto-char (vm-text-of (car vm-message-pointer))) + (let ((case-fold-search t)) + ;; What a wonderful world it would be if mailers + ;; used a single message encapsulation standard + ;; instead of all the weird variants. It is + ;; useless to try to cover them all. This simple + ;; rule should cover the sanest of the formats + (if (not (re-search-forward "^Received:" lim t)) + (error "This doesn't look like a bounced message.")) + (beginning-of-line) + (setq start (point))))) + ;; briefly nullify vm-mail-header-from to keep vm-mail-internal + ;; from inserting another From header. + (let ((vm-mail-header-from nil)) + (vm-mail-internal + :buffer-name (format "retry of bounce from %s" + (vm-su-from (car vm-message-pointer))))) + (goto-char (point-min)) + (if (vectorp layout) + (progn + (setq start (point)) + (vm-mime-insert-mime-body layout) + (vm-mime-transfer-decode-region layout start (point))) + (insert-buffer-substring b start lim)) + (delete-region (point) (point-max)) + (goto-char (point-min)) + ;; delete all but pertinent headers + (vm-reorder-message-headers + nil :keep-list nil :discard-regexp "\\(X-VM-\\|Status:\\|Sender:\\)") + (vm-reorder-message-headers + nil :keep-list vm-resend-bounced-headers + :discard-regexp vm-resend-bounced-discard-header-regexp) + (if (search-forward "\n\n" nil t) + (replace-match "") + (goto-char (point-max))) + (insert ?\n mail-header-separator ?\n) + (goto-char (point-min)) + (if vm-mail-header-from + (insert "Resent-From: " vm-mail-header-from ?\n)) + (if (vm-mail-mode-get-header-contents "Resent-To:") + (mail-position-on-field "Resent-To") + (insert "Resent-To: \n") + (forward-char -1)) + (setq default-directory dir))) + (run-hooks 'vm-resend-bounced-message-hook) + (run-hooks 'vm-mail-mode-hook)) + +;;;###autoload +(defun vm-resend-message () + "Resend the current message to someone else. +The current message will be copied to a Mail mode buffer and you +can edit the message and send it as usual. + +NOTE: since you are doing a resend, a Resent-To header is provided +for you to fill in the new recipient list. If you don't fill in +this header, what happens when you send the message is undefined. +You may also create a Resent-Cc header." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (save-restriction + (widen) + (let ((b (current-buffer)) + (dir default-directory) + (vmp vm-message-pointer) + (start (vm-headers-of (car vm-message-pointer))) + (lim (vm-text-end-of (car vm-message-pointer)))) + ;; We only want to select one message here + (vm-retrieve-operable-messages 1 (list (car vm-message-pointer))) + ;; briefly nullify vm-mail-header-from to keep vm-mail-internal + ;; from inserting another From header. + (let ((vm-mail-header-from nil)) + (vm-mail-internal + :buffer-name (format "resend of %s's note re: %s" + (vm-su-full-name (car vm-message-pointer)) + (vm-su-subject (car vm-message-pointer))))) + (goto-char (point-min)) + (insert-buffer-substring b start lim) + (delete-region (point) (point-max)) + (goto-char (point-min)) + (if vm-mail-header-from + (insert "Resent-From: " vm-mail-header-from ?\n)) + (insert "Resent-To: \n") + (if mail-self-blind + (insert "Bcc: " + (cond ((and vm-xemacs-p (fboundp 'user-mail-address)) + (user-mail-address)) + ((and (boundp 'user-mail-address) + (stringp user-mail-address)) + user-mail-address) + (t (user-login-name))) + ?\n)) + (if mail-archive-file-name + (insert "FCC: " mail-archive-file-name ?\n)) + ;; delete all but pertinent headers + (vm-reorder-message-headers + nil :keep-list nil :discard-regexp "\\(X-VM-\\|Status:\\|Sender:\\)") + (vm-reorder-message-headers + nil :keep-list vm-resend-headers + :discard-regexp vm-resend-discard-header-regexp) + (if (search-forward "\n\n" nil t) + (replace-match "")) + (insert ?\n mail-header-separator ?\n) + (goto-char (point-min)) + (mail-position-on-field "Resent-To") + (make-local-variable 'vm-redistribute-list) + (setq vm-system-state 'redistributing + vm-redistribute-list (list (car vmp)) + default-directory dir) + (run-hooks 'vm-resend-message-hook) + (run-hooks 'vm-mail-mode-hook)))) + +;;;###autoload +(defun vm-send-digest (&optional prefix mlist) + "Send a digest of all messages in the current folder to recipients. +The type of the digest is specified by the variable `vm-digest-send-type'. +You will be placed in a Mail mode buffer as is usual with replies, but you +must fill in the \"To:\" and \"Subject:\" headers manually. + +Prefix arg means to insert a list of preamble lines at the beginning of +the digest. One line is generated for each message being digestified. +The variable `vm-digest-preamble-format' determines the format of the +preamble lines. + +If invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages will be put into the digest. If applied to +collapsed threads in summary and thread operations are enabled via +`vm-enable-thread-operations' then all messages in the thread are +included in the digest." + (interactive "P") + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((dir default-directory) + (miming (and vm-send-using-mime (equal vm-digest-send-type "mime"))) + mp mail-buffer work-buffer b + ms start header-end boundary) + (unless mlist + ;; prefix arg doesn't have "normal" meaning here, so only call + ;; vm-select-operable-messages for marks or threads. + (setq mlist (vm-select-operable-messages + 1 (vm-interactive-p) "Send as digest"))) + ;; if messages were selected use them, otherwise the whole folder + (cond ((cdr mlist) + (vm-retrieve-operable-messages 1 mlist)) + ((not (y-or-n-p "Send the entire folder as a digest? ")) + (error "aborted")) + ((vm-find vm-message-list + (lambda (m) (vm-body-to-be-retrieved-of m))) + (error "Headers-only external messages present in the folder")) + (t + (setq mlist vm-message-list))) + (save-restriction + (widen) + (vm-mail-internal + :buffer-name (format "digest from %s" (buffer-name)) + :subject (and vm-forwarding-subject-format + (let ((vm-summary-uninteresting-senders nil)) + (concat (vm-summary-sprintf + vm-forwarding-subject-format (car mlist)) + (if (cdr mlist) + (format " [and %d more messages]" + (length (cdr mlist)))))))) + ;; current buffer is mail-buffer + (setq mail-buffer (current-buffer)) + (make-local-variable 'vm-forward-list) + (setq vm-system-state 'forwarding + vm-forward-list mlist + default-directory dir) + (if miming + (progn + ;; buffer is changed for only the mime case + (setq work-buffer (vm-make-work-buffer "*vm-digest-buffer*")) + (set-buffer work-buffer) + (setq header-end (point)) + (insert "\n") + (setq start (point-marker))) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) + "\n")) + (goto-char (match-end 0)) + (setq start (point-marker) + header-end (match-beginning 0))) + (vm-inform 5 "Building %s digest..." vm-digest-send-type) + (cond ((equal vm-digest-send-type "mime") + (setq boundary + (vm-mime-encapsulate-messages + mlist :keep-list vm-mime-digest-headers + :discard-regexp vm-mime-digest-discard-header-regexp + :always-use-digest t)) + (goto-char header-end) + (insert "MIME-Version: 1.0\n") + (insert (if vm-mime-avoid-folding-content-type + "Content-Type: multipart/digest; boundary=\"" + "Content-Type: multipart/digest;\n\tboundary=\"") + boundary "\"\n") + (insert "Content-Transfer-Encoding: " + (vm-determine-proper-content-transfer-encoding + (point) + (point-max)) + "\n")) + ((equal vm-digest-send-type "rfc934") + (vm-rfc934-encapsulate-messages + mlist vm-rfc934-digest-headers + vm-rfc934-digest-discard-header-regexp)) + ((equal vm-digest-send-type "rfc1153") + (vm-rfc1153-encapsulate-messages + mlist vm-rfc1153-digest-headers + vm-rfc1153-digest-discard-header-regexp)) + ((equal vm-digest-send-type nil) + (while mlist + (vm-no-frills-encapsulate-message + (car mlist) + (append vm-forwarded-headers vm-forwarded-mime-headers) + vm-unforwarded-header-regexp) ; nil? + (insert "\n") + (setq mlist (cdr mlist))))) + + (goto-char start) + (setq mp mlist) + (when miming + ;; restore buffer in the mime case + (set-buffer mail-buffer) + (mail-text) + (save-excursion + (vm-attach-object work-buffer + :type "multipart/digest" + :params (list (concat "boundary=\"" + boundary "\"")) + :disposition '("inline") + :description "forwarded messages" :mimed t) + (add-hook 'kill-buffer-hook + `(lambda () + (if (eq (current-buffer) ,mail-buffer) + (kill-buffer ,work-buffer)))))) + (when prefix + (vm-inform 6 "Building digest preamble...") + ;; (if miming + ;; (progn + ;; (set-buffer mail-buffer) + ;; (mail-text))) + (while mp + (let ((vm-summary-uninteresting-senders nil)) + (insert (vm-summary-sprintf vm-digest-preamble-format + (car mp)) "\n")) + (if vm-digest-center-preamble + (progn + (forward-char -1) + (center-line) + (forward-char 1))) + (setq mp (cdr mp)))) + (mail-position-on-field "To") + (vm-inform 5 "Building %s digest... done" vm-digest-send-type))) + (run-hooks 'vm-send-digest-hook) + (run-hooks 'vm-mail-mode-hook)) + +;;;###autoload +(defun vm-send-rfc934-digest (&optional preamble) + "Like vm-send-digest but always sends an RFC 934 digest." + (interactive "P") + (let ((vm-digest-send-type "rfc934")) + (vm-send-digest preamble))) + +;;;###autoload +(defun vm-send-rfc1153-digest (&optional preamble) + "Like vm-send-digest but always sends an RFC 1153 digest." + (interactive "P") + (let ((vm-digest-send-type "rfc1153")) + (vm-send-digest preamble))) + +;;;###autoload +(defun vm-send-mime-digest (&optional preamble) + "Like vm-send-digest but always sends an MIME (multipart/digest) digest." + (interactive "P") + (let ((vm-digest-send-type "mime")) + (vm-send-digest preamble))) + +;;;###autoload +(defun vm-continue-composing-message (&optional not-picky) + "Find and select the most recently used mail composition buffer. +If the selected buffer is already a Mail mode buffer then it is +buried before beginning the search. Non Mail mode buffers and +unmodified Mail buffers are skipped. Prefix arg means unmodified +Mail mode buffers are not skipped. If no suitable buffer is +found, the current buffer remains selected." + (interactive "P") + (if (eq major-mode 'mail-mode) + (vm-bury-buffer (current-buffer))) + (let ((b (vm-find-composition-buffer not-picky))) + (if (not (or (null b) (eq b (current-buffer)))) + (progn + ;; avoid having the window configuration code choose a + ;; different composition buffer. + (vm-unbury-buffer b) + (set-buffer b) + (if (and vm-mutable-frame-configuration vm-frame-per-composition + (vm-multiple-frames-possible-p) + ;; only pop up a frame if there's an undisplay + ;; hook in place to make the frame go away. + vm-undisplay-buffer-hook) + (let ((w (vm-get-buffer-window b))) + (if (null w) + (vm-goto-new-frame 'composition) + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))) + ;; need to do this here too, since XEmacs has per + ;; frame buffer lists. + (vm-unbury-buffer b) + (vm-set-hooks-for-frame-deletion))) + (vm-display b t '(vm-continue-composing-message) + '(vm-continue-composing-message composing-message))) + (vm-inform 5 "No composition buffers found")))) + +;;;###autoload +(defun vm-mail-to-mailto-url (url) + "Creates a message composition buffer to send mail to the URL. This +command can be invoked from external agents via an emacsclient." + (interactive "s") + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (let ((list (vm-parse url "^mailto:\\([^?]*\\)\\??\\|\\([^&]+\\)&?" + '(1 2))) + to subject in-reply-to cc references newsgroups body + tem header value header-list) + (setq to (car list) + to (vm-url-decode-string to) + list (cdr list)) + (while list + (setq tem (vm-parse (car list) "\\([^=]+\\)=?")) + (if (null (nth 1 tem)) + nil + (setq header (downcase (vm-url-decode-string (car tem))) + value (vm-url-decode-string (nth 1 tem))) + (if (member header '("subject" "in-reply-to" "cc" + "references" "newsgroups" "body")) + ;; set the variable let-bound above + (set (intern header) value) + ;; we'll insert the header later + (setq header-list (cons header (cons value header-list))))) + (setq list (cdr list))) + (vm-mail-internal :to to :subject subject :in-reply-to in-reply-to + :cc cc :references references :newsgroups newsgroups) + (save-excursion + (goto-char (point-min)) + (while header-list + (insert (car header-list) ": ") + (capitalize-region (point) (save-excursion (beginning-of-line) (point))) + (insert (nth 1 header-list) "\n") + (setq header-list (nthcdr 2 header-list))) + (if (null body) + nil + (mail-text) + (save-excursion (insert (vm-url-decode-string body) "\n")) + ;; CRLF to LF for line breaks in the body + (while (search-forward "\r\n" nil t) + (replace-match "\n")))) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook))) + +;; external variables +(defvar mail-mode-map) +(defvar mail-aliases) +(defvar mail-default-reply-to) +(defvar mail-signature-file) +(defvar mail-personal-alias-file) + +(defun vm-sanitize-buffer-name (buffer-name) + "Replace chars matching `vm-drop-buffer-name-chars' by an \"_\"." + (let ((r vm-drop-buffer-name-chars)) + (when buffer-name + (if r + (setq buffer-name (vm-replace-in-string buffer-name r "_" t))) + (if (>= (length buffer-name) vm-buffer-name-limit) + (setq buffer-name + (concat (substring buffer-name 0 (- vm-buffer-name-limit 4)) + "..."))))) + buffer-name) + +(defvar vm-compositions-exist nil) +(defvar vm-composition-buffer-count 0 + "The current number of composition buffers.") + +(defvar vm-ml-composition-buffer-count "" + "The modeline string displayed for the current number of composition +buffers.") + +(defvar dnd-protocol-alist) +(defvar ns-input-file) + +(defun vm-update-ml-composition-buffer-count () + (setq vm-ml-composition-buffer-count + (format "%d composition%s" vm-composition-buffer-count + (if (= vm-composition-buffer-count 1) "" "s")))) + +(defun vm-forget-composition-buffer () + (setq vm-composition-buffer-count (- vm-composition-buffer-count 1)) + (setq vm-compositions-exist (> vm-composition-buffer-count 0)) + (vm-update-ml-composition-buffer-count)) + +(defun vm-new-composition-buffer () + (setq vm-composition-buffer-count (+ 1 vm-composition-buffer-count)) + (setq vm-compositions-exist t) + (vm-make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'vm-forget-composition-buffer nil t) + (add-hook 'vm-mail-send-hook 'vm-forget-composition-buffer nil t) + (vm-update-ml-composition-buffer-count)) + +(defun vm-select-recipient-from-sender () + "Select a recipient's address from the current message's sender, if +there is a current message." + (when (and vm-mail-use-sender-address + (memq major-mode '(vm-mode vm-virtual-mode + vm-summary-mode vm-presentation-mode))) + (vm-select-folder-buffer) + (vm-get-header-contents (car vm-message-pointer) "From:"))) + + +;;;###autoload +(defun* vm-mail-internal (&key buffer-name to guessed-to subject + in-reply-to cc references newsgroups) + "Create a message buffer and set it up according to args. +Fills in the headers as given by the arguments. +Binds the `vm-mail-mode-map' and hooks" + (let ((folder-buffer nil)) + (when (memq major-mode '(vm-mode vm-virtual-mode)) + (setq folder-buffer (current-buffer))) + (setq buffer-name (if buffer-name + (vm-decode-mime-encoded-words-in-string buffer-name) + "mail to ?")) + (setq buffer-name (vm-sanitize-buffer-name buffer-name)) + (set-buffer (generate-new-buffer buffer-name)) + ;; FSF Emacs: try to prevent write-region (called to handle FCC) from + ;; asking the user to choose a safe coding system. + (if (and vm-fsfemacs-mule-p (fboundp 'set-buffer-file-coding-system)) + (set-buffer-file-coding-system 'raw-text)) + ;; avoid trying to write auto-save files in potentially + ;; unwritable directories. + (setq default-directory + (or vm-mail-auto-save-directory vm-folder-directory + (expand-file-name "~/"))) + (auto-save-mode (if auto-save-default 1 -1)) + (mail-mode) + ;; TM infests mail mode, uninfest it if VM's MIME stuff is in + ;; use. + (when vm-send-using-mime + (vm-mail-mode-remove-tm-hooks)) + (use-local-map vm-mail-mode-map) + ;; make mail-mode-map the parent of this vm-mail-mode-map, if we can. + ;; do it only once. + (unless vm-mail-mode-map-parented + (cond ((fboundp 'set-keymap-parents) + (set-keymap-parents vm-mail-mode-map (list mail-mode-map)) + (setq vm-mail-mode-map-parented t)) + ((consp mail-mode-map) + (nconc vm-mail-mode-map mail-mode-map) + (setq vm-mail-mode-map-parented t)))) + (when (boundp 'dnd-protocol-alist) + (set (make-local-variable 'dnd-protocol-alist) + (append vm-dnd-protocol-alist dnd-protocol-alist))) + (setq vm-mail-buffer folder-buffer + mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu))) + (and vm-use-menus (vm-menu-support-possible-p) + (vm-menu-install-mail-mode-menu)) + (if (fboundp 'mail-aliases-setup) ; use mail-abbrevs.el if present + (mail-aliases-setup) + (when (eq mail-aliases t) + (setq mail-aliases nil) + (when (file-exists-p (or mail-personal-alias-file "~/.mailrc")) + (build-mail-aliases)))) + (when (stringp vm-mail-header-from) + (insert "From: " vm-mail-header-from "\n")) + (setq to (if to + (vm-decode-mime-encoded-words-in-string to)) + guessed-to (if guessed-to + (vm-decode-mime-encoded-words-in-string guessed-to)) + subject (if subject + (vm-decode-mime-encoded-words-in-string subject)) + cc (if cc + (vm-decode-mime-encoded-words-in-string cc))) + (insert "To: " (or to guessed-to "") "\n") + (and cc (insert "Cc: " cc "\n")) + (insert "Subject: " (or subject "") "\n") + (and newsgroups (insert "Newsgroups: " newsgroups "\n")) + (and in-reply-to (insert "In-Reply-To: " in-reply-to "\n")) + (and references (insert "References: " references "\n")) + (insert "X-Mailer: VM " (vm-version) " under ") + (if (boundp 'emacs-version) + (insert emacs-version) + (insert "Unknown Emacs")) + ;; (if (functionp 'emacsw32-version) + ;; (insert " [" (emacsw32-version) "]")) + (if (boundp 'system-configuration) + (insert " (" system-configuration ")")) + (insert "\n") + ;; REPLYTO environmental variable support + ;; note that in FSF Emacs v19.29 we would initialize if the + ;; value was t. nil is the trigger value used now. + (and (eq mail-default-reply-to nil) + (setq mail-default-reply-to (getenv "REPLYTO"))) + (when mail-default-reply-to + (insert "Reply-To: " mail-default-reply-to "\n")) + (when mail-self-blind + (insert "Bcc: " + (cond ((and vm-xemacs-p (fboundp 'user-mail-address)) + (user-mail-address)) + ((and (boundp 'user-mail-address) + (stringp user-mail-address)) + user-mail-address) + (t (user-login-name))) + ?\n)) + (when mail-archive-file-name + (insert "FCC: " mail-archive-file-name "\n")) + (when mail-default-headers + (insert mail-default-headers)) + (unless (= (preceding-char) ?\n) + (insert ?\n)) + (insert mail-header-separator "\n") + (condition-case err + (when mail-signature + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (cond ((stringp mail-signature) + (insert mail-signature)) + ((eq mail-signature t) + (insert-file-contents + (or (and (boundp 'mail-signature-file) + (stringp mail-signature-file) + mail-signature-file) + "~/.signature"))) + (t + (let ((str (eval mail-signature))) + (if (stringp str) + (insert str))))) + (goto-char (point-min)) + (if (looking-at "\n*-- \n") + nil + (insert "\n-- \n")) + (goto-char (point-max))))) + (error (vm-warn 1 2 "Cound not read signature file: %s" (cdr err)))) + ;; move this buffer to the head of the buffer list so window + ;; config stuff will select it as the composition buffer. + (vm-unbury-buffer (current-buffer)) + ;; make a new frame if the user wants it. + (when (and vm-mutable-frame-configuration vm-frame-per-composition + (vm-multiple-frames-possible-p)) + (vm-goto-new-frame 'composition) + (vm-set-hooks-for-frame-deletion)) + ;; now do window configuration + (vm-display (current-buffer) t + '(vm-mail + vm-mail-other-frame + vm-mail-other-window + vm-reply + vm-reply-other-frame + vm-reply-include-text + vm-reply-include-text-other-frame + vm-followup + vm-followup-other-frame + vm-followup-include-text + vm-followup-include-text-other-frame + vm-send-digest + vm-send-digest-other-frame + vm-send-rfc934-digest + vm-send-rfc934-digest-other-frame + vm-send-rfc1153-digest + vm-send-rfc1153-digest-other-frame + vm-send-mime-digest + vm-send-mime-digest-other-frame + vm-forward-message + vm-forward-message-other-frame + vm-forward-message-all-headers + vm-forward-message-all-headers-other-frame + vm-resend-message + vm-resend-message-other-frame + vm-resend-bounced-message + vm-resend-bounced-message-other-frame) + (list this-command 'composing-message)) + (cond ((null to) + (mail-position-on-field "To" t)) + ((null subject) + (mail-position-on-field "Subject" t))) + (cond ((and vm-xemacs-p + (fboundp 'start-itimer) + (null (get-itimer "vm-rename-mail")) + (start-itimer "vm-rename-mail" + 'vm-update-composition-buffer-name + 1.5 1.5 t))) + ((and (fboundp 'run-with-idle-timer) + (null vm-update-composition-buffer-name-timer)) + (setq vm-update-composition-buffer-name-timer + (run-with-idle-timer + 1.5 t 'vm-update-composition-buffer-name)))) + (vm-new-composition-buffer) + (run-hooks 'mail-setup-hook))) + +;;;###autoload +(defun vm-reply-other-frame (count) + "Like vm-reply, but run in a newly created frame." + (interactive "p") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-reply count)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-reply-include-text-other-frame (count) + "Like vm-reply-include-text, but run in a newly created frame." + (interactive "p") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-reply-include-text count)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-followup-other-frame (count) + "Like vm-followup, but run in a newly created frame." + (interactive "p") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-followup count)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-followup-include-text-other-frame (count) + "Like vm-followup-include-text, but run in a newly created frame." + (interactive "p") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-followup-include-text count)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-forward-message-all-headers-other-frame () + "Like vm-forward-message-all-headers, but run in a newly created frame." + (interactive) + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-forward-message-all-headers)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-forward-message-other-frame () + "Like vm-forward-message, but run in a newly created frame." + (interactive) + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-forward-message)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-forward-message-plain-other-frame () + "Like vm-forward-message-plain, but run in a newly created frame." + (interactive) + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-forward-message-plain)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-resend-message-other-frame () + "Like vm-resend-message, but run in a newly created frame." + (interactive) + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-resend-message)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-resend-bounced-message-other-frame () + "Like vm-resend-bounced-message, but run in a newly created frame." + (interactive) + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-resend-bounced-message)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-send-digest-other-frame (&optional prefix) + "Like vm-send-digest, but run in a newly created frame." + (interactive "P") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-send-digest prefix)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-send-rfc934-digest-other-frame (&optional prefix) + "Like vm-send-rfc934-digest, but run in a newly created frame." + (interactive "P") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-send-rfc934-digest prefix)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-send-rfc1153-digest-other-frame (&optional prefix) + "Like vm-send-rfc1153-digest, but run in a newly created frame." + (interactive "P") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-send-rfc1153-digest prefix)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-send-mime-digest-other-frame (&optional prefix) + "Like vm-send-mime-digest, but run in a newly created frame." + (interactive "P") + (when (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-send-mime-digest prefix)) + (when (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +(defvar enriched-mode) + +;;;###autoload +(defun vm-preview-composition () + "Show how the current composition buffer might be displayed +in a MIME-aware mail reader. VM copies and encodes the current +mail composition buffer and displays it as a mail folder. +Type `q' to quit this temp folder and return to composing your +message." + (interactive) + (when (not (eq major-mode 'mail-mode)) + (error "Command must be used in a VM Mail mode buffer.")) + (let ((temp-buffer nil) + (mail-buffer (current-buffer)) + (enriched (and (boundp 'enriched-mode) enriched-mode)) + e-list) + (unwind-protect + (progn + (setq temp-buffer (generate-new-buffer "composition preview")) + (set-buffer temp-buffer) + ;; so vm-mime-xxxx-encode-composition won't complain + (setq major-mode 'mail-mode) + (set (make-local-variable 'enriched-mode) enriched) + (vm-insert-region-from-buffer mail-buffer) + (goto-char (point-min)) + (unless (vm-mail-mode-get-header-contents "From") + (insert "From: " (user-login-name) "\n")) + (unless (vm-mail-mode-get-header-contents "Message-ID") + (insert (format "Message-ID: <fake.%d.%d@fake.fake>\n" + (random 1000000) (random 1000000)))) + (unless (vm-mail-mode-get-header-contents "Date") + (insert "Date: " + (format-time-string "%a, %d %b %Y %T %z" + (current-time)) + "\n")) + (when (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:"))) + (vm-mime-encode-composition)) + (when vm-mail-reorder-message-headers + (vm-reorder-message-headers + nil :keep-list vm-mail-header-order :discard-regexp 'none)) + (vm-remove-mail-mode-header-separator) + (vm-munge-message-separators 'mmdf (point-min) (point-max)) + (goto-char (point-min)) + (insert (vm-leading-message-separator 'mmdf)) + (goto-char (point-max)) + (unless (eq (preceding-char) ?\n) + (insert ?\n)) + (insert (vm-trailing-message-separator 'mmdf)) + (set-buffer-modified-p nil) + ;; point of no return, don't kill it if the user quits + (setq temp-buffer nil) + (let ((vm-auto-decode-mime-messages t)) + (vm-save-buffer-excursion + (vm-goto-new-folder-frame-maybe 'folder) + (vm-mode))) + (vm-inform 5 + (substitute-command-keys + "Type \\[vm-quit] to continue composing your message")) + ;; temp buffer, don't offer to save it. + (setq buffer-offer-save nil) + (vm-display (or vm-presentation-buffer (current-buffer)) t + (list this-command) '(vm-mode startup))) + (when temp-buffer (kill-buffer temp-buffer))))) + +(defun vm-update-composition-buffer-name () + (when (and (eq major-mode 'mail-mode) + (save-match-data (string-match "^\\(mail\\|reply\\) to " + (buffer-name)))) + (let ((to (mail-fetch-field "To")) + (cc (mail-fetch-field "Cc")) + (curbufname (buffer-name)) + (deactivate-mark) + fmt newbufname + (ellipsis "")) + (cond (vm-reply-list (setq fmt "reply to %s%s")) + (t (setq fmt "mail to %s%s on \"%s\""))) + (setq to (vm-parse-addresses to) + cc (vm-parse-addresses cc)) + (when (or (cdr to) + (and (car to) (car cc))) + (setq ellipsis ", ...")) + (setq newbufname (or (car to) (car cc) "foo (?)") + newbufname (funcall vm-chop-full-name-function newbufname) + newbufname (or (car newbufname) (car (cdr newbufname))) + newbufname (format fmt newbufname ellipsis + (mail-fetch-field "Subject"))) + (unless (equal newbufname curbufname) + (setq newbufname (vm-sanitize-buffer-name newbufname)) + (rename-buffer newbufname t))))) + +;;;###autoload +(defun vm-mail-mode-remove-tm-hooks () + (remove-hook 'mail-setup-hook 'turn-on-mime-edit) + (remove-hook 'mail-setup-hook 'mime/decode-message-header) + (remove-hook 'mail-setup-hook 'mime/editor-mode) + (remove-hook 'mail-send-hook 'mime-edit-maybe-translate) + (remove-hook 'mail-send-hook 'mime-editor/maybe-translate)) + + +(defun vm-mail-mode-show-headers () + "Display any hidden headers in a composition buffer." + (interactive) + (mapc 'delete-overlay (overlays-in (point-min) + (save-excursion (mail-text) (point)))) + (if (local-variable-p 'line-move-ignore-invisible (current-buffer)) + (setq line-move-ignore-invisible nil))) + +(make-variable-buffer-local 'line-move-ignore-invisible) + +(defun vm-mail-mode-hide-headers () + "Hides and protects headers listed in `vm-mail-mode-hidden-headers'. +With a prefix arg, call `vm-mail-mode-show-headers' instead." + (interactive) + (let ((case-fold-search t) + (header-regexp (regexp-opt vm-mail-mode-hidden-headers)) + (header-end (save-excursion (mail-text) (point))) + start end o) + (setq header-regexp (concat "^" header-regexp)) + (setq line-move-ignore-invisible t) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward header-regexp header-end t) + (setq start (match-beginning 0) + end (1- (re-search-forward "^[^ \t]" header-end))) + (goto-char end) + (let ((o (or (car (overlays-at start)) + (make-overlay start end)))) + (when (not (overlay-get o 'invisible)) + (overlay-put o 'invisible t) + (overlay-put o 'read-only t))))))) + +;;;###autoload +(defun vm-dnd-attach-file (uri action) + "Insert a drag and drop file as a MIME attachment in a VM +composition buffer. URI is the url of the file as described in +`dnd-protocol-alist'. ACTION is ignored." + (let ((file (dnd-get-local-file-name uri t)) + type) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when (and file (file-regular-p file)) + (setq type (or (vm-mime-default-type-from-filename file) + "application/octet-stream")) + (vm-attach-file file type)))) + +;;;###autoload +(defun vm-ns-attach-file () + "Insert a drag and drop file as a MIME attachment in a VM +composition buffer. This is a version of `vm-dnd-attach-file' +that is needed for Mac and NextStep." + (interactive) + (let ((file (car ns-input-file)) + type) + (unless vm-send-using-mime + (error (concat "MIME attachments disabled, " + "set vm-send-using-mime non-nil to enable."))) + (when (and file (file-regular-p file)) + (setq ns-input-file (cdr ns-input-file)) + (setq type (or (vm-mime-default-type-from-filename file) + "application/octet-stream")) + (vm-attach-file file type)))) + +(defun vm-mail-mode-hide-headers-hook () + "Hook which handles `vm-mail-mode-hidden-headers'." + (when vm-mail-mode-hidden-headers + (vm-mail-mode-hide-headers))) + +(add-hook 'vm-mail-mode-hook 'vm-mail-mode-hide-headers-hook) + +;;; vm-reply.el ends here diff --git a/lisp/vm-rfaddons.el b/lisp/vm-rfaddons.el new file mode 100755 index 0000000..ce472ab --- /dev/null +++ b/lisp/vm-rfaddons.el @@ -0,0 +1,1947 @@ +;;; vm-rfaddons.el --- a collections of various useful VM helper functions +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 1999-2006 Robert Widhopf-Fenk +;; +;; Author: Robert Widhopf-Fenk +;; Status: Integrated into View Mail (aka VM), 8.0.x +;; Keywords: VM helpers +;; X-URL: http://bazaar.launchpad.net/viewmail + +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; Some of the functions should be unbundled into separate packages, +;; but well I'm a lazy guy. And some of them are not tested well. +;; +;; In order to use this package add the following lines to the _end_ of your +;; .vm file. It should be the _end_ in order to ensure that variable you had +;; been setting are honored! +;; +;; (require 'vm-rfaddons) +;; (vm-rfaddons-infect-vm) +;; +;; If you want to use only a subset of the functions you should have a +;; look at the documentation of `vm-rfaddons-infect-vm' and modify +;; its call as desired. +;; +;; Additional packages you may need are: +;; +;; * Package: Personality Crisis for VM +;; is a really cool package if you want to do automatic header rewriting, +;; e.g. if you have various mail accounts and always want to use the right +;; from header, then check it out! +;; +;; * Package: BBDB +;; Homepage: http://bbdb.sourceforge.net +;; +;; All other packages should be included within standard (X)Emacs +;; distributions. +;; +;; As I am no active GNU Emacs user, I would be thankful for any patches to +;; make things work with GNU Emacs! +;; +;;; Code: + +(provide 'vm-rfaddons) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-toolbar) + (require 'vm-mouse) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-crypto) + (require 'vm-mime) + (require 'vm-edit) + (require 'vm-virtual) + (require 'vm-pop) + (require 'vm-imap) + (require 'vm-sort) + (require 'vm-reply) + (require 'vm-pine) + (require 'wid-edit) + (require 'vm) +) + +(declare-function bbdb-record-raw-notes "ext:bbdb" (record)) +(declare-function bbdb-record-net "ext:bbdb " (record)) +(declare-function bbdb-split "ext:bbdb" (string separators)) +(declare-function bbdb-records "ext:bbdb" + (&optional dont-check-disk already-in-db-buffer)) + +(declare-function smtpmail-via-smtp-server "ext:smtpmail" ()) +(declare-function esmtpmail-send-it "ext:esmtpmail" ()) +(declare-function esmtpmail-via-smtp-server "ext:esmtpmail" ()) +(declare-function vm-folder-buffers "ext:vm" (&optional non-virtual)) + +(eval-when-compile + (require 'cl) + (require 'advice) + (vm-load-features '(regexp-opt bbdb bbdb-vm)) + ;; gnus-group removed from features because it gives errors. USR, 2011-01-26 + ) + +(require 'sendmail) +(vm-load-features '(bbdb)) + +(if vm-xemacs-p (require 'overlay)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup vm-rfaddons nil + "Customize vm-rfaddons.el" + :group 'vm-ext) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defmacro vm-rfaddons-check-option (option option-list &rest body) + "Evaluate body if option is in OPTION-LIST or OPTION-LIST is nil." + (list 'if (list 'member option option-list) + (cons 'progn + (cons (list 'setq option-list (list 'delq option option-list)) + (cons (list 'message "Adding vm-rfaddons-option `%s'." + option) + body))))) + +;;;###autoload +(defun vm-rfaddons-infect-vm (&optional sit-for + option-list exclude-option-list) + "This function will setup the key bindings, advices and hooks +necessary to use all the function of vm-rfaddons.el. + +SIT-FOR specifies the number of seconds to display the infection message. +The OPTION-LIST can be use to select individual option. +The EXCLUDE-OPTION-LIST can be use to exclude individual option. + +The following options are possible. + +`general' options: + - rf-faces: change some faces + +`vm-mail-mode' options: + - attach-save-files: bind [C-c C-a] to `vm-attach-files-in-directory' + - check-recipients: add `vm-mail-check-recipients' to `mail-send-hook' in + order to check if the recipients headers are correct. + - encode-headers: add `vm-mime-encode-headers' to `mail-send-hook' in + order to encode the headers before sending. + - fake-date: if enabled allows you to fake the date of an outgoing message. + +`vm-mode' options: + - shrunken-headers: enable shrunken-headers by advising several functions + +Other EXPERIMENTAL options: + - auto-save-all-attachments: add `vm-mime-auto-save-all-attachments' to + `vm-select-new-message-hook' for automatic saving of attachments and define + an advice for `vm-set-deleted-flag-of' in order to automatically delete + the files corresponding to MIME objects of type message/external-body when + deleting the message. + - return-receipt-to + +If you want to use only a subset of the options then call +`vm-rfaddons-infect-vm' like this: + (vm-rfaddons-infect-vm 2 '(general vm-mail-mode shrunken-headers) + '(fake-date)) +This will enable all `general' and `vm-mail-mode' options plus the +`shrunken-headers' option, but it will exclude the `fake-date' option of the +`vm-mail-mode' options. + +or do the binding and advising on your own." + (interactive "") + + (if (eq option-list 'all) + (setq option-list (list 'general 'vm-mail-mode 'vm-mode + 'auto-save-all-attachments + 'auto-delete-message-external-body)) + (if (eq option-list t) + (setq option-list (list 'vm-mail-mode 'vm-mode)))) + + (when (member 'general option-list) + (setq option-list (append '(rf-faces) + option-list)) + (setq option-list (delq 'general option-list))) + + (when (member 'vm-mail-mode option-list) + (setq option-list (append '(attach-save-files + check-recipients + check-for-empty-subject + encode-headers + clean-subject + fake-date + open-line) + option-list)) + (setq option-list (delq 'vm-mail-mode option-list))) + + (when (member 'vm-mode option-list) + (setq option-list (append '( + ;; save-all-attachments + shrunken-headers + take-action-on-attachment + ) + option-list)) + (setq option-list (delq 'vm-mode option-list))) + + (while exclude-option-list + (if (member (car exclude-option-list) option-list) + (setq option-list (delq (car exclude-option-list) option-list)) + (message "VM-RFADDONS: The option `%s' was not excluded, maybe it is unknown!" + (car exclude-option-list)) + (ding) + (sit-for 3)) + (setq exclude-option-list (cdr exclude-option-list))) + + ;; general ---------------------------------------------------------------- + ;; install my choice of faces + (vm-rfaddons-check-option + 'rf-faces option-list + (vm-install-rf-faces)) + + ;; vm-mail-mode ----------------------------------------------------------- + (vm-rfaddons-check-option + 'attach-save-files option-list + ;; this binding overrides the VM binding of C-c C-a to `vm-attach-file' + (define-key vm-mail-mode-map "\C-c\C-a" 'vm-attach-files-in-directory)) + + ;; check recipients headers for errors before sending + (vm-rfaddons-check-option + 'check-recipients option-list + (add-hook 'mail-send-hook 'vm-mail-check-recipients)) + + ;; check if the subjectline is empty + (vm-rfaddons-check-option + 'check-for-empty-subject option-list + (add-hook 'vm-mail-send-hook 'vm-mail-check-for-empty-subject)) + + ;; encode headers before sending + (vm-rfaddons-check-option + 'encode-headers option-list + (add-hook 'mail-send-hook 'vm-mime-encode-headers)) + + ;; This allows us to fake a date by advising vm-mail-mode-insert-date-maybe + (vm-rfaddons-check-option + 'fake-date option-list + (defadvice vm-mail-mode-insert-date-maybe (around vm-fake-date activate) + "Do not change an existing date if `vm-mail-mode-fake-date-p' is t." + (if (not (and vm-mail-mode-fake-date-p + (vm-mail-mode-get-header-contents "Date:"))) + ad-do-it))) + + (vm-rfaddons-check-option + 'open-line option-list + (add-hook 'vm-mail-mode-hook 'vm-mail-mode-install-open-line)) + + (vm-rfaddons-check-option + 'clean-subject option-list + (add-hook 'vm-mail-mode-hook 'vm-mail-subject-cleanup)) + + ;; vm-mode ----------------------------------------------------------- + + ;; Shrunken header handlers + (vm-rfaddons-check-option + 'shrunken-headers option-list + (if (not (boundp 'vm-always-use-presentation)) + (message "Shrunken-headers do NOT work in standard VM!") + ;; We would corrupt the folder buffer for messages which are + ;; not displayed by a presentation buffer, thus we must ensure + ;; that a presentation buffer is used. The visibility-widget + ;; would cause "*"s to be inserted into the folder buffer. + (setq vm-always-use-presentation t) + (defadvice vm-present-current-message + (after vm-shrunken-headers-pcm activate) + "Shrink headers when previewing a message." + (vm-shrunken-headers)) + (defadvice vm-expose-hidden-headers + (after vm-shrunken-headers-ehh activate) + "Shrink headers when viewing hidden headers." + (vm-shrunken-headers)) + ;; this overrides the VM binding of "T" to `vm-toggle-thread' + (define-key vm-mode-map "T" 'vm-shrunken-headers-toggle))) + +;; This is not needed any more because VM has $ commands to take +;; action on attachments. But we keep it for compatibility. + + ;; take action on attachment binding + (vm-rfaddons-check-option + 'take-action-on-attachment option-list + ;; this overrides the VM binding of "." to `vm-mark-message-as-read' + (define-key vm-mode-map "." 'vm-mime-take-action-on-attachment)) + +;; This is not needed any more becaue it is in the core +;; (vm-rfaddons-check-option +;; 'save-all-attachments option-list +;; (define-key vm-mode-map "\C-c\C-s" 'vm-save-all-attachments)) + + ;; other experimental options --------------------------------------------- + ;; Now take care of automatic saving of attachments + (vm-rfaddons-check-option + 'auto-save-all-attachments option-list + ;; In order to reflect MIME type changes when `vm-mime-delete-after-saving' + ;; is t we preview the message again. + (defadvice vm-mime-send-body-to-file + (after vm-do-preview-again activate) + (if vm-mime-delete-after-saving + (vm-present-current-message))) + (add-hook 'vm-select-new-message-hook 'vm-mime-auto-save-all-attachments)) + + (vm-rfaddons-check-option + 'auto-delete-message-external-body option-list + ;; and their deletion when deleting a unfiled message, + ;; this is probably a problem, since actually we should delete it + ;; only if there remains no reference to it!!!! + (defadvice vm-set-deleted-flag-of + (before vm-mime-auto-save-all-attachments activate) + (if (and (eq (ad-get-arg 1) 'expunged) + (not (vm-filed-flag (ad-get-arg 0)))) + (vm-mime-auto-save-all-attachments-delete-external (ad-get-arg 0))))) + + (vm-rfaddons-check-option + 'return-receipt-to option-list + (add-hook 'vm-select-message-hook 'vm-handle-return-receipt)) + + (when option-list + (message "VM-RFADDONS: The following options are unknown: %s" option-list) + (ding) + (sit-for 3)) + + (message "VM-RFADDONS: Options loaded.") + (vm-sit-for (or sit-for 2))) + +(defun rf-vm-su-labels (m) + "This version does some sanity checking." + (let ((labels (vm-label-string-of m))) + (if (and labels (stringp labels)) + labels + (setq labels (vm-labels-of m)) + (if (and labels (listp labels)) + (vm-set-label-string-of + m + (setq labels (mapconcat 'identity labels ","))) + (vm-set-label-string-of m "") + (setq labels ""))) + labels)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This add-on is now obsolete because +;; vm-include-text-from-presentation in core VM enables the same +;; functionality. USR, 2011-03-30 + +(defcustom vm-reply-include-presentation nil + "*If true a reply will include the presentation of a message. +This might give better results when using filling or MIME encoded messages, +e.g. HTML message. + (This variable is part of vm-rfaddons.el.)" + :group 'vm-rfaddons + :type 'boolean) + +;;;###autoload +(defun vm-followup-include-presentation (count) + "Include presentation instead of text. +This does not work when replying to multiple messages." + (interactive "p") + (vm-reply-include-presentation count t)) +(make-obsolete 'vm-followup-include-presentation + 'vm-include-text-from-presentation "8.2.0") + +;;;###autoload +(defun vm-reply-include-presentation (count &optional to-all) + "Include presentation instead of text. +This does only work with my modified VM, i.e. a hacked `vm-yank-message'." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if (null vm-presentation-buffer) + (if to-all + (vm-followup-include-text count) + (vm-reply-include-text count)) + (let ((vm-include-text-from-presentation t) + (vm-reply-include-presentation t) ; is this variable necessary? + (vm-enable-thread-operations nil)) + (vm-do-reply to-all t count)))) +(make-obsolete 'vm-reply-include-presentation + 'vm-include-text-from-presentation "8.2.0") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This add-on is disabled becaust it has been integrated into the +;; core. USR, 2010-05-01 + +;; (defadvice vm-mime-encode-composition +;; (before do-fcc-before-mime-encode activate) +;; "FCC before encoding attachments if `vm-do-fcc-before-mime-encode' is t." +;; (if vm-do-fcc-before-mime-encode +;; (vm-do-fcc-before-mime-encode))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This has been moved to the VM core. USR, 2010-03-11 +;;;;;###autoload +;; (defun vm-fill-paragraphs-by-longlines (width start end) +;; "Uses longlines.el for filling. +;; To use it, advice `vm-fill-paragraphs-containing-long-lines' and call this +;; function instead." +;; (if (eq width 'window-width) +;; (setq width (- (window-width (get-buffer-window (current-buffer))) 1))) +;; ;; prepare for longlines.el in XEmacs +;; (require 'overlay) +;; (require 'longlines) +;; (defvar fill-nobreak-predicate nil) +;; (defvar undo-in-progress nil) +;; (defvar longlines-mode-hook nil) +;; (defvar longlines-mode-on-hook nil) +;; (defvar longlines-mode-off-hook nil) +;; (unless (functionp 'replace-regexp-in-string) +;; (defun replace-regexp-in-string (regexp rep string +;; &optional fixedcase literal) +;; (vm-replace-in-string string regexp rep literal))) +;; (unless (functionp 'line-end-position) +;; (defun line-end-position () +;; (save-excursion (end-of-line) (point)))) +;; (unless (functionp 'line-beginning-position) +;; (defun line-beginning-position (&optional n) +;; (save-excursion +;; (if n (forward-line n)) +;; (beginning-of-line) +;; (point))) +;; (unless (functionp 'replace-regexp-in-string) +;; (defun replace-regexp-in-string (regexp rep string +;; &optional fixedcase literal) +;; (vm-replace-in-string string regexp rep literal)))) +;; ;; now do the filling +;; (let ((buffer-read-only nil) +;; (fill-column width)) +;; (save-excursion +;; (vm-save-restriction +;; ;; longlines-wrap-region contains a (forward-line -1) which is causing +;; ;; wrapping of headers which is wrong, so we restrict it here! +;; (narrow-to-region start end) +;; (longlines-decode-region start end) ; make linebreaks hard +;; (longlines-wrap-region start end) ; wrap, adding soft linebreaks +;; (widen))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-spamassassin-strip-report "spamassassin -d" + "*Shell command used to strip spamassassin-reports from a message." + :type 'string + :group 'vm-rfaddons) + +(defun vm-strip-spamassassin-report () + "Strips spamassassin-reports from a message." + (interactive) + (save-window-excursion + (let ((vm-frame-per-edit nil)) + (vm-edit-message) + (shell-command-on-region (point-min) (point-max) + vm-spamassassin-strip-report + (current-buffer) + t) + (vm-edit-message-end)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; vm-switch-to-folder moved to vm.el. USR, 2011-02-28 + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-rmail-mode nil + "*Non-nil means up/down move to the next/previous message instead. +Otherwise normal cursor movement is done. Specifically only modes +listed in `vm-rmail-mode-list' are affected. +Use `vm-rmail-toggle' to switch between normal and this mode." + :type 'boolean + :group 'vm-rfaddons) + +(defcustom vm-rmail-mode-list '(vm-summary-mode) + "*Mode to activate `vm-rmail-mode' in." + :type '(set (const vm-mode) + (const vm-presentation-mode) + (const vm-virtual-mode) + (const vm-summary-mode)) + :group 'vm-rfaddons) + +(defun vm-rmail-toggle (&optional arg) + (interactive) + (cond ((eq nil arg) + (setq vm-rmail-mode (not vm-rmail-mode))) + ((= 1 arg) + (setq vm-rmail-mode t)) + ((= -1 arg) + (setq vm-rmail-mode nil)) + (t + (setq vm-rmail-mode (not vm-rmail-mode)))) + (message (if vm-rmail-mode "Rmail cursor mode" "VM cursor mode"))) + +(defun vm-rmail-up () + (interactive) + (cond ((and vm-rmail-mode (member major-mode vm-rmail-mode-list)) + (vm-next-message -1) + (vm-display nil nil '(rf-vm-rmail-up vm-previous-message) + (list this-command))) + (t + (forward-line -1)))) + +(defun vm-rmail-down () + (interactive) + (cond ((and vm-rmail-mode (member major-mode vm-rmail-mode-list)) + (vm-next-message 1) + (vm-display nil nil '(rf-vm-rmail-up vm-next-message) + (list this-command))) + (t + (forward-line 1)))) + +(defun vm-do-with-message (count function vm-display) + (vm-follow-summary-cursor) + (save-excursion + (vm-select-folder-buffer) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Operate on"))) + (while mlist + (funcall function (car mlist)) + (vm-mark-for-summary-update (car mlist) t) + (setq mlist (cdr mlist)))) + (vm-display nil nil (append vm-display '(vm-do-with-message)) + (list this-command)) + (vm-update-summary-and-mode-line))) + +(defun vm-toggle-mark (count &optional m) + (interactive "p") + (vm-do-with-message + count + (lambda (m) (vm-set-mark-of m (not (vm-mark-of m)))) + '(vm-toggle-mark vm-mark-message marking-message))) + +(defun vm-toggle-deleted (count &optional m) + (interactive "p") + (vm-do-with-message + count + (lambda (m) (vm-set-deleted-flag m (not (vm-deleted-flag m)))) + '(vm-toggle-deleted vm-delete-message vm-delete-message-backward))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-mail-subject-prefix-replacements + '(("\\(\\(re\\|aw\\|antw\\)\\(\\[[0-9]+\\]\\)?:[ \t]*\\)+" . "Re: ") + ("\\(\\(fo\\|wg\\)\\(\\[[0-9]+\\]\\)?:[ \t]*\\)+" . "Fo: ")) + "*List of subject prefixes which should be replaced. +Matching will be done case insentivily." + :group 'vm-rfaddons + :type '(repeat (cons (regexp :tag "Regexp") + (string :tag "Replacement")))) + +(defcustom vm-mail-subject-number-reply nil + "*Non-nil means, add a number [N] after the reply prefix. +The number reflects the number of references." + :group 'vm-rfaddons + :type '(choice + (const :tag "on" t) + (const :tag "off" nil))) + +(defun vm-mail-subject-cleanup () + "Do some subject line clean up. +- Replace subject prefixes according to `vm-replace-subject-prefixes'. +- Add a number after replies is `vm-mail-subject-number-reply' is t. + +You might add this function to `vm-mail-mode-hook' in order to clean up the +Subject header." + (interactive) + (save-excursion + ;; cleanup + (goto-char (point-min)) + (re-search-forward + (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + (point-max)) + (let ((case-fold-search t) + (rpl vm-mail-subject-prefix-replacements)) + (while rpl + (if (re-search-backward (concat "^Subject:[ \t]*" (caar rpl)) + (point-min) t) + (replace-match (concat "Subject: " (cdar rpl)))) + (setq rpl (cdr rpl)))) + + ;; add number to replys + (let (refs (start 0) end (count 0)) + (when (and vm-mail-subject-number-reply vm-reply-list + (setq refs (vm-mail-mode-get-header-contents "References:"))) + (while (string-match "<[^<>]+>" refs start) + (setq count (1+ count) + start (match-end 0))) + (when (> count 1) + (mail-position-on-field "Subject" t) + (setq end (point)) + (if (re-search-backward "^Subject:" (point-min) t) + (setq start (point)) + (error "Could not find end of Subject header start")) + (goto-char start) + (if (not (re-search-forward (regexp-quote vm-reply-subject-prefix) + end t)) + (error "Cound not find vm-reply-subject-prefix `%s' in header" + vm-reply-subject-prefix) + (goto-char (match-end 0)) + (skip-chars-backward ": \t") + (insert (format "[%d]" count)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-mime-set-8bit-composition-charset (charset &optional buffer-local) + "*Set `vm-mime-8bit-composition-charset' to CHARSET. +With the optional BUFFER-LOCAL prefix arg, this only affects the current +buffer." + (interactive (list (completing-read "Composition charset: " + vm-mime-charset-completion-alist + nil t) + current-prefix-arg)) + (if (or vm-xemacs-mule-p vm-fsfemacs-p) + (error "vm-mime-8bit-composition-charset has no effect in XEmacs/MULE")) + (if buffer-local + (set (make-local-variable 'vm-mime-8bit-composition-charset) charset) + (setq vm-mime-8bit-composition-charset charset))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun bbdb/vm-set-virtual-folder-alist () + "Create a `vm-virtual-folder-alist' according to the records in the bbdb. +For each record that has a 'vm-virtual' attribute, add or modify the +corresponding BBDB-VM-VIRTUAL element of the `vm-virtual-folder-alist'. + + (BBDB-VM-VIRTUAL ((vm-primary-inbox) + (author-or-recipient BBDB-RECORD-NET-REGEXP))) + +The element gets added to the 'element-name' sublist of the +`vm-virtual-folder-alist'." + (interactive) + (let (notes-field email-regexp folder selector) + (dolist (record (bbdb-records)) + (setq notes-field (bbdb-record-raw-notes record)) + (when (and (listp notes-field) + (setq folder (cdr (assq 'vm-virtual notes-field)))) + (setq email-regexp (mapconcat (lambda (addr) + (regexp-quote addr)) + (bbdb-record-net record) "\\|")) + (unless (zerop (length email-regexp)) + (setq folder (or (assoc folder vm-virtual-folder-alist) + (car + (setq vm-virtual-folder-alist + (nconc (list (list folder + (list (list vm-primary-inbox) + (list 'author-or-recipient)))) + vm-virtual-folder-alist)))) + folder (cadr folder) + selector (assoc 'author-or-recipient folder)) + + (if (cdr selector) + (if (not (string-match (regexp-quote email-regexp) + (cadr selector))) + (setcdr selector (list (concat (cadr selector) "\\|" + email-regexp)))) + (nconc selector (list email-regexp))))) + ) + )) + +(defun vm-virtual-find-selector (selector-spec type) + "Return the first selector of TYPE in SELECTOR-SPEC." + (let ((s (assoc type selector-spec))) + (unless s + (while (and (not s) selector-spec) + (setq s (and (listp (car selector-spec)) + (vm-virtual-find-selector (car selector-spec) type)) + selector-spec (cdr selector-spec)))) + s)) + +(defcustom bbdb/vm-virtual-folder-alist-by-mail-alias-alist nil + "*A list of (ALIAS . FOLDER-NAME) pairs, which map an alias to a folder." + :group 'vm-rfaddons + :type '(repeat (cons :tag "Mapping Definition" + (regexp :tag "Alias") + (string :tag "Folder Name")))) + +(defun bbdb/vm-set-virtual-folder-alist-by-mail-alias () + "Create a `vm-virtual-folder-alist' according to the records in the bbdb. +For each record check wheather its alias is in the variable +`bbdb/vm-virtual-folder-alist-by-mail-alias-alist' and then +add/modify the corresponding VM-VIRTUAL element of the +`vm-virtual-folder-alist'. + + (BBDB-VM-VIRTUAL ((vm-primary-inbox) + (author-or-recipient BBDB-RECORD-NET-REGEXP))) + +The element gets added to the 'element-name' sublist of the +`vm-virtual-folder-alist'." + (interactive) + (let (notes-field email-regexp mail-aliases folder selector) + (dolist (record (bbdb-records)) + (setq notes-field (bbdb-record-raw-notes record)) + (when (and (listp notes-field) + (setq mail-aliases (cdr (assq 'mail-alias notes-field))) + (setq mail-aliases (bbdb-split mail-aliases ","))) + (setq folder nil) + (while mail-aliases + (setq folder + (assoc (car mail-aliases) + bbdb/vm-virtual-folder-alist-by-mail-alias-alist)) + + (when (and folder + (setq folder (cdr folder) + email-regexp (mapconcat (lambda (addr) + (regexp-quote addr)) + (bbdb-record-net record) + "\\|")) + (> (length email-regexp) 0)) + (setq folder (or (assoc folder vm-virtual-folder-alist) + (car + (setq vm-virtual-folder-alist + (nconc + (list + (list folder + (list (list vm-primary-inbox) + (list 'author-or-recipient)) + )) + vm-virtual-folder-alist)))) + folder (cadr folder) + selector (vm-virtual-find-selector folder + 'author-or-recipient)) + (unless selector + (nconc (cdr folder) (list (list 'author-or-recipient)))) + (if (cdr selector) + (if (not (string-match (regexp-quote email-regexp) + (cadr selector))) + (setcdr selector (list (concat (cadr selector) "\\|" + email-regexp)))) + (nconc selector (list email-regexp)))) + (setq mail-aliases (cdr mail-aliases))) + )))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-handle-return-receipt-mode 'edit + "*Tells `vm-handle-return-receipt' how to handle return receipts. +One can choose between 'ask, 'auto, 'edit or an expression which is evaluated +and which should return t if the return receipts should be sent." + :group 'vm-rfaddons + :type '(choice (const :tag "Edit" edit) + (const :tag "Ask" ask) + (const :tag "Auto" auto))) + +(defcustom vm-handle-return-receipt-peek 500 + "*Number of characters from the original message body to be returned." + :group 'vm-rfaddons + :type '(integer)) + +(defun vm-handle-return-receipt () + "Generate a reply to the current message if it requests a return receipt +and has not been replied so far. +See the variable `vm-handle-return-receipt-mode' for customization." + (interactive) + (save-excursion + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let* ((msg (car vm-message-pointer)) + (sender (vm-get-header-contents msg "Return-Receipt-To:")) + (mail-signature nil) + (mode (and sender + (cond ((equal 'ask vm-handle-return-receipt-mode) + (y-or-n-p "Send a return receipt? ")) + ((symbolp vm-handle-return-receipt-mode) + vm-handle-return-receipt-mode) + (t + (eval vm-handle-return-receipt-mode))))) + (vm-mutable-frame-configuration + (if (eq mode 'edit) vm-mutable-frame-configuration nil)) + (vm-mail-mode-hook nil) + (vm-mode-hook nil) + message) + (when (and mode (not (vm-replied-flag msg))) + (vm-reply 1) + (vm-mail-mode-remove-header "Return-Receipt-To:") + (vm-mail-mode-remove-header "To:") + (goto-char (point-min)) + (insert "To: " sender "\n") + (mail-text) + (delete-region (point) (point-max)) + (insert + (format + "Your mail has been received on %s." + (current-time-string))) + (save-restriction + (save-excursion + (set-buffer (vm-buffer-of msg)) + (widen) + (setq message + (buffer-substring + (vm-vheaders-of msg) + (let ((tp (+ vm-handle-return-receipt-peek + (marker-position + (vm-text-of msg)))) + (ep (marker-position + (vm-end-of msg)))) + (if (< tp ep) tp ep)) + )))) + (insert "\n-----------------------------------------------------------------------------\n" + message) + (if (re-search-backward "^\\s-+.*" (point-min) t) + (replace-match "")) + (insert "[...]\n") + (if (not (eq mode 'edit)) + (vm-mail-send-and-exit nil)) + ) + ))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defalias 'vm-mime-find-type-of-message/external-body + 'vm-mf-external-body-content-type) +(make-obsolete 'vm-mime-find-type-of-message/external-body + 'vm-mf-external-body-content-type "8.2.0") + +;; This is a hack in order to get the right MIME button +;(defadvice vm-mime-set-extent-glyph-for-type +; (around vm-message/external-body-glyph activate) +; (if (and (boundp 'real-mime-type) +; (string= (ad-get-arg 1) "message/external-body")) +; (ad-set-arg 1 real-mime-type)) +; ad-do-it) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar vm-attach-files-in-directory-regexps-history nil + "Regexp history for matching files.") +(defvaralias 'vm-mime-attach-files-in-directory-regexps-history + 'vm-attach-files-in-directory-regexps-history) + +(defcustom vm-attach-files-in-directory-default-type nil + "*The default MIME-type for attached files. +If set to nil you will be asked for the type if it cannot be guessed. +For guessing mime-types we use `vm-mime-attachment-auto-type-alist'." + :group 'vm-rfaddons + :type '(choice (const :tag "Ask" nil) + (string "application/octet-stream"))) +(defvaralias 'vm-mime-attach-files-in-directory-default-type + 'vm-attach-files-in-directory-default-type) + +(defcustom vm-attach-files-in-directory-default-charset 'guess + "*The default charset used for attached files of type `text'. +If set to nil you will be asked for the charset. +If set to 'guess it will be determined by `vm-determine-proper-charset', but +this may take some time, since the file needs to be visited." + :group 'vm-rfaddons + :type '(choice (const :tag "Ask" nil) + (const :tag "Guess" guess))) +(defvaralias 'vm-mime-attach-files-in-directory-default-charset + 'vm-attach-files-in-directory-default-charset) + +;; (define-obsolete-variable-alias 'vm-mime-save-all-attachments-types +;; 'vm-mime-saveable-types +;; "8.3.0" +;; "*List of MIME types which should be saved.") +(defvaralias 'vm-mime-save-all-attachments-types + 'vm-mime-saveable-types) +(make-obsolete-variable 'vm-mime-save-all-attachments-types + 'vm-mime-saveable-types "8.1.1") + +;; (define-obsolete-variable-alias +;; 'vm-mime-save-all-attachments-types-exceptions +;; 'vm-mime-saveable-type-exceptions +;; "8.3.0" +;; "*List of MIME types which should not be saved.") +(defvaralias 'vm-mime-save-all-attachments-types-exceptions + 'vm-mime-saveable-type-exceptions) +(make-obsolete-variable 'vm-mime-save-all-attachments-types-exceptions + 'vm-mime-saveable-type-exceptions "8.1.1") + +;; (define-obsolete-variable-alias 'vm-mime-delete-all-attachments-types +;; 'vm-mime-deleteable-types +;; "8.3.0" +;; "*List of MIME types which should be deleted.") +(defvaralias 'vm-mime-delete-all-attachments-types + 'vm-mime-deleteable-types) +(make-obsolete-variable 'vm-mime-delete-all-attachments-types + 'vm-mime-deleteable-types "8.1.1") + +;; (define-obsolete-variable-alias +;; 'vm-mime-delete-all-attachments-types-exceptions +;; 'vm-mime-deleteable-type-exceptions +;; "8.3.0" +;; "*List of MIME types which should not be deleted.") +(defvaralias 'vm-mime-delete-all-attachments-types-exceptions + 'vm-mime-deleteable-type-exceptions) +(make-obsolete-variable 'vm-mime-delete-all-attachments-types-exceptions + 'vm-mime-deleteable-type-exceptions "8.1.1") + +;;;###autoload +(defun vm-attach-files-in-directory (directory &optional regexp) + "Attach all files in DIRECTORY matching REGEXP. +The optional argument MATCH might specify a regexp matching all files +which should be attached, when empty all files will be attached. + +When called with a prefix arg it will do a literal match instead of a regexp +match." + (interactive + (flet ((substitute-in-file-name (file) file)) + (let ((file (vm-read-file-name + "Attach files matching regexp: " + (or vm-mime-all-attachments-directory + vm-mime-attachment-save-directory + default-directory) + (or vm-mime-all-attachments-directory + vm-mime-attachment-save-directory + default-directory) + nil nil + vm-attach-files-in-directory-regexps-history))) + (list (file-name-directory file) + (file-name-nondirectory file))))) + + (setq vm-mime-all-attachments-directory directory) + + (message "Attaching files matching `%s' from directory %s " regexp directory) + + (if current-prefix-arg + (setq regexp (concat "^" (regexp-quote regexp) "$"))) + + (let ((files (directory-files directory t regexp nil)) + file type charset) + (if (null files) + (error "No matching files!") + (while files + (setq file (car files)) + (if (file-directory-p file) + nil ;; should we add recursion here? + (setq type (or (vm-mime-default-type-from-filename file) + vm-attach-files-in-directory-default-type)) + (message "Attaching file %s with type %s ..." file type) + (if (null type) + (let ((default-type (or (vm-mime-default-type-from-filename file) + "application/octet-stream"))) + (setq type (completing-read + (format "Content type for %s (default %s): " + (file-name-nondirectory file) + default-type) + vm-mime-type-completion-alist) + type (if (> (length type) 0) type default-type)))) + (if (not (vm-mime-types-match "text" type)) nil + (setq charset vm-attach-files-in-directory-default-charset) + (cond ((eq 'guess charset) + (save-excursion + (let ((b (get-file-buffer file))) + (set-buffer (or b (find-file-noselect file t t))) + (setq charset (vm-determine-proper-charset (point-min) + (point-max))) + (if (null b) (kill-buffer (current-buffer)))))) + ((null charset) + (setq charset + (completing-read + (format "Character set for %s (default US-ASCII): " + file) + vm-mime-charset-completion-alist) + charset (if (> (length charset) 0) charset))))) + (vm-attach-file file type charset)) + (setq files (cdr files)))))) +(defalias 'vm-mime-attach-files-in-directory 'vm-attach-files-in-directory) + +(defcustom vm-mime-auto-save-all-attachments-subdir + nil + "*Subdirectory where to save the attachments of a message. +This variable might be set to a string, a function or anything which evaluates +to a string. If set to nil we use a concatenation of the from, subject and +date header as subdir for the attachments." + :group 'vm-rfaddons + :type '(choice (directory :tag "Directory") + (string :tag "No Subdir" "") + (function :tag "Function") + (sexp :tag "sexp"))) + +(defun vm-mime-auto-save-all-attachments-subdir (msg) + "Return a subdir for the attachments of MSG. +This will be done according to `vm-mime-auto-save-all-attachments-subdir'." + (setq msg (vm-real-message-of msg)) + (when (not (string-match + (regexp-quote (vm-reencode-mime-encoded-words-in-string + (vm-su-full-name msg))) + (vm-get-header-contents msg "From:"))) + (backtrace) + (if (y-or-n-p (format "Is this wrong? %s <> %s " + (vm-su-full-name msg) + (vm-get-header-contents msg "From:"))) + (error "Yes it is wrong!"))) + + (cond ((functionp vm-mime-auto-save-all-attachments-subdir) + (funcall vm-mime-auto-save-all-attachments-subdir msg)) + ((stringp vm-mime-auto-save-all-attachments-subdir) + (vm-summary-sprintf vm-mime-auto-save-all-attachments-subdir msg)) + ((null vm-mime-auto-save-all-attachments-subdir) + (let (;; for the folder + (basedir (buffer-file-name (vm-buffer-of msg))) + ;; for the message + (subdir (concat + "/" + (format "%04s.%02s.%02s-%s" + (vm-su-year msg) + (vm-su-month-number msg) + (vm-su-monthday msg) + (vm-su-hour msg)) + "--" + (or (vm-su-full-name msg) + "unknown") + "--" + (vm-su-subject msg)))) + + (if (and basedir vm-folder-directory + (string-match + (concat "^" (expand-file-name vm-folder-directory)) + basedir)) + (setq basedir (replace-match "" nil nil basedir))) + + (setq subdir (vm-replace-in-string subdir "\\s-\\s-+" " " t)) + (setq subdir (vm-replace-in-string subdir "[^A-Za-z0-9\241-_-]+" "_" t)) + (setq subdir (vm-replace-in-string subdir "?_-?_" "-" nil)) + (setq subdir (vm-replace-in-string subdir "^_+" "" t)) + (setq subdir (vm-replace-in-string subdir "_+$" "" t)) + (concat basedir "/" subdir))) + (t + (eval vm-mime-auto-save-all-attachments-subdir)))) + +(defun vm-mime-auto-save-all-attachments-path (msg) + "Create a path for storing the attachments of MSG." + (let ((subdir (vm-mime-auto-save-all-attachments-subdir + (vm-real-message-of msg)))) + (if (not vm-mime-attachment-save-directory) + (error "Set `vm-mime-attachment-save-directory' for autosaving of attachments") + (if subdir + (if (string-match "/$" vm-mime-attachment-save-directory) + (concat vm-mime-attachment-save-directory subdir) + (concat vm-mime-attachment-save-directory "/" subdir)) + vm-mime-attachment-save-directory)))) + +;;;###autoload +(defun vm-mime-auto-save-all-attachments (&optional count) + "Save all attachments to a subdirectory. +Root directory for saving is `vm-mime-attachment-save-directory'. + +You might add this to `vm-select-new-message-hook' in order to automatically +save attachments. + + (add-hook 'vm-select-new-message-hook 'vm-mime-auto-save-all-attachments) +" + (interactive "P") + + (if vm-mime-auto-save-all-attachments-avoid-recursion + nil + (let ((vm-mime-auto-save-all-attachments-avoid-recursion t)) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + + (vm-save-all-attachments + count + 'vm-mime-auto-save-all-attachments-path) + + (when (vm-interactive-p) + (vm-discard-cached-data) + (vm-present-current-message))))) + +;;;###autoload +(defun vm-mime-auto-save-all-attachments-delete-external (msg) + "Deletes the external attachments created by `vm-save-all-attachments'. +You may want to use this function in order to get rid of the external files +when deleting a message. + +See the advice in `vm-rfaddons-infect-vm'." + (interactive "") + (vm-check-for-killed-folder) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (setq msg (or msg (car vm-message-pointer))) + (if msg + (let ((o (vm-mm-layout msg)) + (no 0) + parts layout file type) + + (if (eq 'none o) + nil;; this is no mime message + (setq type (car (vm-mm-layout-type o))) + + (cond ((or (vm-mime-types-match "multipart/alternative" type) + (vm-mime-types-match "multipart/mixed" type)) + (setq parts (copy-sequence (vm-mm-layout-parts o)))) + (t (setq parts (list o)))) + + (while parts + (if (vm-mime-composite-type-p + (car (vm-mm-layout-type (car parts)))) + (setq parts (nconc (copy-sequence + (vm-mm-layout-parts + (car parts))) + (cdr parts)))) + + (setq layout (car parts)) + (if layout + (setq type (car (vm-mm-layout-type layout)))) + + (if (not (string= type "message/external-body")) + nil + (setq file (vm-mime-get-parameter layout "name")) + (if (and file (file-exists-p file)) + (progn (delete-file file) + (setq no (+ 1 no))))) + (setq parts (cdr parts)))) + + (if (> no 0) + (message "%s file%s deleted." + (if (= no 1) "One" no) + (if (= no 1) "" "s"))) + + (if (and file + (file-name-directory file) + (file-exists-p (file-name-directory file)) + ;; is the directory empty? + (let ((files (directory-files (file-name-directory file)))) + (and files (= 2 (length files))))) + (delete-directory (file-name-directory file)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-mail-check-recipients () + "Check if the recipients are specified correctly. +Actually it checks only if there are any missing commas or the like in the +headers." + (interactive) + (let ((header-list '("To:" "CC:" "BCC:" + "Resent-To:" "Resent-CC:" "Resent-BCC:")) + (contents nil) + (errors nil)) + (while header-list + (setq contents (vm-mail-mode-get-header-contents (car header-list))) + (if (and contents (string-match "@[^,\"]*@" contents)) + (setq errors (vm-replace-in-string + (format "Missing separator in %s \"%s\"! " + (car header-list) + (match-string 0 contents)) + "[\n\t ]+" " "))) + (setq header-list (cdr header-list))) + (if errors + (error errors)))) + + +(defcustom vm-mail-prompt-if-subject-empty t + "*Prompt for a subject when empty." + :group 'vm-rfaddons + :type '(boolean)) + +;;;###autoload +(defun vm-mail-check-for-empty-subject () + "Check if the subject line is empty and issue an error if so." + (interactive) + (let (subject) + (setq subject (vm-mail-mode-get-header-contents "Subject:")) + (if (or (not subject) (string-match "^[ \t]*$" subject)) + (if (not vm-mail-prompt-if-subject-empty) + (error "Empty subject") + (mail-position-on-field "Subject") + (insert (read-string "Subject: ")))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defface vm-shrunken-headers-face + '((((class color) (background light)) + (:background "grey")) + (((class color) (background dark)) + (:background "DimGrey")) + (t (:dim t))) + "Used for marking shrunken headers." + :group 'vm-rfaddons) + +(defconst vm-shrunken-headers-keymap + (let ((map (if vm-xemacs-p (make-keymap) (copy-keymap vm-mode-map)))) + (define-key map [(return)] 'vm-shrunken-headers-toggle-this) + (if vm-xemacs-p + (define-key map [(button2)] 'vm-shrunken-headers-toggle-this-mouse) + (define-key map [(mouse-2)] 'vm-shrunken-headers-toggle-this-mouse)) + map) + "Keymap used for shrunken-headers glyphs.") + +;;;###autoload +(defun vm-shrunken-headers-toggle () + "Toggle display of shrunken headers." + (interactive) + (vm-shrunken-headers 'toggle)) + +;;;###autoload +(defun vm-shrunken-headers-toggle-this-mouse (&optional event) + "Toggle display of shrunken headers." + (interactive "e") + (mouse-set-point event) + (end-of-line) + (vm-shrunken-headers-toggle-this)) + +;;;###autoload +(defun vm-shrunken-headers-toggle-this-widget (widget &rest event) + (goto-char (widget-get widget :to)) + (end-of-line) + (vm-shrunken-headers-toggle-this)) + +;;;###autoload +(defun vm-shrunken-headers-toggle-this () + "Toggle display of shrunken headers." + (interactive) + + (save-excursion + (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer)) + (set-buffer (symbol-value 'vm-mail-buffer))) + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer)) + (let ((o (or (car (vm-shrunken-headers-get-overlays (point))) + (car (vm-shrunken-headers-get-overlays + (save-excursion (end-of-line) + (forward-char 1) + (point))))))) + (save-restriction + (narrow-to-region (- (overlay-start o) 7) (overlay-end o)) + (vm-shrunken-headers 'toggle) + (widen))))) + +(defun vm-shrunken-headers-get-overlays (start &optional end) + (let ((o-list (if end + (overlays-in start end) + (overlays-at start)))) + (setq o-list (mapcar (lambda (o) + (if (overlay-get o 'vm-shrunken-headers) + o + nil)) + o-list) + o-list (delete nil o-list)))) + +;;;###autoload +(defun vm-shrunken-headers (&optional toggle) + "Hide or show headers which occupy more than one line. +Well, one might do it more precisely with only some headers, +but it is sufficient for me! + +If the optional argument TOGGLE, then hiding is toggled. + +The face used for the visible hidden regions is `vm-shrunken-headers-face' and +the keymap used within that region is `vm-shrunken-headers-keymap'." + (interactive "P") + + (save-excursion + (let (headers-start headers-end start end o shrunken modified) + (if (equal major-mode 'vm-summary-mode) + (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer)) + (set-buffer (symbol-value 'vm-mail-buffer)))) + (if (equal major-mode 'vm-mode) + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer))) + + ;; We cannot use the default functions (vm-headers-of, ...) since + ;; we might also work within a presentation buffer. + (setq modified (buffer-modified-p)) + (goto-char (point-min)) + (setq headers-start (point-min) + headers-end (or (re-search-forward "\n\n" (point-max) t) + (point-max))) + + (cond (toggle + (setq shrunken (vm-shrunken-headers-get-overlays + headers-start headers-end)) + (while shrunken + (setq o (car shrunken)) + (let ((w (overlay-get o 'vm-shrunken-headers-widget))) + (widget-toggle-action w)) + (overlay-put o 'invisible (not (overlay-get o 'invisible))) + (setq shrunken (cdr shrunken)))) + (t + (goto-char headers-start) + (while (re-search-forward "^\\(\\s-+.*\n\\)+" headers-end t) + (setq start (match-beginning 0) end (match-end 0)) + (setq o (vm-shrunken-headers-get-overlays start end)) + (if o + (setq o (car o)) + (setq o (make-overlay (1- start) end)) + (overlay-put o 'face 'vm-shrunken-headers-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'local-map vm-shrunken-headers-keymap) + (overlay-put o 'priority 10000) + ;; make a new overlay for the invisibility, the other one we + ;; made before is just for highlighting and key-bindings ... + (setq o (make-overlay start end)) + (overlay-put o 'vm-shrunken-headers t) + (goto-char (1- start)) + (overlay-put o 'start-closed nil) + (overlay-put o 'vm-shrunken-headers-widget + (widget-create 'visibility + :action + 'vm-shrunken-headers-toggle-this-widget)) + (overlay-put o 'invisible t))))) + (set-buffer-modified-p modified) + (goto-char (point-min))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-assimilate-html-command "striptags" + "*Command/function which should be called for stripping tags. + +When this is a string, then it is a command which is fed with the +html and which should return the text. +Otherwise it should be a Lisp function which performs the stripping of +the tags. + +I prefer to use lynx for this job: + +#!/bin/tcsh + +tmpfile=/tmp/$USER-stripttags.html +cat > $tmpfile +lynx -force_html -dump $tmpfile +rm $tmpfile" + :group 'vm-rfaddons + :type '(string)) + +(defcustom vm-assimilate-html-mixed t + "*Non-nil values cause messages to be assimilated as text/mixed. +Otherwise they will be assimilated into a text/alternative message." + :group 'vm-rfaddons + :type '(boolean)) + +;;;###autoload +(defun vm-assimilate-html-message (&optional plain) + "Try to assimilate a message which is only in html format. +When called with a prefix argument then it will replace the message +with the PLAIN text version otherwise it will create a text/mixed or +text/alternative message depending on the value of the variable +`vm-assimilate-html-mixed'." + (interactive "P") + + (let ((vm-frame-per-edit nil) + (boundary (concat (vm-mime-make-multipart-boundary))) + (case-fold-search t) + (qp-encoded nil) + body start end charset) + + (vm-edit-message) + (goto-char (point-min)) + (goto-char (re-search-forward "\n\n")) + + (if (re-search-backward "^Content-Type:\\s-*\\(text/html\\)\\(.*\n?\\(^\\s-.*\\)*\\)$" + (point-min) t) + (progn (setq charset (buffer-substring (match-beginning 2) + (match-end 2))) + (if plain + (progn (delete-region (match-beginning 1) (match-end 1)) + (goto-char (match-beginning 1)) + (insert "text/plain")) + (progn (delete-region (match-beginning 1) (match-end 2)) + (goto-char (match-beginning 1)) + (insert "multipart/" + (if vm-assimilate-html-mixed "mixed" + "alternative") ";\n" + " boundary=\"" boundary "\"")))) + (progn + (kill-this-buffer) + (error "This message seems to be no HTML only message!"))) + + (goto-char (point-min)) + (goto-char (re-search-forward "\n\n")) + (setq qp-encoded (re-search-backward "^Content-Transfer-Encoding: quoted-printable" + (point-min) t)) + + (goto-char (re-search-forward "\n\n")) + (if plain + (progn (setq body (point) + start (point)) + (goto-char (point-max)) + (setq end (point))) + (progn (insert "--" boundary "\n" + "Content-Type: text/plain" charset "\n" + "Content-Transfer-Encoding: 8bit\n\n") + (setq body (point)) + + (insert "\n--" boundary "\n" + "Content-Type: text/html" charset "\n" + "Content-Transfer-Encoding: 8bit\n\n") + (setq start (point-marker)) + (goto-char (point-max)) + (setq end (point-marker)) + (insert "--" boundary "--\n"))) + + (if qp-encoded (vm-mime-qp-decode-region start end)) + + (goto-char body) + (if (stringp vm-assimilate-html-command) + (call-process-region start end vm-assimilate-html-command + plain t) + (funcall vm-assimilate-html-command start end plain)) + (vm-edit-message-end) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Original Authors: Edwin Huffstutler & John Reynolds + +(defcustom vm-mail-mode-citation-kill-regexp-alist + (list + ;; empty lines multi quoted + (cons (concat "^\\(" vm-included-text-prefix "[|{}>:;][^\n]*\n\\)+") + "[...]\n") + ;; empty quoted starting/ending lines + (cons (concat "^\\([^|{}>:;]+.*\\)\n" + vm-included-text-prefix "[|{}>:;]*$") + "\\1") + (cons (concat "^" vm-included-text-prefix "[|{}>:;]*\n" + "\\([^|{}>:;]\\)") + "\\1") + ;; empty quoted multi lines + (cons (concat "^" vm-included-text-prefix "[|{}>:;]*\\s-*\n\\(" + vm-included-text-prefix "[|{}>:;]*\\s-*\n\\)+") + (concat vm-included-text-prefix "\n")) + ;; empty lines + (cons "\n\n\n+" + "\n\n") + ;; signature & -----Ursprüngliche Nachricht----- + (cons (concat "^" vm-included-text-prefix "--[^\n]*\n" + "\\(" vm-included-text-prefix "[^\n]*\n\\)+") + "\n") + (cons (concat "^" vm-included-text-prefix "________[^\n]*\n" + "\\(" vm-included-text-prefix "[^\n]*\n\\)+") + "\n") + ) + "*Regexp replacement pairs for cleaning of replies." + :group 'vm-rfaddons + :type '(repeat (cons :tag "Kill Definition" + (regexp :tag "Regexp") + (string :tag "Replacement")))) + +(defun vm-mail-mode-citation-clean-up () + "Remove doubly-cited text and extra lines in a mail message." + (interactive) + (save-excursion + (mail-text) + (let ((re-alist vm-mail-mode-citation-kill-regexp-alist) + (pmin (point)) + re subst) + + (while re-alist + (goto-char pmin) + (setq re (caar re-alist) + subst (cdar re-alist)) + (while (re-search-forward re (point-max) t) + (replace-match subst)) + (setq re-alist (cdr re-alist)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-summary-attachment-label "$" + "*Label added to messages containing an attachments." + :group 'vm-rfaddons + :type '(choice (string) (const :tag "No Label" nil))) + +;;;###autoload +(defun vm-summary-attachment-label (msg) + "Indicate if there are attachments in a message. +The summary displays a `vm-summary-attachment-indicator', which is a '$' by +default. In order to get this working, add a \"%1UA\" to your +`vm-summary-format' and call `vm-fix-my-summary'. + +As a sideeffect a label can be added to new messages. Setting +`vm-summary-attachment-label' to a string (the label) enables this. +If you just want the label, then set `vm-summary-attachment-indicator' to nil +and add an \"%0UA\" to your `vm-summary-format'." + (let ((attachments 0)) + (setq msg (vm-real-message-of msg)) + (vm-mime-action-on-all-attachments + nil + (lambda (msg layout type file) + (setq attachments (1+ attachments))) + vm-summary-attachment-mime-types + vm-summary-attachment-mime-type-exceptions + (list msg) + t) + + (when (and (> attachments 0 ) + (vm-new-flag msg) + (or (not (vm-labels-of msg)) + (not (member vm-summary-attachment-label + (vm-labels-of msg))))) + (vm-set-labels msg (append (list vm-summary-attachment-label) + (vm-labels-of msg)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-delete-quit () + "Delete mails and quit. Expunge only if it's not the primary inbox." + (interactive) + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (and buffer-file-name + (string-match (regexp-quote vm-primary-inbox) buffer-file-name)) + (message "No auto-expunge for folder `%s'" buffer-file-name) + (condition-case nil + (vm-expunge-folder) + (error nil))) + (vm-quit))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-mail-mode-install-open-line () + "Install the open-line hooks for `vm-mail-mode'. +Add this to `vm-mail-mode-hook'." + ;; these are not local even when using add-hook, so we make them local + (vm-make-local-hook 'before-change-functions) + (vm-make-local-hook 'after-change-functions) + (add-hook 'before-change-functions 'vm-mail-mode-open-line nil t) + (add-hook 'after-change-functions 'vm-mail-mode-open-line nil t)) + +(defvar vm-mail-mode-open-line nil + "Flag used by `vm-mail-mode-open-line'.") + +(defcustom vm-mail-mode-open-line-regexp "[ \t]*>" + "Regexp matching prefix of quoted text at line start.") + +(defun vm-mail-mode-open-line (start end &optional length) + "Opens a line when inserting into the region of a reply. + +Insert newlines before and after an insert where necessary and does a cleanup +of empty lines which have been quoted." + (if (= start end) + (save-excursion + (beginning-of-line) + (setq vm-mail-mode-open-line + (if (and (eq this-command 'self-insert-command) + (looking-at (concat "^" + vm-mail-mode-open-line-regexp))) + (if (< (point) start) (point) start)))) + (if (and length (= length 0) vm-mail-mode-open-line) + (let (start-mark end-mark) + (save-excursion + (if (< vm-mail-mode-open-line start) + (progn + (insert "\n\n" vm-included-text-prefix) + (setq end-mark (point-marker)) + (goto-char start) + (setq start-mark (point-marker)) + (insert "\n\n")) + (if (looking-at (concat "\\(" + vm-mail-mode-open-line-regexp + "\\)+[ \t]*\n")) + (replace-match "")) + (insert "\n\n") + (setq end-mark (point-marker)) + (goto-char start) + (setq start-mark (point-marker)) + (insert "\n")) + + ;; clean leading and trailing garbage + (let ((iq (concat "^" vm-mail-mode-open-line-regexp + "[> \t]*\n"))) + (save-excursion + (goto-char start-mark) + (beginning-of-line) + (while (looking-at "^$") (forward-line -1)) +; (message "1%s<" (buffer-substring (point) (save-excursion (end-of-line) (point)))) + (while (looking-at iq) + (replace-match "") + (forward-line -1)) + (goto-char end-mark) + (beginning-of-line) + (while (looking-at "^$") (forward-line 1)) +; (message "3%s<" (buffer-substring (point) (save-excursion (end-of-line) (point)))) + (while (looking-at iq) + (replace-match ""))))) + + (setq vm-mail-mode-open-line nil))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-mail-mode-elide-reply-region "[...]\n" + "*String which is used as replacement for elided text." + :group 'vm-rfaddons + :type '(string)) + +;;;###autoload +(defun vm-mail-mode-elide-reply-region (b e) + "Replace marked region or current line with `vm-mail-elide-reply-region'. +B and E are the beginning and end of the marked region or the current line." + (interactive (if (mark) + (if (< (mark) (point)) + (list (mark) (point)) + (list (point) (mark))) + (list (save-excursion (beginning-of-line) (point)) + (save-excursion (end-of-line) (point))))) + (if (eobp) (insert "\n")) + (if (mark) (delete-region b e) (delete-region b (+ 1 e))) + (insert vm-mail-mode-elide-reply-region)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-save-everything () + "Save all VM folder buffers, BBDB and newsrc if GNUS is started." + (interactive) + (save-excursion + (let ((folders (vm-folder-buffers))) + (while folders + (set-buffer (car folders)) + (message "Saving <%S>" (car folders)) + (vm-save-folder) + (setq folders (cdr folders)))) + (if (fboundp 'bbdb-save-db) + (bbdb-save-db))) + (if (fboundp 'gnus-group-save-newsrc) + (gnus-group-save-newsrc))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-get-all-new-mail () + "Get mail for all opened VM folders." + (interactive) + (save-excursion + (let ((buffers (buffer-list))) + (while buffers + (set-buffer (car buffers)) + (if (eq major-mode 'vm-mode) + (vm-get-new-mail)) + (setq buffers (cdr buffers)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-save-message-preview (file) + "Save preview of a message in FILE. +It saves the decoded message and not the raw message like `vm-save-message'" + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command) + filename) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (setq filename + (vm-read-file-name + (if vm-last-written-file + (format "Write text to file: (default %s) " + vm-last-written-file) + "Write text to file: ") + nil vm-last-written-file nil)) + (if (and (file-exists-p filename) + (not (yes-or-no-p (format "Overwrite '%s'? " filename)))) + (error "Aborting `vm-save-message-preview'.")) + (list filename)))) + (save-excursion + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + + (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer)) + (set-buffer (symbol-value 'vm-mail-buffer)) + (if vm-presentation-buffer + (set-buffer vm-presentation-buffer))) + (write-region (point-min) (point-max) file))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This code is now obsolete. VM has built-in facilities for taking +;; actions on attachments. USR, 2010-01-05 +;; Subject: Re: How to Delete an attachment? +;; Newsgroups: gnu.emacs.vm.info +;; Date: 05 Oct 1999 11:09:19 -0400 +;; Organization: Road Runner +;; From: Dave Bakhash +(defun vm-mime-take-action-on-attachment (action) + "Do something with the MIME attachment at point." + (interactive + (list (vm-read-string "action: " + '("save-to-file" + "delete" + "display-as-ascii" + "pipe-to-command") + nil))) + (vm-mime-run-display-function-at-point + (cond ((string= action "save-to-file") + 'vm-mime-send-body-to-file) + ((string= action "display-as-ascii") + 'vm-mime-display-body-as-text) + ((string= action "delete") + (vm-delete-mime-object)) + ((string= action "pipe-to-command") + 'vm-mime-pipe-body-to-queried-command-discard-output)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This functionality has now been integrated into VM core. USR, 2011-01-30 + +(defvaralias 'vm-mime-display-internal-multipart/mixed-separator + 'vm-mime-parts-display-separator) + +(make-obsolete-variable 'vm-mime-display-internal-multipart/mixed-separator + 'vm-mime-parts-display-separator + "8.2.0") +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload +(defun vm-assimilate-outlook-message () + "Assimilate a message which has been forwarded by MS Outlook. +You will need vm-pine.el in order to get this work." + (interactive) + (vm-continue-postponed-message t) + (let ((pm (point-max))) + (goto-char (point-min)) + (if (re-search-forward "^.*\\(-----Urspr[u]ngliche Nachricht-----\\|-----Original Message-----\\)\n" pm) + (delete-region 1 (match-end 0))) + ;; remove the quotes from the forwarded message + (while (re-search-forward "^> ?" pm t) + (replace-match "")) + (goto-char (point-min)) + ;; rewrite headers + (while (re-search-forward "^\\(Von\\|From\\):[ \t]*\\(.+\\) *\\[\\(SMTP\\|mailto\\):\\(.+\\)\\].*" pm t) + (replace-match "From: \\2 <\\4>")) + (while (re-search-forward "^\\(Gesendet[^:]*\\|Sent\\):[ \t]*\\(...\\).*, \\([0-9]+\\)\\. \\(...\\)[a-z]+[ \t]*\\(.*\\)" pm t) + (replace-match "Date: \\3 \\4 \\5")) + (while (re-search-forward "^\\(An\\|To\\):[ \t]*\\(.*\\)$" pm t) + (replace-match "To: \\2")) + (while (re-search-forward "^\\(Betreff\\|Subject\\):[ \t]*\\(.*\\)$" pm t) + (replace-match "Subject: \\2")) + (goto-char (point-min)) + ;; insert mail header separator + (re-search-forward "^$" pm) + (goto-char (match-end 0)) + (insert mail-header-separator "\n") + ;; and put it back into the source folder + (vm-postpone-message))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Highlighting faces +;;;###autoload +(defun vm-install-rf-faces () + (make-face 'message-url) + + (custom-set-faces + '(message-url + ((t (:foreground "blue" :bold t)))) + '(message-headers + ((t (:foreground "blue" :bold t)))) + '(message-cited-text + ((t (:foreground "red3")))) + '(message-header-contents + ((((type x)) (:foreground "green3")))) + '(message-highlighted-header-contents + ((((type x)) (:bold t)) + (t (:bold t)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Well I like to have a different comment style a provided as default. +;; I'd like to have blank lines also prefixed by a comment char. +;; I overwrite the standard function by a slightly different version. +;;;###autoload +(defun vm-mail-mode-comment-region (beg end &optional arg) + "Comment or uncomment each line in the region BEG to END. +With just a non-nil prefix ARG, uncomment each line in region. +Numeric prefix arg ARG means use ARG comment characters. +If ARG is negative, delete that many comment characters instead. +Comments are terminated on each line, even for syntax in which newline does +not end the comment. Blank lines do not get comments." + ;; if someone wants it to only put a comment-start at the beginning and + ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x + ;; is easy enough. No option is made here for other than commenting + ;; every line. + (interactive "r\nP") + (or comment-start (error "No comment syntax is defined")) + (if (> beg end) (let (mid) (setq mid beg beg end end mid))) + (save-excursion + (save-restriction + (let ((cs comment-start) (ce comment-end) + numarg) + (if (consp arg) (setq numarg t) + (setq numarg (prefix-numeric-value arg)) + ;; For positive arg > 1, replicate the comment delims now, + ;; then insert the replicated strings just once. + (while (> numarg 1) + (setq cs (concat cs comment-start) + ce (concat ce comment-end)) + (setq numarg (1- numarg)))) + ;; Loop over all lines from BEG to END. + (narrow-to-region beg end) + (goto-char beg) + (while (not (eobp)) + (if (or (eq numarg t) (< numarg 0)) + (progn + ;; Delete comment start from beginning of line. + (if (eq numarg t) + (while (looking-at (regexp-quote cs)) + (delete-char (length cs))) + (let ((count numarg)) + (while (and (> 1 (setq count (1+ count))) + (looking-at (regexp-quote cs))) + (delete-char (length cs))))) + ;; Delete comment end from end of line. + (if (string= "" ce) + nil + (if (eq numarg t) + (progn + (end-of-line) + ;; This is questionable if comment-end ends in + ;; whitespace. That is pretty brain-damaged, + ;; though. + (skip-chars-backward " \t") + (if (and (>= (- (point) (point-min)) (length ce)) + (save-excursion + (backward-char (length ce)) + (looking-at (regexp-quote ce)))) + (delete-char (- (length ce))))) + (let ((count numarg)) + (while (> 1 (setq count (1+ count))) + (end-of-line) + ;; This is questionable if comment-end ends in + ;; whitespace. That is pretty brain-damaged though + (skip-chars-backward " \t") + (save-excursion + (backward-char (length ce)) + (if (looking-at (regexp-quote ce)) + (delete-char (length ce)))))))) + (forward-line 1)) + ;; Insert at beginning and at end. + (progn + (insert cs) + (if (string= "" ce) () + (end-of-line) + (insert ce))) + (search-forward "\n" nil 'move))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Sometimes it's handy to fake a date. +;; I overwrite the standard function by a slightly different version. +(defcustom vm-mail-mode-fake-date-p t + "*Non-nil means `vm-mail-mode-insert-date-maybe' will not overwrite a existing date header." + :group 'vm-rfaddons + :type '(boolean)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-isearch-presentation () + "Switches to the Presentation buffer and starts isearch." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (let ((target (or vm-presentation-buffer (current-buffer)))) + (if (get-buffer-window-list target) + (select-window (car (get-buffer-window-list target))) + (switch-to-buffer target))) + (isearch-forward)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defcustom vm-delete-message-action "vm-next-message" + "Command to do after deleting a message." + :group 'vm-rfaddons) + +;;;###autoload +(defun vm-delete-message-action (&optional arg) + "Delete current message and perform some action after it, e.g. move to next. +Call it with a prefix ARG to change the action." + (interactive "P") + (when (and (listp arg) (not (null arg))) + (setq vm-delete-message-action + (completing-read "After delete: " + '(("vm-rmail-up") + ("vm-rmail-down") + ("vm-previous-message") + ("vm-previous-unread-message") + ("vm-next-message") + ("vm-next-unread-message") + ("nothing")))) + (message "action after delete is %S" vm-delete-message-action)) + (vm-toggle-deleted (prefix-numeric-value arg)) + (let ((fun (intern vm-delete-message-action))) + (if (functionp fun) + (call-interactively fun)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar vm-smtp-server-online-p-cache nil + "Alist of cached (server online-status) entries.") + +(defun vm-smtp-server-online-p (&optional host port) + "Opens SMTP connection to see if the server HOST on PORT is online. +Results are cached in `smtp-server-online-p-cache' for non interactive +calls." + (interactive) + (save-excursion + (let (online-p server hp) + (if (null host) + (setq server (if (functionp 'esmtpmail-via-smtp-server) + (esmtpmail-via-smtp-server) + (smtpmail-via-smtp-server)) + host (car server) + port (cadr server))) + (setq port (or port 25) + hp (format "%s:%s" host port)) + + (if (vm-interactive-p) + (setq vm-smtp-server-online-p-cache nil)) + + (if (assoc hp vm-smtp-server-online-p-cache) + ;; take cache content + (setq online-p (cadr (assoc hp vm-smtp-server-online-p-cache)) + hp (concat hp " (cached)")) + ;; do the check + (let* ((n (format " *SMTP server check %s:%s *" host port)) + (buf (get-buffer n)) + (stream nil)) + (if buf (kill-buffer buf)) + + (condition-case err + (progn + (setq stream (open-network-stream n n host port)) + (setq online-p t)) + (error + (message (cadr err)) + (if (and (get-buffer n) + (< 0 (length (save-excursion + (set-buffer (get-buffer n)) + (buffer-substring (point-min) (point-max)))))) + (pop-to-buffer n)))) + (if stream (delete-process stream)) + (when (setq buf (get-buffer n)) + (set-buffer buf) + (message "%S" (buffer-substring (point-min) (point-max))) + (goto-char (point-min)) + (when (re-search-forward + "gethostbyname: Resource temporarily unavailable" + (point-max) t) + (setq online-p nil)))) + + ;; add to cache for further lookups + (add-to-list 'vm-smtp-server-online-p-cache (list hp online-p))) + + (if (vm-interactive-p) + (message "SMTP server %s is %s" hp + (if online-p "online" "offline"))) + online-p))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun vm-mail-send-or-feed-it () + "Sends a message if the SMTP server is online, queues it otherwise." + (if (not (vm-smtp-server-online-p)) + (feedmail-send-it) + (if (functionp 'esmtpmail-send-it) + (esmtpmail-send-it) + (smtpmail-send-it)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Contributed by Alley Stoughton +;; gnu.emacs.vm.info, 2011-02-26 + +(defun vm-toggle-best-mime () + "Toggle between best-internal and best mime decoding modes" + (interactive) + (if (eq vm-mime-alternative-show-method 'best-internal) + (progn + (vm-decode-mime-message 'undecoded) + (setq vm-mime-alternative-show-method 'best) + (vm-decode-mime-message 'decoded) + (message "using best MIME decoding")) + (progn + (vm-decode-mime-message 'undecoded) + (setq vm-mime-alternative-show-method 'best-internal) + (vm-decode-mime-message 'decoded) + (message "using best internal MIME decoding")))) + +;;; vm-rfaddons.el ends here diff --git a/lisp/vm-save.el b/lisp/vm-save.el new file mode 100755 index 0000000..3ad76c6 --- /dev/null +++ b/lisp/vm-save.el @@ -0,0 +1,1030 @@ +;;; vm-save.el --- Saving and piping messages under VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1989, 1990, 1993, 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;; (match-data) returns the match data as MARKERS, often corrupting it in the +;; process due to buffer narrowing, and the fact that buffers are indexed from +;; 1 while strings are indexed from 0. :-( + +;;; Code: + +(provide 'vm-save) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-mime) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-imap) + ) + +(declare-function vm-session-initialization "vm" ()) + +;;;###autoload +(defun vm-auto-select-folder (mp auto-folder-alist) + (condition-case error-data + (catch 'match + (let (header alist tuple-list) + (setq alist auto-folder-alist) + (while alist + (setq header + (vm-get-header-contents (car mp) (car (car alist)) ", ")) + (when header + (setq tuple-list (cdr (car alist))) + (while tuple-list + (when (let ((case-fold-search vm-auto-folder-case-fold-search)) + (string-match (car (car tuple-list)) header)) + ;; Don't waste time eval'ing an atom. + (if (stringp (cdr (car tuple-list))) + (throw 'match (cdr (car tuple-list))) + (let* ((match-data (vm-match-data)) + ;; allow this buffer to live forever + (buf (get-buffer-create " *vm-auto-folder*")) + (result)) + ;; Set up a buffer that matches our cached + ;; match data. + (save-excursion + (set-buffer buf) + (if vm-fsfemacs-mule-p + (set-buffer-multibyte nil)) ; for empty buffer + (widen) + (erase-buffer) + (insert header) + ;; It appears that get-buffer-create clobbers the + ;; match-data. + ;; + ;; The match data is off by one because we matched + ;; a string and Emacs indexes strings from 0 and + ;; buffers from 1. + ;; + ;; Also store-match-data only accepts MARKERS!! + ;; AUGHGHGH!! + (store-match-data + (mapcar + (function (lambda (n) (and n (vm-marker n)))) + (mapcar + (function (lambda (n) (and n (1+ n)))) + match-data))) + (setq result (eval (cdr (car tuple-list)))) + (while (consp result) + (setq result (vm-auto-select-folder mp result))) + (when result + (throw 'match result)))))) + (setq tuple-list (cdr tuple-list)))) + (setq alist (cdr alist))) + nil )) + (error (error "error processing vm-auto-folder-alist: %s" + (prin1-to-string error-data))))) + +;;;###autoload +(defun vm-auto-archive-messages (&optional arg) + "Save all unfiled messages that auto-match a folder via +`vm-auto-folder-alist' to their appropriate folders. Messages that +are flagged for deletion are not saved. + +Prefix arg means to ask user for confirmation before saving each message. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only marked messages are checked against `vm-auto-folder-alist'. + +The saved messages are flagged as `filed'." + (interactive "P") + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((auto-folder) + (archived 0)) + (unwind-protect + ;; Need separate (let ...) so vm-message-pointer can + ;; revert back in time for + ;; (vm-update-summary-and-mode-line). + ;; vm-last-save-folder is tucked away here since archives + ;; shouldn't affect its value. + (let ((vm-message-pointer + (if (eq last-command 'vm-next-command-uses-marks) + (vm-select-operable-messages + 0 (vm-interactive-p) "Archive"))) + (done nil) + stop-point + (vm-last-save-folder vm-last-save-folder) + (vm-move-after-deleting nil)) + ;; Double check if the user really wants to archive + (unless (or arg vm-message-pointer + (y-or-n-p "Auto archive the entire folder? ")) + (error "Aborted")) + (setq vm-message-pointer (or vm-message-pointer vm-message-list)) + (vm-inform 5 "Archiving...") + ;; mark the place where we should stop. otherwise if any + ;; messages in this folder are archived to this folder + ;; we would file messages into this folder forever. + (setq stop-point (vm-last vm-message-pointer)) + (while (not done) + (and (not (vm-filed-flag (car vm-message-pointer))) + ;; don't archive deleted messages + (not (vm-deleted-flag (car vm-message-pointer))) + (setq auto-folder (vm-auto-select-folder + vm-message-pointer + vm-auto-folder-alist)) + ;; Don't let user archive into the same folder + ;; that they are visiting. + (not (eq (vm-get-file-buffer auto-folder) + (current-buffer))) + (or (null arg) + (y-or-n-p + (format "Save message %s in folder %s? " + (vm-number-of (car vm-message-pointer)) + auto-folder))) + (let ((vm-delete-after-saving vm-delete-after-archiving) + (last-command 'vm-auto-archive-messages)) + (vm-save-message auto-folder 1 nil 'quiet) + (vm-increment archived) + (vm-inform 6 "%d archived, still working..." archived))) + (setq done (eq vm-message-pointer stop-point) + vm-message-pointer (cdr vm-message-pointer)))) + ;; fix mode line + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line)) + (if (zerop archived) + (vm-inform 5 "No messages were archived") + (vm-inform 5 "%d message%s archived" + archived (if (= 1 archived) "" "s"))))) + +;;;--------------------------------------------------------------------------- +;; The following defun seems a lot less efficient than it might be, +;; but I don't have a better sense of how to access the folder buffer +;; and read its local variables. [2006/10/31:rpg] +;;--------------------------------------------------------------------------- + +(defun vm-imap-folder-p () + "Is the current folder an IMAP folder?" + (save-current-buffer + (vm-select-folder-buffer) + (eq vm-folder-access-method 'imap))) + +;;;--------------------------------------------------------------------------- +;; New shell defun to handle both IMAP and local saving. +;;--------------------------------------------------------------------------- + +(defun vm-read-save-folder-name (&optional imap) + (let (default default-is-imap default-imap directory file-name) + (save-current-buffer + ;; is this needed? USR, 2011-11-12 + ;; (vm-session-initialization) + (vm-select-folder-buffer) + (vm-error-if-folder-empty) + (setq default + (or (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist) + vm-last-save-folder)) + (setq default-is-imap + (and default (vm-imap-folder-spec-p default))) + (setq default-imap + (or (and default-is-imap default) + vm-last-save-imap-folder + vm-last-visit-imap-folder)) + (setq directory + (or vm-foreign-folder-directory + vm-folder-directory + default-directory))) + (cond (imap + (vm-read-imap-folder-name + "Save to IMAP folder: " t nil default-imap)) + ((and default + (let ((default-directory directory)) + (file-directory-p default))) + (vm-read-file-name "Save in folder: " directory nil nil default)) + (default-is-imap + (let ((insert-default-directory nil)) + (setq file-name + (vm-read-file-name + (format "Save in folder: (default %s) " + (or (vm-imap-folder-for-spec default) + (vm-safe-imapdrop-string default))) + nil default + ;; 'confirm ; -- this blocks the default + )) + (if (equal file-name "") default file-name))) + (default + (vm-read-file-name + (format "Save in folder: (default %s) " default) + directory default + ;; 'confirm ; -- this blocks the default + )) + (t + (vm-read-file-name "Save in folder: " directory nil 'confirm))))) + +;;;###autoload +(defun vm-save-message (folder &optional count mlist quiet) + "Save the current message to another FOLDER, queried via the +mini-buffer. The FOLDER may be a local file system folder or an +IMAP folder. You can specify a preference by setting the +variable `vm-imap-save-to-server'. + +Prefix arg COUNT means save this message and the next COUNT-1 +messages. A negative COUNT means save this message and the +previous COUNT-1 messages. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages in the current folder are saved; other messages are +ignored. If applied to collapsed threads in summary and thread operations are +enabled via `vm-enable-thread-operations' then all messages in the +thread are saved." + (interactive + (list + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (vm-follow-summary-cursor) + (vm-read-save-folder-name + (and (vm-imap-folder-p) vm-imap-save-to-server))) + (prefix-numeric-value current-prefix-arg))) + + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (unless count (setq count 1)) + (unless mlist + (setq mlist (vm-select-operable-messages count (vm-interactive-p) "Save"))) + (cond ((and (vm-imap-folder-p) vm-imap-save-to-server) + (vm-save-message-to-imap-folder folder count mlist quiet)) + ((vm-imap-folder-spec-p folder) + (vm-save-message-to-imap-folder folder count mlist quiet)) + (t + (vm-save-message-to-local-folder folder count mlist quiet)))) + +;;;###autoload +(defun vm-save-message-to-local-folder (folder &optional count mlist quiet) + "Save the current message to a mail folder. +If the folder already exists, the message will be appended to it. + +Prefix arg COUNT means save this message and the next COUNT-1 +messages. A negative COUNT means save this message and the +previous COUNT-1 messages. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages in the current folder are saved; other messages are +ignored. If applied to collapsed threads in summary and thread +operations are enabled via `vm-enable-thread-operations' then all messages +in the thread are saved. + +The saved messages are flagged as `filed'." + (interactive + (list + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (vm-follow-summary-cursor) + (vm-read-save-folder-name)) + (prefix-numeric-value current-prefix-arg))) + + (let (auto-folder unexpanded-folder ml) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (setq unexpanded-folder folder) + (setq auto-folder (vm-auto-select-folder vm-message-pointer + vm-auto-folder-alist)) + (vm-display nil nil '(vm-save-message) '(vm-save-message)) + (unless count (setq count 1)) + (unless mlist + (setq mlist (vm-select-operable-messages + count (vm-interactive-p) "Save"))) + (vm-retrieve-operable-messages count mlist) + + ;; Expand the filename, forcing relative paths to resolve + ;; into the folder directory. + (let ((default-directory + (expand-file-name (or vm-foreign-folder-directory + vm-folder-directory default-directory)))) + (setq folder (expand-file-name folder))) + ;; Confirm new folders, if the user requested this. + (when (and vm-confirm-new-folders + (not (file-exists-p folder)) + (or (not vm-visit-when-saving) (not (vm-get-file-buffer folder))) + (not (y-or-n-p (format "%s does not exist, save there anyway? " + folder)))) + (error "Save aborted")) + ;; Check and see if we are currently visiting the folder + ;; that the user wants to save to. + (when (and (not vm-visit-when-saving) (vm-get-file-buffer folder)) + (error "Folder %s is being visited, cannot save." folder)) + (let ((coding-system-for-write + (if (file-exists-p folder) + (vm-get-file-line-ending-coding-system folder) + (vm-new-folder-line-ending-coding-system))) + (oldmodebits (and (fboundp 'default-file-modes) (default-file-modes))) + (m nil) + (save-count 0) + folder-buffer target-type) + (cond ((and mlist (eq vm-visit-when-saving t)) + (setq folder-buffer + (or (vm-get-file-buffer folder) + ;; avoid letter bombs + (let ((inhibit-local-variables t) + (enable-local-eval nil) + (enable-local-variables nil)) + (find-file-noselect folder))))) + ((and mlist vm-visit-when-saving) + (setq folder-buffer (vm-get-file-buffer folder)))) + (when (and mlist vm-check-folder-types) + (setq target-type + (or (vm-get-folder-type folder) + vm-default-folder-type + (and mlist (vm-message-type-of (car mlist))))) + (when (eq target-type 'unknown) + (error "Folder %s's type is unrecognized" folder))) + (unwind-protect + (save-excursion + (when oldmodebits + (set-default-file-modes vm-default-folder-permission-bits)) + ;; if target folder is empty or nonexistent we need to + ;; write out the folder header first. + (when mlist + (let ((attrs (file-attributes folder))) + (when (or (null attrs) (= 0 (nth 7 attrs))) + (if (null folder-buffer) + (vm-write-string + folder (vm-folder-header target-type)) + (vm-write-string + folder-buffer (vm-folder-header target-type)))))) + (setq ml mlist) + (while ml + (setq m (vm-real-message-of (car ml))) + (set-buffer (vm-buffer-of m)) + ;; FIXME the following isn't really necessary + (vm-assert (vm-body-retrieved-of m)) + (vm-save-restriction + (widen) + ;; have to stuff the attributes in all cases because + ;; the deleted attribute may have been stuffed + ;; previously and we don't want to save that attribute. + ;; also we don't want to save out the cached summary entry. + (vm-stuff-message-data m t) + (if (null folder-buffer) + ;; write to disk + (if (or (null vm-check-folder-types) + (eq target-type (vm-message-type-of m))) + (write-region + (vm-start-of m) (vm-end-of m) folder t 'quiet) + (if (null vm-convert-folder-types) + (if (not (vm-virtual-message-p (car ml))) + (error "Folder type mismatch: %s vs %s" + (vm-message-type-of m) target-type) + (error "Message %s type mismatches folder %s: %s vs %s" + (vm-number-of (car ml)) + folder + (vm-message-type-of m) + target-type)) + (vm-write-string + folder (vm-leading-message-separator target-type m t)) + (if (eq target-type 'From_-with-Content-Length) + (vm-write-string + folder (concat vm-content-length-header " " + (vm-su-byte-count m) "\n"))) + (write-region + (vm-headers-of m) (vm-text-end-of m) folder t 'quiet) + (vm-write-string + folder (vm-trailing-message-separator target-type)))) + ;; write to folder-buffer + (save-excursion + (set-buffer folder-buffer) + ;; if the buffer is a live VM folder + ;; honor vm-folder-read-only. + (when vm-folder-read-only + (signal 'folder-read-only (list (current-buffer)))) + (let ((buffer-read-only nil)) + (vm-save-restriction + (widen) + (save-excursion + (goto-char (point-max)) + (if (or (null vm-check-folder-types) + (eq target-type (vm-message-type-of m))) + (insert-buffer-substring + (vm-buffer-of m) (vm-start-of m) (vm-end-of m)) + (if (null vm-convert-folder-types) + (if (not (vm-virtual-message-p (car ml))) + (error "Folder type mismatch: %s vs %s" + (vm-message-type-of m) target-type) + (error + "Message %s type mismatches folder %s: %s vs %s" + (vm-number-of (car ml)) folder + (vm-message-type-of m) target-type)) + (vm-write-string + (current-buffer) + (vm-leading-message-separator target-type m t)) + (when (eq target-type 'From_-with-Content-Length) + (vm-write-string + (current-buffer) + (concat vm-content-length-header " " + (vm-su-byte-count m) "\n"))) + (insert-buffer-substring (vm-buffer-of m) + (vm-headers-of m) + (vm-text-end-of m)) + (vm-write-string + (current-buffer) + (vm-trailing-message-separator target-type))))) + ;; vars should exist and be local + ;; but they may have strange values, + ;; so check the major-mode. + (cond ((eq major-mode 'vm-mode) + (vm-increment vm-messages-not-on-disk) + (vm-clear-modification-flag-undos))))))) + (save-excursion + (narrow-to-region (vm-headers-of m) (vm-text-end-of m)) + (run-hook-with-args 'vm-save-message-hook folder)) + (unless (vm-filed-flag m) + (when (vm-set-filed-flag m t) + (vm-increment save-count) + (vm-modify-folder-totals folder 'saved 1 m))) + (vm-update-summary-and-mode-line) + (setq ml (cdr ml))))) + ;; unwind-protections + (when oldmodebits + (set-default-file-modes oldmodebits))) + (when m + (if folder-buffer + (with-current-buffer folder-buffer + (when (eq major-mode 'vm-mode) + (vm-check-for-killed-summary) + (vm-assimilate-new-messages) + (if (null vm-message-pointer) + (progn (setq vm-message-pointer vm-message-list + vm-need-summary-pointer-update t) + (intern (buffer-name) + vm-buffers-needing-display-update) + (vm-present-current-message)) + (vm-update-summary-and-mode-line))) + (unless quiet + (vm-inform 7 "%d message%s saved to buffer %s" + save-count + (if (/= 1 save-count) "s" "") + (buffer-name)))) + (unless quiet + (vm-inform 7 "%d message%s saved to %s" + save-count (if (/= 1 save-count) "s" "") folder))))) + (when (or (null vm-last-save-folder) + (not (equal unexpanded-folder auto-folder))) + (setq vm-last-save-folder unexpanded-folder)) + (when (and vm-delete-after-saving (not vm-folder-read-only)) + (vm-delete-message count mlist)) + folder )) + +;;;###autoload +(defun vm-save-message-sans-headers (file &optional count quiet) + "Save the current message to a file, without its header section. +If the file already exists, the message body will be appended to it. +Prefix arg COUNT means save the next COUNT message bodiess. A +negative COUNT means save the previous COUNT bodies. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +only the next COUNT marked messages are saved; other intervening +messages are ignored. If applied to collapsed threads in summary and +thread operations are enabled via `vm-enable-thread-operations' then all +messages in the thread are saved. + +The saved messages are flagged as `written'. + +This command should NOT be used to save message to mail folders; use +`vm-save-message' instead (normally bound to `s')." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list + (vm-read-file-name + (if vm-last-written-file + (format "Write text to file: (default %s) " + vm-last-written-file) + "Write text to file: ") + nil vm-last-written-file nil) + (prefix-numeric-value current-prefix-arg))))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-save-message-sans-headers) + '(vm-save-message-sans-headers)) + (unless count (setq count 1)) + (let ((mlist (vm-select-operable-messages + count (vm-interactive-p) "Save"))) + (vm-retrieve-operable-messages count mlist) + (setq file (expand-file-name file)) + ;; Check and see if we are currently visiting the file + ;; that the user wants to save to. + (when (and (not vm-visit-when-saving) (vm-get-file-buffer file)) + (error "File %s is being visited, cannot save." file)) + (let ((oldmodebits (and (fboundp 'default-file-modes) (default-file-modes))) + (coding-system-for-write (vm-get-file-line-ending-coding-system file)) + (m nil) file-buffer) + (cond ((and mlist (eq vm-visit-when-saving t)) + (setq file-buffer + (or (vm-get-file-buffer file) (find-file-noselect file)))) + ((and mlist vm-visit-when-saving) + (setq file-buffer (vm-get-file-buffer file)))) + (unless (or (memq (vm-get-folder-type file) '(nil unknown)) + (y-or-n-p + "This file looks like a mail folder, append to it anyway? ")) + (error "Aborted")) + (unwind-protect + (save-excursion + (when oldmodebits + (set-default-file-modes vm-default-folder-permission-bits)) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + ;; FIXME the following shouldn't be necessary any more + (vm-assert (vm-body-retrieved-of m)) + (vm-save-restriction + (widen) + (if (null file-buffer) + (write-region + (vm-text-of m) (vm-text-end-of m) file t 'quiet) + (let ((start (vm-text-of m)) + (end (vm-text-end-of m))) + (save-excursion + (set-buffer file-buffer) + (save-excursion + (let (buffer-read-only) + (vm-save-restriction + (widen) + (save-excursion + (goto-char (point-max)) + (insert-buffer-substring + (vm-buffer-of m) + start end)))))))) + (unless (vm-written-flag m) + (vm-set-written-flag m t)) + (vm-update-summary-and-mode-line) + (setq mlist (cdr mlist))))) + (and oldmodebits (set-default-file-modes oldmodebits))) + (when (and m (not quiet)) + (if file-buffer + (vm-inform 5 "Message%s written to buffer %s" + (if (/= 1 count) "s" "") + (buffer-name file-buffer)) + (vm-inform 5 "Message%s written to %s" + (if (/= 1 count) "s" "") file))) + (setq vm-last-written-file file)))) + +(defun vm-switch-to-command-output-buffer (command buffer discard-output) + "Eventually switch to the output buffer of the command." + (let ((output-bytes (save-excursion (set-buffer buffer) (buffer-size)))) + (if (zerop output-bytes) + (vm-inform 5 "Command '%s' produced no output." command) + (if discard-output + (vm-inform 5 "Command '%s' produced %d bytes of output." + command output-bytes) + (display-buffer buffer))))) + +(defun vm-pipe-message-part (m arg) + "Return (START END) bounds for piping to external command, based on ARG." + (cond ((equal prefix-arg '(4)) + (list (vm-text-of m) (vm-text-end-of m))) + ((equal prefix-arg '(16)) + (list (vm-headers-of m) (vm-text-of m))) + ((equal prefix-arg '(64)) + (list (vm-vheaders-of m) (vm-text-end-of m))) + (t + (list (vm-headers-of m) (vm-text-end-of m))))) + +;;;###autoload +(defun vm-pipe-message-to-command (command &optional prefix-arg discard-output) + "Runs a shell command with contents from the current message as input. +By default, the entire message is used. Message separators are +included if `vm-message-includes-separators' is non-Nil. + +With one \\[universal-argument] the text portion of the message is used. +With two \\[universal-argument]'s the header portion of the message is used. +With three \\[universal-argument]'s the visible header portion of the message +plus the text portion is used. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +each marked message is successively piped to the shell command, one +message per command invocation. If applied to collapsed threads in +summary and thread operations are enabled via +`vm-enable-thread-operations' then all messages in the thread are piped. + +Output, if any, is displayed. The message is not altered." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list (read-string "Pipe to command: " vm-last-pipe-command) + current-prefix-arg)))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (setq vm-last-pipe-command command) + (let ((buffer (get-buffer-create "*Shell Command Output*")) + m + (pop-up-windows (and pop-up-windows (eq vm-mutable-window-configuration t))) + ;; prefix arg doesn't have "normal" meaning here, so only call + ;; vm-select-operable-messages for marks and threads. + (mlist (vm-select-operable-messages 1 (vm-interactive-p) "Pipe"))) + (vm-retrieve-operable-messages 1 mlist) + (save-excursion + (set-buffer buffer) + (erase-buffer)) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + (save-restriction + (widen) + (let ((pop-up-windows (and pop-up-windows (eq vm-mutable-window-configuration t))) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (selective-display nil) + (region (vm-pipe-message-part m prefix-arg))) + (call-process-region (nth 0 region) (nth 1 region) + (or shell-file-name "sh") + nil buffer nil shell-command-switch command))) + (setq mlist (cdr mlist))) + (vm-display nil nil '(vm-pipe-message-to-command) + '(vm-pipe-message-to-command)) + (vm-switch-to-command-output-buffer command buffer discard-output) + buffer)) + +(defun vm-pipe-message-to-command-to-string (command &optional prefix-arg) + "Run a shell command with contents from the current message as input. +This function is like `vm-pipe-message-to-command', but will not display the +output of the command, but return it as a string." + (save-excursion + (set-buffer (vm-pipe-message-to-command command prefix-arg t)) + (buffer-substring-no-properties (point-min) (point-max)))) + +;;;###autoload +(defun vm-pipe-message-to-command-discard-output (command &optional prefix-arg) + "Run a shell command with contents from the current message as input. +This function is like `vm-pipe-message-to-command', but will not display the +output of the command." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list (read-string "Pipe to command: " vm-last-pipe-command) + current-prefix-arg)))) + (vm-pipe-message-to-command command prefix-arg t)) + +(defun vm-pipe-command-exit-handler (process command discard-output + &optional exit-handler) +"Switch to output buffer of PROCESS that ran COMMAND, if +DISCARD-OUTPUT non-nil. +If non-nil call EXIT-HANDLER with the two arguments COMMAND and OUTPUT-BUFFER." + (let ((exit-code (process-exit-status process)) + (buffer (process-buffer process)) + (process-command (process-command process))) + (if (not (zerop exit-code)) + (vm-warn 0 0 "Command '%s' exit code is %d." command exit-code)) + (vm-display nil nil '(vm-pipe-message-to-command) + '(vm-pipe-message-to-command)) + (vm-switch-to-command-output-buffer command buffer discard-output) + (if exit-handler + (funcall exit-handler process-command buffer)))) + +(defvar vm-pipe-messages-to-command-start t + "*The string to be used as the leading message separator by +`vm-pipe-messages-to-command' at the beginning of each message. +If set to 't', then use the leading message separator stored in the VM +folder. If set to nil, then no leading separator is included.") + +(defvar vm-pipe-messages-to-command-end t + "*The string to be used as the trailing message separator by +`vm-pipe-messages-to-command' at the end of each message. +If set to 't', then use the trailing message separator stored in the VM +folder. If set to nil, no trailing separator is included.") + +;;;###autoload +(defun vm-pipe-messages-to-command (command &optional prefix-arg + discard-output no-wait) + "Run a shell command with contents from messages as input. + +Similar to `vm-pipe-message-to-command', but it will call process +just once and pipe all messages to it. For bulk operations this +is much faster than calling the command on each message. This is +more like saving to a pipe. + +With one \\[universal-argument] the text portion of the messages is used. +With two \\[universal-argument]'s the header portion of the messages is used. +With three \\[universal-argument]'s the visible header portion of the messages +plus the text portion is used. + +Leading and trailing separators are included with each message +depending on the settings of `vm-pipe-messages-to-command-start' +and `vm-pipe-messages-to-command-end'. + +Output, if any, is displayed unless DISCARD-OUTPUT is t. + +If NO-WAIT is t, then do not wait for process to finish, if it is +a function then call it with the COMMAND and OUTPUT-BUFFER as +arguments after the command finished." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list (read-string "Pipe to command: " vm-last-pipe-command) + current-prefix-arg)))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (setq vm-last-pipe-command command) + (let ((buffer (get-buffer-create "*Shell Command Output*")) + (pop-up-windows (and pop-up-windows (eq vm-mutable-window-configuration t))) + ;; prefix arg doesn't have "normal" meaning here, so only call + ;; vm-select-operable-messages for marks and threads. + (mlist (vm-select-operable-messages 1 (vm-interactive-p) "Pipe")) + m process) + (vm-retrieve-operable-messages 1 mlist) + (save-excursion + (set-buffer buffer) + (erase-buffer)) + (setq process (start-process command buffer + (or shell-file-name "sh") + shell-command-switch command)) + (set-process-sentinel + process + `(lambda (process status) + (setq status (process-status process)) + (if (eq 'exit status) + (if ,no-wait + (vm-pipe-command-exit-handler + process ,command ,discard-output + (if (and ,no-wait (functionp ,no-wait)) + ,no-wait))) + (vm-inform 1 "Command '%s' changed state to %s." + ,command status)))) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + (save-restriction + (widen) + (cond ((eq vm-pipe-messages-to-command-start t) + (process-send-region process + (vm-start-of m) (vm-headers-of m))) + (vm-pipe-messages-to-command-start + (process-send-string process vm-pipe-messages-to-command-start))) + (let ((region (vm-pipe-message-part m prefix-arg))) + (process-send-region process (nth 0 region) (nth 1 region))) + (cond ((eq vm-pipe-messages-to-command-end t) + (process-send-region process + (vm-text-end-of m) (vm-end-of m))) + (vm-pipe-messages-to-command-end + (process-send-string process vm-pipe-messages-to-command-end)))) + (setq mlist (cdr mlist))) + + (process-send-eof process) + + (when (not no-wait) + (while (and (eq 'run (process-status process))) + (accept-process-output process) + (sit-for 0)) + (vm-pipe-command-exit-handler process command discard-output)) + buffer)) + +(defun vm-pipe-messages-to-command-to-string (command &optional prefix-arg) + "Runs a shell command with contents from the current message as input. +This function is like `vm-pipe-messages-to-command', but will not display the +output of the command, but return it as a string." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list (read-string "Pipe to command: " vm-last-pipe-command) + current-prefix-arg)))) + (save-excursion + (set-buffer (vm-pipe-messages-to-command command prefix-arg t)) + (buffer-substring-no-properties (point-min) (point-max)))) + +;;;###autoload +(defun vm-pipe-messages-to-command-discard-output (command &optional prefix-arg) + "Runs a shell command with contents from the current message as input. +This function is like `vm-pipe-messages-to-command', but will not display the +output of the command." + (interactive + ;; protect value of last-command + (let ((last-command last-command) + (this-command this-command)) + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list (read-string "Pipe to command: " vm-last-pipe-command) + current-prefix-arg)))) + (vm-pipe-messages-to-command command prefix-arg t)) + +;;;###autoload +(defun vm-print-message (&optional count) + "Print the current message +Prefix arg N means print the current message and the next N - 1 messages. +Prefix arg -N means print the current message and the previous N - 1 messages. + +The variable `vm-print-command' controls what command is run to +print the message, and `vm-print-command-switches' is a list of switches +to pass to the command. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +each marked message is printed, one message per vm-print-command +invocation. If applied to collapsed threads in summary and thread +operations are enabled via `vm-enable-thread-operations' then all messages +in the thread are printed. + +Output, if any, is displayed. The message is not altered." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (or count (setq count 1)) + (let* ((buffer (get-buffer-create "*Shell Command Output*")) + (need-tempfile (string-match ".*-.*-\\(win95\\|nt\\)" + system-configuration)) + (tempfile (if need-tempfile (vm-make-tempfile-name))) + (command (mapconcat (function identity) + (nconc (list vm-print-command) + (copy-sequence vm-print-command-switches) + (if need-tempfile + (list tempfile))) + " ")) + (m nil) + (pop-up-windows (and pop-up-windows (eq vm-mutable-window-configuration t))) + (mlist (vm-select-operable-messages count (vm-interactive-p) "Print"))) + (vm-retrieve-operable-messages count mlist) + + (save-excursion + (set-buffer buffer) + (erase-buffer)) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + (if (and vm-display-using-mime (vectorp (vm-mm-layout m))) + (let ((work-buffer nil)) + (unwind-protect + (progn + (setq work-buffer (vm-make-work-buffer)) + (set-buffer work-buffer) + (vm-insert-region-from-buffer + (vm-buffer-of m) (vm-vheaders-of m) (vm-text-of m)) + (vm-decode-mime-encoded-words) + (goto-char (point-max)) + (let ((vm-mime-auto-displayed-content-types + '("text" "multipart")) + (vm-mime-internal-content-types + '("text" "multipart")) + (vm-mime-external-content-types-alist nil)) + (vm-decode-mime-layout (vm-mm-layout m))) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-window-configuration t))) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (selective-display nil)) + (if need-tempfile + (write-region (point-min) (point-max) + tempfile nil 0)) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil buffer nil + shell-command-switch command) + (if need-tempfile + (vm-error-free-call 'delete-file tempfile)))) + (and work-buffer (kill-buffer work-buffer)))) + (save-restriction + (widen) + (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m)) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-window-configuration t))) + ;; call-process-region calls write-region. + ;; don't let it do CR -> LF translation. + (selective-display nil)) + (if need-tempfile + (write-region (point-min) (point-max) + tempfile nil 0)) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil buffer nil + shell-command-switch command) + (if need-tempfile + (vm-error-free-call 'delete-file tempfile))))) + (setq mlist (cdr mlist))) + (vm-display nil nil '(vm-print-message) '(vm-print-message)) + (vm-switch-to-command-output-buffer command buffer nil))) + +;;;###autoload +(defun vm-save-message-to-imap-folder (folder &optional count mlist quiet) + "Save the current message to an IMAP folder. +Prefix arg COUNT means save this message and the next COUNT-1 +messages. A negative COUNT means save this message and the +previous COUNT-1 messages. + +When invoked on marked messages (via `vm-next-command-uses-marks'), +all marked messages in the current folder are saved; other messages are +ignored. If applied to collapsed threads in summary and thread +operations are enabled via `vm-enable-thread-operations' then all +messages in the thread are saved. + +The saved messages are flagged as `filed'." + (interactive + (list + (let ((this-command this-command) + (last-command last-command)) + (vm-follow-summary-cursor) + (vm-read-save-folder-name t)) + (prefix-numeric-value current-prefix-arg))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-display nil nil '(vm-save-message-to-imap-folder) + '(vm-save-message-to-imap-folder)) + (unless count (setq count 1)) + (let (source-spec-list + (target-spec-list (vm-imap-parse-spec-to-list folder)) + ml m + (save-count 0) + server-to-server-p mailbox + process + ) + (unless mlist + (setq mlist + (vm-select-operable-messages count (vm-interactive-p) "Save"))) + (setq mailbox (nth 3 target-spec-list)) + (unwind-protect + (save-excursion + (vm-inform 5 "Saving messages...") + (setq ml mlist) + (while ml + (setq m (vm-real-message-of (car ml))) + (set-buffer (vm-buffer-of m)) + (setq source-spec-list + (and (vm-imap-folder-p) + (vm-imap-parse-spec-to-list + (vm-folder-imap-maildrop-spec)))) + (setq server-to-server-p ; copy on the same imap server + (and (equal (nth 1 source-spec-list) + (nth 1 target-spec-list)) + (equal (nth 5 source-spec-list) + (nth 5 target-spec-list)))) + ;; FIXME try to load the body before saving + (if (and (not server-to-server-p) + (vm-body-to-be-retrieved-of m)) + (error "Message %s body has not been retrieved" + (vm-number-of (car ml)))) + ;; Kyle Jones says: + ;; have to stuff the attributes in all cases because + ;; the deleted attribute may have been stuffed + ;; previously and we don't want to save that attribute. + ;; FIXME But stuffing attributes into the IMAP buffer is + ;; not easy. USR, 2010-03-08 + ;; (vm-stuff-message-data m t) + (if server-to-server-p ; economise on upstream data traffic + (let ((process + (vm-re-establish-folder-imap-session nil "save"))) + (if (null process) + (error "Could not connect to the IMAP server")) + (vm-imap-copy-message process m mailbox)) + (unless process + (setq process + (vm-imap-make-session folder t "save"))) + (if (null process) + (error "Could not connect to the IMAP server")) + (vm-imap-save-message process m mailbox)) + (vm-run-hook-on-message-with-args 'vm-save-message-hook m folder) + (vm-set-filed-flag m t) + (vm-increment save-count) + (vm-modify-folder-totals folder 'saved 1 m) + ;; we set the deleted flag so that the user is not + ;; confused if the save doesn't go through fully. + (when (and vm-delete-after-saving (not (vm-deleted-flag m))) + (vm-set-deleted-flag m t)) + (vm-inform 6 "Saving messages... %s" save-count) + (setq ml (cdr ml)))) + (when process (vm-imap-end-session process)) + (vm-inform 5 "%d message%s saved to %s" + save-count (if (/= 1 save-count) "s" "") + (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder)))) + (vm-update-summary-and-mode-line) + (setq vm-last-save-imap-folder folder) + ;; We call delete-message again even though the deleted-flags have + ;; already been set, perhaps to take care of other business? + (if (and vm-delete-after-saving (not vm-folder-read-only)) + (vm-delete-message count mlist)) + folder )) + +;;; vm-save.el ends here diff --git a/lisp/vm-search.el b/lisp/vm-search.el new file mode 100755 index 0000000..9ad86ce --- /dev/null +++ b/lisp/vm-search.el @@ -0,0 +1,144 @@ +;;; vm-search.el --- Incremental search through a mail folder +;; +;; This file is part of VM +;; +;; Copyright (C) 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-search) + +(eval-and-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-undo) + (require 'vm-startup) + (require 'vm-motion) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) +) + + +;;;###autoload +(defun vm-isearch-forward (&optional arg) + "Incrementally search forward through the current folder's messages. +Usage is identical to the standard Emacs incremental search. +When the search terminates the message containing point will be selected. + +If the variable vm-search-using-regexps is non-nil, regular expressions +are understood; nil means the search will be for the input string taken +literally. Specifying a prefix ARG interactively toggles the value of +vm-search-using-regexps for this search." + (interactive "P") + (let ((vm-search-using-regexps + (if arg (not vm-search-using-regexps) vm-search-using-regexps))) + (vm-isearch t))) + +;;;###autoload +(defun vm-isearch-backward (&optional arg) + "Incrementally search backward through the current folder's messages. +Usage is identical to the standard Emacs incremental search. +When the search terminates the message containing point will be selected. + +If the variable vm-search-using-regexps is non-nil, regular expressions +are understood; nil means the search will be for the input string taken +literally. Specifying a prefix ARG interactively toggles the value of +vm-search-using-regexps for this search." + (interactive "P") + (let ((vm-search-using-regexps + (if arg (not vm-search-using-regexps) vm-search-using-regexps))) + (vm-isearch nil))) + +(defun vm-isearch (forward) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-virtual-folder) + (vm-display (current-buffer) t '(vm-isearch-forward vm-isearch-backward) + (list this-command 'searching-message)) + (let ((clip-head (point-min)) + (clip-tail (point-max)) + (old-vm-message-pointer vm-message-pointer)) + (unwind-protect + (progn (select-window (vm-get-visible-buffer-window (current-buffer))) + (widen) + (add-hook 'pre-command-hook 'vm-isearch-widen) + ;; order is significant, we want to narrow after + ;; the update + (add-hook 'post-command-hook 'vm-isearch-narrow) + (add-hook 'post-command-hook 'vm-isearch-update) + (isearch-mode forward vm-search-using-regexps nil t) + (vm-isearch-update) + (if (not (eq vm-message-pointer old-vm-message-pointer)) + (progn + (vm-record-and-change-message-pointer + old-vm-message-pointer vm-message-pointer) + (vm-update-summary-and-mode-line) + ;; vm-show-current-message only adjusts (point-max), + ;; it doesn't change (point-min). + (widen) + (narrow-to-region + (if (< (point) (vm-vheaders-of (car vm-message-pointer))) + (vm-start-of (car vm-message-pointer)) + (vm-vheaders-of (car vm-message-pointer))) + (vm-text-end-of (car vm-message-pointer))) + (save-excursion (vm-energize-urls)) + (vm-display nil nil + '(vm-isearch-forward vm-isearch-backward) + '(reading-message)) + ;; turn the unwinds into a noop + (setq old-vm-message-pointer vm-message-pointer) + (setq clip-head (point-min)) + (setq clip-tail (point-max))))) + (remove-hook 'pre-command-hook 'vm-isearch-widen) + (remove-hook 'post-command-hook 'vm-isearch-update) + (remove-hook 'post-command-hook 'vm-isearch-narrow) + (narrow-to-region clip-head clip-tail) + (setq vm-message-pointer old-vm-message-pointer)))) + +(defun vm-isearch-widen () + (if (eq major-mode 'vm-mode) + (widen))) + +;;;###autoload +(defun vm-isearch-narrow () + (if (eq major-mode 'vm-mode) + (narrow-to-region + (if (< (point) (vm-vheaders-of (car vm-message-pointer))) + (vm-start-of (car vm-message-pointer)) + (vm-vheaders-of (car vm-message-pointer))) + (vm-text-end-of (car vm-message-pointer))))) + +;;;###autoload +(defun vm-isearch-update () + (if (eq major-mode 'vm-mode) + (if (and (>= (point) (vm-start-of (car vm-message-pointer))) + (<= (point) (vm-end-of (car vm-message-pointer)))) + nil + (let ((mp vm-message-list) + (point (point))) + (while mp + (if (and (>= point (vm-start-of (car mp))) + (<= point (vm-end-of (car mp)))) + (setq vm-message-pointer mp mp nil) + (setq mp (cdr mp)))) + (setq vm-need-summary-pointer-update t) + (intern (buffer-name) vm-buffers-needing-display-update) + (vm-update-summary-and-mode-line))))) + +;;; vm-search.el ends here diff --git a/lisp/vm-serial.el b/lisp/vm-serial.el new file mode 100755 index 0000000..964f35d --- /dev/null +++ b/lisp/vm-serial.el @@ -0,0 +1,910 @@ +;;; vm-serial.el --- automatic creation of personalized message bodies +;; and sending of personalized serial mails +;; +;; This file is an add-on for VM +;; +;; Copyright (C) 2000-2005 Robert Widhopf-Fenk +;; +;; Author: Robert Widhopf-Fenk +;; Status: Tested with XEmacs 21.4.15 & VM 7.19 +;; Keywords: sending mail, default mail, multiple recipients, serial mails +;; X-URL: http://www.robf.de/Hacking/elisp + +;; +;; This code is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; +;;; Commentary: +;; +;; Are you lazy on the one hand, but you like salutations and greetings? +;; +;; YES? +;; +;; If so you got the right package here! The idea is similar to those of +;; autoinsert.el, tempo.el, template.el etc., but specialized for composing +;; mails with VM. +;; +;; You may want to use the following into your .vm file after adding other +;; vm-mail-mode-hooks ... +;; +;; (require 'vm-serial) +;; (add-hook 'vm-mail-mode-hook 'vm-serial-auto-yank-mail t) +;; (define-key vm-mail-mode-map "\C-c\C-t" 'vm-serial-expand-tokens) +;; +;; and check out what happens if you reply to a message or what happens after +;; specifying a recipient in the to header and typing [C-c C-t]. +;; +;; Isn't it cool? +;; +;; Now add multiple recipients to a mail before pressing [C-c C-t] and call +;; [M-x vm-serial-send-mail] in order to see what happens. If you are a +;; trustful guy you may add a prefix arg [C-u]. +;; +;; In order to learn more about valid tokens you should have a look at the +;; documentation mail template. +;; +;; Go to an newly mail buffer add a From and To header and type: +;; C-u M-x vm-serial-yank-mail RET doc RET +;; M-x vm-serial-expand-tokens RET +;; +;;; KNOWN PROBLEMS: +;; +;; - mail-signature: instead of using this variable, you should use +;; `vm-serial-mail-signature' with exaclty the same semantics. +;; +;;; Thanks: +;; +;; Ivan Kanis has contributed some bugfixes & enhancements. +;; +;;; Code: + +(provide 'vm-serial) + +(require 'vm-reply) + +(defgroup vm-serial nil + "Sending personalized serial mails and getting message templates." + :group 'vm-ext) + +(eval-when-compile + (require 'cl)) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-mime)) + +(eval-and-compile + (require 'vm-pine) + (require 'mail-utils) + (require 'mail-extr) + (require 'advice)) + +(declare-function bbdb-extract-address-components + "ext:bbdb-snarf" (adstring &optional ignore-errors)) +(declare-function bbdb-record-firstname "ext:bbdb" (record)) +(declare-function bbdb-record-lastname "ext:bbdb" (record)) +(declare-function bbdb-search-simple "ext:bbdb" (name net)) +(declare-function bbdb-split "ext:bbdb" (string separators)) +(declare-function bbdb/sc-consult-attr "ext:bbdb-sc" (from)) + +;; vm-xemacs is a fake file meant to fool Emacs 23 compiler +(declare-function region-exists-p "vm-xemacs" ()) +(declare-function zmacs-region-buffer "vm-xemacs" ()) +;; The following function is erroneously called in fsfemacs too +;; (declare-function read-expression "vm-xemacs" +;; (prompt &optional initial-contents history default)) + +(let ((feature-list '(bbdb bbdb-sc))) + (while feature-list + (condition-case nil + (require (car feature-list)) + (error + (if (load (format "%s" (car feature-list)) t) + (message "Library %s loaded!" (car feature-list)) + (message "Could not load feature %S. Related functions may not work correctly!" (car feature-list))))) + (setq feature-list (cdr feature-list)))) + +(defvar vm-reply-list nil) +(defvar vm-redistribute-list nil) +(defvar vm-forward-list) + +;;----------------------------------------------------------------------------- +(defcustom vm-serial-token-alist + '(;; standard tokens you should not change (or need not) + ("to" (vm-serial-get-to) + "to header of the mail") + + ("sir" (vm-serial-get-name 'last) + "the last name of the recipient") + ("you" (vm-serial-get-name 'first) + "the first name of the recipient") + ("mr" (vm-serial-get-name) + "the full name of the recipient") + + ("bbdbsir" (vm-serial-get-bbdb-name 'last) + "the last name of the recipient as returned by the BBDB") + ("bbdbyou" (vm-serial-get-bbdb-name 'first) + "the first name of the recipient as returned by the BBDB") + ("bbdbmr" (vm-serial-get-bbdb-name) + "the full name of the recipient as returned by the BBDB") + + ("me" (user-full-name) + "your full name") + ("i" (vm-serial-get-name 'first (user-full-name)) + "your first name") + ("I" (vm-serial-get-name 'last (user-full-name)) + "your last name") + ("point" (and (setq vm-serial-point (point)) nil) + "the position of point after expanding tokens") + ("reply" (if (and vm-reply-list vm-serial-body-contents) + (insert vm-serial-body-contents)) + "set to the message body when replying") + ("forward" (if (and vm-forward-list vm-serial-body-contents) + (insert vm-serial-body-contents)) + "set to the message body when forwarding") + ("body" (if vm-serial-body-contents + (insert vm-serial-body-contents)) + "set to the message body before yanking a mail template") + ("sig" (cond + ((not vm-serial-mail-signature) + nil) + ((stringp vm-serial-mail-signature) + vm-serial-mail-signature) + ((eq t vm-serial-mail-signature) + (insert-file mail-signature-file)) + ((functionp vm-serial-mail-signature) + (funcall vm-serial-mail-signature)) + (t + (eval vm-serial-mail-signature))) + "the signature obtained from `vm-serial-mail-signature'") + ("fifosig" (concat "-- \n" + (shell-command-to-string + (concat "cat " mail-signature-file))) + "a signature read from a FIFO") + ;; english + ("hi" ("Hi" "Hello" "Dear") + "a randomly selected hi-style salutation") + ("dear" ("Lovely" "Hello" "Dear" "Sweetheart") + "a randomly selected dear-style salutation") + ("bye" ("" "Bye " "Cheers " "CU ") + "a randomly selected bye-style greeting") + ("br" ("Best regards" "Sincerly" "Yours") + "a randomly selected best-regards-style greeting") + ("babe" ("honey" "sugar pie" "darling" "babe") + "a randomly selected honey-style salutation") + ("inlove" ("In love" "Dreaming of you" "1 billion kisses") + "a randomly selected inlove-style greeting") + ("your" ("honey" "sugar pie" "darling" "babe" + (vm-serial-get-name 'first (user-full-name))) + "a randomly selected your-style greeting") + ;; german + ("hallo" ("Hi" "Griass di" "Servus" "Hallo") + "ein Hallo-Gruß") + ("mausl" ("Mausl" "Liebling" "Schatzi" "Hallo") + "die Freundin") + ("ciao" ("" "Ciao " "Tschüß " "Servus " "Mach's gut " "Bis denn " + "Bis die Tage mal ") + "Verabschiedung") + ("sg" ("Sehr geehrte Frau/Herr") + "förmliche Anrede") + ("mfg" ("Mit freundlichen Grüßen") + "förmliche Verabschiedung") + ;; french + ("salut" ("Salut" "Bonjour") + "Une salutation au hasard") + ("merci" ("Merci" "Au revoir" "A+" "Amicalement") + "Un au revoir au hasard") + ) + "*Alist for mapping tokens to real things, i.e., strings. +Set this by calling `vm-serial-set-tokens'! + +The format of each record is: + + (TOKENNAME SEXPRESSION DOCUMENTATION) + +TOKENNAME and DOCUMENTATION have to be strings. +SEXPRESSION one of +- a list starting with a string, which might be followed by other + string, functions or Lisp expressions +- a function returning a string +- a Lisp expression which evaluates to a string + +When a list starting with a string then `vm-serial-expand-tokens' will +randomly select one of them during expansion." + :group 'vm-serial + :type '(repeat (list (string :tag "Tagname") + (choice (repeat :tag "List of strings" (string)) + (sexp :tag "Sexp evaluating to a string")) + (string :tag "Documentation")))) + +(defcustom vm-serial-mails-alist + '(("honey" + "girlfriend" + "$dear $babe, + +$point$reply + +$inlove $your +$forward") + ("german-reply" + (and vm-reply-list + (string-match "\\.\\(de\\|at\\|ch\\)>?$" + (vm-mail-mode-get-header-contents "To:"))) + "$reply +$point +$ciao$i") + ("german-default" + "\\.\\(de\\|at\\|ch\\)>?$" + "$hallo $you, + +$point$reply + +$ciao$i + +$forward +$sig") + ("german-serious" + "\\.\\(de\\|at\\|ch\\)>?$" + "$sg $sir, + +$point$reply + +$mfg +$me + +$forward +$sig") + ("english-reply" + vm-reply-list + "$reply +$point +$bye$i") + ("english-default" + t + "$hi $you, + +$point$reply + +$bye$i + +$forward +$sig +") + ;; A test mail for showing what's possible + ("doc" + nil + " + A LECTURE ON VM-SERIAL + +The `vm-serial-mails-alist' contains a list of templates and associated +conditions and names for these templates. + +When doing a `vm-serial-yank-mail' it will check for the first condition +which matches and inserts this template. Tokens in the template are +expanded by the function called `vm-serial-expand-tokens'. + +There are default tokens for various things. Tokens start with the +string specified in `vm-serial-cookie' which is \"$(eval vm-serial-cookie)\" followed by a +string matching the regexp \\([a-zA-Z][a-zA-Z0-9_-]*\\) which may be +enclosed by {} or a lisp expressions. The first type is a named token +and has to be listed in the variable `vm-serial-token-alist'. It will be +expanded and if evaluating to a non nil object then it is inserted. In +order to get just the `vm-serial-cookie' \"$(eval vm-serial-cookie)\" simply write it twice. + +You may also embed any kind of lisp expression. If they return a string, it +will be inserted. + +Do [M-x vm-serial-expand-tokens] in order to see how things change ... + +Example of a embedded lisp expression: + + the current date is $$(format-time-string \"%D %r\"). + + $$(center-line) Center this line + + $$$no expansion + +The following tokens are currently defined: + +Token Documentation (the example follows in the next line) +$(mapconcat + (function (lambda (tk) + (concat (car tk) \"\\t\" (caddr tk) \"\n\t$\" (car tk)))) + vm-serial-token-alist \"\n\") + + +If you thing there are other tokens which should be added to this list, please +let me know! + +mailto:Robert Fenk")) + "*Alist of default mail templates. +Set this by calling `vm-serial-set-mail'! + +Format: + ((SYMBOLIC-NAME CONDITION MAIL-FORM) + ...) + +When calling `vm-serial-yank-mail' interactively one will be prompted for +a SYMBOLIC-NAME of a mail from. If called non interactively it will +search for the first condition which evaluates to true and inserts the +corresponding mail. If CONDITION is a string it is matched against the +To-header otherwise it is evaluated." + :group 'vm-serial + :type '(repeat (list (string :tag "Name") + (choice :tag "Condition" + (const :tag "NEVER" nil) + (const :tag "ALWAYS" t) + (string :tag "Regexp" "emailaddress") + (variable-item :tag "Relpy" vm-reply-list) + (variable-item :tag "Forward" vm-forward-list) + (variable-item :tag "Redistribute" vm-redistribute-list) + (sexp :tag "SEXP")) + (string :tag "Message-Template")))) + +(defcustom vm-serial-cookie "$" + "*The string which begins a token or Lisp expression. +See `vm-serial-expand-tokens' for information about valid tokens." + :group 'vm-serial + :type 'string) + +(defcustom vm-serial-fcc nil + "*Whether to keep a FCC from the source mail within each serial mail. +If the function `vm-postpone-message' (from vm-pine) is present it will +also save the source message in the specified folder otherwise there is +no way to save the source message." + :group 'vm-serial + :type 'boolean) + +(defcustom vm-serial-mail-signature nil + "*Text inserted at the `sig'-token of a mail buffer. +The semantics are equal to those of variable `mail-signature', however you +should disable variable `mail-signature', since it interacts badly with +vm-serial, i.e. set vm-serial-mail-signature to the value of variable +`mail-signature' and set variable `mail-signature' to nil!" + :group 'vm-serial + :type '(choice (const :tag "None" nil) + (const :tag "The content of `mail-signature-file'" t) + (function-item :tag "Function") + (sexp :tag "Lisp-Form"))) + +(defvar vm-serial-to nil + "The recipient of the currently expanded message.") + +(defvar vm-serial-body-contents nil + "The message body of the currently replied or forwarded message.") + +(defcustom vm-serial-unknown-to "unknown" + "*The string displayed for recipients without a real name. +If set to something different than a string it will be evaluated in order to +return a string." + :group 'vm-serial + :type 'string) + +(defvar vm-serial-source-buffer + nil + "The source buffer of the currently expanded template. +When doing a `vm-serial-send-mail' this will point to the source +buffer containing the original message.") + +(defvar vm-serial-send-mail-buffer "*vm-serial-mail*" + "*Name of the buffer use by `vm-serial-send-mail' for expanded template.") + +(defvar vm-serial-send-mail-jobs + nil + "Remaining list of addresses which have to be processed after editing.") + +(make-variable-buffer-local 'vm-serial-source-buffer) +(make-variable-buffer-local 'vm-serial-send-mail-jobs) + +;;----------------------------------------------------------------------------- +(defun vm-serial-get-completing-list (alist) + "Return cars from ALIST for completion." + (mapcar (lambda (e) (list (car e))) alist)) + +;;----------------------------------------------------------------------------- +(defvar vm-serial-token-history nil) + +(defun vm-serial-set-token (&optional token newvalue doc) + "Set vm-serial TOKEN to NEWVALUE with DOC. +You may remove a token by specifying just the TOKEN as argument." + (interactive + (let* ((token (completing-read "Token: " + (vm-serial-get-completing-list + vm-serial-token-alist) + nil nil nil + vm-serial-token-history)) + (value (read-expression + "Value: " + (format "%S" (cdr (assoc token vm-serial-token-alist)))))) + (list token value))) + (let ((tk (assoc token vm-serial-token-alist))) + (if tk + (if newvalue + (setcdr tk (list newvalue doc)) + (setq vm-serial-token-alist (delete tk vm-serial-token-alist))) + (setq vm-serial-token-alist + (nconc vm-serial-token-alist + (list (list token newvalue doc))))))) + +(defun vm-serial-set-tokens (token-list) + "Set `vm-serial-token-alist' according to TOKEN-LIST. +Is a list of (TOKEN NEWVALUE DOC) elements" + (let (token-value) + (while token-list + (setq token-value (car token-list)) + (vm-serial-set-token (car token-value) (cadr token-value) + (caddr token-value)) + (setq token-list (cdr token-list))))) + +(defun vm-serial-get-token (&optional token) + "Return value of vm-serial TOKEN." + (interactive (list (completing-read "Token: " + (vm-serial-get-completing-list + vm-serial-token-alist) + nil nil nil + vm-serial-token-history))) + (let ((value (assoc token vm-serial-token-alist))) + (if value + (cadr value) + (warn "There is no vm-serial token `%s'" token) + nil))) + +(defun vm-serial-eval-token-value (&optional token-value) + "Return string value by evaluation TOKEN-VALUE." + (if (stringp token-value) + token-value + (condition-case err + (cond ((and (listp token-value) (stringp (car token-value))) + (setq token-value (vm-serial-random-string token-value))) + ((functionp token-value) + (setq token-value (funcall token-value))) + (t + (setq token-value (eval token-value)))) + (error (setq token-value nil) + (warn (format "Token `%s' caused a %S" + token-value err)) + nil)) + token-value)) + +;;----------------------------------------------------------------------------- +(defun vm-serial-get-emails (&optional header) + "Return the recipient of current message. +Optional argument HEADER is the header to get the recipients from." + (setq header (or header "To:")) + (let ((to (vm-mail-mode-get-header-contents header))) + (if (functionp 'bbdb-extract-address-components) + (car (bbdb-extract-address-components to)) + (mail-extract-address-components to)))) + +(defun vm-serial-get-to () + "Return the recipient of current message." + (or vm-serial-to + (vm-serial-get-emails "To:"))) + +(defun vm-serial-get-name (&optional part name) + (let ((name (or name + (and vm-serial-to (car vm-serial-to)) + (let ((to (vm-serial-get-to))) + (and to (or (car to) + (cadr to)))) + (eval vm-serial-unknown-to))) + (part (cond ((stringp part) part) + ((equal part 'first) "^\\(\\w+\\)[\t ._]") + ((equal part 'last) "^\\w+[\t ._]+\\(.+\\)$")))) + + (if (and part (string-match part name)) + (match-string 1 name) + name))) + +(defun vm-serial-get-bbdb-name (&optional part name) + (let* ((to (vm-serial-get-to)) + (rec (bbdb-search-simple nil (cadr to)))) + (if rec + (cond ((equal part 'first) (or (bbdb/sc-consult-attr (cadr to)) + (bbdb-record-firstname rec))) + ((equal part 'last) (bbdb-record-lastname rec))) + (vm-serial-get-name part name)))) + +;;----------------------------------------------------------------------------- +(defun vm-serial-set-mails (mail-alist) + "Set `vm-serial-mails-alist' according to MAIL-ALIST." + (let (m) + (setq mail-alist (reverse mail-alist)) + (while mail-alist + (setq m (assoc (caar mail-alist) vm-serial-mails-alist)) + (if m + (setq vm-serial-mails-alist (delete m vm-serial-mails-alist))) + (add-to-list 'vm-serial-mails-alist (car mail-alist)) + (setq mail-alist (cdr mail-alist))))) + +(defun vm-serial-get-mail (&optional mail) + "Return the mail body associated with MAIL." + (let ((value (assoc mail vm-serial-mails-alist))) + (if value (car (last value)) nil))) + +(defvar vm-serial-mail-history nil + "History for `vm-serial-yank-mail'.") + +(defun vm-serial-find-default-mail () + "Return the first recipient." + (let ((to (vm-decode-mime-encoded-words-in-string + (or (vm-mail-mode-get-header-contents "To:") + (vm-mail-mode-get-header-contents "CC:") + (vm-mail-mode-get-header-contents "BCC:") + ""))) + (mails-alist vm-serial-mails-alist) + m mail) + (setq mail nil) + (if (string-match "^\\s-*\\(.*[^ \t]\\)\\s-*$" to) + (setq to (match-string 1 to))) + (while mails-alist + (setq m (car mails-alist)) + (if (and (> (length m) 2) + (cond ((stringp (cadr m)) + (let ((case-fold-search t)) + (string-match (cadr m) to))) + ((functionp (cadr m)) + (funcall (cadr m))) + ((equal (cadr m) t)) + (t + (eval (cadr m))))) + (setq mail (car m) + mails-alist nil)) + (setq mails-alist (cdr mails-alist))) + mail)) + +(defun vm-serial-auto-yank-mail (&optional mail no-expand) + "Yank the mail associated with MAIL. +If MAIL is nil search for a default mail, i.e. the first which evaluates its +condition to true. When called with a prefix argument or if NO-EXPAND is non +nil no tokens will be expanded after yanking. + +This is like `vm-serial-yank-mail', but it ensures to yank only if the buffer +is no serial mail buffer and if there was no yank-mail before!" + (if (and (not vm-serial-source-buffer) + (not vm-redistribute-list) + (not (local-variable-p 'vm-serial-body-contents (current-buffer))) + (boundp 'vm-postponed-message-folder-buffer) + (not vm-postponed-message-folder-buffer)) + (vm-serial-yank-mail (or mail (vm-serial-find-default-mail)) + no-expand))) + +(defvar vm-serial-yank-mail-choice nil) +(make-variable-buffer-local 'vm-serial-yank-mail-choice) + +(defun vm-serial-yank-mail (&optional mail no-expand) + "Yank the template associated with MAIL. + +If MAIL is nil search for a default template, i.e. the first one which +evaluates its condition to true. When called with a prefix argument ask for +a template and with another prefix argument or if NO-EXPAND is non nil +no tokens will be expanded after yanking. + +You may bind this to [C-c C-t] in mail-mode in order to automatically yank +the right mail into the composition buffer and move the cursor to the +editing point. + +I try to be clever when to delete the existing buffer contents and when to +expand the tokens, however if this does not satisfy you please report it to +me." + + (interactive "p") + + (if (numberp mail) + (if (= mail 1) + (setq mail nil) + (setq no-expand (if (= mail 16) '(t)) + mail (completing-read + "Mail: " + (vm-serial-get-completing-list + vm-serial-mails-alist) + nil + t;; exact match + (cons (vm-serial-find-default-mail) + 0) + vm-serial-mail-history) + vm-serial-yank-mail-choice mail))) + + (setq mail (or mail vm-serial-yank-mail-choice (vm-serial-find-default-mail))) + + (let ((save-point (point))) + (if (not mail) + (message "There is no matching mail form!") + (if (local-variable-p 'vm-serial-body-contents (current-buffer)) + (progn (delete-region (mail-text) (point-max)) + (setq no-expand (if (and no-expand (listp no-expand)) + no-expand 'not)))) + + (if (or (vm-interactive-p) + (local-variable-p 'vm-serial-body-contents (current-buffer))) + (message "Inserting serial mail `%S'." mail) + (let ((start (mail-text)) (end (goto-char (point-max)))) + (make-local-variable 'vm-serial-body-contents) + (make-local-variable 'vm-serial-to) + (setq vm-serial-to nil + vm-serial-body-contents nil) + (if (not (or vm-reply-list vm-forward-list)) + (setq no-expand (if (equal no-expand 'not) nil + (if (and no-expand (listp no-expand)) + no-expand t))) + (setq vm-serial-body-contents (buffer-substring start end)) + (delete-region start end)))) + + (let ((value (vm-serial-get-mail mail))) + (save-excursion + (insert value))) + + (if (or (and (not vm-forward-list) (not no-expand)) + (equal no-expand 'not)) + (vm-serial-expand-tokens) + (goto-char save-point))))) + +;;----------------------------------------------------------------------------- +(defun vm-serial-random-string (string-list) + "Randomly return one of the strings in STRING-LIST." + (let ((value (nth (mod (random) (length string-list)) string-list))) + (cond ((stringp value) + value) + ((functionp value) + (funcall value)) + (t + (eval value))))) + +(defun vm-serial-expand-tokens (&optional rstart rend) + "Expand all tokens within the current mail. +This means we search for the `vm-serial-cookie' and if it is followed by a +regexp of \"[a-zA-Z][a-zA-Z0-9_-]\" we treat this as a symbol to look up in +our `vm-serial-token-alist'. Optionally one may enclose the symbol by curly +parenthesis. See the test mail in `vm-serial-mails-alist' for examples. +If the cookie is followed by a parenthesis then it is treated as a lisp +expression which is evaluated + +Results evaluating to a string are inserted all other return values are +ignored. For non existing tokens or errors during evaluation one will get +a warning." + (interactive) + + (let ((token-regexp (concat (regexp-quote vm-serial-cookie) + "\\(" (regexp-quote vm-serial-cookie) "\\)*" + "[{\(a-zA-Z]")) + start end expr result vm-serial-point) + (if (and vm-xemacs-p + (region-exists-p) + (eq (zmacs-region-buffer) (current-buffer))) + (setq rstart (goto-char (region-beginning)) rend (region-end)) + (setq rstart (mail-text) rend (point-max))) + + (narrow-to-region rstart rend) + (while (re-search-forward token-regexp (point-max) t) + (backward-char 1) + (setq start (- (match-end 0) 1) + result nil) + (cond ((> (length (match-string 1)) 0) + (delete-region (match-beginning 1) (match-end 1))) + ((looking-at "(") + (setq end (scan-sexps start 1)) + (goto-char start) + (setq expr (read (current-buffer))) + (delete-region (- start 1) end) + (setq result (vm-serial-eval-token-value expr))) + ((looking-at "\\({\\)?\\([a-zA-Z][a-zA-Z0-9_-]*\\)\\(}\\)?") + (setq start (match-beginning 2)) + (setq end (match-end 2)) + (setq expr (buffer-substring start end)) + (if (and (not (and (match-end 1) (match-end 3))) + (or (match-end 1) (match-end 3))) + (error "Invalid token expression `%s'" + (match-string 0))) + (delete-region (- (match-beginning 0) 1) (match-end 0)) + (setq result (vm-serial-eval-token-value + (vm-serial-get-token expr)))) + ) + (if (and result (stringp result)) + (insert (format "%s" result)))) + (widen) + (if vm-serial-point + (goto-char vm-serial-point)))) + +(defvar vm-serial-insert-token-history nil) + +(defun vm-serial-insert-token (token) + "Reads a valid token, inserts it at point and expands it." + (interactive (list + (completing-read + (format "Token%s: " + (if vm-serial-insert-token-history + (concat " (default: " + (car vm-serial-insert-token-history) + ")") + "")) + (mapcar (lambda (tok) (list (car tok))) + vm-serial-token-alist) + nil + t + nil + 'vm-serial-insert-token-history))) + (setq vm-serial-insert-token-history + (delete "" vm-serial-insert-token-history)) + (if (string= "" token) + (setq token (car vm-serial-insert-token-history))) + (if (null token) + (error "Error: you have to enter a toke name!")) + (let ((start (point))) + (insert vm-serial-cookie token) + (vm-serial-expand-tokens start (point)))) + +;;----------------------------------------------------------------------------- +(defvar vm-serial-sent-cnt nil) +(defvar vm-serial-edited-cnt nil) +(defvar vm-serial-killed-cnt nil) +(defvar vm-serial-send-mail-exit nil) + +(defun vm-serial-send-mail-increment (variable) + (save-excursion + (set-buffer vm-serial-source-buffer) + (eval (list 'vm-increment variable)))) + + +(defun vm-serial-send-mail-and-exit (&optional non-interactive) + "Like `vm-serial-send-mail' but kills the buffer after sending all." + (interactive "P") + (make-local-variable 'vm-serial-send-mail-exit) + (setq vm-serial-send-mail-exit t) + (vm-serial-send-mail non-interactive)) + +(defun vm-serial-send-mail (&optional non-interactive done) + "Send an expanded mail to each recipient listed in the To-header. +This will create a new buffer for expanding the tokens and user interaction. +You may send each mail interactively, that means you may send the message as +it is, or you may edit it before sending or you may skip it. + +If called with a prefix argument or NON-INTERACTIVE set to non nil, no +questions will bother you!" + (interactive "P") + + (remove-hook 'kill-buffer-hook 'vm-serial-send-mail t) + + (if vm-serial-source-buffer + (progn (set-buffer vm-serial-source-buffer) + (setq done t))) + + (if (get-buffer vm-serial-send-mail-buffer) + (save-excursion + (kill-buffer (get-buffer vm-serial-send-mail-buffer)))) + + (let* ((work-buffer + (save-excursion + (let ((vm-frame-per-composition nil)) + (flet ((vm-display (buffer display commands configs + &optional do-not-raise) + nil)) + (vm-mail-internal :buffer-name vm-serial-send-mail-buffer)) + (get-buffer vm-serial-send-mail-buffer)))) + (source-buffer (current-buffer)) + work to to-string) + + (if (and (not vm-serial-send-mail-jobs) (not done)) + (if (not (setq to (mail-fetch-field "To" nil t))) + (error "There are no recipients in %s!" (buffer-name)) + (setq vm-serial-send-mail-jobs + (if (functionp 'bbdb-extract-address-components) + (bbdb-extract-address-components to) + (mapcar 'mail-extract-address-components + (bbdb-split to ",")))) + (make-local-variable 'vm-serial-sent-cnt) + (make-local-variable 'vm-serial-edited-cnt) + (make-local-variable 'vm-serial-killed-cnt) + (setq vm-serial-sent-cnt 0 + vm-serial-edited-cnt 0 + vm-serial-killed-cnt 0))) + + ;; mail-extract-address-components isn't good at all! Fix it! + (save-excursion + (set-buffer work-buffer) + (setq major-mode 'mail-mode)) + + (while (and (not work) vm-serial-send-mail-jobs) + (setq to (car vm-serial-send-mail-jobs) + to-string (if (car to) + (concat (car to) " <" (cadr to) ">") + (cadr to))) + (copy-to-buffer work-buffer (point-min) (point-max)) + (save-excursion + (set-buffer work-buffer) + (goto-char (point-min)) + (vm-mail-mode-remove-header "To:") + (mail-position-on-field "To") + (insert to-string) + (if (not vm-serial-fcc) + (vm-mail-mode-remove-header "FCC:")) + (setq vm-serial-to to + vm-serial-source-buffer source-buffer) + (setq buffer-undo-list t) + (vm-serial-expand-tokens) + + (if (not non-interactive) + (let (command) + (switch-to-buffer work-buffer) + (while (not command) + (message "(q)uit session or (e)dit, (s)end or (k)ill this mail to `%s'?" + to) + (setq command (read-char-exclusive)) + (cond ((= command ?e) + (vm-serial-send-mail-increment 'vm-serial-edited-cnt) + (setq work 'edit)) + ((= command ?s) + (vm-serial-send-mail-increment 'vm-serial-sent-cnt) + (vm-mail-send)) + ((= command ?k) + (vm-serial-send-mail-increment 'vm-serial-killed-cnt)) + ((= command ?q) + (setq work 'quit)) + (t (message "Invalid command!") + (sit-for 1) + (setq command nil))))) + (vm-mail-send) + (vm-serial-send-mail-increment 'vm-serial-sent-cnt))) + + (setq vm-serial-send-mail-jobs (cdr vm-serial-send-mail-jobs))) + + ;; ok there was an exit or the like + (if (equal work 'edit) + (progn ;; and we want to edit the outgoing mail before sending + (switch-to-buffer work-buffer) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook) + (setq buffer-undo-list nil) + (vm-make-local-hook 'kill-buffer-hook) + (vm-make-local-hook 'mail-send-hook) + (add-hook 'kill-buffer-hook + (lambda () + (vm-serial-send-mail-increment 'vm-serial-killed-cnt)) + t t) + (add-hook 'kill-buffer-hook 'vm-serial-send-mail t t) + (add-hook 'mail-send-hook + (lambda () + (vm-serial-send-mail-increment 'vm-serial-sent-cnt)) + t t) + (remove-hook 'kill-buffer-hook 'vm-save-killed-message-hook t) + (message "Kill or send this mail to get to the next mail!")) + + ;; get rid of the work buffer and go back to the source + (kill-buffer work-buffer) + (switch-to-buffer source-buffer) + + (if (not (equal work 'quit)) + (let ((fcc (vm-mail-mode-get-header-contents "FCC:"))) + ;; some statistics + (message "%s mail%s sent, %s edited and %s killed by vm-serial!" + (if (= vm-serial-sent-cnt 1) "One" vm-serial-sent-cnt) + (if (= vm-serial-sent-cnt 1) "" "s") + vm-serial-edited-cnt vm-serial-killed-cnt) + + ;; this was the last mail so is there some FCC work to do? + (if (and fcc (not vm-serial-send-mail-jobs)) + (if (not (functionp 'vm-postpone-message)) + (error "vm-pine.el is needed to save source messages!") + ;; no postponed header for this!! + (vm-mail-mode-remove-header "FCC:") + (vm-postpone-message fcc vm-serial-send-mail-exit t)) + (if vm-serial-send-mail-exit + (kill-this-buffer)))))))) + +(defadvice vm-mail-send-and-exit (after vm-serial-send-mail activate) + (if vm-serial-source-buffer + (kill-this-buffer))) + +;;----------------------------------------------------------------------------- +;;; vm-serial.el ends here diff --git a/lisp/vm-sort.el b/lisp/vm-sort.el new file mode 100755 index 0000000..c088ae4 --- /dev/null +++ b/lisp/vm-sort.el @@ -0,0 +1,818 @@ +;;; vm-sort.el --- Sorting and moving messages inside VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1993, 1994 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + + +;;; Code + +(provide 'vm-sort) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-thread) + (require 'vm-motion) + (require 'vm-page) + (require 'vm-window) + (require 'vm-undo) + ) + +(declare-function vm-sort-insert-auto-folder-names "vm-avirtual" ()) + +;;;###autoload +(defun vm-move-message-forward (count) + "Move a message forward in a VM folder. +Prefix arg COUNT causes the current message to be moved COUNT messages forward. +A negative COUNT causes movement to be backward instead of forward. +COUNT defaults to 1. The current message remains selected after being +moved. + +If vm-move-messages-physically is non-nil, the physical copy of +the message in the folder is moved. A nil value means just +change the presentation order and leave the physical order of +the folder undisturbed." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if vm-move-messages-physically + (vm-error-if-folder-read-only)) + (vm-display nil nil '(vm-move-message-forward + vm-move-message-backward + vm-move-message-forward-physically + vm-move-message-backward-physically) + (list this-command)) + (let* ((ovmp vm-message-pointer) vmp-prev ovmp-prev + (vm-message-pointer vm-message-pointer) + (direction (if (> count 0) 'forward 'backward)) + (count (vm-abs count))) + (while (not (zerop count)) + (vm-move-message-pointer direction) + (vm-decrement count)) + (if (> (string-to-number (vm-number-of (car vm-message-pointer))) + (string-to-number (vm-number-of (car ovmp)))) + (setq vm-message-pointer (cdr vm-message-pointer))) + (if (eq vm-message-pointer ovmp) + () + (if (null vm-message-pointer) + (setq vmp-prev (vm-last vm-message-list)) + (setq vmp-prev (vm-reverse-link-of (car vm-message-pointer)))) + (setq ovmp-prev (vm-reverse-link-of (car ovmp))) + ;; lock out interrupts to preserve message list integrity. + (let ((inhibit-quit t)) + (if ovmp-prev + (progn + (setcdr ovmp-prev (cdr ovmp)) + (and (cdr ovmp) + (vm-set-reverse-link-of (car (cdr ovmp)) ovmp-prev))) + (setq vm-message-list (cdr ovmp)) + (vm-set-reverse-link-of (car vm-message-list) nil)) + (if vmp-prev + (progn + (setcdr vmp-prev ovmp) + (vm-set-reverse-link-of (car ovmp) vmp-prev)) + (setq vm-message-list ovmp) + (vm-set-reverse-link-of (car vm-message-list) nil)) + (setcdr ovmp vm-message-pointer) + (and vm-message-pointer + (vm-set-reverse-link-of (car vm-message-pointer) ovmp)) + (if (and vm-move-messages-physically + (not (eq major-mode 'vm-virtual-mode))) + (vm-physically-move-message (car ovmp) (car vm-message-pointer))) + (setq vm-ml-sort-keys nil) + (if (not vm-folder-read-only) + (progn + (setq vm-message-order-changed t) + (vm-mark-folder-modified-p (current-buffer)) + (vm-clear-modification-flag-undos)))) + (cond ((null ovmp-prev) + (setq vm-numbering-redo-start-point vm-message-list + vm-numbering-redo-end-point vm-message-pointer + vm-summary-pointer (car vm-message-list))) + ((null vmp-prev) + (setq vm-numbering-redo-start-point vm-message-list + vm-numbering-redo-end-point (cdr ovmp-prev) + vm-summary-pointer (car ovmp-prev))) + ((or (not vm-message-pointer) + (< (string-to-number (vm-number-of (car ovmp-prev))) + (string-to-number (vm-number-of (car vm-message-pointer))))) + (setq vm-numbering-redo-start-point (cdr ovmp-prev) + vm-numbering-redo-end-point (cdr ovmp) + vm-summary-pointer (car (cdr ovmp-prev)))) + (t + (setq vm-numbering-redo-start-point ovmp + vm-numbering-redo-end-point (cdr ovmp-prev) + vm-summary-pointer (car ovmp-prev)))) + (if vm-summary-buffer + (let (list mp) + (vm-copy-local-variables vm-summary-buffer 'vm-summary-pointer) + (setq vm-need-summary-pointer-update t) + (setq mp vm-numbering-redo-start-point) + (while (not (eq mp vm-numbering-redo-end-point)) + (vm-mark-for-summary-update (car mp)) + (setq list (cons (car mp) list) + mp (cdr mp))) + (vm-mapc + (function + (lambda (m p) + (vm-set-su-start-of m (car p)) + (vm-set-su-end-of m (car (cdr p))))) + (setq list (nreverse list)) + (sort + (mapcar + (function + (lambda (p) + (list (vm-su-start-of p) (vm-su-end-of p)))) + list) + (function + (lambda (p q) + (< (car p) (car q)))))))))) + (if vm-move-messages-physically + ;; clip region is messed up + (vm-present-current-message) + (vm-update-summary-and-mode-line))) + +;;;###autoload +(defun vm-move-message-backward (count) + "Move a message backward in a VM folder. +Prefix arg COUNT causes the current message to be moved COUNT +messages backward. A negative COUNT causes movement to be +forward instead of backward. COUNT defaults to 1. The current +message remains selected after being moved. + +If vm-move-messages-physically is non-nil, the physical copy of +the message in the folder is moved. A nil value means just +change the presentation order and leave the physical order of +the folder undisturbed." + (interactive "p") + (vm-move-message-forward (- count))) + +;;;###autoload +(defun vm-move-message-forward-physically (count) + "Like vm-move-message-forward but always move the message physically." + (interactive "p") + (let ((vm-move-messages-physically t)) + (vm-move-message-forward count))) + +;;;###autoload +(defun vm-move-message-backward-physically (count) + "Like vm-move-message-backward but always move the message physically." + (interactive "p") + (let ((vm-move-messages-physically t)) + (vm-move-message-backward count))) + +;; move message m to be before m-dest +;; and fix up the location markers afterwards. +;; m better not equal m-dest. +;; of m-dest is nil, move m to the end of buffer. +;; +;; consider carefully the effects of insertion on markers +;; and variables containg markers before you modify this code. +(defun vm-physically-move-message (m m-dest) + (save-excursion + (vm-save-restriction + (widen) + + ;; Make sure vm-headers-of and vm-text-of are non-nil in + ;; their slots before we try to move them. (Simply + ;; referencing the slot with their slot function is + ;; sufficient to guarantee this.) Otherwise, they be + ;; initialized in the middle of the message move and get the + ;; offset applied to them twice by way of a relative offset + ;; from one of the other location markers that has already + ;; been moved. + ;; + ;; Also, and more importantly, vm-vheaders-of might run + ;; vm-reorder-message-headers, which can add text to + ;; message. This MUST NOT happen after offsets have been + ;; computed for the message move or varying levels of chaos + ;; will ensue. In the case of BABYL files, where + ;; vm-reorder-message-headers can add a lot of new text, + ;; folder curroption can be massive. + (vm-text-of m) + (vm-vheaders-of m) + + (let ((dest-start (if m-dest (vm-start-of m-dest) (point-max))) + (buffer-read-only nil) + offset doomed-start doomed-end) + (goto-char dest-start) + (insert-buffer-substring (current-buffer) (vm-start-of m) (vm-end-of m)) + (setq doomed-start (marker-position (vm-start-of m)) + doomed-end (marker-position (vm-end-of m)) + offset (- (vm-start-of m) dest-start)) + (set-marker (vm-start-of m) (- (vm-start-of m) offset)) + (set-marker (vm-headers-of m) (- (vm-headers-of m) offset)) + (set-marker (vm-text-end-of m) (- (vm-text-end-of m) offset)) + (set-marker (vm-end-of m) (- (vm-end-of m) offset)) + (set-marker (vm-text-of m) (- (vm-text-of m) offset)) + (set-marker (vm-vheaders-of m) (- (vm-vheaders-of m) offset)) + ;; now fix the start of m-dest since it didn't + ;; move forward with its message. + (and m-dest (set-marker (vm-start-of m-dest) (vm-end-of m))) + ;; delete the old copy of the message + (delete-region doomed-start doomed-end))))) + +;;;###autoload +(defun vm-so-sortable-datestring (m) + "Returns the date string of M. The date returned is obtained from +the \"Date\" header of the message, if it exists, or the date the +message was received in VM. If `vm-sort-messages-by-delivery-date' is +non-nil, then the \"Delivery-Date\" header is used instead of the +\"Date\" header." + (or (vm-sortable-datestring-of m) + (progn + (vm-set-sortable-datestring-of + m + (condition-case nil + (vm-timezone-make-date-sortable + (or (if vm-sort-messages-by-delivery-date + (vm-get-header-contents m "Delivery-Date:") + (vm-get-header-contents m "Date:")) + (vm-grok-From_-date m) + "Thu, 1 Jan 1970 00:00:00 GMT")) + (error "1970010100:00:00"))) + (vm-sortable-datestring-of m)))) + +;;;###autoload +(defun vm-so-sortable-subject (m) + "Returns the subject string of M, after stripping redundant prefixes +and suffixes, which is suitable for sorting by subject. The string is +MIME-decoded with possible properties." + (or (vm-sortable-subject-of m) + (progn + (vm-set-sortable-subject-of + m + (let ((case-fold-search t) + (subject (vm-su-subject m))) + (if (and vm-subject-ignored-prefix + (string-match vm-subject-ignored-prefix subject) + (zerop (match-beginning 0))) + (setq subject (substring subject (match-end 0)))) + (if (and vm-subject-ignored-suffix + (string-match vm-subject-ignored-suffix subject) + (= (match-end 0) (length subject))) + (setq subject (substring subject 0 (match-beginning 0)))) + (setq subject (vm-with-string-as-temp-buffer + subject + (function vm-collapse-whitespace))) + (if (and vm-subject-significant-chars + (natnump vm-subject-significant-chars) + (< vm-subject-significant-chars (length subject))) + (setq subject + (substring subject 0 vm-subject-significant-chars))) + subject )) + (vm-sortable-subject-of m)))) + +(defvar vm-sort-compare-header nil + "the header to sort on.") + +(defvar vm-sort-compare-header-history nil) + +;;;###autoload +(defun vm-sort-messages (keys &optional lets-get-physical) + "Sort message in a folder by the specified KEYS. +KEYS is a string of sort keys, separated by spaces or tabs. If +messages compare equal by the first key, the second key will be +compared and so on. When called interactively the keys will be +read from the minibuffer. Valid keys are + +\"date\" \"reversed-date\" +\"activity\" \"reversed-activity\" +\"author\" \"reversed-author\" +\"full-name\" \"reversed-full-name\" +\"subject\" \"reversed-subject\" +\"recipients\" \"reversed-recipients\" +\"line-count\" \"reversed-line-count\" +\"byte-count\" \"reversed-byte-count\" +\"physical-order\" \"reversed-physical-order\" +\"spam-score\" \"reversed-spam-score\" + +Optional second arg (prefix arg interactively) means the sort +should change the physical order of the messages in the folder. +Normally VM changes presentation order only, leaving the +folder in the order in which the messages arrived." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (list (vm-read-string (if (or current-prefix-arg + vm-move-messages-physically) + "Physically sort messages by: " + "Sort messages by: ") + vm-supported-sort-keys t) + current-prefix-arg))) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + ;; only squawk if interactive. The thread display uses this + ;; function and doesn't expect errors. + (if (vm-interactive-p) + (vm-error-if-folder-empty)) + ;; ditto + (if (and (vm-interactive-p) (or vm-move-messages-physically lets-get-physical)) + (vm-error-if-folder-read-only)) + + (vm-display nil nil '(vm-sort-messages) '(vm-sort-messages)) + (let (key-list key-funcs key ml-keys + physical-order-list old-message-list new-message-list mp-old mp-new + old-start + doomed-start doomed-end offset + (order-did-change nil) + virtual + physical + auto-folder-p) + (setq key-list (vm-parse keys "[ \t]*\\([^ \t,]+\\)") + ml-keys (and key-list (mapconcat (function identity) key-list "/")) + key-funcs nil + old-message-list vm-message-list + virtual (eq major-mode 'vm-virtual-mode) + physical (and (or lets-get-physical + vm-move-messages-physically) + (not vm-folder-read-only) + (not virtual))) + (unless key-list + (error "No sort keys specified.")) + (while key-list + (setq key (car key-list)) + (cond ((equal key "auto-folder") + (setq auto-folder-p t) + (setq key-funcs (cons 'vm-sort-compare-auto-folder key-funcs))) + ((equal key "author") + (setq key-funcs (cons 'vm-sort-compare-author key-funcs))) + ((equal key "reversed-author") + (setq key-funcs (cons 'vm-sort-compare-author-r key-funcs))) + ((equal key "full-name") + (setq key-funcs (cons 'vm-sort-compare-full-name key-funcs))) + ((equal key "reversed-full-name") + (setq key-funcs (cons 'vm-sort-compare-full-name-r key-funcs))) + ((equal key "date") + (setq key-funcs (cons 'vm-sort-compare-date key-funcs))) + ((equal key "reversed-date") + (setq key-funcs (cons 'vm-sort-compare-date-r key-funcs))) + ((equal key "activity") + (setq vm-summary-show-threads t) + (setq key-funcs (cons 'vm-sort-compare-activity + key-funcs))) + ((equal key "reversed-activity") + (setq vm-summary-show-threads t) + (setq key-funcs (cons 'vm-sort-compare-activity-r + key-funcs))) + ;; ((equal key "thread-oldest-date") + ;; (setq vm-summary-show-threads t) + ;; (setq key-funcs (cons 'vm-sort-compare-thread-oldest-date + ;; key-funcs))) + ;; ((equal key "reversed-thread-oldest-date") + ;; (setq vm-summary-show-threads t) + ;; (setq key-funcs (cons 'vm-sort-compare-thread-oldest-date-r + ;; key-funcs))) + ((equal key "subject") + (setq key-funcs (cons 'vm-sort-compare-subject key-funcs))) + ((equal key "reversed-subject") + (setq key-funcs (cons 'vm-sort-compare-subject-r key-funcs))) + ((equal key "recipients") + (setq key-funcs (cons 'vm-sort-compare-recipients key-funcs))) + ((equal key "reversed-recipients") + (setq key-funcs (cons 'vm-sort-compare-recipients-r key-funcs))) + ((equal key "byte-count") + (setq key-funcs (cons 'vm-sort-compare-byte-count key-funcs))) + ((equal key "reversed-byte-count") + (setq key-funcs (cons 'vm-sort-compare-byte-count-r key-funcs))) + ((equal key "line-count") + (setq key-funcs (cons 'vm-sort-compare-line-count key-funcs))) + ((equal key "reversed-line-count") + (setq key-funcs (cons 'vm-sort-compare-line-count-r key-funcs))) + ((equal key "spam-score") + (setq key-funcs (cons 'vm-sort-compare-spam-score key-funcs))) + ((equal key "reversed-spam-score") + (setq key-funcs (cons 'vm-sort-compare-spam-score-r key-funcs))) + ((equal key "physical-order") + (setq key-funcs (cons 'vm-sort-compare-physical-order key-funcs))) + ((equal key "reversed-physical-order") + (setq key-funcs (cons 'vm-sort-compare-physical-order-r + key-funcs))) + ((equal key "header") + (setq vm-sort-compare-header nil) + (setq key-funcs (cons 'vm-sort-compare-header key-funcs))) + ((equal key "thread") + (vm-build-threads-if-unbuilt) + (vm-build-thread-lists) + (setq key-funcs (cons 'vm-sort-compare-thread key-funcs))) + (t + (let ((compare (intern (format "vm-sort-compare-%s" key)))) + (if (functionp compare) + (setq key-funcs (cons compare key-funcs)) + (error "Unknown key: %s" key))))) + (setq key-list (cdr key-list))) + (setq key-funcs (nreverse key-funcs)) + ;; if this is not a thread sort and threading is enabled, + ;; then disable threading and make sure the whole summary is + ;; regenerated (to recalculate %I everywhere). + (when vm-summary-show-threads + (vm-build-threads-if-unbuilt) + (vm-build-thread-lists) + (setq key-funcs (cons 'vm-sort-compare-thread key-funcs))) + (vm-inform 6 "Sorting messages...") + (let ((vm-key-functions key-funcs)) + (setq new-message-list (sort (copy-sequence old-message-list) + 'vm-sort-compare-xxxxxx)) + ;; only need to do this sort if we're going to physically + ;; move messages later. + (if physical + (setq vm-key-functions '(vm-sort-compare-physical-order) + physical-order-list (sort (copy-sequence old-message-list) + 'vm-sort-compare-xxxxxx)))) + (vm-inform 6 "Sorting messages... done") + (let ((inhibit-quit t)) + (setq mp-old old-message-list + mp-new new-message-list) + (while mp-new + (if (eq (car mp-old) (car mp-new)) + (setq mp-old (cdr mp-old) + mp-new (cdr mp-new)) + (setq order-did-change t) + ;; unless a full redo has been requested, the numbering + ;; start point now points to a cons in the old message + ;; list. therefore we just change the variable + ;; directly to avoid the list scan that + ;; vm-set-numbering-redo-start-point does. + (cond ((not (eq vm-numbering-redo-start-point t)) + (setq vm-numbering-redo-start-point mp-new + vm-numbering-redo-end-point nil))) + (if vm-summary-buffer + (progn + (setq vm-need-summary-pointer-update t) + ;; same logic as numbering reset above... + (cond ((not (eq vm-summary-redo-start-point t)) + (setq vm-summary-redo-start-point mp-new))) + ;; start point of this message's summary is now + ;; wrong relative to where it is in the + ;; message list. fix it and the summary rebuild + ;; will take care of the rest. + (vm-set-su-start-of (car mp-new) + (vm-su-start-of (car mp-old))))) + (setq mp-new nil))) + (if (and physical (vm-has-message-order)) + (let ((buffer-read-only nil)) + ;; the folder is being physically ordered so we don't + ;; need a message order header to be stuffed, nor do + ;; we need to retain one in the folder buffer. so we + ;; strip out any existing message order header and + ;; say there are no changes to prevent a message + ;; order header from being stuffed later. + (vm-remove-message-order) + (setq vm-message-order-changed nil) + (vm-inform 6 "Moving messages... ") + (widen) + (setq mp-old physical-order-list + mp-new new-message-list) + (setq old-start (vm-start-of (car mp-old))) + (while mp-new + (if (< (vm-start-of (car mp-old)) old-start) + ;; already moved this message + (setq mp-old (cdr mp-old)) + (if (eq (car mp-old) (car mp-new)) + (setq mp-old (cdr mp-old) + mp-new (cdr mp-new)) + ;; move message + (vm-physically-move-message (car mp-new) (car mp-old)) + ;; record start position. if vm-start-of + ;; mp-old ever becomes less than old-start + ;; we're running into messages that have + ;; already been moved. + (setq old-start (vm-start-of (car mp-old))) + ;; move mp-new but not mp-old because we moved + ;; mp-old down one message by inserting a + ;; message in front of it. + (setq mp-new (cdr mp-new))))) + (vm-inform 6 "Moving messages... done") + (vm-mark-folder-modified-p (current-buffer)) + (vm-clear-modification-flag-undos)) + (if (and order-did-change (not vm-folder-read-only)) + (progn + (setq vm-message-order-changed t) + ;; only viewing order changed here + ;; (vm-mark-folder-modified-p (current-buffer)) + (vm-clear-modification-flag-undos)))) + (setq vm-ml-sort-keys ml-keys) + (intern (buffer-name) vm-buffers-needing-display-update) + (cond (order-did-change + (setq vm-message-list new-message-list) + (vm-reverse-link-messages) + (if vm-message-pointer + (setq vm-message-pointer + (or (cdr (vm-reverse-link-of (car vm-message-pointer))) + vm-message-list))) + (if vm-last-message-pointer + (setq vm-last-message-pointer + (or (cdr (vm-reverse-link-of + (car vm-last-message-pointer))) + vm-message-list)))))) + (if (and vm-message-pointer + order-did-change + (or lets-get-physical vm-move-messages-physically)) + ;; clip region is most likely messed up + (vm-present-current-message) + (vm-update-summary-and-mode-line)) + + (if auto-folder-p + (vm-sort-insert-auto-folder-names)))) + +;;;###autoload +(defun vm-sort-compare-xxxxxx (msg1 msg2) + (if (and vm-summary-debug + (or (member (vm-number-of msg1) vm-summary-traced-messages) + (member (vm-number-of msg2) vm-summary-traced-messages))) + (debug "traced message")) + (let ((key-funcs vm-key-functions) + result + (m1 msg1) (m2 msg2)) + (catch 'done + (unless key-funcs + (throw 'done nil)) + (when (eq (car key-funcs) 'vm-sort-compare-thread) + (setq result (vm-sort-compare-thread m1 m2)) + (if (consp result) + (progn + (setq m1 (car result) + m2 (cdr result) + key-funcs (cdr key-funcs)) + (if (or (null m1) (null m2)) + (progn (if vm-summary-debug (debug "null message")) + (throw 'done t)))) + (throw 'done result))) + (while key-funcs + (if (eq '= (setq result (funcall (car key-funcs) m1 m2))) + (setq key-funcs (cdr key-funcs)) + (throw 'done result))) + ;; if all else fails try physical order + (if (eq m1 m2) + nil + (vm-sort-compare-physical-order m1 m2))))) + +(defun vm-sort-compare-thread (m1 m2) + (let ((root1 (vm-thread-root-sym m1)) + (root2 (vm-thread-root-sym m2)) + (list1 (vm-thread-list m1)) + (list2 (vm-thread-list m2)) + ;; (criterion (if vm-sort-threads-by-youngest-date + ;; 'youngest-date + ;; 'oldest-date)) + p1 p2 d1 d2) + (catch 'done + (cond + ;; ((not (eq (car list1) (car list2))) + ;; ;; different reference threads + ;; (let ((date1 (vm-th-thread-date-of (car list1) criterion)) + ;; (date2 (vm-th-thread-date-of (car list2) criterion))) + ;; (cond ((string-lessp date1 date2) t) + ;; ((string-equal date1 date2) + ;; (string-lessp (format "%s" root1) (format "%s" root2))) + ;; (t nil)))) + ((eq (car list1) (car list2)) + ;; within the same reference thread + (setq list1 (cdr list1) list2 (cdr list2)) + (if (not vm-sort-subthreads) + ;; no further sorting for internal messages of threads + (when (and list1 list2) + (throw 'done (cons m1 m2))) + (while (and list1 list2) + (setq p1 (car list1) p2 (car list2)) + (cond ((null (vm-th-message-of p1)) + (setq list1 (cdr list1))) + ((null (vm-th-message-of p2)) + (setq list2 (cdr list2))) + ((string-equal p1 p2) + (setq list1 (cdr list1) + list2 (cdr list2))) + (t + (throw 'done + (cons (vm-th-message-of p1) + (vm-th-message-of p2))))))) + (cond (list1 nil) ; list2=nil, m2 ancestor of m1 + (list2 t) ; list1=nil, m1 ancestor of m2 + ((not (eq (vm-thread-symbol m1) ; m1 and m2 different + (vm-thread-symbol m2))) + (cons m1 m2)) + ((eq m1 (vm-th-message-of (vm-thread-symbol m1))) + t) ; list1=list2=nil, m2 copy of m1 + (t nil))) ;; list1=list2=nil, m1 copy of m2 + ((eq root1 root2) + ;; within the same subject thread + (while (null (vm-th-message-of (car list1))) + (setq list1 (cdr list1))) + (while (null (vm-th-message-of (car list2))) + (setq list2 (cdr list2))) + (cons (vm-th-message-of (car list1)) + (vm-th-message-of (car list2)))) + ((not (eq root1 root2)) + ;; different threads + (cons (vm-th-message-of root1) + (vm-th-message-of root2))) + )))) + +(defun vm-sort-compare-author (m1 m2) + (let ((s1 (vm-su-from m1)) + (s2 (vm-su-from m2))) + (cond ((string-lessp s1 s2) t) + ((string-equal s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-author-r (m1 m2) + (let ((s1 (vm-su-from m1)) + (s2 (vm-su-from m2))) + (cond ((string-lessp s1 s2) nil) + ((string-equal s1 s2) '=) + (t t)))) + +(defun vm-sort-compare-full-name (m1 m2) + (let ((s1 (vm-su-full-name m1)) + (s2 (vm-su-full-name m2))) + (cond ((string-lessp s1 s2) t) + ((string-equal s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-full-name-r (m1 m2) + (let ((s1 (vm-su-full-name m1)) + (s2 (vm-su-full-name m2))) + (cond ((string-lessp s1 s2) nil) + ((string-equal s1 s2) '=) + (t t)))) + +(defun vm-sort-compare-date (m1 m2) + (let ((s1 (vm-so-sortable-datestring m1)) + (s2 (vm-so-sortable-datestring m2))) + (cond ((string-lessp s1 s2) t) + ((string-equal s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-date-r (m1 m2) + (let ((s1 (vm-so-sortable-datestring m1)) + (s2 (vm-so-sortable-datestring m2))) + (cond ((string-lessp s1 s2) nil) + ((string-equal s1 s2) '=) + (t t)))) + +(defun vm-sort-compare-activity (m1 m2) + (let ((d1 (vm-th-youngest-date-of (vm-thread-symbol m1))) + (d2 (vm-th-youngest-date-of (vm-thread-symbol m2)))) + (cond ((string-lessp d1 d2) t) + ((string-equal d1 d2) '=) + (t nil)))) + +(defun vm-sort-compare-activity-r (m1 m2) + (let ((d1 (vm-th-youngest-date-of (vm-thread-symbol m1))) + (d2 (vm-th-youngest-date-of (vm-thread-symbol m2)))) + (cond ((string-lessp d1 d2) nil) + ((string-equal d1 d2) '=) + (t t)))) + +;; (defun vm-sort-compare-thread-oldest-date (m1 m2) +;; (let ((d1 (vm-th-oldest-date-of (vm-thread-symbol m1))) +;; (d2 (vm-th-oldest-date-of (vm-thread-symbol m2)))) +;; (cond ((string-lessp d1 d2) t) +;; ((string-equal d1 d2) '=) +;; (t nil)))) + +;; (defun vm-sort-compare-thread-oldest-date-r (m1 m2) +;; (let ((d1 (vm-th-oldest-date-of (vm-thread-symbol m1))) +;; (d2 (vm-th-oldest-date-of (vm-thread-symbol m2)))) +;; (cond ((string-lessp d1 d2) nil) +;; ((string-equal d1 d2) '=) +;; (t t)))) + +(defun vm-sort-compare-recipients (m1 m2) + (let ((s1 (vm-su-to m1)) + (s2 (vm-su-to m2))) + (cond ((string-lessp s1 s2) t) + ((string-equal s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-recipients-r (m1 m2) + (let ((s1 (vm-su-to m1)) + (s2 (vm-su-to m2))) + (cond ((string-lessp s1 s2) nil) + ((string-equal s1 s2) '=) + (t t)))) + +(defun vm-sort-compare-subject (m1 m2) + (let ((s1 (vm-so-sortable-subject m1)) + (s2 (vm-so-sortable-subject m2))) + (cond ((string-lessp s1 s2) t) + ((string-equal s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-subject-r (m1 m2) + (let ((s1 (vm-so-sortable-subject m1)) + (s2 (vm-so-sortable-subject m2))) + (cond ((string-lessp s1 s2) nil) + ((string-equal s1 s2) '=) + (t t)))) + +(defun vm-sort-compare-line-count (m1 m2) + (let ((n1 (string-to-number (vm-su-line-count m1))) + (n2 (string-to-number (vm-su-line-count m2)))) + (cond ((< n1 n2) t) + ((= n1 n2) '=) + (t nil)))) + +(defun vm-sort-compare-line-count-r (m1 m2) + (let ((n1 (string-to-number (vm-su-line-count m1))) + (n2 (string-to-number (vm-su-line-count m2)))) + (cond ((> n1 n2) t) + ((= n1 n2) '=) + (t nil)))) + +(defun vm-sort-compare-byte-count (m1 m2) + (let ((n1 (string-to-number (vm-su-byte-count m1))) + (n2 (string-to-number (vm-su-byte-count m2)))) + (cond ((< n1 n2) t) + ((= n1 n2) '=) + (t nil)))) + +(defun vm-sort-compare-byte-count-r (m1 m2) + (let ((n1 (string-to-number (vm-su-byte-count m1))) + (n2 (string-to-number (vm-su-byte-count m2)))) + (cond ((> n1 n2) t) + ((= n1 n2) '=) + (t nil)))) + +(defun vm-sort-compare-spam-score (m1 m2) + (let ((s1 (vm-su-spam-score m1)) + (s2 (vm-su-spam-score m2))) + (cond ((< s1 s2) t) + ((= s1 s2) '=) + (t nil)))) + +(defun vm-sort-compare-spam-score-r (m1 m2) + (let ((s1 (vm-su-spam-score m1)) + (s2 (vm-su-spam-score m2))) + (cond ((< s1 s2) nil) + ((= s1 s2) '=) + (t t)))) + +;;;###autoload +(defun vm-sort-compare-physical-order (m1 m2) + (let ((r1 (vm-real-message-of m1)) + (r2 (vm-real-message-of m2)) + n1 n2) + (if (and r1 r2 + (setq n1 (marker-position (vm-start-of r1))) + (setq n2 (marker-position (vm-start-of r2)))) + (cond ((< n1 n2) t) + ((= n1 n2) '=) + (t nil)) + '=))) + +;;;###autoload +(defun vm-sort-compare-physical-order-r (m1 m2) + (let ((n1 (vm-start-of m1)) + (n2 (vm-start-of m2))) + (cond ((> n1 n2) t) + ((= n1 n2) '=) + (t nil)))) + +(add-to-list 'vm-supported-sort-keys "header") + +(defun vm-get-headers-of (m &optional headers) + (save-excursion + (save-restriction + (widen) + (let ((end (vm-text-of m))) + (set-buffer (vm-buffer-of m)) + (goto-char (vm-start-of m)) + (while (re-search-forward "^[^: \n\t]+:" end t) + (add-to-list 'headers (match-string 0))) + headers)))) + +(defun vm-sort-compare-header (m1 m2) + (if (null vm-sort-compare-header) + (setq vm-sort-compare-header + (completing-read + (if (car vm-sort-compare-header-history) + (format "Sort hy header (%s): " + (car vm-sort-compare-header-history)) + "Sort hy header: ") + (mapcar (lambda (h) (list h)) + (vm-get-headers-of m2 (vm-get-headers-of m1))) + nil nil nil + 'vm-sort-compare-header-history + (car vm-sort-compare-header-history))) + (string< (vm-get-header-contents m1 vm-sort-compare-header) + (vm-get-header-contents m2 vm-sort-compare-header)))) + +;;; vm-sort.el ends here diff --git a/lisp/vm-startup.el b/lisp/vm-startup.el new file mode 100755 index 0000000..c8e21be --- /dev/null +++ b/lisp/vm-startup.el @@ -0,0 +1,3 @@ +;; This file is only here for compatibility with older VM versions +(require 'vm) +(provide 'vm-startup) diff --git a/lisp/vm-summary-faces.el b/lisp/vm-summary-faces.el new file mode 100755 index 0000000..96f1e44 --- /dev/null +++ b/lisp/vm-summary-faces.el @@ -0,0 +1,180 @@ +;;; vm-summary-faces.el --- faces support for VM summary buffers +;; +;; This file is part of VM +;; +;; Copyright (C) 2001 Robert Fenk +;; Copyright (C) 2010 Uday S Reddy +;; +;; Author: Robert Fenk +;; Status: Tested with XEmacs 21.4.15 & VM 7.18 +;; Keywords: VM +;; X-URL: http://www.robf.de/Hacking/elisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Commentary: +;; +;; to use this add the following line to your ~/.vm file +;; +;; (add-hook 'vm-summary-mode-hook 'vm-summary-faces-mode) +;; +;;; Code + +(provide 'vm-summary-faces) + +(eval-when-compile + (require 'vm-misc)) + +(eval-and-compile + (require 'vm-summary) + (require 'vm-virtual)) + +;; (eval-and-compile +;; (if vm-xemacs-p (require 'overlay))) + +(declare-function vm-extent-property "vm-misc.el" (overlay prop) t) +(declare-function vm-set-extent-property "vm-misc.el" (overlay prop value) t) + + +(eval-and-compile + (if (fboundp 'mapcar-extents) + (defun vm-summary-faces-list-extents () (mapcar-extents 'identity)) + (defun vm-summary-faces-list-extents () + (let ((o (overlay-lists))) (nconc (car o) (cdr o)))))) + +(defvar vm-summary-faces-hide nil + "Last face hidden by `vm-summary-faces-hide'.") + +;;;###autoload +(defun vm-summary-faces-hide (&optional prop) + "Toggle visibility of a particular vm-summary-face. By +default, the deleted face is toggled (with the effect that all +deleted messages will be hidden or unhidden). + +With a prefix argument, the property name identifying the face is +queried interactively. The property is a keyword such as edited, +collapsed or outgoing which has an associated face such as +vm-summary-edited. See `vm-summary-faces-alist' for a list +of available face names." + (interactive "P") + (if (and (listp prop) (numberp (car prop))) + (setq prop (completing-read "Face name: " + (mapcar (lambda (f) + (list (format "%s" (cadr f)))) + vm-summary-faces-alist) + nil t "vm-summary-deleted"))) + (setq prop (or prop vm-summary-faces-hide "vm-summary-deleted")) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-summarize) + (set-buffer vm-summary-buffer) + (let ((extents (vm-summary-faces-list-extents)) + (hidden-face (intern prop)) + x faces) + (while extents + (setq x (car extents)) + (setq faces (vm-extent-property x 'face)) + (unless (listp faces) + (setq faces (list faces))) + (when (memq hidden-face faces) + (vm-set-extent-property + x 'invisible (not (vm-extent-property x 'invisible)))) + (setq extents (cdr extents))))) + +;;;###autoload +(defun vm-summary-faces-add (msg) + "Add a face to a summary entry according to `vm-summary-faces-alist'." + (let ((faces vm-summary-faces-alist) + (x (or (vm-su-summary-mouse-track-overlay-of msg) + (vm-extent-at (vm-su-start-of msg)) + (vm-extent-at (vm-su-end-of msg))))) + (while faces + (when (apply 'vm-vs-or msg (list (caar faces))) + (cond ((vm-collapsed-root-p msg) + (vm-set-extent-property + x 'face (list (cadar faces) 'vm-summary-collapsed))) + ((vm-expanded-root-p msg) + (vm-set-extent-property + x 'face (list (cadar faces) 'vm-summary-expanded))) + (t + (vm-set-extent-property + x 'face (list (cadar faces))))) + (setq faces nil)) + (setq faces (cdr faces))))) + +(defun vm-summary-faces-destroy () + "Removes the face from all summary entries." + (let ((extents (vm-summary-faces-list-extents)) + x) + (while extents + (setq x (car extents)) + (vm-set-extent-property x 'face nil) + (setq extents (cdr extents))))) + +;;;###autoload +(defun vm-summary-faces-mode (&optional arg) + "Toggle `vm-summary-faces-mode'. Optional argument ARG should be 0 +or 1, indicating whether the summary faces should be off or on. + +When it is on, the VM summary buffers are decorated with faces, i.e., +fonts and colors, for easy recogniton of the message status." + (interactive "P") + (if (null arg) + (setq vm-summary-enable-faces (not vm-summary-enable-faces)) + (if (> (prefix-numeric-value arg) 0) + (setq vm-summary-enable-faces t) + (setq vm-summary-enable-faces nil))) + + (when (vm-interactive-p) + (vm-inform 1 "VM summary faces mode is %s" + (if vm-summary-enable-faces "on" "off"))) + + (if (memq major-mode '(vm-mode vm-virtual-mode vm-summary-mode + vm-presentation-mode)) + (save-excursion + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-summarize) + (set-buffer vm-summary-buffer) + (if vm-summary-enable-faces + (progn + (mapc 'vm-summary-faces-add vm-message-list) + (if vm-summary-overlay + (vm-set-extent-property vm-summary-overlay 'face + 'vm-summary-selected))) + (vm-summary-faces-destroy) + (if vm-summary-overlay + (vm-set-extent-property vm-summary-overlay 'face + vm-summary-highlight-face)))))) + +;; No need for advice because the code has been integrated into +;; VM. USR, 2010-08-01 + +;; (defadvice vm-mouse-set-mouse-track-highlight +;; (after vm-summary-faces activate) +;; (when (and vm-summary-enable-faces +;; (eq major-mode 'vm-summary-mode) +;; (boundp 'm) +;; m) +;; ;; FIXME there is a warning about a free variable here, sorry! +;; (vm-summary-faces-add m))) + +(defun vm-summary-faces-fix-pointer () + (if vm-summary-overlay + (vm-set-extent-property vm-summary-overlay 'face + (if vm-summary-enable-faces + 'vm-summary-selected + vm-summary-highlight-face)))) + +(add-hook 'vm-summary-pointer-update-hook 'vm-summary-faces-fix-pointer) + diff --git a/lisp/vm-summary.el b/lisp/vm-summary.el new file mode 100755 index 0000000..3ab6e7e --- /dev/null +++ b/lisp/vm-summary.el @@ -0,0 +1,2233 @@ +;;; vm-summary.el --- Summary gathering and formatting routines for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1995, 2000 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; Copyright (C) 2009-2010 Uday S Reddy +;; Copyright (C) 2010 Arik Mitschang +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-summary) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-crypto) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-menu) + (require 'vm-toolbar) + (require 'vm-mouse) + (require 'vm-motion) + (require 'vm-mime) + (require 'vm-thread) + (require 'vm-pop) + (require 'vm-summary-faces) +) + +(declare-function set-specifier "vm-xemacs" + (specifier value &optional locale tag-set how-to-add)) +(declare-function rfc822-addresses "ext:rfc822" (header-text)) + +(declare-function vm-visit-folder "vm.el" (folder &optional read-only)) +(declare-function vm-set-folded-flag "vm-undo.el" (m flag &optional norecord)) + +(defvar scrollbar-height) ; defined for XEmacs + + +(defun vm-summary-trace-message () + (interactive) + (add-to-list 'vm-summary-traced-messages + (vm-number-of (vm-current-message))) + (message "%s" vm-summary-traced-messages)) + +(defsubst vm-summary-debug (m) + (if (and vm-debug + (member (vm-number-of m) vm-summary-traced-messages)) + (debug 'vm-summary m))) + +(defsubst vm-summary-message-at-point () + "Returns the message of the current summary line." + (save-excursion + (forward-line 0) + ;; The point often ends up preceding the invisible stuff. Skip it. + (while (get-text-property (point) 'invisible) + (forward-char)) + (get-text-property (+ (point) 3) 'vm-message))) + +(defsubst vm-summary-padded-thread-count (m) + "Returns a formatted thread count of the message M, usable in +summary display." + (let ((count (vm-thread-count m))) + (if (> count 1) + (format "+%-2s" (1- (vm-thread-count m))) + " "))) + +(defsubst vm-summary-message-number-thread-descendant (m) + "Returns the message number of M, padded with spaces to display as +an interior message of a thread." + (concat " " (vm-padded-number-of m) " ")) + +(defsubst vm-expanded-root-p (m) + "Returns t if M is the root of a thread that is currently shown +expanded (using the folded attribute of the message)." + (and (vm-thread-root-p m) + (null (vm-folded-flag m)))) + +(defsubst vm-collapsed-root-p (m) + "Returns t if M is the root fo a thread that is currently shown + collapsed (usint the folded attribute of the message)." + (and (vm-thread-root-p m) + (vm-folded-flag m))) + +(defsubst vm-summary-mark-root-collapsed (m) + "Mark a thread root message M as collapsed." + (vm-set-folded-flag m t)) + +(defsubst vm-summary-mark-root-expanded (m) + "Mark a thread root message M as expanded." + (vm-set-folded-flag m nil)) + +(defsubst vm-visible-message (m) + (apply 'vm-vs-or m vm-summary-visible)) + +;; This variable is only in Emacs 24 +(defvar bidi-paragraph-direction) + +(defun vm-summary-mode-internal () + (setq mode-name "VM Summary" + major-mode 'vm-summary-mode + mode-line-format vm-mode-line-format + ;; must come after the setting of major-mode + mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu)) + buffer-read-only t + vm-summary-pointer nil + vm-summary-=> (if (stringp vm-summary-arrow) vm-summary-arrow "") + vm-summary-no-=> (make-string (length vm-summary-=>) ? ) + truncate-lines t + ;; Needed for Emacs 24 bidi display + bidi-paragraph-direction 'left-to-right) + ;; horizontal scrollbar off by default + ;; user can turn it on in summary hook if desired. + (when (and vm-xemacs-p (featurep 'scrollbar)) + (set-specifier scrollbar-height (cons (current-buffer) 0))) + (use-local-map vm-summary-mode-map) + (when (vm-menu-support-possible-p) + (vm-menu-install-menus)) +;; using the 'mouse-face property gives faster highlighting than this. +;; (and vm-mouse-track-summary +;; (vm-mouse-support-possible-p) +;; (vm-mouse-xemacs-mouse-p) +;; (add-hook 'mode-motion-hook 'mode-motion-highlight-line)) + (when (and vm-mutable-frame-configuration + (or vm-frame-per-folder vm-frame-per-summary)) + (vm-set-hooks-for-frame-deletion)) + (run-hooks 'vm-summary-mode-hook) + ;; Lucid Emacs apparently used this name + (run-hooks 'vm-summary-mode-hooks)) + +(fset 'vm-summary-mode 'vm-mode) +(put 'vm-summary-mode 'mode-class 'special) + +;;;###autoload +(defun vm-summarize (&optional display raise) + "Summarize the contents of the folder in a summary buffer. +The format is as described by the variable `vm-summary-format'. Generally +one line per message is most pleasing to the eye but this is not +mandatory." + (interactive "p\np") + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (null vm-summary-buffer) + (let ((b (current-buffer)) + (read-only vm-folder-read-only) + (summary-buffer-name (format "%s Summary" (buffer-name)))) + (setq vm-summary-buffer + (or (get-buffer summary-buffer-name) + (vm-generate-new-multibyte-buffer summary-buffer-name))) + (save-excursion + (set-buffer vm-summary-buffer) + (abbrev-mode 0) + (auto-fill-mode 0) + (vm-fsfemacs-nonmule-display-8bit-chars) + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (setq vm-mail-buffer b + vm-folder-read-only read-only) + (vm-summary-mode-internal)) + (vm-set-summary-redo-start-point t))) + (if display + (save-excursion + (vm-goto-new-summary-frame-maybe) + (vm-display vm-summary-buffer t + '(vm-summarize + vm-summarize-other-frame) + (list this-command) (not raise)) + ;; need to do this after any frame creation because the + ;; toolbar sets frame-specific height and width specifiers. + (set-buffer vm-summary-buffer) + (vm-toolbar-install-or-uninstall-toolbar)) + (vm-display nil nil '(vm-summarize vm-summarize-other-frame) + (list this-command))) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-summarize-other-frame (&optional display) + "Like vm-summarize, but run in a newly created frame." + (interactive "p") + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'summary)) + (vm-summarize display) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +(defun vm-do-summary (&optional start-point) + "Generate summary lines for all the messages in the optional +argument START-POINT (a list of messages) or, if it is nil, all +the messages in the current folder." + (let ((m-list (or start-point vm-message-list)) + (n 0) + (modulus 100) + (do-mouse-track (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces))) + ;; (setq mp m-list) + (save-excursion + (set-buffer vm-summary-buffer) + (setq line-move-ignore-invisible vm-summary-show-threads) + (let ((buffer-read-only nil) + (modified (buffer-modified-p)) + (debug nil) ; vm-summary-debug, if necessary + track) + (unwind-protect + (progn + (if (null start-point) + (setq vm-summary-pointer nil)) + (if start-point + (goto-char (or (vm-su-start-of (car m-list)) (point-max))) + (goto-char (point-min))) + (vm-disable-extents (point) (point-max)) + (delete-region (point) (point-max)) + + ;; avoid doing long runs down the marker chain while + ;; building the summary. use integers to store positions + ;; and then convert them to markers after all the + ;; insertions are done. Likewise, detach overlays and + ;; re-establish them afterwards. + (vm-inform 7 "Generating summary... %d" n) + (overlay-recenter (point)) + (let ((mp m-list) + m start end track) + (while mp + (setq m (car mp)) + (setq start (vm-su-start-of m) + end (vm-su-end-of m) + track (vm-su-summary-mouse-track-overlay-of m)) + (when start (set-marker start nil)) + (vm-set-su-start-of m nil) + (when end (set-marker end nil)) + (vm-set-su-end-of m nil) + (when track (vm-detach-extent track)) + (setq mp (cdr mp)))) + + (overlay-recenter (point-max)) + + (let ((mp m-list) + m root) + (while mp + (setq m (car mp)) + (vm-summary-debug m) + (vm-set-su-start-of m (point)) + (insert vm-summary-no-=>) + (vm-tokenized-summary-insert m (vm-su-summary m)) + (vm-set-su-end-of m (point)) + (let ((s (vm-su-start-of m)) (e (vm-su-end-of m))) + (when s + (put-text-property s e 'vm-message m) + (when (and vm-summary-enable-thread-folding + vm-summary-show-threads) + (if (= (vm-thread-indentation-of m) 0) + (when (> (vm-thread-count m) 1) + (if vm-summary-threads-collapsed + (vm-summary-mark-root-collapsed m) + (vm-summary-mark-root-expanded m))) + (setq root (vm-thread-root m)) + (when (and root (vm-collapsed-root-p root)) + (unless (vm-visible-message m) + (put-text-property s e 'invisible t)) + ;; why mess with the root here? USR, 2010-07-20 + ;; (vm-summary-mark-root-collapsed root) + ))))) + (setq mp (cdr mp) n (1+ n)) + (when (zerop (% n modulus)) + (vm-inform 7 "Generating summary... %d" n) + (if debug (debug "vm-debug-summary: Generating summary")) + (setq debug nil))))) + + ;; unwind-protection + ;; convert the summary markers back from ints + (let ((mp m-list) + m start end) + (while mp + (setq m (car mp)) + (setq start (or (vm-su-start-of m) (point-max)) + end (or (vm-su-end-of m) (point-max)) + track (vm-su-summary-mouse-track-overlay-of m)) + (when do-mouse-track + (vm-set-su-summary-mouse-track-overlay-of + m (vm-mouse-set-mouse-track-highlight start end track))) + (vm-set-su-start-of m (vm-marker start)) + (vm-set-su-end-of m (vm-marker end)) + (when vm-summary-enable-faces (vm-summary-faces-add m)) + (setq mp (cdr mp)))) + (set-buffer-modified-p modified)) + + (run-hooks 'vm-summary-redo-hook))) + + (if (>= n modulus) + (unless vm-summary-debug + (vm-inform 7 "Generating summary... done"))))) + +(defun vm-expand-thread (&optional root) + "Expand the thread associated with the message at point. This +will make visible all invisible elements of the thread tree and +place a '-' character at the pointer position indicating that the +thread can be collapsed. + +In a Lisp program, you should call it with an argument ROOT, which +is the root of the thread you want expanded." + (interactive) + (unless vm-summary-enable-thread-folding + (error "Thread folding not enabled")) + (when (vm-interactive-p) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (unless vm-summary-show-threads + (error "Summary is not sorted by threads")) + (vm-follow-summary-cursor) + (set-buffer vm-summary-buffer)) + (let ((buffer-read-only nil)) + (unless root + (setq root (vm-thread-root (vm-summary-message-at-point)))) + (when (> (vm-thread-count root) 1) + (vm-summary-mark-root-expanded root) + (vm-mark-for-summary-update root) + (mapc + (lambda (m) + (put-text-property + (vm-su-start-of m) (vm-su-end-of m) 'invisible nil)) + (vm-thread-subtree (vm-thread-symbol root))) + (when (vm-interactive-p) + (vm-update-summary-and-mode-line))))) + +(defun vm-collapse-thread (&optional nomove root) + "Collapse the thread associated with the message at point. This +will make invisible all read and non-new elements of the thread +tree and will place a '+' character at the pointer position +indicating the thread can be expanded. Optional argument nomove +directs vm-collapse-thread to not take the default action of +moving the pointer to the thread root after collapsing. + +In a Lisp program, you should call it with an additional argument +ROOT, which is the root of the thread you want collapsed." + (interactive "P") + (unless vm-summary-enable-thread-folding + (error "Thread folding not enabled")) + (when (vm-interactive-p) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (unless vm-summary-show-threads + (error "Summary is not sorted by threads")) + (vm-follow-summary-cursor) + (set-buffer vm-summary-buffer)) + (let ((buffer-read-only nil) + (msg nil)) + (unless root + (setq msg (vm-summary-message-at-point)) + (setq root (vm-thread-root msg))) + (when (> (vm-thread-count root) 1) + (vm-summary-mark-root-collapsed root) + (vm-mark-for-summary-update root) + (mapc + (lambda (m) + (unless (or (eq m root) (vm-visible-message m)) + (put-text-property + (vm-su-start-of m) (vm-su-end-of m) 'invisible t))) + (vm-thread-subtree (vm-thread-symbol root))) + ;; move to the parent thread only when not + ;; instructed not to, AND when the currently + ;; selected message will become invisible + (when (vm-interactive-p) + (unless nomove + (when (get-text-property (+ (vm-su-start-of msg) 3) 'invisible) + (goto-char (vm-su-start-of root)))) + (vm-update-summary-and-mode-line))))) + +(defun vm-expand-all-threads () + "Expand all threads in the folder, which might have been collapsed + (folded) earlier." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (unless vm-summary-show-threads + (error "Summary is not sorted by threads")) + (let ((ml vm-message-list)) + (with-current-buffer vm-summary-buffer + (save-excursion + (mapc (lambda (m) + (when (and (eq m (vm-thread-root m)) + (> (vm-thread-count m) 1)) + (vm-expand-thread m))) + ml)))) + (setq vm-summary-threads-collapsed nil) + (when (vm-interactive-p) + (vm-update-summary-and-mode-line))) + +(defun vm-collapse-all-threads () + "Collapse (fold) all threads in the folder so that only the roots of +the threads are shown in the Summary window." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (unless vm-summary-show-threads + (error "Summary is not sorted by threads")) + (let ((ml vm-message-list) + msg root) + (with-current-buffer vm-summary-buffer + (setq msg (vm-summary-message-at-point)) + (setq root (vm-thread-root msg)) + (save-excursion + (mapc (lambda (m) + (when (and (eq m (vm-thread-root m)) + (> (vm-thread-count m) 1)) + (vm-collapse-thread t m))) + ml)) + (when (vm-interactive-p) + (when (get-text-property (+ (vm-su-start-of msg) 3) 'invisible) + (goto-char (vm-su-start-of root)))))) + (setq vm-summary-threads-collapsed t) + (when (vm-interactive-p) + (vm-update-summary-and-mode-line))) + +(defun vm-toggle-thread () + "Toggle collapse/expand thread associated with message at point. +see `vm-expand-thread' and `vm-collapse-thread' for a description +of action." + (interactive) + (when (and vm-summary-enable-thread-folding vm-summary-show-threads) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if (vm-interactive-p) + (vm-follow-summary-cursor)) + (when vm-summary-buffer + (set-buffer vm-summary-buffer) + (let ((buffer-read-only nil) + root next) + (setq root (vm-thread-root (vm-summary-message-at-point))) + (if (vm-expanded-root-p root) + (call-interactively 'vm-collapse-thread) + (call-interactively 'vm-expand-thread)) + )))) + +(defun vm-do-needed-summary-rebuild () + "Rebuild the summary lines of all the messages starting at +`vm-summary-redo-start-point'. Also, reset the summary pointer +to the current message. Do the latter anyway if +`vm-need-summary-pointer-update' is non-NIL. All this, only if +the Summary buffer exists. " + (if (and vm-summary-redo-start-point vm-summary-buffer) + (progn + (vm-copy-local-variables vm-summary-buffer 'vm-summary-show-threads) + (vm-do-summary (and (consp vm-summary-redo-start-point) + vm-summary-redo-start-point)) + (setq vm-summary-redo-start-point nil) + (when vm-message-pointer + (vm-set-summary-pointer (car vm-message-pointer))) + (setq vm-need-summary-pointer-update nil)) + (when (and vm-need-summary-pointer-update + vm-summary-buffer + vm-message-pointer) + (vm-set-summary-pointer (car vm-message-pointer)) + (setq vm-need-summary-pointer-update nil)))) + +(defun vm-update-message-summary (m) + "Replace the summary line of the message M in the summary +buffer by a regenerated summary line." + (vm-summary-debug m) + (if (and (buffer-name (vm-buffer-of m)) ; ignore deleted folders and + (markerp (vm-su-start-of m)) ; markers into deleted buffers + (marker-buffer (vm-su-start-of m))) + (let ((modified (buffer-modified-p)) ; Folder or Presentation + (do-mouse-track + (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces)) + summary) + (save-excursion + (setq summary (vm-su-summary m)) + (set-buffer (marker-buffer (vm-su-start-of m))) + (let ((buffer-read-only nil) + s e i + (selected nil) + (indicator nil) + (modified (buffer-modified-p))) ; Summary buffer + (unwind-protect + (save-excursion + (goto-char (vm-su-start-of m)) + (setq selected (looking-at "[+-]>")) + (if (and vm-summary-show-threads + (eq m (vm-thread-root m)) + (> (vm-thread-count m) 1)) + (setq indicator (if (vm-collapsed-root-p m) "+" "-")) + (setq indicator nil)) + ;; We do a little dance to update the text in + ;; order to make the markers in the text do + ;; what we want. + ;; + ;; 1. We need to avoid having the su-start-of + ;; and su-end-of markers clumping together at + ;; the start position. + ;; + ;; 2. We want the window point marker (w->pointm + ;; in the Emacs display code) to move to the + ;; start of the summary entry if it is + ;; anywhere within the su-start-of to + ;; su-end-of region. + ;; + ;; We achieve (2) by deleting before inserting. + ;; Reversing the order of insertion/deletion + ;; pushes the point marker into the next + ;; summary entry. We achieve (1) by inserting a + ;; placeholder character at the end of the + ;; summary entry before deleting the region. + (goto-char (vm-su-end-of m)) + (insert-before-markers "z") + (goto-char (vm-su-start-of m)) + (setq s (vm-su-start-of m)) + (setq e (vm-su-end-of m)) + (setq i (get-text-property (+ s 2) 'invisible)) + (delete-region (point) (1- (vm-su-end-of m))) + (if (not selected) + (insert (concat (or indicator " ") " ")) + (if indicator + (insert (concat indicator ">")) + (insert vm-summary-=>))) + (vm-tokenized-summary-insert m (vm-su-summary m)) + (delete-char 1) ; delete "z" + (run-hooks 'vm-summary-update-hook) + (when do-mouse-track + (vm-mouse-set-mouse-track-highlight + (vm-su-start-of m) + (vm-su-end-of m) + (vm-su-summary-mouse-track-overlay-of m))) + (if vm-summary-enable-faces + (vm-summary-faces-add m) + (if (and selected + (facep vm-summary-highlight-face)) + (vm-summary-highlight-region + (vm-su-start-of m) (point) + vm-summary-highlight-face)))) + (when s + (put-text-property s e 'vm-message m) + (put-text-property s e 'invisible i)) + (vm-reset-buffer-modified-p ; Summary buffer + modified (current-buffer)) + )))))) + +(defun vm-set-summary-pointer (m) + "Set the summary-pointer in the summary window to the message M. +Also move the cursor (point and window-point)." + (if vm-summary-buffer + (let ((w (vm-get-visible-buffer-window vm-summary-buffer)) + (do-mouse-track + (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces)) + (old-window nil)) + (with-current-buffer vm-summary-buffer + (when w + (setq old-window (selected-window)) + (select-window w)) + (unwind-protect + (let ((buffer-read-only nil)) + (when (and vm-summary-pointer + (vm-su-start-of vm-summary-pointer)) + (goto-char (vm-su-start-of vm-summary-pointer)) + (if (not (get-text-property (+ (point) 3) 'invisible)) + (let ((msg (vm-summary-message-at-point))) + (if (and vm-summary-show-threads + vm-summary-enable-thread-folding + (eq msg (vm-thread-root msg)) + (> (vm-thread-count msg) 1)) + (if (vm-collapsed-root-p msg) + (progn (insert "+ ") + (delete-char (length vm-summary-=>))) + (progn (insert "- ") + (delete-char (length vm-summary-=>)))) + (insert vm-summary-no-=>) + (delete-char (length vm-summary-=>)))) + (delete-char (length vm-summary-=>)) + (insert vm-summary-no-=>) + ;; re-invisible it so we dont have problems + (put-text-property + (- (point) (length vm-summary-no-=>)) (point) + 'invisible t)) + (when do-mouse-track + (vm-mouse-set-mouse-track-highlight + (vm-su-start-of vm-summary-pointer) + (vm-su-end-of vm-summary-pointer) + (vm-su-summary-mouse-track-overlay-of + vm-summary-pointer))) + (when vm-summary-enable-faces + (vm-summary-faces-add vm-summary-pointer))) + + (setq vm-summary-pointer m) + (goto-char (vm-su-start-of m)) + (let ((modified (buffer-modified-p))) + (unwind-protect + (progn + ;; + ;; when we move the cursor, the thread-state + ;; indicator should have already changed, + ;; check now to see if we should set the + ;; cursor with indicator + ;; + ;; if, somehow, the cursor became on an + ;; invisible message in a collapsed thread, + ;; assume that there is a good reason for + ;; this and expand the thread (e.g in + ;; visiting a folder with bookmark on + ;; sub-thread + ;; + (if vm-summary-show-threads + (if (vm-collapsed-root-p m) + (insert "+>") + (if (get-text-property + (+ (vm-su-start-of m) 3) 'invisible) + (progn (insert vm-summary-=>) + (vm-expand-thread + (vm-thread-root m))) + (insert vm-summary-=>))) + (insert vm-summary-=>)) + (delete-char (length vm-summary-=>)) + + (when do-mouse-track + (vm-mouse-set-mouse-track-highlight + (vm-su-start-of m) (vm-su-end-of m) + (vm-su-summary-mouse-track-overlay-of m))) + (when vm-summary-enable-faces + (vm-summary-faces-add m))) + (set-buffer-modified-p modified))) + (forward-char (- (length vm-summary-=>))) + (when vm-summary-highlight-face + (vm-summary-highlight-region + (vm-su-start-of m) (vm-su-end-of m) + vm-summary-highlight-face)) + (when (and w vm-auto-center-summary) + (vm-auto-center-summary)) + (run-hooks 'vm-summary-pointer-update-hook)) + ;; unwind-protections + (when old-window (select-window old-window))))))) + +(defun vm-summary-highlight-region (start end face) + (vm-summary-xxxx-highlight-region start end face 'vm-summary-overlay)) + +(defun vm-folders-summary-highlight-region (start end face) + (vm-summary-xxxx-highlight-region start end face + 'vm-folders-summary-overlay)) + +(defun vm-summary-xxxx-highlight-region (start end face var) + (let ((ooo (symbol-value var))) + (cond (vm-fsfemacs-p + (if (and ooo (overlay-buffer ooo)) + (move-overlay ooo start end) + (setq ooo (make-overlay start end)) + (set var ooo) + (overlay-put ooo 'evaporate nil) + (overlay-put ooo 'face face))) + (vm-xemacs-p + (if (and ooo (vm-extent-end-position ooo)) + (vm-set-extent-endpoints ooo start end) + (setq ooo (vm-make-extent start end)) + (set var ooo) + ;; the reason this isn't needed under FSF Emacs is + ;; that insert-before-markers also inserts before + ;; overlays! so a summary update of an entry just + ;; before this overlay in the summary buffer won't + ;; leak into the overlay, but it _will_ leak into an + ;; XEmacs extent. + (vm-set-extent-property ooo 'start-open t) + (vm-set-extent-property ooo 'detachable nil) + (vm-set-extent-property ooo 'face face)))))) + +(defun vm-auto-center-summary () + (if vm-auto-center-summary + (if (or (eq vm-auto-center-summary t) (not (one-window-p t))) + (recenter '(4))))) + +(defun vm-summary-sprintf (format message &optional tokenize) + "Generates a summary in FORMAT for MESSAGE and return the +result. The optional argument TOKENIZE says whether the summary +should be in tokenized form. If so, the result is a list of +tokens, including strings in mime-decoded form with text-properties. +Otherwise, it is a string in mime-decoded form with text-properties. + USR, 2010-05-13" + ;; compile the format into an eval'able s-expression + ;; if it hasn't been compiled already. + (let* ((alist-var (if tokenize + 'vm-summary-tokenized-compiled-format-alist + 'vm-summary-untokenized-compiled-format-alist)) + (match (assoc format (symbol-value alist-var)))) + (unless match + (vm-summary-compile-format format tokenize) + (setq match (assoc format (symbol-value alist-var)))) + ;; The local variable name `vm-su-message' is mandatory here for + ;; the format s-expression to work. + (let ((vm-su-message message)) + (if (or tokenize (null vm-display-using-mime)) + (eval (cdr match)) + (vm-decode-mime-encoded-words-in-string (eval (cdr match))))))) + +(defun vm-summary-compile-format (format tokenize) + "Compile FORMAT into an eval'able expression that generates the +summary. If TOKENIZE is t, the the summary generated will be a +list of tokens. Otherwise it is a string in mime-decoded form +with text-propertiies. USR, 2010-05-13." + + (let ((return-value (nth 1 (vm-summary-compile-format-1 format tokenize)))) + (if tokenize + (setq vm-summary-tokenized-compiled-format-alist + (cons (cons format return-value) + vm-summary-tokenized-compiled-format-alist)) + (setq vm-summary-untokenized-compiled-format-alist + (cons (cons format return-value) + vm-summary-untokenized-compiled-format-alist))))) + +;; Inserts the summary line for MESSAGE created from TOKENS, which is +;; a list of tokens. A token is one of +;; - string, which is inserted literally, +;; - 'number, meaning message number, +;; - 'mark, meaning the message mark indicator, +;; - 'thread-indent, meaning the indentation space for the message +;; - 'group-begin and 'group-end + +(defun vm-tokenized-summary-insert (message tokens) + "Insert a summary line for MESSAGE in the current buffer, using the +tokenized summary TOKENS." + (if (stringp tokens) + (insert tokens) + (let (token group-list) + (while tokens + (setq token (car tokens)) + (cond ((stringp token) + (if vm-display-using-mime + (let ((vm-mime-qp-decoder-program nil) ; speed up decoding + (vm-mime-base64-decoder-program nil)) + (insert (vm-decode-mime-encoded-words-in-string token))) + (insert token))) + ((eq token 'group-begin) + (setq group-list (cons (list (point) (nth 1 tokens) + (nth 2 tokens)) + group-list) + tokens (cdr (cdr tokens)))) + ((eq token 'group-end) + (let* ((space (string-to-char " ")) + (blob (car group-list)) + (start (car blob)) + (field-width (nth 1 blob)) + (precision (nth 2 blob)) + (end (vm-marker (point)))) + (if (integerp field-width) + (if (< (- end start) (vm-abs field-width)) + (if (< field-width 0) + (insert-char space (vm-abs (+ field-width + (- end start)))) + (save-excursion + (goto-char start) + (insert-char space (- field-width + (- end start))))))) + (if (integerp precision) + (if (> (- end start) (vm-abs precision)) + (if (> precision 0) + (delete-char (- precision (- end start))) + (save-excursion + (goto-char start) + (delete-char (vm-abs (+ precision + (- end start)))))))) + (setq group-list (cdr group-list)))) + ((eq token 'number) + (if (and vm-summary-enable-thread-folding + vm-summary-show-threads + vm-summary-show-thread-count) + (if (= (vm-thread-indentation message) 0) + (insert + (concat (vm-padded-number-of message) + (vm-summary-padded-thread-count message))) + (insert + (vm-summary-message-number-thread-descendant message))) + (insert (vm-padded-number-of message)))) + ((eq token 'mark) + (insert (vm-su-mark message))) + ((eq token 'thread-indent) + (if (and vm-summary-show-threads + (natnump vm-summary-thread-indent-level)) + (insert-char + ?\ + (* vm-summary-thread-indent-level + (min vm-summary-maximum-thread-indentation + (vm-thread-indentation message))))))) + (setq tokens (cdr tokens)))))) + +(defun vm-reencode-mime-encoded-words-in-tokenized-summary (summary) + "Given a tokenized SUMMARY, with tokens including mime-decoded +strings, returns another version where the strings are reencoded in +mime. It is used for writing summary lines to disk. USR, 2010-05-13." + (mapcar + (function (lambda (token) + (if (stringp token) + (vm-reencode-mime-encoded-words-in-string token) + token))) + summary)) + +(defun vm-summary-compile-format-1 (format &optional tokenize start-index) + (or start-index (setq start-index 0)) + (let ((case-fold-search nil) + (finished-parsing-format nil) + (list nil) + (sexp nil) + (sexp-fmt nil) + (saw-close-group nil) + (last-match-end start-index) + new-match-end token conv-spec splice) + (store-match-data nil) + (while (and (not saw-close-group) (not finished-parsing-format)) + (setq token nil + splice nil) + (while + (and (not saw-close-group) (not token) + (string-match + "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()pPaAbcSdfFhHiIlLmMnstTwyz*%]\\|U[A-Za-z]\\)" + format last-match-end)) + (setq conv-spec (aref format (match-beginning 5))) + (setq new-match-end (match-end 0)) + (if (and (memq conv-spec '(?\( ?\) ?p ?P ?a ?A ?b ?c ?S ?d ?f ?F ?h ?H ?i ?I + ?l ?L ?M ?m ?n ?s ?t ?T ?U ?w ?y ?z ?* )) + ;; for the non-tokenized path, we don't want + ;; the close group spcifier processed here, we + ;; want to just bail out and return, which is + ;; accomplished by setting a flag in the other + ;; branch of this 'if'. + (or tokenize (not (= conv-spec ?\))))) + (progn + (cond ((= conv-spec ?\() + (if (not tokenize) + (save-match-data + (let ((retval (vm-summary-compile-format-1 + format tokenize (match-end 5)))) + (setq sexp (cons (nth 1 retval) sexp) + new-match-end (car retval)))) + (setq token `('group-begin + ,(if (match-beginning 2) + (string-to-number + (concat (match-string 1 format) + (match-string 2 format)))) + ,(string-to-number + (match-string 4 format))) + splice t))) + ((= conv-spec ?\)) + (setq token ''group-end)) + ((= conv-spec ?p) + (setq sexp (cons (list 'vm-su-postponed-indicator + 'vm-su-message) sexp))) + ((= conv-spec ?P) + (setq sexp (cons (list 'vm-su-attachment-indicator + 'vm-su-message) sexp))) + ((= conv-spec ?a) + (setq sexp (cons (list 'vm-su-attribute-indicators + 'vm-su-message) sexp))) + ((= conv-spec ?A) + (setq sexp (cons (list 'vm-su-attribute-indicators-long + 'vm-su-message) sexp))) + ((= conv-spec ?b) + (setq sexp (cons (list 'vm-su-attribute-indicators-short + 'vm-su-message) sexp))) + ((= conv-spec ?c) + (setq sexp (cons (list 'vm-su-byte-count + 'vm-su-message) sexp))) + ((= conv-spec ?S) + (setq sexp (cons (list 'vm-su-size + 'vm-su-message) sexp))) + ((= conv-spec ?d) + (setq sexp (cons (list 'vm-su-monthday + 'vm-su-message) sexp))) + ((= conv-spec ?f) + (setq sexp (cons (list 'vm-su-interesting-from + 'vm-su-message) sexp))) + ((= conv-spec ?F) + (setq sexp (cons (list 'vm-su-interesting-full-name + 'vm-su-message) sexp))) + ((= conv-spec ?h) + (setq sexp (cons (list 'vm-su-hour + 'vm-su-message) sexp))) + ((= conv-spec ?H) + (setq sexp (cons (list 'vm-su-hour-short + 'vm-su-message) sexp))) + ((= conv-spec ?i) + (setq sexp (cons (list 'vm-su-message-id + 'vm-su-message) sexp))) + ((= conv-spec ?I) + (if tokenize + (setq token ''thread-indent) + (setq sexp (cons (list 'vm-su-thread-indent + 'vm-su-message) sexp)))) + ((= conv-spec ?l) + (setq sexp (cons (list 'vm-su-line-count + 'vm-su-message) sexp))) + ((= conv-spec ?L) + (setq sexp (cons (list 'vm-su-labels + 'vm-su-message) sexp))) + ((= conv-spec ?m) + (setq sexp (cons (list 'vm-su-month + 'vm-su-message) sexp))) + ((= conv-spec ?M) + (setq sexp (cons (list 'vm-su-month-number + 'vm-su-message) sexp))) + ((= conv-spec ?n) + (if tokenize + (setq token ''number) + (setq sexp (cons (list 'vm-padded-number-of + 'vm-su-message) sexp)))) + ((= conv-spec ?s) + (setq sexp (cons (list 'vm-su-subject + 'vm-su-message) sexp))) + ((= conv-spec ?T) + (setq sexp (cons (list 'vm-su-to-names + 'vm-su-message) sexp))) + ((= conv-spec ?t) + (setq sexp (cons (list 'vm-su-to + 'vm-su-message) sexp))) + ((= conv-spec ?U) + (setq sexp + (cons (list 'vm-run-user-summary-function + (list 'quote + (intern + (concat + "vm-summary-function-" + (substring + format + (1+ (match-beginning 5)) + (+ 2 (match-beginning 5)))))) + 'vm-su-message) sexp))) + ((= conv-spec ?w) + (setq sexp (cons (list 'vm-su-weekday + 'vm-su-message) sexp))) + ((= conv-spec ?y) + (setq sexp (cons (list 'vm-su-year + 'vm-su-message) sexp))) + ((= conv-spec ?z) + (setq sexp (cons (list 'vm-su-zone + 'vm-su-message) sexp))) + ((= conv-spec ?*) + (if tokenize + (setq token ''mark) + (setq sexp (cons (list 'vm-su-mark + 'vm-su-message) sexp))))) + (cond ((and (not token) vm-display-using-mime) + ;; strings might have been already mime-decoded, + ;; but there is no harm in doing it again. USR, 2010-05-13 + (setcar sexp + (list 'vm-decode-mime-encoded-words-in-string + (car sexp))))) + (cond ((and (not token) (match-beginning 1) (match-beginning 2)) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-left-justify-string + 'vm-left-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2)))))) + ((and (not token) (match-beginning 2)) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-right-justify-string + 'vm-right-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2))))))) + (cond ((and (not token) (match-beginning 3)) + (setcar sexp + (list 'vm-truncate-string (car sexp) + (string-to-number + (substring format + (match-beginning 4) + (match-end 4))))))) + ;; Why do we reencode decoded strings? USR, 2010-05-12 +;; (cond ((and (not token) vm-display-using-mime) +;; (setcar sexp +;; (list 'vm-reencode-mime-encoded-words-in-string +;; (car sexp))))) + (setq sexp-fmt + (cons (if token "" "%s") + (cons (substring format + last-match-end + (match-beginning 0)) + sexp-fmt)))) + (setq sexp-fmt + (cons (if (eq conv-spec ?\)) + (prog1 "" (setq saw-close-group t)) + "%%") + (cons (substring format + (or last-match-end 0) + (match-beginning 0)) + sexp-fmt)))) + (setq last-match-end new-match-end)) + (if (and (not saw-close-group) (not token)) + (setq sexp-fmt + (cons (substring format last-match-end (length format)) + sexp-fmt) + finished-parsing-format t)) + (setq sexp-fmt (apply 'concat (nreverse sexp-fmt))) + (if sexp + (setq sexp (cons 'format (cons sexp-fmt (nreverse sexp)))) + (setq sexp sexp-fmt)) + (if tokenize + (setq list (nconc list (if (equal sexp "") nil (list sexp)) + (and token (if splice token (list token)))) + sexp nil + sexp-fmt nil))) + (list last-match-end (if list (cons 'list list) sexp)))) + +;;;###autoload +(defun vm-get-header-contents (message header-name-regexp &optional clump-sep) + "Return the header field of MESSAGE with the header name matching +HEADER-NAME-REGEXP. The result will be a string that is +mime-encoded. The optional argument CLUMP-SEP, if present, should be +a string, which can be used as a separator to concatenate the fields +of multiple header lines which might match HEADER-NAME-REGEXP. + USR, 2010-05-13." + (let ((contents nil) + (regexp (concat "^\\(" header-name-regexp "\\)"))) + (setq message (vm-real-message-of message)) + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of message))) + (save-restriction + (widen) + (goto-char (vm-headers-of message)) + (let ((case-fold-search t)) + (while (and (or (null contents) clump-sep) + (re-search-forward regexp (vm-text-of message) t) + (save-excursion (goto-char (match-beginning 0)) + (vm-match-header))) + (if contents + (setq contents + (concat contents clump-sep (vm-matched-header-contents))) + (setq contents (vm-matched-header-contents)))))) + contents ))) + +;; Do not use Emacs 20's string-width here. +;; It does not consider buffer-display-table. +(defun vm-string-width (string) + (if (not (fboundp 'char-width)) + (length string) + (let ((i 0) + (lim (length string)) + (total 0)) + (while (< i lim) + (setq total (+ total (char-width (aref string i))) + i (1+ i))) + total ))) + +(defun vm-left-justify-string (string width) + (let ((sw (vm-string-width string))) + (if (>= sw width) + string + (concat string (make-string (- width sw) ?\ ))))) + +(defun vm-right-justify-string (string width) + (let ((sw (vm-string-width string))) + (if (>= sw width) + string + (concat (make-string (- width sw) ?\ ) string)))) + +;; I don't think number glyphs ever have a width > 1 +(defun vm-numeric-left-justify-string (string width) + (let ((sw (length string))) + (if (>= sw width) + string + (concat string (make-string (- width sw) ?0))))) + +;; I don't think number glyphs ever have a width > 1 +(defun vm-numeric-right-justify-string (string width) + (let ((sw (length string))) + (if (>= sw width) + string + (concat (make-string (- width sw) ?0) string)))) + +(defun vm-truncate-string (string width) + (cond ((fboundp 'char-width) + (cond ((> width 0) + (let ((i 0) + (lim (length string)) + (total 0)) + (while (and (< i lim) (< total width)) + (setq total (+ total (char-width (aref string i))) + i (1+ i))) + (if (< total width) + string + (substring string 0 i)))) + (t + (let ((i (1- (length string))) + (lim -1) + (total 0)) + (setq width (- width)) + (while (and (> i lim) (< total width)) + (setq total (+ total (char-width (aref string i))) + i (1- i))) + (if (< total width) + string + (substring string (1+ i))))))) + (t (vm-truncate-roman-string string width)))) + +(defun vm-truncate-roman-string (string width) + (cond ((<= (length string) (vm-abs width)) + string) + ((< width 0) + (substring string width)) + (t + (substring string 0 width)))) + +(defvar vm-postponed-header) ; defined vm-pine.el + +(defun vm-su-postponed-indicator (msg) + "Given a MESSAGE, ruturns a string indicating whether the +message is a postponed draft that still needs to be sent. The +indicator string is that defined by the variable +`vm-summary-postponed-indicator'. USR, 2010-05-13." + (if (vm-get-header-contents msg vm-postponed-header) + vm-summary-postponed-indicator + "")) + +(defun vm-su-attachment-indicator (msg) + "Given a MESSAGE, ruturns a string indicating whether the +message has attachments. The indicator string is the value of +`vm-summary-attachment-indicator' followed by the number of +attachments. USR, 2010-05-13." + (let ((attachments 0)) + (setq msg (vm-real-message-of msg)) + ;; If this calls back vm-update-summary-and-mode-line + ;; an infinite regress happens! + (vm-mime-operate-on-attachments + nil + :action + (lambda (msg layout type file) + (setq attachments (1+ attachments))) + :included vm-summary-attachment-mime-types + :excluded vm-summary-attachment-mime-type-exceptions + :messages (list msg)) + (if (= attachments 0) + "" + (if (stringp vm-summary-attachment-indicator) + vm-summary-attachment-indicator + (format "%s%d" vm-summary-attachment-indicator attachments))))) + +(defun vm-su-attribute-indicators (m) + "Given a MESSAGE, ruturns a short string showing the attributes of the +message. The string is 4 characters long. USR, 2010-05-13." + (concat + (cond ((vm-deleted-flag m) "D") + ((vm-new-flag m) "N") + ((vm-unread-flag m) "U") + ((vm-flagged-flag m) "!") + (t " ")) + (cond ((vm-filed-flag m) "F") + ((vm-written-flag m) "W") + (t " ")) + (cond ((vm-replied-flag m) "R") + ((vm-forwarded-flag m) "Z") + ((vm-redistributed-flag m) "B") + (t " ")) + (cond ((vm-edited-flag m) "E") + (t " ")))) + +(defun vm-su-attribute-indicators-short (m) + "Given a MESSAGE, ruturns a short string showing the attributes of the +message. The string is 1 character long. USR, 2011-01-08." + (concat + (cond ((vm-deleted-flag m) "D") + ((vm-new-flag m) "N") + ((vm-unread-flag m) "U") + ((vm-flagged-flag m) "!") + (t " ")))) + +(defun vm-su-attribute-indicators-long (m) + "Given a MESSAGE, ruturns a long string showing the attributes of the +message. The string is 7 characters long. USR, 2010-05-13." + (concat + (cond ((vm-deleted-flag m) "D") + ((vm-new-flag m) "N") + ((vm-unread-flag m) "U") + ((vm-flagged-flag m) "!") + (t " ")) + (if (vm-replied-flag m) "r" " ") + (if (vm-forwarded-flag m) "z" " ") + (if (vm-redistributed-flag m) "b" " ") + (if (vm-filed-flag m) "f" " ") + (if (vm-written-flag m) "w" " ") + (if (vm-edited-flag m) "e" " "))) + +(defun vm-su-byte-count (m) + "Given a MESSAGE, ruturns a string showing the length of the +message in bytes. USR, 2010-05-13." + (or (vm-byte-count-of m) + (vm-set-byte-count-of + m + (int-to-string + (- (vm-text-end-of (vm-real-message-of m)) + (vm-text-of (vm-real-message-of m))))))) + +(defun vm-su-size (msg) + "Given a MESSAGE, return a string showing the the size of the +message in bytes, kilobytes or megabytes. USR, 2010-05.13" + (let ((size (string-to-number (vm-su-byte-count msg)))) + (cond ((< size 1024) + (format "%d" size)) + ((< size 1048576) + (setq size (/ size 1024)) + (format "%dK" size)) + (t + (setq size (/ size 1048576)) + (format "%dM" size))))) + +(defun vm-su-spam-score-aux (m) + "Return the numeric spam level for M. The spam level is obtained +from any of the headers listed in `vm-spam-score-headers'." + (let ((spam-headers vm-spam-score-headers)) + (catch 'done + (while spam-headers + (let* ((spam-selector (car spam-headers)) + (score (vm-get-header-contents m (car spam-selector)))) + (when (and score (string-match (nth 1 spam-selector) score)) + (throw 'done + (funcall (nth 2 spam-selector) (match-string 0 score)))) + (setq spam-headers (cdr spam-headers)))) + 0))) + +(defun vm-su-spam-score (m) + "Return the numeric spam level for M (possibly using the cached-data)." + (or (vm-spam-score-of m) + (vm-set-spam-score-of m (vm-su-spam-score-aux m)))) + +(defun vm-su-weekday (m) + "Given a MESSAGE, returns a string showing the week day on which it +was sent. USR, 2010-05-13" + (or (vm-weekday-of m) + (progn (vm-su-do-date m) (vm-weekday-of m)))) + +(defun vm-su-monthday (m) + "Given a MESSAGE, returns a string showing the month day on which it +was sent. USR, 2010-05-13" + (or (vm-monthday-of m) + (progn (vm-su-do-date m) (vm-monthday-of m)))) + +(defun vm-su-month (m) + (or (vm-month-of m) + (progn (vm-su-do-date m) (vm-month-of m)))) + +(defun vm-su-month-number (m) + (or (vm-month-number-of m) + (progn (vm-su-do-date m) (vm-month-number-of m)))) + +(defun vm-su-year (m) + (or (vm-year-of m) + (progn (vm-su-do-date m) (vm-year-of m)))) + +(defun vm-su-hour-short (m) + (let ((string (vm-su-hour m))) + (if (> (length string) 5) + (substring string 0 5) + string))) + +(defun vm-su-hour (m) + (or (vm-hour-of m) + (progn (vm-su-do-date m) (vm-hour-of m)))) + +(defun vm-su-zone (m) + (or (vm-zone-of m) + (progn (vm-su-do-date m) (vm-zone-of m)))) + +(defun vm-su-mark (m) (if (vm-mark-of m) "*" " ")) + +;; Some yogurt-headed delivery agents don't provide a Date: header. +(defun vm-grok-From_-date (message) + ;; This works only on the From_ types, obviously + (if (not (memq (vm-message-type-of message) + '(BellFrom_ From_ From_-with-Content-Length))) + nil + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of message))) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-start-of message)) + (let ((case-fold-search nil)) + (if (or (looking-at + ;; special case this so that the "remote from blah" + ;; isn't included. + "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\) remote from .*") + (looking-at "From [^ \t\n]*[ \t]+\\([^ \t\n].*\\)")) + (vm-buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))))))) + +(defun vm-su-do-date (m) + (let ((case-fold-search t) + vector date) + (setq date + (or + ;; (and vm-sort-messages-by-delivery-date + ;; (vm-get-header-contents m "Delivery-Date:")) + (vm-get-header-contents m "Date:") + (vm-grok-From_-date m))) + (cond + ((null date) + (vm-set-weekday-of m "") + (vm-set-monthday-of m "") + (vm-set-month-of m "") + (vm-set-month-number-of m "") + (vm-set-year-of m "") + (vm-set-hour-of m "") + (vm-set-zone-of m "")) + ((string-match +;; The date format recognized here is the one specified in RFC 822. +;; Some slop is allowed e.g. dashes between the monthday, month and year +;; because such malformed headers have been observed. +"\\(\\([a-z][a-z][a-z]\\),\\)?[ \t\n]*\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*\\([0-9]*[0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|\\(-\\|\\+\\)[01][0-9][0-9][0-9]\\)" + date) + (if (match-beginning 2) + (vm-su-do-weekday m (substring date (match-beginning 2) + (match-end 2))) + (vm-set-weekday-of m "")) + (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3))) + (vm-su-do-month m (substring date (match-beginning 4) (match-end 4))) + (vm-set-year-of m (substring date (match-beginning 5) (match-end 5))) + (if (= 2 (length (vm-year-of m))) + (save-match-data + (cond ((string-match "^[0-6]" (vm-year-of m)) + (vm-set-year-of m (concat "20" (vm-year-of m)))) + (t + (vm-set-year-of m (concat "19" (vm-year-of m))))))) + (vm-set-hour-of m (substring date (match-beginning 6) (match-end 6))) + (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7)))) + ((string-match +;; UNIX ctime(3) format, with slop allowed in the whitespace, and we allow for +;; the possibility of a timezone at the end. +"\\([a-z][a-z][a-z]\\)[ \t\n]*\\([a-z][a-z][a-z]\\)[ \t\n]*\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([0-9][0-9][0-9][0-9]\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|\\(-\\|\\+\\)[01][0-9][0-9][0-9]\\)?" + date) + (vm-su-do-weekday m (substring date (match-beginning 1) + (match-end 1))) + (vm-su-do-month m (substring date (match-beginning 2) (match-end 2))) + (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3))) + (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4))) + (vm-set-year-of m (substring date (match-beginning 5) (match-end 5))) + (if (match-beginning 6) + (vm-set-zone-of m (substring date (match-beginning 6) + (match-end 6))) + (vm-set-zone-of m ""))) + (t + (setq vector (vm-parse-date date)) + (vm-su-do-weekday m (elt vector 0)) + (vm-set-monthday-of m (elt vector 1)) + (vm-su-do-month m (elt vector 2)) + (vm-set-year-of m (elt vector 3)) + (vm-set-hour-of m (elt vector 4)) + (vm-set-zone-of m (elt vector 5))))) + + ;; Normalize all hour and date specifications to avoid jagged margins. + ;; If the hour is " 3:..." or "3:...", turn it into "03:...". + ;; If the date is "03", turn it into " 3". + (cond ((null (vm-hour-of m)) nil) + ((string-match "\\`[0-9]:" (vm-hour-of m)) + (vm-set-hour-of m (concat "0" (vm-hour-of m))))) + (cond ((null (vm-monthday-of m)) nil) + ((string-match "\\`0[0-9]\\'" (vm-monthday-of m)) + (vm-set-monthday-of m (substring (vm-monthday-of m) 1 2)))) + ) + +(defun vm-su-do-month (m month-abbrev) + (let ((val (assoc (downcase month-abbrev) vm-month-alist))) + (if val + (progn (vm-set-month-of m (nth 1 val)) + (vm-set-month-number-of m (nth 2 val))) + (vm-set-month-of m "") + (vm-set-month-number-of m "")))) + +(defun vm-su-do-weekday (m weekday-abbrev) + (let ((val (assoc (downcase weekday-abbrev) vm-weekday-alist))) + (if val + (vm-set-weekday-of m (nth 1 val)) + (vm-set-weekday-of m "")))) + +(defun vm-run-user-summary-function (function message) + ;; (condition-case nil + (let ((m (vm-real-message-of message))) + (save-excursion + (set-buffer (vm-buffer-of m)) + (save-restriction + (widen) + (save-excursion + (narrow-to-region (vm-headers-of m) (vm-text-end-of m)) + (funcall function m))))) + ;; (error " ")) + ) + +(defun vm-su-full-name (m) + "Returns the author name of M as a string, either from +the stored entry (vm-full-name-of) or recalculating it if necessary. +The result is a mime-decoded string with text-properties. + USR 2010-05-13" + (or (vm-full-name-of m) + (progn (vm-su-do-author m) (vm-full-name-of m)))) + +(defun vm-su-interesting-full-name (m) + "Returns the author name of M as a string, but if the author is +\"uninteresting\" then returns the value of +`vm-summary-uninteresting-senders-arrow' followed by recipient +names. The result is a mime-decoded string with text properties. + USR 2010-05-13" + (if vm-summary-uninteresting-senders + (let ((case-fold-search nil)) + (if (string-match vm-summary-uninteresting-senders (vm-su-from m)) + (concat vm-summary-uninteresting-senders-arrow (vm-su-to-names m)) + (vm-su-full-name m))) + (vm-su-full-name m))) + +(defun vm-su-from (m) + "Returns the author address of M as a string, either from +the stored entry (vm-from-of) or recalculating it if necessary. +The result is a mime-encoded string, but this is not certain. + USR 2010-05-13" + (or (vm-from-of m) + (progn (vm-su-do-author m) (vm-from-of m)))) + +(defun vm-su-interesting-from (m) + "Returns the author address of M as a string, but if the author is +\"uninteresting\" then returns the value of +`vm-summary-uninteresting-senders-arrow' followed by recipient +addresses. The result is a mime-encoded string, but this not certain. + USR 2010-05-13" + (if vm-summary-uninteresting-senders + (let ((case-fold-search nil)) + (if (string-match vm-summary-uninteresting-senders (vm-su-from m)) + (concat vm-summary-uninteresting-senders-arrow (vm-su-to m)) + (vm-su-from m))) + (vm-su-from m))) + +;; Some yogurt-headed delivery agents don't even provide a From: header. +(defun vm-grok-From_-author (message) + ;; This works only on the From_ types, obviously + (if (not (memq (vm-message-type-of message) + '(From_ BellFrom_ From_-with-Content-Length))) + nil + (save-excursion + (set-buffer (vm-buffer-of message)) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-start-of message)) + (let ((case-fold-search nil)) + (if (looking-at "From \\([^ \t\n]+\\)") + (vm-buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))))))) + +(defun vm-su-do-author (m) + "Parses the From headers of the message M and stores the results in +the from and full-name entries of the cached-data vector. USR, 2010-05-13" + (let ((full-name (vm-get-header-contents m "Full-Name:")) + (from (or (vm-get-header-contents m "From:" ", ") + (vm-grok-From_-author m))) + pair i) + (if (and full-name (string-match "^[ \t]*$" full-name)) + (setq full-name nil)) + (if (null from) + (progn + (setq from "???") + (if (null full-name) + (setq full-name "???"))) + (setq pair (funcall vm-chop-full-name-function from) + from (or (nth 1 pair) from) + full-name (or full-name (nth 0 pair) from))) + (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) + (setq full-name + (substring full-name (match-beginning 1) (match-end 1)))) + (while (setq i (string-match "\n" full-name i)) + (aset full-name i ?\ )) + (vm-set-full-name-of m (vm-decode-mime-encoded-words-in-string full-name)) + (vm-set-from-of m (vm-decode-mime-encoded-words-in-string from)))) + +(defun vm-default-chop-full-name (address) + (let ((from address) + (full-name nil)) + (cond ((string-match +"\\`[ \t\n]*\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*<\\([^>]+\\)>[ \t\n]*\\'" + address) + (if (match-beginning 1) + (setq full-name + (substring address (match-beginning 1) (match-end 1)))) + (setq from + (substring address (match-beginning 3) (match-end 3)))) + ((string-match +"\\`[ \t\n]*\\(\\(\"[^\"]+\"\\|[^\"( \t\n]\\)+\\)[ \t\n]*(\\([^ \t\n]+\\([ \t\n]+[^ \t\n]+\\)*\\)?)[ \t\n]*\\'" + address) + (if (match-beginning 3) + (setq full-name + (substring address (match-beginning 3) (match-end 3)))) + (setq from + (substring address (match-beginning 1) (match-end 1))))) + (list full-name from))) + +;; test for existence and functionality of mail-extract-address-components +;; there are versions out there that don't work right, so we run +;; some test data through it to see if we can trust it. +(defun vm-choose-chop-full-name-function (address) + (let ((test-data '(("kyle@uunet.uu.net" . + (nil "kyle@uunet.uu.net")) + ("c++std=lib@inet.research.att.com" . + (nil "c++std=lib@inet.research.att.com")) + ("\"Piet.Rypens\" <rypens@reks.uia.ac.be>" . + ("Piet Rypens" "rypens@reks.uia.ac.be")) + ("makke@wins.uia.ac.be (Marc.Gemis)" . + ("Marc Gemis" "makke@wins.uia.ac.be")) + ("" . (nil nil)))) + (failed nil) + result) + (while test-data + (setq result (condition-case nil + (mail-extract-address-components (car (car test-data))) + (error nil))) + (if (not (equal result (cdr (car test-data)))) + ;; failed test, use default + (setq failed t + test-data nil) + (setq test-data (cdr test-data)))) + (if failed + ;; it failed, use default + (setq vm-chop-full-name-function 'vm-default-chop-full-name) + ;; it passed the tests + (setq vm-chop-full-name-function 'mail-extract-address-components)) + (funcall vm-chop-full-name-function address))) + +(defun vm-su-do-recipients (m) + (let ((mail-use-rfc822 t) i names addresses to cc all list full-name) + (setq to (or (vm-get-header-contents m "To:" ", ") + (vm-get-header-contents m "Apparently-To:" ", ") + (vm-get-header-contents m "Newsgroups:" ", ") + ;; desperation.... + (user-login-name)) + cc (or (vm-get-header-contents m "Cc:" ", ") + (vm-get-header-contents m "Bcc:" ", ")) + all to + all (if all (concat all ", " cc) cc) + addresses (condition-case err + (rfc822-addresses all) + (error + (vm-warn 0 5 err) + (list "corrupted-header")))) + (setq list (vm-parse-addresses all)) ; adds text properties for charsets + (while list + ;; Just like vm-su-do-author: + (setq full-name (or (nth 0 (funcall vm-chop-full-name-function + (car list))) + (car list))) + ;; If double quotes are around the full name, fish the name out. + (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) + (setq full-name + (substring full-name (match-beginning 1) (match-end 1)))) + (while (setq i (string-match "\n" full-name i)) + (aset full-name i ?\ )) + (setq names (cons full-name names)) + (setq list (cdr list))) + (setq names (nreverse names)) + ;; added by jwz for fixed vm-parse-addresses + (vm-set-to-of m (mapconcat 'identity addresses ", ")) + (vm-set-to-names-of m (mapconcat 'identity names ", ")))) + +(defun vm-su-to (m) + "Returns the recipient addresses of M as a string, either from +the stored entry (vm-to-of) or recalculating them if necessary. +The result is a mime-decoded string with text properties. + USR 2010-05-13" + (or (vm-to-of m) (progn (vm-su-do-recipients m) (vm-to-of m)))) + +(defun vm-su-to-names (m) + "Returns the recipient names of M as a string, either from +the stored entry (vm-to-names-of) or recalculating them if necessary. +The result is a mime-decoded string with text properties. + USR 2010-05-13" + (or (vm-to-names-of m) (progn (vm-su-do-recipients m) (vm-to-names-of m)))) + +;;;###autoload +(defun vm-su-message-id (m) + "Returns the message id of M. It is a mime-encoded string. + USR 2010-12-16" + (or (vm-message-id-of m) + (vm-set-message-id-of + m + (or (let ((id (vm-get-header-contents m "Message-Id:"))) + (and id (car (vm-parse id "[^<]*\\(<[^>]+>\\)")))) + ;; try running md5 on the message body to produce an ID + ;; better than nothing. + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of m))) + (save-restriction + (widen) + (condition-case nil + (concat "<fake-VM-id." + (vm-md5-string + (buffer-substring + (vm-headers-of (vm-real-message-of m)) + (vm-text-of (vm-real-message-of m)))) + "@talos.iv>") + (error nil)))) + (concat "<" (int-to-string (vm-abs (random))) "@toto.iv>"))))) + +(defun vm-su-line-count (m) + "Returns the line count of M as a string, either from the stored +entry (vm-line-count-of) or recalculating it if necessary. USR 2010-05-13" + (or (vm-line-count-of m) + (vm-set-line-count-of + m + (save-excursion + (set-buffer (vm-buffer-of (vm-real-message-of m))) + (save-restriction + (widen) + (int-to-string + (count-lines (vm-text-of (vm-real-message-of m)) + (vm-text-end-of (vm-real-message-of m))))))))) + +;;;###autoload +(defun vm-su-subject (m) + "Returns the subject string of M, either from the stored +entry (vm-subject-of) or recalculating it if necessary. It is a +mime-decoded string with text properties. USR 2010-05-13" + (or (vm-subject-of m) + (vm-set-subject-of + m + (let ((subject (vm-decode-mime-encoded-words-in-string + (or (vm-get-header-contents m "Subject:") ""))) + (i nil)) + (while (string-match "\n[ \t]*" subject) + (setq subject (replace-match " " nil t subject))) + subject )))) + +(defun vm-su-summary (m) + "Returns the tokenized summary line of M, either from the +stored entry (vm-summary-of) or recalculating it if necessary. +The summary line is a mime-decoded string with text properties. + USR 2010-05-13" + (if (and (vm-virtual-message-p m) (not (vm-virtual-messages-of m))) + (or (vm-virtual-summary-of m) + (save-excursion + (vm-select-folder-buffer) + (vm-set-virtual-summary-of m (vm-summary-sprintf + vm-summary-format m t)) + (vm-virtual-summary-of m))) + (or (vm-summary-of m) + (save-excursion + (vm-select-folder-buffer) + (vm-set-summary-of m (vm-summary-sprintf vm-summary-format m t)) + (vm-summary-of m))))) + +;;;###autoload +(defun vm-fix-my-summary (&optional kill-local-summary) + "Rebuild the summary. +Call this function if you made changes to `vm-summary-format'." + (interactive "P") + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if kill-local-summary + (kill-local-variable 'vm-summary-format)) + (vm-inform 5 "Fixing your summary... %s" vm-summary-format) + (let ((mp vm-message-list)) + ;; Erase all the cached summary and threading data + (while mp + (vm-set-summary-of (car mp) nil) + (vm-set-thread-indentation-of (car mp) nil) + (vm-set-thread-list-of (car mp) nil) + (vm-set-thread-subtree-of (car mp) nil) + (vm-mark-for-summary-update (car mp)) + (vm-set-stuff-flag-of (car mp) t) + (setq mp (cdr mp))) + ;; Erase threading information + (setq vm-thread-obarray 'bonk + vm-thread-subject-obarray 'bonk) + ;; Generate fresh summary data and stuff it +;; (vm-inform 7 "Stuffing cached data...") +;; (vm-stuff-folder-data nil) +;; (vm-inform 7 "Stuffing cached data... done") +;; (set-buffer-modified-p t) + ;; Regenerate the summary + (vm-inform 5 "Recreating summary...") + (vm-update-summary-and-mode-line) + (unless vm-summary-debug + (vm-inform 5 "Recreating summary... done"))) + (if vm-thread-debug + (vm-check-thread-integrity)) + (vm-inform 5 "Fixing your summary... done")) + +(defun vm-su-thread-indent (m) + (if (and vm-summary-show-threads (natnump vm-summary-thread-indent-level)) + (make-string (* (vm-thread-indentation m) + vm-summary-thread-indent-level) + ?\ ) + "" )) + +(defun vm-su-labels (m) + (or (vm-label-string-of m) + (vm-set-label-string-of + m + (mapconcat 'identity (sort (vm-labels-of m) 'string-lessp) ",")) + (vm-label-string-of m))) + +(defun vm-make-folder-summary () + (make-vector vm-folder-summary-vector-length nil)) + +(defun vm-fs-folder-of (fs) (aref fs 0)) +(defun vm-fs-total-count-of (fs) (aref fs 1)) +(defun vm-fs-new-count-of (fs) (aref fs 2)) +(defun vm-fs-unread-count-of (fs) (aref fs 3)) +(defun vm-fs-deleted-count-of (fs) (aref fs 4)) +(defun vm-fs-start-of (fs) (aref fs 5)) +(defun vm-fs-end-of (fs) (aref fs 6)) +(defun vm-fs-folder-key-of (fs) (aref fs 7)) +(defun vm-fs-mouse-track-overlay-of (fs) (aref fs 8)) +(defun vm-fs-short-folder-of (fs) (aref fs 9)) +(defun vm-fs-modflag-of (fs) (aref fs 10)) + +(defun vm-set-fs-folder-of (fs x) (aset fs 0 x)) +(defun vm-set-fs-total-count-of (fs x) (aset fs 1 x)) +(defun vm-set-fs-new-count-of (fs x) (aset fs 2 x)) +(defun vm-set-fs-unread-count-of (fs x) (aset fs 3 x)) +(defun vm-set-fs-deleted-count-of (fs x) (aset fs 4 x)) +(defun vm-set-fs-start-of (fs x) (aset fs 5 x)) +(defun vm-set-fs-end-of (fs x) (aset fs 6 x)) +(defun vm-set-fs-folder-key-of (fs x) (aset fs 7 x)) +(defun vm-set-fs-mouse-track-overlay-of (fs x) (aset fs 8 x)) +(defun vm-set-fs-short-folder-of (fs x) (aset fs 9 x)) +(defun vm-set-fs-modflag-of (fs x) (aset fs 10 x)) + +(defun vm-fs-spooled (fs) + (let ((count 0) + (list (symbol-value + (intern-soft (vm-fs-folder-key-of fs) + vm-folders-summary-folder-hash)))) + (while list + (setq count (+ count (car (vm-get-folder-totals (car list)))) + list (cdr list))) + (int-to-string count))) + +(defun vm-make-folders-summary-key (folder &optional dir) + (cond ((vm-pop-folder-spec-p folder) + (or (vm-pop-find-name-for-spec folder) + (vm-safe-popdrop-string folder))) + ((vm-imap-folder-spec-p folder) + (or (vm-imap-folder-for-spec folder) + (vm-safe-imapdrop-string folder))) + (t + (concat "folder-summary0:" + (file-truename + (expand-file-name folder (or dir vm-folder-directory))))))) + +(defun vm-open-folders-summary-database (mode) + (condition-case data + (open-database vm-folders-summary-database 'berkeley-db 'hash mode) + (error (vm-warn 0 2 "open-database signaled: %S" data) + nil ))) + +(defun vm-get-folder-totals (folder) + (let ((default "(0 0 0 0)") fs db key data) + (catch 'done + (if (null vm-folders-summary-database) + (throw 'done (read default))) + (if (not (featurep 'berkeley-db)) + (throw 'done (read default))) + (if (null (setq db (vm-open-folders-summary-database "rw+"))) + (throw 'done (read default))) + (setq key (vm-make-folders-summary-key folder) + data (read (get-database key db default))) + (close-database db) + data ))) + +(defun vm-store-folder-totals (folder totals) + (let (fs db key data) + (catch 'done + (if (null vm-folders-summary-database) + (throw 'done nil)) + (if (not (featurep 'berkeley-db)) + (throw 'done nil)) + (if (null (setq db (vm-open-folders-summary-database "rw+"))) + (throw 'done nil)) + (setq key (vm-make-folders-summary-key folder) + data (prin1-to-string totals)) + (put-database key data db t) + (close-database db) + (if (null vm-folders-summary-hash) + nil + (setq fs (intern-soft key vm-folders-summary-hash) + fs (symbol-value fs)) + (if (null fs) + nil + (vm-set-fs-total-count-of fs (int-to-string (car totals))) + (vm-set-fs-new-count-of fs (int-to-string (nth 1 totals))) + (vm-set-fs-unread-count-of fs (int-to-string (nth 2 totals))) + (vm-set-fs-deleted-count-of fs (int-to-string (nth 3 totals))))) + (vm-mark-for-folders-summary-update folder)))) + +(defun vm-modify-folder-totals (folder action &rest objects) + (let (fs db totals key data) + (catch 'done + (if (null vm-folders-summary-database) + (throw 'done nil)) + (if (not (featurep 'berkeley-db)) + (throw 'done nil)) + (if (null (setq db (vm-open-folders-summary-database "r"))) + (throw 'done nil)) + (setq key (vm-make-folders-summary-key folder)) + (setq totals (get-database key db)) + (close-database db) + (if (null totals) + (throw 'done nil)) + (setq totals (read totals)) + (cond ((eq action 'arrived) + (let ((arrived (car objects)) c n) + (setcar totals (+ (car totals) arrived)) + (setq c (cdr totals)) + (setcar c (+ (car c) arrived)))) + ((eq action 'saved) + (let ((arrived (car objects)) + (m (nth 1 objects)) c n) + (setcar totals (+ (car totals) arrived)) + ;; increment new and unread counts if necessary. + ;; messages are never saved with the deleted flag + ;; set no need to check that. + (setq c (cdr totals)) + (if (eq (car c) -1) + nil + (if (vm-new-flag m) + (setcar c (+ (car c) arrived)))) + (setq c (cdr c)) + (if (eq (car c) -1) + nil + (if (vm-unread-flag m) + (setcar c (+ (car c) arrived))))))) + (setq data (prin1-to-string totals)) + (if (null (setq db (vm-open-folders-summary-database "rw+"))) + (throw 'done nil)) + (put-database key data db t) + (close-database db) + (if (null vm-folders-summary-hash) + nil + (setq fs (intern-soft key vm-folders-summary-hash) + fs (symbol-value fs)) + (if (null fs) + nil + (vm-set-fs-total-count-of fs (int-to-string (car totals))) + (vm-set-fs-new-count-of fs (int-to-string (nth 1 totals))) + (vm-set-fs-unread-count-of fs (int-to-string (nth 2 totals))) + (vm-set-fs-deleted-count-of fs (int-to-string (nth 3 totals))))) + (vm-mark-for-folders-summary-update folder)))) + +(defun vm-folders-summary-sprintf (format layout) + ;; compile the format into an eval'able s-expression + ;; if it hasn't been compiled already. + (let ((match (assoc format vm-folders-summary-compiled-format-alist))) + (if (null match) + (progn + (vm-folders-summary-compile-format format) + (setq match + (assoc format vm-folders-summary-compiled-format-alist)))) + ;; The local variable name `vm-folder-summary' is mandatory here for + ;; the format s-expression to work. + (let ((vm-folder-summary layout)) + (eval (cdr match))))) + +(defun vm-folders-summary-compile-format (format) + (let ((return-value (vm-folders-summary-compile-format-1 format 0))) + (setq vm-folders-summary-compiled-format-alist + (cons (cons format (nth 1 return-value)) + vm-folders-summary-compiled-format-alist)))) + +(defun vm-folders-summary-compile-format-1 (format start-index) + (let ((case-fold-search nil) + (done nil) + (sexp nil) + (sexp-fmt nil) + (last-match-end start-index) + new-match-end conv-spec) + (store-match-data nil) + (while (not done) + (while + (and (not done) + (string-match + "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()dfnstu%]\\)" + format last-match-end)) + (setq conv-spec (aref format (match-beginning 5))) + (setq new-match-end (match-end 0)) + (if (memq conv-spec '(?\( ?d ?f ?n ?s ?t ?u)) + (progn + (cond ((= conv-spec ?\() + (save-match-data + (let ((retval + (vm-folders-summary-compile-format-1 + format + (match-end 5)))) + (setq sexp (cons (nth 1 retval) sexp) + new-match-end (car retval))))) + ((= conv-spec ?d) + (setq sexp (cons (list 'vm-fs-deleted-count-of + 'vm-folder-summary) sexp))) + ((= conv-spec ?f) + (setq sexp (cons (list 'vm-fs-short-folder-of + 'vm-folder-summary) sexp))) + ((= conv-spec ?n) + (setq sexp (cons (list 'vm-fs-new-count-of + 'vm-folder-summary) sexp))) + ((= conv-spec ?t) + (setq sexp (cons (list 'vm-fs-total-count-of + 'vm-folder-summary) sexp))) + ((= conv-spec ?s) + (setq sexp (cons (list 'vm-fs-spooled + 'vm-folder-summary) sexp))) + ((= conv-spec ?u) + (setq sexp (cons (list 'vm-fs-unread-count-of + 'vm-folder-summary) sexp)))) + (cond ((and (match-beginning 1) (match-beginning 2)) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-left-justify-string + 'vm-left-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2)))))) + ((match-beginning 2) + (setcar sexp + (list + (if (eq (aref format (match-beginning 2)) ?0) + 'vm-numeric-right-justify-string + 'vm-right-justify-string) + (car sexp) + (string-to-number + (substring format + (match-beginning 2) + (match-end 2))))))) + (cond ((match-beginning 3) + (setcar sexp + (list 'vm-truncate-string (car sexp) + (string-to-number + (substring format + (match-beginning 4) + (match-end 4))))))) + (setq sexp-fmt + (cons "%s" + (cons (substring format + last-match-end + (match-beginning 0)) + sexp-fmt)))) + (setq sexp-fmt + (cons (if (eq conv-spec ?\)) + (prog1 "" (setq done t)) + "%%") + (cons (substring format + (or last-match-end 0) + (match-beginning 0)) + sexp-fmt)))) + (setq last-match-end new-match-end)) + (if (not done) + (setq sexp-fmt + (cons (substring format last-match-end (length format)) + sexp-fmt) + done t)) + (setq sexp-fmt (apply 'concat (nreverse sexp-fmt))) + (if sexp + (setq sexp (cons 'format (cons sexp-fmt (nreverse sexp)))) + (setq sexp sexp-fmt))) + (list last-match-end sexp))) + +(defun vm-update-folders-summary-entry (fs) + (if (and (vm-fs-start-of fs) + (marker-buffer (vm-fs-start-of fs))) + (let ((modified (buffer-modified-p)) + (do-mouse-track + (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces)) + summary) + (save-excursion + (set-buffer (marker-buffer (vm-fs-start-of fs))) + (let ((buffer-read-only nil)) + (unwind-protect + (save-excursion + (goto-char (vm-fs-start-of fs)) + ;; We do a little dance to update the text in + ;; order to make the markers in the text do + ;; what we want. + ;; + ;; 1. We need to avoid having the start + ;; and end markers clumping together at + ;; the start position. + ;; + ;; 2. We want the window point marker (w->pointm + ;; in the Emacs display code) to move to the + ;; start of the summary entry if it is + ;; anywhere within the su-start-of to + ;; su-end-of region. + ;; + ;; We achieve (2) by deleting before inserting. + ;; Reversing the order of insertion/deletion + ;; pushes the point marker into the next + ;; summary entry. We achieve (1) by inserting a + ;; placeholder character at the end of the + ;; summary entry before deleting the region. + (goto-char (vm-fs-end-of fs)) + (insert-before-markers "z") + (goto-char (vm-fs-start-of fs)) + (delete-region (point) (1- (vm-fs-end-of fs))) + (insert + (vm-folders-summary-sprintf vm-folders-summary-format fs)) + (delete-char 1) + (when do-mouse-track + (vm-mouse-set-mouse-track-highlight + (vm-fs-start-of fs) + (vm-fs-end-of fs) + (vm-fs-mouse-track-overlay-of fs))) + ;; VM Summary Faces may not work for this yet + ;; (when vm-summary-enable-faces + ;; (vm-summary-faces-add fs)) + ) + (set-buffer-modified-p modified))))))) + +(defun vm-folders-summary-mode-internal () + (setq mode-name "VM Folders Summary" + major-mode 'vm-folders-summary-mode + mode-line-format '(" %b") + ;; must come after the setting of major-mode + mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu)) + buffer-read-only t + buffer-offer-save nil + truncate-lines t) + (when (and vm-xemacs-p (featurep 'scrollbar)) + (set-specifier scrollbar-height (cons (current-buffer) 0))) + (use-local-map vm-folders-summary-mode-map) + (when (vm-menu-support-possible-p) + (vm-menu-install-menus)) + (when (and vm-mutable-frame-configuration vm-frame-per-folders-summary) + (vm-set-hooks-for-frame-deletion)) + (run-hooks 'vm-folders-summary-mode-hook)) + +(defun vm-do-folders-summary () + (catch 'done + (let ((fs-hash (make-vector 89 0)) db dp fp f key fs totals + (format vm-folders-summary-format) + (do-mouse-track (or (and vm-mouse-track-summary + (vm-mouse-support-possible-p)) + vm-summary-enable-faces))) + (save-excursion + (set-buffer vm-folders-summary-buffer) + (erase-buffer) + (let ((buffer-read-only nil)) + (if (null vm-folders-summary-database) + (throw 'done nil)) + (if (not (featurep 'berkeley-db)) + (throw 'done nil)) + (if (null (setq db (vm-open-folders-summary-database "r"))) + (throw 'done nil)) + (setq dp vm-folders-summary-directories) + (while dp + (if (cdr vm-folders-summary-directories) + (insert (car dp) ":\n")) + (let ((default-directory (car dp))) + (setq fp (sort (vm-delete-backup-file-names + (vm-delete-auto-save-file-names + (vm-delete-index-file-names + (vm-delete-directory-names + (directory-files (car dp)))))) + (function string-lessp)))) + (while fp + (setq f (car fp) + key (vm-make-folders-summary-key f (car dp)) + totals (get-database key db)) + (if (null totals) + (let ((ff (expand-file-name f (car dp)))) + (setq totals (list (or (vm-count-messages-in-file ff) -1) + -1 -1 -1)) + (if (eq (car totals) -1) + nil + (vm-store-folder-totals ff totals))) + (setq totals (read totals))) + (if (eq (car totals) -1) + nil + (setq fs (vm-make-folder-summary)) + (vm-set-fs-folder-of fs (expand-file-name f (car dp))) + (vm-set-fs-short-folder-of fs f) + (vm-set-fs-total-count-of fs (vm-nonneg-string (car totals))) + (vm-set-fs-new-count-of fs (vm-nonneg-string (nth 1 totals))) + (vm-set-fs-unread-count-of fs (vm-nonneg-string + (nth 2 totals))) + (vm-set-fs-deleted-count-of fs (vm-nonneg-string + (nth 3 totals))) + (vm-set-fs-folder-key-of fs key) + (vm-set-fs-start-of fs (vm-marker (point))) + (insert (vm-folders-summary-sprintf format fs)) + (vm-set-fs-end-of fs (vm-marker (point))) + (when do-mouse-track + (vm-set-fs-mouse-track-overlay-of + fs + (vm-mouse-set-mouse-track-highlight + (vm-fs-start-of fs) + (vm-fs-end-of fs)))) + ;; VM Summary Faces may not work here yet + ;; (when vm-summary-enable-faces + ;; (vm-summary-faces-add fs)) + (set (intern key fs-hash) fs)) + (setq fp (cdr fp))) + (setq dp (cdr dp))) + (close-database db) + (setq vm-folders-summary-hash fs-hash)) + (goto-char (point-min)))))) + +(defun vm-update-folders-summary-highlight () + (if (or (null vm-mail-buffer) + (null (buffer-file-name vm-mail-buffer)) + (null vm-folders-summary-hash)) + (progn + (and vm-folders-summary-overlay + (vm-set-extent-endpoints vm-folders-summary-overlay 1 1)) + (setq vm-mail-buffer nil)) + (let ((ooo vm-folders-summary-overlay) + (fs (symbol-value (intern-soft (vm-make-folders-summary-key + (buffer-file-name vm-mail-buffer)) + vm-folders-summary-hash)))) + (if (and fs + (or (null ooo) + (null (vm-extent-object ooo)) + (/= (vm-extent-end-position ooo) + (vm-fs-end-of fs)))) + (vm-folders-summary-highlight-region + (vm-fs-start-of fs) (vm-fs-end-of fs) + vm-summary-highlight-face))))) + +(defun vm-do-needed-folders-summary-update () + (if (null vm-folders-summary-buffer) + nil + (save-excursion + (set-buffer vm-folders-summary-buffer) + (if (or (eq vm-modification-counter vm-flushed-modification-counter) + (null vm-folders-summary-hash)) + nil + (mapatoms + (function + (lambda (sym) + (let ((fs (symbol-value sym))) + (if (null (vm-fs-modflag-of fs)) + nil + (vm-update-folders-summary-entry fs) + (vm-set-fs-modflag-of fs nil))))) + vm-folders-summary-hash) + (vm-update-folders-summary-highlight) + (setq vm-flushed-modification-counter vm-modification-counter))))) + +(defun vm-mark-for-folders-summary-update (folder &optional dont-descend) + (let ((key (vm-make-folders-summary-key folder)) + (hash vm-folders-summary-hash) + (spool-hash vm-folders-summary-spool-hash) + list fs ) + (setq fs (symbol-value (intern-soft key hash))) + (if (not fs) + nil + (vm-set-fs-modflag-of fs t) + (vm-check-for-killed-summary) + (if vm-folders-summary-buffer + (save-excursion + (set-buffer vm-folders-summary-buffer) + (vm-increment vm-modification-counter)))) + (if dont-descend + nil + (setq list (symbol-value (intern-soft key spool-hash))) + (while list + (vm-mark-for-folders-summary-update (car list) t) + (setq list (cdr list)))))) + +(defun vm-make-folders-summary-associative-hashes () + (let ((triples (vm-compute-spool-files t)) + (spool-hash (make-vector 61 0)) + (folder-hash (make-vector 61 0)) + s-list f-list folder-key spool-key) + (while triples + (setq folder-key (vm-make-folders-summary-key (car (car triples))) + spool-key (vm-make-folders-summary-key (nth 1 (car triples))) + s-list (symbol-value (intern-soft spool-key spool-hash)) + s-list (cons (car (car triples)) s-list) + f-list (symbol-value (intern-soft folder-key folder-hash)) + f-list (cons (nth 1 (car triples)) f-list) + triples (cdr triples)) + (set (intern spool-key spool-hash) s-list) + (set (intern folder-key folder-hash) f-list)) + (setq vm-folders-summary-spool-hash spool-hash) + (setq vm-folders-summary-folder-hash folder-hash))) + +(defun vm-follow-folders-summary-cursor () + (if (or (not (eq major-mode 'vm-folders-summary-mode)) + (null vm-folders-summary-hash)) + nil + (catch 'done + (mapatoms + (function + (lambda (sym) + (let ((fs (symbol-value sym))) + (if (and (>= (point) (vm-fs-start-of fs)) + (< (point) (vm-fs-end-of fs)) + (or (null vm-mail-buffer) + (not (eq vm-mail-buffer + (vm-get-file-buffer (vm-fs-folder-of fs)))))) + (progn + (setq vm-mail-buffer + (save-excursion + (vm-visit-folder (vm-fs-folder-of fs)) + (current-buffer))) + (vm-increment vm-modification-counter) + (vm-update-summary-and-mode-line) + (throw 'done t)))))) + vm-folders-summary-hash) + nil ))) + + +;;; vm-summary.el ends here diff --git a/lisp/vm-thread.el b/lisp/vm-thread.el new file mode 100755 index 0000000..bdb1ba5 --- /dev/null +++ b/lisp/vm-thread.el @@ -0,0 +1,1491 @@ +;;; vm-thread.el --- Thread support for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1994, 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; Copyright (C) 2010 Uday S. Reddy +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-thread) + +;; For function declarations + +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-motion) + (require 'vm-summary) + (require 'vm-sort) +) + +;; -------------------------------------------------------------------------- +;; Top-level operations +;; +;; vm-toggle-threads-display: interactive () -> none +;; vm-build-threads : (message list) -> none +;; vm-build-thread-lists : () -> none +;; vm-unthread-message-and-mirrors : (message &key +;; :message-changing bool) -> none +;; vm-unthread-message : (message &key +;; :message-changing bool) -> none +;; +;; vm-check-thread-integrity: (&optional message list) -> none +;; +;; vm-thread-mark-for-summary-update : message list -> none +;; +;; vm-parent: (message) -> message +;; vm-references: (message) -> string list +;; +;; vm-thread-symbol : (message) -> symbol +;; vm-thread-list : (message) -> symbol list +;; vm-thread-root : (message or symbol) -> message +;; vm-thread-root-sym : (message or symbol) -> symbol +;; vm-thread-root-p : (message) -> bool +;; vm-thread-indentation : (message) -> integer +;; vm-thread-subtree : (message or symbol) -> message list +;; vm-thread-count : (message or symbol) -> integer +;; vm-subject-symbol: (message) -> symbol +;; +;; The thread-obarray and thread-subject-obarray properties +;; +;; vm-th-thread-symbol: (message) -> symbol +;; vm-th-messages-of : symbol -> message list +;; vm-th-message-of : symbol -> message or nil +;; vm-th-children-of : symbol -> symbol list +;; vm-th-child-messages-of : symbol -> message list +;; vm-th-parent-of : symbol -> symbol +;; vm-th-date-of : symbol -> string +;; vm-th-youngest-date-of : symbol -> string +;; vm-th-oldest-date-of : symbol -> string +;; vm-th-oldest-subject-of : symbol -> string +;; vm-th-thread-date-of : symbol X criterion-symbol -> string +;; vm-th-canonical-message-p : message -> bool +;; vm-th-canonical-message: message -> message +;; vm-th-root : symbol -> message +;; +;; vm-th-new-thread-symbol: message -> symbol +;; vm-th-add-message-to-symbol: symbol X message -> void +;; vm-th-remove-message-from-symbol: symbol X message -> void +;; vm-th-init-thread-symbol: symbol X message -> void +;; vm-th-set-parent : symbol X symbol -> void +;; vm-th-add-child: symbol X symbol -> void +;; vm-th-delete-child: symbol X symbol -> void +;; +;; vm-th-clear-cached-data: symbol X symbol -> void +;; +;; +;; vm-ts-subject-symbol : symbol -> symbol +;; vm-ts-root-of : symbol -> symbol +;; vm-ts-root-date-of : symbol -> date +;; vm-ts-members-of : symbol -> symbol list +;; vm-ts-messages-of : symbol -> message list +;; vm-ts-set-root-of: symbol X symbol -> void +;; vm-ts-set-root-date-of: symbol X date -> void +;; vm-ts-set-members-of: symbol X symbol list -> void +;; vm-ts-set-messages-of: symbol X message list -> void +;; vm-ts-set: symbol X +;; (:root symbol :root-date date +;; :members symbol list :messages message list) -> void +;; +;; vm-ts-add-member: symbol X symbol -> void +;; vm-ts-add-message: symbol X message -> void +;; vm-ts-add-members: symbol X symbol list -> void +;; vm-ts-add-messages: symbol X message list -> void +;; +;; vm-ts-merge : symbol X symbol -> void +;; +;; vm-ts-clear-cached-data: symbol X symbol -> void +;; +;; vm-th-parent : message -> string +;; (aliased to vm-parent) +;; vm-th-references : message -> string list +;; (aliased to vm-references) +;; vm-th-thread-indentation : message -> integer +;; (aliased to vm-thread-indentation) +;; -------------------------------------------------------------------------- + +(if (fboundp 'define-error) + (define-error 'vm-thread-error "VM internal threading error") + (put 'vm-thread-error 'error-conditions + '(vm-thread-error error)) + (put 'vm-thread-error 'error-message "VM internal threading error") + ) + +(defun vm-trace-message-id () + (interactive) + (add-to-list 'vm-traced-message-ids (vm-su-message-id (vm-current-message))) + (message "%s" vm-traced-message-ids)) + +(defun vm-trace-message-subject () + (interactive) + (add-to-list 'vm-traced-message-subjects + (vm-so-sortable-subject (vm-current-message))) + (message "%s" vm-traced-message-subjects)) + +(defsubst vm-thread-debug (message &rest args) + (if (and vm-thread-debug vm-summary-show-threads (vectorp vm-thread-obarray)) + (apply 'debug message args))) + + +(defsubst vm-th-thread-symbol (m) + (intern (vm-su-message-id m) vm-thread-obarray)) + +(defsubst vm-th-youngest-date-of (id-sym) + (get id-sym 'youngest-date)) + +(defsubst vm-th-set-youngest-date-of (id-sym date) + (put id-sym 'youngest-date date)) + +(defsubst vm-th-oldest-date-of (id-sym) + (get id-sym 'oldest-date)) + +(defsubst vm-th-oldest-subject-of (id-sym) + (get id-sym 'oldest-subject)) + +(defsubst vm-th-set-oldest-date-of (id-sym date) + (put id-sym 'oldest-date date)) + +(defsubst vm-th-set-oldest-subject-of (id-sym subject) + (put id-sym 'oldest-subject subject)) + +(defsubst vm-th-thread-date-of (id-sym criterion) + "For the message with the interned symbol ID-SYM, return the +youngest or oldest date in its thread. CRITERION must be one of +'youngest-date and 'oldest-date" + (get id-sym criterion)) + +(defsubst vm-th-message-of (id-sym) + (and (boundp id-sym) (symbol-value id-sym))) + +(defsubst vm-th-set-message-of (id-sym m) + (set id-sym m)) + +(defsubst vm-th-messages-of (id-sym) + (get id-sym 'messages)) + +(defsubst vm-th-canonical-message-p (m) + (eq m (vm-th-message-of (vm-th-thread-symbol m)))) + +(defsubst vm-th-canonical-message (m) + (vm-th-message-of (vm-th-thread-symbol m))) + +;; (defsubst vm-th-message (id-sym) +;; (and (vm-th-messages-of id-sym) +;; (vm-last-elem (vm-th-messages-of id-sym)))) + +(defsubst vm-th-set-messages-of (id-sym ml) + (put id-sym 'messages ml)) + +(defsubst vm-th-parent-of (id-sym) + (get id-sym 'parent)) + +(defsubst vm-th-set-parent-of (id-sym p-sym) + ;; For safety, set the symbol-value to nil + (unless (boundp id-sym) + (set id-sym nil)) + (put id-sym 'parent p-sym)) + +(defsubst vm-th-children-of (id-sym) + (get id-sym 'children)) + +(defun vm-th-visible-children-of (id-sym) + (let ((kids (vm-th-children-of id-sym)) + (result nil)) + (while kids + (if (vm-th-message-of (car kids)) + (setq result (cons (car kids) result) + kids (cdr kids)) + (setq kids (append (vm-th-children-of (car kids)) (cdr kids))))) + (nreverse result))) + +(defun vm-th-child-messages-of (id-sym) + (let ((kids (vm-th-children-of id-sym)) + (result nil) + m) + (while kids + (setq m (vm-th-message-of (car kids))) + (if m + (setq result (cons m result))) + (setq kids (cdr kids))) + (nreverse result))) + +(defsubst vm-th-set-children-of (id-sym ml) + (put id-sym 'children ml)) + +(defun vm-th-add-child (parent-sym id-sym) + (if (member (symbol-name id-sym) (car vm-traced-message-ids)) + (vm-thread-debug 'vm-th-add-child id-sym)) + (unless (member id-sym (vm-th-children-of parent-sym)) + (vm-th-set-children-of + parent-sym (cons id-sym (vm-th-children-of parent-sym))))) + +(defun vm-th-delete-child (parent-sym id-sym) + (if (member (symbol-name id-sym) (car vm-traced-message-ids) ) + (vm-thread-debug 'vm-th-delete-child id-sym)) + (let ((kids (vm-th-children-of parent-sym))) + (vm-th-set-children-of parent-sym (remq id-sym kids)))) + +(defsubst vm-th-date-of (id-sym) + (get id-sym 'date)) + +(defsubst vm-th-set-date-of (id-sym date) + (put id-sym 'date date)) + +(defun vm-ts-subject-symbol (id-sym) + ;; the subject symbol is calculated from the oldest-subject field + ;; stored in the reference root of ID-SYM. + ;; if there is no such field exists, then nil is returned. + (if (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-ts-subject-symbol id-sym)) + (let ((sym id-sym) + parent subject) + (while (setq parent (vm-th-parent-of sym)) + (setq sym parent)) + (if (setq subject (vm-th-oldest-subject-of sym)) + (intern subject vm-thread-subject-obarray)))) + +(defsubst vm-ts-root-of (subject-sym) + (aref (symbol-value subject-sym) 0)) + +(defsubst vm-ts-root-date-of (subject-sym) + (aref (symbol-value subject-sym) 1)) + +(defsubst vm-ts-members-of (subject-sym) + (aref (symbol-value subject-sym) 2)) + +(defsubst vm-ts-messages-of (subject-sym) + (aref (symbol-value subject-sym) 3)) + +(defsubst vm-ts-set-root-of (subject-sym id-sym) + (aset (symbol-value subject-sym) 0 id-sym)) + +(defsubst vm-ts-set-root-date-of (subject-sym date) + (aset (symbol-value subject-sym) 1 date)) + +(defsubst vm-ts-set-members-of (subject-sym ml) + (aset (symbol-value subject-sym) 2 ml)) + +(defsubst vm-ts-set-messages-of (subject-sym ml) + (aset (symbol-value subject-sym) 3 ml)) + +(defun* vm-ts-set (subject-sym &key root root-date members messages) + (let ((vec (symbol-value subject-sym))) + (aset vec 0 root) + (aset vec 1 root-date) + (aset vec 2 members) + (aset vec 3 messages))) + +;;;###autoload +(defun vm-thread-symbol (m) + "Returns the interned symbol of message M which carries the +threading information. Threads should have been built before this. +Otherwise nil is returned." + (with-current-buffer (vm-buffer-of m) + (and (vectorp vm-thread-obarray) + (intern (vm-su-message-id m) vm-thread-obarray)))) + +;;;###autoload +(defun vm-subject-symbol (m) + "Returns the interned symbol of message M which carries the +subject-based threading information. Threads should have been built +before this. Otherwise nil is returned." + (with-current-buffer (vm-buffer-of m) + (vm-ts-subject-symbol (vm-th-thread-symbol m)))) + +;; Integrity constraints for reference threads + +;; MESSAGES: +;; The messages field of id-sym points to all known messages with +;; this id. +;; MESSAGE: +;; The message field of id-sym points to the canonical +;; message with this id, which must be the first in the messages +;; field. +;; DATE: +;; The date field of id-sym contains the date of the canonical +;; message with this id. +;; BASIC: +;; MESSAGES /\ MESSAGE /\ DATE +;; PARENT: +;; The parent field of id-sym contains the interned id of the +;; parent of the message, and the parent's children field contains +;; this id-sym. +;; CHILDREN: +;; The children field of id-sym contains the interned id's of all +;; the known children of the message. +;; LINKS: +;; PARENT /\ CHILDREN +;; YOUNGEST: +;; The youngest-date of id-sym contains the date of the youngest +;; message in the subthread rooted in this id. +;; OLDEST: +;; The oldest-date and oldest-subject of id-sym contain the date +;; and the subject (resp.) of the oldest +;; message in the thread containing this id. +;; DATES: +;; YOUNGEST /\ OLDEST +;; NODE: +;; BASIC /\ LINKS /\ DATES + +;; Integrity constraints for subject threads + +;; TS-ROOT: +;; The root of the subject symbol is the id of the canonical message of +;; the oldest message with the subject. +;; TS-DATE: +;; The date field of the subject symbol is the date of the root +;; message. +;; TS-MEMBERS: +;; The members field of the subject symbol contains all known +;; "members" of the subject thread, except for the root. +;; "Member" means the root of a reference thread with the given +;; subject. (The descendants may have different subject lines.) +;; TS-MESSAGES: +;; The messages field of the subject symbol is the list of all +;; the messages in the folder with this subject. (What about +;; descendant of a member that may have a different subject line?) + +;; Cached information + +;; SUBTREE: +;; The subtree fields of all the messages with the id contain the +;; subtrees rooted at that node (as recorded in the threads database). +;; LIST: +;; The thread-list fields of all the messages with the id contain +;; the thread-list above that node (as recorded in the threads database). +;; INDENTATION: +;; The thread-indentation field of all the messages with the id +;; store the length of the thread-list. +;; DISPLAY +;; The summary display shows the thread-indentation value. +;; SUBTREE0, LIST0, INDENTATION0 +;; Above properties hold only if the corresponding fields are +;; non-nil. +;; DISPLAY0: +;; If the message is not scheduled for summary-update then its +;; summary display shows the thread-indentation value. +;; CACHE: +;; SUBTREE /\ LIST /\ INDENTATION /\ DISPLAY +;; CACHE0: +;; SUBTREE0 /\ LIST0 /\ INDENTATION0 /\ DISPLAY0 + +;;; thread tree - basic operations + +(defun vm-th-new-thread-symbol (m) + "Create a new thread symbol for message M and intitialize its parent +and child pointers." + (let ((id-sym (vm-th-thread-symbol m))) + (vm-th-set-parent-of id-sym nil) + (vm-th-set-children-of id-sym nil) + id-sym)) + +(defsubst vm-th-add-message-to-symbol (id-sym m) + "Add message M to ID-SYM as one of the messages with its id." + ;; requires: BASIC and messages /= nil + ;; ensures: BASIC + (unless (memq m (vm-th-messages-of id-sym)) + (vm-th-set-messages-of id-sym (cons m (vm-th-messages-of id-sym))))) + +(defsubst vm-th-remove-message-from-symbol (id-sym m) + "Delete message M from ID-SYM as one of the messages with its id." + ;; requires: BASIC and m in messages + ;; ensures: BASIC + (vm-th-set-messages-of id-sym (remq m (vm-th-messages-of id-sym))) + (if (eq m (vm-th-message-of id-sym)) + (vm-th-set-message-of id-sym (car (vm-th-messages-of id-sym))))) + +(defsubst vm-th-init-thread-symbol (id-sym m) + "Initialize thread symbol ID-SYM to the message M." + ;; requires: true + ;; ensures: BASIC + (vm-th-set-message-of id-sym m) + (vm-th-set-messages-of id-sym (list m)) + (vm-th-set-date-of id-sym (vm-so-sortable-datestring m))) + +(defsubst vm-th-set-parent (id-sym parent-sym) + "Set the parent of ID-SYM to PARENT-SYM." + ;; requires: BASIC + ;; ensures: BASIC /\ PARENT + (vm-th-set-parent-of id-sym parent-sym) + (vm-th-add-child parent-sym id-sym)) + +(defsubst vm-th-clear-cached-data (id-sym parent-sym) + "Clear the cached thread-subtree and thread-list information that is +invalidated by setting the parent of ID-SYM to PARENT-SYM. This +involves the thread-subtrees of PARENT-SYM and all its ancestors. +It also invovles thread-lists of ID-SYM and all its descendants." + ;; ensures: SUBTREE0(ancestors(parent-sym)), LIST0(descendents(id-sym)) + (vm-th-clear-subtree parent-sym) + (vm-th-clear-thread-lists id-sym)) + +(defsubst vm-ts-add-member (subject-sym id-sym) + "Add ID-SYM as a member of SUBJECT-SYM." + ;; ensures: TS-MEMBERS(subject-sym) + (unless (memq id-sym (vm-ts-members-of subject-sym)) + (vm-ts-set-members-of + subject-sym (cons id-sym (vm-ts-members-of subject-sym))))) + +(defun vm-ts-add-members (subject-sym id-sym-list) + "Add all the elements of ID-SYM-LIST as members of SUBJECT-SYM" + (mapc (lambda (id-sym) (vm-ts-add-member subject-sym id-sym)) + id-sym-list)) + +(defsubst vm-ts-add-message (subject-sym m) + "Add M as a message in the subject thread of SUBJECT-SYM." + ;; ensures: TS-MESSAGES(subject-sym) + (vm-ts-set-messages-of + subject-sym (cons m (vm-ts-messages-of subject-sym)))) + +(defun vm-ts-add-messages (subject-sym m-list) + "Add all the elements of M-LIST to the subject thread of SUBJECT-SYM" + (mapc (lambda (m) (vm-ts-add-message subject-sym m)) + m-list)) + +(defun vm-ts-merge (subject-sym other-sym) + "Merge subject symbol OTHER-SYM into SUBJECT-SYM and destroy OTHER-SYM." + (let ((subject-root (vm-ts-root-of subject-sym)) + (other-root (vm-ts-root-of other-sym))) + (vm-th-clear-cached-data subject-root subject-root) + (vm-th-clear-cached-data other-root other-root) + (if (string< (vm-ts-root-date-of subject-sym) + (vm-ts-root-date-of other-sym)) + ;; subject-sym is older; merge other-sym + (progn + (vm-ts-add-members subject-sym (cons other-root + (vm-ts-members-of other-sym))) + (vm-ts-add-messages subject-sym (vm-ts-messages-of other-sym))) + ;; other-sym is older; copy it into subject-sym + (vm-ts-add-member subject-sym subject-root) + (vm-ts-set-root-of subject-sym other-root) + (vm-ts-set-root-date-of subject-sym (vm-ts-root-date-of other-sym)) + (vm-ts-add-members subject-sym (vm-ts-members-of other-sym)) + (vm-ts-add-messages subject-sym (vm-ts-messages-of other-sym))) + ;; destroy other-sym + (makunbound other-sym) + ;; ---------------- atomic block ----------------------- + (let ((inhibit-quit nil)) + (mapc (lambda (c-sym) + (vm-thread-mark-for-summary-update + (vm-th-messages-of c-sym))) + (vm-ts-members-of subject-sym))) + ;; -------------- end atomic block --------------------- + )) + +(defsubst vm-ts-clear-cached-data (id-sym subject-sym) + "Clear the cached thread-subtree and thread-list information +for ID-SYM, which is the subject root of SUBJECT-SYM. This +involves clearing the thread-subtree of ID-SYM and the +thread-lists of all members of SUBJEC-SYM. (not entirely clear if this +is right). USR, 2011-04-08" + ;; ensures: SUBTREE0(ancestors(id-sym)) /\ + ;; LIST0(descendants(members(subject-sym))) + (vm-th-clear-subtree id-sym) + (mapc 'vm-th-clear-thread-lists + (vm-ts-members-of subject-sym))) + + +;;;###autoload +(defun vm-toggle-threads-display () + "Toggle the threads display on and off. +When the threads display is on, the folder will be sorted by +thread activity and thread indentation (via the %I summary format +specifier) will be visible." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + ;; get numbering of new messages done now + ;; so that the sort code only has to worry about the + ;; changes it needs to make. + (vm-update-summary-and-mode-line) + (vm-set-summary-redo-start-point t) + (setq vm-summary-show-threads (not vm-summary-show-threads)) + ;; Toggle between "physical-order" and "activity" sort-keys. + ;; This would have been better if vm-ml-sort-keys was a list of + ;; sort-keys, but it is a string and this is a quick fix. + (cond ((equal vm-ml-sort-keys "physical-order") + (setq vm-ml-sort-keys "activity")) + ((equal vm-ml-sort-keys "activity") + (setq vm-ml-sort-keys "physical-order")) + ((equal vm-ml-sort-keys "reversed-physical-order") + (setq vm-ml-sort-keys "reversed-activity")) + ((equal vm-ml-sort-keys "reversed-activity") + (setq vm-ml-sort-keys "reversed-physical-order"))) + (if vm-summary-show-threads + (vm-sort-messages (or vm-ml-sort-keys "activity")) + (vm-sort-messages (or vm-ml-sort-keys "physical-order")))) + +;;;###autoload +(defun vm-promote-subthread (n) + "Decrease the thread indentation of the current message and its +subthread by $N$ steps (provided as a prefix argument). + +The case $N$ being 0 is a special case. It means to decrease the +indentation all the way to 0." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((modified (buffer-modified-p)) + (msg (car vm-message-pointer)) + (indent 0)) + (if (= n 0) ; special case, set to 0 + (let ((indent (or (vm-thread-indentation-of msg) 0))) + (mapc (lambda (m) + (vm-set-thread-indentation-offset-of m (- indent))) + (vm-thread-subtree msg))) + (mapc (lambda (m) + (vm-set-thread-indentation-offset-of + m (- (or (vm-thread-indentation-offset-of m) 0) + n))) + (vm-thread-subtree msg))) + (vm-thread-mark-for-summary-update (list msg)) + (vm-update-summary-and-mode-line))) + +;;;###autoload +(defun vm-demote-subthread (n) + "Increase the thread indentation of the current message and its +subthread by $N$ steps (provided as a prefix argument). + +The case $N$ being 0 is a special case. It means to reset the +indentation back to the normal indentation, i.e., no offset is used." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((modified (buffer-modified-p)) + (msg (car vm-message-pointer))) + (if (= n 0) + (mapc (lambda (m) (vm-set-thread-indentation-offset-of m 0)) + (vm-thread-subtree msg)) + (mapc (lambda (m) + (vm-set-thread-indentation-offset-of + m (+ (or (vm-thread-indentation-offset-of m) 0) n))) + (vm-thread-subtree msg))) + (vm-thread-mark-for-summary-update (list msg)) + (vm-update-summary-and-mode-line))) + +;; Dependency of threading information +;; +;; parent & children -> thread-list -> thread-indentation +;; | +;; |--> thread-subtree + +;;;###autoload +(defun vm-build-threads (message-list) + "For all messages in MESSAGE-LIST, build thread information in the +`vm-thread-obarray' and `vm-thread-subject-obarray'. If MESSAGE-LIST +is nil, do it for all the messages in the folder. USR, 2010-07-15" + (let ((initializing (not (vectorp vm-thread-obarray))) + (mp (or message-list vm-message-list)) + (n 0) + ;; Just for laughs, make the update interval vary. + (modulus (+ (% (vm-abs (random)) 11) 40)) + ;; no need to schedule reindents of reparented messages + ;; unless there were already messages present. + (schedule-reindents message-list) + m parent parent-sym id id-sym date refs old-parent-sym) + (when initializing + (setq vm-thread-obarray (make-vector 641 0) + vm-thread-subject-obarray (make-vector 641 0))) + ;; Build threads using references + (vm-build-reference-threads mp schedule-reindents initializing) + ;; Record thread dates and subjects + (vm-record-thread-dates mp) + ;; Build threads using subject + (when vm-thread-using-subject + (vm-build-subject-threads mp schedule-reindents initializing)) + ;; Calculate thread-subtrees for all the known message ID's + (mapatoms + (lambda (id-sym) + (when (vm-th-message-of id-sym) + (vm-thread-subtree id-sym))) + vm-thread-obarray) + (when (> n modulus) + (vm-inform 6 "Building threads... done")))) + +(defun vm-build-reference-threads (mlist schedule-reindents initializing) + "Build reference threads for all the messages in MLIST. If threads are +already built, then just insert these messages into the threads +database. + +If SCHEDULE-REINDENTS is non-nil, then ask for the summary lines of +all affected messages to be updated. + +If INITIALIZING is non-nil, then assume that the threads database is +being initialized." + (let ((n 0) + (mp mlist) + modulus total + m parent parent-sym id id-sym date refs old-parent-sym) + (setq total (* 2 (length mlist))) + (setq modulus (max 10 (/ (length mlist) 50))) + (while mp + (setq m (car mp) + id (vm-su-message-id m) + id-sym (intern-soft id vm-thread-obarray)) + (if (member id vm-traced-message-ids) + (vm-thread-debug 'vm-build-reference-threads id m)) + (unless id-sym ; first occurrence now + (setq id-sym (vm-th-new-thread-symbol m))) + ;; { BASIC0(id-sym) } + (if (vm-th-messages-of id-sym) ; registered already + (vm-th-add-message-to-symbol id-sym m) + (vm-th-init-thread-symbol id-sym m)) + ;; { BASIC /\ DISPLAY0 (id-sym) } + (when schedule-reindents + (vm-thread-mark-for-summary-update (list m))) + ;; { BASIC /\ DISPLAY0 (id-sym) } + ;; Thread using the parent + (setq parent (vm-parent m)) + (if (null parent) + ;; {NODE /\ DISPLAY0 (id-sym)} + ;; could be a duplicate copy of a message + (unless initializing + (vm-th-clear-subtree id-sym)) + ;; {NODE /\ SUBTREE0 /\ DISPLAY0 (id-sym)} + ;; {NODE /\ SUBTREE0 /\ LIST0 /\ INDENTATION0 /\ DISPLAY0 (id-sym)} + (setq parent-sym (intern parent vm-thread-obarray)) + ;; set the parent of m. + ;; if there was a parent already, update it consistently. + (if (not (vm-th-safe-parent-p id-sym parent-sym)) + (vm-inform 10 "Unsafe thread parent detected for %s: %s" + (symbol-name id-sym) (symbol-name parent-sym)) + (if (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-build-reference-threads-1 id-sym)) + (cond ((null (vm-th-parent-of id-sym)) + ;; {BASIC /\ LINKS0 /\ DISPLAY0 (id-sym)} + (unless initializing + (vm-th-clear-cached-data id-sym parent-sym)) + (vm-th-set-parent id-sym parent-sym)) + ((eq (vm-th-parent-of id-sym) parent-sym) + ;; could be a duplicate copy of a message + (unless initializing + (vm-th-clear-subtree id-sym)) + (when schedule-reindents + (vm-thread-mark-for-summary-update + (vm-th-messages-of parent-sym)))) + (t + (setq old-parent-sym (vm-th-parent-of id-sym)) + (unless initializing + (vm-th-clear-subtree old-parent-sym) + (vm-th-clear-cached-data id-sym parent-sym)) + (vm-th-delete-child old-parent-sym id-sym) + (vm-th-set-parent id-sym parent-sym) + (when schedule-reindents + (vm-thread-mark-for-summary-update + (vm-th-messages-of id-sym)) + (if (vm-th-message-of old-parent-sym) + (vm-mark-for-summary-update + (vm-th-message-of old-parent-sym)) + (vm-thread-debug 'vm-build-reference-threads + 'old-parent-sym old-parent-sym) + )))))) + ;; { NODE /\ CACHE0 (id-sym) } + (setq mp (cdr mp) n (1+ n)) + (if (zerop (% n modulus)) + (vm-inform 7 "Building threads... %d%%" (* (/ (+ n 0.0) total) 100)))) + + ;; use the References header to set parenting information + ;; for ancestors of this message. This does not override + ;; a parent pointer for a message if it already exists. + (setq mp mlist) + (while mp + (setq m (car mp) + id (vm-su-message-id m)) + (if (member id vm-traced-message-ids) + (vm-thread-debug 'vm-build-reference-threads-2 m)) + (if (cdr (setq refs (vm-references m))) + (let (parent-sym id-sym msgs msg-syms) + (setq parent-sym (intern (car refs) vm-thread-obarray) + refs (cdr refs)) + (while refs + (setq id-sym (intern (car refs) vm-thread-obarray)) + (when (null (vm-th-parent-of id-sym)) + (if (not (vm-th-safe-parent-p id-sym parent-sym)) + (vm-inform 10 "Unsafe reference parent detected for %s: %s" + (symbol-name id-sym) (symbol-name parent-sym)) + (if (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-build-reference-threads-2 id-sym)) + (unless initializing + (vm-th-clear-cached-data id-sym parent-sym)) + (vm-th-set-parent id-sym parent-sym) + (if schedule-reindents + (vm-thread-mark-for-summary-update + (vm-th-messages-of id-sym))))) + (setq parent-sym id-sym + refs (cdr refs))))) + (setq mp (cdr mp) n (1+ n)) + (if (zerop (% n modulus)) + (vm-inform 7 "Building threads... %d%%" (* (/ (+ n 0.0) total) 100))) + ))) + +(defun vm-th-clear-thread-lists (id-sym) + "Clear the thread-list and thread-indentation fields of the +message with ID-SYM and all its descendants." + ;; requires: BASIC /\ LINKS (descendants(id-sym)) + ;; ensures: LIST0 /\ INDENTATION0 (descendants(id-sym)) + (mapc (lambda (d) + (vm-set-thread-list-of d nil) + (vm-set-thread-indentation-of d nil)) + (vm-th-messages-of id-sym)) + (mapc 'vm-th-clear-thread-lists + (vm-th-children-of id-sym))) + +(defun vm-th-clear-subtree-of (id-sym) + "Clear the thread-subtrees of the messages with ID-SYM, i.e., +set them to nil. They will get recalculated on demand." + ;; (when (vm-th-message-of id-sym) + ;; (vm-set-thread-subtree-of (vm-th-message-of id-sym) nil)) + (mapc (lambda (m) + (vm-set-thread-subtree-of m nil)) + (vm-th-messages-of id-sym)) + ) + +(defun vm-th-clear-subtree (id-sym) + "Clear the thread subtrees of the messages with id-symbol ID-SYM and +all its ancestors, followed via the parent links." + ;; requires: BASIC /\ LINKS (ancestors(id-sym)) + ;; ensures: TREE0(ancestors(id-sym)) + (let ((msg (vm-th-message-of id-sym)) + subject subject-sym) + (vm-th-clear-subtree-of id-sym) + (while (vm-th-parent-of id-sym) + (setq id-sym (vm-th-parent-of id-sym)) + (vm-th-clear-subtree-of id-sym) + (when (vm-th-message-of id-sym) + (setq msg (vm-th-message-of id-sym)))) + ;; msg is now the reference root of id-sym + (when msg + (setq subject-sym (vm-ts-subject-symbol (vm-th-thread-symbol msg))) + (when (and subject-sym (boundp subject-sym)) + (setq id-sym (vm-ts-root-of subject-sym)) + (vm-th-clear-subtree-of id-sym))))) + +(defun vm-th-safe-parent-p (id-sym parent-sym) + "Check if it is safe to set the parent of ID-SYM to PARENT-SYM." + ;; Check to make sure that ID-SYM is not an ancestor of PARENT-SYM + (if (or (member (symbol-name id-sym) vm-traced-message-ids) + (member (symbol-name parent-sym) vm-traced-message-ids)) + (vm-thread-debug 'vm-thread-safe-parent-p id-sym parent-sym)) + (let ((ancestor parent-sym)) + (catch 'return + (while ancestor + (when (eq ancestor id-sym) + (throw 'return nil)) + (setq ancestor (vm-th-parent-of ancestor))) + t))) + +(defun vm-th-belongs-to-reference-thread (id-sym) + "Check if ID-SYM is the symbol of a message in a reference thread +with other ancestors." + (let ((parent (vm-th-parent-of id-sym))) + (catch 'return + (while parent + (if (vm-th-messages-of parent) + (throw 'return t) + (setq parent (vm-th-parent-of parent)))) + nil))) + +(defun vm-th-root (id-sym) + "Return the reference-thread root message of ID-SYM; nil is returned + in the special case ID-SYM doesn't have any messages or ancestors." + (let ((parent (vm-th-parent-of id-sym)) + (root (vm-th-message-of id-sym))) + (while parent + (when (vm-th-messages-of parent) + (setq root (vm-th-message-of parent))) + (setq parent (vm-th-parent-of parent))) + root)) + +(defun vm-build-subject-threads (mp schedule-reindents initializing) + (let ((n 0) + (modulus 10) + m id id-sym date + subject subject-sym) + (while mp + (setq m (car mp) + id (vm-su-message-id m) + id-sym (vm-th-thread-symbol m) + date (vm-so-sortable-datestring m)) + (when (member id vm-traced-message-ids) + (vm-thread-debug 'vm-build-subject-threads id m)) + ;; Use the reference root's oldest-subject, which should be + ;; defined by now + (setq subject-sym (vm-ts-subject-symbol id-sym) + subject (symbol-name subject-sym)) + (when (member subject vm-traced-message-subjects) + (vm-thread-debug 'vm-build-subject-threads id m)) + ;; -------------- atomic block ------------------------------- + (let* ((inhibit-quit t)) + ;; if this subject was never seen before create the + ;; information vector. + (if (not (boundp subject-sym)) + ;; new subject + (set subject-sym (vector id-sym date nil (list m))) + ;; this subject seen before + (vm-ts-add-message subject-sym m) + (cond + ;; duplicate copy of the ts-root + ((eq id-sym (vm-ts-root-of subject-sym)) + (vm-th-clear-subtree (vm-ts-root-of subject-sym))) + ;; if older than the ts-root, make it the root + ((string< date (vm-ts-root-date-of subject-sym)) + (let* ((i-sym (vm-ts-root-of subject-sym))) + (unless initializing + (vm-ts-clear-cached-data i-sym subject-sym)) + (unless (vm-th-belongs-to-reference-thread i-sym) + ;; strange. why would i-sym ever be in a ref thread? + (vm-ts-add-member subject-sym i-sym)) + (vm-ts-set-root-of subject-sym id-sym) + (vm-ts-set-root-date-of subject-sym date) + ;; this loops _and_ recurses and I'm worried + ;; about it going into a spin someday. So I + ;; unblock interrupts here. It's not critical + ;; that it finish... the summary will just be out + ;; of sync. + (when schedule-reindents + (let ((inhibit-quit nil)) + ;; there might be need for vm-th-clear-subtree here + (vm-thread-mark-for-summary-update + (vm-ts-messages-of subject-sym)))))) + ;; newer than the ts-root + (t + (unless (vm-th-belongs-to-reference-thread id-sym) + (vm-th-clear-subtree (vm-ts-root-of subject-sym)) + ;; no need to clear thread-lists; ts-root is unchanged + (vm-ts-add-member subject-sym id-sym)))))) + ;; -------------- end atomic block ---------------------------------- + (setq mp (cdr mp) n (1+ n)) + (when (zerop (% n modulus)) + (vm-inform 7 "Building threads... %d" n))))) + +;; used by the thread sort code. +;; +;; vm-thread-list initializes the oldest-date property on +;; the message-id symbols. Since this property is used as an +;; ordering key by the thread sort the oldest-date properties +;; must be computed before the sort begins, not during it. +;; Otherwise the sort won't be stable and there will be chaos. + +;;;###autoload +(defun vm-build-thread-lists () + "Fill in the thread-list fields of the Soft data vector for all +messages in the folder. Threads should have been built before this +function is called." + ;; (if vm-thread-debug + ;; (vm-check-thread-integrity vm-message-list)) + (dolist (m vm-message-list) + (vm-thread-list m)) + (if vm-thread-debug + (vm-check-thread-integrity vm-message-list))) + +;;;###autoload +(defun vm-thread-mark-for-summary-update (message-list) + "Mark the messages in MESSAGE-LIST and all their descendants for +summary update. This function does not depend on cached +thread-subtrees. USR, 2011-04-03" + ;; requires: BASIC /\ LINKS (descendants(message-list)) + ;; ensures: LIST0 /\ INDENTATION0 /\ DISPLAY0 (descendants(message-list)) + (mapc (lambda (m) + ;; if thread-list is null then we've already marked this + ;; message, or it doesn't need marking. + (if (null (vm-thread-list-of m)) + nil + (vm-mark-for-summary-update m t) + (vm-set-thread-list-of m nil) + (vm-set-thread-indentation-of m nil) + (vm-thread-mark-for-summary-update + (vm-th-child-messages-of (vm-thread-symbol m))))) + message-list)) + +(defun vm-record-thread-dates (mlist) + "Returns date and subject of all messages in MLIST in the oldest-date, +youngest-date and oldest-subject fields of all their ancestors. The +oldest-subject field is only updated for reference-based ancestors, +whereas dates are updated for both reference and subject-based ancestors." + (dolist (m mlist) + (let ((done nil) + (subject-thread nil) + (loop-recovery-point nil) + (date (vm-so-sortable-datestring m)) + (subject (vm-so-sortable-subject m)) + id-sym subject-sym loop-sym + root-date root-subject youngest-date + root) + (with-current-buffer (vm-buffer-of m) + ;; thread trees do not have loops any more, but better to be + ;; safe than sorry. USR, 2011-05-13 + (fillarray vm-thread-loop-obarray 0) + (setq id-sym (vm-th-thread-symbol m)) + (when (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-record-thread-dates id-sym)) + (set (intern (symbol-name id-sym) vm-thread-loop-obarray) t) + (while (not done) + ;; save the date of the oldest message in this thread + (setq root-date (vm-th-oldest-date-of id-sym)) + (setq root-subject (vm-th-oldest-subject-of id-sym)) + (when (or (null root-date) (string< date root-date)) + (vm-th-set-oldest-date-of id-sym date) + (unless subject-thread + (vm-th-set-oldest-subject-of id-sym subject))) + ;; save the date of the youngest message in this thread + (setq youngest-date (vm-th-youngest-date-of id-sym)) + (when (or (null root-date) (string< youngest-date date)) + (vm-th-set-youngest-date-of id-sym date)) + (cond ((vm-th-parent-of id-sym) + (setq id-sym (vm-th-parent-of id-sym) + loop-sym (intern (symbol-name id-sym) + vm-thread-loop-obarray)) + (if (boundp loop-sym) + ;; loop detected, bail... + (setq done t) + (set loop-sym t) + (when (vm-th-messages-of id-sym) + (setq m (vm-th-message-of id-sym))))) + ((null m) ; why this? USR, 2011-09-24 + (setq done t)) + ((null vm-thread-using-subject) + (setq done t)) + ((and (setq subject-sym + (vm-ts-subject-symbol (vm-th-thread-symbol m))) + (or (not (boundp subject-sym)) + (and (eq (vm-ts-root-of subject-sym) + (vm-th-thread-symbol m))))) + (setq done t)) + (t + (setq subject-thread t) + (setq id-sym (vm-ts-root-of subject-sym)) + (setq loop-sym (intern (symbol-name id-sym) + vm-thread-loop-obarray)) + (if (boundp loop-sym) + ;; loop detected, bail... + (setq done t) + (setq root (vm-th-message-of id-sym)) + (set loop-sym t) + (setq m (vm-th-message-of id-sym)))))) + )))) + +(defun vm-build-thread-list (message) + "Returns the thread-list, i.e., the lineage of MESSAGE, as a list of +symbols interned in vm-thread-obarray." + (if (null message) + (vm-thread-debug 'vm-build-thread-list-null) + (let ((done nil) + (loop-recovery-point nil) + (date (vm-so-sortable-datestring message)) + (subject (vm-so-sortable-subject message)) + m thread-list id-sym subject-sym loop-sym + root-date root-subject youngest-date + root ancestors) + (setq m message) + (with-current-buffer (vm-buffer-of m) + ;; thread trees do not have loops any more, but better to be + ;; safe than sorry. USR, 2011-05-13 + (fillarray vm-thread-loop-obarray 0) + (setq id-sym (vm-th-thread-symbol m) + thread-list (list id-sym)) + (when (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-build-thread-list id-sym)) + ;; if m is a non-canonical message for its message ID, give it + ;; an artificial thread-list + ;; But, does this make sense? + ;; (unless (eq m (vm-th-message-of id-sym)) + ;; (setq thread-list (list id-sym id-sym)) + ;; (setq done t)) + (set (intern (symbol-name id-sym) vm-thread-loop-obarray) t) + (while (not done) + ;; save the date of the oldest message in this thread + (setq root-date (vm-th-oldest-date-of id-sym)) + (setq root-subject (vm-th-oldest-subject-of id-sym)) + (when (or (null root-date) + (string< date root-date)) + (vm-th-set-oldest-date-of id-sym date) + (vm-th-set-oldest-subject-of id-sym subject)) + ;; save the date of the youngest message in this thread + (setq youngest-date (vm-th-youngest-date-of id-sym)) + (when (or (null root-date) + (string< youngest-date date)) + (vm-th-set-youngest-date-of id-sym date)) + (cond ((vm-th-parent-of id-sym) + (setq id-sym (vm-th-parent-of id-sym) + loop-sym (intern (symbol-name id-sym) + vm-thread-loop-obarray)) + (if (boundp loop-sym) + ;; loop detected, bail... + (setq done t + thread-list (or loop-recovery-point thread-list)) + (set loop-sym t) + (setq thread-list (cons id-sym thread-list)) + (when (vm-th-messages-of id-sym) + (setq m (vm-th-message-of id-sym))))) + ((null m) + (setq done t)) + ((null vm-thread-using-subject) + (setq done t)) + ((and (setq subject-sym + (vm-ts-subject-symbol (vm-th-thread-symbol m))) + (or (not (boundp subject-sym)) + (and (eq (vm-ts-root-of subject-sym) + (vm-th-thread-symbol m))))) + (setq done t)) + (t + (setq id-sym (vm-ts-root-of subject-sym)) + ;; seems to cause more trouble than it fixes + ;; revisit this later. + ;; (setq loop-recovery-point (or loop-recovery-point + ;; thread-list)) + (setq loop-sym (intern (symbol-name id-sym) + vm-thread-loop-obarray)) + (if (boundp loop-sym) + ;; loop detected, bail... + (setq done t + thread-list (or loop-recovery-point thread-list)) + (setq root (vm-th-message-of id-sym)) + ;; the ancestors of id-sym will be added. + ;; remove them if they were already added. + (setq ancestors (remq id-sym (vm-thread-list root))) + (mapc (lambda (a) + (setq thread-list (remq a thread-list)) + (makunbound (intern (symbol-name a) + vm-thread-loop-obarray))) + ancestors) + (set loop-sym t) + (setq thread-list (cons id-sym thread-list) + m (vm-th-message-of id-sym)))))) + thread-list )))) + +;; remove message struct from thread data. +;; +;; optional second arg non-nil means forget information that +;; might be different if the message contents changed. +;; +;; message must be a real (non-virtual) message + +;;;###autoload +(defun* vm-unthread-message-and-mirrors (message &key message-changing) + "Removes MESSAGE and all its mirrored messages from their +current threads. If optional argument MESSAGE-CHANGING is +non-nil, then forget information that might be different if the +message contents changed. + +MESSAGE should be a real (non-virtual) message. + +The full functionality of this function is not entirely clear. + USR, 2010-07-24" + (save-current-buffer + (mapc + (lambda (m) + ;; Don't trust blindly. The user could have killed some of + ;; these buffers. + (when (buffer-name (vm-buffer-of m)) + (set-buffer (vm-buffer-of m)) + (when (vectorp vm-thread-obarray) + (vm-unthread-message + m :message-changing message-changing)))) + (cons message (vm-virtual-messages-of message))))) + +;;;###autoload +(defun* vm-unthread-message (m &key message-changing) + "Removes message M from its thread. If optional argument +MESSAGE-CHANGING is non-nil, then forget information that might +be different if the message contents changed. The message will be +reinserted into an appropriate thread later. USR, 2011-03-17" + (let (date subject id-sym s-sym p-sym root root-sym) + ;; handles for the thread and thread-subject databases + (setq id-sym (vm-th-thread-symbol m)) + (setq s-sym (vm-ts-subject-symbol id-sym)) + (if (member (symbol-name id-sym) vm-traced-message-ids) + (vm-thread-debug 'vm-unthread-message id-sym)) + (if (and s-sym (member (symbol-name s-sym) vm-traced-message-subjects)) + (vm-thread-debug 'vm-unthread-message id-sym)) + ;; mark the subtree for summary update before we change it + (vm-thread-mark-for-summary-update (list m)) + ;; discard cached thread properties of descendants and ancestors + (vm-th-clear-cached-data id-sym id-sym) + ;; remove the message from its erstwhile thread + ;; -------------- atomic block ------------------------------- + (let ((inhibit-quit t)) + (when (boundp id-sym) + ;; remove m from its thread node + (vm-th-remove-message-from-symbol id-sym m) + ;; reset the thread dates of m + (setq date (vm-so-sortable-datestring m)) + (setq subject (vm-so-sortable-subject m)) + (vm-th-set-youngest-date-of id-sym date) + (vm-th-set-oldest-date-of id-sym date) + (vm-th-set-oldest-subject-of id-sym subject) + ;; if message changed, remove it from the thread tree + ;; not clear what is going on. USR, 2010-07-24 + (when (and message-changing (null (vm-th-message-of id-sym))) + (setq p-sym (vm-th-parent-of id-sym)) + (when p-sym + (vm-th-delete-child p-sym id-sym)) + (vm-th-set-parent-of id-sym nil)))) + ;;-------------- end atomic block ------------------------------ + + ;; remove the message from its erstwhile subject thread + (when (and s-sym (boundp s-sym)) + (if (eq (vm-ts-root-of s-sym) id-sym) + ;; handle the subject thread root + ;; (when message-changing + (cond + ;; duplicate copy present, so keep the root id-sym. + ;; FIXME the thread-subtree of the duplicate copy has to be + ;; cleared somehow. + ((vm-th-message-of id-sym) + (vm-ts-set-messages-of + s-sym (remq m (vm-ts-messages-of s-sym)))) + ;; subject thread becomes empty + ((null (remq m (vm-ts-messages-of s-sym))) + (makunbound s-sym)) + (t + (let ((p (remq m (vm-ts-messages-of s-sym))) + msg date children + oldest-msg oldest-date) + ;; find the oldest message in the subject thread + (while p + (setq msg (vm-th-canonical-message (car p))) + (when msg + (setq date (vm-so-sortable-datestring msg)) + (when (or (null oldest-date) + (string-lessp date oldest-date)) + (setq oldest-msg msg) + (setq oldest-date date))) + (setq p (cdr p))) + ;; make the oldest message the new subject root + (if (null oldest-msg) + ;; subject thread is empty + (makunbound s-sym) + ;; subject thread nonempty + (let (new-sub new-s-sym) + (setq root-sym (vm-th-thread-symbol oldest-msg)) + ;; (setq children (vm-th-visible-children-of id-sym)) + (setq children (cons id-sym (vm-ts-members-of s-sym))) + ;; (vm-th-clear-cached-data root-sym root-sym) + (vm-th-clear-subtree root-sym) + ;; (vm-th-clear-thread-lists root-sym) + (mapc 'vm-th-clear-thread-lists (vm-ts-members-of s-sym)) + (vm-ts-set s-sym :root root-sym + :root-date oldest-date + :members (remq root-sym children) + :messages (remq m (vm-ts-messages-of s-sym))) + ;; I'm not sure there aren't situations + ;; where this might loop forever. + ;; ---------------- atomic block ----------------------- + (let ((inhibit-quit nil)) + (mapc (lambda (c-sym) + (vm-thread-mark-for-summary-update + (vm-th-messages-of c-sym))) + (cons root-sym children))) + ;; -------------- end atomic block --------------------- + ))))) + ;; ) + ;; handle a non-root of subject thread + (unless (vm-th-message-of id-sym) + (vm-ts-set-members-of + s-sym (append (vm-th-visible-children-of id-sym) + (remq id-sym (vm-ts-members-of s-sym))))) + (vm-ts-set-messages-of + s-sym (remq m (vm-ts-messages-of s-sym))) + ))) + ;; This doesn't work yet + ;; (if vm-thread-debug + ;; (vm-check-thread-integrity)) + ) + +;; This function is still under development. USR, 2011-04-04 + +;;;###autoload +(defun vm-attach-to-thread () + "Attach the current message as a child of the message last visited." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (vm-build-threads-if-unbuilt) + (unless vm-last-message-pointer + (error "No last message visited")) + (let ((new-parent (car vm-last-message-pointer)) + (p-sym (vm-thread-symbol (car vm-last-message-pointer))) + (m (car vm-message-pointer)) + (m-sym (vm-thread-symbol (car vm-message-pointer)))) + ;; (vm-thread-mark-for-summary-update (list m)) + (vm-unthread-message m :message-changing t) + (unless (vm-th-safe-parent-p m-sym p-sym) + (error "Attaching to thread will create a cycle")) + (vm-th-set-parent-of m-sym p-sym) + (vm-th-add-child p-sym m-sym)) + (vm-inform 5 "Message attached to thread") + (vm-update-summary-and-mode-line) + ) + +;;;###autoload +(defun vm-references (m) + "Returns the cached references list of message M. If the cache is +nil, retrieves the references list from the headers and caches it. +USR, 2010-03-13" + (or (vm-references-of m) + (vm-set-references-of + m + (let (references) + (setq references (vm-get-header-contents m "References:" " ")) + (and references (vm-parse references "[^<]*\\(<[^>]+>\\)")))))) +(defalias 'vm-th-references 'vm-references) + +;;;###autoload +(defun vm-parent (m) + "Returns the cached parent message of message M (in its thread). If +the cache is nil, calculates the parent and caches it. USR, 2010-03-13" + (or (vm-parent-of m) + (vm-set-parent-of + m + (or (vm-last-elem (vm-references m)) + (let (in-reply-to ids id) + (setq in-reply-to (vm-get-header-contents m "In-Reply-To:" " ") + ids (and in-reply-to (vm-parse in-reply-to + "[^<]*\\(<[^>]+>\\)"))) + (while ids + (when (< (length id) (length (car ids))) + (setq id (car ids))) + (setq ids (cdr ids))) + (and id (vm-set-references-of m (list id))) + id ))))) +(defalias 'vm-th-parent 'vm-parent) + +;;;###autoload +(defun vm-thread-indentation (m) + "Returns the cached thread-indentation of message M. If the cache is +nil, calculates the thread-indentation and caches it. It also applies +any thread-indentation-offset that has been defined for a subthread. + USR, 2011-04-03" + (+ (or (vm-thread-indentation-of m) + (let ((p (vm-thread-list m)) + (n 0)) + (catch 'done + (while p + (cond ((null (vm-th-messages-of (car p))) + (setq p (cdr p))) + (vm-summary-thread-indentation-by-references + (setq n (length p)) + (throw 'done nil)) + (t + (setq n (1+ n) + p (cdr p)))))) + (if (and (eq (car p) (vm-thread-symbol m)) + (not (eq (vm-th-message-of (car p)) m))) + ;; thread root is a duplicate of m + (vm-set-thread-indentation-of m n) + (vm-set-thread-indentation-of m (1- n))) + (vm-thread-indentation-of m))) + (or (vm-thread-indentation-offset-of m) + 0) + )) + +(defalias 'vm-th-thread-indentation 'vm-thread-indentation) + +;;;###autoload +(defun vm-thread-list (m) + "Returns the cached thread-list of message M. If the cache is nil, +calculates the thread-list and caches it. USR, 2010-03-13" + (or (vm-thread-list-of m) + (progn + (vm-set-thread-list-of m (vm-build-thread-list m)) + ;; reset the thread-subtrees, forcing them to be rebuilt + ;; (mapc 'vm-th-clear-subtree-of (vm-thread-list-of m)) + (vm-thread-list-of m)))) +(defalias 'vm-th-thread-list 'vm-thread-list) + +;;;###autoload +(defun vm-thread-root (m) + "Returns the root message of M. M can be either a message or +the interned symbol of a message. If there are multiple messages with +the same root message ID, one of them is chosen arbitrarily. Threads +should have been built for this function to work." + ;; requires: LIST0(m) + (let (m-sym list id-sym) + (cond ((symbolp m) + (setq m-sym m) + (setq m (vm-th-message-of m-sym))) + (t + (setq m-sym (vm-thread-symbol m)))) + (if (and vm-debug (member (symbol-name m-sym) vm-traced-message-ids)) + (debug 'vm-thread-root m-sym)) + (catch 'return + (unless m-sym + (vm-thread-debug 'vm-thread-root-null m-sym) + (throw 'return m)) + (setq list (vm-thread-list m)) + (while list + (setq id-sym (car list)) + (when (vm-th-messages-of id-sym) + (throw 'return (vm-th-message-of id-sym))) + (setq list (cdr list))) + nil))) + +;;;###autoload +(defun vm-thread-root-sym (m) + "Returns interned symbol of the root message of M. M can be +either a message or the interned symbol of M. Threads should +have been built for this function to work. + +See also: `vm-thread-root'." + ;; requires: LIST0(m) + (let (m-sym list id-sym) + (cond ((symbolp m) + (setq m-sym m) + (setq m (vm-th-message-of m-sym))) + (t + (setq m-sym (vm-thread-symbol m)))) + (if (and vm-debug (member (symbol-name m-sym) vm-traced-message-ids)) + (debug 'vm-thread-root-sym m-sym)) + (catch 'return + (unless m-sym + (vm-thread-debug 'vm-thread-root-sym-null m-sym) + (throw 'return nil)) + (setq list (vm-thread-list m)) + (while list + (setq id-sym (car list)) + (when (vm-th-messages-of id-sym) + (throw 'return id-sym)) + (setq list (cdr list))) + nil))) + +;;;###autoload +(defun vm-thread-root-p (m) + "Returns t if message M is known to be a thread root, nil +otherwise. No exceptions are thrown for errors." + ;; Threads may not be turned on. So, ignore errors. + ;; requires: LIST0(m) + (condition-case err + (and (eq m (vm-thread-root m)) + (> (vm-thread-count m) 1)) + (vm-thread-error + nil))) + +;;;###autoload +(defun vm-thread-subtree (msg) + "Returns the list of messages in the thread subtree of MSG. +MSG can be a message or the interned symbol of a message. +Threads should have been built for this function to work." + (let (m-sym) + (if (symbolp msg) + (setq m-sym msg + msg (vm-th-message-of msg)) + (setq m-sym (vm-thread-symbol msg))) + (unless m-sym + (vm-thread-debug 'vm-thread-subtree m-sym) + (signal 'vm-thread-error (list 'vm-thread-subtree))) + (if (eq msg (vm-th-message-of m-sym)) + ;; canonical message for this message ID + (or (vm-thread-subtree-of msg) + ;; otherwise calcuate the thread-subtree + (let ((list (list m-sym)) + (loop-obarray (make-vector 29 0)) + subject-sym id-sym id + result) + (when (member (vm-su-message-id msg) vm-traced-message-ids) + (with-current-buffer (vm-buffer-of msg) + (vm-thread-debug 'vm-thread-subtree (vm-su-message-id msg)))) + (while list + (setq id-sym (car list) + id (symbol-name id-sym) + subject-sym (with-current-buffer (vm-buffer-of msg) + (vm-ts-subject-symbol id-sym))) + (when (and (vm-th-messages-of id-sym) + (not (memq (vm-th-message-of id-sym) result))) + (setq result (append result (vm-th-messages-of id-sym)))) + (when (null (intern-soft id loop-obarray)) + (intern id loop-obarray) + (nconc list (copy-sequence (vm-th-children-of id-sym))) + (when (and subject-sym (boundp subject-sym) + (eq id-sym (vm-ts-root-of subject-sym))) + (nconc list + (copy-sequence (vm-ts-members-of subject-sym))))) + (setq list (cdr list))) + (when msg + (vm-set-thread-subtree-of msg result)) + result)) + ;; non-canonical message for this message ID + (vm-set-thread-subtree-of msg (list msg)) + (list msg)))) + +;;;###autoload +(defun vm-thread-count (m) + "Returns the number of messages in the thread-subtree of message M. +M can be a message or the interned symbol of M. Threads should +have been built for this function to work." + (length (vm-thread-subtree m))) + +;;;###autoload +(defun vm-check-thread-integrity (&optional ml) + "Check that all messages are members of their thread subtrees. +Conversely, all members of thread subtrees should actually belong +to the thread. Used for testing purposes." + (interactive) + (vm-select-folder-buffer) + (let ((errors-found nil)) + (when (vectorp vm-thread-obarray) + (unless ml + (with-current-buffer (or vm-mail-buffer (current-buffer)) + (setq ml vm-message-list))) + ;; Check that all messages have been recorded in the threads + ;; database + (mapc (lambda (m) + (unless (vm-th-message-of (vm-th-thread-symbol m)) + (vm-thread-debug 'message-not-in-database m))) + ml) + ;; Check that all messages belong to their respective subtrees + (mapc (lambda (m) + (let* ((root (vm-thread-root-sym m)) + (tree (and root (vm-thread-subtree root)))) + (if (vm-th-messages-of (vm-thread-symbol m)) + (unless root + (vm-thread-debug 'message-with-no-root m) + (setq errors-found t)) + (vm-thread-debug 'message-lost m) + (setq errors-found t)) + (with-current-buffer (vm-buffer-of m) + (unless (eq root + (intern-soft (symbol-name root) vm-thread-obarray)) + (vm-thread-debug 'interned-in-wrong-buffer root m) + (setq errors-found t))) + (when (and (vm-th-message-of root) (not (memq m tree))) + (vm-thread-debug 'missing m)))) + ml) + ;; Check that all subtrees have correct messages + (mapc (lambda (subroot) + (let* ((subtree (vm-thread-subtree subroot)) + (buf (vm-buffer-of subroot))) + (mapc (lambda (m) + (unless (and (vm-thread-root m) + (eq (vm-thread-root m) + (vm-thread-root subroot))) + (vm-thread-debug 'spurious m) + (setq errors-found t)) + (unless (eq buf (vm-buffer-of m)) + (vm-thread-debug 'wrong-buffer m) + (setq errors-found t))) + subtree))) + ml) + ;; Recover from errors + (when errors-found + (vm-warn 0 2 (concat "Problem detected with the threads database; " + "try vm-fix-my-summary")) + ;; (setq vm-thread-obarray 'bonk) + ;; (setq vm-thread-subject-obarray 'bonk) + )))) + +;;; vm-thread.el ends here diff --git a/lisp/vm-toolbar.el b/lisp/vm-toolbar.el new file mode 100755 index 0000000..16e154b --- /dev/null +++ b/lisp/vm-toolbar.el @@ -0,0 +1,728 @@ +;;; vm-toolbar.el --- Toolbar related functions and commands +;; +;; This file is part of VM +;; +;; Copyright (C) 1995-1997, 2000, 2001 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-toolbar) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-window) + ) + +(declare-function vm-follow-summary-cursor "vm-motion" ()) +(declare-function vm-mime-plain-message-p "vm-mime" (message)) +(declare-function vm-save-message "vm-save" (folder + &optional count mlist quiet)) +(declare-function vm-auto-select-folder "vm-save" (mp auto-folder-alist)) + +(declare-function glyph-height "vm-xemacs" (glyph &optional window)) +(declare-function glyph-width "vm-xemacs" (glyph &optional window)) +(declare-function make-glyph "vm-xemacs" (&optional spec-list type)) +(declare-function set-specifier "vm-xemacs" + (specifier value &optional locale tag-set how-to-add)) + +(defvar vm-toolbar-specifier nil) +(defvar right-toolbar) +(defvar right-toolbar-width) +(defvar left-toolbar) +(defvar left-toolbar-width) +(defvar bottom-toolbar) +(defvar bottom-toolbar-height) +(defvar top-toolbar) +(defvar top-toolbar-height) + +(defconst vm-toolbar-next-button + [vm-toolbar-next-icon + vm-toolbar-next-command + (vm-toolbar-any-messages-p) + "Go to the next message.\n +The command `vm-toolbar-next-command' is run, which is normally +fbound to `vm-next-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-next-command 'some-other-command)"]) +(defvar vm-toolbar-next-icon nil) +(or (fboundp 'vm-toolbar-next-command) + (fset 'vm-toolbar-next-command 'vm-next-message)) + +(defconst vm-toolbar-previous-button + [vm-toolbar-previous-icon + vm-toolbar-previous-command + (vm-toolbar-any-messages-p) + "Go to the previous message.\n +The command `vm-toolbar-previous-command' is run, which is normally +fbound to `vm-previous-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-previous-command 'some-other-command)"]) +(defvar vm-toolbar-previous-icon nil) +(or (fboundp 'vm-toolbar-previous-command) + (fset 'vm-toolbar-previous-command 'vm-previous-message)) + +(defconst vm-toolbar-autofile-button + [vm-toolbar-autofile-icon + vm-toolbar-autofile-message + (vm-toolbar-can-autofile-p) + "Save the current message to a folder selected using vm-auto-folder-alist."]) +(defvar vm-toolbar-autofile-icon nil) + +(defconst vm-toolbar-file-button + [vm-toolbar-file-icon vm-toolbar-file-command (vm-toolbar-any-messages-p) + "Save the current message to a folder.\n +The command `vm-toolbar-file-command' is run, which is normally +fbound to `vm-save-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-file-command 'some-other-command)"]) +(defvar vm-toolbar-file-icon nil) +(or (fboundp 'vm-toolbar-file-command) + (fset 'vm-toolbar-file-command 'vm-save-message)) + +(defconst vm-toolbar-getmail-button + [vm-toolbar-getmail-icon vm-toolbar-getmail-command + (vm-toolbar-mail-waiting-p) + "Retrieve spooled mail for the current folder.\n +The command `vm-toolbar-getmail-command' is run, which is normally +fbound to `vm-get-new-mail'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-getmail-command 'some-other-command)"]) +(defvar vm-toolbar-getmail-icon nil) +(or (fboundp 'vm-toolbar-getmail-command) + (fset 'vm-toolbar-getmail-command 'vm-get-new-mail)) + +(defconst vm-toolbar-print-button + [vm-toolbar-print-icon + vm-toolbar-print-command + (vm-toolbar-any-messages-p) + "Print the current message.\n +The command `vm-toolbar-print-command' is run, which is normally +fbound to `vm-print-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-print-command 'some-other-command)"]) +(defvar vm-toolbar-print-icon nil) +(or (fboundp 'vm-toolbar-print-command) + (fset 'vm-toolbar-print-command 'vm-print-message)) + +(defconst vm-toolbar-visit-button + [vm-toolbar-visit-icon vm-toolbar-visit-command t + "Visit a different folder.\n +The command `vm-toolbar-visit-command' is run, which is normally +fbound to `vm-visit-folder'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-visit-command 'some-other-command)"]) +(defvar vm-toolbar-visit-icon nil) +(or (fboundp 'vm-toolbar-visit-command) + (fset 'vm-toolbar-visit-command 'vm-visit-folder)) + +(defconst vm-toolbar-reply-button + [vm-toolbar-reply-icon + vm-toolbar-reply-command + (vm-toolbar-any-messages-p) + "Reply to the current message.\n +The command `vm-toolbar-reply-command' is run, which is normally +fbound to `vm-followup-include-text'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-reply-command 'some-other-command)"]) +(defvar vm-toolbar-reply-icon nil) +(or (fboundp 'vm-toolbar-reply-command) + (fset 'vm-toolbar-reply-command 'vm-followup-include-text)) + +(defconst vm-toolbar-forward-button + [vm-toolbar-forward-icon + vm-toolbar-forward-command + (vm-toolbar-any-messages-p) + "Forward the current message.\n +The command `vm-toolbar-forward-command' is run, which is normally +fbound to `vm-forward-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-forward-command 'some-other-command)"]) +(defvar vm-toolbar-forward-icon nil) +(or (fboundp 'vm-toolbar-forward-command) + (fset 'vm-toolbar-forward-command 'vm-forward-message)) + +(defconst vm-toolbar-followup-button + [vm-toolbar-followup-icon + vm-toolbar-followup-command + (vm-toolbar-any-messages-p) + "Follow up the current message.\n +The command `vm-toolbar-followup-command' is run, which is normally +fbound to `vm-followup-message'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-followup-command 'some-other-command)"]) +(defvar vm-toolbar-followup-icon nil) +(or (fboundp 'vm-toolbar-followup-command) + (fset 'vm-toolbar-followup-command 'vm-followup)) + +(defconst vm-toolbar-compose-button + [vm-toolbar-compose-icon vm-toolbar-compose-command t + "Compose a new message.\n +The command `vm-toolbar-compose-command' is run, which is normally +fbound to `vm-mail'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-compose-command 'some-other-command)"]) +(defvar vm-toolbar-compose-icon nil) +(or (fboundp 'vm-toolbar-compose-command) + (fset 'vm-toolbar-compose-command 'vm-mail)) + +(defconst vm-toolbar-decode-mime-button + [vm-toolbar-decode-mime-icon vm-toolbar-decode-mime-command + (vm-toolbar-can-decode-mime-p) + "Decode the MIME objects in the current message.\n +The objects might be displayed immediately, or buttons might be +displayed that you need to click on to view the object. See the +documentation for the variables vm-mime-internal-content-types +and vm-mime-external-content-types-alist to see how to control +whether you see buttons or objects.\n +The command `vm-toolbar-decode-mime-command' is run, which is normally +fbound to `vm-decode-mime-messages'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-decode-mime-command 'some-other-command)"]) +(defvar vm-toolbar-decode-mime-icon nil) +(or (fboundp 'vm-toolbar-decode-mime-command) + (fset 'vm-toolbar-decode-mime-command 'vm-decode-mime-message)) + +;; The values of these two are used by the FSF Emacs toolbar +;; code. The values don't matter as long as they are different +;; (as compared with eq). Under XEmacs these values are ignored +;; and overwritten. +(defvar vm-toolbar-delete-icon t) +(defvar vm-toolbar-undelete-icon nil) + +(defconst vm-toolbar-delete/undelete-button + [vm-toolbar-delete/undelete-icon + vm-toolbar-delete/undelete-message + (vm-toolbar-any-messages-p) + "Delete the current message, or undelete it if it is already deleted."]) +(defvar vm-toolbar-delete/undelete-icon nil) +(make-variable-buffer-local 'vm-toolbar-delete/undelete-icon) + +(defvar vm-toolbar-help-icon nil) + +(defvar vm-toolbar-recover-icon nil) + +(defvar vm-toolbar-helper-icon nil) +(make-variable-buffer-local 'vm-toolbar-helper-icon) + +(defconst vm-toolbar-help-button + [vm-toolbar-helper-icon vm-toolbar-helper-command + (vm-toolbar-can-help-p) + "Don't Panic.\n +VM uses this button to offer help if you're in trouble. +Under normal circumstances, this button runs `vm-help'. +If the current folder looks out-of-date relative to its auto-save +file then this button will run `vm-recover-folder'. +If there is mail waiting in one of the spool files associated +with the current folder, and the `getmail' button is not on the +toolbar, this button will run `vm-get-new-mail'. +If the current message needs to be MIME decoded then this button +will run 'vm-decode-mime-message'."]) + +(defvar vm-toolbar-helper-command nil) +(make-variable-buffer-local 'vm-toolbar-helper-command) + +;;;###autoload +(defun vm-toolbar-helper-command () + (interactive) + (setq this-command vm-toolbar-helper-command) + (call-interactively vm-toolbar-helper-command)) + +(defconst vm-toolbar-quit-button + [vm-toolbar-quit-icon vm-toolbar-quit-command + (vm-toolbar-can-quit-p) + "Quit visiting this folder.\n +The command `vm-toolbar-quit-command' is run, which is normally +fbound to `vm-quit'. +You can make this button run some other command by using a Lisp +s-expression like this one in your .vm file: + (fset 'vm-toolbar-quit-command 'some-other-command)"]) +(defvar vm-toolbar-quit-icon nil) +(or (fboundp 'vm-toolbar-quit-command) + (fset 'vm-toolbar-quit-command 'vm-quit)) + +(defun vm-toolbar-any-messages-p () + (condition-case nil + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + vm-message-list) + (error nil))) + +;;;###autoload +(defun vm-toolbar-delete/undelete-message (&optional prefix-arg) + (interactive "P") + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((current-prefix-arg prefix-arg)) + (if (vm-deleted-flag (car vm-message-pointer)) + (call-interactively 'vm-undelete-message) + (call-interactively 'vm-delete-message)))) + +;;;###autoload +(defun vm-toolbar-can-autofile-p () + (interactive) + (condition-case nil + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (and vm-message-pointer + (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist))) + (error nil))) + +;;;###autoload +(defun vm-toolbar-autofile-message () + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((file (vm-auto-select-folder vm-message-pointer vm-auto-folder-alist))) + (if file + (progn + (vm-save-message file 1) + (vm-inform 5 "Message saved to %s" file)) + (error "No match for message in vm-auto-folder-alist.")))) + +(defun vm-toolbar-can-recover-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (and vm-folder-read-only + buffer-file-name + buffer-auto-save-file-name + (null (buffer-modified-p)) + (file-newer-than-file-p + buffer-auto-save-file-name + buffer-file-name))) + (error nil))) + +(defun vm-toolbar-can-decode-mime-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (and + vm-display-using-mime + vm-message-pointer + vm-presentation-buffer + (not (vm-mime-plain-message-p (car vm-message-pointer))))) + (error nil))) + +(defun vm-toolbar-can-quit-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (memq major-mode '(vm-mode vm-virtual-mode))) + (error nil))) + +(defun vm-toolbar-mail-waiting-p () + (condition-case nil + (save-excursion + (vm-select-folder-buffer) + (or (not (natnump vm-mail-check-interval)) + vm-spooled-mail-waiting)) + (error nil))) + +(fset 'vm-toolbar-can-help-p 'vm-toolbar-can-quit-p) + +(defun vm-toolbar-update-toolbar () + (if (and vm-message-pointer (vm-deleted-flag (car vm-message-pointer))) + (setq vm-toolbar-delete/undelete-icon vm-toolbar-undelete-icon) + (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon)) + (cond ((vm-toolbar-can-recover-p) + (setq vm-toolbar-helper-command 'vm-recover-folder + vm-toolbar-helper-icon vm-toolbar-recover-icon)) + ((and (vm-toolbar-mail-waiting-p) + (not (memq 'getmail vm-use-toolbar))) + (setq vm-toolbar-helper-command 'vm-get-new-mail + vm-toolbar-helper-icon vm-toolbar-getmail-icon)) + ((and (vm-toolbar-can-decode-mime-p) (not vm-mime-decoded) + (not (memq 'mime vm-use-toolbar))) + (setq vm-toolbar-helper-command 'vm-decode-mime-message + vm-toolbar-helper-icon vm-toolbar-decode-mime-icon)) + (t + (setq vm-toolbar-helper-command 'vm-help + vm-toolbar-helper-icon vm-toolbar-help-icon))) + (if (and vm-summary-buffer (buffer-name vm-summary-buffer)) + (vm-copy-local-variables vm-summary-buffer + 'vm-toolbar-delete/undelete-icon + 'vm-toolbar-helper-command + 'vm-toolbar-helper-icon)) + (if (and vm-presentation-buffer (buffer-name vm-presentation-buffer)) + (vm-copy-local-variables vm-presentation-buffer + 'vm-toolbar-delete/undelete-icon + 'vm-toolbar-helper-command + 'vm-toolbar-helper-icon)) + (and vm-toolbar-specifier + (progn + (set-specifier vm-toolbar-specifier (cons (current-buffer) nil)) + (set-specifier vm-toolbar-specifier (cons (current-buffer) + vm-toolbar))))) + +(defun vm-toolbar-install-or-uninstall-toolbar () + (and (vm-toolbar-support-possible-p) vm-use-toolbar + (vm-toolbar-install-toolbar)) + (if (and vm-fsfemacs-p (not vm-use-toolbar)) + (vm-toolbar-fsfemacs-uninstall-toolbar))) + +(defcustom vm-toolbar-height nil + "*Desired height of the toolbar." + :group 'vm-toolbar + :type '(choice (const :tag "Automatic" nil) integer)) + +(defun vm-toolbar-install-toolbar () + ;; drag these in now instead of waiting for them to be + ;; autoloaded. the "loading..." messages could come at a bad + ;; moment and wipe an important echo area message, like "Auto + ;; save file is newer..." + (require 'vm-save) + (require 'vm-summary) + (if vm-fsfemacs-p + (if (not vm-fsfemacs-toolbar-installed-p) + (vm-toolbar-fsfemacs-install-toolbar)) + (if (not (vm-toolbar-pixmap-directory)) + (progn + (vm-warn + 0 2 "Bad toolbar pixmap directory, can't setup toolbar.")) + (vm-toolbar-initialize) + (let ((height (or vm-toolbar-height + (+ 5 (glyph-height (car vm-toolbar-help-icon))))) + (width (+ 5 (glyph-width (car vm-toolbar-help-icon)))) + (frame (selected-frame)) + (buffer (current-buffer)) + (tag-set '(win)) + (myframe (vm-created-this-frame-p)) + toolbar ) + ;; glyph-width and glyph-height return 0 at startup sometimes + ;; use reasonable values if they fail. + (if (= width 4) + (setq width 38)) + (if (= height 4) + (setq height 38)) + ;; honor user setting of vm-toolbar if they are daring enough + ;; to set it. + (if vm-toolbar + (setq toolbar vm-toolbar) + (setq toolbar (vm-toolbar-make-toolbar-spec) + vm-toolbar toolbar)) + (cond ((eq vm-toolbar-orientation 'right) + (setq vm-toolbar-specifier right-toolbar) + (if myframe + (set-specifier right-toolbar toolbar frame tag-set)) + (set-specifier right-toolbar toolbar buffer) + (set-specifier right-toolbar-width width frame tag-set)) + ((eq vm-toolbar-orientation 'left) + (setq vm-toolbar-specifier left-toolbar) + (if myframe + (set-specifier left-toolbar toolbar frame tag-set)) + (set-specifier left-toolbar toolbar buffer) + (set-specifier left-toolbar-width width frame tag-set)) + ((eq vm-toolbar-orientation 'bottom) + (setq vm-toolbar-specifier bottom-toolbar) + (if myframe + (set-specifier bottom-toolbar toolbar frame tag-set)) + (set-specifier bottom-toolbar toolbar buffer) + (set-specifier bottom-toolbar-height height frame tag-set)) + (t + (setq vm-toolbar-specifier top-toolbar) + (if myframe + (set-specifier top-toolbar toolbar frame tag-set)) + (set-specifier top-toolbar toolbar buffer) + (set-specifier top-toolbar-height height frame tag-set))))))) + +(defun vm-toolbar-make-toolbar-spec () + (let ((button-alist '( + (autofile . vm-toolbar-autofile-button) + (compose . vm-toolbar-compose-button) + (delete/undelete . vm-toolbar-delete/undelete-button) + (file . vm-toolbar-file-button) + (getmail . vm-toolbar-getmail-button) + (help . vm-toolbar-help-button) + (mime . vm-toolbar-decode-mime-button) + (next . vm-toolbar-next-button) + (previous . vm-toolbar-previous-button) + (print . vm-toolbar-print-button) + (quit . vm-toolbar-quit-button) + (reply . vm-toolbar-reply-button) + (forward . vm-toolbar-forward-button) + (followup . vm-toolbar-followup-button) + (visit . vm-toolbar-visit-button) + )) + (button-list vm-use-toolbar) + cons + (toolbar nil)) + (while button-list + (cond ((null (car button-list)) + (setq toolbar (cons nil toolbar))) + ((integerp (car button-list)) + (if (< 0 (car button-list)) + (setq toolbar (cons (vector ':size (car button-list) + ':style '2d) + toolbar)))) + (t + (setq cons (assq (car button-list) button-alist)) + (if cons + (setq toolbar (cons (symbol-value (cdr cons)) toolbar))))) + (setq button-list (cdr button-list))) + (nreverse toolbar) )) + +(defun vm-toolbar-initialize () + (cond + (vm-fsfemacs-p nil) + ((null vm-toolbar-help-icon) + (let ((tuples + (list + '(vm-toolbar-decode-mime-icon + "mime-up.xpm" "mime-dn.xpm" "mime-xx.xpm") + '(vm-toolbar-next-icon + "next-up.xpm" "next-dn.xpm" "next-dn.xpm") + '(vm-toolbar-previous-icon + "previous-up.xpm" "previous-dn.xpm" "previous-dn.xpm") + '(vm-toolbar-delete-icon + "delete-up.xpm" "delete-dn.xpm" "delete-dn.xpm") + '(vm-toolbar-undelete-icon + "undelete-up.xpm" "undelete-dn.xpm" "undelete-dn.xpm") + '(vm-toolbar-autofile-icon + "autofile-up.xpm" "autofile-dn.xpm" "autofile-dn.xpm") + '(vm-toolbar-getmail-icon + "getmail-up.xpm" "getmail-dn.xpm" "getmail-dn.xpm") + '(vm-toolbar-file-icon + "file-up.xpm" "file-dn.xpm" "file-dn.xpm") + '(vm-toolbar-reply-icon + "reply-up.xpm" "reply-dn.xpm" "reply-dn.xpm") + '(vm-toolbar-forward-icon + "forward-up.xpm" "forward-dn.xpm" "forward-dn.xpm") + '(vm-toolbar-followup-icon + "followup-up.xpm" "followup-dn.xpm" "followup-dn.xpm") + '(vm-toolbar-compose-icon + "compose-up.xpm" "compose-dn.xpm" "compose-dn.xpm") + '(vm-toolbar-print-icon + "print-up.xpm" "print-dn.xpm" "print-dn.xpm") + '(vm-toolbar-visit-icon + "visit-up.xpm" "visit-dn.xpm" "visit-dn.xpm") + '(vm-toolbar-quit-icon + "quit-up.xpm" "quit-dn.xpm" "quit-dn.xpm") + '(vm-toolbar-help-icon + "help-up.xpm" "help-dn.xpm" "help-dn.xpm") + '(vm-toolbar-recover-icon + "recover-up.xpm" "recover-dn.xpm" "recover-dn.xpm") + )) + tuple files var) + (while tuples + (setq tuple (car tuples) + var (car tuple) + files (cdr tuple)) + (set var (mapcar + (function + (lambda (f) + (make-glyph + (expand-file-name f (vm-toolbar-pixmap-directory))))) + files)) + (setq tuples (cdr tuples)))))) + (setq vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon) + (setq-default vm-toolbar-delete/undelete-icon vm-toolbar-delete-icon) + (setq vm-toolbar-helper-command 'vm-help) + (setq vm-toolbar-helper-icon vm-toolbar-help-icon) + (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon)) + +(defun vm-toolbar-fsfemacs-uninstall-toolbar () + (define-key vm-mode-map [toolbar] nil) + (setq vm-fsfemacs-toolbar-installed-p nil)) + +(defun vm-toolbar-fsfemacs-install-toolbar () + (let ((button-list (reverse vm-use-toolbar)) + (dir (vm-toolbar-pixmap-directory)) + (extension "xpm") + item t-spec sym name images) + (defvar tool-bar-map) + ;; hide the toolbar entries that are in the global keymap so + ;; VM has full control of the toolbar in its buffers. + (if (and (boundp 'tool-bar-map) + (consp tool-bar-map)) + (let ((map (cdr tool-bar-map)) + (v [tool-bar x])) + (while map + (aset v 1 (car (car map))) + (define-key vm-mode-map v 'undefined) + (setq map (cdr map))))) + (while button-list + (setq sym (car button-list)) + (cond ((null sym) + ;; can't do flushright in FSF Emacs + t) + ((integerp sym) + ;; can't do separators in FSF Emacs + t) + ((memq sym '(autofile compose file getmail + mime next previous print quit + reply followup forward visit)) + (setq t-spec (symbol-value + (intern (format "vm-toolbar-%s-button" + (if (eq sym 'mime) + 'decode-mime + sym))))) + (setq name (symbol-name sym)) + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir + (if (eq sym 'mime) nil 'heuristic))) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar sym) item)) + ((eq sym 'delete/undelete) + (setq t-spec vm-toolbar-delete/undelete-button) + (setq name "delete") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir 'heuristic)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-delete/undelete-icon + vm-toolbar-delete-icon) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'delete) item) + (setq name "undelete") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir 'heuristic)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-delete/undelete-icon + vm-toolbar-undelete-icon) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'undelete) item)) + ((eq sym 'help) + (setq t-spec vm-toolbar-help-button) + (setq name "help") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir 'heuristic)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-helper-command 'vm-help) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-help) item) + (setq name "recover") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir 'heuristic)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-helper-command + 'recover-file) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-recover) item) + (setq name "getmail") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir 'heuristic)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-helper-command + 'vm-get-new-mail) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-getmail) item) + (setq name "mime") + (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec + name extension dir nil)) + (setq item + (list 'menu-item + name + (aref t-spec 1) + ':help (aref t-spec 3) + ':visible '(eq vm-toolbar-helper-command + 'vm-decode-mime-message) + ':enable (aref t-spec 2) +; ':button '(:toggle nil) + ':image images)) + (define-key vm-mode-map (vector 'tool-bar 'help-mime) item))) + (setq button-list (cdr button-list)))) + (setq vm-fsfemacs-toolbar-installed-p t)) + +(defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir mask) + (if vm-gtk-emacs-p + ;; the GTK-toolbar will not display icons when providing a vector since + ;; some version of GTK resp. Emacs 22 ... + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-up.%s" + name extension) + dir)) + (vector + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-up.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir)) + (list 'image + ':type (intern extension) + ':file (expand-file-name + (format "%s-dn.%s" + name extension) + dir))))) + +;;; vm-toolbar.el ends here diff --git a/lisp/vm-undo.el b/lisp/vm-undo.el new file mode 100755 index 0000000..5912f50 --- /dev/null +++ b/lisp/vm-undo.el @@ -0,0 +1,688 @@ +;;; vm-undo.el --- Commands to undo message attribute changes in VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1995 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-undo) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-menu) + (require 'vm-minibuf) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + ) + +;; vm-undo-record-list is a buffer-local-variable containing +;; undo-records. +;; An undo-record has: +;; - action +;; - message +;; - args + +(defun vm-undo-boundary () + (if (car vm-undo-record-list) + (setq vm-undo-record-list (cons nil vm-undo-record-list)))) + +(defun vm-add-undo-boundaries () + (save-excursion + (mapatoms (function + (lambda (b) + (setq b (get-buffer (symbol-name b))) + (when b + (set-buffer b) + (vm-undo-boundary)))) + vm-buffers-needing-undo-boundaries) + (fillarray vm-buffers-needing-undo-boundaries 0))) + +(defun vm-clear-expunge-invalidated-undos () + (let ((udp vm-undo-record-list) udp-prev) + (while udp + (cond ((null (car udp)) + (setq udp-prev udp)) + ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p)) + ;; delete flag == expunged is the + ;; indicator of an expunged message + (eq (vm-deleted-flag (car (cdr (car udp)))) 'expunged)) + (cond (udp-prev (setcdr udp-prev (cdr udp))) + (t (setq vm-undo-record-list (cdr udp))))) + (t (setq udp-prev udp))) + (setq udp (cdr udp)))) + (vm-clear-modification-flag-undos)) + +(defun vm-clear-virtual-quit-invalidated-undos () + (let ((udp vm-undo-record-list) udp-prev) + (while udp + (cond ((null (car udp)) + (setq udp-prev udp)) + ((and (not (eq (car (car udp)) 'vm-set-buffer-modified-p)) + ;; message-id-number == "Q" is the + ;; indicator of a dead message + (equal (vm-message-id-number-of (car (cdr (car udp)))) "Q")) + (cond (udp-prev (setcdr udp-prev (cdr udp))) + (t (setq vm-undo-record-list (cdr udp))))) + (t (setq udp-prev udp))) + (setq udp (cdr udp)))) + (vm-clear-modification-flag-undos)) + +(defun vm-clear-modification-flag-undos () + (let ((udp vm-undo-record-list) udp-prev) + (while udp + (cond ((null (car udp)) + (setq udp-prev udp)) + ((eq (car (car udp)) 'vm-set-buffer-modified-p) + (cond (udp-prev (setcdr udp-prev (cdr udp))) + (t (setq vm-undo-record-list (cdr udp))))) + (t (setq udp-prev udp))) + (setq udp (cdr udp))) + (vm-squeeze-consecutive-undo-boundaries))) + +;; squeeze out consecutive record separators left by record deletions +(defun vm-squeeze-consecutive-undo-boundaries () + (let ((udp vm-undo-record-list) udp-prev) + (while udp + (cond ((and (null (car udp)) udp-prev (null (car udp-prev))) + (setcdr udp-prev (cdr udp))) + (t (setq udp-prev udp))) + (setq udp (cdr udp))) + (if (equal '(nil) vm-undo-record-list) + (setq vm-undo-record-list nil))) + ;; for the Undo button on the menubar, if present + (when (and (null vm-undo-record-list) + (vm-menu-support-possible-p) + (vm-menu-xemacs-menus-p)) + (vm-menu-set-menubar-dirty-flag))) + +(defun vm-undo-record (sexp) + ;; for the Undo button on the menubar, if present + (when (and (null vm-undo-record-list) + (vm-menu-support-possible-p) + (vm-menu-xemacs-menus-p)) + (vm-menu-set-menubar-dirty-flag)) + (setq vm-undo-record-list (cons sexp vm-undo-record-list))) + +(defun vm-undo-describe (record) + (let ((cell + (assq (car record) + '((vm-set-new-flag "new" "old") + (vm-set-unread-flag "unread" "read") + (vm-set-deleted-flag "deleted" "undeleted") + (vm-set-forwarded-flag "forwarded" "unforwarded") + (vm-set-replied-flag "answered" "unanswered") + (vm-set-redistributed-flag "redistributed" "unredistributed") + (vm-set-filed-flag "filed" "unfiled") + (vm-set-written-flag "written" "unwritten")))) + (m (nth 1 record)) + labels) + (cond (cell + (vm-inform 1 "VM Undo! %s/%s %s -> %s" + (buffer-name (vm-buffer-of m)) + (vm-number-of m) + (if (nth 2 record) + (nth 2 cell) + (nth 1 cell)) + (if (nth 2 record) + (nth 1 cell) + (nth 2 cell)))) + ((eq (car cell) 'vm-set-labels) + (setq labels (nth 2 record)) + (vm-inform 1 "VM Undo! %s/%s %s%s" + (buffer-name (vm-buffer-of m)) + (vm-number-of m) + (if (null labels) + "lost all its labels" + "labels set to ") + (if (null labels) + "" + (mapconcat 'identity labels ", "))))))) + +(defun vm-undo-set-message-pointer (record) + (if (and (not (eq (car record) 'vm-set-buffer-modified-p)) + (not (eq (nth 1 record) vm-message-pointer))) + (progn + (vm-record-and-change-message-pointer + vm-message-pointer + (or (cdr (vm-reverse-link-of (nth 1 record))) + vm-message-list)) + ;; make folder read-only to avoid modifications when we + ;; do this. + (let ((vm-folder-read-only t)) + (vm-present-current-message))))) + +;;;###autoload +(defun vm-undo () + "Undo last change to message attributes in the current folder. +Consecutive invocations of this command cause sequentially earlier +changes to be undone. After an intervening command between undos, +the undos themselves become undoable." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (vm-display nil nil '(vm-undo) '(vm-undo)) + (let ((modified (buffer-modified-p))) + (unless (eq last-command 'vm-undo) + (setq vm-undo-record-pointer vm-undo-record-list)) + (unless vm-undo-record-pointer + (error "No further VM undo information available")) + ;; skip current record boundary + (setq vm-undo-record-pointer (cdr vm-undo-record-pointer)) + (while (car vm-undo-record-pointer) + (vm-undo-set-message-pointer (car vm-undo-record-pointer)) + (vm-undo-describe (car vm-undo-record-pointer)) + (eval (car vm-undo-record-pointer)) + (setq vm-undo-record-pointer (cdr vm-undo-record-pointer))) + (when (and modified (not (buffer-modified-p))) + (delete-auto-save-file-if-necessary)) + (vm-update-summary-and-mode-line))) + +;;;###autoload +(defun vm-set-message-attributes (string count) + "Set message attributes. +Use this command to change attributes like `deleted' or +`replied'. Interactively you will be prompted for the attributes +to be changed, and only the attributes you enter will be altered. +You can use completion to expand the attribute names. The names +should be entered as a space separated list. + +A numeric prefix argument COUNT causes the current message and +the next COUNT-1 message to have their attributes altered. A +negative COUNT arg causes the current message and the previous +COUNT-1 messages to be altered. COUNT defaults to one." + (interactive + (let ((last-command last-command) + (this-command this-command)) + ;; so the user can see what message they are about to + ;; modify. + (vm-follow-summary-cursor) + (list + (vm-read-string "Set attributes: " vm-supported-attribute-names t) + (prefix-numeric-value current-prefix-arg)))) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (vm-display nil nil '(vm-set-message-attributes) + '(vm-set-message-attributes)) + (let ((name-list (vm-parse string "[ \t]*\\([^ \t]+\\)")) + (m-list (vm-select-operable-messages + count (vm-interactive-p) "Set attributes of")) + n-list name m) + (while m-list + (setq m (car m-list) + n-list name-list) + (while n-list + (setq name (car n-list)) + (cond ((string= name "new") + (vm-set-new-flag m t)) + ((string= name "recent") + (vm-set-new-flag m t)) + ((string= name "unread") + (vm-set-unread-flag m t)) + ((string= name "unseen") + (vm-set-unread-flag m t)) + ((string= name "read") + (vm-set-new-flag m nil) + (vm-set-unread-flag m nil)) + ((string= name "deleted") + (vm-set-deleted-flag m t)) + ((string= name "replied") + (vm-set-replied-flag m t)) + ((string= name "answered") + (vm-set-replied-flag m t)) + ((string= name "forwarded") + (vm-set-forwarded-flag m t)) + ((string= name "redistributed") + (vm-set-redistributed-flag m t)) + ((string= name "filed") + (vm-set-filed-flag m t)) + ((string= name "written") + (vm-set-written-flag m t)) + ((string= name "edited") + (vm-set-edited-flag-of m t)) + ((string= name "undeleted") + (vm-set-deleted-flag m nil)) + ((string= name "unreplied") + (vm-set-replied-flag m nil)) + ((string= name "unanswered") + (vm-set-replied-flag m nil)) + ((string= name "unforwarded") + (vm-set-forwarded-flag m nil)) + ((string= name "unredistributed") + (vm-set-redistributed-flag m nil)) + ((string= name "unfiled") + (vm-set-filed-flag m nil)) + ((string= name "unwritten") + (vm-set-written-flag m nil)) + ((string= name "unedited") + (vm-set-edited-flag-of m nil))) + (setq n-list (cdr n-list))) + (setq m-list (cdr m-list))) + (vm-update-summary-and-mode-line))) + +;;;###autoload +(defun vm-add-message-labels (string count) + "Attach some labels to a message. +These are arbitrary user-defined labels, not to be confused with +message attributes like `new' and `deleted'. Interactively you +will be prompted for the labels to be added. You can use +completion to expand the label names, with the completion list +being all the labels that have ever been used in this folder. +The names should be entered as a space separated list. Label +names are compared case-insensitively. + +A numeric prefix argument COUNT causes the current message and +the next COUNT-1 message to have the labels added. A +negative COUNT arg causes the current message and the previous +COUNT-1 messages to be altered. COUNT defaults to one." + (interactive + (let ((last-command last-command) + (this-command this-command) + (vm-completion-auto-correct nil) + (completion-ignore-case t)) + ;; so the user can see what message they are about to + ;; modify. + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list + (vm-read-string "Add labels: " + (vm-obarray-to-string-list vm-label-obarray) t) + (prefix-numeric-value current-prefix-arg))))) + (let ((m-list nil) + (ignored-labels nil)) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (setq m-list (vm-select-operable-messages + count (vm-interactive-p) "Add labels to")) + (setq ignored-labels + (vm-add-or-delete-message-labels string m-list 'all)) + (if ignored-labels + (vm-inform 1 "Label %s could not be added" string)))) + +;;;###autoload +(defun vm-add-existing-message-labels (string count) + "Attach some already existing labels to a message. +Only labels that are currently attached to some message in this +folder or labels that have previously been attached to messages +in this folder will be added. Other labels will be silently +ignored. + +These are arbitrary user-defined labels, not to be confused with +message attributes like `new' and `deleted'. Interactively you +will be prompted for the labels to be added. You can use +completion to expand the label names, with the completion list +being all the labels that have ever been used in this folder. +The names should be entered as a space separated list. Label +names are compared case-insensitively. + +A numeric prefix argument COUNT causes the current message and +the next COUNT-1 messages to have the labels added. A +negative COUNT arg causes the current message and the previous +COUNT-1 messages to be altered. COUNT defaults to one." + (interactive + (let ((last-command last-command) + (this-command this-command) + (vm-completion-auto-correct nil) + (completion-ignore-case t)) + ;; so the user can see what message they are about to + ;; modify. + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list + (vm-read-string "Add labels: " + (vm-obarray-to-string-list vm-label-obarray) t) + (prefix-numeric-value current-prefix-arg))))) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let* ((m-list (vm-select-operable-messages + count (vm-interactive-p) "Add labels to")) + (ignored-labels + (vm-add-or-delete-message-labels string m-list 'existing-only))) + (if ignored-labels + (progn + (set-buffer (get-buffer-create "*Ignored Labels*")) + (erase-buffer) + (insert "These labels do not exist and were not added:\n\n") + (while ignored-labels + (insert (car ignored-labels) "\n") + (setq ignored-labels (cdr ignored-labels))) + (display-buffer (current-buffer)))))) + +;;;###autoload +(defun vm-delete-message-labels (string count) + "Delete some labels from a message. +These are arbitrary user-defined labels, not to be confused with +message attributes like `new' and `deleted'. Interactively you +will be prompted for the labels to be deleted. You can use +completion to expand the label names, with the completion list +being all the labels that have ever been used in this folder. +The names should be entered as a space separated list. Label +names are compared case-insensitively. + +A numeric prefix argument COUNT causes the current message and +the next COUNT-1 message to have the labels deleted. A +negative COUNT arg causes the current message and the previous +COUNT-1 messages to be altered. COUNT defaults to one." + (interactive + (let ((last-command last-command) + (this-command this-command) + (vm-completion-auto-correct nil) + (completion-ignore-case t)) + ;; so the user can see what message they are about to + ;; modify. + (save-current-buffer + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (list + (vm-read-string "Delete labels: " + (vm-obarray-to-string-list vm-label-obarray) t) + (prefix-numeric-value current-prefix-arg))))) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-error-if-folder-read-only) + (let ((m-list (vm-select-operable-messages + count (vm-interactive-p) "Delete labels to"))) + (vm-add-or-delete-message-labels string m-list nil))) + +(defun vm-add-or-delete-message-labels (string m-list add) + "Add or delete the labels given in STRING for all messages in +M-LIST. The third parameter ADD is one of: + +nil delete the label +'all add the label in all cases +'existing-only add the label only if it is already existing in the folder + USR, 2010-12-20 +" + (vm-display nil nil '(vm-add-message-labels vm-delete-message-labels) + (list this-command)) + (setq string (downcase string)) + (let ((action-labels (vm-parse string +"[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*")) + (ignored-labels nil) + labels act-labels m mm-list) + (when (and add m-list) + (if (eq add 'all) + (progn + (setq act-labels action-labels) + (while act-labels + (intern (car act-labels) vm-label-obarray) + (setq act-labels (cdr act-labels)))) + (let ((newlist nil)) + (setq act-labels action-labels) + (while act-labels + (if (intern-soft (car act-labels) vm-label-obarray) + (setq newlist (cons (car act-labels) newlist)) + (setq ignored-labels (cons (car act-labels) ignored-labels))) + (setq act-labels (cdr act-labels))) + (setq action-labels newlist)))) + (unless action-labels + (setq m-list nil)) + (while m-list + (setq m (car m-list)) + (when (and add (vm-virtual-message-p m)) + (let ((labels action-labels)) + (with-current-buffer (vm-buffer-of (vm-real-message-of m)) + (while labels + (intern (car labels) vm-label-obarray) + (setq labels (cdr labels)))))) + (when add + (dolist (mm (vm-virtual-messages-of m)) + (let ((labels action-labels)) + (when (buffer-name (vm-buffer-of mm)) + (with-current-buffer (vm-buffer-of mm) + (while labels + (intern (car labels) vm-label-obarray) + (setq labels (cdr labels)))))))) + (setq act-labels action-labels + labels (copy-sequence (vm-labels-of (car m-list)))) + (if add + (while act-labels + (setq labels (cons (car act-labels) labels) + act-labels (cdr act-labels))) + (while act-labels + (setq labels (vm-delqual (car act-labels) labels) + act-labels (cdr act-labels)))) + (when add + (setq labels (vm-delete-duplicates labels))) + (vm-set-labels (car m-list) labels) + (vm-set-attribute-modflag-of (car m-list) t) ; added by USR + (setq m-list (cdr m-list))) + (vm-update-summary-and-mode-line) + ignored-labels)) + +(defun vm-set-xxxx-flag (m flag norecord function attr-index) + "A generic function to set the message flag of M at ATTR-INDEX to + the value FLAG. The argument FUNCTION tells the specific + non-generic function that invoked this one. A boolean flag is + returned indicating success or failure of the operation. +The flag is also set for all the virtual messages mirroring M as well + as the real message underlying M. +Normally, a record of the change is kept for the purpose of undo, and + the changed attributes are stuffed into the folder, but NORECORD + suppresses all of this. USR 2010-04-06" + (let ((m-list nil) vmp) + (when (and (not vm-folder-read-only) + (or (not (vm-virtual-messages-of m)) + (not (with-current-buffer + (vm-buffer-of + (vm-real-message-of m)) + vm-folder-read-only))) + ;; do nothing it is is already set + (not (eq flag (aref (vm-attributes-of m) attr-index)))) + (unless norecord + (dolist (v-m (cons (vm-real-message-of m) (vm-virtual-messages-of m))) + (if (eq (vm-attributes-of m) (vm-attributes-of v-m)) + (setq m-list (cons v-m m-list)))) + (if (null m-list) + (setq m-list (cons m m-list))) + (save-excursion + (dolist (mm m-list) + (when (buffer-name (vm-buffer-of mm)) + (set-buffer (vm-buffer-of mm)) + (cond ((not (buffer-modified-p)) + (vm-mark-folder-modified-p (vm-buffer-of mm)) + (vm-undo-record (list 'vm-set-buffer-modified-p nil)))) + (vm-undo-record (list function mm (not flag))) + ;; (vm-undo-boundary) + (vm-increment vm-modification-counter))))) + (aset (vm-attributes-of m) attr-index flag) + (vm-mark-for-summary-update m) + (unless norecord + (vm-set-attribute-modflag-of m t) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-message-data m) + (vm-set-stuff-flag-of m t))) + ;; return success result + t))) + +(defun vm-set-xxxx-cached-data-flag (m flag norecord function attr-index) + "A generic function to set the cached-data flag of M at ATTR-INDEX to + the value FLAG. The argument FUNCTION tells the specific + non-generic function that invoked this one. +The flag is also set for all the virtual messages mirroring M as well + as the real message underlying M. +Normally, a record of the change is kept for the purpose of undo, and + the changed attributes are stuffed into the folder, but NORECORD + suppresses all of this. USR 2010-04-06" + (let ((m-list nil) vmp) + (when + (and (not vm-folder-read-only) + (or (not (vm-virtual-messages-of m)) + (not (with-current-buffer + (vm-buffer-of + (vm-real-message-of m)) + vm-folder-read-only))) + ;; do nothing it is is already set + (not (eq flag (aref (vm-cached-data-of m) attr-index)))) + (unless norecord + (dolist (v-m (cons (vm-real-message-of m) (vm-virtual-messages-of m))) + (if (eq (vm-cached-data-of m) (vm-cached-data-of v-m)) + (setq m-list (cons v-m m-list)))) + (if (null m-list) + (setq m-list (cons m m-list))) + (save-excursion + (dolist (mm m-list) + (when (buffer-name (vm-buffer-of mm)) + (set-buffer (vm-buffer-of mm)) + (cond ((not (buffer-modified-p)) + (vm-mark-folder-modified-p (vm-buffer-of mm)) + (vm-undo-record (list 'vm-set-buffer-modified-p nil)))) + (vm-undo-record (list function mm (not flag))) + ;; (vm-undo-boundary) + (vm-increment vm-modification-counter))))) + (aset (vm-cached-data-of m) attr-index flag) + (vm-mark-for-summary-update m) + (unless norecord + (vm-set-attribute-modflag-of m t) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-message-data m) + (vm-set-stuff-flag-of m t)))))) + + +(defun vm-set-labels (m labels) + "Set the message labels of M to the value LABELS (a list of + strings). +The labels are also set for all the virtual messages mirroring M as + well as the real message underlying M. +A record of the change is kept for the purpose of undo, and the + changed attributes are stuffed into the folder. USR 2010-04-06" + (let ((m-list nil) + (old-labels (vm-labels-of m))) + (cond + ((and (not vm-folder-read-only) + (or (not (vm-virtual-messages-of m)) + (not (save-excursion + (set-buffer + (vm-buffer-of + (vm-real-message-of m))) + vm-folder-read-only)))) + (dolist (v-m (cons (vm-real-message-of m) (vm-virtual-messages-of m))) + (if (eq (vm-attributes-of m) (vm-attributes-of v-m)) + (setq m-list (cons v-m m-list)))) + (if (null m-list) + (setq m-list (cons m m-list))) + (save-excursion + (dolist (mm m-list) + (when (buffer-name (vm-buffer-of mm)) + (set-buffer (vm-buffer-of mm)) + (cond ((not (buffer-modified-p)) + (vm-mark-folder-modified-p (vm-buffer-of mm)) + (vm-undo-record (list 'vm-set-buffer-modified-p nil)))) + (vm-undo-record (list 'vm-set-labels m old-labels)) + ;; (vm-undo-boundary) + (vm-increment vm-modification-counter)))) + (vm-set-labels-of m labels) + (vm-set-label-string-of m nil) + (vm-mark-for-summary-update m) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-message-data m) + (vm-set-stuff-flag-of m t)))))) + + +;; This flag is defunct, replaced by body-to-be-discarded. USR, 2010-06-08 +(defun vm-set-headers-to-be-retrieved-flag (m flag &optional norecord) + nil) + +(defun vm-set-body-to-be-discarded-flag (m flag &optional norecord) + (vm-set-xxxx-cached-data-flag + m flag norecord 'vm-set-body-to-be-discarded-flag 21)) + +(defun vm-set-body-to-be-retrieved-flag (m flag &optional norecord) + (vm-set-xxxx-cached-data-flag + m flag norecord 'vm-set-body-to-be-retrieved-flag 22)) + +(defun vm-set-new-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-new-flag 0)) + +(defun vm-set-unread-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-unread-flag 1)) + +(defun vm-set-deleted-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-deleted-flag 2)) + +(defun vm-set-filed-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-filed-flag 3)) + +(defun vm-set-replied-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-replied-flag 4)) + +(defun vm-set-written-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-written-flag 5)) + +(defun vm-set-forwarded-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 6)) + +(defun vm-set-redistributed-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 8)) + +(defun vm-set-flagged-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 9)) + +(defun vm-set-folded-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 10)) + +(defun vm-set-watched-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 11)) + +(defun vm-set-ignored-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 12)) + +(defun vm-set-read-receipt-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 13)) + +(defun vm-set-read-receipt-sent-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 14)) + +(defun vm-set-attachments-flag (m flag &optional norecord) + (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 15)) + +;; use these to avoid undo and summary update. +(defun vm-set-new-flag-of (m flag) (aset (aref m 2) 0 flag)) +(defun vm-set-unread-flag-of (m flag) (aset (aref m 2) 1 flag)) +(defun vm-set-deleted-flag-of (m flag) (aset (aref m 2) 2 flag)) +(defun vm-set-filed-flag-of (m flag) (aset (aref m 2) 3 flag)) +(defun vm-set-replied-flag-of (m flag) (aset (aref m 2) 4 flag)) +(defun vm-set-written-flag-of (m flag) (aset (aref m 2) 5 flag)) +(defun vm-set-forwarded-flag-of (m flag) (aset (aref m 2) 6 flag)) +(defun vm-set-redistributed-flag-of (m flag) (aset (aref m 2) 8 flag)) +(defun vm-set-flagged-flag-of (m flag) (aset (aref m 2) 9 flag)) +(defun vm-set-folded-flag-of (m flag) (aset (aref m 2) 10 flag)) +(defun vm-set-watched-flag-of (m flag) (aset (aref m 2) 11 flag)) +(defun vm-set-ignored-flag-of (m flag) (aset (aref m 2) 12 flag)) +(defun vm-set-read-receipt-flag-of (m flag) (aset (aref m 2) 13 flag)) +(defun vm-set-read-receipt-sent-flag-of (m flag) (aset (aref m 2) 14 flag)) +(defun vm-set-attachments-flag-of (m flag) (aset (aref m 2) 15 flag)) + +;; this is solely for the use of vm-stuff-message-data and +;; appears here only because this function should be grouped with +;; others of its kind for maintenance purposes. +(defun vm-set-deleted-flag-in-vector (v flag) + (aset v 2 flag)) +;; ditto. this is for vm-read-attributes. +(defun vm-set-new-flag-in-vector (v flag) + (aset v 0 flag)) + +;;; vm-undo.el ends here diff --git a/lisp/vm-user.el b/lisp/vm-user.el new file mode 100755 index 0000000..8d41161 --- /dev/null +++ b/lisp/vm-user.el @@ -0,0 +1,62 @@ +;;; vm-user.el --- Interface functions to VM internal data +;; +;; This file is part of VM +;; +;; Copyright (C) 1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-user) + +(defun vm-user-composition-folder-buffer () + "Return the folder buffer associated with the current buffer. +The current buffer must be a composition buffer created by VM for +a reply, resend or forward. + +Nil is returned if the current buffer is not associated with any +VM folder. + +Note that the buffer returned might be a virtual folder buffer, +which might have several underlying real folders associated with +it. To get the list of real folder buffers associated with a +composition buffer, use vm-user-composition-real-folder-buffers +instead." + (if (eq major-mode 'mail-mode) + vm-mail-buffer + nil )) + +(defun vm-user-composition-real-folder-buffers () + "Returns a list of the real folder buffers associated with the current +buffer. The current buffer must be a composition buffer created +by VM for a reply, resend or forward." + (if (eq major-mode 'mail-mode) + (let ((list nil) (newlist nil)) + (cond ((eq vm-system-state 'replying) + (setq list vm-reply-list)) + ((eq vm-system-state 'forwarding) + (setq list vm-forward-list)) + ((eq vm-system-state 'redistributing) + (setq list vm-redistribute-list))) + (while list + (setq newlist (cons (vm-buffer-of (vm-real-message-of (car list))) + newlist) + list (cdr list))) + newlist ) + nil )) + +;;; vm-user.el ends here diff --git a/lisp/vm-vars.el b/lisp/vm-vars.el new file mode 100755 index 0000000..aca979e --- /dev/null +++ b/lisp/vm-vars.el @@ -0,0 +1,7357 @@ + +;;; vm-vars.el --- VM user and internal variable initialization +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-2003 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-vars) + +(require 'vm-version) + +(declare-function vm-parse "vm-misc" (string regexp &optional matchn matches)) +(declare-function vm-delete-directory-names "vm-misc" (list)) +(declare-function vm-display "vm-window" + (buffer display commands configs &optional do-not-raise)) + +(declare-function xemacs-locate-data-directory "vm-xemacs" (name)) +(fset 'xemacs-locate-data-directory 'locate-data-directory) +;; Don't use vm-device-type here because it may not be loaded yet. +(declare-function device-type "vm-xemacs" ()) +;; (fset 'xemacs-device-type 'device-type) + +;; Custom group definitions +(defgroup vm nil + "The VM mail reader." + :link '(custom-manual "(vm)Top") + :link '(url-link :tag "VM Homepage" "http://www.nongnu.org/viewmail/") + :group 'mail) + +(defgroup vm-faces nil + "Faces for VM." + :group 'vm) + +(defgroup vm-misc nil + "Miscellaneous VM configuration options." + :group 'vm) + +(defgroup vm-folders nil + "Mail folder settings for VM." + :group 'vm) + +(defgroup vm-pop nil + "POP3 mail folders for VM." + :group 'vm-folders) + +(defgroup vm-imap nil + "IMAP mail folders for VM." + :group 'vm-folders) + +(defgroup vm-mime nil + "MIME options for VM." + :group 'vm) + +(defgroup vm-helpers nil + "External helper programs used by VM." + :group 'vm) + +(defgroup vm-summary nil + "Options for VM's summary window." + :group 'vm) + +(defgroup vm-hooks nil + "Hooks for the VM mail reader." + :group 'vm) + +(defgroup vm-digest nil + "Options affecting VM's handling of digests." + :group 'vm) + +(defgroup vm-frames nil + "Options affecting frames and windows in VM." + :group 'vm) + +(defgroup vm-url nil + "Options affecting handling of URLs in VM." + :group 'vm) + +(defgroup vm-compose nil + "Options affecting mail composition within VM." + :group 'vm) + +(defgroup vm-presentation nil + "Options affecting the presentation of messages in VM." + :group 'vm) + +(defgroup vm-dispose nil + "Options affecting the saving, deleting and expunging of messages in VM." + :group 'vm) + +(defgroup vm-print nil + "Options affecting printing of messages in VM." + :group 'vm) + +(defgroup vm-toolbar nil + "Options affecting the VM toolbar" + :group 'vm) + +(defgroup vm-add-ons nil + "Options for non-core VM extensions" + :group 'vm) + +;; Custom variable definitions + +(defcustom vm-assimilate-new-messages-sorted nil + "*When enabled new messages will be inserted in current sort order. +Otherwise they are appended to the folder, which is VM default." + :group 'vm-presentation + :type 'boolean) + +(defcustom vm-init-file "~/.vm" + "*Startup file for VM that is loaded the first time you run VM +in an Emacs session." + :group 'vm-misc + :type 'file) + +(defcustom vm-preferences-file "~/.vm.preferences" + "*Secondary startup file for VM, loaded after `vm-init-file'. It is +meant for specifying the preferred settings for VM variables." + :group 'vm-misc + :type 'file) + +(defcustom vm-temp-file-directory + (or (getenv "TMPDIR") + (and (file-directory-p "/tmp") "/tmp") + (and (file-directory-p "C:\\TEMP") "C:\\TEMP") + (and (file-directory-p "C:\\") "C:\\") + "/tmp") + "*Name of a directory where VM can put temporary files." + :group 'vm-misc + :type 'directory) + +(defcustom vm-folder-directory nil + "*Directory where folders of mail are kept." + :group 'vm-folders + :type '(choice (const nil) directory)) + +(defcustom vm-thunderbird-folder-directory nil + "*Directory where Thunderbird's local folders are kept. This +setting is used in `vm-visit-thunderbird-folder'. + +Note that only Thunderbird's local folders can be visited in VM, +not its IMAP folders. " + :group 'vm-folders + :type '(choice (const nil) directory)) + +(defvar vm-foreign-folder-directory nil + "If the current folder is a \"foreign\" folder, i.e., maintained by +anothe mail client such as Thunderbird, then this variable holds its +directory.") + +(defcustom vm-primary-inbox "~/INBOX" + "*Mail is moved from the system mailbox to this file for reading." + :group 'vm-folders + :type 'file) + +(defcustom vm-crash-box nil + "*File in which to store mail temporarily while it is transferred from +the system mailbox to the primary inbox. If a crash occurs +during this mail transfer, any missing mail will be found in this +file. VM will do crash recovery from this file automatically at +startup, as necessary. + +If the variable is to nil, a crash box name is created by appending +`vm-primary-inbox' and `vm-crash-box-suffix'." + :group 'vm-folders + :type '(choice file + (const :tag "Use vm-crash-box-suffix" nil))) + +(defcustom vm-crash-box-suffix ".crash" + "*String suffix used to create possible crash box file names for folders. +When VM uses `vm-spool-file-suffixes' to create a spool file name, +it will append the value of `vm-crash-box-suffix' to the folder's +file name to create a crash box name." + :group 'vm-folders + :type '(choice string + (const :tag "No crash boxes" nil))) + +(defcustom vm-keep-crash-boxes nil + "*Non-nil value should be a string specifying a directory where +your crash boxes should be moved after VM has copied new mail +out of them. This is a safety measure. In at least one case a +pointer corruption bug inside Emacs has caused VM to believe that +it had copied information out of the crash box when it in fact +had not. VM then deleted the crash box, losing the batch of +incoming mail. This is an exceedingly rare problem, but if you +want to avoid losing mail if it happens, set `vm-keep-crash-boxes' +to point to a directory in the same filesystem as all your +crash boxes. Each saved crash box will have a unique name based +on the current date and time the box was saved. You will need to +clean out this directory from time to time; VM does not do so. + +A nil value means VM should just delete crash boxes after it +has copied out the mail." + :group 'vm-folders + :type '(choice directory + (const :tag "No, do not keep crash boxes" nil))) + +(defcustom vm-fetched-message-limit 10 + "*Should be an integer representing the maximum number of messages +that VM should keep in the Folder buffer when the messages are +fetched on demand, or nil to signify no limit." + :group 'vm-folders + :type '(choice (const :tag "No Limit" nil) + (integer :tag "Number of Mesages"))) + +(defcustom vm-index-file-suffix nil + "*Suffix used to construct VM index file names, e.g., \".inx\". +When VM visits a folder, it checks for the existence of a file +whose name is the folder's file name with the value of this +variable appended to it. If found, the file's contents will be +used to tell VM about the contents of the folder. This is faster +than parsing the folder itself. + +When you save a folder, the index file will be rewritten with +updated information about the folder. + +A nil value means VM should not read or write index files." + :group 'vm-folders + :type '(choice (string :tag "File Suffix") + (const :tag "Do not use index file" nil))) + +(defcustom vm-enable-external-messages nil + "*Non-nil value should be a list of contexts in which VM may +use message bodies stored externally. External messages are +those stored in external sources such as the file system or +remote mail servers. In some cases, VM is able to work with +minimal header information of the messages, without loading the +entire message bodies into the folder buffers. + +This allows faster start-up times and smaller memory images of +Emacs sessions, at the cost of short delays when messages are +viewed. + +As of version 8.2.0, this facility is only available for IMAP +folders (context name `imap'). Messages larger than +`vm-imap-max-message-size' are treated as external messages." + :group 'vm-folders + :type '(repeat (choice (const imap)))) + +(defvar vm-load-headers-only nil + "This variable is replaced by `vm-enable-external-messages'.") +(make-obsolete-variable 'vm-load-headers-only + 'vm-enable-external-messages "8.2.0") + +;; use this function to access vm-spool-files on the fly. this +;; allows us to use environmental variables without setting +;; vm-spool-files at load time and thereby making it hard to dump an +;; Emacs containing a preloaded VM. +(defun vm-spool-files () + (or vm-spool-files + (and (setq vm-spool-files (getenv "MAILPATH")) + (setq vm-spool-files + (vm-delete-directory-names + (vm-parse vm-spool-files + "\\([^:%?]+\\)\\([%?][^:]*\\)?\\(:\\|$\\)")))) + (and (setq vm-spool-files (getenv "MAIL")) + (setq vm-spool-files (vm-delete-directory-names + (list vm-spool-files)))))) + +(defcustom vm-spool-files nil + "*If non-nil this variable's value should be a list of strings +or a list of lists. + +If the value is a list of strings, the strings should name files +that VM will check for incoming mail instead of the default place +VM thinks your system mailbox is. Mail will be moved from these +mailboxes to your primary inbox as specified by `vm-primary-inbox', +using `vm-crash-box' as a waystation. + +If the value is a list of lists, each sublist should be of the form + + (INBOX SPOOLNAME CRASHBOX) + +INBOX, SPOOLNAME and CRASHBOX are all strings. + +INBOX is the folder where you want your new mail to be moved when +you type 'g' (running `vm-get-new-mail') in VM. It is where you +will read the mail. + +SPOOLNAME is where the mail system leaves your incoming mail, +e.g. /var/spool/mail/kyle. It can also be a mailbox +specification of the form, \"po:USER\", where USER is a user +name. VM will pass this specification to the movemail program. +It is up to movemail to interpret it and figure out where to find +your mailbox. Some systems use special authentication methods that +are only accessible via the movemail program. + +SPOOLNAME can also be a POP maildrop. + + A POP maildrop specification has the following format: + + \"pop:HOST:PORT:AUTH:USER:PASSWORD\" + or + \"pop-ssl:HOST:PORT:AUTH:USER:PASSWORD\" + or + \"pop-ssh:HOST:PORT:AUTH:USER:PASSWORD\" + + The second form is used to speak POP over an SSL connection. + For this to work you should either have a version of Emacs + with SSL capability or you have the stunnel program installed + and set the variable `vm-stunnel-program'. The SSL version + of the POP server will not use the same port as the non-SSL + version. + + The third form is used to speak POP over an SSH connection. + You must have the ssh program installed and the variable + `vm-ssh-program' must name it in order for POP over SSH to + work. SSH must be able to authenticate without a password, + which means you must be using either .shosts authentication + or RSA authentication. + + HOST is the host name of the POP server + + PORT is the TCP port number to connect to. This should + normally be 110, unless you're using POP over SSL in which + case the stanard port is 995. + + USER is the user name sent to the server. + + PASSWORD is the secret shared by you and the server for + authentication purposes. How is it used depends on the value of + the AUTH parameter. If the PASSWORD is \"*\", VM will prompt + you for the password the first time you try to retrieve mail from + maildrop. If the password is valid, VM will not ask you for the + password again during this Emacs session. + + AUTH is the authentication method used to convince the server you + should have access to the maildrop. Acceptable values are + \"pass\", \"rpop\" and \"apop\". For \"pass\", the PASSWORD is sent to + the server with the POP PASS command. For \"rpop\", the PASSWORD + should be the string to be sent to the server via the RPOP + command. In this case the string is not really a secret; + authentication is done by other means. For \"apop\", an MD5 digest + of the PASSWORD appended to the server timestamp will be sent to + the server with the APOP command. In order to use \"apop\" you + will have to set the value of `vm-pop-md5-program' appropriately to + point at the program that will generate the MD5 digest that VM + needs. + +SPOOLNAME can also be an IMAP maildrop. + + An IMAP maildrop specification has the following format: + + \"imap:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + or + \"imap-ssl:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + or + \"imap-ssh:HOST:PORT:MAILBOX:AUTH:USER:PASSWORD\" + + The second form is used to speak IMAP over an SSL connection. + For this to work, you should either be using a version of + Emacs with SSL capability or you must have the stunnel + program installed and the variable `vm-stunnel-program' + naming it. + + The third form is used to speak IMAP over an SSH connection. + You must have the ssh program installed and the variable + `vm-ssh-program' must name it in order for IMAP over SSH to + work. SSH must be able to authenticate without a password, + which means you must be using .shosts authentication or + public key user authentication. + + HOST is the host name of the IMAP server. + + PORT is the TCP port number to connect to. This should + normally be 143. For IMAP over SSL, the standard port is + 993. There is no special port for IMAP over SSH. + + MAILBOX is the name of the mailbox on the IMAP server. Should + be \"inbox\", to access your default IMAP maildrop on the + server. + + AUTH is the authentication method used to convince the server + you should have access to the maildrop. Acceptable values + are \"preauth\", \"login\" and \"cram-md5\". \"preauth\" + causes VM to skip the authentication stage of the protocol + with the assumption that the session was authenticated in some + external way. \"login\", tells VM to use the IMAP LOGIN + command for authentication, which sends your username and + password in cleartext to the server. \"cram-md5\" is a + challenge response system that convinces the server of your + identity without transmitting your password in the clear. + Not all servers support \"cram-md5\"; if you're not sure, ask + your mail administrator or just try it. + + USER is the user name used with authentication methods that + require such an identifier. \"login\" and \"cram-md5\" + use it currently. + + PASSWORD is the secret shared by you and the server for + authentication purposes. If the PASSWORD is \"*\", VM + will prompt you for the password the first time you try to + retrieve mail from maildrop. If the password is valid, VM + will not ask you for the password again during this Emacs + session. + +CRASHBOX is the temporary file that VM uses to store mail in +transit between the SPOOLNAME and the INBOX. If the system +crashes or Emacs dies while mail is being moved, and the new +mail is not in the SPOOLNAME or the INBOX, then it will be in +the CRASHBOX. + +There can be multiple entries with the same INBOX value, but a +particular SPOOLNAME should appear only once. CRASHBOXes should +not be shared among different INBOXes, but you can use the same +CRASHBOX/INBOX pair with a different SPOOLNAME. + +`vm-spool-files' will default to the value of the shell +environmental variables MAILPATH or MAIL if either of these +variables are defined and no particular value for `vm-spool-files' +has been specified." + :group 'vm-folders + :type '(choice (repeat :tag "List of spool files" + (file :tag "Spoolfile")) + (repeat :tag "List of (inbox spoolfile crashbox) elements" + (list (file :tag "Inbox") + (file :tag "Spoolfile") + (file :tag "Crashbox"))))) + +(defcustom vm-spool-file-suffixes nil + "*List of suffixes to be used to create possible spool file names +for folders. Example: + + (setq vm-spool-file-suffixes '(\".spool\" \"-\")) + +If you visit a folder ~/mail/beekeeping, when VM attempts to +retrieve new mail for that folder it will look for mail in +~/mail/beekeeping.spool and ~/mail/beekeeping- in addition to +scanning `vm-spool-files' for matches. + +The value of `vm-spool-files-suffixes' will not be used unless +`vm-crash-box-suffix' is also defined, since a crash box is +required for all mail retrieval from spool files." + :group 'vm-folders + :type '(repeat string)) + +(defcustom vm-make-spool-file-name nil + "*Non-nil value should be a function that returns a spool file name +for a folder. The function will be called with one argument, the +folder's file name. If the folder does not have a file name, +the function will not be called." + :group 'vm-folders + :type '(choice (const :tag "Default" nil) + function)) + +(defcustom vm-make-crash-box-name nil + "*Non-nil value should be a function that returns a crash box file name +for a folder. The function will be called with one argument, the +folder's file name. If the folder does not have a file name, +the function will not be called." + :group 'vm-folders + :type '(choice (const :tag "Default" nil) + function)) + +(defconst vm-pop-md5-program "md5" + "*Program that reads a message on its standard input and writes an +MD5 digest on its output.") + +(defcustom vm-pop-max-message-size nil + "*If VM is about to retrieve via POP a message larger than this +size (in bytes) it will ask the you whether it should retrieve +the message. + +If VM is retrieving mail automatically because `vm-auto-get-new-mail' +is set to a numeric value then you will not be prompted about large +messages. This is to avoid prompting you while you're typing in +another buffer. In this case the large message will be skipped with a +warning message. You will be able to retrieved any skipped messages +later by running `vm-get-new-mail' interactively. + +A nil value for `vm-pop-max-message-size' means no size limit." + :group 'vm-pop + :type '(choice (const :tag "No Limit" nil) + (integer :tag "Bytes"))) + +(defcustom vm-pop-messages-per-session nil + "*Non-nil value should be an integer specifying how many messages to +retrieve per POP session. When you type 'g' to get new mail, VM +will only retrieve that many messages from any particular POP maildrop. +To retrieve more messages, type 'g' again. + +A nil value means there's no limit." + :group 'vm-pop + :type '(choice (const :tag "No Limit" nil) + integer)) + +(defcustom vm-pop-bytes-per-session nil + "*Non-nil value should be an integer specifying how many bytes to +retrieve per POP session. When you type 'g' to get new mail, VM +will only retrieve messages until the byte limit is reached on +any particular POP maildrop. To retrieve more messages, type 'g' +again. + +A nil value means there's no limit." + :group 'vm-pop + :type '(choice (const :tag "No Limit" nil) + (integer :tag "Bytes"))) + +(defcustom vm-pop-expunge-after-retrieving nil + "*Non-nil value means that, when a POP mailbox is used as a +spool file, messages should be deleted after retrieving them. A +nil value means messages will be left in the POP mailbox until +you run `vm-expunge-pop-messages'. VM can only support a nil +value for this variable if the remote POP server supports the +UIDL command. If the server does not support UIDL and you've +asked VM leave messages on the server, VM will complain about the +lack of UIDL support and not retrieve messages from the server. + +This variable only affects POP mailboxes not listed in +`vm-pop-auto-expunge-alist' (which is the recommended method for +customizing this behavior)." + :group 'vm-pop + :type 'boolean) + +(defcustom vm-pop-auto-expunge-alist nil + "*List of POP mailboxes and values specifying whether messages +should be automatically deleted from the mailbox after retrieval. +The format of the list is + + ((MAILBOX . VAL) (MAILBOX . VAL) ...) + +MAILBOX should be a POP mailbox specification as described in +the documentation for the variable `vm-spool-files'. If you have +the POP password specified in the `vm-spool-files' entry, you do +not have to specify it here as well. Use `*' instead; VM will +still understand that this mailbox is the same as the one in +`vm-spool-files' that gives the password. + +VAL should be nil if retrieved messages should be left in the +corresponding POP mailbox, t if retrieved messages should be +deleted from the mailbox immediately after retrieval. + +VM can only support a non-nil setting of this variable if the +remote POP server supports the UIDL command. If the server does +not support UIDL and you've asked to VM leave messages on the server, +VM will complain about the lack of UIDL support and not retrieve +messages from the server." + :group 'vm-pop + :type '(repeat (cons string boolean))) + +(defvar vm-pop-auto-expunge-warned nil + "List of POP mailboxes for which warning has been given about the +lack of settings for auto-expunge.") + +(defcustom vm-pop-read-quit-response t + "*Non-nil value tells VM to read the response to the POP QUIT command. +Sometimes, for reasons unknown, the QUIT response never arrives +from some POP servers and VM will hang waiting for it. So it is +useful to be able to tell VM not to wait. Some other +servers will not expunge messages unless the QUIT response is +read, so for these servers you should set the variable's value to +t." + :group 'vm-pop + :type 'boolean) + +(defconst vm-recognize-pop-maildrops + "^\\(pop\\|pop-ssl\\|pop-ssh\\):[^:]+:[^:]+:[^:]+:[^:]+:.+" + "Regular expression matching the maildrop specification of POP + folders. It can be set to nil to prohibit POP maildrops.") + +(defcustom vm-pop-folder-alist nil + "*Alist of POP maildrop specifications and names that refer to them. +The alist format is: + + ((POPDROP NAME) ...) + +POPDROP is a POP maildrop specification in the same format used +by `vm-spool-files' (which see). + +NAME is a string that should give a less cumbersome name that you +will use to refer to this maildrop when using `vm-visit-pop-folder'." + :group 'vm-pop + :type '(repeat (list string string))) + +(defcustom vm-pop-folder-cache-directory nil + "*Directory where VM stores cached copies of POP folders. +When VM visits a POP folder (really just a POP server where you +have a mailbox) it stores the retrieved message on your computer +so that they need not be retrieved each time you visit the folder. +The cached copies are stored in the directory specified by this +variable." + :group 'vm-pop + :type '(choice (const nil) directory)) + +(defcustom vm-imap-max-message-size nil + "*The largest message size of IMAP messages that VM should retrieve +automatically. + +If VM encounters an IMAP message larger than this size, the action +is as follows: + +- In IMAP folders, the message is treated as an external message if +`vm-enable-external-messages' includes 'imap. Otherwise it is +retrieved. + +- In local folders, the message is skipped if it is part of +automatical mail retrieval. During interactive mail retrieval, obtained by +running `vm-get-new-mail', VM queries you whether it should be retrieved. + +A nil value for `vm-imap-max-message-size' means no size limit." + :group 'vm-imap + :type '(choice (const :tag "Unlimited" nil) + (integer :tag "Bytes"))) + +(defcustom vm-imap-messages-per-session nil + "*Non-nil value should be an integer specifying how many messages to +retrieve per IMAP session. When you type 'g' to get new mail, VM +will only retrieve that many messages from any particular IMAP maildrop. +To retrieve more messages, type 'g' again. + +A nil value means there's no limit." + :group 'vm-imap + :type '(choice (const :tag "Unlimited" nil) integer)) + +(defcustom vm-imap-bytes-per-session nil + "*Non-nil value should be an integer specifying how many bytes to +retrieve per IMAP session. When you type 'g' to get new mail, VM +will only retrieve messages until the byte limit is reached on +any particular IMAP maildrop. To retrieve more messages, type 'g' +again. + +A nil value means there's no limit." + :group 'vm-imap + :type '(choice (const :tag "No Limit" nil) + (integer :tag "Bytes"))) + +(defcustom vm-imap-expunge-after-retrieving nil + "*Non-nil value means that, when an IMAP mailbox is used as a +spool file, messages should be deleted after retrieving them. A +nil value means messages will be left in the IMAP mailbox until +you run `vm-expunge-imap-messages'. + +This variable only affects IMAP mailboxes not listed in +`vm-imap-auto-expunge-alist' (which is the recommended method for +customizing this behavior)." + :group 'vm-imap + :type 'boolean) + +(defcustom vm-imap-auto-expunge-alist nil + "*List of IMAP mailboxes and values specifying whether messages +should be automatically deleted from the mailbox after retrieval. +The format of the list is + + ((MAILBOX . VAL) (MAILBOX . VAL) ...) + +MAILBOX should be an IMAP mailbox specification as described in +the documentation for the variable `vm-spool-files'. If you have +the IMAP password specified in the `vm-spool-files' entry, you do +not have to specify it here as well. Use `*' instead; VM will +still understand that this mailbox is the same as the one in +`vm-spool-files' that contains the password. + +VAL should be nil if retrieved messages should be left in the +corresponding IMAP mailbox, t if retrieved messages should be +deleted from the mailbox immediately after retrieval." + :group 'vm-imap + :type '(repeat (cons (string :tag "IMAP Folder Specificaiton") + boolean))) + +(defvar vm-imap-auto-expunge-warned nil + "List of IMAP mailboxes for which warning has been given about the +lack of settings for auto-expunge.") + +(defconst vm-recognize-imap-maildrops + "^\\(imap\\|imap-ssl\\|imap-ssh\\):[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:.+" + "Regular expression matching maildrop specificaiton of IMAP +folders. It can be set to nil to prohibit the recognition of +IMAP maildrops.") + +(defvar vm-imap-server-list nil + "*List of IMAP maildrop specifications that tell VM the IMAP servers +you have access to and how to log into them. The IMAP maildrop +specification in the same format used by `vm-spool-files' (which +see). The mailbox part of the specifiation is ignored and should +be asterisk or some other placeholder. + +***This customization variable is deprecated. Use `vm-imap-account-alist' +instead. + +Example: + (setq vm-imap-server-list + '( + \"imap-ssl:mail.foocorp.com:993:inbox:login:becky:*\" + \"imap:crickle.lex.ky.us:143:inbox:login:becky:*\" + ) + )" +) + +(make-obsolete-variable 'vm-imap-server-list + 'vm-imap-account-alist "8.1.0") + +(defcustom vm-imap-account-alist nil + "*Alist of IMAP account specifications and names that refer to them. +The alist format is: + + ((IMAPDROP NAME) ...) + +IMAPDROP is a IMAP maildrop specification in the same format used +by `vm-spool-files' (which see). + +NAME is a string that should give a less cumbersome name that you +will use to refer to this maildrop when using `vm-visit-imap-folder'. + +Example: + (setq vm-imap-account-alist + '( + (\"imap-ssl:mail.foocorp.com:993:inbox:login:becky:*\" \"becky\") + (\"imap:crickle.lex.ky.us:143:inbox:login:becky:*\" \"crickle\") + ) + ) +" + :group 'vm-imap + :type '(repeat (list (string :tag "IMAP Folder Specification") + (string :tag "Nickname")))) + +(defcustom vm-imap-default-account nil + "*Set this variable to a string denoting the name of an IMAP account + (short name) declared in `vm-imap-account-alist'. The account + specified here will be regarded as the default account for + various purposes, e.g., for saving copies of outgoing mail." + :group 'vm-imap + :type '(choice (const :tag "None" nil) + (string :tag "IMAP Account"))) + +(defcustom vm-imap-refer-to-inbox-by-account-name nil + "*If set to non-nil, the INBOX folders on IMAP accounts are +referred to by their account names instead of as \"INBOX\". The +account names are those declared in `vm-imap-account-alist'. +This is useful if one wants to handle multiple IMAP accounts +during the same VM session, all of which might have an \"INBOX\" +folder." + :group 'vm-imap + :type 'boolean) + +(defcustom vm-imap-tolerant-of-bad-imap nil + "*Level of tolerance that vm should use for IMAP servers that +don't follow the IMAP specification. Default of NIL or 0 means no +tolerance. Level 1 allows possibly harmless violations of +prohibitions. (But these violations could also be symptomatic of +deeper problems.) Use this level carefully. Higher levels of +violations are not currently permitted." + :group 'vm-imap + :type '(choice (const :tag "No Tolerance" nil) + (const :tag "Tolerant" 1))) + +(defcustom vm-imap-folder-cache-directory nil + "*Directory where VM stores cached copies of IMAP folders. +When VM visits a IMAP folder (really just a IMAP server where you +have a mailbox) it stores the retrieved message on your computer +so that they need not be retrieved each time you visit the folder. +The cached copies are stored in the directory specified by this +variable." + :group 'vm-imap + :type '(choice (const :tag "None" nil) directory)) + +(defcustom vm-imap-save-to-server nil + "*This variable controls the behavior of the `vm-save-message' +command. If it is non-NIL, then messages from IMAP folders +are saved to other IMAP folders on the server, instead of +local folders. Messages from local folders are still saved to local +folders. + +The specialized commands `vm-save-message-to-local-folder' and +`vm-save-message-to-imap-folder' can be used to obtain particular +behavior independent of this variable." + :group 'vm-imap + :type 'boolean) + +(defcustom vm-imap-expunge-retries 1 + "*Number of retries to be performed for expunging IMAP mailboxes. +Increase this if your IMAP server is sluggish." + :group 'vm-imap + :type 'integer) + +(defcustom vm-imap-server-timeout nil + "*Number of seconds to wait for output from the IMAP server before +timing out. It can be set to nil to never time out." + :group 'vm-imap + :type '(choice (const :tag "Never" nil) + (integer :tag "Seconds"))) + +(defcustom vm-imap-ensure-active-sessions t + "*If non-NIL, ensures that an IMAP session is active before issuing +commands to the server. If it is not active, a new session is +started. This ensures a failure-proof operation, but involves +additional overhead in checking that the session is active." + :group 'vm-imap + :type 'boolean) + +(defcustom vm-imap-message-bunch-size 10 + "*Number of messages to be bunched together in IMAP server +operations. This permits faster interation with the IMAP servers. To +disable bunching, set it to 1." + :group 'vm-imap + :type 'integer) + +(defcustom vm-imap-sync-on-get t + "*If this variable is non-NIL, then the vm-get-new-mail command +should synchronize with the IMAP mailbox on the server. This involves +expunging messages that have been expunged from the server, saving and +retrieving message attributes as well retrieving new messages. If the +variable is NIL, this functionality can be obtained via the +vm-imap-synchronize command." + :group 'vm-imap + :type 'boolean) + +(defcustom vm-auto-get-new-mail t + "*Non-nil value causes VM to automatically move mail from spool files +to a mail folder when the folder is first visited. Nil means +you must always use `vm-get-new-mail' to pull in newly arrived messages. + +If the value is a number, then it specifies how often (in +seconds) VM should check for new mail and try to retrieve it. +This is done asynchronously using a timer task and may occur +while you are editing other files. It should not disturb your +editing, except perhaps for a pause while the check is being +done." + :group 'vm-folders + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (integer :tag "Seconds"))) + +(defcustom vm-mail-check-interval 300 + "*Numeric value specifies the number of seconds between checks +for new mail, carried out using a timer task. The maildrops for all +visited folders are checked. + +A nil value means don't check for new mail. + +Note that if new mail is found, it is not retrieved. The +buffer local variable `vm-spooled-mail-waiting' is set non-nil in +the buffers of those folders that have mail waiting. VM +displays \"Mail\" in the mode line of folders that have mail +waiting." + :group 'vm-folders + :type '(choice (const nil) integer)) + +(defcustom vm-mail-check-always nil + "*Set this variable to `t' if you want VM's mail-check to run +continuously and take into account multiple mail clients reading from +the same mail spool." + :group 'vm-folders + :type 'boolean) + +(defvar vm-spooled-mail-waiting nil + "Value is non-nil if there is mail waiting for the current folder. +This variable's value is local in all buffers. +VM maintains this variable, you should not set it.") +(make-variable-buffer-local 'vm-spooled-mail-waiting) + +(defcustom vm-default-folder-type + (cond ((not (boundp 'system-configuration)) + 'From_) + ((or (string-match "-solaris" system-configuration) + (string-match "usg-unix-v" system-configuration) + (string-match "-ibm-aix" system-configuration)) + 'From_-with-Content-Length) + ((string-match "-sco" system-configuration) + 'mmdf) + (t 'From_)) + "*Default folder type for empty folders. +If VM has to add messages that have no specific folder type to an +empty folder, the folder will become this default type. +Allowed types are: + + From_ + From_-with-Content-Length + BellFrom_ + mmdf + babyl + +Value must be a symbol, not a string. i.e. write + + (setq vm-default-folder-type 'From_) + +in your .emacs or .vm file. + +If you set this variable's value to From_-with-Content-Length you +must set `vm-trust-From_-with-Content-Length' non-nil." + :group 'vm-folders + :type '(choice (const From_) + (const From_-with-Content-Length) + (const BellFrom_) + (const mmdf) + (const babyl))) + +(defcustom vm-default-From_-folder-type 'From_ + "*Value must be a symbol that tells VM which From-style folder type +is used by your local mail delivery system. Valid values are + + From_ + BellFrom_ + +Messages in From_ folders are separated by the two newlines +followed by the string \"From\" and a space. Messages in +BellFrom_ folders are only required to have a single newline +before the \"From\" string. + +Since BellFrom_ and From_ folders cannot be reliably distinguished +from each other, you must tell VM which one your system uses by +setting the variable `vm-default-From_-folder-type' to either From_ +or BellFrom_." + :group 'vm-folders + :type '(choice (const From_) + (const BellFrom_))) + +(defcustom vm-default-new-folder-line-ending-type nil + "*Value must be a symbol that specifies the line ending convention +to use for new folders. Text files under UNIXish and Windows +systems use different characters to indicate the end of a line. +UNIXish systems use a single linefeed character, Windows uses a +carriage return followed by a line feed. The value of this +variable tells VM which to use. + +`nil' means use the line ending convention of the local system; +CRLF if you're on a Windows system, LF for UNIXish systems. +`crlf' means use CRLF. +`lf' mean use LF. +`cr' means use CR (old Macs use this)." + :group 'vm-folders + :type '(choice (const :tag "System Default" nil) + (const :tag "Windows" crlf) + (const :tag "Old Mac" cr) + (const :tag "Unix" lf))) + +(defcustom vm-check-folder-types t + "*Non-nil value causes VM to check folder and message types for +compatibility before it performs certain operations. + +Before saving a message to a folder, VM will check that the destination folder +is of the same type as the message to be saved. + +Before incorporating message into a visited folder, VM will check that the +messages are of the same type as that folder. + +A nil value means don't do the checks. + +If non-nil, VM will either convert the messages to the appropriate +type before saving or incorporating them, or it will signal an +error. The value of `vm-convert-folder-types' determines which +action VM will take." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-convert-folder-types t + "*Non-nil value means that when VM checks folder types and finds +a mismatch (see `vm-check-folder-types'), it will convert the +source messages to the type of the destination folder, if it can. + +If `vm-check-folder-types' is nil, then this variable isn't +consulted." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-trust-From_-with-Content-Length + (eq vm-default-folder-type 'From_-with-Content-Length) + "*Non-nil value means that if the first message in a folder contains +a Content-Length header and begins with \"From \" VM can safely +assume that all messages in the folder have Content-Length headers +that specify the length of the text section of each message. VM +will then use these headers to determine message boundaries +instead of the usual way of searching for two newlines followed by a +line that begins with \"From \". + +If you set `vm-default-folder-type' to From_-with-Content-Length you +must set this variable non-nil." + :group 'vm-folders + :type 'boolean) + +(defvar vm-sync-thunderbird-status t + "* If set to t, VM synchronizes its headers with the headers of +Thunderbird so that full interoperation with Thunderbird becomes +possible. If it is set to 'read-only then VM reads the Thunderbird +status flags, but refrains from updating them. If it is set to nil +then VM makes no attempt to read or write the Thunderbird status +flags.") + +(make-variable-buffer-local 'vm-sync-thunderbird-status) + +;; (defvar vm-folder-sync-thunderbird-status t +;; "If t VM synchronizes its headers with the headers of +;; Thunderbird so that full interoperation with Thunderbird becomes +;; possible. This is not a customization variable. See +;; `vm-sync-thunderbird-status' for customization.") + +;; (defvar vm-read-thunderbird-status t +;; "* If t VM reads the headers of Thunderbird when visiting +;; folders, but not write Thunderbird headers. This variable has +;; effect only if `vm-folder-sync-thunderbird-status' is nil.") + +(defvar vm-folder-read-thunderbird-status t + "If t VM reads the headers of Thunderbird when visiting +folders. This is not a customization variable. See +`vm-sync-thunderbird-status' for customization.") + +(make-variable-buffer-local 'vm-folder-read-thunderbird-status) + +(defcustom vm-sort-messages-by-delivery-date nil + "*If set to t, VM will use the \"Delivery-Date\" header instead of +the \"Date\" header for sorting messages." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-visible-headers + '("Resent-" + "From:" "Sender:" + "To:" "Newsgroups:" "Apparently-To:" "Cc:" + "Subject:" + "Date:") + "*List of headers that should be visible when VM first displays a message. +These should be listed in the order you wish them presented. +Regular expressions are allowed. There's no need to anchor +patterns with \"^\", as searches always start at the beginning of +a line. Put a colon at the end of patterns to get exact matches. +For example, \"Date\" matches \"Date\" and \"Date-Sent\". Header names +are always matched case insensitively. + +If the value of `vm-invisible-header-regexp' is nil, only the +headers matched by `vm-visible-headers' will be displayed. +Otherwise all headers are displayed except those matched by +`vm-invisible-header-regexp'. In this case `vm-visible-headers' +specifies the order in which headers are displayed. Headers not +matching `vm-visible-headers' are displayed last." + :group 'vm-presentation + :type '(repeat regexp)) + +(defcustom vm-invisible-header-regexp nil + "*Non-nil value should be a regular expression that tells what headers +VM should NOT normally display when presenting a message. All other +headers will be displayed. The variable `vm-visible-headers' specifies +the presentation order of headers; headers not matched by +`vm-visible-headers' are displayed last. + +Nil value causes VM to display ONLY those headers specified in +`vm-visible-headers'." + :group 'vm-presentation + :type '(choice (const nil) regexp)) + +(defcustom vm-highlighted-header-regexp nil + "*Value specifies which headers to highlight. +This is a regular expression that matches the names of headers that should +be highlighted when a message is first presented. For example setting +this variable to \"From:\\\\|Subject:\" causes the From and Subject +headers to be highlighted. + +If you're using XEmacs, you might want to use the builtin +`highlight-headers' package instead. If so, then you should set +the variable `vm-use-lucid-highlighting' non-nil. You'll need to +set the various variables used by the highlight-headers package +to customize highlighting. `vm-highlighted-header-regexp' is +ignored in this case." + :group 'vm-presentation + :type '(choice (const nil) regexp)) + +(defcustom vm-use-lucid-highlighting (condition-case nil + (progn + (require 'highlight-headers) + t ) + (error nil)) + "*Non-nil means to use the `highlight-headers' package in XEmacs. +Nil means just use VM's builtin header highlighting code. + +FSF Emacs always uses VM's builtin highlighting code." + :group 'vm-misc + :type 'boolean) + +(defface vm-highlighted-header '((t (:inherit bold))) + "Default face used to highlight headers." + :group 'vm-faces) +;; (copy-face 'bold 'vm-highlighted-header) + +(defcustom vm-highlighted-header-face 'vm-highlighted-header + "*Face to be used to highlight headers. +The headers to highlight are specified by the `vm-highlighted-header-regexp' +variable. + +This variable is ignored under XEmacs if `vm-use-lucid-highlighting' is +non-nil. XEmacs' highlight-headers package is used instead. See the +documentation for the function `highlight-headers' to find out how to +customize header highlighting using this package." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-preview-lines 0 + "*Non-nil value N causes VM to display the visible headers + N lines of text +of a message when it is first presented. The message is not actually +flagged as read until it is exposed in its entirety. + +A value of t causes VM to display as much of the message as will +fit in the window associated with the folder buffer. + +A nil value causes VM not to preview messages; no text lines are hidden and +messages are immediately flagged as read." + :group 'vm-presentation + :type '(choice boolean integer)) + +(defcustom vm-preview-read-messages nil + "*Non-nil value means to preview messages even if they've already been read. +A nil value causes VM to preview messages only if new or unread." + :group 'vm-presentation + :type 'boolean) + +(defconst vm-always-use-presentation-buffer t + "Non-nil means to always use a presentation buffer for displaying + messages. It will also be used if no decoding or other + modification of the message are necessary.") + +(make-obsolete-variable 'vm-always-use-presentation-buffer + "The current behaviour is equivalent to setting this variable + to t. Please remove all settings for this variable and report + any problems that you might encounter." + "8.2.0") + +(defconst vm-always-use-presentation t + "Non-nil means to always use a presentation buffer for displaying + messages. It will also be used if no decoding or other + modification of the message are necessary. + +This constant is a place holder for the obsolete variable +`vm-always-use-presentation-buffer'. It should be removed eventually.") + +(defcustom vm-word-wrap-paragraphs nil + "*If non-nil, causes VM to word wrap paragraphs with long lines. +This is done using the `longlines' library, which must be installed +for the variable to have effect." + :group 'vm-presentation + :type 'boolean) + +(defcustom vm-word-wrap-paragraphs-in-reply nil + "*If non-nil, causes VM to word wrap paragraphs with long lines +during message composition. This is done using the `longlines' +library, which must be installed for the variable to have +effect." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-fill-paragraphs-containing-long-lines nil + "*This variable can be set to nil, a numeric value N, the +symbol 'window-width. If it is numeric, it causes VM to fill +paragraphs that contain lines spanning that many columns or more. +Setting it to 'window-width has the effect of using the width of +the Emacs window. + +Only plain text messages and text/plain MIME parts will be +filled. The message itself is not modified; its text is copied +into a presentation buffer before the filling is done. + +This variable determines which paragraphs are filled, +but `vm-paragraph-fill-column' determines the fill column. + +Note that filling is carried out only if word wrapping is not in +effect. The variable `vm-word-wrap-paragraphs' controls word +wrapping." + :group 'vm-presentation + :type '(choice (const :tag "Off" nil) + (const :tag "Window width" window-width) + (integer :tag "Fill width"))) + +(defcustom vm-fill-paragraphs-containing-long-lines-in-reply nil + "*This variable can be set to nil, a numeric value N, the +symbol 'window-width. If it is numeric, it causes VM to fill +included text in replies provided it has lines spanning that many +columns or more. Setting it to 'window-width has the effect of +using the width of the Emacs window. + +This variable determines which paragraphs are filled, +but `vm-fill-long-lines-in-reply-column' determines the fill column. + +Note that filling is carried out only if word wrapping is not in +effect. The variable `vm-word-wrap-paragraphs-in-reply' controls word +wrapping." + :group 'vm-compose + :type '(choice (const :tag "No" nil) + (const :tag "Window width" window-width) + (integer :tag "Fill column"))) + +(defcustom vm-paragraph-fill-column (default-value 'fill-column) + "*Column beyond which automatic line-wrapping should happen when +re-filling lines longer than the value of +`vm-fill-paragraphs-containing-long-lines'." + :group 'vm-presentation + :type 'integer) + +(defcustom vm-fill-long-lines-in-reply-column (default-value 'fill-column) + "*Fill lines spanning that many columns or more in replies." + :group 'vm-compose + :type '(choice (const :tag "Off" nil) + (const :tag "Window width" window-width) + (integer :tag "Fill column"))) + +(defcustom vm-display-using-mime t + "*Non-nil value means VM should display messages using MIME. +MIME (Multipurpose Internet Mail Extensions) is a set of +extensions to the standard Internet message format that allows +reliable tranmission and reception of arbitrary data including +images, audio and video as well as ordinary text. + +A non-nil value for this variable means that VM will recognize +MIME encoded messages and display them as specified by the +various MIME standards specifications. + +A nil value means VM will not display MIME messages any +differently than any other message." + :group 'vm-mime + :type 'boolean) + +;; this is t because at this time (11 April 1997) Solaris is +;; generating too many mangled MIME version headers. For the same +;; reason vm-mime-avoid-folding-content-type is also set to t. +(defcustom vm-mime-ignore-mime-version t + "*Non-nil value means ignore the version number in the MIME-Version +header. VM only knows how to decode and display MIME version 1.0 +messages. Some systems scramble the MIME-Version header, causing +VM to believe that it cannot display a message that it actually +can display. You can set `vm-mime-ignore-mime-version' non-nil if +you use such systems." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-require-mime-version-header nil + "*Non-nil means a message must contain MIME-Version to be considered MIME. +The MIME standard requires that MIME messages contain a MIME-Version, +but some mailers ignore the standard and do not send the header. Set +this variable to nil if you want VM to be lax and parse such messages +as MIME anyway." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-ignore-composite-type-opaque-transfer-encoding t + "*Non-nil means VM should ignore transfer encoding declarations +of base64 and quoted-printable for object of type message/* or +multipart/*. The MIME spec requires that these composite types +use either 7bit, 8bit, or binary transfer encodings but some +mailers declare quoted-printable and base64 even when they are +not used. Set this variable non-nil if you want VM to be lax and +ignore this problem and try to display the object anyway." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-ignore-missing-multipart-boundary t + "*Non-nil means VM should treat a missing MIME boundary marker +as if the marker were at the end of the current enclosing MIME +object or, if there is no enclosing object, at the end of the +message. A nil value means VM will complain about missing +boundaries and refuse to parse such MIME messages." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-send-using-mime t + "*Non-nil value means VM should support sending messages using MIME. +MIME (Multipurpose Internet Mail Extensions) is a set of +extensions to the standard Internet message format that allows +reliable tranmission and reception of arbitrary data including +images, audio and video as well as traditional text. + +A non-nil value for this variable means that VM will + + - allow you to attach files and messages to your outbound message. + - analyze the composition buffer when you send off a message and + encode it as needed. + +A nil value means VM will not offer any support for composing +MIME messages." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-honor-content-disposition nil + "*Non-nil value means use information from the Content-Disposition +header to display MIME messages. Possible values are `t', to mean that the +Content-Disposition header should always be honored or 'internal-only, +to mean that an \"inline\" disposition should be honored only for +internally-displayable types. + +The Content-Disposition header specifies whether a MIME object +should be displayed inline or treated as an attachment. For VM, +\"inline\" display means displaying the object in the Emacs +buffer, if possible. Attachments will be displayed as a button +that you can use mouse-2 to activate or mouse-3 to pull up a menu +of options." + :group 'vm-mime + :type '(choice (const :tag "Ignore it" nil) + (const :tag "Honor it always" t) + (const :tag "Honor inline for internal types" internal-only))) +(defvaralias 'vm-honor-mime-content-disposition + 'vm-mime-honor-content-disposition) + +(defcustom vm-auto-decode-mime-messages t + "*Non-nil value causes MIME decoding to occur automatically +when a message containing MIME objects is exposed. A nil value +means that you will have to run the `vm-decode-mime-message' +command (normally bound to `D') manually to decode and display +MIME objects." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-decode-for-preview t + "*Non-nil value causes partial MIME decoding to happen when a message +is previewed, instead of when it is displayed in full. The point of +this is if `vm-preview-lines' is set to a non-nil, non-zero +value you can see readable text instead of a potentially inscrutable +MIME jumble. `vm-auto-decode-mime-messages' must also be set non-nil +for this variable to have effect." + :group 'vm-mime + :type 'boolean) + +(defvar vm-mime-decode-for-show t + "*Control variable that says whether MIME messages should be decoded +for showing the message, in addition to decoding for preview.") + +(defcustom vm-mime-auto-displayed-content-types + '("text" "image" "message/rfc822") + "*List of MIME content types that should be displayed immediately +after decoding. Other types will be displayed as a button that +you must activate to display the object. + +A value of t means that all types should be displayed immediately. +A nil value means never display MIME objects immediately; only use buttons. + +If the value is a list, it should be a list of strings, which +should all be types or type/subtype pairs. Example: + + (setq vm-mime-auto-displayed-content-types '(\"text\" \"image/jpeg\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included. + +Note that all multipart types are processed specially, and this +variable does not apply to them. In particular, + + multipart/digest messages are always displayed as a button to + avoid automatically visiting a new folder while you are moving + around in the current folder. + + message/partial messages are always displayed as a button, + because there always needs to be a way to trigger the assembly + of the parts into a full message. + +Any type that cannot be displayed internally or externally will +be displayed as a button that allows you to save the body of the MIME +object to a file." + :group 'vm-mime + :type '(choice (const t) + (const nil) + (repeat string))) +(defvaralias 'vm-auto-displayed-mime-content-types + 'vm-mime-auto-displayed-content-types) + +(defcustom vm-mime-auto-displayed-content-type-exceptions nil + "*List of MIME content types that should not be displayed immediately +after decoding. These types will be displayed as a button that you +must activate to display the object. This is an exception list for +the types listed in `vm-mime-auto-displayed-content-types'; all types +listed there will be auto-displayed except those in the exception +list. + +The value should be either nil or a list of strings. The strings +should all be types or type/subtype pairs. Example: + + (setq vm-mime-auto-displayed-content-type-exceptions '(\"text/html\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included." + :group 'vm-mime + :type '(choice (const nil) + (repeat string))) +(defvaralias 'vm-auto-displayed-mime-content-type-exceptions + 'vm-mime-auto-displayed-content-type-exceptions) + +(defcustom vm-mime-internal-content-types t + "*List of MIME content types that should be displayed internally +if Emacs is capable of doing so. A value of t means that VM +displays all types internally if possible. A list of exceptions +can be specified via `vm-mime-internal-content-type-exceptions'. +A nil value means never display MIME objects internally, which +means VM must run an external viewer to display MIME objects. + +If the value is a list, it should be a list of strings. Example: + + (setq vm-mime-internal-content-types '(\"text\" \"message\" \"image/jpeg\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included. + +Note that all multipart types are always handled internally. +There is no need to list them here." + :group 'vm-mime + :type '(choice (const :tag "Display all interanlly when possible" t) + (const :tag "Never use Emacs' internal display capabilities" nil) + (repeat (string :tag "MIME Type")))) + +(defcustom vm-mime-internal-content-type-exceptions nil + "*List of MIME content types that should not be displayed internally. +This is an exception list for the types specified in +`vm-mime-internal-content-types'; all types listed there will be +displayed internally except for those in the exception list. + +The value should be a list of strings. Example: + + (setq vm-mime-internal-content-type-exceptions '(\"image/jpeg\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included." + :group 'vm-mime + :type '(choice (const nil) + (repeat string))) + +(defcustom vm-mime-external-content-types-alist nil + "*Alist of MIME content types and the external programs used to display them. +If VM cannot display a type internally or has been instructed not +to (see the documentation for the `vm-mime-internal-content-types' +variable) it will try to launch an external program to display that +type. + +The alist format is a list of lists, each sublist having the form + + (TYPE FUNCTION ARG ... ) + +or + + (TYPE PROGRAM ARG ARG ... ) + +or + + (TYPE COMMAND-LINE) + +TYPE is a string specifying a MIME type or type/subtype pair. +For example \"text\" or \"image/jpeg\". If a top-level type is +listed without a subtype, all subtypes of that type are assumed +to be included. + +In the first form, FUNCTION is a lisp function that is responsible for +displaying the attachment in an external application. Any ARGS will +be passed to the function as arguments. The octets that compose the +object will be written into a temporary file and the name of the file +is passed as an additional argument. + +In the second form, PROGRAM is a string naming a program to run to +display an object. Any ARGS will be passed to the program as +arguments. The octets that compose the object will be written +into a temporary file and the name of the file can be inserted +into an ARG string by writing %f. In earlier versions of VM the +filename was always added as the last argument; as of VM 6.49 this +is only done if %f does not appear in any of the ARG strings. +The filename inserted by %f will be quoted by `shell-quote-argument' +and thus no single quotes should be used, i.e. do not use the following +\"...'%f'...\". + +If the COMMAND-LINE form is used, the program and its arguments +are specified as a single string and that string is passed to the +shell for execution. Since the command line will be passed to +the shell, you can use shell variables and redirection if needed. +As with the PROGRAM/ARGS form, the name of the temporary file +that contains the MIME object will be appended to the command +line if %f does not appear in the command line string. + +In either the PROGRAM/ARG or COMMAND-LINE forms, all the +program and argument strings will have any %-specifiers in +them expanded as described in the documentation for the +variable `vm-mime-button-format-alist'. The only difference +is that %f refers to the temporary file VM creates to store +the object to be displayed, not the filename that the sender +may have associated with the attachment. + +Example: + + (setq vm-mime-external-content-types-alist + '( + (\"text/html\" browse-url-of-file) + (\"image/gif\" \"xv\") + (\"image/jpeg\" \"xv\") + (\"video/mpeg\" \"mpeg_play\") + (\"video\" w32-shell-execute \"open\") + ) + ) + +The first matching list element will be used. + +No multipart message will ever be sent to an external viewer." + :group 'vm-mime + :type '(choice (const nil) + (alist :key-type (string :tag "MIME Type") + :value-type + (choice + (group :tag "Function" + (function :tag "Function") + (repeat :inline t (string :tag "Args"))) + (group :tag "Program" (file :tag "Program") + (repeat :inline t (string :tag "Args"))) + (string :tag "Shell Command"))))) + +(defcustom vm-mime-external-content-type-exceptions nil + "*List of MIME content types that should not be displayed externally +without a manual request from the user. This is an exception list +for the types specified in `vm-mime-external-content-types-alist'; +types listed there will not be displayed using the specified viewer +unless you explicitly request it by menu or `$ e' from the keyboard. + +The value should be a list of strings. Example: + + (setq vm-mime-external-content-type-exceptions '(\"text/html\")) + +If a top-level type is listed without a subtype, all subtypes of +that type are assumed to be included." + :group 'vm-mime + :type '(choice (const nil) + (repeat string))) + +(defcustom vm-mime-delete-viewer-processes t + "*Non-nil value causes VM to kill external MIME viewer processes +when you switch to a different message or quit the current message's +folder." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-type-converter-alist nil + "*Alist of MIME types and programs that can convert between them. +If VM cannot display a content type, it will scan this list to +see if the type can be converted into a type that it can display. + +The alist format is + + ( (START-TYPE END-TYPE COMMAND-LINE ) ... ) + +START-TYPE is a string specifying a MIME type or type/subtype pair. +Example \"text\" or \"image/jpeg\". If a top-level type is +listed without a subtype, all subtypes of that type are assumed +to be included. + +END-TYPE must be an exact type/subtype pair. This is the type +to which START-TYPE will be converted. + +COMMAND-LINE is a string giving a command line to be passed to +the shell. The octets that compose the object will be written to +the standard input of the shell command. + +Example: + + (setq vm-mime-type-converter-alist + '( + (\"image/jpeg\" \"image/gif\" \"jpeg2gif\") + (\"text/html\" \"text/plain\" \"striptags\") + ) + ) + +The first matching list element will be used." + :group 'vm-mime + :type '(choice (const nil) + (repeat (list (string :tag "From type") + (string :tag "To type") + (string :tag "Converter program"))))) +(defvaralias 'vm-mime-alternative-select-method + 'vm-mime-alternative-show-method) +(make-obsolete-variable 'vm-mime-alternative-select-method + 'vm-mime-alternative-show-method + "8.2.0") + + +(defcustom vm-mime-charset-converter-alist nil + "*Alist of MIME charsets and programs that can convert between them. +If VM cannot display a particular character set, it will scan this list to +see if the charset can be converted into a charset that it can display. + +The alist format is + + ( ( START-CHARSET END-CHARSET COMMAND-LINE ) ... ) + +START-CHARSET is a string specifying a MIME charset. +Example \"iso-8859-1\" or \"utf-8\". + +END-CHARSET is a string specifying the charset to which START-CHARSET +will be converted. + +COMMAND-LINE is a string giving a command line to be passed to +the shell. The characters in START-CHARSET will be written to the +standard input of the shell command and VM expects characters +encoded in END-CHARSET to appear at the standard output of the +COMMAND-LINE. COMMAND-LINE is passed to the shell, so you can +use pipelines, shell variables and redirections. + +Example: + + (setq vm-mime-charset-converter-alist + '( + (\"utf-8\" \"iso-2022-jp\" \"iconv -f utf-8 -t iso-2022-jp\") + ) + ) + +The first matching list element will be used." + :group 'vm-mime + :type '(choice (const nil) + (repeat (list string string string)))) + +(defcustom vm-mime-alternative-show-method 'best-internal + "*Value tells how to choose which multipart/alternative part to display. +A MIME message of type multipart/alternative has multiple message +parts containing the same information, but each part may be +formatted differently. VM will display only one of the parts. +This variable tells VM how to choose which part to display. +(There is a separate variable `vm-mime-alternative-yank-method' +for deciding the multipart/alternative to be used in replies.) + +A value of 'best means choose the part that is the most faithful to +the sender's original content that can be displayed. + +A value of 'best-internal means choose the best part that can +be displayed internally, (i.e. with the built-in capabilities +of Emacs) and is allowed to be displayed internally (see +`vm-mime-internal-content-types'). If none of the parts can be +displayed internally, behavior reverts to that of 'best. + +The value can also be a list of the form + + (favorite TYPE ...) + +with the first element of the list being the symbol 'favorite'. The +remaining elements of the list are strings specifying MIME types. +VM will look for each TYPE in turn in the list of alternatives and +choose the first matching alternative found that can be displayed. +If the symbol 'favorite' is 'favorite-internal' instead, the first TYPE +that matches an alternative that can be displayed internally will be +chosen." + :group 'vm-mime + :type '(choice (choice (const best-internal) + (const best) + (const all)) + (cons (const favorite) (repeat string)) + (cons (const favorite-internal) (repeat string)))) + +(defcustom vm-mime-alternative-yank-method 'best-internal + "*Value tells how to choose which multipart/alternative part to +yank, i.e., include, in replies. It is similar to +`vm-mime-alternative-show-method' used for displaying messages. + +A value of 'best means choose the part that is the most faithful to +the sender's original content that can be displayed. + +A value of 'best-internal means choose the best part that can +be displayed internally, (i.e. with the built-in capabilities +of Emacs) and is allowed to be displayed internally (see +`vm-mime-internal-content-types'). If none of the parts can be +displayed internally, behavior reverts to that of 'best. + +The value can also be a list of the form + + (favorite TYPE ...) + +with the first element of the list being the symbol 'favorite'. The +remaining elements of the list are strings specifying MIME types. +VM will look for each TYPE in turn in the list of alternatives and +choose the first matching alternative found that can be displayed. +If the symbol 'favorite' is 'favorite-internal' instead, the first TYPE +that matches an alternative that can be displayed internally will be +chosen." + + :group 'vm-mime + :type '(choice (choice (const best-internal) + (const best) + (const all)) + (cons (const favorite) (repeat string)) + (cons (const favorite-internal) (repeat string)))) + +(defcustom vm-mime-text/html-handler 'auto-select + "*The library used for displaying HTML messages. The possible +values are: + emacs-w3m The emacs interface to the w3m viewer, + emacs-w3 The emacs interface to the w3 viewer, + w3m The w3m viewer used externally to convert to plain text, + lynx The lynx viewer used externally to convert to plain text, + auto-select Automatic selection among these alternatives, and + nil No internal display of HTML messages. +" + :group 'vm-mime + :type '(choice (const nil :tag "Do not display HTML messages.") + (const auto-select :tag "Autoselect best method") + (const emacs-w3m) + (const emacs-w3) + (const w3m) + (const lynx))) + +(defcustom vm-mime-text/html-blocker "<img[^>]*\\s-src=." + "*Regexp after which a \"blocked:\" will be inserted. +This is done in order to prevent loading of embedded images used to check if +and when you read an email." + :group 'vm-mime + :type 'regexp) + +(defcustom vm-mime-text/html-blocker-exceptions nil + "*Regexp matching URL which should not be blocked." + :group 'vm-mime + :type '(choice (const :tag "None" nil) + regexp)) + +(defcustom vm-mime-default-face-charsets + (if vm-fsfemacs-mule-p + (if (eq window-system nil) + '("us-ascii" "iso-8859-1") + '("us-ascii")) + '("us-ascii" "iso-8859-1")) + "*List of character sets that can be displayed using the `default' face. +The default face is what you normally see when you edit text in Emacs. +The font assigned to the default face can typically display one or two +character sets. For U.S. and Western European users, ``us-ascii'' and +one of the ISO-8859 character sets usually can be displayed. Whatever +character sets that your default face can display should be listed as +the value of `vm-mime-default-face-charsets'. Example: + + (setq vm-mime-default-face-charsets '(\"us-ascii\" \"iso-8859-1\")) + +Case is not significant in character set names. + +For Emacs versions with MULE or Unicode support, this variable is +semi-obsolete and should only be used for making bogus, unregistered +character sets that are slight variants of ISO-8859-1 visible. +Don't add charsets like \"utf-8\" that require additional decoding. + +A value of t means all character sets can be displayed by the +default face. This should only be used in combination with +`vm-mime-default-face-charset-exceptions' to tell VM that most of +the mail you receive is displayable using your default face and +its associated font, even though the messages might arrive with +unknown or unregistered character sets specified in the MIME +Content-Type header. + +To tell VM how to display other character sets, see +`vm-mime-charset-font-alist'." + :group 'vm-mime + :type '(choice (const t) (repeat string))) + +(defcustom vm-mime-default-face-charset-exceptions nil + "*List of character sets that cannot be displayed using the default face. +This variable acts as an exception list for `vm-mime-default-face-charsets'. +Character sets listed here will not be considered displayable using the +default face even if they are also listed in `vm-mime-default-face-charsets'." + :group 'vm-mime + :type '(repeat string)) + +(defcustom vm-mime-charset-font-alist nil + "*Assoc list of character sets and fonts that can be used to display them. +The format of the list is: + + ( (CHARSET . FONT) ...) + +CHARSET is a string naming a MIME registered character set such +as \"iso-8859-5\". Character set names should be specified in +lower case. + +FONT is a string naming a font that can be used to display CHARSET. + +An example setup might be: + + (setq vm-mime-charset-font-alist + '( + (\"iso-8859-7\" . \"-*-*-medium-r-normal-*-16-160-72-72-c-80-iso8859-7\") + ) + ) + +This variable is only useful for character sets whose characters +can all be encoded in single 8-bit bytes. Also multiple fonts +can only be displayed if you're running under a window system +e.g. X windows. So this variable will have no effect if you're +running Emacs on a tty. + +If you're using FSF Emacs 20 or later, or you're using XEmacs with +compiled in MULE support, this value of this variable is ignored. + +Note that under FSF Emacs 19, any fonts you use must be the +same height as your default font. XEmacs does not have this +limitation." + :group 'vm-mime + :type '(choice (const nil) + (repeat (cons string string)))) + +(defcustom vm-mime-use-image-strips t + "*Non-nil means chop an image into horizontal strip for display. +Emacs treats a displayed image as a single large character and cannot +scroll vertically within an image. To work around this limitation VM +can display an image as a series of contiguous horizontal strips that +Emacs' scrolling routines can better handle. To do this VM needs to +have the ImageMagick programs 'convert' and 'identify' installed; +`vm-imagemagick-convert-program' and `vm-imagemagick-identify-program +must point to them. + +A nil value means VM should display images without cutting them +into strips." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-display-image-strips-incrementally t + "*Non-nil means display image strips as they are created +rather than waiting until all the strips are created and displaying +them all at once. See `vm-mime-use-image-strips'." + :group 'vm-mime + :type 'boolean) + +(defun vm-locate-executable-file (name) + (or (cond ((fboundp 'locate-file) + (locate-file name exec-path nil 1)) + (t + (let (file done (dirs exec-path)) + (while (and dirs (not done)) + (setq file (expand-file-name name (car dirs))) + (if (file-executable-p file) + (setq done t) + (setq dirs (cdr dirs)))) + (and dirs file)))) + (let ((vmdir (file-name-directory (locate-library "vm"))) + file) + (setq vmdir (expand-file-name "../src/" vmdir) + file (expand-file-name name vmdir)) + (if (file-exists-p file) + file +; (vm-warn 0 2 "VM could not find executable %S!" name) + nil)))) + +(defcustom vm-imagemagick-convert-program (vm-locate-executable-file "convert") + "*Name of ImageMagick 'convert' program. +VM uses this program to convert between image formats and to slice up +images for display. Set this to nil and VM will not use the +'convert' program." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-imagemagick-identify-program + (vm-locate-executable-file "identify") + "*Name of ImageMagick 'identify' program. +VM uses this program to gather information about images. Set this to nil +and VM will not use the 'convert' program." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defvar vm-mime-image-type-converter-alist + (if (stringp vm-imagemagick-convert-program) + (let ((x vm-imagemagick-convert-program)) + (list + (list "image" "image/png" (format "%s - png:-" x)) + (list "image" "image/jpeg" (format "%s - jpeg:-" x)) + (list "image" "image/gif" (format "%s - gif:-" x)) + (list "image" "image/tiff" (format "%s - tiff:-" x)) + (list "image" "image/xpm" (format "%s - xpm:-" x)) + (list "image" "image/pbm" (format "%s - pbm:-" x)) + (list "image" "image/xbm" (format "%s - xbm:-" x)) + )))) + +(defcustom vm-mime-delete-after-saving nil + "*Non-nil value causes VM to delete MIME body contents from a folder +after the MIME object has been saved to disk. The MIME object is replaced +with a message/external-body object that points to the disk copy of the +object." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-confirm-delete t + "*Non-nil value causes VM to request confirmation from the user before +deleting a MIME object with `vm-delete-mime-object'." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-saveable-types + (append + '("application" "x-unknown" "application/x-gzip") + ;; These are eliminated because they depend on evaluation order. + ;; USR, 2011-04-28 + ;; (mapcar (lambda (a) (car a)) + ;; vm-mime-external-content-types-alist) + ) + "*List of MIME types which should be saved." + :group 'vm-mime + :type '(repeat (string :tag "MIME type" nil))) +(defvaralias 'vm-mime-savable-types + 'vm-mime-saveable-types) + +(defcustom vm-mime-saveable-type-exceptions + '("text") + "*List of MIME types which should not be saved." + :group 'vm-mime + :type '(repeat (string :tag "MIME type" nil))) +(defvaralias 'vm-mime-savable-type-exceptions + 'vm-mime-saveable-type-exceptions) + +(defcustom vm-mime-deleteable-types + (append + '("application" "x-unknown" "application/x-gzip") + ;; These are eliminated because they depend on evaluation order. + ;; USR, 2011-04-28 + ;; (mapcar (lambda (a) (car a)) + ;; vm-mime-external-content-types-alist) + ) + "*List of MIME types which should be deleted." + :group 'vm-mime + :type '(repeat (string :tag "MIME type" nil))) +(defvaralias 'vm-mime-deletable-types + 'vm-mime-deleteable-types) + +(defcustom vm-mime-deleteable-type-exceptions '("text") + "*List of MIME types which should not be deleted." + :group 'vm-mime + :type '(repeat (string :tag "MIME type" nil))) +(defvaralias 'vm-mime-deletable-type-exceptions + 'vm-mime-deleteable-type-exceptions) + +(defvar vm-mime-auto-save-all-attachments-avoid-recursion nil + "For internal use.") + +(defface vm-mime-button + '((((type x w32 mswindows mac) (class color) (background light)) + (:background "lightgrey" :box (:line-width 2 :style released-button))) + (((type x w32 mswindows mac) (class color) (background dark)) + (:background "grey50" :box (:line-width 2 :style released-button))) + (((class color) (background light)) (:foreground "blue" :underline t)) + (((class color) (background dark)) (:foreground "cyan" :underline t)) + (t (:underline t))) + "Default face used for MIME buttons." + :group 'vm-faces) + +(defface vm-mime-button-mouse + '((((type x w32 mswindows mac) (class color)) + (:inherit highlight :box (:line-width 2 :style released-button))) + (((class color)) (:inherit highlight)) + (t (:inherit highlight))) + "*Face to fontify focused MIME buttons." + :group 'vm-faces) + +(defface vm-mime-button-pressed-face + '((((type x w32 mswindows mac) (class color)) + (:inherit vm-mime-button :box (:line-width 2 :style pressed-button))) + (((class color)) (:inherit vm-mime-button)) + (t (:inherit vm-mime-button))) + "*Face to fontify pressed MIME buttons. (This is not yet used in VM.)" + :group 'vm-faces) + +(defcustom vm-mime-button-face 'vm-mime-button + "*Face used for text in buttons that trigger the display of MIME objects." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-mime-button-mouse-face 'vm-mime-button-mouse + "*Face used for text in MIME buttons when mouse is hovering." + :group 'vm-faces + :type 'symbol) + +(defface vm-attachment-button + '((((type x w32 mswindows mac) (class color) (background light)) + (:background "LavenderBlush3" :box (:line-width 2 :style released-button))) + (((type x w32 mswindows mac) (class color) (background dark)) + (:background "LavenderBlush4" :box (:line-width 2 :style released-button))) + (((class color) (background light)) (:foreground "blue" :underline t)) + (((class color) (background dark)) (:foreground "cyan" :underline t)) + (t (:underline t))) + "Default face used for MIME buttons." + :group 'vm-faces) + +(defface vm-attachment-button-mouse + '((((type x w32 mswindows mac) (class color)) + (:inherit highlight :box (:line-width 2 :style released-button))) + (((class color)) (:inherit highlight)) + (t (:inherit highlight))) + "*Face to fontify focused MIME buttons." + :group 'vm-faces) + +(defface vm-attachment-button-pressed-face + '((((type x w32 mswindows mac) (class color)) + (:inherit vm-attachment-button :box (:line-width 2 :style pressed-button))) + (((class color)) (:inherit vm-attachment-button)) + (t (:inherit vm-attachment-button))) + "*Face to fontify pressed MIME buttons. (This is not yet used in VM.)" + :group 'vm-faces) + +(defcustom vm-attachment-button-face 'vm-attachment-button + "*Face used for text in buttons that trigger the display of MIME objects." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-attachment-button-mouse-face 'vm-attachment-button-mouse + "*Face used for text in MIME buttons when mouse is hovering." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-mime-button-format-alist + '(("text" . "%-60.60(%t (%c): %f, %d%) %10.10([%a]%)") + ("multipart/alternative" . "%-50.50(%d%) %20.20([%a]%)") + ("multipart/digest" . "%-50.50(%d, %n message%s%) %20.20([%a]%)") + ("multipart" . "%-50.50(%d, %n part%s%) %20.20([%a]%)") + ("message/partial" . "%-50.50(%d, part %N (of %T)%) %20.20([%a]%)") + ("message/external-body" . "%-55.55(%d%) [%a (%x)]") + ("message" . "%-50.50(%d%) %20.20([%a]%)") + ("audio" . "%-55.55(%t: %f, %d%) %10.10([%a]%)") + ("video" . "%-55.55(%t: %f, %d%) %10.10([%a]%)") + ("image" . "%-55.55(%t: %f, %d%) %10.10([%a]%)") + ("application" . "%-55.55(%t: %f, %d%) %10.10([%a]%)")) + ;; old definition + ;; '(("text" . "%-35.35(%d, %c%) [%k to %a]") + ;; ("multipart/alternative" . "%-35.35(%d%) [%k to %a]") + ;; ("multipart/digest" . "%-35.35(%d, %n message%s%) [%k to %a]") + ;; ("multipart" . "%-35.35(%d, %n part%s%) [%k to %a]") + ;; ("message/partial" . "%-35.35(%d, part %N (of %T)%) [%k to %a]") + ;; ("message/external-body" . "%-35.35(%d%) [%k to %a (%x)]") + ;; ("message" . "%-35.35(%d%) [%k to %a]") + ;; ("audio" . "%-35.35(%d%) [%k to %a]") + ;; ("video" . "%-35.35(%d%) [%k to %a]") + ;; ("image" . "%-35.35(%d%) [%k to %a]") + ;; ("application/octet-stream" . "%-35.35(%d, %f%) [%k to %a]")) + "*List of types and formats for MIME buttons. +When VM does not display a MIME object immediately, it displays a +button or tag line in its place that describes the object and what you +have to do to display it. The value of `vm-mime-button-format-alist' +determines the format of the text in those buttons. + +The format of the list is + + ((TYPE . FORMAT) (TYPE . FORMAT) ...) + +The list is searched sequentially and the FORMAT corresponding to +the first TYPE that matches the type of the button's object is +used. + +TYPE should be a string specifying a top level type or a type/subtype +pair. If a top-level type is listed without a subtype, all subtypes +of that type are assumed to be included. + +FORMAT should be a string specifying the text of the button. The +string should not include a newline. The string may contain the +printf-like `%' conversion specifiers which substitute information +about the MIME object into the button. + +Recognized specifiers are: + a - the default action of the button. E.g. \"display image\" for images, + \"display text\" for text objects and so on. + c - the character set of the object. Usually only specified + for text objects. Displays as \"us-ascii\" if the MIME object + does not specifiy a character set. + d - the content description of the object taken from the + Content-Description header, if present. If the header + isn't present, a generic description is provided. + e - the content transfer encoding, either \"base64\" or + \"quoted-printable\". + f - the suggested file name to save the object into, as + specified either in the Content-Disposition header, or the + \"name\" parameter for objects of type \"application\". + k - how to activate the button. Usually \"Press RETURN\" or + \"Click mouse-2\". + n - for multipart types this is the number of bundled parts, + messages, whatever. + N - for message/partial objects, the part number. + s - an empty string if %n would display \"1\", otherwise + \"s\". + t - the content type of the object, e.g. \"text/enriched\". + T - for message/partial objects, the total number of expected + parts. \"?\" is displayed if the object doesn't specify + the total number of parts expected. + x - the content type of the external body of a message/external-body + object. + ( - starts a group, terminated by %). Useful for specifying + the field width and precision for the concatentation of + group of format specifiers. Example: \"%.25(%d, %t, %f%)\" + specifies a maximum display width of 25 characters for the + concatenation of the content description, content type and + suggested file name. + ) - ends a group. + +Use %% to get a single %. + +A numeric field width may be given between the `%' and the specifier; +this causes right justification of the substituted string. A negative field +width causes left justification. + +The field width may be followed by a `.' and a number specifying +the maximum allowed length of the substituted string. If the +string is longer than this value the right end of the string is +truncated. If the value is negative, the string is truncated on +the left instead of the right." + :group 'vm-mime + :type '(repeat (cons (string :tag "MIME Type") + (string :tag "Format")))) + +(defcustom vm-mime-parts-display-separator + "\n----------------------------------------------------------------------\n" + "*Separator string to insert between mime parts when displayed +one after another." + :group 'vm-mime + :type 'string) + +(defcustom vm-mime-7bit-composition-charset "us-ascii" + "*Character set that VM should assume if it finds no character codes > 128 +in a composition buffer. Composition buffers are assumed to use +this character set unless the buffer contains a byte with the high bit set. +This variable specifies what character set VM should assume if +no such a character is found. + +This variable is unused in XEmacs/MULE. Since multiple character +sets can be displayed in a single buffer under MULE, VM will map +the file coding system of the composition buffer to a single MIME +character set that can display all the buffer's characters." + :group 'vm-mime + :type 'string) + +(defcustom vm-mime-8bit-composition-charset nil + "*Character set that VM should assume if it finds non-US-ASCII characters +in a composition buffer. Composition buffers are assumed to use +US-ASCII unless the buffer contains a byte with the high bit set. +This variable specifies what character set VM should assume if +such a character is found. + +This variable is unused in XEmacs/MULE and FSF Emacs starting +with version 20. Since multiple character sets can be displayed +in a single buffer under MULE, VM will map the file coding system +of the buffer to a single MIME character set that can display all +the buffer's characters." + :group 'vm-mime + :type '(choice (const nil) + (string :tag "iso-8859-1" "iso-8859-1") + (string :tag "iso-2022-jp" "iso-2022-jp") + (string :tag "User defined") + (const :tag "Auto select" nil))) + +(defcustom vm-mime-8bit-text-transfer-encoding 'quoted-printable + "*Symbol specifying what kind of transfer encoding to use on 8bit +text. Characters with the high bit set cannot safely pass +through all mail gateways and mail transport software. MIME has +two transfer encodings that convert 8-bit data to 7-bit for safe +transport. Quoted-printable leaves the text mostly readable even +if the recipient does not have a MIME-capable mail reader. BASE64 +is unreadable without a MIME-capable mail reader, unless your name +is U3BvY2s=. + +A value of 'quoted-printable, means to use quoted-printable encoding. +A value of 'base64 means to use BASE64 encoding. +A value of '8bit means to send the message as is. + +Note that this variable usually only applies to textual MIME +content types. Images, audio, video, etc. typically will have +some attribute that makes VM consider them to be \"binary\", +which moves them outside the scope of this variable. For +example, messages with line lengths of 1000 characters or more +are considered binary, as are messages that contain carriage +returns (ascii code 13) or NULs (ascii code 0)." + :group 'vm-mime + :type '(choice (const quoted-printable) + (const base64) + (const 8bit))) + +(defcustom vm-mime-composition-armor-from-lines nil + "*Non-nil value means \"From \" lines should be armored before sending. +A line beginning with \"From \" is considered a message separator +by many mail delivery agents. These agents will often insert a > +before the word \"From\" to prevent mail readers from being +confused. This is proper behavior, but it breaks digitally signed +messages, which require bit-perfect transport in order for the +message contents to be considered genuine. + +If `vm-mime-composition-armor-from-lines' is non-nil, a line +beginning with \"From \" will cause VM to encode the message +using either quoted-printable or BASE64 encoding so that the From +line can be protected." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-attachment-auto-type-alist + '( + ("\\.jpe?g$" . "image/jpeg") + ("\\.gif$" . "image/gif") + ("\\.png$" . "image/png") + ("\\.tiff?$" . "image/tiff") + ("\\.svg$" . "image/svg+xml") + ("\\.pcx$" . "image/x-pcx") + ("\\.txt$" . "text/plain") + ("\\.html?$" . "text/html") + ("\\.css$" . "text/css") + ("\\.csv$" . "text/csv") + ("\\.xml$" . "text/xml") + ("\\.vcf$" . "text/x-vcard") + ("\\.vcard$" . "text/x-vcard") + ("\\.au$" . "audio/basic") + ("\\.mp4$" . "audio/mp4") + ("\\.m4[abpr]$". "audio/mp4") + ("\\.wma$" . "audio/x-ms-wma") + ("\\.wax$" . "audio/x-ms-wax") + ("\\.ram?$" . "audio/vnd.ra-realaudio") + ("\\.ogg$" . "audio/vorbis") + ("\\.oga$" . "audio/vorbis") + ("\\.wav$" . "audio/vnd.wave") + ("\\.mpe?g$" . "video/mpeg") + ("\\.m4v$" . "video/mp4") + ("\\.mov$" . "video/quicktime") + ("\\.ogc$" . "video/ogg") + ("\\.wmv$" . "video/x-ms-wmv") + ("\\.webm$" . "video/webm") + ("\\.zip$" . "application/zip") + ("\\.gz$" . "application/x-gzip") + ("\\.tar$" . "application/x-tar") + ("\\.rar$" . "application/x-rar-compressed") + ("\\.e?ps$" . "application/postscript") + ("\\.pdf$" . "application/pdf") + ("\\.dvi$" . "application/x-dvi") + ("\\.tex$" . "application/x-latex") + ("\\.ttf$" . "application/x-font-ttf") + ("\\.swf$" . "application/x-shockwave-flash") + ("\\.tex$" . "application/x-latex") + ("\\.js$" . "application/javascript") + ("\\.dtd$" . "application/xml-dtd") + ("\\.pdf$" . "application/pdf") + ("\\.rtf$" . "application/rtf") + ("\\.doc$" . "application/msword") + ("\\.xls$" . "application/vnd.ms-excel") + ("\\.ppt$" . "application/vnd.ms-powerpoint") + ("\\.mdb$" . "application/vnd.ms-access") + ("\\.odt$" . "application/vnd.oasis.opendocument.text") + ("\\.odp$" . "application/vnd.oasis.opendocument.presentation") + ("\\.ods$" . "application/vnd.oasis.opendocument.spreadsheet") + ("\\.odg$" . "application/vnd.oasis.opendocument.graphics") + ("\\.odf$" . "application/vnd.oasis.opendocument.formulae") + ("\\.odb$" . "application/vnd.oasis.opendocument.databases") + ("\\.docx$" . "application/vnd.openxmlformats-officedocument.wordprocessingml.document") + ("\\.docm$" . "application/vnd.openxmlformats-officedocument.wordprocessingml.document") + ("\\.pptx$" . "application/vnd.openxmlformats-officedocument.presentationml.presentation") + ("\\.pptm$ " . "application/vnd.openxmlformats-officedocument.presentationml.presentation") + ("\\.xlsx$" . "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") + ("\\.xlsm$" . "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet") + ("\\.hqx$" . "application/mac-binhex40") + ) + "*Alist used to guess a MIME content type based on a file name. +The list format is + + ((REGEXP . TYPE) ...) + +REGEXP is a string that specifies a regular expression. +TYPE is a string specifying a MIME content type. + +When a file is attached to a MIME composition buffer using +`vm-attach-file', this list will be scanned until a REGEXP +matches the file's name. The corresponding TYPE will be +offered as a default when you are prompted for the file's +type. + +The value of this variable is also used to guess the MIME type of +application/octet-stream objects for display purposes if the +value of `vm-infer-mime-types' is non-nil." + :group 'vm-mime + :type '(repeat (cons regexp + (string :tag "MIME Type")))) + +(defcustom vm-mime-attachment-auto-suffix-alist + '( + ("image/jpeg" . ".jpg") + ("image/gif" . ".gif") + ("image/png" . ".png") + ("image/tiff" . ".tif") + ("text/html" . ".html") + ("audio/basic" . ".au") + ("video/mpeg" . ".mpg") + ("video/quicktime" . ".mov") + ("application/zip" . ".zip") + ("application/postscript" . ".ps") + ("application/pdf" . ".pdf") + ("application/msword" . ".doc") + ("application/vnd.ms-excel" . ".xls") + ("application/vnd.ms-powerpoint" . ".ppt") + ("application/mac-binhex40" . ".hqx") + ) + "*Alist used to select a filename suffix for MIME object temporary files. +The list format is + + ((TYPE . SUFFIX) ...) + +TYPE is a string specifying a MIME top-level type or a type/subtype pair. +If a top-level type is listed without a subtype, all subtypes of +that type are matched. + +SUFFIX is a string specifying the suffix that should be used for +the accompanying type. + +When a MIME object is displayed using an external viewer VM must +first write the object to a temporary file. The external viewer +opens and displays that file. Some viewers will not open a file +unless the filename ends with some extention that it recognizes +such as '.html' or '.jpg'. You can use this variable to map MIME +types to extensions that your external viewers will recognize. VM +will search the list for a matching type. The suffix associated +with the first type that matches will be used." + :group 'vm-mime + :type '(repeat (cons (string :tag "MIME Type") + (string :tag "File Suffix")))) + +(defcustom vm-mime-encode-headers-regexp + "Subject\\|\\(\\(Resent-\\)?\\(From\\|To\\|CC\\|BCC\\)\\)\\|Organization" + "*A regexp matching the headers which should be encoded." + :group 'vm-mime + :type '(regexp)) + +(defcustom vm-mime-encode-headers-words-regexp + (let ((8bit-word "\\([^ ,\t\n\r]*[^\x0-\x7f]+[^ ,\t\n\r]*\\)+")) + (concat "[ ,\t\n\r]\\(" 8bit-word "\\(\\s-+" 8bit-word "\\)*\\)")) + "*A regexp matching a set of consecutive words which must be encoded." + :group 'vm-mime + :type '(regexp)) + +(defcustom vm-mime-encode-headers-type 'Q + "*The encoding type to use for encoding headers." + :group 'vm-mime + :type '(choice (const :tag "Quoted-printable" Q) + (const :tag "Binary" B) + (regexp :tag "BASE64 on match of " + "[^- !#-'*+/-9=?A-Z^-~]"))) + +(defcustom vm-mime-encode-words-regexp "[^\x0-\x7f]+" + "*A regexp matching a sequence of 8 bit chars." + :group 'vm-mime + :type '(regexp)) + +(defcustom vm-mime-max-message-size nil + "*Largest MIME message that VM should send without fragmentation. +The value should be an integer which specifies the size in bytes. +A message larger than this value will be split into multiple parts +for transmission using the MIME message/partial type." + :group 'vm-mime + :type '(choice (const nil) integer)) + +(defcustom vm-mime-attachment-save-directory (expand-file-name "~/") + "*Non-nil value is a default directory for saving MIME attachments. +When VM prompts you for a target file name when saving a MIME body, +any relative pathnames will be relative to this directory." + :group 'vm-mime + :type '(choice (const nil) + directory)) + +(defcustom vm-mime-attachment-source-directory (expand-file-name "~/") + "*Non-nil value is a default source directory for MIME attachments. +When `vm-attach-file' prompts you for the name of a file to +attach, any relative pathnames will be relative to this directory." + :group 'vm-mime + :type '(choice (const nil) + directory)) + +(defcustom vm-mime-all-attachments-directory nil + "*Directory to where the attachments should go or come from." + :group 'vm-mime + :type '(choice (directory :tag "Directory:") + (const :tag "Use `vm-mime-attachment-save-directory'" nil))) + +(defvar vm-mime-save-all-attachments-history nil + "Directory history to where the attachments should go.") + +(defvar vm-mime-yank-attachments nil + "*This variable, originally from vm-pine, is deprecated. It is +replaced by `vm-include-mime-attachments'.") + +(defvaralias 'vm-mime-yank-attachments 'vm-include-mime-attachments) +(make-obsolete-variable 'vm-mime-yank-attachments + 'vm-include-mime-attachments + "8.2.0") + +(defcustom vm-include-mime-attachments nil + "*Non-nil value enables attachments to be included in quoted text in +a reply message. Otherwise only the button label will be included." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-infer-mime-types nil + "*Non-nil value means that VM should try to infer a MIME object's +type from its filename when deciding whether the object should be +displayed and how it should be displayed. This will be done only +for objects of type application/octet-stream. The object's filename +is checked against the regexps in `vm-mime-attachment-auto-type-alist' +and the type corresponding to the first match found is used." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-infer-mime-types-for-text nil + "*Non-nil value means VM should try to infer a MIME object's + type from its filename also for text attachments, not only for + application/octet-stream." + :group 'vm-mime + :type 'boolean) +(defvaralias 'vm-mime-attachment-infer-type-for-text-attachments + 'vm-infer-mime-types-for-text) +(make-obsolete-variable 'vm-mime-attachment-infer-type-for-text-attachments + 'vm-infer-mime-types-for-text "8.2.0") + +(defcustom vm-mime-avoid-folding-content-type t + "*Non-nil means don't send folded Content- headers in MIME messages. +`Folded' headers are headers broken into multiple lines as specified +in RFC822 for readability and to avoid excessive line lengths. At +least one major UNIX vendor ships a version of sendmail that believes +a folded Content-Type header is a syntax error, and returns any such +message to sender. A typical error message from such a sendmail +version is, + +553 header syntax error, line \" charset=us-ascii\" + +If you see one of these, setting `vm-mime-avoid-folding-content-type' +non-nil may let your mail get through." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-mime-base64-decoder-program + (vm-locate-executable-file "base64-decode") + "*Non-nil value should be a string that names a MIME base64 decoder. +If the program is in your executable search path, you need not +specify a full pathname. The program should expect to read +base64 data on its standard input and write the converted data +to its standard output." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mime-base64-decoder-switches nil + "*List of command line flags passed to the command named by +`vm-mime-base64-decoder-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mime-base64-encoder-program + (vm-locate-executable-file "base64-encode") + "*Non-nil value should be a string that names a MIME base64 encoder. +If the program is in your executable search path, you need not +specify a full pathname. The program should expect arbitrary +data on its standard input and write base64 data to its standard +output." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mime-base64-encoder-switches nil + "*List of command line flags passed to the command named by +`vm-mime-base64-encoder-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mime-qp-decoder-program (vm-locate-executable-file "qp-decode") + "*Non-nil value should be a string that names a MIME quoted-printable +decoder. If the program is in your executable search path, you +need not specify a full pathname. The program should expect to +read quoted-printable data on its standard input and write the +converted data to its standard output." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mime-qp-decoder-switches nil + "*List of command line flags passed to the command named by +`vm-mime-qp-decoder-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mime-qp-encoder-program (vm-locate-executable-file "qp-encode") + "*Non-nil value should be a string that names a MIME quoted-printable +encoder. If the program is in your executable search path, you +need not specify a full pathname. The program should expect +arbitrary data on its standard input and write quoted-printable +data to its standard output." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mime-qp-encoder-switches nil + "*List of command line flags passed to the command named by +`vm-mime-qp-encoder-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mime-uuencode-decoder-program "uudecode" + "*Non-nil value should be a string that names UUENCODE decoder. +If the program is in your executable search path, you need not +specify a full pathname. The program should expect to read +uuencoded data on its standard input and write the converted +data to the file specified in the ``begin'' line at the start of +the data." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mime-uuencode-decoder-switches nil + "*List of command line flags passed to the command named by +`vm-mime-uuencode-decoder-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-auto-next-message t + "*Non-nil value causes VM to use `vm-next-message' to advance to the next +message in the folder if the user attempts to scroll past the end of the +current messages. A nil value disables this behavior." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-honor-page-delimiters nil + "*Non-nil value causes VM to honor page delimiters (as specified by the +Emacs page-delimiter variable) when scrolling through a message. +This means that when VM encounters a page delimiter when displaying a +message all the screen lines below that delimiter will be blank until +you scroll past that delimiter. When you scroll past the delimiter +the text lines between the delimiter and the next delimiter will be +displayed. Scrolling backward past a page delimiter reverses this +process. + +A nil value means ignore page-delimiters." + :group 'vm-presentation + :type 'boolean) + +(defcustom vm-page-continuation-glyph "...press SPACE to see more..." + "*Glyph VM uses to indicate there is more text on the next page. +When VM honors page delimiters (see `vm-honor-page-delimiters') +and when VM is previewing a message (see `vm-preview-lines') VM +indicates that there is more text by placing the glyph specified +by this variable at the end of the displayed text. + +Under XEmacs, the value of `vm-page-continuation-glyph' can be a +string or a glyph object. + +Under FSF Emacs, `vm-page-continuation-glyph' must be a string." + :group 'vm-presentation + :type 'boolean) + +(defconst vm-default-window-configuration + ;; startup = folder on bottom, summary on top + ;; quitting = full screen folder + ;; reading-message = folder on bottom, summary on top + ;; composing-message = full screen composition + ;; editing-message = full screen edit + ;; vm-summarize = folder on bottom, summary on top + ;; vm-pipe-message-to-command = summary on top, shell output on bottom + '( + (startup + ((((top . 70) (left . 70))) + (((- (0 0 80 10) (0 10 80 40)) + ((nil summary) (nil message)) + ((nil nil nil t) (nil nil nil nil)))))) + (quitting + ((((top . 70) (left . 70))) + (((0 0 80 40) + ((nil message)) + ((nil nil nil t)))))) + (reading-message + ((((top . 70) (left . 70))) + (((- (0 0 80 10) (0 10 80 40)) + ((nil summary) (nil message)) + ((nil nil nil t) (nil nil nil nil)))))) + (composing-message + ((((top . 70) (left . 70))) + (((0 0 80 40) + ((nil composition)) + ((nil nil nil t)))))) + (editing-message + ((((top . 70) (left . 70))) + (((0 0 80 40) + ((nil edit)) + ((nil nil nil t)))))) + (vm-summarize + ((((top . 70) (left . 70))) + (((- (0 0 80 10) (0 10 80 40)) + ((nil summary) (nil message)) + ((nil nil nil t) (nil nil nil nil)))))) + (vm-folders-summarize + ((((top . 70) (left . 70))) + (((- (0 0 80 10) (0 10 80 40)) + ((nil folders-summary) (nil message)) + ((nil nil nil t) (nil nil nil nil)))))) + ) + "Default window configuration for VM if the user does not specify one. +If you want to completely turn off VM's window configuration +feature, set this variable and `vm-window-configuration-file' to +nil in your .vm file. + +If you want to have a different window configuration setup than +this, you should not set this variable directly. Rather you +should set the variable `vm-window-configuration-file' to point at +a file, and use the command `vm-save-window-configuration' +(normally bound to `WS') to modify part of this configuration to +your liking. + +WARNING: Don't point `vm-window-configuration-file' at your .vm or +.emacs file. Your window configuration file should start out as +an empty or nonexistent file. VM will repeatedly overwrite this +file as you update your window configuration settings, so +anything else you put into this file will go away.") + +(defcustom vm-window-configuration-file "~/.vm.windows" + "*Non-nil value should be a string that tells VM where to load +and save your window configuration settings. Your window +configuration settings are loaded automatically the first time +you run VM in an Emacs session, and tells VM how to set up +windows depending on what you are doing inside VM. + +The commands `vm-save-window-configuration' (normally bound to `WS') and +`vm-delete-window-configuration' (bound to `WD') let you update this +information; see their documentation for more information. + +You cannot change your window configuration setup without giving +`vm-window-configuration-file' a non-nil value. A nil value causes +VM to use the default window setup specified by the value of +`vm-default-window-configuration'. + +WARNING: Don't point `vm-window-configuration-file' at your .vm or +.emacs file. Your window configuration file should start out as +an empty or nonexistent file. VM will repeatedly overwrite this +file as you update your window configuration settings, so +anything else you put into this file will go away." + :group 'vm-frames + :type 'file) + +(defcustom vm-expunge-before-quit nil + "*Non-nil value causes VM to expunge deleted messages before +quitting. You can use `vm-quit-no-expunge' and `vm-quit-no-change' +to override this behavior." + :group 'vm-misc + :type 'boolean) + +(defcustom vm-expunge-before-save nil + "*Non-nil value causes VM to expunge deleted messages before +saving a folder." + :group 'vm-dispose + :type 'boolean) + +(defcustom vm-confirm-quit 'if-something-will-be-lost + "*Value of t causes VM to always ask for confirmation before quitting +a VM visit of a folder. A nil value means VM will ask only when messages +will be lost unwittingly by quitting, i.e. not removed by intentional +delete and expunge. A value that is not nil and not t causes VM to ask +only when there are unsaved changes to message attributes, or when messages +will be unwittingly lost." + :group 'vm-misc + :type '(choice (const :tag "Always ask" t) + (const :tag "Only ask if messages will be lost" nil) + (const :tag "Only ask if there are unsaved changes" + 'if-something-will-be-lost))) + +(defcustom vm-confirm-new-folders nil + "*Non-nil value causes interactive calls to `vm-save-message' +to ask for confirmation before creating a new folder." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-delete-empty-folders t + "*Non-nil value means remove empty (zero length) folders after saving. +A value of t means always remove the folders. +A value of nil means never remove empty folders. +A value that's not t or nil means ask before removing empty folders." + :group 'vm-folders + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Ask" ask))) + +(defcustom vm-folder-file-precious-flag t + "*Value that `file-precious-flag' should have in visited folders. +A non-nil value causes folders to be saved by writing to a +temporary file and then replacing the folder with that file. A +nil value causes folders to be saved by writing directly to the +folder without the use of a temporary file." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-flush-interval 90 + "*Non-nil value specifies how often VM flushes its cached +internal data using a timer task. A numeric value gives the +number of seconds between flushes. A value of t means flush +every time there is a change. Nil means don't do flushing until +a message or folder is saved. + +Normally when a message attribute is changed. VM keeps the record +of the change in its internal memory and doesn't insert the +changed data into the folder buffer until a particular message or +the whole folder is saved to disk. This makes normal Emacs +auto-saving useless for VM folder buffers because the information +you'd want to auto-save, i.e. the attribute changes are not in +the buffer when it is auto-saved. + +Setting `vm-flush-interval' to a numeric value will cause the VM's +internal memory caches to be periodically flushed to the folder +buffer. This is done non-obtrusively, so that if you type +something while flushing is occurring, the flush will abort +cleanly and Emacs will respond to your keystrokes as usual." + :group 'vm-folders + :type '(choice (const :tag "Flush after folder/message saved" nil) + (const :tag "Flush after every change" t) + (integer :tag "Seconds"))) + +(defcustom vm-visit-when-saving 'not-always + "*Value determines whether VM will visit folders when saving messages. +`Visiting' means that VM will read the folder into Emacs and append the +message to the buffer instead of appending to the folder file directly. +This behavior is ideal when folders are encrypted or compressed since +appending plaintext directly to such folders is a ghastly mistake. + +A value of t means VM will always visit folders when saving. + +A nil value means VM will never visit folders before saving to them, and +VM will generate an error if you attempt to save messages to a folder +that is being visited. The latter restriction is necessary to insure +that the buffer and disk copies of the folder being visited remain +consistent. + +A value other than nil or t means that VM will save to the folder +buffer if it is visited or to the file otherwise." + :group 'vm-dispose + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Not always" not-always))) + +(defcustom vm-auto-folder-alist nil + "*Non-nil value should be an alist that VM will use to choose a default +folder name when messages are saved. The alist should be of the form +\((HEADER-NAME-REGEXP + (REGEXP . FOLDER-NAME) ... ) + ...) +where HEADER-NAME-REGEXP and REGEXP are strings, and FOLDER-NAME +is a string or an s-expression that evaluates to a string. + +If any part of the contents of the first message header whose +name is matched by HEADER-NAME-REGEXP is matched by the regular +expression REGEXP, VM will evaluate the corresponding FOLDER-NAME +and use the result as the default folder for saving the message. +If the resulting folder name is a relative pathname, then it will +be rooted in the directory named by `vm-folder-directory', or the +default-directory of the currently visited folder if +`vm-folder-directory' is nil. If the resulting folder name is an IMAP +maildrop specification, then the corresponding IMAP folder is used for +saving. + +When FOLDER-NAME is evaluated, the current buffer will contain +only the contents of the header matched by HEADER-NAME-REGEXP. +It is safe to modify this buffer. You can use the match data +from any \\( ... \\) grouping constructs in REGEXP along with the +function buffer-substring to build a folder name based on the +header information. If the result of evaluating FOLDER-NAME is a +list, then the list will be treated as another auto-folder-alist +and will be descended recursively. + +Whether REGEXP is matched case sensitively depends on the value +of the variable `vm-auto-folder-case-fold-search'. Header names +are always matched case insensitively." + :group 'vm-dispose + :type '(choice (const :tag "None" nil) + (repeat (cons + (regexp :tag "Header Regexp") + (repeat + (cons (regexp :tag "Content Regexp") + (choice (string :tag "Folder Name") + (sexp :tag "Folder Expresion")))))))) + +(defcustom vm-auto-folder-case-fold-search nil + "*Non-nil value means VM will ignore case when matching header +contents while doing automatic folder selection via the variable +`vm-auto-folder-alist'." + :group 'vm-dispose + :type 'boolean) + +(defcustom vm-virtual-folder-alist nil + "*Non-nil value should be a list of virtual folder definitions. + +A virtual folder is a mapping of messages from one or more real folders +into what appears to be a single folder. A virtual folder definition +specifies which real folders should be searched for prospective messages +and what the inclusion criteria are. + +Each virtual folder definition should have the following form: + + (VIRTUAL-FOLDER-NAME + ( (FOLDER-NAME ...) + (SELECTOR [ARG ...]) ... ) + ... ) + +VIRTUAL-FOLDER-NAME is the name of the virtual folder being defined. +This is the name by which you and VM will refer to this folder. + +FOLDER-NAME should be the name of a real folder. There may be more than +one FOLDER-NAME listed, the SELECTORs within that sublist will apply to +them all. If FOLDER-NAME is a directory, VM will assume this to mean that +all the folders in that directory should be searched. + +The SELECTOR is a Lisp symbol that tells VM how to decide whether a message +from one of the folders specified by the FOLDER-NAMEs should be included +in the virtual folder. Some SELECTORs require an argument ARG; unless +otherwise noted ARG may be omitted. + +The recognized SELECTORs are: + + author - matches message if ARG matches the author; ARG should be a + regular expression. + author-or-recipient + - matches message if ARG matches the author of + the message or any of its recipients; ARG + should be a regular expression. + and - matches the message if all its argument + selectors match the message. Example: + (and (author \"Derek McGinty\") (new)) + matches all new messages from Derek McGinty. + `and' takes any number of arguments. + any - matches any message. + deleted - matches message if it is flagged for deletion. + edited - matches message if it has been edited. + filed - matches message if it has been saved with its headers. + forwarded - matches message if it has been forwarded using + a variant of `vm-forward-message' or `vm-send-digest'. + header - matches message if ARG matches any part of the header + portion of the message; ARG should be a + regular expression. + header-field - matches message if the header field named ARG1 + has the regular expression pattern ARG2. + header-or-text - matches message if ARG matches any part of the + headers or the text portion of the message; + ARG should be a regular expression. + label - matches message if message has a label named ARG. + less-chars-than - matches message if message has less than ARG + characters. ARG should be a number. + less-lines-than - matches message if message has less than ARG + lines. ARG should be a number. + more-chars-than - matches message if message has more than ARG + characters. ARG should be a number. + more-lines-than - matches message if message has more than ARG + lines. ARG should be a number. + marked - matches message if it is marked, as with `vm-mark-message'. + new - matches message if it is new. + not - matches message only if its selector argument + does NOT match the message. Example: + (not (deleted)) + matches messages that are not deleted. + or - matches the message if any of its argument + selectors match the message. Example: + (or (author \"Dave Weckl\") (subject \"drum\")) + matches messages from Dave Weckl or messages + with the word \"drum\" in their Subject header. + `or' takes any number of arguments. + read - matches message if it is neither new nor unread. + recent - matches message if it is new. + recipient - matches message if ARG matches any part of the recipient + list of the message. ARG should be a regular expression. + redistributed - matches message if it has been redistributed using + `vm-resend-message'. + replied - matches message if it has been replied to. + sent-after - matches message if it was sent after the date ARG. + A fully specified date looks like this: + \"31 Dec 1999 23:59:59 GMT\" + although the parts can appear in any order. + You can leave out any part and it will + default to the current date's value for that + part, with the exception of the hh:mm:ss + part which defaults to midnight. + sent-before - matches message if it was sent before the date ARG. + A fully specified date looks like this: + \"31 Dec 1999 23:59:59 GMT\" + although the parts can appear in any order. + You can leave out any part and it will + default to the current date's value for that + part, with the exception of the hh:mm:ss + part which defaults to midnight. + subject - matches message if ARG matches any part of the message's + subject; ARG should be a regular expression. + text - matches message if ARG matches any part of the text + portion of the message; ARG should be a + regular expression. + unanswered - matches message if it has not been replied to. + Same as the `unreplied' selector. + undeleted - matches message if it has not been deleted. + unedited - matches message if it has not been edited. + unfiled - matches message if it has not been saved with its + headers. + unforwarded - matches message if it has not been forwarded using + `vm-forward-message' or `vm-send-digest' or one + of their variants. + unread - matches message if it is not new and hasn't been read. + unseen - matches message if it is not new and hasn't been read. + Same as `unread' selector. + unredistributed - matches message if it has not been redistributed using + `vm-resend-message'. + unreplied - matches message if it has not been replied to. + virtual-folder-member + - matches message if the message is already a + member of some virtual folder currently + being visited. + written - matches message if it has been saved without its headers. +" + :group 'vm-folders + :type '(choice (const :tag "none" nil) + (repeat (group (string :tag "Virtual Folder Name") + (repeat :tag "Folder List" string) + (sexp :tag "Selectors"))))) + +(defcustom vm-virtual-mirror t + "*Non-nil value causes the attributes of messages in virtual folders +to mirror the changes in the attributes of the underlying real messages. +Similarly, changes in the attributes of virtual messages will change the +attributes of the underlying real messages. A nil value causes virtual +messages to have their own distinct set of attributes, apart from the +underlying real message. + +This variable automatically becomes buffer-local when set in any +fashion. You should set this variable only in your .vm or .emacs +file. Use setq-default. Once VM has been started, you should not +set this variable directly, rather you should use the command +`vm-toggle-virtual-mirror', normally bound to `V M'." + :group 'vm-folders + :type 'boolean) + +(make-variable-buffer-local 'vm-virtual-mirror) + +(defvar vm-folder-read-only nil + "*Non-nil value causes a folder to be considered unmodifiable by VM. +Commands that modify message attributes or messages themselves are disallowed. +Commands that add or remove messages from the folder are disallowed. +Commands that scan or allow the reading of messages are allowed but the +`new' and `unread' message flags are not changed by them. + +This variable automatically becomes buffer-local when set in any +fashion. You should set this variable only in your .vm or .emacs +file. Use setq-default. Once VM has been started, you should not +set this variable directly, rather you should use the command +`vm-toggle-read-only', normally bound to C-x C-q.") + +(make-variable-buffer-local 'vm-folder-read-only) + +(defcustom vm-included-text-prefix " > " + "*String used to prefix included text in replies." + :group 'vm-compose + :type 'string) + +(defcustom vm-keep-sent-messages 1 + "*Non-nil value N causes VM to keep the last N messages sent from within VM. +`Keep' means that VM will not kill the composition buffer after +you send a message with C-c C-c (`vm-mail-send-and-exit'). A +value of 0 or nil causes VM never to keep such buffers. A value +of t causes VM never to kill such buffers. + +Note that these buffers will vanish once you exit Emacs. To keep a permanent +record of your outgoing mail, use the `mail-archive-file-name' variable." + :group 'vm-compose + :type '(choice (const :tag "Keep" Keep) + (const :tag "Don't Keep" nil) + (integer :tag "Keep N"))) + +(defcustom vm-confirm-mail-send nil + "*Non-nil means ask before sending a mail message. +This affects `vm-mail-send' and `vm-mail-send-and-exit' in Mail mode." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-mail-auto-save-directory nil + "*Directory where messages being composed are auto-saved. If it is +nil, `vm-folder-directory' is used for this purpose." + :group 'vm-compose + :type '(choice (const nil) directory)) + +(defcustom vm-mail-header-from nil + "*Non-nil value should be a string that will be appear as the body +of the From header in outbound mail messages. A nil value means don't +insert a From header. This variable also controls the inclusion and +format of the Resent-From header, when resending a message with +`vm-resend-message'." + :group 'vm-compose + :type '(choice (const nil) string)) + +(defcustom vm-mail-use-sender-address nil + "*If this set to `t', \\[vm-mail] will use the sender of the current +message as the recipient for the new message composition." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-mail-header-insert-date t + "*Non-nil value causes VM to insert a Date header into a message +when it is sent. If the message has a Date header, it will be +removed before the new one is inserted. If the message being +sent is a resent message (i.e. has a Resent- recipient header) +then the Resent-Date header will be removed/inserted instead. + +This is useful if you set mail-archive-file-name, +because your archived message will contain a Date header. + +A nil value means don't insert a Date header." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-mail-header-insert-message-id t + "*Non-nil value causes VM to insert a Message-ID header into a message +when it is sent. If the message has a Message-ID header, it will +be removed before the new one is inserted. If the message being +sent is a resent message (i.e. has a Resent- recipient header) a +Resent-Message-ID header will be removed/inserted instead. + +This is useful if you set mail-archive-file-name, because your +archived messages will contain a Message-ID header, which may be +useful later for threading messages. + +A nil value means don't insert a Message-ID header." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-mail-mode-hidden-headers '("References" "X-Mailer") + "*A list of headers to hide in `vm-mail-mode'." + :group 'vm-compose + :type '(repeat :tag "Header" string)) + +(defcustom vm-mail-header-order '("From:" "Organization:" "Subject:" + "Date:" "Priority:" "X-Priority:" + "Importance:" "Message-ID:" + "MIME-Version:" "Content-Type:" + "To:" "Newsgroups:" "CC:" "BCC:" "Reply-To:") + "*Order of headers when calling `vm-reorder-message-headers' interactively +in a composition buffer." + :group 'vm-compose + :type '(repeat :tag "Header" string)) + +(defcustom vm-mail-reorder-message-headers nil + "*Reorder message headers before sending." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-do-fcc-before-mime-encode nil + "*Non-nil means to FCC before encoding. This allows saving of +messages unencoded, specifically not to waste storage for +attachments which are stored on disk anyway." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-reply-subject-prefix nil + "*Non-nil value should be a string that VM should add to the beginning +of the Subject header in replies, if the string is not already present. +Nil means don't prefix the Subject header." + :group 'vm-compose + :type '(choice (const nil) string)) + +(defcustom vm-reply-ignored-addresses nil + "*Non-nil value should be a list of regular expressions that match +addresses that VM should automatically remove from the recipient +headers of replies. These addresses are removed from the headers +before you are placed in the message composition buffer. So if +you see an address in the header you don't want you should remove +it yourself. + +Case is ignored when matching the addresses." + :group 'vm-compose + :type '(choice (const nil) + (repeat regexp))) + +(defcustom vm-reply-ignored-reply-tos nil + "*Non-nil value should be a list of regular expressions that match +addresses that, if VM finds in a message's Reply-To header, VM +should ignore the Reply-To header and not use it for replies. VM +will use the From header instead. + +Case is ignored when matching the addresses. + +This variable exists solely to provide an escape chute from +mailing lists that add a Reply-To: mailing list header, thereby +leaving no way to reply to just the author of a message." + :group 'vm-compose + :type '(choice (const nil) + (repeat regexp))) + +(defcustom vm-in-reply-to-format "%i" + "*String which specifies the format of the contents of the In-Reply-To +header that is generated for replies. See the documentation for the +variable `vm-summary-format' for information on what this string may +contain. The format should *not* end with a newline. +Nil means don't put an In-Reply-To header in replies. + +If the format includes elements with non-ASCII characters, then +\"In-Reply-To\" should be added to `vm-mime-encode-headers-regexp'." + :group 'vm-compose + :type '(choice (const nil) string)) + +(defcustom vm-included-text-attribution-format "%F writes:\n" + "*String which specifies the format of the attribution that precedes the +included text from a message in a reply. See the documentation for the +variable `vm-summary-format' for information on what this string may contain. +Nil means don't attribute included text in replies." + :group 'vm-compose + :type '(choice (const nil) string)) + +(defcustom vm-include-text-basic nil + "*If true a reply will include the basic text of a message. +This is an old method for citing messages and should not be used +normally." + :group 'vm-compose + :type 'boolean) + +(defvar vm-include-text-from-presentation nil + "*If true `vm-reply-include-text' will include the presentation +of a message as shown in the Presentation buffer, instead of the +normal text generated by the default VM method. + +This is an exeperimental feature that should not be used +normally, but it might give better results when using filling or +MIME encoded messages, e.g. HTML message. + +You can only include the presentation of the current message in +your reply using this method. Marked messages, threads and +prefix argument counts are not available.") +(make-obsolete-variable 'vm-load-headers-only nil "8.2.0") + + +(defcustom vm-included-mime-types-list nil + "*If non-nil, the list of mime type/subtype pairs that should be +included in quoted text in a reply message in addition to the default +types. + +This variable currently has an effect only if `vm-include-text-basic' +is true. It has no effect for the default text quotation mechanism +based on MIME decoding. + +The defaut value is nil." + :group 'vm-compose + :type '(choice (const nil) + (repeat string))) + +(defcustom vm-included-text-headers nil + "*List of headers that should be retained in a message included in +a reply. These should be listed in the order you wish them to +appear in the included text. Regular expressions are allowed. +There's no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched case +insensitively. + +If the value of `vm-included-text-discard-header-regexp' is nil, +the headers matched by `vm-included-text-headers' are the only +headers that will be retained. + +If `vm-included-text-discard-header-regexp' is non-nil, then the +headers matched by that variable will be omitted; all the others +will be included. `vm-included-text-headers' determines the +header order in that case, with headers not matching any in the +`vm-included-text-headers' list appearing last in the header +section of the included text." + :group 'vm-compose + :type '(choice (const nil) + (repeat regexp))) + +(defcustom vm-included-text-discard-header-regexp nil + "*Non-nil value should be a regular expression that tells what +headers should not be retained in a message included in a reply. +This variable along with `vm-included-text-headers' determines +which headers are retained. + +If the value of `vm-included-text-discard-header-regexp' is nil, +the headers matched by `vm-included-text-headers' are the only headers +that will be retained. + +If `vm-included-text-discard-header-regexp' is non-nil, then only +headers matched by this variable will not be retained; all +others will be included. `vm-included-text-headers' determines the +header order in that case, with headers not matching any in +the `vm-included-text-headers' list appearing last in the header +section of the included text." + :group 'vm-compose + :type '(choice (const nil) + regexp)) + +(defcustom vm-forwarding-subject-format "forwarded message from %F" + "*String which specifies the format of the contents of the Subject +header that is generated for a forwarded message. See the documentation +for the variable `vm-summary-format' for information on what this string +may contain. The format should *not* end with nor contain a newline. +Nil means leave the Subject header empty when forwarding." + :group 'vm-compose + :type '(choice (const nil) + (string))) + +(defcustom vm-forwarded-message-preamble-format + "\n---------- Original Message ----------\n" + "*String which specifies the preamble for a forwarded message." + :group 'vm-compose + :type 'string) + +(defcustom vm-forwarded-headers nil + "*List of headers that should be forwarded by `vm-forward-message'. +The headers should be listed in the order you wish them to appear +in the forwarded message. Regular expressions are allowed. +There's no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched +case-insensitively. + +If the value of `vm-unforwarded-header-regexp' is nil, the headers +matched by `vm-forwarded-headers' are the only headers that will be +forwarded. + +If `vm-unforwarded-header-regexp' is non-nil, then the headers +matched by that variable will be omitted and all the others will +be forwarded. `vm-forwarded-headers' determines the forwarding +order in that case, with headers not matching any in the +`vm-forwarded-headers' list appearing last in the header section +of the forwarded message." + :group 'vm-compose + :type '(repeat regexp)) + +(defcustom vm-unforwarded-header-regexp "none-to-be-dropped" + "*Non-nil value should be a regular expression that tells what +headers should not be forwarded by `vm-forward-message' and +`vm-send-digest'. This variable along with `vm-forwarded-headers' +determines which headers are forwarded. + +If the value of `vm-unforwarded-header-regexp' is nil, the headers +matched by `vm-forwarded-headers' are the only headers that will be +forwarded. + +If `vm-unforwarded-header-regexp' is non-nil, then only the +headers matched by this variable will be omitted; all the others will +be forwarded. `vm-forwarded-headers' determines the forwarding +order in that case, with headers not matching any in the +`vm-forwarded-headers' list appearing last in the header section +of the forwarded message." + :group 'vm-compose + :type '(choice + (const :tag "Only forward headers listed in vm-forward-headers" nil) + (const :tag "Forward all headers" "none-to-be-dropped") + regexp)) + +(defcustom vm-forwarded-headers-plain + '("From:" "To:" "Newsgroups:" "Cc:" "Subject:" "Date:" "In-Reply-To:") + "*List of headers that should be forwarded by `vm-forward-message-plain'. +The headers should be listed in the order you wish them to appear in the +forwarded message. Regular expressions are allowed. There's no need to +anchor patterns with \"^\", as searches always start at the beginning of a +line. Put a colon at the end of patterns to get exact matches. (E.g., +\"Date\" matches \"Date\" and \"Date-Sent\".) Header names are always +matched case-insensitively. + +If the value of `vm-unforwarded-header-regexp-plain' is nil, the headers +matched by `vm-forwarded-headers' are the only headers that will be +forwarded. + +If `vm-unforwarded-header-regexp-plain' is non-nil, then the headers +matched by that variable will be omitted and all the others will be +forwarded. In this case, `vm-forwarded-headers-plain' determines the +forwarding order in that case, with headers not matching any in the +`vm-forwarded-headers-plain' list appearing last in the header section +of the forwarded message." + :group 'vm-compose + :type '(repeat regexp)) + +(defcustom vm-unforwarded-header-regexp-plain nil + "*Non-nil value should be a regular expression that tells what +headers should not be forwarded by `vm-forward-message-plain'. This +variable along with `vm-forwarded-headers-plain' determines which headers +are forwarded. + +If the value of `vm-unforwarded-header-regexp-plain' is nil, the +headers matched by `vm-forwarded-headers-plain' are the only +headers that will be forwarded. + +If `vm-unforwarded-header-regexp-plain' is non-nil, then only the +headers matched by this variable will be omitted; all the others +will be forwarded. `vm-forwarded-headers-plain' determines the +forwarding order in that case, with headers not matching any in +the `vm-forwarded-headers-plain' list appearing last in the +header section of the forwarded message." + :group 'vm-compose + :type '(choice + (const :tag "Only forward headers listed in vm-forward-headers-plain" nil) + (const :tag "Forward all headers" "none-to-be-dropped") + regexp)) + +(defconst vm-forwarded-mime-headers '("MIME" "Content") + "List of MIME headers that are always included in messages forwarded with +encapsulation.") + +(defcustom vm-forwarding-digest-type "mime" + "*Non-nil value should be a string that specifies the type of +message encapsulation format to use when forwarding messages. +Legal values of this variable are: + +\"mime\" +\"rfc934\" +\"rfc1153\" +nil + +A nil value means to use plain text forwarding." + :group 'vm-compose + :type '(choice + (const "mime") + (const "rfc934") + (const "rfc1153") + (const nil :tag "Forward in plain text"))) + +(defcustom vm-mime-forward-local-external-bodies nil + "*Non-nil value means forward messages that contain +message/external-body parts that use the `local-file' access +method. A nil value means copy the externally referenced objects +into the message before forwarding. This copying is only done +for objects accessed with the `local-file' access method. Objects +referenced with other methods are not copied. + +Messages that use the mesage/external-body type contain a +reference to an object (image, audio, etc.) instead of the object +itself. So instead of the data that makes up an image, there +might be a reference to a local file that contains the image. If +the recipient doesn't have access to your local filesystems then +they will not be able to use the message/external-body reference. +That is why the default value of this variable is nil, which +forces such referneces to be converted to objects present in the +message itself." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-burst-digest-messages-inherit-labels t + "*Non-nil values means messages from a digest inherit the digest's labels. +Labels are added to messages with `vm-add-message-labels', normally +bound to `l a'." + :group 'vm-digest + :type 'boolean) + +(defcustom vm-digest-preamble-format "\"%s\" (%F)" + "*String which specifies the format of the preamble lines generated by +`vm-send-digest' when it is invoked with a prefix argument. One +line will be generated for each message put into the digest. See the +documentation for the variable `vm-summary-format' for information +on what this string may contain. The format should *not* end +with nor contain a newline." + :group 'vm-digest + :type 'string) + +(defcustom vm-digest-center-preamble t + "*Non-nil value means VM will center the preamble lines that precede +the start of a digest. How the lines will be centered depends on the +ambient value of fill-column. A nil value suppresses centering." + :group 'vm-digest + :type 'boolean) + +(defcustom vm-digest-identifier-header-format "X-Digest: %s\n" + "*Header to insert into messages burst from a digest. +Value should be a format string of the same type as `vm-summary-format' +that describes a header to be inserted into each message burst from a +digest. The format string must end with a newline." + :group 'vm-digest + :type 'string) + +(defcustom vm-digest-burst-type "guess" + "*Value specifies the default digest type offered by `vm-burst-digest' +when it asks you what type of digest you want to unpack. Allowed +values of this variable are: + + \"rfc934\" + \"rfc1153\" + \"mime\" + \"guess\" + +rfc1153 digests have a preamble, followed by a line of exactly 70 +dashes, with digested messages separated by lines of exactly 30 dashes. + +rfc934 digests separate messages on any line that begins with a few +dashes, but doesn't require lines with only dashes or lines with a +specific number of dashes. In the text of the message, any line +beginning with dashes is textually modified to be preceded by a dash +and a space to prevent confusion with message separators. + +MIME digests use whatever boundary that is specified by the +boundary parameter in the Content-Type header of the digest. + +If the value is \"guess\", and you take the default +response when `vm-burst-digest' queries you, VM will try to guess +the digest type." + :group 'vm-digest + :type '(choice (const "rfc934") + (const "rfc1153") + (const "mime") + (const "guess"))) + +(defcustom vm-digest-send-type "mime" + "*String that specifies the type of digest `vm-send-digest' will use. +Legal values of this variable are: + +\"rfc934\" +\"rfc1153\" +\"mime\" +nil + +A nil value means to use plain text digests." + :group 'vm-digest + :type '(choice (const "mime") + (const "rfc934") + (const "rfc1153") + (const nil "Plain text digests"))) + +(defcustom vm-rfc934-digest-headers + '("Resent-" + "From:" "Sender:" + "To:" "Newsgroups:" "Cc:" + "Subject:" + "Date:" + "Message-ID:" + "Keywords:") + "*List of headers that should be appear in RFC 934 digests +created by VM. These should be listed in the order you wish them +to appear in the digest. Regular expressions are allowed. +There's no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched case +insensitively. + +If the value of `vm-rfc934-digest-discard-header-regexp' is nil, the headers +matched by `vm-rfc934-digest-headers' are the only headers that will be +kept. + +If `vm-rfc934-digest-discard-header-regexp' is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. `vm-rfc934-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-rfc934-digest-headers' list appearing last in the headers +of the digestified messages." + :group 'vm-digest + :type '(repeat regexp)) + +(defcustom vm-rfc934-digest-discard-header-regexp nil + "*Non-nil value should be a regular expression that tells +what headers should not appear in RFC 934 digests created by VM. This +variable along with `vm-rfc934-digest-headers' determines which headers +are kept and which are discarded. + +If the value of `vm-rfc934-digest-discard-header-regexp' is nil, the headers +matched by `vm-rfc934-digest-headers' are the only headers that will be +kept. + +If `vm-rfc934-digest-discard-header-regexp' is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. `vm-rfc934-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-rfc934-digest-headers' list appearing last in the headers +of the digestified messages." + :group 'vm-digest + :type '(choice (const nil) + regexp)) + +(defcustom vm-rfc1153-digest-headers + '("Resent-" + "Date:" + "From:" "Sender:" + "To:" "Newsgroups:" "Cc:" + "Subject:" + "Message-ID:" + "Keywords:") + "*List of headers that should be appear in RFC 1153 digests +created by VM. These should be listed in the order you wish them +to appear in the digest. Regular expressions are allowed. +There is no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched case +insensitively. + +If the value of `vm-rfc1153-digest-discard-header-regexp' is nil, the headers +matched by `vm-rfc1153-digest-headers' are the only headers that will be +kept. + +If `vm-rfc1153-digest-discard-header-regexp' is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. `vm-rfc1153-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-rfc1153-digest-headers' list appearing last in the headers of +the digestified messages." + :group 'vm-digest + :type '(repeat regexp)) + +(defcustom vm-rfc1153-digest-discard-header-regexp "\\(X400-\\)?Received:" + "*Non-nil value should be a regular expression that tells +what headers should not appear in RFC 1153 digests created by VM. This +variable along with `vm-rfc1153-digest-headers' determines which headers +are kept and which headers are discarded. + +If the value of `vm-rfc1153-digest-discard-header-regexp' is nil, the headers +matched by `vm-rfc1153-digest-headers' are the only headers that will be +kept. + +If `vm-rfc1153-digest-discard-header-regexp' is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. `vm-rfc1153-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-rfc1153-digest-headers' list appearing last in the headers of +the digestified messages." + :group 'vm-digest + :type '(choice (const nil) + regexp)) + +(defcustom vm-mime-digest-headers + '("Resent-" + "From:" "Sender:" + "To:" "Newsgroups:" "Cc:" + "Subject:" + "Date:" + "Message-ID:" + "Keywords:" + "MIME-Version:" + "Content-") + "*List of headers that should be appear in MIME digests +created by VM. These should be listed in the order you wish them +to appear in the messages in the digest. Regular expressions are +allowed. There's no need to anchor patterns with \"^\", as +searches always start at the beginning of a line. Put a colon at +the end of patterns to get exact matches. (E.g. \"Date\" matches +\"Date\" and \"Date-Sent\".) Header names are always matched +case insensitively. + +If the value of `vm-mime-digest-discard-header-regexp' is nil, the headers +matched by `vm-mime-digest-headers' are the only headers that will be +kept. + +If `vm-mime-digest-discard-header-regexp' is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. `vm-mime-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-mime-digest-headers' list appearing last in the headers +of the digestified messages." + :group 'vm-digest + :type '(repeat regexp)) + +(defcustom vm-mime-digest-discard-header-regexp nil + "*Non-nil value should be a regular expression that tells +which headers should not appear in MIME digests created +by VM. This variable along with `vm-mime-digest-headers' +determines which headers are kept and which are discarded. + +If the value of `vm-mime-digest-discard-header-regexp' is nil, the headers +matched by `vm-mime-digest-headers' are the only headers that will be +kept. + +If `vm-mime-digest-discard-header-regexp' is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. `vm-mime-digest-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-mime-digest-headers' list appearing last in the headers +of the digestified messages." + :group 'vm-digest + :type '(choice (const nil) + regexp)) + +(defcustom vm-resend-bounced-headers + '("MIME-Version:" "Content-" + "From:" "Sender:" "Reply-To:" + "To:" "Newsgroups:" "Cc:" + "Subject:" + "Newsgroups:" + "In-Reply-To:" "References:" + "Keywords:" + "X-") + "*List of headers that should be appear in messages resent with +`vm-resend-bounced-message'. These should be listed in the order you wish them +to appear in the message. Regular expressions are allowed. +There is no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched case +insensitively. + +If the value of `vm-resend-bounced-discard-header-regexp' is nil, the headers +matched by `vm-resend-bounced-headers' are the only headers that will be +kept. + +If `vm-resend-bounced-discard-header-regexp' is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. `vm-resend-bounced-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-resend-bounced-headers' list appearing last in the headers of +the message." + :group 'vm-compose + :type '(repeat regexp)) + +(defcustom vm-resend-bounced-discard-header-regexp nil + "*Non-nil value should be a regular expression that tells +what headers should not appear in a resent bounced message. This +variable along with `vm-resend-bounced-headers' determines which headers +are kept and which headers are discarded. + +If the value of `vm-resend-bounced-discard-header-regexp' is nil, +the headers matched by `vm-resend-bounced-headers' are the only +headers that will be kept. + +If `vm-resend-bounced-discard-header-regexp' is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. `vm-resend-bounced-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-resend-bounced-headers' list appearing last in the headers of +the message." + :group 'vm-compose + :type '(choice (const nil) + regexp)) + +(defcustom vm-resend-headers nil + "*List of headers that should be appear in messages resent with +`vm-resend-message'. These should be listed in the order you wish them +to appear in the message. Regular expressions are allowed. +There is no need to anchor patterns with \"^\", as searches always +start at the beginning of a line. Put a colon at the end of +patterns to get exact matches. (E.g. \"Date\" matches \"Date\" +and \"Date-Sent\".) Header names are always matched case +insensitively. + +If the value of `vm-resend-discard-header-regexp' is nil, the headers +matched by `vm-resend-headers' are the only headers that will be +kept. + +If `vm-resend-discard-header-regexp' is non-nil, then only +headers matched by that variable will be discarded; all others +will be kept. `vm-resend-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-resend-headers' list appearing last in the headers of +the message." + :group 'vm-compose + :type '(choice (const nil) + repeat regexp)) + +(defcustom vm-resend-discard-header-regexp "\\(\\(X400-\\)?Received:\\|Resent-\\)" + "*Non-nil value should be a regular expression that tells +what headers should not appear in a resent message. This +variable along with `vm-resend-headers' determines which +headers are kept and which headers are discarded. + +If the value of `vm-resend-discard-header-regexp' is nil, +the headers matched by `vm-resend-headers' are the only +headers that will be kept. + +If `vm-resend-discard-header-regexp' is non-nil, then only +headers matched by this variable will be discarded; all others +will be kept. `vm-resend-headers' determines the order of +appearance in that case, with headers not matching any in the +`vm-resend-headers' list appearing last in the headers of +the message." + :group 'vm-compose + :type '(choice (const nil) + regexp)) + +(defcustom vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c %I\"%s\"\n" + "*String which specifies the message summary line format. +The string may contain the printf-like `%' conversion specifiers which +substitute information about the message into the final summary line. + +Recognized specifiers are: + p - indicator for postponed messages + P - indicator for attachments, see `vm-summary-attachment-indicator' + a - attribute indicators (always four characters wide) + The first char is `D', `N', `U', ` ' or `!' for deleted, new, unread, + read and flagged messages respectively. + The second char is `F', `W' or ` ' for filed (saved) or written + messages. + The third char is `R', `Z' or ` ' for messages replied to, + and forwarded messages. + The fourth char is `E' if the message has been edited, ` ' otherwise. + A - longer version of attributes indicators (seven characters wide) + The first char is `D', `N', `U', ` ' or `!' for deleted, new, unread + read and flagged messages respectively. + The second is `r' or ` ', for message replied to. + The third is `z' or ` ', for messages forwarded. + The fourth is `b' or ` ', for messages redistributed. + The fifth is `f' or ` ', for messages filed. + The sixth is `w' or ` ', for messages written. + The seventh is `e' or ` ', for messages that have been edited. + b - shorter version of attribute indicators (1 character wide) + The first char is `D', `N', `U', ` ' or `!' for deleted, new, unread + read and flagged messages respectively. + c - number of characters in message (ignoring headers) + S - human readable size of the message + d - numeric day of month message sent + f - author's address + F - author's full name (same as f if full name not found) + h - hour:min:sec message sent + H - hour:min message sent + i - message ID + I - thread indentation + l - number of lines in message (ignoring headers) + L - labels (as a comma list) + m - month message sent + M - numeric month message sent (January = 1) + n - message number + s - message subject + t - addresses of the recipients of the message, in a comma-separated list + T - full names of the recipients of the message, in a comma-separated list + If a full name cannot be found, the corresponding address is used + instead. + U - user defined specifier. The next character in the format + string should be a letter. VM will call the function + vm-summary-function-<letter> (e.g. vm-summary-function-A for + \"%UA\") in the folder buffer with the message being summarized + bracketed by (point-min) and (point-max). The function + will be passed a message struct as an argument. + The function should return a string, which VM will insert into + the summary as it would for information from any other summary + specifier. + w - day of the week message sent + y - year message sent + z - timezone of date when the message was sent + * - `*' if the message is marked, ` ' otherwise + ( - starts a group, terminated by %). Useful for specifying + the field width and precision for the concatentation of + group of format specifiers. Example: \"%.35(%I%s%)\" + specifies a maximum display width of 35 characters for the + concatenation of the thread indentation and the subject. + ) - ends a group. + +Use %% to get a single %. + +A numeric field width may be given between the `%' and the specifier; +this causes right justification of the substituted string. A negative field +width causes left justification. + +The field width may be followed by a `.' and a number specifying +the maximum allowed length of the substituted string. If the +string is longer than this value the right end of the string is +truncated. If the value is negative, the string is truncated on +the left instead of the right. + +The summary format need not be one line per message but it must end with +a newline, otherwise the message pointer will not be displayed correctly +in the summary window." + :group 'vm-summary + :type 'string) + +(defcustom vm-restore-saved-summary-formats nil + "*If t, the summary format is stored in each folder and restored +after visiting it again." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-postponed-indicator "P" + "*Indicator shown for postponed messages." + :group 'vm-summary + :type 'string) + +(defcustom vm-summary-attachment-indicator "$" + "*Indicator shown for messages containing an attachments." + :group 'vm-summary + :type '(choice (string :tag "A string to display" "$") + (symbol :tag "Number of attachments prefixed by" ?$))) + +(defcustom vm-summary-attachment-mime-types nil + "*List of MIME types which should be listed as attachment. +Mime parts with a disposition of attachment or a filename/name disposition +parameter will be automatically considered as attachment." + :group 'vm-summary + :type '(repeat (string :tag "MIME type" nil))) + +(defcustom vm-summary-attachment-mime-type-exceptions nil + "*List of MIME types which should not be listed as attachment." + :group 'vm-summary + :type '(repeat (string :tag "MIME type" nil))) + +(defcustom vm-summary-arrow "->" + "*String that is displayed to the left of the summary of the +message VM consider to be the current message. The value takes +effect when the summary buffer is created. Changing this +variable's value has no effect on existing summary buffers." + :group 'vm-summary + :type 'string) + +(defface vm-summary-highlight '((t (:inherit bold))) + "Default face to use to highlight the summary entry for the current message." + :group 'vm-faces) +;; (copy-face 'bold 'vm-summary-highlight) + +(defcustom vm-summary-highlight-face 'vm-summary-highlight + "*Face to use to highlight the summary entry for the current message. +Nil means don't highlight the current message's summary entry." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-mouse-track-summary t + "*Non-nil value means highlight summary lines as the mouse passes +over them." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-show-threads nil + "*Non-nil value means VM should display and maintain +message thread trees in the summary buffer. This means that +messages with a common ancestor will be displayed contiguously in +the summary. (If you have `vm-move-messages-physically' set +non-nil the folder itself will be reordered to match the thread +ordering.) If you use the `%I' summary format specifier in your +`vm-summary-format', indentation will be provided as described in the +documentation for `vm-summary-thread-indent-level' (which see). + +A nil value means don't display thread information. The `%I' +specifier does nothing in the summary format. + +This variable automatically becomes buffer-local when set in any +fashion. You should set this variable only in your .vm or .emacs +file. Use setq-default. Once VM has been started, you should not +set this variable directly, rather you should use the command +`vm-toggle-threads-display', normally bound to C-t." + :group 'vm-summary + :type 'boolean) +(make-variable-buffer-local 'vm-summary-show-threads) + +(defcustom vm-summary-thread-indentation-by-references t + "*If non-nil, threaded messages are indented according to their +nesting level determined by their references headers. This is +likely to be their original nesting level in the discussion. If +it is nil, then the indentation level is determined by the number +of thread ancestors within the folder. When some messages in the +thread are missing or deleted, this is likely to be less than the +original nesting level." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-thread-indent-level 2 + "*Value should be a number that specifies how much +indentation the '%I' summary format specifier should provide per +thread level. A message's `thread level' refers to the number of +direct ancestors from the message to the oldest ancestor the +message has that is in the current folder. For example, the +first message of a thread is generally a message about a new +topic, e.g. a message that is not a reply to some other message. +Therefore it has no ancestor and would cause %I to generate no +indentation. A reply to this message will be indented by the value +of `vm-summary-thread-indent-level'. A reply to that reply will be +indented twice the value of `vm-summary-thread-indent-level'." + :group 'vm-summary + :type 'integer) + +(defcustom vm-summary-maximum-thread-indentation 20 + "*The maximum number of thread nesting levels that should be +displayed by indentation in the folder summary." + :group 'vm-summary + :type 'integer) + +(defcustom vm-thread-using-subject t + "*Non-nil value causes VM to use the Subject header to thread messages. +Messages with the same subject will be grouped together. + +A nil value means VM will disregard the Subject header when +threading messages." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-sort-subthreads t +"*Non-nil values causes VM to sort threads as well as their subthreads +by chosen sorting criteria. Nil value causes it to sort all the +messages in a thread without grouping them into subthreads. This +might be useful for very long threads." + :group 'vm-summary + :type 'boolean) + +;; This variable is not used any more because threads can be sorted by +;; "activity". USR, 2011-02-09. +;; (defcustom vm-sort-threads-by-youngest-date t +;; "*Non-nil values causes VM to sort threads by their youngest date, +;; i.e., a thread A will appear before B if the youngest message in the +;; thread A is dated before the youngest message in the thread B. If the +;; variable is nil, threads are sorted by their oldest date." +;; :group 'vm-summary +;; :type 'boolean) +(make-obsolete 'vm-sort-threads-by-youngest-date + 'vm-sort-messages "8.2.0") + +(defcustom vm-summary-uninteresting-senders nil + "*Non-nil value should be a regular expression that matches +addresses that you don't consider interesting enough to +appear in the summary. When such senders would be displayed by +the %F or %f summary format specifiers VM will substitute the +value of `vm-summary-uninteresting-senders-arrow' (default \"To: +\") followed by what would be shown by the %T and %t specifiers +respectively." + :group 'vm-summary + :type '(choice (const nil) regexp)) + +(defcustom vm-summary-uninteresting-senders-arrow "To: " + "*String to display before the string that is displayed instead of an +\"uninteresting\" sender. See `vm-summary-uninteresting-senders'." + :group 'vm-summary + :type 'string) + +(defcustom vm-auto-center-summary nil + "*Value controls whether VM will keep the summary arrow vertically +centered within the summary window. A value of t causes VM to always +keep arrow centered. A value of nil means VM will never bother centering +the arrow. A value that is not nil and not t causes VM to center the +arrow only if the summary window is not the only existing window." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Always" t) + (const :tag "Yes, if not only window" yes-if-not-only-window))) + +(defcustom vm-verbosity 8 + "*Level of chattiness in progress messages displayed in the +minibuffer. Indicative levels are: + 1 - extremely quiet + 5 - normally level + 7 - detailed level + 10 - debugging information" + :group 'vm-misc + :type 'integer) + +;; These flags and variables are for debugging purposes + +(defvar vm-debug nil + "*Flag used by developers to control localized debugging features.") + +(defvar vm-virtual-debug nil + "*Flag used by developers to control localized debugging of virtual folders.") + +(defvar vm-traced-message-ids nil + "*List of message ID's whose activity is debugged. This is for +developers' use only.") + +(defvar vm-traced-message-subjects nil + "*List of message subjectss whose activity is debugged. This is for +developers' use only.") + +(defvar vm-summary-debug nil + "*Flag used by developers for tracing summary generation") + +(defvar vm-summary-traced-messages nil + "*List of message numbers whose activity is debugged during +summary generation. This is for developers' use only.") + +(defvar vm-thread-debug nil + "*Flag that enables the integrity checking of threads. This is for +developers' use only.") + +(defcustom vm-subject-ignored-prefix "^\\(re: *\\)+" + "*Non-nil value should be a regular expression that matches +strings at the beginning of the Subject header that you want VM to ignore +when threading, sorting, marking, and killing messages by subject. + +Matches are done case-insensitively." + :group 'vm-summary + :type 'regexp) + +(defcustom vm-subject-ignored-suffix "\\( (fwd)\\| \\)+$" + "*Non-nil value should be a regular expression that matches +strings at the end of the Subject header that you want VM to ignore +when threading, sorting, marking and killing messages by subject. + +Matches are done case-insensitively." + :group 'vm-summary + :type 'regexp) + +(defcustom vm-subject-significant-chars nil + "*Number of characters in the normalized message subject considered +significant in message threading and sorting. The normalized +subject is the contents of the Subject header after ignored +prefixes and suffixes have been removed and after consecutive +whitespace has been collapsed into single spaces. The first +`vm-subject-significant-chars' will be considered significant. +Characters beyond this point in the subject string will be +ignored. + +A nil value for this variable means all characters in the message +subject are significant." + :group 'vm-summary + :type '(choice (const :tag "All Characters" nil) + (integer :tag "Number of characters"))) + +(defcustom vm-folders-summary-database "~/.vm.folders.db" + "*Name of Berkeley DB file used to store summary information about folders. +This file is consulted to produce the folders summary." + :group 'vm-summary + :type 'file) + +(defcustom vm-folders-summary-format + " %12f %4t total, %n new, %u unread, %s spooled\n" + "*String that specifies the folders summary format. +The string may contain the printf-like `%' conversion specifiers which +substitute information about the folder into the final summary line. + +Recognized specifiers are: + d - the number of deleted messages in the folder + f - the name of the folder without the directory part + n - the number of new messages in the folder + t - the total number of messages in the folder + u - the number of old but still unread messages in the folder + ( - starts a group, terminated by %). Useful for specifying + the field width and precision for the concatentation of + group of format specifiers. Example: \"%.35(%d, %t, %f%)\" + specifies a maximum display width of 35 characters for the + concatenation of the content description, content type and + suggested file name. + ) - ends a group. + +Use %% to get a single %. + +A numeric field width may be given between the `%' and the specifier; +this causes right justification of the substituted string. A negative field +width causes left justification. + +The field width may be followed by a `.' and a number specifying +the maximum allowed length of the substituted string. If the +string is longer than this value the right end of the string is +truncated. If the value is negative, the string is truncated on +the left instead of the right. + +The summary format need not be one line per folder, but it should end with +a newline." + :group 'vm-summary + :type 'string) + +(defcustom vm-folders-summary-directories + (list (or vm-folder-directory (file-name-directory vm-primary-inbox))) + "*List of directories containing folders to be listed in the folders summary. +List the directories in the order you wish them to appear in the summary." + :group 'vm-summary + :type '(repeat directory)) + +(defcustom vm-mutable-window-configuration pop-up-windows + "*This variable's value controls VM's window usage. + +A non-nil value gives VM free run of the Emacs display; it will commandeer +the entire screen for its purposes. + +A value of nil restricts VM's window usage to the window from which +it was invoked. VM will not create, delete, or use any other windows, +nor will it resize its own window." + :group 'vm-frames + :type 'boolean) +(defvaralias 'vm-mutable-windows + 'vm-mutable-window-configuration) + +(defcustom vm-mutable-frame-configuration t + "*Non-nil value means VM is allowed to create and destroy frames +to display and undisplay buffers. Whether VM actually does +so depends on the value of the variables with names prefixed by +``vm-frame-per-''. + +VM can create a frame to display a buffer, and delete frame to +undisplay a buffer. A nil value means VM should not create or +delete frames. + +This variable does not apply to the VM commands whose +names end in -other-frame, which always create a new frame." + :group 'vm-frames + :type 'boolean) +(defvaralias 'vm-mutable-frames + 'vm-mutable-frame-configuration) + +(defcustom vm-raise-frame-at-startup t + "*Specifies whether VM should raise its frame at startup. +A value of nil means never raise the frame. +A value of t means always raise the frame. +Other values are reserved for future use." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-folder t + "*Non-nil value causes the folder visiting commands to visit in a new frame. +Nil means the commands will use the current frame. This variable +does not apply to the VM commands whose names end in +-other-frame, which always create a new frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs supports multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-summary nil + "*Non-nil value causes VM to display the folder summary in its own frame. +Nil means the `vm-summarize' command will use the current frame. +This variable does not apply to `vm-summarize-other-frame', which +always create a new frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs supports multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-folders-summary nil + "*Non-nil value causes VM to display the 'all folders' summary in its own frame. +Nil means the `vm-folders-summarize' command will use the current frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs supports multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-composition t + "*Non-nil value causes the mail composition commands to open a new frame. +Nil means the commands will use the current frame. This variable +does not apply to the VM commands whose names end in +-other-frame, which always create a new frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs supports multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-edit t + "*Non-nil value causes `vm-edit-message' to open a new frame. +Nil means the `vm-edit-message' will use the current frame. This +variable does not apply to `vm-edit-message-other-frame', which +always create a new frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs support multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-help nil + "*Non-nil value causes VM to open a new frame to display help buffers. +Nil means the VM will use the current frame. + +This variable has no meaning if you're not running under an Emacs +capable of displaying multiple real or virtual frames. Note that +Emacs supports multiple virtual frames on dumb terminals, and +VM will use them." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-per-completion t + "*Non-nil value causes VM to open a new frame on mouse +initiated completing reads. A mouse initiated completing read +occurs when you invoke a VM command using the mouse, either with a +menu or a toolbar button. That command must then prompt you for +information, and there must be a limited set of valid responses. + +If these conditions are met and `vm-frame-per-completion''s value +is non-nil, VM will create a new frame containing a list of +responses that you can select with the mouse. + +A nil value means the current frame will be used to display the +list of choices. + +This variable has no meaning if you're not running Emacs native +under X Windows or some other window system that allows multiple +real Emacs frames. Note that Emacs supports virtual frames under +ttys but VM will not use these to display completion information." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-frame-parameter-alist nil + "*Non-nil value is an alist of types and lists of frame parameters. +This list tells VM what frame parameters to associate with each +new frame it creates of a specific type. + +The alist should be of this form + + ((SYMBOL PARAMLIST) (SYMBOL2 PARAMLIST2) ...) + +SYMBOL must be one of ``completion'', ``composition'', ``edit'', +``folder'', ``primary-folder'' or ``summary''. It specifies the type +of frame that the following PARAMLIST applies to. + +``completion'' specifies parameters for frames that display lists of + choices generated by a mouse-initiated completing read. + (See `vm-frame-per-completion'.) +``composition'' specifies parameters for mail composition frames. +``edit'' specifies parameters for message edit frames + (e.g. created by `vm-edit-message-other-frame') +``folder'' specifies parameters for frames created by `vm' and the + ``vm-visit-'' commands. +``folders-summary'' specifies parameters for frames created by the + ``vm-folder-summarize'' command. +``primary-folder'' specifies parameters for the frame created by running + `vm' without any arguments. +``summary'' specifies parameters for frames that display a summary buffer + (e.g. created by `vm-summarize-other-frame') + +PARAMLIST is a list of pairs as described in the documentation for +the function `make-frame'." + :group 'vm-frames + :type '(repeat (cons (choice (const completion) + (const composition) + (const edit) + (const folder) + (const folders-summary) + (const primary-folder) + (const summary)) + (repeat (cons symbol sexp))))) + +(defcustom vm-search-other-frames t + "*Non-nil means VM should search frames other than the selected frame +when looking for a window that is already displaying a buffer that +VM wants to display or undisplay." + :group 'vm-frames + :type 'boolean) + +(defvar vm-configure-datadir nil + "A directory VM will search for data files. + +It will be set at build time and should not be used by the user.") + +(defvar vm-configure-pixmapdir nil + "A directory VM will search for pixmaps. + +It will be set at build time and should not be used by the user.") + +(defvar vm-configure-docdir nil + "A directory VM will search for documentation files. + +It will be set at build time and should not be used by the user.") + +(defvar vm-configure-infodir nil + "A directory VM will search for info files. + +It will be set at build time and should not be used by the user.") + +(defun vm-pixmap-directory () + "Return the directory where the pixmaps are. + +We look for the file followup-dn.xpm in order not to pickup the pixmaps of an +older VM installation." + (let* ((vm-dir (file-name-directory (locate-library "vm"))) + (image-dirs (list (and vm-configure-pixmapdir + (expand-file-name vm-configure-pixmapdir)) + (and vm-configure-datadir + (expand-file-name vm-configure-datadir)) + (expand-file-name "pixmaps" vm-dir) + (expand-file-name "../pixmaps" vm-dir) + (let ((d (and vm-xemacs-p + (xemacs-locate-data-directory "vm")))) + (and d (expand-file-name "pixmaps" d))))) + image-dir) + (while image-dirs + (setq image-dir (car image-dirs)) + (if (and image-dir + (file-exists-p (expand-file-name "visit-up.xpm" image-dir))) + (setq image-dirs nil) + (setq image-dirs (cdr image-dirs)))) + image-dir)) + +(defcustom vm-image-directory nil + "*The directory where VM finds the pixmaps for mime objects." + :group 'vm-misc + :type '(choice directory (const :tag "Automatic" nil))) + +(defun vm-image-directory () + "Return the directory where the images for mime objects are." + (or vm-image-directory + (expand-file-name "mime" (vm-pixmap-directory)))) + +(defcustom vm-use-toolbar + '(getmail + next previous delete/undelete autofile file + reply followup forward compose print visit quit help) + "*Non-nil value causes VM to provide a toolbar interface. +Value should be a list of symbols and integers that will determine which +toolbar buttons will appear and in what order. + +If nil appears in the list, it should appear exactly once. All +buttons after nil in the list will be displayed flushright in +top/bottom toolbars and flushbottom in left/right toolbars. + +If a positive integer N appears in the list, a blank space will +appear in the toolbar with a width of N pixels for top/bottom +toolbars, and a height of N for left/right toolbars. + +See also `vm-toolbar-orientation' to control where the toolbar is placed." + :group 'vm-toolbar + :type '(repeat (choice integer + (const autofile) + (const compose) + (const delete/undelete) + (const file) + (const getmail) + (const help) + (const mime) + (const next) + (const previous) + (const print) + (const quit) + (const reply) + (const followup) + (const forward) + (const visit) + (const nil)))) + +(defcustom vm-toolbar-orientation 'top + "*Value is a symbol that specifies where the VM toolbar is located. +Legal values are `left', `right' `top' and `bottom'. Any other +value will be interpreted as `top'. + +This variable only has meaning under XEmacs. +Under FSF Emacs 21 the toolbar is always at the top of the frame." + :group 'vm-toolbar + :type '(choice (const left) + (const right) + (const top) + (const bottom))) + +(defcustom vm-toolbar-pixmap-directory nil + "*The directory VM should find its toolbar pixmaps." + :group 'vm-toolbar + :type '(choice directory (const :tag "Automatic" nil))) + +(defvar vm-gtk-emacs-p (or (featurep 'gtk) + (string-match "'--with-gtk'" + system-configuration-options) + (and (boundp 'device-type) + (eq (device-type) 'gtk))) + "True when running in a GTK enabled Emacs.") + +(defun vm-toolbar-pixmap-directory () + "Return the directory where the toolbar pixmaps are." + (or vm-toolbar-pixmap-directory + (if vm-gtk-emacs-p + (concat (vm-pixmap-directory) "/gtk") + (vm-pixmap-directory)))) + +(defcustom vm-toolbar nil + "*Non-nil value should be a list of toolbar button descriptors. +See the documentation for the variable default-toolbar for a +definition of what a toolbar button descriptor is. + +If `vm-toolbar' is set non-nil VM will use its value as a toolbar +instantiator instead of the usual behavior of building a button +list based on the value of `vm-use-toolbar'. `vm-use-toolbar' still +must be set non-nil for a toolbar to appear, however. + +Consider this variable experimental; it may not be supported forever." + :group 'vm-toolbar + :type 'sexp) + +(defcustom vm-use-menus + (nconc (list 'folder 'motion 'send 'mark 'label 'sort 'virtual) + (list 'undo) + (list 'dispose) + (list 'emacs) + (list nil 'help)) + "*Non-nil value causes VM to provide a menu interface. +A value that is a list causes VM to install its own menubar. +A value of 1 causes VM to install a \"VM\" item in the Emacs menubar. + +If the value of `vm-use-menus' is a list, it should be a list of +symbols. The symbols and the order in which they are listed +determine which menus will be in the menubar and how they are +ordered. Valid symbol values are: + + dispose + emacs + folder + help + label + mark + motion + send + sort + undo + virtual + nil + +If nil appears in the list, it should appear exactly once. All +menus after nil in the list will be displayed flushright in +menubar. + +This variable only has meaning in Emacs environments where menus +are provided, which usually means Emacs has to be running under a +window system." + :group 'vm-toolbar + :type '(choice (const 1) + (repeat (choice (const dispose) + (const emacs) + (const folder) + (const help) + (const label) + (const mark) + (const motion) + (const send) + (const sort) + (const undo) + (const virtual) + (const nil))))) + +(defcustom vm-use-menubar-buttons t + "*Non-nil value means that VM should use buttons on menubars, such +as [Emacs] and [VM], in environments that support such buttons." + :group 'vm-toolbar + :type 'boolean) + +(defcustom vm-popup-menu-on-mouse-3 t + "*Non-nil value means VM should provide context-sensitive menus on mouse-3. +A nil value means VM should not change the binding of mouse-3." + :group 'vm-toolbar + :type 'boolean) + +(defcustom vm-warp-mouse-to-new-frame nil + "*Non-nil value causes VM to move the mouse cursor into newly created frames. +This is useful to give the new frame the focus under some window managers +that randomly place newly created frames. + +Nil means don't move the mouse cursor." + :group 'vm-frames + :type 'boolean) + +(defcustom vm-url-retrieval-methods '(lynx wget fetch curl w3m) + "*Non-nil value specifies how VM is permitted to retrieve URLs. +VM needs to do this when supporting the message/external-body +MIME type, which provides a reference to an object instead of the +object itself. The specification should be a list of symbols +with the following meanings + + lynx - means VM should try to use the lynx program. + wget - means VM should try to use the wget program. + w3m - means VM should try to use the w3m program. + fetch - means VM should try to use the fetch program. + curl - means VM should try to use the curl program. + +The list can contain all these values and VM will try them all, +but not in any particular order, except that the url-w3 method +will likely be tried last since it is likely to be the slowest +retrieval method. + +If `vm-url-retrieval-methods' value is nil, VM will not try to +use any URL retrieval methods." + :group 'vm-url + :type '(set (const lynx) + (const wget) + (const w3m) + (const fetch) + (const curl) + (const url-w3))) + +(defcustom vm-url-browser 'browse-url + "*The default web browser to be used for following URLs (hyperlinks) +in messages. + +Clicking mouse-2 on a URL will send it to the default browser. +Moving point to a character within the URL and pressing RETURN +will also send the URL to the default browser. + +If the value of `vm-url-browser' is a string, it should specify +name of an external browser to run. The URL will be passed to +the program as its first argument after the program switches +specified by `vm-url-browser-switches', if any. + +If the value of `vm-url-browser' is a symbol, it should specify a +Lisp function to call. The URL will be passed to the function as +its first and only argument. The Emacs `browse-url' function is +an excellent choice. It is the default value of the variable. +VM also defines a number of browser functions of the form +`vm-mouse-send-url-to-xxx', where xxx is the name of a browser. +The `xxx' can be netscape, mmosaic, mosaic, opera, mozilla, +konqueror, firefox, window-system or clipboard. If it is +window-system then the URL is passed to the window system's +\"copy\" mechanism so that it can be pasted somwhere else. If it +is clipboard, the URL is sent to the X clipboard. + + +A nil value means VM should not enable URL passing to browsers." + :group 'vm-url + :type '(choice (const :tag "Disable URL parsing" nil) + (function :tag "Browser function") + (string :tag "External browser"))) + +(defcustom vm-url-browser-switches nil + "*List of command line flags passed to the command named by +`vm-url-browser'. VM uses `vm-url-browser' to display URLs +in messages when you click on them." + :group 'vm-url + :type '(repeat string)) + +(defface vm-highlight-url '((t (:inherit link))) + "Default face used to highlight URLs." + :group 'vm-faces) +;; (copy-face 'bold-italic 'vm-highlight-url) + +(defcustom vm-highlight-url-face 'vm-highlight-url + "*Non-nil value should be a face to use display URLs found in messages. +Nil means don't highlight URLs." + :group 'vm-faces + :type 'symbol) + +(defcustom vm-url-search-limit 12000 + "*Non-nil numeric value tells VM how hard to search for URLs. +The number specifies the maximum message size in characters that +VM will search for URLs. For message larger than this value, VM +will search from the beginning of the message to a point +`vm-url-search-limit' / 2 characters into the message. Then VM will +search from a point `vm-url-search-limit' / 2 characters from the +end of the message to the end of message." + :group 'vm-url + :type '(choice (const nil) integer)) + +(defcustom vm-display-xfaces nil + "*Non-nil means display images as specified in X-Face headers. +This requires XEmacs with native xface support compiled in." + :group 'vm-presentation + :type 'boolean) + +(defcustom vm-startup-with-summary t + "*Value tells VM whether to generate a summary when a folder is visited. +Nil means don't automatically generate a summary. + +A value of t means always generate a summary. + +A positive numeric value N means only generate a summary if there +are N or more messages. + +A negative numeric value -N means only generate a summary if +there are N or less messages." + :group 'vm-summary + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (integer :tag "Number of messages") )) + +(defcustom vm-follow-summary-cursor t + "*Non-nil value causes VM to select the message under the cursor in the +summary window before executing commands that operate on the current message. +This occurs only when the summary buffer window is the selected window." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-jump-to-new-messages t + "*Non-nil value causes VM to jump to the first new message +whenever such messages arrive in a folder or the first time a +folder is visited. + +See also `vm-jump-to-unread-messages'." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-jump-to-unread-messages t + "*Non-nil value causes VM to jump to the first unread message +whenever such messages arrive in a folder or the first time a +folder is visited. New messages are considered unread in this +context so new messages will be jumped to as well. + +The value of `vm-jump-to-new-messages' takes precedence over the +setting of this variable. So if there are unread messages and +new messages VM will jump to the first new message, even if an +unread message appears before it in the folder, provided +`vm-jump-to-new-messages' is non-nil." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-skip-deleted-messages t + "*Non-nil value causes VM's `n' and 'p' commands to skip over +deleted messages. A value of t causes deleted messages to always be skipped. +A value that is not nil and not t causes deleted messages to be skipped only +if there are other messages that are not flagged for deletion in the desired +direction of motion." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Skip if some undeleted" skip-if-some-undeleted))) + +(defcustom vm-skip-read-messages nil + "*Non-nil value causes VM's `n' and `p' commands to skip over +messages that have already been read, in favor of new or unread messages. +A value of t causes read messages to always be skipped. A value that is +not nil and not t causes read messages to be skipped only if there are +unread messages in the desired direction of motion." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Skip if some unread" skip-if-some-unread))) + +(defcustom vm-move-after-deleting nil + "*Non-nil value causes VM's `d' command to automatically invoke +`vm-next-message' or `vm-previous-message' after deleting, to move +past the deleted messages. A value of t means motion should +honor the value of `vm-circular-folders'. A value that is not t +and not nil means that motion should be done as if +`vm-circular-folders' is set to nil." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Skip if some undeleted" skip-if-some-undeleted))) + +(defcustom vm-move-after-undeleting nil + "*Non-nil value causes VM's `u' command to automatically invoke +`vm-next-message' or `vm-previous-message' after undeleting, to move +past the undeleted messages. A value of t means motion should +honor the value of `vm-circular-folders'. A value that is not t +and not nil means that motion should be done as if +`vm-circular-folders' is set to nil." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Skip if some undeleted" skip-if-some-undeleted))) + +(defcustom vm-move-after-killing nil + "*Non-nil value causes VM's `k' command to automatically invoke +`vm-next-message' or `vm-previous-message' after killing messages, to try +to move past the deleted messages. A value of t means motion +should honor the value of `vm-circular-folders'. A value that is +not t and not nil means that motion should be done as if +`vm-circular-folders' is set to nil." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Skip if some undeleted" skip-if-some-undeleted))) + +(defcustom vm-delete-after-saving nil + "*Non-nil value causes VM automatically to mark messages for deletion +after successfully saving them to a folder." + :group 'vm-dispose + :type 'boolean) + +(defcustom vm-delete-after-archiving nil + "*Non-nil value causes VM automatically to mark messages for deletion +after successfully auto-archiving them with the `vm-auto-archive-messages' +command." + :group 'vm-dispose + :type 'boolean) + +(defcustom vm-delete-after-bursting nil + "*Non-nil value causes VM automatically to mark a message for deletion +after it has been successfully burst by the `vm-burst-digest' command." + :group 'vm-dispose + :type 'boolean) + +(defcustom vm-circular-folders nil + "*Value determines whether VM folders will be considered circular by +various commands. `Circular' means VM will wrap from the end of the folder +to the start and vice versa when moving the message pointer, or deleting, +undeleting or saving messages before or after the current message. + +A value of t causes all VM commands to consider folders circular. + +A value of nil causes all of VM commands to signal an error if the start +or end of the folder would have to be passed to complete the command. +For movement commands, this occurs after the message pointer has been +moved as far as possible in the specified direction. For other commands, +the error occurs before any part of the command has been executed, i.e. +no deletions, saves, etc. will be done unless they can be done in their +entirety. + +A value that is not nil and not t causes only VM's movement commands to +consider folders circular. Saves, deletes and undelete commands will +behave the same as if the value is nil." + :group 'vm-summary + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "For movement commands only" for-movement-only))) + +(defcustom vm-search-using-regexps nil + "*Non-nil value causes VM's search command to interpret user input as a +regular expression instead of as a literal string." + :group 'vm-misc + :type 'boolean) + +(defcustom vm-move-messages-physically nil + "*Non-nil value causes VM's commands that change the message order +of a folder to always move the physical messages involved and not +just change the presentation order. Nil means that commands just +change the order in which VM displays messages and leave the +folder itself undisturbed." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-edit-message-mode 'text-mode + "*Major mode to use when editing messages in VM." + :group 'vm-dispose + :type 'function) + +(defvar lpr-command) +(defcustom vm-print-command (if (boundp 'lpr-command) lpr-command "lpr") + "*Command VM uses to print messages." + :group 'vm-print + :type '(choice (string :tag "Command") + (const nil))) + +(defvar lpr-switches) +(defcustom vm-print-command-switches (if (boundp 'lpr-switches) lpr-switches nil) + "*List of command line flags passed to the command named by +`vm-print-command'. VM uses `vm-print-command' to print +messages." + :group 'vm-print + :type '(repeat (const nil) + (string :tag "Switch"))) + +(defcustom vm-berkeley-mail-compatibility + (memq system-type '(berkeley-unix netbsd)) + "*Non-nil means to read and write BSD Mail(1) style Status: headers. +This makes sense if you plan to use VM to read mail archives created by +Mail." + :group 'vm-folders + :type 'boolean) + +(defcustom vm-strip-reply-headers nil + "*Non-nil value causes VM to strip away all comments and extraneous text +from the headers generated in reply messages. If you use the \"fakemail\" +program as distributed with Emacs, you probably want to set this variable +to t, because as of Emacs v18.52 \"fakemail\" could not handle unstripped +headers." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-select-new-message-hook nil + "*List of hook functions called every time a message with the 'new' +attribute is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max)." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-select-unread-message-hook nil + "*List of hook functions called every time a message with the 'unread' +attribute is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and +(point-max)." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-select-message-hook nil + "*List of hook functions called every time a message +is made to be the current message. When the hooks are run, the +current buffer will be the folder containing the message and the +start and end of the message will be bracketed by (point-min) and + (point-max)." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-showing-message-hook nil + "*List of hook functions called every time a message is showed. +When the hooks are run, the current buffer will be the folder containing the +message and the start and end of the message will be bracketed by (point-min) +and (point-max)." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-arrived-message-hook nil + "*List of hook functions called once for each message gathered from +the system mail spool, or from another folder with +`vm-get-new-mail', or from a digest with `vm-burst-digest'. When the +hooks are run, the current buffer will be the folder containing +the message and the start and end of the message will be +bracketed by (point-min) and (point-max)." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-spooled-mail-waiting-hook nil + "*List of functions called when VM first notices mail is spooled +for a folder. The folder buffer will be current when the hooks are +run." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-arrived-messages-hook nil + "*List of hook functions called after VM has gathered a group of +messages from the system mail spool, or from another folder with +`vm-get-new-mail', or from a digest with `vm-burst-digest'. When the +hooks are run, the new messages will have already been added to +the message list but may not yet appear in the summary. +Also, the current buffer will be the folder containing +the messages." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-reply-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created for a reply. VM runs this +hook and then runs `vm-mail-mode-hook' before leaving the user in +the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-forward-message-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created to forward a message. VM +runs this hook and then runs `vm-mail-mode-hook' before leaving the +user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-resend-bounced-message-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created to resend a bounced message. +VM runs this hook and then runs `vm-mail-mode-hook' before leaving +the user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-resend-message-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created to resend a message. +VM runs this hook and then runs `vm-mail-mode-hook' before leaving +the user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-send-digest-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created to send a digest. +VM runs this hook and then runs `vm-mail-mode-hook' before leaving +the user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mail-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created to send a non specialized +message, i.e. a message that is not a reply, forward, digest, +etc. VM runs this hook and then runs `vm-mail-mode-hook' before +leaving the user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-summary-update-hook nil + "*List of hook functions called just after VM updates an existing +entry a folder summary." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-summary-redo-hook nil + "*List of hook functions called just after VM adds or deletes +entries from a folder summary." + :group 'vm-hooks + :type 'hook) + +(defgroup vm-summary-faces nil + "VM additional faces for the summary buffer." + :group 'vm-faces) + +(defcustom vm-summary-faces-alist + '( + ;; Most important status info + ((deleted) vm-summary-deleted) + ((new) vm-summary-new) + ((marked) vm-summary-marked) + ((or (header "Priority: urgent") + (header "Importance: high") + (header "X-Priority: 1") + (flagged) + (label "!") + (label "\\flagged") + (header "X-VM-postponed-data:")) + vm-summary-high-priority) + ((unread) vm-summary-unread) + ;; less important status info + ((replied) vm-summary-replied) + ((or (filed) + (written)) vm-summary-saved) + ((or (forwarded) + (redistributed)) vm-summary-forwarded) + ((edited) vm-summary-edited) + ;; + ((outgoing) vm-summary-outgoing) + ((any) vm-summary-default)) + "List of condition-face pairs for deciding the faces for summary +lines. Each element of the list is a pair, i.e., a two-element list. +The first element is a virtual folder condition as described in the +documentation of `vm-virtual-folder-alist'. The second element is a +face name. + +The order matters. The first condition that matches the message will +decide the face." + :type '(repeat (cons (sexp) (face))) + :group 'vm-summary-faces) + +;;--------------------------------------------------------------------------- +;; Color coding +;; +;; Face light bgd dark bgd monochrome +;; ---- --------- -------- ---------- +;; +;; deleted grey50 grey70 dim +;; high-priority red +;; low-priority grey50 +;; marked purple magenta underlined +;; new blue cyan italic +;; unread navy magenta italic +;; saved green +;; replied grey30 +;; forwarded grey20 +;; outgoing grey30 +;; expanded +;; collapsed +;; -------------------------------------------------------------------------- + + +(defface vm-summary-selected + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:background "grey85")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:background "SlateBlue3")) + (((class color) (background light)) + (:background "grey80")) + (((class color) (background dark)) + (:background "Blue3")) + (t + (:weight bold))) + "The face used in VM Summary buffers for the selected message." + :group 'vm-summary-faces) + +(put 'vm-summary-selected-face 'face-alias 'vm-summary-selected) +(make-obsolete 'vm-summary-selected-face 'vm-summary-selected "8.2.0") + +(defface vm-summary-marked + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "Purple")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "Magenta")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "Purple")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "Magenta")) + (((class color) (background light)) ; (min-colors 8) + (:foreground "Magenta" :weight bold)) + (((class color) (background dark)) + (:foreground "Magenta" :weight bold)) + (t (:underline t))) + "The face used in VM Summary buffers for marked messages." + :group 'vm-summary-faces) + +(put 'vm-summary-marked-face 'face-alias 'vm-summary-marked) +(make-obsolete 'vm-summary-marked-face 'vm-summary-marked "8.2.0") + +(if vm-xemacs-p + (defface vm-summary-deleted + '( + (((class color) (background light)) + (:foreground "grey50" :strikethru t)) + (((class color) (background dark)) + (:foreground "grey70" :strikethru t)) + (((type tty) (class color) (background light)) + (:foreground "yellow")) + (((type tty) (class color) (background dark)) + (:foreground "yellow")) + (((class grayscale) (background light)) + (:foreground "grey50" :strikethru t)) + (((class grayscale) (background dark)) + (:foreground "grey70" :strikethru t)) + (((class mono)) + (:strikethru t)) + (((type tty)) + (:dim t)) + (t ())) + "The face used in VM Summary buffers for deleted messages." + :group 'vm-summary-faces) + (defface vm-summary-deleted + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "grey50" :strike-through "grey80")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "grey70" :strike-through "grey50")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "grey50" :strike-through "grey70")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "grey70" :strike-trhough "grey50")) + (((class color) (background light)) ; (min-colors 8) + (:foreground "yellow")) + (((class color) (background dark)) + (:foreground "yellow")) + (((class grayscale) (background light)) + (:foreground "grey50" :strike-through "grey70")) + (((class grayscale) (background dark)) + (:foreground "grey70" :strike-trhough "grey50")) + (((class mono)) + (:strike-through t)) + (((type tty)) + (:dim t)) + (t ())) + "The face used in VM Summary buffers for deleted messages." + :group 'vm-summary-faces)) + +(put 'vm-summary-deleted-face 'face-alias 'vm-summary-deleted) +(make-obsolete 'vm-summary-deleted-face 'vm-summary-deleted "8.2.0") + +(defface vm-summary-new + '( + (((class color) (background light)) + (:foreground "blue")) + (((class color) (background dark)) + (:foreground "cyan")) + (((class grayscale) (background light)) + (:foreground "DimGray" :slant italic)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :slant italic)) + (t + (:slant italic))) + "The face used in VM Summary buffers for new messages." + :group 'vm-summary-faces) + +(put 'vm-summary-new-face 'face-alias 'vm-summary-new) +(make-obsolete 'vm-summary-new-face 'vm-summary-new "8.2.0") + +(defface vm-summary-unread + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "blue3")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "LightSkyBlue")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "blue")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "magenta")) + (((class color) (background light)) ; (min-colors 8) + (:foreground "blue")) + (((class color) (background dark)) + (:foreground "magenta")) + (((class grayscale) (background light)) + (:foreground "DimGray" :slant italic)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :slant italic)) + (t + (:slant italic))) + "The face used in VM Summary buffers for unread messages." + :group 'vm-summary-faces) + +(put 'vm-summary-unread-face 'face-alias 'vm-summary-unread) +(make-obsolete 'vm-summary-unread-face 'vm-summary-unread "8.2.0") + +(defface vm-summary-saved + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "green4")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "PaleGreen")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "green")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "green")) + (((class color)) + (:foreground "green"))) + "The face used in VM Summary buffers for saved messages." + :group 'vm-summary-faces) + +(put 'vm-summary-filed-face 'face-alias 'vm-summary-saved) +(make-obsolete 'vm-summary-filed 'vm-summary-saved "8.2.0") +(put 'vm-summary-written-face 'face-alias 'vm-summary-saved) +(make-obsolete 'vm-summary-written 'vm-summary-saved "8.2.0") + +(defface vm-summary-replied + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "MediumOrchid4")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "plum1")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "Orchid")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "purple")) + (((class color)) + (:foreground "magenta")) + (t + ())) + "The face used in VM Summary buffers for replied messages." + :group 'vm-summary-faces) + +(put 'vm-summary-replied-face 'face-alias 'vm-summary-replied) +(make-obsolete 'vm-summary-replied-face 'vm-summary-replied "8.2.0") + +(defface vm-summary-forwarded + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "MediumOrchid3")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "Thistle1")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "Orchid")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "Yellow")) + (((class color)) + (:foreground "Yellow")) + (((class grayscale) (background light)) + (:foreground "LightGray")) + (((class grayscale) (background dark)) + (:foreground "DimGray")) + (t + ())) + "The face used in VM Summary buffers for forwarded messages." + :group 'vm-summary-faces) + +(put 'vm-summary-forwarded-face 'face-alias 'vm-summary-forwarded) +(make-obsolete 'vm-summary-forwarded-face 'vm-summary-forwarded "8.2.0") +(put 'vm-summary-redistributed-face 'face-alias 'vm-summary-forwarded) +(make-obsolete 'vm-summary-redistributed-face 'vm-summary-forwarded "8.2.0") + +(defface vm-summary-edited + '((t ())) + "The face used in VM Summary buffers for edited messages." + :group 'vm-summary-faces) + +(put 'vm-summary-edited-face 'face-alias 'vm-summary-edited) +(make-obsolete 'vm-summary-edited-face 'vm-summary-edited "8.2.0") + +(defface vm-summary-outgoing + '( + (((class color) (background light)) + (:foreground "grey40")) + (((class color) (background dark)) + (:foreground "grey80")) + (t + ())) + "The face used in VM Summary buffers for outgoing messages." + :group 'vm-summary-faces) + +(put 'vm-summary-outgoing-face 'face-alias 'vm-summary-outgoing) +(make-obsolete 'vm-summary-outgoing-face 'vm-summary-outgoing "8.2.0") + +(defface vm-summary-expanded + '((t ())) + "The face used in VM Summary buffers for the root messages of +expanded threads." + :group 'vm-summary-faces) + +(put 'vm-summary-expanded-face 'face-alias 'vm-summary-expanded) +(make-obsolete 'vm-summary-expanded-face 'vm-summary-expanded "8.2.0") + +(defface vm-summary-collapsed + '((t (:slant oblique))) + "The face used in VM Summary buffers for the root messages of +collapsed threads." + :group 'vm-summary-faces) + +(put 'vm-summary-collapsed-face 'face-alias 'vm-summary-collapsed) +(make-obsolete 'vm-summary-collapsed-face 'vm-summary-collapsed "8.2.0") + +(defface vm-summary-high-priority + '( + (((type x w32 mswindows mac) (class color) (background light)) + (:foreground "Red1")) + (((type x w32 mswindows mac) (class color) (background dark)) + (:foreground "LightSalmon")) + ;; (((class color) (min-colors 16) (background light)) + ;; (:foreground "Red")) + ;; (((class color) (min-colors 16) (background dark)) + ;; (:foreground "Pink")) + (((class color)) ; (min-colors 8) + (:foreground "red")) + (t + (:inverse-video t :weight bold))) + "The face used in VM Summary buffers for high-priority messages." + :group 'vm-summary-faces) + +(put 'vm-summary-high-priority-face 'face-alias 'vm-summary-high-priority) +(make-obsolete 'vm-summary-high-priority-face 'vm-summary-high-priority "8.2.0") + +(defface vm-summary-low-priority + '( + (((class color) (background light)) + (:foreground "grey50")) + (((class color) (background dark)) + (:foreground "grey70")) + (((type tty) (class color) (background light)) + (:foreground "yellow")) + (((type tty) (class color) (background dark)) + (:foreground "yellow")) + (((class grayscale) (background light)) + (:foreground "grey50")) + (((class grayscale) (background dark)) + (:foreground "grey70")) + (((class mono)) + (:strikethru t)) + (((type tty)) + (:dim t)) + (t ())) + "The face used in VM Summary buffers for low-priority messages." + :group 'vm-summary-faces) + +(defface vm-summary-default + '((t ())) + "The default face used in VM Summary buffers." + :group 'vm-summary-faces) + +(put 'vm-summary-default-face 'face-alias 'vm-summary-default) +(make-obsolete 'vm-summary-default-face 'vm-summary-default "8.2.0") + +(defcustom vm-visit-folder-hook nil + "*List of hook functions called just after VM visits a folder. +It doesn't matter if the folder buffer already exists, this hook +is run each time `vm' or `vm-visit-folder' is called interactively. +It is NOT run after `vm-mode' is called." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-retrieved-spooled-mail-hook nil + "*List of hook functions called just after VM has retrieved +a group of messages from your system mailbox(es). When these +hooks are run, the messages have been added to the folder buffer +but not the message list or summary. When the hooks are run, the +current buffer will be the folder where the messages were +incorporated." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-edit-message-hook nil + "*List of hook functions to be run just before a message is edited. +This is the last thing `vm-edit-message' does before leaving the user +in the edit buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mail-mode-hook nil + "*List of hook functions to be run after a Mail mode +composition buffer has been created. This is the last thing VM +does before leaving the user in the Mail mode buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mode-hook nil + "*List of hook functions to run when a buffer enters `vm-mode'. +These hook functions should generally be used to set key bindings +and local variables." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mode-hooks nil + "*Old name for `vm-mode-hook'. +Supported for backward compatibility. +You should use the new name." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-summary-mode-hook nil + "*List of hook functions to run when a VM summary buffer is created. +The current buffer will be that buffer when the hooks are run." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-summary-mode-hooks nil + "*Old name for `vm-summary-mode-hook'. +Supported for backward compatibility. +You should use the new name." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-folders-summary-mode-hook nil + "*List of hook functions to run when a VM folders summary buffer is created. +The current buffer will be that buffer when the hooks are run." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-virtual-mode-hook nil + "*List of hook functions to run when a VM virtual folder buffer is created. +The current buffer will be that buffer when the hooks are run." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-presentation-mode-hook nil + "*List of hook functions to run when a VM presentation buffer is created. +The current buffer will be the new presentation buffer when the hooks are run. +Presentation buffers are used to display messages when some type of decoding +must be done to the message to make it presentable. E.g. MIME decoding." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-quit-hook nil + "*List of hook functions to run when you quit VM. +This applies to any VM quit command." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-summary-pointer-update-hook nil + "*List of hook functions to run when the VM summary pointer is updated. +When the hooks are run, the current buffer will be the summary buffer." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-display-buffer-hook nil + "*List of hook functions that are run every time VM wants to +display a buffer. When the hooks are run, the current buffer will +be the buffer that VM wants to display. The hooks are expected +to select a window and VM will display the buffer in that +window. + +If you use display hooks, you should not use VM's builtin window +configuration system as the result is likely to be confusing." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-undisplay-buffer-hook nil + "*List of hook functions that are run every time VM wants to +remove a buffer from the display. When the hooks are run, the +current buffer will be the buffer that VM wants to disappear. +The hooks are expected to do the work of removing the buffer from +the display. The hook functions should not kill the buffer. + +If you use undisplay hooks, you should not use VM's builtin +window configuration system as the result is likely to be +confusing." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-iconify-frame-hook nil + "*List of hook functions that are run whenever VM iconifies a frame." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-menu-setup-hook nil + "*List of hook functions that are run just after all menus are initialized." + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mime-display-function nil + "*If non-nil, this should name a function to be called inside +`vm-decode-mime-message' to do the MIME display the current +message. The function is called with no arguments, and at the +time of the call the current buffer will be the `presentation' +buffer for the folder, which is a temporary buffer that VM uses +for the display of MIME messages. A copy of the current message +will be in the presentation buffer at that time. The normal work +that `vm-decode-mime-message' would do is not done, because this +function is expected to subsume all of it." + :group 'vm-mime + :type '(choice (const :tag "None" nil) + 'function)) + +(defcustom vm-mime-deleted-object-label "[Deleted %f (%t)]\n" + "*The label that will be inserted instead of the original mime object. +See `vm-mime-compile-format-1' for valid format specifiers." + :group 'vm-mime + :type 'string) + +(defvar vm-mime-show-alternatives nil + "*This variable is deprecated. You can set +`vm-mime-alternative-show-method' to 'all to get the same effect as +setting this one to t.") + +(make-obsolete-variable 'vm-mime-show-alternatives + 'vm-mime-alternative-show-method "8.2.0") + +(defcustom vm-emit-messages-for-mime-decoding t + "*Flag to allow minibuffer messages about the progress of MIME +decoding of messages. Only nontrivial decodings are normally +reported. So there is normally no need to change this from the default." + :group 'vm-mime + :type 'boolean) + +(defcustom vm-imap-session-preauth-hook nil + "*List of hook functions to call to generate an preauthenticated +IMAP session process. This hook is only run if the +authentication method for the IMAP mailbox is ``preauth''. Each +hook is called with five arguments: HOST, PORT, MAILBOX, USER, +PASSWORD. (See the documentation for `vm-spool-files' to find out +about these arguments.) It is the responsibility of the hook +function to create an Emacs process whose input/output streams +are connected to an authenticated IMAP session, and to return +this process. If the hook cannot accomplish this, +it should return nil. If all the hooks return nil, VM will +signal an error. + +At the time the hook is run, the current buffer will be the +buffer any created process should be associated with. (The BUFFER +argument to start-process or open-network-stream should be +(current-bfufer).)" + :group 'vm-hooks + :type 'hook) + +(defcustom vm-mail-send-hook nil + "*List of hook functions to call just before sending a message. +The hooks are run after confirming that you want to send the +message (see `vm-confirm-mail-send') but before MIME encoding and +FCC processing." + :group 'vm-hooks + :type 'hook) + +;; The following settings are disabled because they are defined in +;; mail-mode/sendmail.el. + +;; (defvar mail-yank-hooks nil +;; "Hooks called after a message is yanked into a mail composition buffer. + +;; (This hook is deprecated, you should use mail-citation-hook instead.) + +;; The value of this hook is a list of functions to be run. +;; Each hook function can find the newly yanked message between point and mark. +;; Each hook function should return with point and mark around the yanked message. + +;; See the documentation for `vm-yank-message' to see when VM will run +;; these hooks.") + +;; (defcustom mail-citation-hook nil +;; "*Hook for modifying a citation just inserted in the mail buffer. +;; Each hook function can find the citation between (point) and (mark t). +;; And each hook function should leave point and mark around the citation +;; text as modified. + +;; If this hook is entirely empty (nil), a default action is taken +;; instead of no action." +;; :group 'vm +;; :type 'hook) + +;; (defcustom mail-default-headers nil +;; "*A string containing header lines, to be inserted in outgoing messages. +;; It is inserted before you edit the message, +;; so you can edit or delete these lines." +;; :group 'vm +;; :type '(choice (const nil) string)) + +;; (defcustom mail-signature nil +;; "*Text inserted at end of mail buffer when a message is initialized. +;; If t, it means to insert the contents of the file `~/.signature'." +;; :group 'vm +;; :type '(choice (const nil) (const t) string)) + +(defconst vm-rename-current-buffer-function nil + "*Non-nil value should be a function to call to rename a buffer. +Value should be something that can be passed to `funcall'. If +this variable is non-nil, VM will use this function instead of +its own buffer renaming code. The buffer to be renamed will be +the current buffer when the function is called.") + +(defvar mode-popup-menu nil + "The mode-specific popup menu. Automatically buffer local. +By default, when you press mouse-3 in VM, this menu is popped up.") +(make-variable-buffer-local 'mode-popup-menu) + +(defcustom vm-movemail-program "movemail" + "*Name of program to use to move mail from the system spool +to another location. Normally this should be the movemail +program distributed with Emacs. If you use another program, it must +accept as its last two arguments the spool file (or maildrop) from which +mail is retrieved, and the local file where the retrieved mail +should be stored." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-movemail-program-switches nil + "*List of command line flags to pass to the movemail program +named by `vm-movemail-program'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-netscape-program "netscape" + "*Name of program to use to run Netscape. +`vm-mouse-send-url-to-netscape' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-netscape-program-switches nil + "*List of command line switches to pass to Netscape." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-opera-program "opera" + "*Name of program to use to run Opera. +`vm-mouse-send-url-to-opera' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-opera-program-switches nil + "*List of command line switches to pass to Opera." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mozilla-program nil + "*Name of program to use to run Mozilla. +`vm-mouse-send-url-to-mozilla' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mozilla-program-switches nil + "*List of command line switches to pass to Mozilla." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mosaic-program nil + "*Name of program to use to run Mosaic. +`vm-mouse-send-url-to-mosaic' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mosaic-program-switches nil + "*List of command line switches to pass to Mosaic." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-mmosaic-program nil + "*Name of program to use to run mMosaic. +`vm-mouse-send-url-to-mosaic' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-mmosaic-program-switches nil + "*List of command line switches to pass to mMosaic." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-konqueror-program "konqueror" + "*Name of program to use to run Konqueror. +`vm-mouse-send-url-to-konqueror' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-konqueror-program-switches nil + "*List of command line switches to pass to Konqueror." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-konqueror-client-program "kfmclient" + "*Name of program to use to issue requests to Konqueror. +`vm-mouse-send-url-to-konqueror' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-konqueror-client-program-switches nil + "*List of command line switches to pass to Konqueror client." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-firefox-program "firefox" + "*Name of program to use to run Mozilla Firefox. +`vm-mouse-send-url-to-firefox' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-firefox-program-switches nil + "*List of command line switches to pass to Mozilla Firefox." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-firefox-client-program "firefox" + "*Name of program to use to issue requests to Mozilla Firefox. +`vm-mouse-send-url-to-firefox' uses this." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-firefox-client-program-switches '("-remote") + "*List of command line switches to pass to Mozilla Firefox client." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-wget-program "wget" + "*Name of program to use to run wget. +This is used to retrieve URLs." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-w3m-program "w3m" + "*Name of program to use to run w3m. +This is used to retrieve URLs." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-fetch-program "fetch" + "*Name of program to use to run fetch. +This is used to retrieve URLs. Fetch is part of the standard +FreeBSD installation." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-curl-program "curl" + "*Name of program to use to run curl. +This is used to retrieve URLs." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-lynx-program "lynx" + "*Name of program to use to run lynx. +This is used to retrieve URLs." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-grep-program "grep" + "*Name of program to use to run grep. +This is used to count message separators in folders. +Set this to nil and VM will not use it." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-stunnel-program "stunnel" + "*Name of program to use to run stunnel. +This is used to make SSL connections to POP and IMAP servers that +support SSL. If this is set to nil, VM will attempt to use the +built-in SSL functionality of Emacs. Use this setting only if you +know that your version of Emacs has SSL capability, or any attempt to +contact the server will likely hang. + +If you do use an stunnel program, then see also the related variables +`vm-stunnel-program-switches' and +`vm-stunnel-program-additional-configuration-file'." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-stunnel-program-switches nil + "*List of command line switches to pass to stunnel. +Leave this set to nil unless you understand how VM uses stunnel +and know that you need to change something to get stunnel working. +This variable is ignored if you're running stunnel version 4 or +later versions, since those versions of stunnel are configurable +only with a configuration file." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-stunnel-program-additional-configuration-file nil + "*Name of a configuration file to append to the config file VM creates +when using stunnel version 4 or later. Leave this set to nil +unless you understand how VM uses stunnel and know that you need +to change something to get stunnel working. + +For stunnel version 4 and beyond stunnel relies on a configuration +file to tell it what to do. VM builts the necessary configuration +file for each instance of stunnel that it runs. If you have extra +configuration options you want stunnel to use, put them in a file +and set vm-stunnel-program-additional-configuration-file to the +name of that file. + +This variable is ignored if you're running stunnel versions prior +to version 4 as VM uses command line argument to control stunnel +in those cases." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (file :must-match t))) + +(defcustom vm-stunnel-random-data-method 'generate + "*Specifies what VM should do about sending the PRNG. +The stunnel program uses the OpenSSL library which requires a +certain amount of random data to seed its pseudo-random number +generator. VM can generate this data using Emacs' random number +generator or it can rely on stunnel to find the data by itself +somehow. Some systems have a /dev/urandom device that stunnel +can use. Some system have a entropy gathering daemon that can be +tapped for random data. If sufficient random data cannot be +found, the OpenSSL library will refuse to work and stunnel will +not be able to establish an SSL connection. + +Setting `vm-stunnel-random-data-method' to the symbol `generate' +tells VM to generate the random data. + +A nil value tells VM to do nothing and let stunnel find the data +if it can." + :group 'vm-helpers + :type '(choice (const "Leave it to stunnel" nil) + (const generate))) + +(defcustom vm-ssh-program "ssh" + "*Name of program to use to run SSH. +This is used to build an SSH tunnel to remote POP and IMAP servers. +Set this to nil and VM will not use it." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-ssh-program-switches nil + "*List of command line switches to pass to SSH." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + (repeat string))) + +(defcustom vm-ssh-remote-command "echo ready; sleep 15" + "*Shell command to run to hold open the SSH connection. +This command must generate one line of output and then +sleep long enough for VM to open a port-forwarded connection. +The default should work on UNIX systems." + :group 'vm-helpers + :type '(string :tag "Shell command")) + +(defcustom vm-uncompface-program (and vm-fsfemacs-p + (fboundp 'image-type-available-p) + (vm-locate-executable-file "uncompface")) + "*Program used to convert X-Face data to Sun icon format. +Or if the program version is new enough, it will be called with +-X to produce XBM data. This program is needed to support he +display of X-Faces under Emacs 21." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defcustom vm-icontopbm-program (and vm-fsfemacs-p + (fboundp 'image-type-available-p) + (vm-locate-executable-file "icontopbm")) + "*Program to convert Sun icon data to a PBM file. +This program is needed to support the display of X-Faces under +Emacs 21 if the uncompface program can't convert X-Face image +data to XBM data." + :group 'vm-helpers + :type '(choice (const :tag "None" nil) + file)) + +(defvar vm-uncompface-accepts-dash-x + (and vm-fsfemacs-p (fboundp 'image-type-available-p) + (stringp vm-uncompface-program) + (eq 0 (string-match "#define" + (shell-command-to-string + (format "%s -X" vm-uncompface-program))))) + "Non-nil if the uncompface command accepts a -X argument. +This is only used for FSF Emacs currently.") + +(defvar vm-stunnel-wants-configuration-file 'unknown + "Non-nil if stunnel is controlled by a configuration file. +An older stunnel version used command line arguments instead.") + +(defcustom vm-tale-is-an-idiot nil + "*Non-nil value causes `vm-mail-send' to check multi-line recipient +headers of outbound mail for lines that don't end with a +comma. If such a line is found, an error is signaled and the +mail is not sent." + :group 'vm-compose + :type 'boolean) + +(defcustom vm-dnd-protocol-alist + '(("^file:///" . vm-dnd-attach-file) + ("^file://" . dnd-open-file) + ("^file:" . vm-dnd-attach-file)) + "The functions to call when a drop in `mail-mode' is made. +See `dnd-protocol-alist' for more information. When nil, behave +as in other buffers." + :group 'vm-compose + :type '(choice (repeat (cons (regexp) (function))) + (const :tag "Behave as in other buffers" nil))) + +(defun vm-octal (n) + (let ((val 0) digit (expo 1)) + (while (> n 0) + (setq digit (% n 10)) + (if (>= digit 8) + (error "invalid octal digit: %d" digit)) + (setq val (+ val (* digit expo)) + n (/ n 10) + expo (* expo 8))) + val )) + +(defcustom vm-default-folder-permission-bits (vm-octal 600) + "*Default UNIX permission bits for newly created folders." + :group 'vm-folders + :type 'integer) + +(defcustom vm-coding-system-priorities nil ;'(iso-8859-1 iso-8859-15 utf-8) + "*List of coding systems for VM to use, for outgoing mail, in order of +preference. + +If you find that your outgoing mail is being encoded in `iso-2022-jp' and +you'd prefer something more widely used outside of Japan be used instead, +you could load the `latin-unity' and `un-define' libraries under XEmacs +21.4, and initialize this list to something like `(iso-8859-1 iso-8859-15 +utf-8)'. " + :group 'vm-compose + :type '(choice (const nil) + (repeat :tag "Coding system" symbol))) + +(defcustom vm-mime-ucs-list '(utf-8 iso-2022-jp ctext escape-quoted) + "*List of coding systems that can encode all characters known to emacs." + :group 'vm-mime + :type '(repeat symbol)) + +(defcustom vm-drop-buffer-name-chars "[^ a-zA-Z0-9.,_\"'+-]" + "*Regexp used to replace chars in composition buffer names. +If non-nil buffer names will be cleaned to avoid save problems. +If t, 8bit chars are replaced by a \"_\", if a string it should +be a regexp matching all chars to be replaced by a \"_\"." + :group 'vm-compose + :type '(choice (const :tag "Disabled" nil) + (regexp :tag "Enabled" "[^ a-zA-Z0-9.,_\"'+-]") + (regexp :tag "Custom regexp"))) + +(defconst vm-buffer-name-limit 80 + "*The limit for a generated buffer name.") + +(defconst vm-maintainer-address "viewmail-bugs@nongnu.org" + "Where to send VM bug reports.") + +(defvar vm-use-v7-key-bindings nil + "*Retain all the optional key bindings of VM as per version 7.19.") + +(defun vm-v8-key-bindings () + "Install optional key bindings for VM modes, as per versions 8.2.0 +and up." + (interactive) + (define-key vm-mode-map "!" 'vm-toggle-flag-message) + (define-key vm-mode-map "<" 'vm-promote-subthread) + (define-key vm-mode-map ">" 'vm-demote-subthread) + (define-key vm-mode-virtual-map "O" 'vm-virtual-omit-message) + (define-key vm-mode-virtual-map "U" 'vm-virtual-update-folders) + (define-key vm-mode-virtual-map "D" 'vm-virtual-auto-delete-message) + ;; (define-key vm-mode-virtual-map "S" 'vm-virtual-save-message) + ;; (define-key vm-mode-virtual-map "A" 'vm-virtual-auto-archive-messages) + (define-key vm-mode-virtual-map "?" 'vm-virtual-check-selector-interactive) + ) +(defalias 'vm-current-key-bindings 'vm-v8-key-bindings) + +(defun vm-v7-key-bindings () + "Install optional key bindings for VM modes, as per version 7.19. + +These key bindings are considered optional. They can be rebound by +the users or bound to other functions in future versions of VM." + (interactive) + (define-key vm-mode-map "<" 'vm-beginning-of-message) ; infrequent + (define-key vm-mode-map ">" 'vm-end-of-message) ; infrequent + (define-key vm-mode-map "b" 'vm-scroll-backward) ; redundant, use <BSP> + (define-key vm-mode-map "e" 'vm-edit-message) ; infrequent and dangerous + (define-key vm-mode-map "w" 'vm-save-message-sans-headers) ; infrequent + (define-key vm-mode-map "a" 'vm-set-message-attributes) ; infrequent + (define-key vm-mode-map "i" 'vm-iconify-frame) ; redundant, C-x C-z + (define-key vm-mode-map "*" 'vm-burst-digest) ; specialized + (define-key vm-mode-map "!" 'shell-command) ; Emacs has a key binding + (define-key vm-mode-map "=" 'vm-summarize) ; redundant, use `h' + (define-key vm-mode-map "L" 'vm-load-init-file) ; infrequent + (define-key vm-mode-map "\M-l" 'vm-edit-init-file) ; infrequent + (define-key vm-mode-map "%" 'vm-change-folder-type) ; infrequent + (define-key vm-mode-map "\M-g" 'vm-goto-message) ; redundant, use <RET> + ) +(defalias 'vm-legacy-key-bindings 'vm-v7-key-bindings) + +(defvar vm-mode-map + (let ((map (make-keymap))) + (defvar vm-mode-label-map (make-sparse-keymap)) + (defvar vm-mode-virtual-map (make-sparse-keymap)) + (defvar vm-mode-mark-map (make-sparse-keymap)) + (defvar vm-mode-window-map (make-sparse-keymap)) + (defvar vm-mode-mark-map (make-sparse-keymap)) + (defvar vm-mode-mark-map (make-sparse-keymap)) + (defvar vm-mode-pipe-map (make-sparse-keymap)) + ;; unneeded now that VM buffers all have buffer-read-only == t. + ;; but no harm in suppressing. USR, 2011-04-27 + (suppress-keymap map) + (define-key map "h" 'vm-summarize) + (define-key map "H" 'vm-folders-summarize) + (define-key map "\M-n" 'vm-next-unread-message) + (define-key map "\M-p" 'vm-previous-unread-message) + (define-key map "n" 'vm-next-message) + (define-key map "p" 'vm-previous-message) + (define-key map "N" 'vm-next-message-no-skip) + (define-key map "P" 'vm-previous-message-no-skip) + (define-key map "\C-\M-n" 'vm-move-message-forward) + (define-key map "\C-\M-p" 'vm-move-message-backward) + (define-key map "\t" 'vm-goto-message-last-seen) + (define-key map "\r" 'vm-goto-message) + (define-key map "\M-g" 'vm-optional-key) + (define-key map "^" 'vm-goto-parent-message) + (define-key map "t" 'vm-expose-hidden-headers) + (define-key map " " 'vm-scroll-forward) + (define-key map "b" 'vm-optional-key) + (define-key map "\C-?" 'vm-scroll-backward) + (define-key map [delete] 'vm-scroll-backward) + (define-key map [backspace] 'vm-scroll-backward) + (define-key map "D" 'vm-decode-mime-message) + (define-key map "d" 'vm-delete-message) + (define-key map "\C-d" 'vm-delete-message-backward) + (define-key map "u" 'vm-undelete-message) + (define-key map "U" 'vm-mark-message-unread) + (define-key map "." 'vm-mark-message-read) + (define-key map "e" 'vm-optional-key) + (define-key map "\C-c\C-e" 'vm-edit-message) + (define-key map "a" 'vm-optional-key) + (define-key map "j" 'vm-discard-cached-data) + (define-key map "k" 'vm-kill-subject) + (define-key map "f" 'vm-followup) + (define-key map "F" 'vm-followup-include-text) + (define-key map "r" 'vm-reply) + (define-key map "R" 'vm-reply-include-text) + (define-key map "\M-r" 'vm-resend-bounced-message) + (define-key map "B" 'vm-resend-message) + (define-key map "z" 'vm-forward-message) + (define-key map "Z" 'vm-forward-message-plain) + (define-key map "c" 'vm-continue-composing-message) + (define-key map "@" 'vm-send-digest) + (define-key map "*" 'vm-optional-key) + (define-key map "m" 'vm-mail) + (define-key map "g" 'vm-get-new-mail) + (define-key map "G" 'vm-sort-messages) + (define-key map "v" 'vm-visit-folder) + (define-key map "s" 'vm-save-message) + (define-key map "w" 'vm-optional-key) + (define-key map "A" 'vm-auto-archive-messages) + (define-key map "S" 'vm-save-folder) + ;; these two key bindings are experimental + (define-key map "o" 'vm-load-message) + (define-key map "O" 'vm-unload-message) + (define-key map "|" vm-mode-pipe-map) + (define-key vm-mode-pipe-map "|" 'vm-pipe-message-to-command) + (define-key vm-mode-pipe-map "d" 'vm-pipe-message-to-command-discard-output) + (define-key vm-mode-pipe-map "s" 'vm-pipe-messages-to-command) + (define-key vm-mode-pipe-map "n" 'vm-pipe-messages-to-command-discard-output) + (define-key map "#" (make-sparse-keymap)) + (define-key map "##" (make-sparse-keymap)) + (define-key map "###" 'vm-expunge-folder) + (cond ((fboundp 'set-keymap-prompt) + (set-keymap-prompt (lookup-key map "#") + "(Type # twice more to expunge)") + (set-keymap-prompt (lookup-key map "##") + "(Type # once more to expunge)"))) + (define-key map "q" 'vm-quit) + (define-key map "x" 'vm-quit-no-change) + (define-key map "i" 'vm-optional-key) + (define-key map "?" 'vm-help) + (define-key map "\C-_" 'vm-undo) + (define-key map [(control /)] 'vm-undo) + (define-key map "\C-xu" 'vm-undo) + (define-key map "!" 'vm-optional-key) + (define-key map "[" 'vm-move-to-previous-button) + (define-key map "]" 'vm-move-to-next-button) + (define-key map "\M-s" 'vm-isearch-forward) + (define-key map "=" 'vm-optional-key) + (define-key map "L" 'vm-optional-key) + (define-key map "\M-l" 'vm-optional-key) + (define-key map "l" vm-mode-label-map) + (define-key vm-mode-label-map "a" 'vm-add-message-labels) + (define-key vm-mode-label-map "e" 'vm-add-existing-message-labels) + (define-key vm-mode-label-map "d" 'vm-delete-message-labels) + (define-key map "V" vm-mode-virtual-map) + (define-key vm-mode-virtual-map "V" 'vm-visit-virtual-folder) + (define-key vm-mode-virtual-map "C" 'vm-create-virtual-folder) + (define-key vm-mode-virtual-map "T" 'vm-create-virtual-folder-of-threads) + (define-key vm-mode-virtual-map "X" 'vm-apply-virtual-folder) + (define-key vm-mode-virtual-map "A" 'vm-create-virtual-folder-same-author) + (define-key vm-mode-virtual-map "S" 'vm-create-virtual-folder-same-subject) + (define-key vm-mode-virtual-map "M" 'vm-toggle-virtual-mirror) + + (define-key vm-mode-virtual-map "a" 'vm-create-author-virtual-folder) + (define-key vm-mode-virtual-map "r" 'vm-create-author-or-recipient-virtual-folder) + (define-key vm-mode-virtual-map "d" 'vm-create-date-virtual-folder) + (define-key vm-mode-virtual-map "l" 'vm-create-label-virtual-folder) + (define-key vm-mode-virtual-map "s" 'vm-create-subject-virtual-folder) + (define-key vm-mode-virtual-map "t" 'vm-create-text-virtual-folder) + (define-key vm-mode-virtual-map "!" 'vm-create-flagged-virtual-folder) + (define-key vm-mode-virtual-map "n" 'vm-create-new-virtual-folder) + (define-key vm-mode-virtual-map "u" 'vm-create-unseen-virtual-folder) + + (define-key vm-mode-virtual-map "?" 'vm-virtual-help) + (define-key map "M" vm-mode-mark-map) + (define-key vm-mode-mark-map "N" 'vm-next-command-uses-marks) + (define-key vm-mode-mark-map "n" 'vm-next-command-uses-marks) + (define-key vm-mode-mark-map "M" 'vm-mark-message) + (define-key vm-mode-mark-map "U" 'vm-unmark-message) + (define-key vm-mode-mark-map "m" 'vm-mark-all-messages) + (define-key vm-mode-mark-map "u" 'vm-clear-all-marks) + (define-key vm-mode-mark-map "C" 'vm-mark-matching-messages) + (define-key vm-mode-mark-map "c" 'vm-unmark-matching-messages) + (define-key vm-mode-mark-map "T" 'vm-mark-thread-subtree) + (define-key vm-mode-mark-map "t" 'vm-unmark-thread-subtree) + (define-key vm-mode-mark-map "S" 'vm-mark-messages-same-subject) + (define-key vm-mode-mark-map "s" 'vm-unmark-messages-same-subject) + (define-key vm-mode-mark-map "A" 'vm-mark-messages-same-author) + (define-key vm-mode-mark-map "a" 'vm-unmark-messages-same-author) + (define-key vm-mode-mark-map "R" 'vm-mark-summary-region) + (define-key vm-mode-mark-map "r" 'vm-unmark-summary-region) + (define-key vm-mode-mark-map "V" 'vm-toggle-all-marks) + (define-key vm-mode-mark-map "X" 'vm-mark-matching-messages-with-virtual-folder) + (define-key vm-mode-mark-map "x" 'vm-unmark-matching-messages-with-virtual-folder) + (define-key vm-mode-mark-map "?" 'vm-mark-help) + (define-key map "W" vm-mode-window-map) + (define-key vm-mode-window-map "W" 'vm-apply-window-configuration) + (define-key vm-mode-window-map "S" 'vm-save-window-configuration) + (define-key vm-mode-window-map "D" 'vm-delete-window-configuration) + (define-key vm-mode-window-map "?" 'vm-window-help) + (define-key map "\C-t" 'vm-toggle-threads-display) + (define-key map "\C-x\C-s" 'vm-save-buffer) + (define-key map "\C-x\C-w" 'vm-write-file) + (define-key map "\C-x\C-q" 'vm-toggle-read-only) + (define-key map "%" 'vm-optional-key) + (define-key map "\M-C" 'vm-show-copying-restrictions) + (define-key map "\M-W" 'vm-show-no-warranty) + (define-key map "\C-c\C-s" 'vm-save-all-attachments) + (define-key map "\C-c\C-d" 'vm-delete-all-attachments) + (define-key map "T" 'vm-toggle-thread) + (define-key map "E" 'vm-expand-all-threads) + (define-key map "C" 'vm-collapse-all-threads) + (define-key map "K" 'vm-kill-thread-subtree) + ;; suppress-keymap provides these, but now that we don't use + ;; suppress-keymap anymore... + (define-key map "0" 'digit-argument) + (define-key map "1" 'digit-argument) + (define-key map "2" 'digit-argument) + (define-key map "3" 'digit-argument) + (define-key map "4" 'digit-argument) + (define-key map "5" 'digit-argument) + (define-key map "6" 'digit-argument) + (define-key map "7" 'digit-argument) + (define-key map "8" 'digit-argument) + (define-key map "9" 'digit-argument) + (define-key map "-" 'negative-argument) + (cond ((fboundp 'set-keymap-name) + (set-keymap-name map 'vm-mode-map) + (set-keymap-name (lookup-key map "l") + "VM mode message labels map") + (set-keymap-name (lookup-key map "V") + "VM mode virtual folders map") + (set-keymap-name (lookup-key map "M") + "VM mode message marks map") + (set-keymap-name (lookup-key map "W") + "VM mode window configuration map") + (set-keymap-name (lookup-key map "|") + "VM mode pipe-to-application map"))) + map ) + "Keymap for VM mode. See also the following subsidiary keymaps: +`vm-mode-label-map' VM mode message labels map (`l') +`vm-mode-virtual-map' VM mode virtual folders map (`V') +`vm-mode-mark-map' VM mode message marking map (`M') +`vm-mode-window-map' VM mode window configuration map (`W') +`vm-mode-pipe-map' VM mode pipe-to-application map (`|') +") + +(defun vm-optional-key () + "Certain VM keys have optional bindings in VM, which differ from +version to version. Include \"(vm-legacy-key-bindings)\" in your +`vm-preferences-file' in order to bind them as in version 7.19. For +other possibilities, see the NEWS file of VM." + (interactive) + (error "This key has an optional binding in VM. Do C-h k for help.")) + +(defcustom vm-summary-enable-thread-folding nil + "*If non-nil, enables folding of threads in VM summary +windows. (This functionality is still experimental.)" + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-show-thread-count t + "*If non-nil, thread folding displays the count of messages in +a thread along with the message number of the thread root. Note +that this takes up 3 extra characters in each summary line." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-thread-folding-on-motion nil + "*If non-nil and thread folding is enabled, invoking +vm-next/previous-message-no-skip (`N' or `P' respectively) +will expand a thread upon moving into the thread and collapse it when +you move out of the thread." + :group 'vm-summary + :type 'boolean) + +(defcustom vm-summary-visible '((new)) + "*List of selectors identifying messages that should be visible in +folded thread summaries, i.e., such messages remain visible even if +their threads are shown collapsed. The selectors are the same as +those used in `vm-virtual-folder-alist'." + :group 'vm-summary + :type '(repeat sexp)) + +(defcustom vm-enable-thread-operations nil + "*If non-nil, VM operations on root messages of collapsed +threads will apply to all the messages in the threads. + +\"Operations\" in this context include deleting, saving, setting +attributes, adding/deleting labels etc. + +If the variable is set to t then thread operations are always +carried out. If it is set to 'ask, then the user is asked for +confirmation whether the operation should apply to all the +messages in the thread. This can be overridden by invoking the +operation with a prefix argument using `C-u' and no questions will be +asked." + :group 'vm-summary + :type '(choice (const t) + (const ask) + (const nil))) + +(defvar vm-summary-threads-collapsed t + "If non-nil, indicates that threads should be +folded (collapsed) in VM summary windows.") +(make-variable-buffer-local 'vm-summary-threads-collapsed) + +(defvar vm-summary-mode-map vm-mode-map + "Keymap for VM Summary mode") + +(defvar vm-folders-summary-mode-map vm-mode-map + "Keymap for VM Folders Summary mode") + +(defvar vm-mail-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-v" vm-mode-map) + (define-key map "\C-c\C-p" 'vm-preview-composition) + (define-key map "\C-c\C-d" 'vm-postpone-message) + (define-key map "\C-c\C-e" 'vm-mime-encode-composition) + (define-key map "\C-c\C-a" 'vm-attach-file) + (define-key map "\C-c\C-b" 'vm-attach-buffer) + (define-key map "\C-c\C-m" 'vm-attach-message) + (define-key map "\C-c\C-y" 'vm-yank-message) + (define-key map "\C-c\C-s" 'vm-mail-send) + (define-key map "\C-c\C-c" 'vm-mail-send-and-exit) + ;; The following is a temporary binding for Mac/NextStep + ;; It should be removed when dnd-protocol-alist is implemented + (define-key map [ns-drag-file] 'vm-ns-attach-file) + (cond ((fboundp 'set-keymap-name) + (set-keymap-name map 'vm-mail-mode-map))) + map ) + "Keymap for VM Mail mode buffers. +Its parent keymap is mail-mode-map.") + +(defvar vm-edit-message-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-v" vm-mode-map) + (define-key map "\C-c\e" 'vm-edit-message-end) + (define-key map "\C-c\C-c" 'vm-edit-message-end) + (define-key map "\C-c\C-]" 'vm-edit-message-abort) + (cond ((fboundp 'set-keymap-name) + (set-keymap-name map 'vm-edit-message-map))) + map ) + "Keymap for the buffers created by VM's `vm-edit-message' command.") + +(defvar vm-mime-reader-map + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'vm-mime-run-display-function-at-point) + (define-key map "$\r" 'vm-mime-reader-map-display-using-default) + (define-key map "$e" 'vm-mime-reader-map-display-using-external-viewer) + (define-key map "$c" 'vm-mime-reader-map-convert-then-display) + (define-key map "$v" 'vm-mime-reader-map-display-object-as-type) + (define-key map "$w" 'vm-mime-reader-map-save-file) + (define-key map "$s" 'vm-mime-reader-map-save-message) + (define-key map "$p" 'vm-mime-reader-map-pipe-to-printer) + (define-key map "$|" 'vm-mime-reader-map-pipe-to-command) + (define-key map "$a" 'vm-mime-reader-map-attach-to-composition) + (define-key map "$d" 'vm-delete-mime-object) + (cond ((vm-mouse-xemacs-mouse-p) + (define-key map 'button3 'vm-menu-popup-mime-dispose-menu))) + (cond ((fboundp 'set-keymap-name) + (set-keymap-name map 'vm-mime-reader-map))) + map ) + "Keymap for the MIME buttons in VM folder buffers.") + +(defvar vm-folder-history nil + "List of folders visited this Emacs session.") + +;; Do we need this variable in addition to the above? +(defvar vm-switch-to-folder-history nil + "List of folders used with `vm-switch-to-folder'.") + +;; for sixth arg of read-file-name in early version of Emacs 21. +(defun vm-folder-history (&rest ignored) t) + +;; internal vars +(defvar vm-skip-collapsed-sub-threads t) +(defvar vm-folder-type nil) +(make-variable-buffer-local 'vm-folder-type) +(defvar vm-folder-access-method nil + "Indicates how a VM folder is accessed: 'pop for POP folders, 'imap +for IMAP folders and nil for local folders.") +(make-variable-buffer-local 'vm-folder-access-method) + +(defvar vm-folder-access-data nil + "Holds a vector of data about the mailbox on a mail server that this +folder is meant to access.") +(make-variable-buffer-local 'vm-folder-access-data) +(defconst vm-folder-pop-access-data-length 2) +(defconst vm-folder-imap-access-data-length 13) + +(defvar vm-message-list nil) +(make-variable-buffer-local 'vm-message-list) +(defvar vm-fetched-messages nil) +(make-variable-buffer-local 'vm-fetched-messages) +(defvar vm-fetched-message-count 0) +(make-variable-buffer-local 'vm-fetched-message-count) + +(defvar vm-virtual-folder-definition nil + "The virtual folder definition of the folder in the current buffer, +which is normally an entry in `vm-virtual-folder-alist'. It is of the +form: + (VIRTUAL-FOLDER-NAME + ((FOLDER-NAME ...) + (SELECTOR [ARG ...]) ...) + ... ) +A FOLDER-NAME entry can be +- the name of a local folder, or +- an s-expression which, when evaluated, yields a folder buffer loaded +in VM." ) +(make-variable-buffer-local 'vm-virtual-folder-definition) + +(defvar vm-virtual-buffers nil) +(make-variable-buffer-local 'vm-virtual-buffers) +(defvar vm-real-buffers nil) +(make-variable-buffer-local 'vm-real-buffers) +(defvar vm-component-buffers nil + "An a-list of folder buffers that make up the components of the current +virtual folder, and a flag indicating whether they are being visited +as a part of visiting this virtual folder. All such folders will be +closed when the virtual folder is closed.") +(make-variable-buffer-local 'vm-component-buffers) + +(defvar vm-message-pointer nil + "A pointer into the `vm-message-list' indicating the position of the +current message.") +(make-variable-buffer-local 'vm-message-pointer) +(defvar vm-message-order-changed nil) +(make-variable-buffer-local 'vm-message-order-changed) +(defvar vm-message-order-header-present nil) +(make-variable-buffer-local 'vm-message-order-header-present) +(defvar vm-last-message-pointer nil + "A pointer into the `vm-message-list' indicating the position of the +message last viewed.") +(make-variable-buffer-local 'vm-last-message-pointer) +(defvar vm-folders-summary-hash nil) +(defvar vm-folders-summary-spool-hash nil) +(defvar vm-folders-summary-folder-hash nil) +(defvar vm-folders-summary-buffer nil) +(defvar vm-mail-buffer nil + "The folder buffer of the current buffer.") +(make-variable-buffer-local 'vm-mail-buffer) +(defvar vm-fetch-buffer nil + "The fetch buffer, where message bodies are fetched, for the current +folder. (Not in use.)") +(make-variable-buffer-local 'vm-fetch-buffer) +(defvar vm-presentation-buffer nil + "The message presentation buffer for the current folder.") +(make-variable-buffer-local 'vm-presentation-buffer) +(defvar vm-presentation-buffer-handle nil + "The message presentation buffer for the current folder.") +(make-variable-buffer-local 'vm-presentation-buffer-handle) +(defvar vm-mime-decoded nil + "The MIME decoding state of the current folder.") +(make-variable-buffer-local 'vm-mime-decoded) +(defvar vm-summary-buffer nil + "The summary buffer for the current folder.") +(make-variable-buffer-local 'vm-summary-buffer) +(defvar vm-user-interaction-buffer nil + "The buffer in which the current VM command was invoked.") +(defvar vm-summary-pointer nil) +(make-variable-buffer-local 'vm-summary-pointer) +(defvar vm-system-state nil) +(make-variable-buffer-local 'vm-system-state) +(defvar vm-undo-record-list nil + "The list of undo records for the folder.") +(make-variable-buffer-local 'vm-undo-record-list) +(defvar vm-saved-undo-record-list nil + "A saved version of the undo record list used in `vm-toggle-virtual-mirror'.") +(make-variable-buffer-local 'vm-saved-undo-record-list) +(defvar vm-undo-record-pointer nil + "A pointer into the `vm-undo-record-list'.") +(make-variable-buffer-local 'vm-undo-record-pointer) +(defvar vm-last-save-folder nil) +(make-variable-buffer-local 'vm-last-save-folder) +(defvar vm-last-save-imap-folder nil) +(make-variable-buffer-local 'vm-last-save-imap-folder) +(defvar vm-last-written-file nil) +(make-variable-buffer-local 'vm-last-written-file) +(defvar vm-last-visit-folder nil) +(defvar vm-last-visit-pop-folder nil) +(defvar vm-last-visit-imap-folder nil) +(defvar vm-last-visit-imap-account nil) +(defvar vm-last-pipe-command nil) +(make-variable-buffer-local 'vm-last-pipe-command) +(defvar vm-messages-not-on-disk 0 + "Number of messages in the folder that are not on the disk copy +of the folder. This is the count from the user's point of view but +may include some messages that are really on disk.") +(make-variable-buffer-local 'vm-messages-not-on-disk) +(defvar vm-totals nil) +(make-variable-buffer-local 'vm-totals) +(defvar vm-modification-counter 0) +(make-variable-buffer-local 'vm-modification-counter) +(defvar vm-flushed-modification-counter nil) +(make-variable-buffer-local 'vm-flushed-modification-counter) +(defvar vm-tempfile-counter 0) +(defvar vm-messages-needing-summary-update nil) +(defvar vm-buffers-needing-display-update nil + "Obarray containing the names of VM buffers that need display +update.") +(defvar vm-buffers-needing-undo-boundaries nil + "Obarray containing the names of VM buffers that need undo +boundaries.") ; whatever they are! +(defvar vm-numbering-redo-start-point nil + "A pointer into `vm-message-list' indicating the position from which +messages may need to be renumbered.") +(make-variable-buffer-local 'vm-numbering-redo-start-point) +(defvar vm-numbering-redo-end-point nil + "A pointer into `vm-message-list' indicating the stopping point +for any needed message renumbering.") +(make-variable-buffer-local 'vm-numbering-redo-end-point) +(defvar vm-summary-redo-start-point nil + "A pointer into `vm-message-list' indicating the position from which +summary lines may need to be redisplayed.") +(make-variable-buffer-local 'vm-summary-redo-start-point) +(defvar vm-need-summary-pointer-update nil + "A boolean indicating whether the summary pointer for the current +folder needs to be updated.") +(make-variable-buffer-local 'vm-need-summary-pointer-update) +(defvar vm-thread-obarray 'bonk) +(make-variable-buffer-local 'vm-thread-obarray) +(defvar vm-thread-subject-obarray 'bonk) +(make-variable-buffer-local 'vm-thread-subject-obarray) +(defvar vm-label-obarray nil) +(make-variable-buffer-local 'vm-label-obarray) +(defvar vm-block-new-mail nil) +(make-variable-buffer-local 'vm-block-new-mail) +(defvar vm-global-block-new-mail nil) +(defvar vm-saved-buffer-modified-p nil) +(make-variable-buffer-local 'vm-saved-buffer-modified-p) +(defvar vm-kept-mail-buffers nil) +(defvar vm-inhibit-write-file-hook nil) +;; used to choose between the default and +;; mail-extract-address-components but I don't see the utility of +;; it anymore. It tries to be too smart. +;;(defvar vm-chop-full-name-function 'vm-choose-chop-full-name-function) +(defvar vm-chop-full-name-function 'vm-default-chop-full-name) +(defvar vm-session-beginning t) +(defvar vm-init-file-loaded nil) +(defvar vm-window-configurations nil) +(defvar vm-window-configuration nil) +(defvar vm-message-id-number 0) +(defconst vm-spool-directory + (or (and (boundp 'rmail-spool-directory) rmail-spool-directory) + "/usr/spool/mail/")) +(defconst vm-content-length-search-regexp "^Content-Length:.*\n\\|\\(\n\n\\)") +(defconst vm-content-length-header "Content-Length:") +(defconst vm-references-header-regexp + "^References:\\(.*\n\\([ \t].*\n\\)*\\)") +(defconst vm-attributes-header-regexp + "^X-VM-\\(Attributes\\|v5-Data\\):\\(.*\n\\([ \t].*\n\\)*\\)") +(defconst vm-attributes-header "X-VM-v5-Data:") +(defconst vm-message-order-header-regexp "^X-VM-Message-Order:") +(defconst vm-message-order-header "X-VM-Message-Order:") +(defconst vm-bookmark-header-regexp "^X-VM-Bookmark:") +(defconst vm-bookmark-header "X-VM-Bookmark:") +(defconst vm-pop-retrieved-header-regexp "^X-VM-POP-Retrieved:") +(defconst vm-pop-retrieved-header "X-VM-POP-Retrieved:") +(defconst vm-imap-retrieved-header-regexp "^X-VM-IMAP-Retrieved:") +(defconst vm-imap-retrieved-header "X-VM-IMAP-Retrieved:") +(defconst vm-storage-header-regexp "^X-VM-Storage:") +(defconst vm-storage-header "X-VM-Storage:") +(defconst vm-last-modified-header-regexp "^X-VM-Last-Modified:") +(defconst vm-last-modified-header "X-VM-Last-Modified:") +(defconst vm-summary-header-regexp "^X-VM-Summary-Format:") +(defconst vm-summary-header "X-VM-Summary-Format:") +(defconst vm-vheader-header-regexp "^X-VM-VHeader:") +(defconst vm-vheader-header "X-VM-VHeader:") +(defconst vm-labels-header-regexp "^X-VM-Labels:") +(defconst vm-labels-header "X-VM-Labels:") +(defconst vm-berkeley-mail-status-header "Status: ") +(defconst vm-berkeley-mail-status-header-regexp "^Status: \\(..?\\)\n") +(defconst vm-internal-unforwarded-header-regexp + "\\(X-VM-\\|X-Mozilla-\\|Status:\\|Content-Length:\\)") +(defvar vm-matched-header-vector (make-vector 6 nil)) +(defconst vm-supported-folder-types + '("From_" "BellFrom_" "From_-with-Content-Length" "mmdf" "babyl")) +(defconst vm-supported-window-configurations + '( + ("default") + ("startup") + ("quitting") + ("composing-message") + ("editing-message") + ("marking-message") + ("reading-message") + ("searching-message") + ("vm") + ("vm-add-message-labels") + ("vm-apply-virtual-folder") + ("vm-auto-archive-messages") + ("vm-beginning-of-message") + ("vm-burst-digest") + ("vm-burst-mime-digest") + ("vm-burst-rfc1153-digest") + ("vm-burst-rfc934-digest") + ("vm-change-folder-type") + ("vm-clear-all-marks") + ("vm-continue-composing-message") + ("vm-create-virtual-folder") + ("vm-create-virtual-folder-same-author") + ("vm-create-virtual-folder-same-subject") + ("vm-decode-mime-message") + ("vm-delete-duplicate-messages") + ("vm-delete-message") + ("vm-delete-message-backward") + ("vm-delete-message-labels") + ("vm-delete-mime-object") + ("vm-discard-cached-data") + ("vm-edit-message") + ("vm-edit-message-abort") + ("vm-edit-message-end") + ("vm-edit-message-other-frame") + ("vm-end-of-message") + ("vm-expose-hidden-headers") + ("vm-expunge-folder") + ("vm-expunge-imap-messages") + ("vm-expunge-pop-messages") + ("vm-folders-summarize") + ("vm-followup") + ("vm-followup-include-text") + ("vm-followup-include-text-other-frame") + ("vm-followup-other-frame") + ("vm-forward-message") + ("vm-forward-message-encapsulated") + ("vm-forward-message-all-headers") + ("vm-forward-message-all-headers-other-frame") + ("vm-forward-message-other-frame") + ("vm-forward-message-encapsulated-other-frame") + ("vm-get-new-mail") + ("vm-goto-message") + ("vm-goto-message-last-seen") + ("vm-goto-parent-message") + ("vm-help") + ("vm-isearch-forward") + ("vm-kill-subject") + ("vm-load-init-file") + ("vm-mail") + ("vm-mail-other-frame") + ("vm-mail-other-window") + ("vm-mail-send") + ("vm-mail-send-and-exit") + ("vm-mark-all-messages") + ("vm-mark-help") + ("vm-mark-matching-messages") + ("vm-mark-matching-messages-with-virtual-folder") + ("vm-mark-message") + ("vm-mark-messages-same-author") + ("vm-mark-messages-same-subject") + ("vm-mark-summary-region") + ("vm-mark-thread-subtree") + ("vm-attach-buffer") + ("vm-attach-file") + ("vm-attach-message") + ("vm-attach-mime-file") + ("vm-attach-object-to-composition") + ("vm-attach-message-to-composition") + ("vm-mode") + ("vm-move-message-backward") + ("vm-move-message-backward-physically") + ("vm-move-message-forward") + ("vm-move-message-forward-physically") + ("vm-move-to-previous-button") + ("vm-move-to-next-button") + ("vm-next-command-uses-marks") + ("vm-next-message") + ("vm-next-message-no-skip") + ("vm-next-message-no-skip") + ("vm-next-message-same-subject") + ("vm-next-unread-message") + ("vm-other-frame") + ("vm-other-window") + ("vm-pipe-message-to-command") + ("vm-previous-message") + ("vm-previous-message-no-skip") + ("vm-previous-message-no-skip") + ("vm-previous-message-same-subject") + ("vm-previous-unread-message") + ("vm-quit") + ("vm-quit-just-bury") + ("vm-quit-just-iconify") + ("vm-quit-no-expunge") + ("vm-quit-no-change") + ("vm-reply") + ("vm-reply-include-text") + ("vm-reply-include-text-other-frame") + ("vm-reply-other-frame") + ("vm-resend-bounced-message") + ("vm-resend-bounced-message-other-frame") + ("vm-resend-message") + ("vm-resend-message-other-frame") + ("vm-save-and-expunge-folder") + ("vm-save-buffer") + ("vm-save-folder") + ("vm-save-message") + ("vm-save-message-sans-headers") + ("vm-save-message-to-imap-folder") + ("vm-scroll-backward") + ("vm-scroll-backward-one-line") + ("vm-scroll-forward") + ("vm-scroll-forward-one-line") + ("vm-send-digest") + ("vm-send-digest-other-frame") + ("vm-send-mime-digest") + ("vm-send-mime-digest-other-frame") + ("vm-send-rfc1153-digest") + ("vm-send-rfc1153-digest-other-frame") + ("vm-send-rfc934-digest") + ("vm-send-rfc934-digest-other-frame") + ("vm-set-message-attributes") + ("vm-show-copying-restrictions") + ("vm-show-no-warranty") + ("vm-sort-messages") + ("vm-submit-bug-report") + ("vm-summarize") + ("vm-summarize-other-frame") + ("vm-toggle-all-marks") + ("vm-toggle-read-only") + ("vm-toggle-threads-display") + ("vm-undelete-message") + ("vm-undo") + ("vm-unmark-matching-messages") + ("vm-unmark-matching-messages-with-virtual-folder") + ("vm-unmark-message") + ("vm-unmark-messages-same-author") + ("vm-unmark-messages-same-subject") + ("vm-unmark-summary-region") + ("vm-unmark-thread-subtree") + ("vm-mark-message-unread") + ("vm-mark-message-read") + ("vm-virtual-help") + ("vm-visit-folder") + ("vm-visit-folder-other-frame") + ("vm-visit-folder-other-window") + ("vm-visit-imap-folder") + ("vm-visit-imap-folder-other-frame") + ("vm-visit-imap-folder-other-window") + ("vm-visit-pop-folder") + ("vm-visit-pop-folder-other-frame") + ("vm-visit-pop-folder-other-window") + ("vm-visit-virtual-folder") + ("vm-visit-virtual-folder-other-frame") + ("vm-visit-virtual-folder-other-window") + ("vm-write-file") + ("vm-yank-message") + ("vm-yank-message-other-folder") +)) + +(defconst vm-vs-attachment-regexp "^Content-Disposition: attachment" + "Regexp used to detect attachments in a message.") + +(defvar vm-spam-words nil + "A list of words often contained in spam messages.") + +(defvar vm-spam-words-regexp nil + "A regexp matching those words in `vm-spam-words'.") + +(defcustom vm-spam-words-file + (expand-file-name "~/.spam-words") + "A file storing a list of words contained in spam messages." + :group 'vm-folders + :type 'file) + +(defcustom vm-spam-score-headers + '(("X-Spam-Score:" "[-+]?[0-9]*\\.?[0-9]+" string-to-number) + ("X-Spam-Status:" "[-+]?[0-9]*\\.?[0-9]+" string-to-number) + ("X-Spam-Level:" "\\*+" length)) + "The value should be a list of lists, with each sublist of the form + + (HEADER-REGEXP SCORE-REGEXP SCORE-FN) + +- HEADER-REGEXP is a regular expression matching the spam score +header line in email messages, + +- SCORE-REGEXP is a regular expression matching the score, and + +- SCORE-FN is a function that converts the score string into a number." + :group 'vm-folders + :type '(repeat (list (string :tag "Header regexp") + (regexp :tag "Regexp matching the spam-score") + (function :tag "Function to convert the spam-score string to a number")))) + +(defvaralias 'vm-vs-spam-score-headers + 'vm-spam-score-headers) + +(defconst vm-supported-sort-keys + '("date" "reversed-date" + "activity" "reversed-activity" + "author" "reversed-author" + "full-name" "reversed-full-name" + "subject" "reversed-subject" + "recipients" "reversed-recipients" + "line-count" "reversed-line-count" + "byte-count" "reversed-byte-count" + "spam-score" "reversed-spam-score" + "physical-order" "reversed-physical-order")) + +(defconst vm-supported-interactive-virtual-selectors + '(("any") + ("sexp") + ("eval") + ;; ("member") ; - yet to be defined + ("virtual-folder-member") + ("header") + ("label") + ("uid") + ("uidl") + ("message-id") + ("text") + ("header-or-text") + ("recipient") + ("author") + ("author-or-recipient") + ("outgoing") + ("uninteresting-senders") + ("subject") + ("sent-before") + ("sent-after") + ("older-than") + ("newer-than") + ("attachment") + ("more-chars-than") + ("less-chars-than") + ("more-lines-than") + ("less-lines-than") + ("new") + ("unread") + ("read") + ("unseen") + ("recent") + ("flagged") + ("unflagged") + ("deleted") + ("replied") + ("forwarded") + ("redistributed") + ("filed") + ("written") + ("edited") + ("marked") + ("undeleted") + ("unreplied") + ("unforwarded") + ("unredistributed") + ("unfiled") + ("unwritten") + ("unedited") + ("unmarked") + ("expanded") + ("collapsed") + ("spam-word") + ("spam-score") + )) + +(defconst vm-virtual-selector-function-alist + '((any . vm-vs-any) + ;; (member . vm-vs-member) ; yet to be defined + (virtual-folder-member . vm-vs-virtual-folder-member) + (and . vm-vs-and) + (or . vm-vs-or) + (not . vm-vs-not) + (sexp . vm-vs-sexp) + (eval . vm-vs-eval) + (thread . vm-vs-thread) + (thread-all . vm-vs-thread-all) + (header . vm-vs-header) + (header-field . vm-vs-header-field) + (label . vm-vs-label) + (uid . vm-vs-uid) + (uidl . vm-vs-uidl) + (message-id . vm-vs-message-id) + (text . vm-vs-text) + (header-or-text . vm-vs-header-or-text) + (recipient . vm-vs-recipient) + (author . vm-vs-author) + (author-or-recipient . vm-vs-author-or-recipient) + (outgoing . vm-vs-outgoing) + (uninteresting-senders . vm-vs-uninteresting-senders) + (subject . vm-vs-subject) + (sortable-subject . vm-vs-sortable-subject) + (sent-before . vm-vs-sent-before) + (sent-after . vm-vs-sent-after) + (older-than . vm-vs-older-than) + (newer-than . vm-vs-newer-than) + (attachment . vm-vs-attachment) + (more-chars-than . vm-vs-more-chars-than) + (less-chars-than . vm-vs-less-chars-than) + (more-lines-than . vm-vs-more-lines-than) + (less-lines-than . vm-vs-less-lines-than) + (new . vm-vs-new) + (unread . vm-vs-unread) + (read . vm-vs-read) + (unseen . vm-vs-unseen) + (recent . vm-vs-recent) + (flagged . vm-vs-flagged) + (unflagged . vm-vs-unflagged) + (deleted . vm-vs-deleted) + (replied . vm-vs-replied) + (answered . vm-vs-answered) + (forwarded . vm-vs-forwarded) + (redistributed . vm-vs-redistributed) + (filed . vm-vs-filed) + (written . vm-vs-written) + (edited . vm-vs-edited) + (marked . vm-vs-marked) + (undeleted . vm-vs-undeleted) + (unreplied . vm-vs-unreplied) + (unanswered . vm-vs-unanswered) + (unforwarded . vm-vs-unforwarded) + (unredistributed . vm-vs-unredistributed) + (unfiled . vm-vs-unfiled) + (unwritten . vm-vs-unwritten) + (unedited . vm-vs-unedited) + (unmarked . vm-vs-unmarked) + (spam-word . vm-vs-spam-word) + (spam-score . vm-vs-spam-score) + (expanded . vm-vs-expanded) + (collapsed . vm-vs-collapsed) + )) + +(defconst vm-supported-attribute-names + '("new" + "unread" + "read" + "deleted" + "replied" + "forwarded" + "redistributed" + "filed" + "written" + "edited" + "undeleted" + "unreplied" + "unforwarded" + "unredistributed" + "unfiled" + "unwritten" + "unedited" + "expanded" + "collapsed" + ;; for babyl cogniscenti + "recent" + "unseen" + "flagged" + "unflagged" + "answered" + "unanswered" + )) + +(defvar vm-key-functions nil) +(defconst vm-digest-type-alist '(("rfc934") ("rfc1153") ("mime"))) +(defvar vm-completion-auto-correct t + "Non-nil means that minibuffer-complete-file should aggressively erase +the trailing part of a word that caused completion to fail, and retry +the completion with the resulting word.") +(defvar vm-minibuffer-completion-table nil + "Completion table used by `vm-minibuffer-complete-word'. +Should be just a list of strings, not an alist or an obarray.") +(defvar vm-completion-auto-space t + "Non-nil value means that `vm-minibuffer-complete-word' should automatically +append a space to words that complete unambiguously.") +(defconst vm-folder-summary-vector-length 15) +(defconst vm-startup-message-lines + '("Please use \\[vm-submit-bug-report] to report bugs." + "For discussion about the VM mail reader, see the gnu.emacs.vm.info newsgroup" + "You may give out copies of VM. Type \\[vm-show-copying-restrictions] to see the conditions" + "VM comes with ABSOLUTELY NO WARRANTY; type \\[vm-show-no-warranty] for full details")) +(defconst vm-startup-message-displayed nil) +;; for the mode line +(defconst vm-mode-line-format-robf + '("- " + (vm-compositions-exist ("" vm-ml-composition-buffer-count " / ")) + (vm-drafts-exist ("" vm-ml-draft-count " / ")) + ((vm-spooled-mail-waiting "New mail for ") + (vm-folder-read-only "read-only ") + (vm-virtual-folder-definition (vm-virtual-mirror "mirrored ")) + " %&%& " + "%b" + (vm-mail-buffer (vm-ml-sort-keys ("" " by " vm-ml-sort-keys))) + (vm-message-list + (" " vm-ml-message-number + " (of " vm-ml-highest-message-number ")") + (vm-folder-type + " (unrecognized folder type)" + " (no messages)"))) + (vm-message-list + (" %[ " vm-ml-message-attributes-alist + (vm-ml-labels ("; " vm-ml-labels)) " %] ") + (" %[%] ")) + "%p" + " (VM " vm-version ")" + global-mode-string + "%-")) +(defconst vm-mode-line-format-classic + '("" " %&%& " + ("VM: " + (vm-folder-read-only "read-only ") + (vm-virtual-folder-definition (vm-virtual-mirror "mirrored ")) + "%b" + (vm-mail-buffer (vm-ml-sort-keys ("" " by " vm-ml-sort-keys))) + (vm-message-list + (" " vm-ml-message-number + " (of " vm-ml-highest-message-number ")") + (vm-folder-type + " (unrecognized folder type)" + " (no messages)"))) + (vm-spooled-mail-waiting " Mail") + (vm-message-list + (" %[ " vm-ml-message-attributes-alist + (vm-ml-labels ("; " vm-ml-labels)) " %] ") + (" %[%] ")) + "%p" " " global-mode-string)) + +(defconst vm-mode-line-format vm-mode-line-format-classic) + + +(defconst vm-ml-message-attributes-alist + '((vm-ml-message-new + "new" + (vm-ml-message-unread + "unread" + (vm-ml-message-read "read"))) + (vm-ml-message-edited " edited") + (vm-ml-message-filed " filed") + (vm-ml-message-written " written") + (vm-ml-message-replied " replied") + (vm-ml-message-forwarded " forwarded") + (vm-ml-message-redistributed " redistributed") + (vm-ml-message-deleted " deleted") + (vm-ml-message-marked " MARKED"))) +(defvar vm-ml-message-number nil) +(make-variable-buffer-local 'vm-ml-message-number) +(defvar vm-ml-highest-message-number nil) +(make-variable-buffer-local 'vm-ml-highest-message-number) +(defvar vm-ml-sort-keys nil) +(make-variable-buffer-local 'vm-ml-sort-keys) +(defvar vm-ml-labels nil) +(make-variable-buffer-local 'vm-ml-labels) +; unused now +;(defvar vm-ml-attributes-string nil) +;(make-variable-buffer-local 'vm-ml-attributes-string) +(defvar vm-ml-message-new nil) +(make-variable-buffer-local 'vm-ml-message-new) +(defvar vm-ml-message-unread nil) +(make-variable-buffer-local 'vm-ml-message-unread) +(defvar vm-ml-message-read nil) +(make-variable-buffer-local 'vm-ml-message-read) +(defvar vm-ml-message-edited nil) +(make-variable-buffer-local 'vm-ml-message-edited) +(defvar vm-ml-message-replied nil) +(make-variable-buffer-local 'vm-ml-message-replied) +(defvar vm-ml-message-forwarded nil) +(make-variable-buffer-local 'vm-ml-message-forwarded) +(defvar vm-ml-message-redistributed nil) +(make-variable-buffer-local 'vm-ml-message-redistributed) +(defvar vm-ml-message-deleted nil) +(make-variable-buffer-local 'vm-ml-message-deleted) +(defvar vm-ml-message-filed nil) +(make-variable-buffer-local 'vm-ml-message-filed) +(defvar vm-ml-message-written nil) +(make-variable-buffer-local 'vm-ml-message-written) +(defvar vm-ml-message-marked nil) +(make-variable-buffer-local 'vm-ml-message-marked) + +(defcustom vm-remember-passwords-insecurely nil + "If set to `t', VM uses its own storage for remembering passwords +for POP/IMAP accounts, which is insecure." + :group 'vm-folders + :type 'boolean) + +;; to make the tanjed compiler shut up +(defvar vm-pop-read-point nil) +(defvar vm-pop-ok-to-ask nil) +(defvar vm-pop-passwords nil) +;; Keep a list of messages retrieved from the POP maildrops +;; Prune the list when messages are expunged on the server +;; This variable is also used for POP folders, to selectively mark +;; messages that need to be expunged on the server +(defvar vm-pop-retrieved-messages nil) +(make-variable-buffer-local 'vm-pop-retrieved-messages) +;; list of messages to be expunged on the server during the next save +(defvar vm-pop-messages-to-expunge nil) +(make-variable-buffer-local 'vm-pop-messages-to-expunge) + +(defvar vm-imap-read-point nil + "Position in an IMAP process buffer where the next read must +take place. In general, IMAP process reading functions move the +point. No save-excursion's are used. This variable holds the +position for the next read.") +;; Variable indicating whether IMAP session handling functions can ask +;; questions to the user, typically if they are run from interactive +;; commands. +(defvar vm-imap-ok-to-ask nil) +;; Stored passwords for IMAP accounts during a VM session +(defvar vm-imap-passwords nil) +;; Keep a list of messages retrieved from the IMAP maildrops +;; Prune the list when messages are expunged on the server +;; This variable is also used for IMAP folders, to selectively mark +;; messages that need to be expunged on the server +(defvar vm-imap-retrieved-messages nil) +(make-variable-buffer-local 'vm-imap-retrieved-messages) +(defvar vm-imap-messages-to-expunge nil + "Buffer local variable indicating messages to be expunged on the +server. It is a list of pairs containing the UID and the +UIDVALIDITY for each message to be expunged.") +(make-variable-buffer-local 'vm-imap-messages-to-expunge) +(defvar vm-imap-capabilities nil) +(make-variable-buffer-local 'vm-imap-capabilities) +(defvar vm-imap-auth-methods nil) +(make-variable-buffer-local 'vm-imap-auth-methods) +;; The number of old ('failed') trace buffers to remember for debugging +;; purposes +;; These are now subsumed in vm-...-keep-trace-buffer variables. USR, 2011-11 +;; (defvar vm-pop-keep-failed-trace-buffers 20) +;; (defvar vm-imap-keep-failed-trace-buffers 20) +;; Lists of trace buffers remembered for debugging purposes +(defvar vm-kept-pop-buffers nil + "* Variable that holds the old trace buffers of POP sessions for + debugging purposes.") +;; (make-variable-buffer-local 'vm-kept-pop-buffers) +(defvar vm-kept-imap-buffers nil + "* Variable that holds the old trace buffers of IMAP sessions for + debugging purposes.") +;; (make-variable-buffer-local 'vm-kept-imap-buffers) +;; Flag to make POP/IMAP code remember old trace buffers +(defcustom vm-pop-keep-trace-buffer 1 + "* The number of POP session trace buffers that should be + retained for debugging purposes. If it is nil, then no trace + buffers are kept." + :group 'vm-pop + :type '(choice (integer :tag "Number of session buffers kept" + (const :tag "No session buffers kept" nil)))) +(defcustom vm-imap-keep-trace-buffer 1 + "* The number of IMAP session trace buffers that should be + retained for debugging purposes. If it is nil, then no trace + buffers are kept." + :group 'vm-imap + :type '(choice (integer :tag "Number of session buffers kept" + (const :tag "No session buffers kept" nil)))) +(defvar vm-imap-session-done nil) +(defvar vm-reply-list nil + "Buffer local variable in Composition buffers that holds the set of + messages to which this composition is a reply.") +(defvar vm-forward-list nil + "Buffer local variable in Composition buffers that holds the set of + messages that are forwarded in this composition.") +(defvar vm-redistribute-list nil + "Buffer local variable in Composition buffers that holds the set of + messages that are redistributed in this composition.") + +;; For verification of assertions + +(defvar vm-assertion-checking-off t + "* Set this to nil to enable assertion checking") + +;; For verification of the correct buffer protocol +;; Possible values are 'folder, 'presentation, 'summary, 'process + +(defvar vm-buffer-types (cons nil nil)) + +(defvar vm-imap-session-type nil + "This buffer-local variable holds the status of the IMAP session. +Possible values are +'active - active session present +'valid - message sequence numbers are valid + validity is preserved by FETCH, STORE and SEARCH operations +'inactive - session is inactive") +(make-variable-buffer-local 'vm-imap-session-type) + +(eval-when-compile + (defvar current-itimer nil) + (defvar current-menubar nil) + (defvar scrollbar-height nil) + (defvar top-toolbar nil) + (defvar top-toolbar-height nil) + (defvar bottom-toolbar nil) + (defvar bottom-toolbar-height nil) + (defvar right-toolbar nil) + (defvar right-toolbar-width nil) + (defvar left-toolbar nil) + (defvar left-toolbar-width nil)) + +(defvar vm-fsfemacs-toolbar-installed-p nil) +;; this defvar matches the XEmacs one so it doesn't matter if VM +;; is loaded before highlight-headers.el +(defconst highlight-headers-regexp "Subject[ \t]*:") +(defconst vm-url-regexp + "<URL:\\([^>\n]+\\)>\\|\\(\\(file\\|sftp\\|ftp\\|gopher\\|http\\|https\\|news\\|wais\\|www\\)://[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]\\)\\|\\(mailto:[^ \t\n\f\r\"<>|()]*[^] \t\n\f\r\"<>|.!?(){}]\\)\\|\\(file:/[^ \t\n\f\r\"<>|()]*[^ \t\n\f\r\"<>|.!?(){}]\\)" + "Regular expression that matches an absolute URL. +The URL itself must be matched by a \\(..\\) grouping. +VM will extract the URL by copying the lowest number grouping +that has a match.") +(defconst vm-month-alist + '(("jan" "January" "1") + ("feb" "February" "2") + ("mar" "March" "3") + ("apr" "April" "4") + ("may" "May" "5") + ("jun" "June" "6") + ("jul" "July" "7") + ("aug" "August" "8") + ("sep" "September" "9") + ("oct" "October" "10") + ("nov" "November" "11") + ("dec" "December" "12"))) +(defconst vm-weekday-alist + '(("sun" "Sunday" "0") + ("mon" "Monday" "1") + ("tue" "Tuesday" "2") + ("wed" "Wednesday" "3") + ("thu" "Thursday" "4") + ("fri" "Friday" "5") + ("sat" "Saturday" "6"))) +(defvar pop-up-frames nil) +(defvar vm-parse-date-workspace (make-vector 6 nil)) +;; cache so we don't call timezone-make-date-sortable so much. +;; messages have their own cache; this is for the virtual folder +;; alist selectors. +(defvar vm-sortable-date-alist nil) +(make-variable-buffer-local 'vm-sortable-date-alist) +(defvar vm-summary-=> nil) +(defvar vm-summary-no-=> nil) +(defvar vm-summary-overlay nil) +(make-variable-buffer-local 'vm-summary-overlay) +(defvar vm-summary-tokenized-compiled-format-alist nil) +(defvar vm-summary-untokenized-compiled-format-alist nil) +(defvar vm-folders-summary-compiled-format-alist nil) +(defvar vm-folders-summary-overlay nil) +(defvar vm-spool-file-message-count-hash (make-vector 61 0)) +(defvar vm-page-end-overlay nil) +(make-variable-buffer-local 'vm-page-end-overlay) +(defvar vm-begin-glyph-property (if (fboundp 'extent-property) + 'begin-glyph + 'before-string)) +(defvar vm-thread-loop-obarray (make-vector 641 0)) +(defvar vm-delete-duplicates-obarray (make-vector 29 0)) +(defvar vm-image-obarray (make-vector 29 0)) +(defvar vm-mail-mode-map-parented nil) +(defvar vm-xface-cache (make-vector 29 0)) +(defvar vm-mf-default-action nil) +(defvar vm-mime-compiled-format-alist nil) +(defconst vm-mime-default-action-string-alist + ;; old definition + ;; '(("text" . "display text") + ;; ("multipart/alternative" . "display selected part") + ;; ("multipart/digest" . "read digest") + ;; ("multipart/parallel" . "display parts in parallel") + ;; ("multipart" . "display parts") + ;; ("message/partial" . "attempt message assembly") + ;; ("message/external-body" . "retrieve the object") + ;; ("message" . "display message") + ;; ("audio" . "play audio") + ;; ("video" . "display video") + ;; ("image" . "display image") + ;; ("model" . "display model") + ;; ("application/postscript" . "display PostScript") + ;; ("application/msword" . "display Word document") + ;; ("application" . "display attachment")) + + '(("text" . "display") + ("multipart/alternative" . "display selected part") + ("multipart/digest" . "read digest") + ("multipart/parallel" . "display parts in parallel") + ("multipart" . "display parts") + ("message/partial" . "attempt message assembly") + ("message/external-body" . "retrieve") + ("message" . "display") + ("audio" . "play") + ("video" . "play") + ("image" . "display") + ("model" . "display") + ("application" . "display"))) + +(defconst vm-mime-type-description-alist + '(("multipart/digest" . "digest") + ("multipart/alternative" . "multipart alternative") + ("multipart/parallel" . "multipart parallel") + ("multipart" . "multipart message") + ("text/plain" . "plain text") + ("text/enriched" . "enriched text") + ("text/html" . "HTML") + ("text/calendar" . "Calendar event") + ("text/directory" . "VCard") + ("text/x-vcard" . "VCard") + ("image/gif" . "GIF image") + ("image/tiff" . "TIFF image") + ("image/jpeg" . "JPEG image") + ("image/png" . "PNG image") + ("message/rfc822" . "mail message") + ("message/news" . "news article") + ("message/partial" . "message fragment") + ("message/external-body" . "external") + ("application/pdf" . "PDF") + ("application/postscript" . "PostScript") + ("application/msword" . "Document") + ("application/vnd.ms-excel" . "Spreadsheet") + ("application/vnd.ms-powerpoint" . "Presentation") + ("application/vnd-ms-access" . "Database") + ("application/vnd.oasis.opendocument.text" . "Open Doc") + ("application/vnd.oasis.opendocument.presentation" . "Prsentation") + ("application/vnd.oasis.opendocument.spreadsheet" . "Spreadsheet") + ("application/vnd.oasis.opendocument.graphics" . "Graphics") + ("application/vnd.oasis.opendocument.formulae" . "Formulae") + ("application/vnd.oasis.opendocument.databases" . "Database") + ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" + . "Document") + ("application/vnd.openxmlformats-officedocument.wordprocessingml.document" + . "Document") + ("application/vnd.openxmlformats-officedocument.presentationml.presentation" + . "Presentation") + ("application/vnd.openxmlformats-officedocument.presentationml.presentation" + . "Presentation") + ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" + . "Spreadsheet") + ("application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" + . "Spreadsheet") + ("application/x-dvi" . "DVI") + ("application/octet-stream" . "Untyped binary data") + ("application/mac-binhex40" . "Untyped Mac data"))) + +(defconst vm-mime-base64-alphabet + (concat + [ + 65 66 67 68 69 70 71 72 73 74 75 76 77 + 78 79 80 81 82 83 84 85 86 87 88 89 90 + 97 98 99 100 101 102 103 104 105 106 107 108 109 + 110 111 112 113 114 115 116 117 118 119 120 121 122 + 48 49 50 51 52 53 54 55 56 57 43 47 + ] + )) +(defconst vm-mime-base64-alphabet-decoding-vector + [ + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 62 0 0 0 63 + 52 53 54 55 56 57 58 59 60 61 0 0 0 0 0 0 + 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 + 15 16 17 18 19 20 21 22 23 24 25 0 0 0 0 0 + 0 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 + 41 42 43 44 45 46 47 48 49 50 51 0 0 0 0 0 + ]) + +;;(defconst vm-mime-base64-alphabet-decoding-alist +;; '( +;; ( 65 . 00) ( 66 . 01) ( 67 . 02) ( 68 . 03) ( 69 . 04) ( 70 . 05) +;; ( 71 . 06) ( 72 . 07) ( 73 . 08) ( 74 . 09) ( 75 . 10) ( 76 . 11) +;; ( 77 . 12) ( 78 . 13) ( 79 . 14) ( 80 . 15) ( 81 . 16) ( 82 . 17) +;; ( 83 . 18) ( 84 . 19) ( 85 . 20) ( 86 . 21) ( 87 . 22) ( 88 . 23) +;; ( 89 . 24) ( 90 . 25) ( 97 . 26) ( 98 . 27) ( 99 . 28) (100 . 29) +;; (101 . 30) (102 . 31) (103 . 32) (104 . 33) (105 . 34) (106 . 35) +;; (107 . 36) (108 . 37) (109 . 38) (110 . 39) (111 . 40) (112 . 41) +;; (113 . 42) (114 . 43) (115 . 44) (116 . 45) (117 . 46) (118 . 47) +;; (119 . 48) (120 . 49) (121 . 50) (122 . 51) ( 48 . 52) ( 49 . 53) +;; ( 50 . 54) ( 51 . 55) ( 52 . 56) ( 53 . 57) ( 54 . 58) ( 55 . 59) +;; ( 56 . 60) ( 57 . 61) ( 43 . 62) ( 47 . 63) +;; )) +;; +;;(defvar vm-mime-base64-alphabet-decoding-vector +;; (let ((v (make-vector 123 nil)) +;; (p vm-mime-base64-alphabet-decoding-alist)) +;; (while p +;; (aset v (car (car p)) (cdr (car p))) +;; (setq p (cdr p))) +;; v )) + +(defvar vm-message-garbage-alist nil + "An association list of files created for this message and the +actions to be taken to destroy them.") +(make-variable-buffer-local 'vm-message-garbage-alist) +(defvar vm-folder-garbage-alist nil + "An association list of files created for this message and the +actions to be taken to destroy them.") +(make-variable-buffer-local 'vm-folder-garbage-alist) +(defvar vm-global-garbage-alist nil + "An association list of files created for this VM session and the +actions to be taken to destroy them.") +(defconst vm-mime-header-list '("MIME-Version:" "Content-")) +(defconst vm-mime-header-regexp "\\(MIME-Version:\\|Content-\\)") +(defconst vm-mime-mule-charset-to-coding-alist + (cond (vm-fsfemacs-mule-p + (let ((coding-systems (coding-system-list)) + (alist nil) + val) + (while coding-systems + (setq val (coding-system-get (car coding-systems) 'mime-charset)) + (if val + (setq alist (cons (list (symbol-name val) + (car coding-systems)) + alist))) + (setq coding-systems (cdr coding-systems))) + (setq alist (append '(("us-ascii" raw-text) + ("unknown" iso-8859-1)) alist)) + alist)) + (t + '( + ("us-ascii" no-conversion) + ("iso-8859-1" no-conversion) + ("iso-8859-2" iso-8859-2) + ("iso-8859-3" iso-8859-3) + ("iso-8859-4" iso-8859-4) + ("iso-8859-5" iso-8859-5) +; ("iso-8859-6" iso-8859-6) + ("iso-8859-7" iso-8859-7) + ("iso-8859-8" iso-8859-8) + ("iso-8859-8-i" iso-8859-8) + ("iso-8859-9" iso-8859-9) + ("iso-2022-jp" iso-2022-jp) + ("big5" big5) + ("koi8-r" koi8-r) + ("ks_c_5601-1987" euc-kr) + ("euc-jp" euc-jp) + ;; probably not correct, but probably better than nothing. + ("iso-2022-jp-2" iso-2022-jp) + ("iso-2022-int-1" iso-2022-int-1) + ("iso-2022-kr" iso-2022-kr) + ("euc-kr" iso-2022-kr) + ) + )) + "Alist that maps MIME character sets to MULE coding systems. The +information is generated from the 'mime-charset property of coding +systems, if it is defined in the Emacs version. Otherwise, a +default alist is used.") + +(defconst vm-mime-mule-charset-to-charset-alist + '( + (latin-iso8859-1 "iso-8859-1") + (latin-iso8859-2 "iso-8859-2") + (latin-iso8859-3 "iso-8859-3") + (latin-iso8859-4 "iso-8859-4") + (cyrillic-iso8859-5 "iso-8859-5") + (arabic-iso8859-6 "iso-8859-6") + (greek-iso8859-7 "iso-8859-7") + (hebrew-iso8859-8 "iso-8859-8") + (latin-iso8859-9 "iso-8859-9") + (japanese-jisx0208 "iso-2022-jp") + (korean-ksc5601 "iso-2022-kr") + (chinese-gb2312 "iso-2022-jp") + (sisheng "iso-2022-jp") + (thai-tis620 "iso-2022-jp") + ) + "Alist that maps MULE character sets to matching MIME character sets.") + +(defconst vm-mime-mule-coding-to-charset-alist + (cond (vm-fsfemacs-mule-p + (let ((coding-systems (coding-system-list)) + (alist nil) + val) + (while coding-systems + (setq val (coding-system-get (car coding-systems) 'mime-charset)) + (if val + (setq alist (cons (list (car coding-systems) + (symbol-name val)) + alist))) + (setq coding-systems (cdr coding-systems))) + (setq alist (append '((raw-text "us-ascii")) alist)) + alist)) + (t + '( + (iso-2022-8 "iso-2022-jp") + (iso-2022-7-unix "iso-2022-jp") + (iso-2022-7-dos "iso-2022-jp") + (iso-2022-7-mac "iso-2022-jp") + ))) + "Alist that maps MULE coding systems to MIME character sets. The +information is generated from the 'mime-charset property of coding +systems, if it is defined in the Emacs version. Otherwise, a +default alist is used.") + +(defcustom vm-mime-charset-completion-alist + (mapcar (lambda (a) (list (car a))) + vm-mime-mule-charset-to-coding-alist) + "The completion alist of MIME charsets known to VM. The default +information is derived from `vm-mime-mule-charset-to-coding-alist' (which see)." + :group 'vm-mime + :type '(repeat (list string))) + + +(defconst vm-mime-type-completion-alist + '( + ("text/plain") + ("text/enriched") + ("text/html") + ("audio/basic") + ("image/jpeg") + ("image/png") + ("image/gif") + ("image/tiff") + ("video/mpeg") + ("application/postscript") + ("application/octet-stream") + ("message/rfc822") + ("message/news") + )) + +(defconst vm-mime-encoded-word-regexp + "=\\?\\([^?*]+\\)\\(\\*\\([^?*]+\\)\\)?\\?\\([BbQq]\\)\\?\\([^?]+\\)\\?=") + +;; for MS-DOS and Windows NT +;; nil value means text file +;; t value means binary file +;; presumably it controls whether LF -> CRLF mapping is done +;; when writing to files. +(defvar buffer-file-type) +(defvar vm-mf-attachment-file nil) +(defvar vm-frame-list nil) +(if (not (boundp 'shell-command-switch)) + (defvar shell-command-switch "-c")) +(defvar vm-stunnel-random-data-file nil) +(defvar vm-stunnel-configuration-file nil) +(defvar vm-fsfemacs-cached-scroll-bar-width nil) +(defvar vm-update-composition-buffer-name-timer nil) + +(defcustom vm-enable-addons '(check-recipients + check-for-empty-subject + encode-headers) + "*A list of addons to enable, t for all and nil to disable all. +Most addons are from `vm-rfaddons-infect-vm'. + +You must restart VM after a change to cause any effects." + :group 'vm-rfaddons + :type '(set (const :tag "Enable shrinking of multi-line headers to one line." + shrunken-headers) + (const :tag "Open a line when typing in quoted text" + open-line) + (const :tag "Check the recipients before sending a message" + check-recipients) + (const :tag "Check for an empty subject before sending a message" + check-for-empty-subject) + (const :tag "MIME encode headers before sending a message" + encode-headers) + (const :tag "Clean up subject prefixes before sending a message" + clean-subject) + (const :tag "Do not replace Date: header when sending a message" + fake-date) + (const :tag "Bind '.' on attachment buttons to 'vm-mime-take-action-on-attachment'" + take-action-on-attachment) + (const :tag "Automatically save attachments of new messages" + auto-save-all-attachments) + (const :tag "Delete external attachments of a message when expunging it." + auto-delete-message-external-body) + (const :tag "Enable all addons" t))) + +(defcustom vm-summary-enable-faces nil + "A non-NIL value enables the use of faces in the summary buffer. + +You should set this variable in the init-file. For interactive use, +the command `vm-summary-faces-mode' should be used." + :group 'vm-faces + :type 'boolean) + +(defcustom vm-disable-modes-before-encoding + '(auto-fill-mode font-lock-mode ispell-minor-mode flyspell-mode + abbrev-mode adaptive-fill-mode) + "*A list of minor modes to disable before encoding a message. +These modes may slow down (font-lock and *spell) encoding and may +cause trouble (abbrev-mode)." + :group 'vm-compose + :type '(repeat :tag "Mode" symbol)) + +(defvar vm-summary-faces-mode nil + "Records whether VM Summary Faces mode is in use.") + +(make-obsolete-variable 'vm-summary-faces-mode + 'vm-summary-enable-faces "8.2.0") + +;; Duplicate defintion. See above. TX +;; (defcustom vm-mail-mode-hidden-headers '("References" "In-Reply-To" "X-Mailer") +;; "*A list of headers to hide in `vm-mail-mode'." +;; :group 'vm +;; :type '(choice (const :tag "Disabled" nil) +;; (set :tag "Header list" +;; (string "References") +;; (string "In-Reply-To") +;; (string "X-Mailer")))) + +;; define this here so that the user can invoke it right away, if needed. + +(defun vm-load-init-file (&optional init-only) + (interactive "P") + (when (or (not vm-init-file-loaded) (interactive-p)) + (when vm-init-file + (load vm-init-file (not (interactive-p)) (not (interactive-p)) t)) + (when (and vm-preferences-file (not init-only)) + (load vm-preferences-file t t t))) + (setq vm-init-file-loaded t) + (vm-display nil nil '(vm-load-init-file) '(vm-load-init-file))) + +;;; vm-vars.el ends here diff --git a/lisp/vm-vcard.el b/lisp/vm-vcard.el new file mode 100755 index 0000000..2493529 --- /dev/null +++ b/lisp/vm-vcard.el @@ -0,0 +1,91 @@ +;;; vm-vcard.el --- vcard parsing and formatting routines for VM +;; +;; This file is an add-on for VM + +;; Copyright (C) 1997, 2000 Noah S. Friedman + +;; Author: Noah Friedman <friedman@splode.com> +;; Maintainer: friedman@splode.com +;; Keywords: extensions +;; Created: 1997-10-03 + + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, you can either send email to this +;; program's maintainer or write to: The Free Software Foundation, +;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +;;; Commentary: +;;; Code: + +(provide 'vm-vcard) + +(require 'vcard) + +(eval-when-compile + (require 'vm-mime)) + +(and (string-lessp vcard-api-version "2.0") + (error "vm-vcard.el requires vcard API version 2.0 or later.")) + +;;;###autoload +(defvar vm-vcard-format-function nil + "*Function to use for formatting vcards; if nil, use default.") + +;;;###autoload +(defvar vm-vcard-filter nil + "*Filter function to use for formatting vcards; if nil, use default.") + +;;;###autoload +(defun vm-mime-display-internal-text/x-vcard (layout) + (let ((inhibit-read-only t) + (buffer-read-only nil)) + (insert (vm-vcard-format-layout layout))) + t) + +;;;###autoload +(defun vm-mime-display-internal-text/vcard (layout) + (vm-mime-display-internal-text/x-vcard layout)) + +;;;###autoload +(defun vm-mime-display-internal-text/directory (layout) + (vm-mime-display-internal-text/x-vcard layout)) + +(defun vm-vcard-format-layout (layout) + (let* ((beg (vm-mm-layout-body-start layout)) + (end (vm-mm-layout-body-end layout)) + (buf (if (markerp beg) (marker-buffer beg) (current-buffer))) + (raw (vm-vcard-decode (save-excursion + (set-buffer buf) + (save-restriction + (widen) + (buffer-substring beg end))) + layout)) + (vcard-pretty-print-function (or vm-vcard-format-function + vcard-pretty-print-function))) + (vcard-pretty-print (vcard-parse-string raw vm-vcard-filter)))) + +(defun vm-vcard-decode (string layout) + (let ((buf (generate-new-buffer " *vcard decoding*"))) + (save-excursion + (set-buffer buf) + (insert string) + (vm-mime-transfer-decode-region layout (point-min) (point-max)) + (setq string (buffer-substring (point-min) (point-max)))) + (kill-buffer buf)) + string) + +(defun vm-vcard-format-simple (vcard) + (concat "\n\n--\n" (vcard-format-sample-string vcard) "\n\n")) + +;;; vm-vcard.el ends here. diff --git a/lisp/vm-version.el b/lisp/vm-version.el new file mode 100755 index 0000000..d327065 --- /dev/null +++ b/lisp/vm-version.el @@ -0,0 +1,180 @@ +;;; vm-version.el --- Version information about VM and the Emacs running VM. +;; +;; Copyright (C) Kyle E. Jones, Robert Widhopf-Fenk +;; Copyright (C) 2003-2007 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-version) + +;; Don't use vm-device-type here because it may not not be loaded yet. +(declare-function device-type "vm-xemacs" ()) +(declare-function device-matching-specifier-tag-list "vm-xemacs" ()) + + +(defconst vm-version + (condition-case nil + (with-temp-buffer + (insert-file-contents-literally + (expand-file-name + "version.txt" + (and load-file-name (file-name-directory load-file-name)))) + (read (current-buffer))) + (file-error "undefined")) + "Version number of VM.") + +(defun vm-version () + "Return the value of the variable `vm-version'." + (interactive) + (when (interactive-p) + (or (and (stringp vm-version) + (string-match "[0-9]" vm-version)) + (error "Cannot determine VM version!")) + (message "VM version is: %s" vm-version)) + vm-version) + +(defconst vm-xemacs-p + (featurep 'xemacs)) +(defconst vm-xemacs-mule-p + (and vm-xemacs-p (featurep 'mule))) +(defconst vm-xemacs-file-coding-p + (and vm-xemacs-p (featurep 'file-coding) + ;; paranoia + (fboundp + 'set-buffer-file-coding-system))) +(defconst vm-fsfemacs-p + (not vm-xemacs-p)) +(defconst vm-fsfemacs-mule-p + (and (not vm-xemacs-mule-p) (featurep 'mule) + (fboundp 'set-buffer-file-coding-system))) + +(defun vm-xemacs-p () vm-xemacs-p) +(defun vm-xemacs-mule-p () vm-xemacs-mule-p) +(defun vm-xemacs-file-coding-p () vm-xemacs-file-coding-p) +(defun vm-fsfemacs-p () vm-fsfemacs-p) +(defun vm-fsfemacs-mule-p () vm-fsfemacs-mule-p) + +(defun vm-emacs-mule-p () + (or vm-xemacs-mule-p vm-fsfemacs-mule-p)) + +(defun vm-mouse-fsfemacs-mouse-p () + (and vm-fsfemacs-p + (fboundp 'set-mouse-position))) + +(defun vm-mouse-xemacs-mouse-p () + (and vm-xemacs-p + (fboundp 'set-mouse-position))) + +(defun vm-menu-fsfemacs-menus-p () + (and vm-fsfemacs-p + (fboundp 'menu-bar-mode))) + +(defun vm-menu-fsfemacs19-menus-p () + (and vm-fsfemacs-p + (fboundp 'menu-bar-mode) + (= emacs-major-version 19))) + +(defun vm-menu-xemacs-menus-p () + (and vm-xemacs-p + (fboundp 'set-buffer-menubar))) + +(defun vm-menu-can-eval-item-name () + (and vm-xemacs-p + (fboundp 'check-menu-syntax) + (condition-case nil + (check-menu-syntax '("bar" ((identity "foo") 'ding t))) + (error nil)))) + +(defun vm-multiple-frames-possible-p () + (cond (vm-xemacs-p + (or (memq 'win (device-matching-specifier-tag-list)) + (featurep 'tty-frames))) + (vm-fsfemacs-p + (fboundp 'make-frame)))) + +(defun vm-mouse-support-possible-p () + (cond (vm-xemacs-p + (featurep 'window-system)) + (vm-fsfemacs-p + (fboundp 'track-mouse)))) + +(defun vm-mouse-support-possible-here-p () + (cond (vm-xemacs-p + (memq 'win (device-matching-specifier-tag-list))) + (vm-fsfemacs-p + (memq window-system '(x mac w32 win32))))) + +(defun vm-menu-support-possible-p () + (cond (vm-xemacs-p + (featurep 'menubar)) + (vm-fsfemacs-p + (fboundp 'menu-bar-mode)))) + +(defun vm-menubar-buttons-possible-p () + "Menubar buttons are menus that have an immediate action. Some +Windowing toolkits do not allow such buttons. This says whether such +buttons are possible under the current windowing system." + (not + (cond (vm-xemacs-p (memq (device-type) '(gtk ns))) + (vm-fsfemacs-p (or (and (eq window-system 'x) (featurep 'gtk)) + (eq window-system 'ns)))))) + +(defun vm-toolbar-support-possible-p () + (or (and vm-xemacs-p (featurep 'toolbar)) + (and vm-fsfemacs-p (fboundp 'tool-bar-mode) (boundp 'tool-bar-map)))) + +(defun vm-multiple-fonts-possible-p () + (cond (vm-xemacs-p + (memq (device-type) '(x gtk mswindows))) + (vm-fsfemacs-p + (memq window-system '(x mac w32 win32))))) + +(defun vm-images-possible-here-p () + (or (and vm-xemacs-p (memq (device-type) '(x gtk mswindows))) + (and vm-fsfemacs-p window-system + (or (fboundp 'image-type-available-p) + (and (stringp vm-imagemagick-convert-program) + (stringp vm-imagemagick-identify-program)))))) + +(defun vm-image-type-available-p (type) + (if (fboundp 'image-type-available-p) + (image-type-available-p type) + (or (featurep type) (eq type 'xbm)))) + +(defun vm-load-features (feature-list &optional silent) + "Try to load those features listed in FEATURE_LIST. +If SILENT is t, do not display warnings for unloadable features. +Return the list of loaded features." + (setq feature-list + (mapcar (lambda (f) + (condition-case nil + (progn (require f) + f) + (error + (if (load (format "%s" f) t) + f + (when (not silent) + (message "WARNING: Could not load feature %S." f) + ;; (sit-for 1) + (message "WARNING: Related functions may not work correctly!") + ;; (sit-for 1) + ) + nil)))) + feature-list)) + (delete nil feature-list)) + +;;; vm-version.el ends here diff --git a/lisp/vm-virtual.el b/lisp/vm-virtual.el new file mode 100755 index 0000000..8b6cb37 --- /dev/null +++ b/lisp/vm-virtual.el @@ -0,0 +1,1160 @@ +;;; vm-virtual.el --- Virtual folders for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1990-1997 Kyle E. Jones +;; Copyright (C) 2000-2006 Robert Widhopf-Fenk +;; Copyright (C) 2011 Uday S. Reddy +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-virtual) + +(eval-when-compile + (require 'vm-misc) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-summary) + (require 'vm-folder) + (require 'vm-window) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-save) + (require 'vm-reply) + (require 'vm-sort) + (require 'vm-thread) +) + +(declare-function vm-visit-folder "vm" + (folder &optional read-only revisit)) +(declare-function vm-visit-virtual-folder "vm" + (folder &optional read-only bookmark)) +(declare-function vm-mode "vm" + (&optional read-only)) +(declare-function vm-get-folder-buffer "vm" + (folder)) + + +;;;###autoload +(defun vm-build-virtual-message-list (new-messages &optional dont-finalize) + "Builds a list of messages matching the virtual folder definition +stored in the variable `vm-virtual-folder-definition'. + +If the NEW-MESSAGES argument is nil, the message list is +derived from the folders listed in the virtual folder +definition and selected by the various selectors. The +resulting message list is assigned to `vm-message-list' unless +DONT-FINALIZE is non-nil. + +If NEW-MESSAGES is non-nil then it is a list of messages to +be tried against the selector parts of the virtual folder +definition. Matching messages are added to `vm-message-list', +instead of replacing it. + +The messages in the NEW-MESSAGES list, if any, must all be in the +same real folder. + +The list of matching virtual messages is returned. + +If DONT-FINALIZE is nil, in addition to `vm-message-list' being +set, the virtual messages are added to the virtual message +lists of their real messages, the current buffer is added to +`vm-virtual-buffers' list of each real folder buffer represented +in the virtual list, and `vm-real-buffers' is set to a list of +all the real folder buffers involved." + (let ((clauses (cdr vm-virtual-folder-definition)) + (message-set (make-vector 311 0)) + (vbuffer (current-buffer)) + (mirrored vm-virtual-mirror) + (case-fold-search t) + (tail-cons (if dont-finalize nil (vm-last vm-message-list))) + (new-message-list nil) + virtual location-vector + message folders folder buffer + selectors sel-list selector arglist i + real-buffers-used components) + (if dont-finalize + nil + ;; Since there is at most one virtual message in the folder + ;; buffer of a virtual folder, the location data vector (and + ;; the markers in it) of all virtual messages in a virtual + ;; folder is shared. We initialize the vector here if it + ;; hasn't been created already. + (if vm-message-list + (setq location-vector + (vm-location-data-of (car vm-message-pointer))) + (setq i 0 + location-vector + (make-vector vm-location-data-vector-length nil)) + (while (< i vm-location-data-vector-length) + (aset location-vector i (vm-marker nil)) + (vm-increment i))) + ;; To keep track of the messages in a virtual folder to + ;; prevent duplicates we create and maintain a set that + ;; contain all the real messages. + (dolist (m vm-message-list) + (intern (vm-message-id-number-of (vm-real-message-of m)) + message-set))) + ;; now select the messages + (save-excursion + (dolist (clause clauses) + (setq folders (car clause) + selectors (cdr clause)) + (while folders ; folders can change below + (setq folder (car folders)) + (cond ((and (stringp folder) + (vm-pop-folder-spec-p folder)) + ;; POP folder, fine + nil) + ((and (stringp folder) + (vm-imap-folder-spec-p folder)) + ;; IMAP folder, fine + nil) + ((stringp folder) + ;; Local folder, use full path + (setq folder (expand-file-name folder vm-folder-directory))) + ((listp folder) + ;; Sexpr, eval it + (setq folder (eval folder)))) + (cond + ((null folder) + ;; folder was a s-expr which returned nil + ;; skip it + nil ) + ((and (stringp folder) (file-directory-p folder)) + ;; an entire directory! + (setq folders (nconc folders + (vm-delete-backup-file-names + (vm-delete-auto-save-file-names + (vm-delete-directory-file-names + (directory-files folder t nil))))))) + ((or (null new-messages) + ;; If we're assimilating messages into an + ;; existing virtual folder, only allow selectors + ;; that would be normally applied to this folder. + (and (bufferp folder) + (eq (vm-buffer-of (car new-messages)) folder)) + (and (stringp folder) + (eq (vm-buffer-of (car new-messages)) + ;; letter bomb protection + ;; set inhibit-local-variables to t for v18 Emacses + ;; set enable-local-variables to nil + ;; for newer Emacses + (let ((inhibit-local-variables t) + (coding-system-for-read + (vm-binary-coding-system)) + (enable-local-eval nil) + (enable-local-variables nil) + (vm-frame-per-folder nil) + (vm-verbosity (1- vm-verbosity))) + (vm-visit-folder folder nil t) + (vm-select-folder-buffer) + (current-buffer))))) + + ;; Check if the folder is already visited, or visit it + (cond ((bufferp folder) + (setq buffer folder) + (setq components (cons (cons buffer nil) components)) + (set-buffer folder)) + ((setq buffer (vm-get-folder-buffer folder)) + (setq components (cons (cons buffer nil) components)) + (set-buffer buffer)) + (t + (let ((inhibit-local-variables t) + (coding-system-for-read + (vm-binary-coding-system)) + (enable-local-eval nil) + (enable-local-variables nil) + (vm-frame-per-folder nil) + (vm-verbosity (1- vm-verbosity))) + (vm-visit-folder folder nil t) + (vm-select-folder-buffer) + (setq buffer (current-buffer)) + (setq components (cons (cons buffer t) components)) + (set-buffer buffer)))) + (if (eq major-mode 'vm-virtual-mode) + (setq virtual t + real-buffers-used + (append vm-real-buffers real-buffers-used)) + (setq virtual nil) + (unless (memq (current-buffer) real-buffers-used) + (setq real-buffers-used (cons (current-buffer) + real-buffers-used))) + (unless (eq major-mode 'vm-mode) + (vm-mode))) + + ;; change (sexpr) into ("/file" "/file2" ...) + ;; this assumes that there will never be (sexpr sexpr2) + ;; in a virtual folder spec. + ;; But why are we doing this? This is ugly and + ;; error-prone, and breaks things for server folders! + ;; USR, 2010-09-20 + ;; (when (bufferp folder) + ;; (if virtual + ;; (setcar (car clauses) + ;; (delq nil + ;; (mapcar 'buffer-file-name vm-real-buffers))) + ;; (if buffer-file-name + ;; (setcar (car clauses) (list buffer-file-name))))) + + ;; if new-messages non-nil use it instead of the + ;; whole message list + (dolist (m (or new-messages vm-message-list)) + (when (and (or dont-finalize + (not (intern-soft + (vm-message-id-number-of + (vm-real-message-of m)) + message-set))) + (if virtual + (save-excursion + (set-buffer + (vm-buffer-of (vm-real-message-of m))) + (apply 'vm-vs-or m selectors)) + (apply 'vm-vs-or m selectors))) + (when (and vm-virtual-debug + (member (vm-su-message-id m) + vm-traced-message-ids)) + (debug "vm-build-virtual-message-list" m) + (apply 'vm-vs-or m selectors)) + (unless dont-finalize + (intern + (vm-message-id-number-of (vm-real-message-of m)) + message-set)) + (setq message (copy-sequence (vm-real-message-of m))) + (unless mirrored + (vm-set-mirror-data-of + message (make-vector vm-mirror-data-vector-length nil)) + (vm-set-virtual-messages-sym-of + message (make-symbol "<v>")) + (vm-set-virtual-messages-of message nil) + (vm-set-attributes-of + message (make-vector vm-attributes-vector-length nil))) + (vm-set-location-data-of message location-vector) + (vm-set-softdata-of + message (make-vector vm-softdata-vector-length nil)) + (if (eq m (symbol-value (vm-mirrored-message-sym-of m))) + (vm-set-mirrored-message-sym-of + message (vm-mirrored-message-sym-of m)) + (let ((sym (make-symbol "<<>>"))) + (set sym m) + (vm-set-mirrored-message-sym-of message sym))) + (vm-set-real-message-sym-of + message (vm-real-message-sym-of m)) + (vm-set-message-type-of message vm-folder-type) + (vm-set-message-access-method-of + message vm-folder-access-method) + (vm-set-message-id-number-of + message vm-message-id-number) + (vm-increment vm-message-id-number) + (vm-set-buffer-of message vbuffer) + (vm-set-reverse-link-sym-of message (make-symbol "<--")) + (vm-set-reverse-link-of message tail-cons) + (if (null tail-cons) + (setq new-message-list (list message) + tail-cons new-message-list) + (setcdr tail-cons (list message)) + (if (null new-message-list) + (setq new-message-list (cdr tail-cons))) + (setq tail-cons (cdr tail-cons))))))) + (setq folders (cdr folders))))) + (if dont-finalize + new-message-list + ;; this doesn't need to work currently, but it might someday + ;; (if virtual + ;; (setq real-buffers-used (vm-delete-duplicates real-buffers-used))) + (vm-increment vm-modification-counter) + ;; Until this point the user doesn't really have a virtual + ;; folder, as the virtual messages haven't been linked to the + ;; real messages, virtual buffers to the real buffers, and no + ;; message list has been installed. + ;; + ;; Now we tie it all together, with this section of code being + ;; uninterruptible. + (let ((inhibit-quit t) + (label-obarray vm-label-obarray)) + (unless vm-real-buffers + (setq vm-real-buffers real-buffers-used)) + (unless vm-component-buffers + (setq vm-component-buffers components)) + (save-excursion + (dolist (real-buffer real-buffers-used) + (set-buffer real-buffer) + ;; inherit the global label lists of all the associated + ;; real folders. + (mapatoms (function (lambda (x) (intern (symbol-name x) + label-obarray))) + vm-label-obarray) + (unless (memq vbuffer vm-virtual-buffers) + (setq vm-virtual-buffers (cons vbuffer + vm-virtual-buffers))))) + (dolist (m new-message-list) + (vm-set-virtual-messages-of + (vm-real-message-of m) + (cons m (vm-virtual-messages-of (vm-real-message-of m))))) + (if vm-message-list + (when new-message-list + (vm-set-summary-redo-start-point new-message-list) + (vm-set-numbering-redo-start-point new-message-list)) + (vm-set-summary-redo-start-point t) + (vm-set-numbering-redo-start-point t) + (setq vm-message-list new-message-list)) + new-message-list )))) + +;;;###autoload +(defun vm-create-virtual-folder (selector &optional arg read-only name + bookmark) + "Create a new virtual folder from messages in the current folder. +The messages will be chosen by applying the selector you specify, +which is normally read from the minibuffer. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (save-current-buffer + (vm-select-folder-buffer) + (nconc (vm-read-virtual-selector "Create virtual folder of messages: ") + (list prefix))))) + + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (if vm-folder-read-only (setq read-only t)) + (let ((use-marks (eq last-command 'vm-next-command-uses-marks)) + (parent-summary-format vm-summary-format) + vm-virtual-folder-alist ; shadow the global variable + clause + ) + (unless name + (if arg + (setq name (format "%s %s %s" (buffer-name) selector arg)) + (setq name (format "%s %s" (buffer-name) selector)))) + (setq clause (if arg (list selector arg) (list selector))) + (if use-marks + (setq clause (list 'and '(marked) clause))) + (setq vm-virtual-folder-alist + `(( ,name (((get-buffer ,(buffer-name))) ,clause)))) + (vm-visit-virtual-folder name read-only bookmark) + (setq vm-summary-format parent-summary-format)) + ;; have to do this again here because the known virtual + ;; folder menu is now hosed because we installed it while + ;; vm-virtual-folder-alist was bound to the temp value above + (when vm-use-menus + (vm-menu-install-known-virtual-folders-menu))) + +(defalias 'vm-create-search-folder 'vm-create-virtual-folder) + +;;;###autoload +(defun vm-create-virtual-folder-of-threads (selector &optional arg + read-only name + bookmark) + "Create a new virtual folder of threads in the current folder. +The threads will be chosen by applying the selector you specify, +which is normally read from the minibuffer. If any message in a +thread matches the selector then the thread is chosen. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (save-current-buffer + (vm-select-folder-buffer) + (nconc (vm-read-virtual-selector "Create virtual folder of threads: ") + (list prefix))))) + + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (vm-build-threads-if-unbuilt) + (let ((use-marks (eq last-command 'vm-next-command-uses-marks)) + (parent-summary-format vm-summary-format) + vm-virtual-folder-alist ; shadow the global variable + clause + ) + (unless name + (if arg + (setq name (format "%s %s %s" (buffer-name) selector arg)) + (setq name (format "%s %s" (buffer-name) selector)))) + (setq clause + (if arg + (list 'thread (list selector arg)) + (list 'thread (list selector)))) + (if use-marks + (setq clause (list 'and '(marked) clause))) + (setq vm-virtual-folder-alist + `(( ,name (((get-buffer ,(buffer-name))) ,clause)))) + (vm-visit-virtual-folder name read-only bookmark) + (setq vm-summary-format parent-summary-format)) + ;; have to do this again here because the known virtual + ;; folder menu is now hosed because we installed it while + ;; vm-virtual-folder-alist was bound to the temp value above + (when vm-use-menus + (vm-menu-install-known-virtual-folders-menu))) + + +;;;###autoload +(defun vm-apply-virtual-folder (name &optional read-only) + "Apply the selectors of a named virtual folder to the current folder +and create a virtual folder containing the selected messages. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (list + (completing-read "Apply this virtual folder's selectors: " + vm-virtual-folder-alist nil t) + current-prefix-arg))) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let ((vfolder (assoc name vm-virtual-folder-alist)) + (use-marks (eq last-command 'vm-next-command-uses-marks)) + clauses vm-virtual-folder-alist) + (or vfolder (error "No such virtual folder, %s" name)) + (setq vfolder (vm-copy vfolder)) + (setq clauses (cdr vfolder)) + (while clauses + (setcar (car clauses) (list (list 'get-buffer (buffer-name)))) + (if use-marks + (setcdr (car clauses) + (list (list 'and '(marked) + (nconc (list 'or) (cdr (car clauses))))))) + (setq clauses (cdr clauses))) + (setcar vfolder (format "%s/%s" (buffer-name) (car vfolder))) + (setq vm-virtual-folder-alist (list vfolder)) + (vm-visit-virtual-folder (car vfolder) read-only)) + ;; have to do this again here because the "known virtual + ;; folder" menu is now hosed because we installed it while + ;; vm-virtual-folder-alist was bound to the temp value above + (if vm-use-menus + (vm-menu-install-known-virtual-folders-menu))) + +;;;###autoload +(defun vm-create-virtual-folder-same-subject () + "Create a virtual folder (search folder) for all messages with +the same subject as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let* ((subject (vm-so-sortable-subject (car vm-message-pointer))) + (displayed-subject subject) + (bookmark (if (vm-virtual-message-p (car vm-message-pointer)) + (vm-real-message-of (car vm-message-pointer)) + (car vm-message-pointer)))) + (if (equal subject "") + (setq subject "^$" + displayed-subject "\"\"") + (setq subject (regexp-quote subject))) + (vm-create-virtual-folder + 'sortable-subject subject nil + (format "%s %s %s" (buffer-name) 'subject displayed-subject) bookmark))) + +;;;###autoload +(defun vm-create-virtual-folder-same-author () + "Create a virtual folder (search folder) for all messages from the +same author as the current message." + (interactive) + (vm-follow-summary-cursor) + (vm-select-folder-buffer-and-validate 1 (vm-interactive-p)) + (let* ((author (vm-su-from (car vm-message-pointer))) + (displayed-author author) + (bookmark (if (vm-virtual-message-p (car vm-message-pointer)) + (vm-real-message-of (car vm-message-pointer)) + (car vm-message-pointer)))) + (if (equal author "") + (setq author "^$" + displayed-author "<none>") + (setq author (regexp-quote author))) + (vm-create-virtual-folder + 'author author nil + (format "%s %s %s" (buffer-name) 'author displayed-author) bookmark))) + +;;;###autoload +(defun vm-create-author-virtual-folder (&optional arg read-only name) + "Create a virtual folder (search folder) of messages with the given +author in the current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-string "Virtual folder of author/recipient: ") + prefix))) + (vm-create-virtual-folder 'author arg read-only name)) + +;;;###autoload +(defun vm-create-author-or-recipient-virtual-folder (&optional arg read-only name) + "Create a virtual folder (search folder) with given author or +recipient from messages in the current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-string "Virtual folder of author/recipient: ") + prefix))) + (vm-create-virtual-folder 'author-or-recipient arg read-only name)) + +;;;###autoload +(defun vm-create-subject-virtual-folder (&optional arg read-only subject) + "Create a virtual folder (search folder) with given subject from +messages in the current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-string "Virtual folder of subject: ") + prefix))) + (vm-create-virtual-folder 'subject arg read-only subject)) + +;;;###autoload +(defun vm-create-text-virtual-folder (&optional arg read-only subject) + "Create a virtual folder (search folder) of all messsages with the +given string in its text. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-string "Virtual folder of subject: ") + prefix))) + (vm-create-virtual-folder 'text arg read-only subject)) + +;;;###autoload +(defun vm-create-date-virtual-folder (&optional arg read-only subject) + "Create a virtual folder (search folder) of all messsages with date +in given range. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-number "Virtual folder of date in days: ") + prefix))) + (vm-create-virtual-folder 'newer-than arg read-only subject)) + +;;;###autoload +(defun vm-create-label-virtual-folder (&optional arg read-only name) + "Create a virtual folder with given label from messages in the +current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list (read-string "Virtual folder of label: ") + prefix))) + (vm-create-virtual-folder 'label arg read-only name)) + +;;;###autoload +(defun vm-create-flagged-virtual-folder (&optional read-only name) + "Create a virtual folder (search folder) with all the flagged +messages in the current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list prefix))) + (vm-create-virtual-folder 'flagged read-only name)) + +;;;###autoload +(defun vm-create-new-virtual-folder (&optional read-only name) + "Create a virtual folder (search folder) of all newly received +messages in the current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list prefix))) + (vm-create-virtual-folder 'new read-only name)) + +;;;###autoload +(defun vm-create-unseen-virtual-folder (&optional read-only name) + "Create a virtual folder (search folder) of all unseen from messages in the +current folder. + +Prefix arg means the new virtual folder should be visited read only." + (interactive + (let ((last-command last-command) + (this-command this-command) + (prefix current-prefix-arg)) + (vm-select-folder-buffer) + (list prefix))) + (vm-create-virtual-folder 'unseen read-only name)) + + +(defun vm-toggle-virtual-mirror () + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (not (eq major-mode 'vm-virtual-mode)) + (error "This is not a virtual folder.")) + (let ((mp vm-message-list) + (inhibit-quit t) + modified undo-list) + (setq undo-list vm-saved-undo-record-list + vm-saved-undo-record-list vm-undo-record-list + vm-undo-record-list undo-list + vm-undo-record-pointer undo-list) + (setq modified vm-saved-buffer-modified-p + vm-saved-buffer-modified-p (buffer-modified-p)) + (set-buffer-modified-p modified) + (if vm-virtual-mirror + (while mp + (vm-set-attributes-of + (car mp) (or (vm-saved-virtual-attributes-of (car mp)) + (make-vector vm-attributes-vector-length nil))) + (vm-set-mirror-data-of + (car mp) (or (vm-saved-virtual-mirror-data-of (car mp)) + (make-vector vm-mirror-data-vector-length nil))) + (vm-mark-for-summary-update (car mp) t) + (setq mp (cdr mp))) + (while mp + ;; mark for summary update _before_ we set this message to + ;; be mirrored. this will prevent the real message and + ;; the other messages that will share attributes with + ;; this message from having their summaries + ;; updated... they don't need it. + (vm-mark-for-summary-update (car mp) t) + (vm-set-saved-virtual-attributes-of + (car mp) (vm-attributes-of (car mp))) + (vm-set-saved-virtual-mirror-data-of + (car mp) (vm-mirror-data-of (car mp))) + (vm-set-attributes-of + (car mp) (vm-attributes-of (vm-real-message-of (car mp)))) + (vm-set-mirror-data-of + (car mp) (vm-mirror-data-of (vm-real-message-of (car mp)))) + (setq mp (cdr mp)))) + (setq vm-virtual-mirror (not vm-virtual-mirror)) + (vm-increment vm-modification-counter)) + (vm-update-summary-and-mode-line) + (vm-inform 5 "Virtual folder now %s the underlying real folder%s." + (if vm-virtual-mirror "mirrors" "does not mirror") + (if (cdr vm-real-buffers) "s" ""))) + +;;;###autoload +(defun vm-virtual-help () +(interactive) + (vm-display nil nil '(vm-virtual-help) '(vm-virtual-help)) + (vm-inform 0 "VV = visit, VX = apply selectors, VC = create, VM = toggle virtual mirror")) + +(defun vm-vs-or (m &rest selectors) + (let ((result nil) selector arglist function) + (while selectors + (setq selector (car (car selectors)) + function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (setq arglist (cdr (car selectors)) + arglist (cdr (car selectors)) + result (apply function m arglist) + selectors (if result nil (cdr selectors)))) + result )) + +(defun vm-vs-and (m &rest selectors) + (let ((result t) selector arglist function) + (while selectors + (setq selector (car (car selectors)) + function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (setq arglist (cdr (car selectors)) + result (apply function m arglist) + selectors (if (null result) nil (cdr selectors)))) + result )) + +(defun vm-vs-not (m arg) + (let ((selector (car arg)) + (arglist (cdr arg)) + function) + (setq function (cdr (assq selector vm-virtual-selector-function-alist))) + (if (null function) + (error "Invalid virtual selector: %s" selector)) + (not (apply function m arglist)))) + +(defun vm-vs-sexp (m arg) + (vm-vs-and m arg)) + +(defun vm-vs-any (m) t) + +(defun vm-vs-thread (m arg) + (let ((selector (car arg)) + (arglist (cdr arg)) + (root (vm-thread-root m)) + tree function) + (setq tree (vm-thread-subtree root)) + (setq function (cdr (assq selector vm-virtual-selector-function-alist))) + (vm-find tree + (lambda (m) + (apply function m arglist))))) + +(defun vm-vs-thread-all (m arg) + (let ((selector (car arg)) + (arglist (cdr arg)) + (root (vm-thread-root m)) + tree function) + (setq tree (vm-thread-subtree root)) + (setq function (cdr (assq selector vm-virtual-selector-function-alist))) + (vm-for-all tree + (lambda (m) + (apply function m arglist))))) + +(defun vm-vs-author (m arg) + (or (string-match arg (vm-su-full-name m)) + (string-match arg (vm-su-from m)))) + +(defun vm-vs-recipient (m arg) + (or (string-match arg (vm-su-to m)) + (string-match arg (vm-su-to-names m)))) + +(defun vm-vs-author-or-recipient (m arg) + (or (vm-vs-author m arg) + (vm-vs-recipient m arg))) + +(defun vm-vs-subject (m arg) + (string-match arg (vm-su-subject m))) + +(defun vm-vs-sortable-subject (m arg) + (string-match arg (vm-so-sortable-subject m))) + +(defun vm-vs-sent-before (m arg) + (string< (vm-so-sortable-datestring m) (vm-timezone-make-date-sortable arg))) + +(defun vm-vs-sent-after (m arg) + (string< (vm-timezone-make-date-sortable arg) (vm-so-sortable-datestring m))) + +(defun vm-vs-older-than (m arg) + (let ((date (vm-get-header-contents m "Date:"))) + (if date + (> (days-between (current-time-string) date) arg)))) + +(defun vm-vs-newer-than (m arg) + (let ((date (vm-get-header-contents m "Date:"))) + (if date + (<= (days-between (current-time-string) date) arg)))) + +(defun vm-vs-outgoing (m) + (and vm-summary-uninteresting-senders + (or (string-match vm-summary-uninteresting-senders (vm-su-full-name m)) + (string-match vm-summary-uninteresting-senders (vm-su-from m))))) + +(defun vm-vs-uninteresting-senders (m) + (string-match vm-summary-uninteresting-senders + (vm-get-header-contents m "From:"))) + +(defun vm-vs-attachment (m) + (or (vm-attachments-flag m) + (vm-vs-text m vm-vs-attachment-regexp))) + +(defun vm-vs-spam-word (m &optional selector) + (if (and (not vm-spam-words) + vm-spam-words-file + (file-readable-p vm-spam-words-file) + (not (get-file-buffer vm-spam-words-file))) + (save-excursion + (set-buffer (find-file-noselect vm-spam-words-file)) + (goto-char (point-min)) + (while (re-search-forward "^\\s-*\\([^#;].*\\)\\s-*$" (point-max) t) + (setq vm-spam-words (cons (match-string 1) vm-spam-words))) + (setq vm-spam-words-regexp (regexp-opt vm-spam-words)))) + (if (and m vm-spam-words-regexp) + (let ((case-fold-search t)) + (cond ((eq selector 'header) + (vm-vs-header m vm-spam-words-regexp)) + ((eq selector 'header-or-text) + (vm-vs-header-or-text m vm-spam-words-regexp)) + (t + (vm-vs-text m vm-spam-words-regexp)))))) + +(defun vm-vs-spam-score (m min &optional max) + "True when the spam score is >= MIN and optionally <= MAX. +The headers that will be checked are those listed in +`vm-vs-spam-score-headers'." + (let ((spam-headers vm-vs-spam-score-headers) + it-is-spam) + (while spam-headers + (let* ((spam-selector (car spam-headers)) + (score (vm-get-header-contents m (car spam-selector)))) + (when (and score (string-match (nth 1 spam-selector) score)) + (setq score (funcall (nth 2 spam-selector) (match-string 0 score))) + (if (and (<= min score) (or (null max) (<= score max))) + (setq it-is-spam t spam-headers nil)))) + (setq spam-headers (cdr spam-headers))) + it-is-spam)) + +(defun vm-vs-header (m arg) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-headers-of (vm-real-message-of m))) + (re-search-forward arg (vm-text-of (vm-real-message-of m)) t)))) + +(defun vm-vs-header-field (m field arg) + (let ((header (vm-get-header-contents m field))) + (string-match arg header))) + +(defun vm-vs-uid (m arg) + (equal (vm-imap-uid-of m) arg)) + +(defun vm-vs-uidl (m arg) + (equal (vm-pop-uidl-of m) arg)) + +(defun vm-vs-message-id (m arg) + (equal (vm-su-message-id m) arg)) + +(defun vm-vs-label (m arg) + (vm-member arg (vm-labels-of m))) + +(defun vm-vs-text (m arg) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-text-of (vm-real-message-of m))) + (re-search-forward arg (vm-text-end-of (vm-real-message-of m)) t)))) + +(defun vm-vs-header-or-text (m arg) + (save-excursion + (save-restriction + (widen) + (goto-char (vm-headers-of (vm-real-message-of m))) + (re-search-forward arg (vm-text-end-of (vm-real-message-of m)) t)))) + +(defun vm-vs-more-chars-than (m arg) + (> (string-to-number (vm-su-byte-count m)) arg)) + +(defun vm-vs-less-chars-than (m arg) + (< (string-to-number (vm-su-byte-count m)) arg)) + +(defun vm-vs-more-lines-than (m arg) + (> (string-to-number (vm-su-line-count m)) arg)) + +(defun vm-vs-less-lines-than (m arg) + (< (string-to-number (vm-su-line-count m)) arg)) + +(defun vm-vs-virtual-folder-member (m) + (vm-virtual-messages-of m)) + +(defun vm-vs-new (m) (vm-new-flag m)) +(fset 'vm-vs-recent 'vm-vs-new) +(defun vm-vs-unread (m) (vm-unread-flag m)) +(fset 'vm-vs-unseen 'vm-vs-unread) +(defun vm-vs-read (m) (not (or (vm-new-flag m) (vm-unread-flag m)))) +(defun vm-vs-flagged (m) (vm-flagged-flag m)) +(defun vm-vs-unflagged (m) (not (vm-flagged-flag m))) +(defun vm-vs-deleted (m) (vm-deleted-flag m)) +(defun vm-vs-replied (m) (vm-replied-flag m)) +(fset 'vm-vs-answered 'vm-vs-replied) +(defun vm-vs-forwarded (m) (vm-forwarded-flag m)) +(defun vm-vs-redistributed (m) (vm-redistributed-flag m)) +(defun vm-vs-filed (m) (vm-filed-flag m)) +(defun vm-vs-written (m) (vm-written-flag m)) +(defun vm-vs-marked (m) (vm-mark-of m)) +(defun vm-vs-edited (m) (vm-edited-flag m)) + +(defun vm-vs-undeleted (m) (not (vm-deleted-flag m))) +(defun vm-vs-unreplied (m) (not (vm-replied-flag m))) +(fset 'vm-vs-unanswered 'vm-vs-unreplied) +(defun vm-vs-unforwarded (m) (not (vm-forwarded-flag m))) +(defun vm-vs-unredistributed (m) (not (vm-redistributed-flag m))) +(defun vm-vs-unfiled (m) (not (vm-filed-flag m))) +(defun vm-vs-unwritten (m) (not (vm-written-flag m))) +(defun vm-vs-unmarked (m) (not (vm-mark-of m))) +(defun vm-vs-unedited (m) (not (vm-edited-flag m))) +(defun vm-vs-expanded (m) (vm-expanded-root-p m)) +(defun vm-vs-collapsed (m) (vm-collapsed-root-p m)) + + +(put 'sexp 'vm-virtual-selector-clause "matching S-expression selector") +(put 'eval 'vm-virtual-selector-clause "giving true for expression") +(put 'header 'vm-virtual-selector-clause "with header matching") +(put 'label 'vm-virtual-selector-clause "with label of") +(put 'uid 'vm-virtual-selector-clause "with IMAP UID of") +(put 'uidl 'vm-virtual-selector-clause "with POP UIDL of") +(put 'message-id 'vm-virtual-selector-clause "with Message ID of") +(put 'text 'vm-virtual-selector-clause "with text matching") +(put 'header-or-text 'vm-virtual-selector-clause + "with header or text matching") +(put 'recipient 'vm-virtual-selector-clause "with recipient matching") +(put 'author-or-recipient 'vm-virtual-selector-clause + "with author or recipient matching") +(put 'author 'vm-virtual-selector-clause "with author matching") +(put 'subject 'vm-virtual-selector-clause "with subject matching") +(put 'sent-before 'vm-virtual-selector-clause "sent before") +(put 'sent-after 'vm-virtual-selector-clause "sent after") +(put 'older-than 'vm-virtual-selector-clause "days older than") +(put 'newer-than 'vm-virtual-selector-clause "days newer than") +(put 'more-chars-than 'vm-virtual-selector-clause + "with more characters than") +(put 'less-chars-than 'vm-virtual-selector-clause + "with less characters than") +(put 'more-lines-than 'vm-virtual-selector-clause "with more lines than") +(put 'less-lines-than 'vm-virtual-selector-clause "with less lines than") + +(put 'sexp 'vm-virtual-selector-arg-type 'string) +(put 'eval 'vm-virtual-selector-arg-type 'string) +(put 'header 'vm-virtual-selector-arg-type 'string) +(put 'label 'vm-virtual-selector-arg-type 'label) +(put 'uid 'vm-virtual-selector-arg-type 'string) +(put 'uidl 'vm-virtual-selector-arg-type 'string) +(put 'message-id 'vm-virtual-selector-arg-type 'string) +(put 'text 'vm-virtual-selector-arg-type 'string) +(put 'header-or-text 'vm-virtual-selector-arg-type 'string) +(put 'recipient 'vm-virtual-selector-arg-type 'string) +(put 'author-or-recipient 'vm-virtual-selector-arg-type 'string) +(put 'author 'vm-virtual-selector-arg-type 'string) +(put 'subject 'vm-virtual-selector-arg-type 'string) +(put 'sent-before 'vm-virtual-selector-arg-type 'string) +(put 'sent-after 'vm-virtual-selector-arg-type 'string) +(put 'older-than 'vm-virtual-selector-arg-type 'number) +(put 'newer-than 'vm-virtual-selector-arg-type 'number) +(put 'more-chars-than 'vm-virtual-selector-arg-type 'number) +(put 'less-chars-than 'vm-virtual-selector-arg-type 'number) +(put 'more-lines-than 'vm-virtual-selector-arg-type 'number) +(put 'less-lines-than 'vm-virtual-selector-arg-type 'number) +(put 'spam-score 'vm-virtual-selector-arg-type 'number) + +;;;###autoload +(defun vm-read-virtual-selector (prompt) + (let (selector (arg nil)) + (setq selector + (vm-read-string prompt vm-supported-interactive-virtual-selectors) + selector (intern selector)) + (let ((arg-type (get selector 'vm-virtual-selector-arg-type))) + (if (null arg-type) + nil + (setq prompt (concat (substring prompt 0 -2) " " + (get selector 'vm-virtual-selector-clause) + ": ")) + (raise-frame (selected-frame)) + (cond ((eq arg-type 'number) + (setq arg (vm-read-number prompt))) + ((eq arg-type 'label) + (let ((vm-completion-auto-correct nil) + (completion-ignore-case t)) + (setq arg (downcase + (vm-read-string + prompt + (vm-obarray-to-string-list + vm-label-obarray) + nil))))) + (t (setq arg (read-string prompt)))))) + (let ((real-arg + (if (or (eq selector 'sexp) (eq selector 'eval)) + (let ((read-arg (read arg))) + (if (listp read-arg) read-arg (list read-arg))) + arg))) + (or (fboundp (intern (concat "vm-vs-" (symbol-name selector)))) + (error "Invalid selector")) + (list selector real-arg)))) + + +;;;###autoload +(defun vm-virtual-quit (&optional no-expunge no-change) + "Clear away links between real and virtual folders when a +`vm-quit' is performed in the current folder (which could be either +real or virtual)." + (save-excursion + (cond ((eq major-mode 'vm-virtual-mode) + ;; don't trust blindly, user might have killed some of + ;; these buffers. + (setq vm-component-buffers + (vm-delete (lambda (pair) + (buffer-name (car pair))) + vm-component-buffers t)) + (setq vm-real-buffers + (vm-delete 'buffer-name vm-real-buffers t)) + (let ((b (current-buffer)) + (mirrored-msg nil) + (real-msg nil) + ;; lock out interrupts here + (inhibit-quit t)) + ;; Move the message-pointer of the original buffer to the + ;; current message in the virtual folder + (setq mirrored-msg (and vm-message-pointer + (vm-mirrored-message-of + (car vm-message-pointer)))) + (when (and mirrored-msg (vm-buffer-of mirrored-msg)) + (with-current-buffer (vm-buffer-of mirrored-msg) + (vm-record-and-change-message-pointer + vm-message-pointer (vm-message-position mirrored-msg)))) + (dolist (real-buf vm-real-buffers) + (with-current-buffer real-buf + (setq vm-virtual-buffers (delq b vm-virtual-buffers)))) + (dolist (m vm-message-list) + (setq real-msg (vm-real-message-of m)) + (vm-set-virtual-messages-of + real-msg (delq m (vm-virtual-messages-of real-msg)))) + (condition-case error-data + (dolist (pair vm-component-buffers) + (when (cdr pair) + (with-current-buffer (car pair) + ;; Use dynamic non-local bindings from vm-quit + (vm-quit no-expunge no-change)))) + (error + (vm-warn 0 2 "Unable to quit component folders: %s" + (prin1-to-string error-data)))))) + + ((eq major-mode 'vm-mode) + ;; don't trust blindly, user might have killed some of + ;; these buffers. + (setq vm-virtual-buffers + (vm-delete 'buffer-name vm-virtual-buffers t)) + (let (vmp + (b (current-buffer)) + ;; lock out interrupts here + (inhibit-quit t)) + (dolist (m vm-message-list) + ;; we'll clear these messages from the virtual + ;; folder by looking for messages that have a "Q" + ;; id number associated with them. + (when (vm-virtual-messages-of m) + (dolist (v-m (vm-virtual-messages-of m)) + (vm-set-message-id-number-of v-m "Q")) + (vm-unthread-message-and-mirrors m :message-changing nil) + (vm-set-virtual-messages-of m nil))) + (dolist (virtual-buf vm-virtual-buffers) + (set-buffer virtual-buf) + (setq vm-real-buffers (delq b vm-real-buffers)) + ;; set the message pointer to a new value if it is + ;; now invalid. + (when (and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) + (vm-garbage-collect-message) + (setq vmp vm-message-pointer) + (while (and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) + (setq vm-message-pointer + (cdr vm-message-pointer))) + ;; if there were no good messages ahead, try going + ;; backward. + (unless vm-message-pointer + (setq vm-message-pointer vmp) + (while (and vm-message-pointer + (equal "Q" (vm-message-id-number-of + (car vm-message-pointer)))) + (setq vm-message-pointer + (vm-reverse-link-of (car vm-message-pointer)))))) + ;; expunge the virtual messages associated with + ;; real messages that are going away. + (setq vm-message-list + (vm-delete (function + (lambda (m) + (equal "Q" (vm-message-id-number-of m)))) + vm-message-list nil)) + (if (null vm-message-pointer) + (setq vm-message-pointer vm-message-list)) + ;; same for vm-last-message-pointer + (if (null vm-last-message-pointer) + (setq vm-last-message-pointer nil)) + (vm-clear-virtual-quit-invalidated-undos) + (vm-reverse-link-messages) + (vm-set-numbering-redo-start-point t) + (vm-set-summary-redo-start-point t) + (if vm-message-pointer + (vm-present-current-message) + (vm-update-summary-and-mode-line)))))))) + +;;;###autoload +(defun vm-virtual-save-folder (prefix) + (save-excursion + ;; don't trust blindly, user might have killed some of + ;; these buffers. + (setq vm-real-buffers (vm-delete 'buffer-name vm-real-buffers t)) + (dolist (real-buf vm-real-buffers) + (set-buffer real-buf) + (vm-save-folder prefix))) + (vm-unmark-folder-modified-p (current-buffer)) + (vm-clear-modification-flag-undos) + (vm-update-summary-and-mode-line)) + +;;;###autoload +(defun vm-virtual-get-new-mail () + (save-excursion + ;; don't trust blindly, user might have killed some of + ;; these buffers. + (setq vm-real-buffers (vm-delete 'buffer-name vm-real-buffers t)) + (dolist (real-buf vm-real-buffers) + (set-buffer real-buf) + (condition-case error-data + (vm-get-new-mail) + ;; handlers + (folder-read-only + (vm-warn 0 1 "Folder is read only: %s" + (or buffer-file-name (buffer-name)))) + (unrecognized-folder-type + (vm-warn 0 1 "Folder type is unrecognized: %s" + (or buffer-file-name (buffer-name))))))) + (vm-emit-totals-blurb)) + +;;;###autoload +(defun vm-make-virtual-copy (m) + "Copy of the real message of the virtual message M in the current +folder buffer (which should be the virtual folder in which M occurs)." + (widen) + (let ((virtual-buffer (current-buffer)) + (real-m (vm-real-message-of m)) + (buffer-read-only nil) + (modified (buffer-modified-p))) + (unwind-protect + (save-excursion + (set-buffer (vm-buffer-of real-m)) + (save-restriction + (widen) + ;; must reference this now so that headers will be in + ;; their final position before the message is copied. + ;; otherwise the vheader offset computed below will be wrong. + (vm-vheaders-of real-m) + (copy-to-buffer virtual-buffer (vm-start-of real-m) + (vm-end-of real-m)))) + (set-buffer-modified-p modified)) + (set-marker (vm-start-of m) (point-min)) + (set-marker (vm-headers-of m) (+ (vm-start-of m) + (- (vm-headers-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-vheaders-of m) (+ (vm-start-of m) + (- (vm-vheaders-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-of m) (+ (vm-start-of m) (- (vm-text-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-text-end-of m) (+ (vm-start-of m) + (- (vm-text-end-of real-m) + (vm-start-of real-m)))) + (set-marker (vm-end-of m) (+ (vm-start-of m) (- (vm-end-of real-m) + (vm-start-of real-m)))))) +;; ;; now load vm-avirtual to avoid a loading loop +;; (require 'vm-avirtual) + +;;; vm-virtual.el ends here diff --git a/lisp/vm-w3.el b/lisp/vm-w3.el new file mode 100755 index 0000000..e83b3d5 --- /dev/null +++ b/lisp/vm-w3.el @@ -0,0 +1,75 @@ +;;; vm-w3.el --- additional functions to make VM use w3 for HTML mails +;; +;; This file is part of VM +;; +;; Copyright (C) 2008 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;; 02110-1301, USA. + +;;; Commentary: + +;; You need to have w3 installed for this module to work. + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'advice) + (require 'vm-mime) +) + +(eval-and-compile + (vm-load-features '(w3))) + +(declare-function w3-region "ext:w3-display.el" (st nd)) + +(defvar vm-w3-text/html-message nil + "The currently displayed message.") + +(defvar url-working-buffer) +(defvar url-current-content-length) +(defvar url-current-mime-encoding) +(defvar url-current-mime-type) +(defvar url-current-mime-headers) + +(defun vm-w3-cid-retrieve (url) + "Insert content of URL." + (set-buffer (get-buffer-create url-working-buffer)) + (let ((part (vm-mime-cid-retrieve url vm-w3-text/html-message)) + type encoding) + (setq type (car (vm-mm-layout-type part))) + (setq encoding (vm-mm-layout-encoding part)) + (if (= 0 (length type)) (setq type "text/plain")) + (if (= 0 (length encoding)) (setq encoding "8bit")) + (setq url-current-content-length (point-max) + url-current-mime-type type + url-current-mime-encoding encoding + url-current-mime-headers (list (cons "content-type" type) + (cons "content-encoding" encoding))))) + +(defadvice url-cid (around vm-w3 activate) + (if nil;(not vm-w3-text/html-message) + ad-do-it + (vm-w3-cid-retrieve (ad-get-arg 0)))) + +;;;###autoload +(defun vm-mime-display-internal-w3-text/html (start end layout) + (setq vm-w3-text/html-message (vm-mm-layout-message layout)) + (let nil;((vm-w3-text/html-message (vm-mm-layout-message layout))) + (w3-region start (1- end))) + ;; remove read-only text properties + (let ((inhibit-read-only t)) + (remove-text-properties start end '(read-only nil)))) diff --git a/lisp/vm-w3m.el b/lisp/vm-w3m.el new file mode 100755 index 0000000..ba4737d --- /dev/null +++ b/lisp/vm-w3m.el @@ -0,0 +1,166 @@ +;;; vm-w3m.el --- additional functions to make VM use emacs-w3m for HTML mails +;; +;; This file is part of VM +;; +;; Copyright (C) 2003, 2005, 2006 Katsumi Yamaoka, +;; Copyright (C) 2007 Robert Widhopf-Fenk + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;; 02110-1301, USA. + +;;; Commentary: + +;; You need to have w3m and emacs-w3m installed for this module to +;; work. Visit <URL:http://emacs-w3m.namazu.org/> for details. +;; You don't have to change VM at all. Simply load this module and +;; you will see HTML mails inlined by emacs-w3m in the VM presentation +;; buffer. + +;;; Code: + +(provide 'vm-w3m) + +(eval-when-compile + (require 'vm-mime) + (require 'executable)) + +(eval-and-compile + (vm-load-features '(w3m))) + +(declare-function w3m-region + "ext:w3m" (start end &optional url charset)) +(declare-function w3m-safe-toggle-inline-images + "ext:w3m" (&optional force no-cache)) + + +;; Dummy vriable declarations to suppress warnings if w3m is not +;; loaded + +(defvar w3m-current-buffer) +(defvar w3m-cid-retrieve-function-alist) +(defvar w3m-minor-mode-map) +(defvar url-working-buffer) +(defvar url-current-mime-type) +(defvar url-current-mime-headers) + +(defvar vm-w3m-mode-map nil + "Keymap for w3m within VM.") + +(defgroup vm-w3m nil + "w3m settings for VM." + :group 'vm-presentation) + +(defcustom vm-w3m-display-inline-images t + "Non-nil means VM will allow retrieving images in the HTML contents +with the <img> tags. See also the documentation for the variable +`vm-w3m-safe-url-regexp'." + :group 'vm-w3m + :type 'boolean) + +(defcustom vm-w3m-safe-url-regexp "\\`cid:" + "Regexp matching URLs which are considered to be safe. +Some HTML mails might contain a nasty trick used by spammers, using +the <img> tag which is far more evil than the [Click Here!] button. +It is most likely intended to check whether the ominous spam mail has +reached your eyes or not, in which case the spammer knows for sure +that your email address is valid. It is done by embedding an +identifier string into a URL that you might automatically retrieve +when displaying the image. The default value is \"\\\\`cid:\" which only +matches parts embedded to the Multipart/Related type MIME contents and +VM will never connect to the spammer's site arbitrarily. You may set +this variable to nil if you consider all urls to be safe." + :group 'vm-w3m + :type '(choice (regexp :tag "Regexp") + (const :tag "All URLs are safe" nil))) + +(defcustom vm-w3m-use-w3m-minor-mode-map t + "Say whether to use emacs-w3m command keys in VM presentation buffers. +Set this variable to nil if you don't want vm-w3m to override any VM +commend keys. If it is non-nil, you will not be able to use some VM +command keys, which are bound to emacs-w3m commands defined in the +`w3m-minor-mode-command-alist' variable." + :group 'vm-w3m + :type 'boolean) + +(eval-and-compile + (or (featurep 'xemacs) (>= emacs-major-version 21) + (defvar vm-w3m-mode-map nil + "Keymap for text/html parts inlined by emacs-w3m. +This keymap will be bound only when Emacs 20 is running and overwritten +by the value of `w3m-minor-mode-map'. In order to add some commands to +this keymap, add them to `w3m-minor-mode-map' instead of this keymap."))) + +(defun vm-w3m-cid-retrieve (url &rest args) + "Insert a content of URL." + (let ((message (save-excursion + (set-buffer w3m-current-buffer) + (car vm-message-pointer))) + part + type) + (setq part (vm-mime-cid-retrieve url message)) + (when part + (setq type (car (vm-mm-layout-type part))) + (vm-mime-transfer-decode-region part (point-min) (point-max))) + type)) + +(or (assq 'vm-presentation-mode w3m-cid-retrieve-function-alist) + (setq w3m-cid-retrieve-function-alist + (cons '(vm-presentation-mode . vm-w3m-cid-retrieve) + w3m-cid-retrieve-function-alist))) + +(defun vm-w3m-local-map-property () + (if (and (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) + (if (or (featurep 'xemacs) (>= emacs-major-version 21)) + (list 'keymap w3m-minor-mode-map) + (list 'local-map + (or vm-w3m-mode-map + (progn + (setq vm-w3m-mode-map + (copy-keymap w3m-minor-mode-map)) + (set-keymap-parent vm-w3m-mode-map vm-mode-map) + vm-w3m-mode-map)))))) + +;;;###autoload +(defun vm-mime-display-internal-emacs-w3m-text/html (start end layout) + "Use emacs-w3m to inline HTML mails in the VM presentation buffer." + (let ((w3m-display-inline-images vm-w3m-display-inline-images) + (w3m-safe-url-regexp vm-w3m-safe-url-regexp)) + (w3m-region start (1- end)) + (add-text-properties + start end + (nconc (if vm-w3m-use-w3m-minor-mode-map + (if (equal major-mode 'vm-presentation-mode) + (vm-w3m-local-map-property))) + ;; Put the mark meaning that this part was + ;; inlined by emacs-w3m. + '(text-rendered-by-emacs-w3m t))))) + +(defun vm-w3m-safe-toggle-inline-images (&optional arg) + "Toggle displaying of all images in the presentation buffer. +If the prefix arg is given, all images are considered to be safe." + (interactive "P") + (let ((buffer (cond ((eq major-mode 'vm-summary-mode) + (with-current-buffer vm-mail-buffer + vm-presentation-buffer)) + ((eq major-mode 'vm-presentation-mode) + (current-buffer)) + ((eq major-mode 'vm-mode) + vm-presentation-buffer)))) + (if (buffer-live-p buffer) + (save-excursion + (set-buffer buffer) + (w3m-safe-toggle-inline-images arg))))) + +;;; vm-w3m.el ends here diff --git a/lisp/vm-window.el b/lisp/vm-window.el new file mode 100755 index 0000000..8ce27d4 --- /dev/null +++ b/lisp/vm-window.el @@ -0,0 +1,717 @@ +;;; vm-window.el --- Window management code for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1989-1997 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +;;; Code: + +(provide 'vm-window) + +(eval-when-compile + (require 'vm-misc) + (require 'tapestry) + ) + +(declare-function frame-highest-window "vm-xemacs" (frame)) + +(declare-function vm-selected-frame "vm-window.el" ()) +(declare-function vm-window-frame "vm-window.el" (window)) +(declare-function vm-delete-frame "vm-window.el" (&optional frame force)) +(declare-function vm-raise-frame "vm-window.el" (&optional frame)) +(declare-function vm-frame-visible-p "vm-window.el" (frame)) +(declare-function vm-frame-iconified-p "vm-window.el" (frame)) +(declare-function vm-window-frame "vm-window.el" (window)) +(declare-function vm-next-frame "vm-window.el" (&optional frame miniframe)) +(declare-function vm-select-frame "vm-window.el" (frame &optional norecord)) +(declare-function vm-frame-selected-window "vm-window.el" (&optional frame)) + +;;;###autoload +(defun vm-display (buffer display commands configs + &optional do-not-raise) +;; the clearinghouse VM display function. +;; +;; First arg BUFFER non-nil is a buffer to display or undisplay. +;; nil means there is no request to display or undisplay a +;; buffer. +;; +;; Second arg DISPLAY non-nil means to display the buffer, nil means +;; to undisplay it. This function guarantees to display the +;; buffer if requested. Undisplay is not guaranteed. +;; +;; Third arg COMMANDS is a list of symbols. this-command must +;; match one of these symbols for a window configuration to be +;; applied. +;; +;; Fourth arg CONFIGS is a list of window configurations to try. +;; vm-set-window-configuration will step through the list looking +;; for an existing configuration, and apply the one it finds. +;; +;; Display is done this way: +;; 1. if the buffer is visible in an invisible frame, make that frame visible +;; 2. if the buffer is already displayed, quit +;; 3. if vm-display-buffer-hook in non-nil +;; run the hooks +;; use the selected window/frame to display the buffer +;; quit +;; 4. apply a window configuration +;; if the buffer is displayed now, quit +;; 5. call vm-display-buffer which will display the buffer. +;; +;; Undisplay is done this way: +;; 1. if the buffer is not displayed, quit +;; 2. if vm-undisplay-buffer-hook is non-nil +;; run the hooks +;; quit +;; 3. apply a window configuration +;; 4, if a window configuration was applied +;; quit +;; 5. call vm-undisplay-buffer which will make the buffer +;; disappear from at least one window/frame. +;; +;; If display/undisplay is not requested, only window +;; configuration is done, and only then if the value of +;; this-command is found in the COMMANDS list. + (and (stringp buffer) (setq buffer (get-buffer buffer))) + (vm-save-buffer-excursion + (let* ((w (and buffer (vm-get-buffer-window buffer))) + (wf (and w (vm-window-frame w)))) + (if (and w display (not do-not-raise)) + (vm-raise-frame wf)) + (if (and w display (not (eq (vm-selected-frame) wf))) + (vm-select-frame wf)) + (cond ((and buffer display) + (if (and vm-display-buffer-hook + (null (vm-get-visible-buffer-window buffer))) + (progn (save-excursion + (set-buffer buffer) + (run-hooks 'vm-display-buffer-hook)) + (switch-to-buffer buffer)) + (if (not (and (memq this-command commands) + (apply 'vm-set-window-configuration configs) + (vm-get-visible-buffer-window buffer))) + (vm-display-buffer buffer)))) + ((and buffer (not display)) + (if (and vm-undisplay-buffer-hook + (vm-get-visible-buffer-window buffer)) + (progn (save-excursion + (set-buffer buffer) + (run-hooks 'vm-undisplay-buffer-hook))) + (if (not (and (memq this-command commands) + (apply 'vm-set-window-configuration configs))) + (vm-undisplay-buffer buffer)))) + ((memq this-command commands) + (apply 'vm-set-window-configuration configs)))))) + +(defun vm-display-buffer (buffer) + (let ((pop-up-windows (eq vm-mutable-window-configuration t)) + (pop-up-frames (and pop-up-frames vm-mutable-frame-configuration))) + (if (or pop-up-frames + (and (eq vm-mutable-window-configuration t) + (symbolp + (vm-buffer-to-label + (window-buffer + (selected-window)))))) + (select-window (display-buffer buffer)) + (switch-to-buffer buffer)))) + +(defun vm-undisplay-buffer (buffer) + (vm-save-buffer-excursion + (let ((vm-mutable-frame-configuration + (and vm-mutable-frame-configuration pop-up-frames))) + (vm-maybe-delete-windows-or-frames-on buffer)) + (let (w) + (while (setq w (vm-get-buffer-window buffer)) + (set-window-buffer w (other-buffer buffer)))))) + +(defun vm-load-window-configurations (file) + (save-excursion + (let ((work-buffer nil)) + (unwind-protect + (progn + (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*"))) + (if vm-fsfemacs-mule-p + (set-buffer-multibyte nil)) ; for empty buffer + (erase-buffer) + (setq vm-window-configurations + (condition-case () + (progn + (let ((coding-system-for-read + (vm-line-ending-coding-system))) + (insert-file-contents file)) + (read (current-buffer))) + (error nil)))) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-store-window-configurations (file) + (save-excursion + (let ((work-buffer nil)) + (unwind-protect + (progn + (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*"))) + (if vm-fsfemacs-mule-p + (set-buffer-multibyte nil)) ; for empty buffer + ;; for MULE + (if (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system (vm-line-ending-coding-system))) + (erase-buffer) + (print vm-window-configurations (current-buffer)) + (let ((coding-system-for-write (vm-line-ending-coding-system)) + (selective-display nil)) + (write-region (point-min) (point-max) file nil 0))) + (and work-buffer (kill-buffer work-buffer)))))) + +(defun vm-set-window-configuration (&rest tags) + (catch 'done + (if (not vm-mutable-window-configuration) + (throw 'done nil)) + (let ((nonexistent " *vm-nonexistent*") + (nonexistent-summary " *vm-nonexistent-summary*") + (selected-frame (vm-selected-frame)) + folders-summary summary message composition edit config) + (while (and tags (null config)) + (setq config (assq (car tags) vm-window-configurations) + tags (cdr tags))) + (or config (setq config (assq 'default vm-window-configurations))) + (or config (throw 'done nil)) + (setq config (vm-copy config)) + (setq composition (vm-find-composition-buffer t)) + (cond ((eq major-mode 'vm-summary-mode) + (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) + (throw 'done nil) + (setq summary (current-buffer)) + (setq message vm-mail-buffer))) + ((eq major-mode 'vm-folders-summary-mode) + (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) + (throw 'done nil) + (setq folders-summary (current-buffer)) + (setq message vm-mail-buffer))) + ((eq major-mode 'vm-mode) + (setq message (current-buffer))) + ((eq major-mode 'vm-presentation-mode) + (setq message vm-mail-buffer)) + ((eq major-mode 'vm-virtual-mode) + (setq message (current-buffer))) + ((eq major-mode 'mail-mode) + (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) + (throw 'done nil) + (setq message vm-mail-buffer + ;; assume that the proximity implies affinity + composition (current-buffer)))) + ((eq vm-system-state 'editing) + (if (or (null vm-mail-buffer) (null (buffer-name vm-mail-buffer))) + (throw 'done nil) + (setq edit (current-buffer)) + (setq message vm-mail-buffer))) + ;; not in a VM related buffer, bail... + (t (throw 'done nil))) + (set-buffer message) + (vm-check-for-killed-presentation) + (if vm-presentation-buffer + (setq message vm-presentation-buffer)) + (vm-check-for-killed-summary) + (or folders-summary (setq folders-summary (or vm-folders-summary-buffer + nonexistent))) + (or summary (setq summary (or vm-summary-buffer nonexistent-summary))) + (or composition (setq composition nonexistent)) + (or edit (setq edit nonexistent)) + (tapestry-replace-tapestry-element (nth 1 config) 'buffer-name + (function + (lambda (x) + (if (symbolp x) + (symbol-value x) + (if (and (stringp x) + (get-buffer x) + (zerop + (save-excursion + (set-buffer x) + (buffer-size)))) + nonexistent + x ))))) + (set-tapestry (nth 1 config) 1) + (and (get-buffer nonexistent) + (vm-maybe-delete-windows-or-frames-on nonexistent)) + (if (and (vm-get-buffer-window nonexistent-summary) + (not (vm-get-buffer-window message))) + ;; user asked for summary to be displayed but doesn't + ;; have one, nor is the folder buffer displayed. Help + ;; the user not to lose here. + (vm-replace-buffer-in-windows nonexistent-summary message) + (and (get-buffer nonexistent-summary) + (vm-maybe-delete-windows-or-frames-on nonexistent-summary))) + config ))) + +;;;###autoload +(defun vm-save-window-configuration (tag) + "Name and save the current window configuration. +With this command you associate the current window setup with an +action. Each time you perform this action VM will duplicate this +window setup. + +Nearly every VM command can have a window configuration +associated with it. VM also allows some category configurations, +`startup', `reading-message', `composing-message', `editing-message', +`marking-message' and `searching-message' for the commands that +do these things. There is also a `default' configuration that VM +will use if no other configuration is applicable. Command +specific configurations are searched for first, then the category +configurations and then the default configuration. The first +configuration found is the one that is applied. + +The value of vm-mutable-window-configuration must be non-nil for VM to use +window configurations." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (if (null vm-window-configuration-file) + (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) + (list + (intern + (completing-read "Name this window configuration: " + vm-supported-window-configurations + 'identity t))))) + (if (null vm-window-configuration-file) + (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) + (let (map p) + (setq map (tapestry (list (vm-selected-frame)))) + ;; set frame map to nil since we don't use it. this prevents + ;; cursor objects and any other objects that have an + ;; "unreadable" read syntax appearing in the window + ;; configuration file by way of frame-parameters. + (setcar map nil) + (tapestry-replace-tapestry-element map 'buffer-name 'vm-buffer-to-label) + (tapestry-nullify-tapestry-elements map t nil t t t nil) + (setq p (assq tag vm-window-configurations)) + (if p + (setcar (cdr p) map) + (setq vm-window-configurations + (cons (list tag map) vm-window-configurations))) + (vm-store-window-configurations vm-window-configuration-file) + (vm-inform 5 "%s configuration recorded" tag))) + +(defun vm-buffer-to-label (buf) + (save-excursion + (set-buffer buf) + (cond ((eq major-mode 'vm-summary-mode) + 'summary) + ((eq major-mode 'vm-folders-summary-mode) + 'folders-summary) + ((eq major-mode 'mail-mode) + 'composition) + ((eq major-mode 'vm-mode) + 'message) + ((eq major-mode 'vm-presentation-mode) + 'message) + ((eq major-mode 'vm-virtual-mode) + 'message) + ((eq vm-system-state 'editing) + 'edit) + (t buf)))) + +;;;###autoload +(defun vm-delete-window-configuration (tag) + "Delete the configuration saved for a particular action. +This action will no longer have an associated window configuration. +The action will be read from the minibuffer." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (if (null vm-window-configuration-file) + (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) + (list + (intern + (completing-read "Delete window configuration: " + (mapcar (function + (lambda (x) + (list (symbol-name (car x))))) + vm-window-configurations) + 'identity t))))) + (if (null vm-window-configuration-file) + (error "Configurable windows not enabled. Set vm-window-configuration-file to enable.")) + (let (p) + (setq p (assq tag vm-window-configurations)) + (if p + (if (eq p (car vm-window-configurations)) + (setq vm-window-configurations (cdr vm-window-configurations)) + (setq vm-window-configurations (delq p vm-window-configurations))) + (error "No window configuration set for %s" tag))) + (vm-store-window-configurations vm-window-configuration-file) + (vm-inform 5 "%s configuration deleted" tag)) + +;;;###autoload +(defun vm-apply-window-configuration (tag) + "Change the current window configuration to be one +associated with a particular action. The action will be read +from the minibuffer." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (list + (intern + (completing-read "Apply window configuration: " + (mapcar (function + (lambda (x) + (list (symbol-name (car x))))) + vm-window-configurations) + 'identity t))))) + (vm-set-window-configuration tag)) + +(defun vm-window-help () + (interactive) + (vm-inform 0 "WS = save configuration, WD = delete configuration, WW = apply configuration")) + +(defun vm-iconify-frame () + "Iconify the current frame. +Run the hooks in vm-iconify-frame-hook before doing so." + (interactive) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (if (vm-multiple-frames-possible-p) + (progn + (run-hooks 'vm-iconify-frame-hook) + (vm-iconify-frame-xxx)))) + +(defun vm-window-loop (action obj-1 &optional obj-2) + (let ((delete-me nil) + (done nil) + (all-frames (if vm-search-other-frames t nil)) + start w) + (setq start (next-window (selected-window) 'nomini all-frames) + w start) + (and obj-1 (setq obj-1 (get-buffer obj-1))) + (while (not done) + (if (and delete-me (not (eq delete-me (next-window delete-me 'nomini)))) + (progn + (delete-window delete-me) + (if (eq delete-me start) + (setq start nil)) + (setq delete-me nil))) + (cond ((and (eq action 'delete) (eq obj-1 (window-buffer w))) + ;; a deleted window has no next window, so we + ;; defer the deletion until after we've moved + ;; to the next window. + (setq delete-me w)) + ((and (eq action 'replace) (eq obj-1 (window-buffer w))) + (set-window-buffer w obj-2))) + (setq done (eq start + (setq w + (condition-case nil + (next-window w 'nomini all-frames) + (wrong-number-of-arguments + (next-window w 'nomini)))))) + (if (null start) + (setq start w))) + (if (and delete-me (not (eq delete-me (next-window delete-me 'nomini)))) + (delete-window delete-me)))) + +(defun vm-frame-loop (action obj-1) + (if (fboundp 'vm-next-frame) + (let ((start (vm-next-frame (vm-selected-frame))) + (delete-me nil) + (done nil) + f) + (setq f start) + (and obj-1 (setq obj-1 (get-buffer obj-1))) + (while (not done) + (if delete-me + (progn + (condition-case nil + (progn + (if (vm-created-this-frame-p delete-me) + (progn + (vm-delete-frame delete-me) + (if (eq delete-me start) + (setq start nil))))) + (error nil)) + (setq delete-me nil))) + (cond ((and (eq action 'delete) + ;; one-window-p doesn't take a frame argument + (eq (next-window (vm-frame-selected-window f) 'nomini) + (previous-window (vm-frame-selected-window f) + 'nomini)) + ;; the next-window call is to avoid looking + ;; at the minibuffer window + (eq obj-1 (window-buffer + (next-window + (vm-frame-selected-window f) + 'nomini)))) + ;; a deleted frame has no next frame, so we + ;; defer the deletion until after we've moved + ;; to the next frame. + (setq delete-me f)) + ((eq action 'bury) + (bury-buffer obj-1))) + (setq done (eq start (setq f (vm-next-frame f)))) + (if (null start) + (setq start f))) + (if (and delete-me (vm-created-this-frame-p delete-me)) + (progn + (vm-error-free-call 'vm-delete-frame delete-me) + (setq delete-me nil)))))) + +(defun vm-maybe-delete-windows-or-frames-on (buffer) + (and (eq vm-mutable-window-configuration t) (vm-window-loop 'delete buffer)) + (and vm-mutable-frame-configuration (vm-frame-loop 'delete buffer))) + +(defun vm-replace-buffer-in-windows (old new) + (vm-window-loop 'replace old new)) + +(defun vm-bury-buffer (&optional buffer) + (or buffer (setq buffer (current-buffer))) + (if vm-xemacs-p + (if (vm-multiple-frames-possible-p) + (vm-frame-loop 'bury buffer) + (bury-buffer buffer)) + (bury-buffer buffer))) + +(defun vm-unbury-buffer (buffer) + (save-excursion + (save-window-excursion + ;; catch errors--- the selected window might be a dedicated + ;; window or a minibuffer window. We don't care and we + ;; don't want to crash because of it. + (condition-case data + (switch-to-buffer buffer) + (error nil))))) + +(defun vm-set-hooks-for-frame-deletion () + (make-local-variable 'vm-undisplay-buffer-hook) + (add-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) + (add-hook 'kill-buffer-hook 'vm-delete-buffer-frame)) + +(defun vm-created-this-frame-p (&optional frame) + (memq (or frame (vm-selected-frame)) vm-frame-list)) + +(defun vm-delete-buffer-frame () + ;; kludge. we only want to this to run on VM related buffers + ;; but this function is generally on a global hook. Check for + ;; vm-undisplay-buffer-hook set; this is a good sign that this + ;; is a VM buffer. + (if vm-undisplay-buffer-hook + (save-excursion + ;; run once only per buffer. + (remove-hook 'vm-undisplay-buffer-hook 'vm-delete-buffer-frame) + (let* ((w (vm-get-visible-buffer-window (current-buffer))) + (b (current-buffer)) + (wf (and w (vm-window-frame w)))) + (and w (eq (vm-selected-frame) wf) (vm-created-this-frame-p wf) + (vm-error-free-call 'vm-delete-frame wf)) + (and w (let ((vm-mutable-frame-configuration t)) + (vm-maybe-delete-windows-or-frames-on b))))))) + +(defun vm-register-frame (frame) + (setq vm-frame-list (cons frame vm-frame-list))) + +(defun vm-goto-new-frame (&rest types) + (let ((params nil)) + (while (and types (null params)) + (setq params (car (cdr (assq (car types) vm-frame-parameter-alist))) + types (cdr types))) + ;; these functions might be defined in an Emacs that isn't + ;; running under a window system, but VM always checks for + ;; multi-frame support before calling this function. + (cond ((fboundp 'make-frame) + (vm-select-frame (make-frame params))) + ((fboundp 'make-screen) + (vm-select-frame (make-screen params))) + ((fboundp 'new-screen) + (vm-select-frame (new-screen params)))) + (vm-register-frame (vm-selected-frame)) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-selected-frame))))) + +(defun vm-goto-new-summary-frame-maybe () + (if (and vm-mutable-frame-configuration vm-frame-per-summary + (vm-multiple-frames-possible-p)) + (let ((w (vm-get-buffer-window vm-summary-buffer))) + (if (null w) + (progn + (vm-goto-new-frame 'summary) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) + +(defun vm-goto-new-folders-summary-frame-maybe () + (if (and vm-mutable-frame-configuration vm-frame-per-folders-summary + (vm-multiple-frames-possible-p)) + (let ((w (vm-get-buffer-window vm-folders-summary-buffer))) + (if (null w) + (progn + (vm-goto-new-frame 'folders-summary) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) + +(defun vm-goto-new-folder-frame-maybe (&rest types) + (if (and vm-mutable-frame-configuration vm-frame-per-folder + (vm-multiple-frames-possible-p)) + (let ((w (or (vm-get-buffer-window (current-buffer)) + ;; summary == folder for the purpose + ;; of frame reuse. + (and vm-summary-buffer + (vm-get-buffer-window vm-summary-buffer)) + ;; presentation == folder for the purpose + ;; of frame reuse. + (and vm-presentation-buffer + (vm-get-buffer-window vm-presentation-buffer))))) + (if (null w) + (progn + (apply 'vm-goto-new-frame types) + (vm-set-hooks-for-frame-deletion)) + (save-excursion + (select-window w) + (and vm-warp-mouse-to-new-frame + (vm-warp-mouse-to-frame-maybe (vm-window-frame w)))))))) + +(defun vm-warp-mouse-to-frame-maybe (&optional frame) + (or frame (setq frame (vm-selected-frame))) + (if (vm-mouse-support-possible-here-p) + (cond ((vm-mouse-xemacs-mouse-p) + (cond ((fboundp 'mouse-position);; XEmacs 19.12 and up + (let ((mp (mouse-position))) + (if (and (car mp) + (eq (window-frame (car mp)) (selected-frame))) + nil + (set-mouse-position (frame-highest-window frame) + (/ (frame-width frame) 2) + (/ (frame-height frame) 2))))) + (t + (error "Emacs version too old") + ;; XEmacs 19.11 + ;; use (apply 'screen-...) instead of + ;; (screen-...) to avoid stimulating a + ;; byte-compiler bug in Emacs 19.29 that + ;; happens when it encounters 'obsolete' + ;; functions. puke, puke, puke. + ;; (let ((mp (read-mouse-position frame))) + ;; (if (and (>= (car mp) 0) + ;; (<= (car mp) (apply 'screen-width frame)) + ;; (>= (cdr mp) 0) + ;; (<= (cdr mp) (apply 'screen-height frame))) + ;; nil + ;; (set-mouse-position + ;; frame + ;; (/ (apply 'screen-width frame) 2) + ;; (/ (apply 'screen-height frame) 2)))) + ))) + ((vm-fsfemacs-p) + (let ((mp (mouse-position))) + (if (and (eq (car mp) frame) + ;; nil coordinates mean that the mouse + ;; pointer isn't really within the frame + (car (cdr mp))) + nil + (set-mouse-position frame + (/ (frame-width frame) 2) + (/ (frame-height frame) 2)) + ;; doc for set-mouse-position says to do this + ;; but Emacs 22 doesn't say it and unfocus-frame is + ;; obsolete now. USR, 2010-07-03 + ;; (unfocus-frame) + )))))) + +(fset 'vm-selected-frame + (symbol-function + (cond ((fboundp 'selected-frame) 'selected-frame) + ;; ((fboundp 'selected-screen) 'selected-screen) ; Xemacs 19? + (t 'ignore)))) + +(fset 'vm-delete-frame + (symbol-function + (cond ((fboundp 'delete-frame) 'delete-frame) + ;; ((fboundp 'delete-screen) 'delete-screen) ; XEmacs 19? + (t 'ignore)))) + +;; xxx because vm-iconify-frame is a command +(defun vm-iconify-frame-xxx (&optional frame) + (cond ((fboundp 'iconify-frame) + (iconify-frame frame)) + ;; ((fboundp 'iconify-screen) ; XEmacs 19? + ;; (iconify-screen (or frame (vm-selected-frame)))) + )) + +(defun vm-deiconify-frame (frame) + "Deiconify FRAME." + (if (fboundp 'deiconify-frame) + (deiconify-frame frame) + (when (eq (frame-visible-p frame) 'icon) + (select-frame frame) + (iconify-or-deiconify-frame)))) + +(fset 'vm-raise-frame + (symbol-function + (cond ((fboundp 'raise-frame) 'raise-frame) + ;; ((fboundp 'raise-screen) 'raise-screen) ; XEmacs 19? + (t 'ignore)))) + +(fset 'vm-frame-visible-p + (symbol-function + (cond ((fboundp 'frame-visible-p) 'frame-visible-p) + ;; ((fboundp 'screen-visible-p) 'screen-visible-p) ; XEmacs 19? + (t 'ignore)))) + +(if (fboundp 'frame-iconified-p) + (fset 'vm-frame-iconified-p 'frame-iconified-p) + (defun vm-frame-iconified-p (&optional frame) + (eq (vm-frame-visible-p frame) 'icon))) + +;; frame-totally-visible-p is broken under XEmacs 19.14 and is +;; absent under Emacs 19.34. So vm-frame-per-summary won't work +;; quite right under these Emacs versions. XEmacs 19.15 should +;; have a working version of this function. +;; 2 April 1997, frame-totally-visible-p apparently still broken +;; under 19.15. I give up for now. +;;(if (and (fboundp 'frame-totally-visible-p) +;; vm-xemacs-p +;; (or (>= emacs-major-version 20) +;; (>= emacs-minor-version 15))) +;; (fset 'vm-frame-totally-visible-p 'frame-totally-visible-p) +;; (fset 'vm-frame-totally-visible-p 'vm-frame-visible-p)) +;; 2 April 1998, frame-visible-p returns 'hidden for tty frames +;; that are visible but not the topmost frame. Use that info. +(defun vm-frame-totally-visible-p (&optional frame) + (or frame (setq frame (selected-frame))) + (not (memq (frame-visible-p frame) '(nil hidden)))) + +(fset 'vm-window-frame + (symbol-function + (cond ((fboundp 'window-frame) 'window-frame) + ((fboundp 'window-screen) 'window-screen) + (t 'ignore)))) + +(cond ((fboundp 'next-frame) + (fset 'vm-next-frame (symbol-function 'next-frame)) + (fset 'vm-select-frame (symbol-function 'select-frame)) + (fset 'vm-frame-selected-window + (symbol-function 'frame-selected-window))) + ((fboundp 'next-screen) + (fset 'vm-next-frame (symbol-function 'next-screen)) + (fset 'vm-select-frame (symbol-function 'select-screen)) + (fset 'vm-frame-selected-window + (if (fboundp 'epoch::selected-window) + (symbol-function 'epoch::selected-window) + (symbol-function 'screen-selected-window)))) + (t + ;; it is useful for this to be a no-op, but don't bind the + ;; others. + (fset 'vm-select-frame 'ignore))) + +;;; vm-window.el ends here diff --git a/lisp/vm.el b/lisp/vm.el new file mode 100755 index 0000000..9b1395f --- /dev/null +++ b/lisp/vm.el @@ -0,0 +1,1529 @@ +;;; vm.el --- Entry points for VM +;; +;; This file is part of VM +;; +;; Copyright (C) 1994-1998, 2003 Kyle E. Jones +;; Copyright (C) 2003-2006 Robert Widhopf-Fenk +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License along +;; with this program; if not, write to the Free Software Foundation, Inc., +;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + + +;;; History: +;; +;; This file was vm-startup.el! + +;;; Code: + +(provide 'vm) + +(require 'vm-version) + +(defvar enable-multibyte-characters) + +;; For function declarations +(eval-when-compile + (require 'vm-misc) + (require 'vm-folder) + (require 'vm-summary) + (require 'vm-window) + (require 'vm-minibuf) + (require 'vm-menu) + (require 'vm-toolbar) + (require 'vm-mouse) + (require 'vm-page) + (require 'vm-motion) + (require 'vm-undo) + (require 'vm-delete) + (require 'vm-crypto) + (require 'vm-mime) + (require 'vm-virtual) + (require 'vm-pop) + (require 'vm-imap) + (require 'vm-sort) + (require 'vm-reply) +) + +;; vm-xemacs.el is a non-existent file to fool the Emacs 23 compiler +(declare-function vm-xemacs-set-face-foreground "vm-xemacs.el" + (face color &optional locale tag-set how-to-add)) +(declare-function vm-xemacs-set-face-background "vm-xemacs.el" + (face color &optional locale tag-set how-to-add)) +(declare-function get-coding-system "vm-xemacs.el" (name)) +(declare-function find-face "vm-xemacs.el" (face-or-name)) + +(declare-function vm-rfaddons-infect-vm "vm-rfaddons.el" + (&optional sit-for option-list exclude-option-list)) +(declare-function vm-summary-faces-mode "vm-summary-faces.el" + (&optional arg)) + +;; Ensure that vm-autoloads is loaded in case the user is using VM 7.x +;; autoloads + +(eval-when (load) + (if (not (featurep 'xemacs)) + (require 'vm-autoloads))) + +;;;###autoload +(defun* vm (&optional folder &key (read-only nil) (access-method nil) + (reload nil) (revisit nil)) + "Read mail under Emacs. +Optional first arg FOLDER specifies the folder to visit. It can +be the path name of a local folder or the maildrop specification +of a POP or IMAP folder. It defaults to the value of +`vm-primary-inbox'. The folder is visited in a VM buffer is put +into VM mode, a major mode for reading mail. (See `vm-mode'.) + +Prefix arg or optional second arg READ-ONLY non-nil indicates +that the folder should be considered read only. No attribute +changes, message additions or deletions will be allowed in the +visited folder. + +Visiting a folder normally causes any contents of its spool files +to be moved and appended to the folder buffer. You can disable +this automatic fetching of mail by setting `vm-auto-get-new-mail' +to nil. + +All the messages can be read by repeatedly pressing SPC. Use `n'ext and +`p'revious to move about in the folder. Messages are marked for +deletion with `d', and saved to another folder with `s'. Quitting VM +with `q' saves the buffered folder to disk, but does not expunge +deleted messages. Use `###' to expunge deleted messages." + + ;; Additional documentation for internal calls to vm: + + ;; *** Note that this function causes the folder buffer to become + ;; *** the current-buffer. + + ;; Internally, this function may also be called with a buffer as the + ;; FOLDER argument. In that case, the function sets up the buffer + ;; as a folder buffer and turns on vm-mode. + + ;; ACCESS-METHOD, if non-nil, indicates that the FOLDER is the + ;; maildrop spec of a remote server folder. Possible values for the + ;; parameter are 'pop and 'imap. Or, if FOLDER is a buffer instead + ;; of a name, it will be set up as a folder buffer using the + ;; specified ACCESS-METHOD. + + ;; RELOAD, if non-nil, means that the folder should be reloaded into + ;; an existing buffer. All initialisations must be performed but + ;; some variables need to be preserved, e.g., vm-folder-access-data. + + ;; REVISIT, if non-nil, means that, if the folder has already been + ;; visited, then it should be just selected. No further processing + ;; should be done. + + ;; The functions find-name-for-spec and find-spec-for-name translate + ;; between folder names and maildrop specs for the server folders. + + (interactive (list nil :read-only current-prefix-arg)) + (vm-session-initialization) + ;; recursive call to vm in order to allow defadvice on its first call + (unless (boundp 'vm-session-beginning) + (vm folder :read-only read-only :access-method access-method + :reload reload :revisit revisit)) + ;; set inhibit-local-variables non-nil to protect + ;; against letter bombs. + ;; set enable-local-variables to nil for newer Emacses + (catch 'done + ;; deduce the access method if none specified + (if (null access-method) + (let ((f (or folder vm-primary-inbox))) + (cond ((bufferp f) ; may be unnecessary. USR, 2010-01 + (setq access-method vm-folder-access-method)) + ((and (stringp f) + (vm-imap-folder-spec-p f)) + (setq access-method 'imap + folder f)) + ((and (stringp f) + (vm-pop-folder-spec-p f)) + (setq access-method 'pop + folder f))))) + (let ((full-startup (and (not reload) (not (bufferp folder)))) + ;; if we have been asked to visit a folder that is already + ;; visited, then we don't do a full-startup unless we are + ;; reloading. but what exactly do we do? - USR, 2011-04-24 + (did-read-index-file nil) + folder-buffer first-time totals-blurb + folder-name account-name remote-spec + preserve-auto-save-file) + (cond ((and full-startup (eq access-method 'pop)) + ;; (setq vm-last-visit-pop-folder folder) + (setq remote-spec folder) + (setq folder-name (or (vm-pop-find-name-for-spec folder) "POP")) + (setq folder (vm-pop-find-cache-file-for-spec remote-spec))) + ((and full-startup (eq access-method 'imap)) + ;; (setq vm-last-visit-imap-folder folder) + (setq remote-spec folder) + (setq folder-name (or (nth 3 (vm-imap-parse-spec-to-list + remote-spec)) + folder)) + (if (and vm-imap-refer-to-inbox-by-account-name + (equal (downcase folder-name) "inbox") + (setq account-name + (vm-imap-account-name-for-spec remote-spec))) + (setq folder-name account-name)) + (setq folder (vm-imap-make-filename-for-spec remote-spec)))) + (setq folder-buffer + (if (bufferp folder) + folder + (vm-read-folder folder remote-spec folder-name))) + (set-buffer folder-buffer) + ;; Thunderbird folders + (let ((msf (concat (buffer-file-name) ".msf"))) + ;; notice the message summary file of Thunderbird + (setq vm-folder-read-thunderbird-status + (and (file-exists-p msf) + vm-sync-thunderbird-status))) + (if (and vm-fsfemacs-mule-p enable-multibyte-characters) + (set-buffer-multibyte nil)) ; is this safe? + ;; for MULE + ;; + ;; If the file coding system is not a no-conversion variant, + ;; make it so by encoding all the text, then setting the + ;; file coding system and decoding it. This situation is + ;; only possible if a file is visited and then vm-mode is + ;; run on it afterwards. + ;; + ;; There are separate code blocks for FSF Emacs and XEmacs + ;; because the coding systems have different names. + (defvar buffer-file-coding-system) + (if (and (or vm-xemacs-mule-p vm-xemacs-file-coding-p) + (not (eq (get-coding-system buffer-file-coding-system) + (get-coding-system 'no-conversion-unix))) + (not (eq (get-coding-system buffer-file-coding-system) + (get-coding-system 'no-conversion-dos))) + (not (eq (get-coding-system buffer-file-coding-system) + (get-coding-system 'no-conversion-mac))) + (not (eq (get-coding-system buffer-file-coding-system) + (get-coding-system 'binary)))) + (let ((buffer-read-only nil) + (omodified (buffer-modified-p))) + (unwind-protect + (progn + (encode-coding-region (point-min) (point-max) + buffer-file-coding-system) + (set-buffer-file-coding-system 'no-conversion nil) + (decode-coding-region (point-min) (point-max) + buffer-file-coding-system)) + (set-buffer-modified-p omodified)))) + (if (and vm-fsfemacs-mule-p (null buffer-file-coding-system)) + (set-buffer-file-coding-system 'raw-text nil)) + (if (and vm-fsfemacs-mule-p + (not (eq (coding-system-base buffer-file-coding-system) + (coding-system-base 'raw-text-unix))) + (not (eq (coding-system-base buffer-file-coding-system) + (coding-system-base 'raw-text-mac))) + (not (eq (coding-system-base buffer-file-coding-system) + (coding-system-base 'raw-text-dos))) + (not (eq (coding-system-base buffer-file-coding-system) + (coding-system-base 'no-conversion)))) + (let ((buffer-read-only nil) + (omodified (buffer-modified-p))) + (unwind-protect + (progn + (encode-coding-region (point-min) (point-max) + buffer-file-coding-system) + (set-buffer-file-coding-system 'raw-text nil) + (decode-coding-region (point-min) (point-max) + buffer-file-coding-system)) + (set-buffer-modified-p omodified)))) + (vm-check-for-killed-summary) + (vm-check-for-killed-presentation) + ;; If the buffer's not modified then we know that there can be no + ;; messages in the folder that are not on disk. + (unless (buffer-modified-p) + (setq vm-messages-not-on-disk 0)) + (setq first-time (not (eq major-mode 'vm-mode)) + preserve-auto-save-file (and buffer-file-name + (not (buffer-modified-p)) + (file-newer-than-file-p + (make-auto-save-file-name) + buffer-file-name))) + (setq vm-folder-read-only (or preserve-auto-save-file read-only + (default-value 'vm-folder-read-only) + (and first-time buffer-read-only))) + ;; If this is not a VM mode buffer then some initialization + ;; needs to be done + (if first-time + (progn + (buffer-disable-undo (current-buffer)) + (abbrev-mode 0) + (auto-fill-mode 0) + ;; If an 8-bit message arrives undeclared the 8-bit + ;; characters in it should be displayed using the + ;; user's default face charset, rather than as octal + ;; escapes. + (vm-fsfemacs-nonmule-display-8bit-chars) + (vm-mode-internal access-method reload) + (if full-startup + (cond ((eq access-method 'pop) + (vm-set-folder-pop-maildrop-spec remote-spec)) + ((eq access-method 'imap) + (vm-set-folder-imap-maildrop-spec remote-spec) + (vm-register-folder-garbage + 'vm-kill-folder-imap-session nil) + ))) + ;; If the buffer is modified we don't know if the + ;; folder format has been changed to be different + ;; from index file, so don't read the index file in + ;; that case. + (if (not (buffer-modified-p)) + (setq did-read-index-file (vm-read-index-file-maybe))))) + + ;; builds message list, reads attributes if they weren't + ;; read from an index file. + ;; but that is not what the code is doing! - USR, 2011-04-24 + (unless revisit + (vm-assimilate-new-messages :read-attributes t + :gobble-order (not did-read-index-file) + :run-hooks nil)) + + (if (and first-time (not did-read-index-file)) + (progn + (vm-gobble-visible-header-variables) + (vm-gobble-bookmark) + (vm-gobble-pop-retrieved) + (vm-gobble-imap-retrieved) + (vm-gobble-summary) + (vm-gobble-labels))) + + ;; Recall the UID VALIDITY value stored in the cache folder + (cond ((eq access-method 'imap) + (if vm-imap-retrieved-messages + (vm-set-folder-imap-uid-validity + (vm-imap-recorded-uid-validity)))) + ((eq access-method 'pop) + ;; FIXME yet to be filled in + )) + + (if first-time + (vm-start-itimers-if-needed)) + + ;; make a new frame if the user wants one. reuse an + ;; existing frame that is showing this folder. + (if (and full-startup + ;; this so that "emacs -f vm" doesn't create a frame. + this-command) + (apply 'vm-goto-new-folder-frame-maybe + (if folder '(folder) '(primary-folder folder)))) + + ;; raise frame if requested and apply startup window + ;; configuration. + (if full-startup + (let ((buffer-to-display (or vm-summary-buffer + vm-presentation-buffer + (current-buffer)))) + (vm-display buffer-to-display buffer-to-display + (list this-command) + (list (or this-command 'vm) 'startup)) + (if vm-raise-frame-at-startup + (vm-raise-frame)))) + + ;; if the folder is being revisited, nothing more to be done + (if (and revisit (not first-time)) + (throw 'done t)) + + ;; say this NOW, before the non-previewers read a message, + ;; alter the new message count and confuse themselves. + (when full-startup + ;; save blurb so we can repeat it later as necessary. + (setq totals-blurb (vm-emit-totals-blurb)) + (if buffer-file-name + (vm-store-folder-totals buffer-file-name (cdr vm-totals)))) + + (vm-thoughtfully-select-message) + (vm-update-summary-and-mode-line) + ;; need to do this after any frame creation because the + ;; toolbar sets frame-specific height and width specifiers. + (vm-toolbar-install-or-uninstall-toolbar) + + (when (and vm-use-menus (vm-menu-support-possible-p)) + (vm-menu-install-visited-folders-menu)) + + (when full-startup + (if (and (vm-should-generate-summary) + ;; don't generate a summary if recover-file is + ;; likely to happen, since recover-file does + ;; not work in a summary buffer. + (not preserve-auto-save-file)) + (vm-summarize t nil)) + ;; raise the summary frame if the user wants frames + ;; raised and if there is a summary frame. + (if (and vm-summary-buffer + vm-mutable-frame-configuration + vm-frame-per-summary + vm-raise-frame-at-startup) + (vm-raise-frame)) + ;; if vm-mutable-window-configuration is nil, the startup + ;; configuration can't be applied, so do + ;; something to get a VM buffer on the screen + (if vm-mutable-window-configuration + (vm-display nil nil (list this-command) + (list (or this-command 'vm) 'startup)) + (save-excursion + (switch-to-buffer (or vm-summary-buffer + vm-presentation-buffer + (current-buffer)))))) + + (if vm-message-list + ;; don't decode MIME if recover-file is + ;; likely to happen, since recover-file does + ;; not work in a presentation buffer. + (let ((vm-auto-decode-mime-messages + (and vm-auto-decode-mime-messages + (not preserve-auto-save-file)))) + (vm-present-current-message))) + + (run-hooks 'vm-visit-folder-hook) + + ;; Warn user about auto save file, if appropriate. + (if preserve-auto-save-file + (vm-inform 0 + (substitute-command-keys + (concat + "Auto save file is newer; consider \\[vm-recover-folder]. " + "FOLDER IS READ ONLY.")))) + ;; if we're not doing a full startup or if doing more would + ;; trash the auto save file that we need to preserve, + ;; stop here. + (if (or (not full-startup) preserve-auto-save-file) + (throw 'done t)) + + (if (vm-interactive-p) + (vm-inform 5 totals-blurb)) + + (if (and vm-auto-get-new-mail + (not vm-block-new-mail) + (not vm-folder-read-only)) + (progn + (vm-inform 6 "Checking for new mail for %s..." + (or buffer-file-name (buffer-name))) + (if (vm-get-spooled-mail nil) ; automatic is non-interactive! + (progn + (setq totals-blurb (vm-emit-totals-blurb)) + (if (vm-thoughtfully-select-message) + (vm-present-current-message) + (vm-update-summary-and-mode-line)))) + (vm-inform 5 totals-blurb))) + + ;; Display copyright and copying info. + (when (and (vm-interactive-p) (not vm-startup-message-displayed)) + (vm-display-startup-message) + (if (not (input-pending-p)) + (vm-inform 5 totals-blurb)))))) + +;;;###autoload +(defun vm-other-frame (&optional folder read-only) + "Like vm, but run in a newly created frame." + (interactive (list nil current-prefix-arg)) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (if folder + (vm-goto-new-frame 'folder) + (vm-goto-new-frame 'primary-folder 'folder))) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm folder :read-only read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-other-window (&optional folder read-only) + "Like vm, but run in a different window." + (interactive (list nil current-prefix-arg)) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm folder :read-only read-only))) + +(put 'vm-mode 'mode-class 'special) + +;;;###autoload +(defun vm-mode (&optional read-only) + "Major mode for reading mail. + +This is VM. + +Use M-x vm-submit-bug-report to submit a bug report. + +Commands: +\\{vm-mode-map} + +Customize VM by setting variables and store them in the `vm-init-file'." + (interactive "P") + (vm (current-buffer) :read-only read-only) + (vm-display nil nil '(vm-mode) '(vm-mode))) + +;;;###autoload +(defun vm-visit-folder (folder &optional read-only revisit) + "Visit a mail file. +VM will parse and present its messages to you in the usual way. + +First arg FOLDER specifies the mail file to visit. When this +command is called interactively the file name is read from the +minibuffer. + +Prefix arg or optional second arg READ-ONLY non-nil indicates +that the folder should be considered read only. No attribute +changes, messages additions or deletions will be allowed in the +visited folder. + +The optional third arg REVISIT (not available interactively) says +that, if the folder is already visited, then it should be merely +selected without doing further processing (such as moving the +message-pointer or getting new mail)." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((default-directory (if vm-folder-directory + (expand-file-name vm-folder-directory) + default-directory)) + (default (or vm-last-visit-folder vm-last-save-folder)) + (this-command this-command) + (last-command last-command)) + (list (vm-read-file-name + (format "Visit%s folder:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + default-directory default nil nil 'vm-folder-history) + current-prefix-arg)))) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (setq vm-last-visit-folder folder) + (let ((access-method nil) foo) + (cond ((and (vm-pop-folder-spec-p folder) + (setq foo (vm-pop-find-name-for-spec folder))) + (setq folder foo + access-method 'pop + vm-last-visit-pop-folder folder)) + ((and (vm-imap-folder-spec-p folder) + ;;(setq foo (vm-imap-find-name-for-spec folder)) + ) + (setq ;; folder foo + access-method 'imap + vm-last-visit-imap-folder folder)) + (t + (let ((default-directory + (or vm-folder-directory default-directory))) + (setq folder (expand-file-name folder) + vm-last-visit-folder folder)))) + (vm folder + :read-only read-only :access-method access-method :revisit revisit))) + +;;;###autoload +(defun vm-visit-folder-other-frame (folder &optional read-only) + "Like vm-visit-folder, but run in a newly created frame." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((default-directory (if vm-folder-directory + (expand-file-name vm-folder-directory) + default-directory)) + (default (or vm-last-visit-folder vm-last-save-folder)) + (this-command this-command) + (last-command last-command)) + (list (vm-read-file-name + (format "Visit%s folder in other frame:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + default-directory default nil nil 'vm-folder-history) + current-prefix-arg)))) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-folder folder read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-visit-folder-other-window (folder &optional read-only) + "Like vm-visit-folder, but run in a different window." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((default-directory (if vm-folder-directory + (expand-file-name vm-folder-directory) + default-directory)) + (default (or vm-last-visit-folder vm-last-save-folder)) + (this-command this-command) + (last-command last-command)) + (list (vm-read-file-name + (format "Visit%s folder in other window:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + default-directory default nil nil 'vm-folder-history) + current-prefix-arg)))) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-folder folder read-only))) + +;;;###autoload +(defun vm-visit-thunderbird-folder (folder &optional read-only) + "Visit a mail file maintained by Thunderbird. +VM will parse and present its messages to you in the usual way. + +First arg FOLDER specifies the mail file to visit. When this +command is called interactively the file name is read from the +minibuffer. + +Prefix arg or optional second arg READ-ONLY non-nil indicates +that the folder should be considered read only. No attribute +changes, messages additions or deletions will be allowed in the +visited folder. + +This function differs from `vm-visit-folder' in that it remembers that +the folder is a foreign folder maintained by Thunderbird. Saving +of messages is carried out preferentially to other Thunderbird folders." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (let ((default-directory + (if vm-thunderbird-folder-directory + (expand-file-name vm-thunderbird-folder-directory) + default-directory)) + (default (or vm-last-visit-folder vm-last-save-folder)) + (this-command this-command) + (last-command last-command)) + (list (vm-read-file-name + (format "Visit%s folder:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + default-directory default nil nil 'vm-folder-history) + current-prefix-arg)))) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (setq vm-last-visit-folder folder) + (let ((default-directory + (or vm-thunderbird-folder-directory default-directory))) + (setq folder (expand-file-name folder) + vm-last-visit-folder folder)) + (vm folder :read-only read-only) + (set (make-local-variable 'vm-foreign-folder-directory) + vm-thunderbird-folder-directory) + ) + +;;;###autoload +(defun vm-visit-pop-folder (folder &optional read-only) + "Visit a POP mailbox. +VM will present its messages to you in the usual way. Messages +found in the POP mailbox will be downloaded and stored in a local +cache. If you expunge messages from the cache, the corresponding +messages will be expunged from the POP mailbox. + +First arg FOLDER specifies the name of the POP mailbox to visit. +You can only visit mailboxes that are specified in `vm-pop-folder-alist'. +When this command is called interactively the mailbox name is read from the +minibuffer. + +Prefix arg or optional second arg READ-ONLY non-nil indicates +that the folder should be considered read only. No attribute +changes, messages additions or deletions will be allowed in the +visited folder." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-pop) + (let ((completion-list (mapcar (function (lambda (x) (nth 1 x))) + vm-pop-folder-alist)) + (default vm-last-visit-pop-folder) + (this-command this-command) + (last-command last-command)) + (list (vm-read-string + (format "Visit%s POP folder:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + completion-list) + current-prefix-arg)))) + (let (remote-spec) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (if (and (equal folder "") (stringp vm-last-visit-pop-folder)) + (setq folder vm-last-visit-pop-folder)) + (setq vm-last-visit-pop-folder folder) + (setq remote-spec (vm-pop-find-spec-for-name folder)) + (if (null remote-spec) + (error "No such POP folder: %s" folder)) + (vm remote-spec :read-only read-only :access-method 'pop))) + +;;;###autoload +(defun vm-visit-pop-folder-other-frame (folder &optional read-only) + "Like vm-visit-pop-folder, but run in a newly created frame." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-pop) + (let ((completion-list (mapcar (function (lambda (x) (nth 1 x))) + vm-pop-folder-alist)) + (default vm-last-visit-pop-folder) + (this-command this-command) + (last-command last-command)) + (list (vm-read-string + (format "Visit%s POP folder:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + completion-list) + current-prefix-arg)))) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-pop-folder folder read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-visit-pop-folder-other-window (folder &optional read-only) + "Like vm-visit-pop-folder, but run in a different window." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-pop) + (let ((completion-list (mapcar (function (lambda (x) (nth 1 x))) + vm-pop-folder-alist)) + (default vm-last-visit-pop-folder) + (this-command this-command) + (last-command last-command)) + (list (vm-read-string + (format "Visit%s POP folder:%s " + (if current-prefix-arg " read only" "") + (if default + (format " (default %s)" default) + "")) + completion-list) + current-prefix-arg)))) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-pop-folder folder read-only))) + +;;;###autoload +(defun vm-visit-imap-folder (folder &optional read-only) + "Visit a IMAP mailbox. +VM will present its messages to you in the usual way. Messages +found in the IMAP mailbox will be downloaded and stored in a local +cache. If you expunge messages from the cache, the corresponding +messages will be expunged from the IMAP mailbox when the folder is +saved. + +When this command is called interactively, the FOLDER name will +be read from the minibuffer in the format +\"account-name:folder-name\", where account-name is the short +name of an IMAP account listed in `vm-imap-account-alist' and +folder-name is a folder in this account. + +Prefix arg or optional second arg READ-ONLY non-nil indicates +that the folder should be considered read only. No attribute +changes, messages additions or deletions will be allowed in the +visited folder." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-imap) + (let ((this-command this-command) + (last-command last-command)) + (if (null vm-imap-account-alist) + (setq vm-imap-account-alist + (mapcar + 'reverse + (with-no-warnings + (vm-imap-spec-list-to-host-alist vm-imap-server-list))))) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + t nil vm-last-visit-imap-folder) + current-prefix-arg)))) + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (setq vm-last-visit-imap-folder folder) + (vm folder :read-only read-only :access-method 'imap)) + +;;;###autoload +(defun vm-visit-imap-folder-other-frame (folder &optional read-only) + "Like vm-visit-imap-folder, but run in a newly created frame." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-imap) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + nil nil vm-last-visit-imap-folder) + current-prefix-arg)))) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-imap-folder folder read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-visit-imap-folder-other-window (folder &optional read-only) + "Like vm-visit-imap-folder, but run in a different window." + (interactive + (save-current-buffer + (vm-session-initialization) + (vm-check-for-killed-folder) + (vm-select-folder-buffer-if-possible) + (require 'vm-imap) + (let ((this-command this-command) + (last-command last-command)) + (list (vm-read-imap-folder-name + (format "Visit%s IMAP folder: " + (if current-prefix-arg " read only" "")) + nil nil vm-last-visit-imap-folder) + current-prefix-arg)))) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-imap-folder folder read-only))) + + +;;;###autoload +(defun vm-folder-buffers (&optional non-virtual) + "Return the list of buffer names that are currently visiting VM +folders. The optional argument NON-VIRTUAL says that only +non-virtual folders should be returned." + (save-excursion + (let ((buffers (buffer-list)) + (modes (if non-virtual '(vm-mode) '(vm-mode vm-virtual-mode))) + folders) + (while buffers + (set-buffer (car buffers)) + (if (member major-mode modes) + (setq folders (cons (buffer-name) folders))) + (setq buffers (cdr buffers))) + folders))) +(defalias 'vm-folder-list 'vm-folder-buffers) + +;; The following function is from vm-rfaddons.el. USR, 2011-02-28 +;;;###autoload +(defun vm-switch-to-folder (folder-name) + "Switch to another opened VM folder and rearrange windows as with a scroll." + (interactive (list + (let* ((buffers (vm-folder-buffers)) + (history vm-switch-to-folder-history) + pos default) + (if (member major-mode + '(vm-mode vm-presentation-mode + vm-summary-mode)) + (save-excursion + (vm-select-folder-buffer) + (setq buffers (delete (buffer-name) buffers)))) + (setq pos (vm-find history + (lambda (f) (member f buffers)))) + (if pos (setq default (nth pos history))) + (completing-read + (format "Foldername%s: " + (if default (format " (%s)" default) "")) + (mapcar (lambda (b) (list b)) (vm-folder-buffers)) + nil t nil + 'vm-switch-to-folder-history + default)))) + + (switch-to-buffer folder-name) + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p)) + (vm-summarize) + (let ((this-command 'vm-scroll-backward)) + (vm-display nil nil '(vm-scroll-forward vm-scroll-backward) + (list this-command 'reading-message)) + (vm-update-summary-and-mode-line))) + +;;;###autoload +(defun vm-get-folder-buffer (folder) + "Returns the buffer visiting FOLDER if it exists, nil otherwise." + (let ((buffers (vm-folder-buffers)) + pos) + (setq pos + (vm-find buffers + (lambda (b) + (with-current-buffer b + (equal folder (vm-folder-name)))))) + (and pos (get-buffer (nth pos buffers))))) + + +(put 'vm-virtual-mode 'mode-class 'special) + +(defun vm-virtual-mode (&rest ignored) + "Mode for reading multiple mail folders as one folder. + +The commands available are the same commands that are found in +vm-mode, except that a few of them are not applicable to virtual +folders. + +vm-virtual-mode is not a normal major mode. If you run it, it +will not do anything. The entry point to vm-virtual-mode is +vm-visit-virtual-folder.") + +(defvar scroll-in-place) + +;;;###autoload +(defun vm-visit-virtual-folder (folder-name &optional read-only bookmark) + (interactive + (let ((last-command last-command) + (this-command this-command)) + (vm-session-initialization) + (list + (vm-read-string (format "Visit%s virtual folder: " + (if current-prefix-arg " read only" "")) + vm-virtual-folder-alist) + current-prefix-arg))) + (vm-session-initialization) + (require 'vm-virtual) + (unless (assoc folder-name vm-virtual-folder-alist) + (error "No such virtual folder, %s" folder-name)) + (let ((buffer-name (concat "(" folder-name ")")) + first-time blurb) + (set-buffer (get-buffer-create buffer-name)) + (setq first-time (not (eq major-mode 'vm-virtual-mode))) + (when first-time + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (abbrev-mode 0) + (auto-fill-mode 0) + (vm-fsfemacs-nonmule-display-8bit-chars) + (setq mode-name "VM Virtual" + mode-line-format vm-mode-line-format + buffer-read-only t + vm-folder-read-only read-only + vm-label-obarray (make-vector 29 0) + vm-virtual-folder-definition + (assoc folder-name vm-virtual-folder-alist)) + ;; scroll in place messes with scroll-up and this loses + (make-local-variable 'scroll-in-place) + (setq scroll-in-place nil) + (vm-build-virtual-message-list nil) + (use-local-map vm-mode-map) + (when (vm-menu-support-possible-p) + (vm-menu-install-menus)) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-folder) + (add-hook 'kill-buffer-hook 'vm-garbage-collect-message) + ;; save this for last in case the user interrupts. + ;; an interrupt anywhere before this point will cause + ;; everything to be redone next revisit. + (setq major-mode 'vm-virtual-mode) + (run-hooks 'vm-virtual-mode-hook) + ;; must come after the setting of major-mode + (setq mode-popup-menu (and vm-use-menus + (vm-menu-support-possible-p) + (vm-menu-mode-menu))) + (setq blurb (vm-emit-totals-blurb)) + (when vm-summary-show-threads + (vm-sort-messages "activity")) + (if bookmark + (let ((mp vm-message-list)) + (while mp + (if (eq bookmark (vm-real-message-of (car mp))) + (progn + (vm-record-and-change-message-pointer + vm-message-pointer mp) + (vm-present-current-message) + (setq mp nil)) + (setq mp (cdr mp)))))) + (unless vm-message-pointer + (if (vm-thoughtfully-select-message) + (vm-present-current-message) + (vm-update-summary-and-mode-line))) + (vm-inform 5 blurb)) + ;; make a new frame if the user wants one. reuse an + ;; existing frame that is showing this folder. + (vm-goto-new-folder-frame-maybe 'folder) + (if vm-raise-frame-at-startup + (vm-raise-frame)) + (vm-display nil nil (list this-command) (list this-command 'startup)) + (vm-toolbar-install-or-uninstall-toolbar) + (when first-time + (when (vm-should-generate-summary) + (vm-summarize t nil) + (vm-inform 5 blurb)) + ;; raise the summary frame if the user wants frames + ;; raised and if there is a summary frame. + (when (and vm-summary-buffer + vm-mutable-frame-configuration + vm-frame-per-summary + vm-raise-frame-at-startup) + (vm-raise-frame)) + ;; if vm-mutable-window-configuration is nil, the startup + ;; configuration can't be applied, so do + ;; something to get a VM buffer on the screen + (if vm-mutable-window-configuration + (vm-display nil nil (list this-command) + (list (or this-command 'vm) 'startup)) + (save-excursion + (switch-to-buffer (or vm-summary-buffer + vm-presentation-buffer + (current-buffer)))))) + + ;; check interactive-p so as not to bog the user down if they + ;; run this function from within another function. + (when (and (vm-interactive-p) + (not vm-startup-message-displayed)) + (vm-display-startup-message) + (vm-inform 5 blurb)))) + +;;;###autoload +(defun vm-visit-virtual-folder-other-frame (folder-name &optional read-only) + "Like vm-visit-virtual-folder, but run in a newly created frame." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (vm-session-initialization) + (list + (vm-read-string (format "Visit%s virtual folder in other frame: " + (if current-prefix-arg " read only" "")) + vm-virtual-folder-alist) + current-prefix-arg))) + (vm-session-initialization) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'folder)) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-virtual-folder folder-name read-only)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-visit-virtual-folder-other-window (folder-name &optional read-only) + "Like vm-visit-virtual-folder, but run in a different window." + (interactive + (let ((last-command last-command) + (this-command this-command)) + (vm-session-initialization) + (list + (vm-read-string (format "Visit%s virtual folder in other window: " + (if current-prefix-arg " read only" "")) + vm-virtual-folder-alist) + current-prefix-arg))) + (vm-session-initialization) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-folder nil) + (vm-search-other-frames nil)) + (vm-visit-virtual-folder folder-name read-only))) + +;;;###autoload +(defun vm-mail (&optional to subject) + "Send a mail message from within VM, or from without. +Optional argument TO is a string that should contain a comma separated +recipient list." + (interactive) + (vm-session-initialization) + (vm-check-for-killed-folder) + (let ((guess (when (null to) + (vm-select-recipient-from-sender)))) + (vm-select-folder-buffer-if-possible) + (vm-check-for-killed-summary) + (vm-mail-internal :to to :guessed-to guess :subject subject) + (run-hooks 'vm-mail-hook) + (run-hooks 'vm-mail-mode-hook))) + +;;;###autoload +(defun vm-mail-other-frame (&optional to) + "Like vm-mail, but run in a newly created frame. +Optional argument TO is a string that should contain a comma separated +recipient list." + (interactive) + (vm-session-initialization) + (when (null to) + (setq to (vm-select-recipient-from-sender))) + (if (vm-multiple-frames-possible-p) + (vm-goto-new-frame 'composition)) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-mail to)) + (if (vm-multiple-frames-possible-p) + (vm-set-hooks-for-frame-deletion))) + +;;;###autoload +(defun vm-mail-other-window (&optional to) + "Like vm-mail, but run in a different window. +Optional argument TO is a string that should contain a comma separated +recipient list." + (interactive) + (vm-session-initialization) + (when (null to) + (setq to (vm-select-recipient-from-sender))) + (if (one-window-p t) + (split-window)) + (other-window 1) + (let ((vm-frame-per-composition nil) + (vm-search-other-frames nil)) + (vm-mail to))) + +(fset 'vm-folders-summary-mode 'vm-mode) +(put 'vm-folders-summary-mode 'mode-class 'special) + +;;;###autoload +(defun vm-folders-summarize (&optional display raise) + "Generate a summary of the folders in your folder directories. +Set `vm-folders-summary-directories' to specify the folder directories. +Press RETURN or click mouse button 2 on an entry in the folders +summary buffer to select a folder." + (interactive "p\np") + (vm-session-initialization) + (vm-check-for-killed-summary) + (if (not (featurep 'berkeley-db)) + (error "Berkeley DB support needed to run this command")) + (if (null vm-folders-summary-database) + (error "'vm-folders-summary-database' must be non-nil to run this command")) + (if (null vm-folders-summary-buffer) + (let ((folder-buffer (and (eq major-mode 'vm-mode) + (current-buffer))) + (summary-buffer-name "VM Folders Summary")) + (setq vm-folders-summary-buffer + (or (get-buffer summary-buffer-name) + (vm-generate-new-multibyte-buffer summary-buffer-name))) + (save-excursion + (set-buffer vm-folders-summary-buffer) + (abbrev-mode 0) + (auto-fill-mode 0) + (vm-fsfemacs-nonmule-display-8bit-chars) + (if (fboundp 'buffer-disable-undo) + (buffer-disable-undo (current-buffer)) + ;; obfuscation to make the v19 compiler not whine + ;; about obsolete functions. + (let ((x 'buffer-flush-undo)) + (funcall x (current-buffer)))) + (vm-folders-summary-mode-internal)) + (vm-make-folders-summary-associative-hashes) + (vm-do-folders-summary))) + ;; if this command was run from a VM related buffer, select + ;; the folder buffer in the folders summary, but only if that + ;; folder has an entry there. + (and vm-mail-buffer + (vm-check-for-killed-folder)) + (save-excursion + (and vm-mail-buffer + (vm-select-folder-buffer-and-validate 0 (vm-interactive-p))) + (vm-check-for-killed-summary) + (let ((folder-buffer (and (eq major-mode 'vm-mode) + (current-buffer))) + fs ) + (if (or (null vm-folders-summary-hash) (null folder-buffer) + (null buffer-file-name)) + nil + (setq fs (symbol-value (intern-soft (vm-make-folders-summary-key + buffer-file-name) + vm-folders-summary-hash))) + (if (null fs) + nil + (vm-mark-for-folders-summary-update buffer-file-name) + (set-buffer vm-folders-summary-buffer) + (setq vm-mail-buffer folder-buffer))))) + (if display + (save-excursion + (vm-goto-new-folders-summary-frame-maybe) + (vm-display vm-folders-summary-buffer t + '(vm-folders-summarize) + (list this-command) (not raise)) + ;; need to do this after any frame creation because the + ;; toolbar sets frame-specific height and width specifiers. + (set-buffer vm-folders-summary-buffer) + (vm-toolbar-install-or-uninstall-toolbar)) + (vm-display nil nil '(vm-folders-summarize) + (list this-command))) + (vm-update-summary-and-mode-line)) + +(defvar mail-reply-action) +(defvar mail-send-actions) +(defvar mail-return-action) + +;;;###autoload +(defun vm-compose-mail (&optional to subject other-headers continue + switch-function yank-action + send-actions return-action &rest ignored) + (interactive) + (vm-session-initialization) + (if continue + (vm-continue-composing-message) + (let ((buffer (vm-mail-internal + :buffer-name (if to + (format "message to %s" + (vm-truncate-roman-string to 20)) + nil) + :to to :subject subject))) + (goto-char (point-min)) + (re-search-forward (concat "^" mail-header-separator "$")) + (beginning-of-line) + (while other-headers + (insert (car (car other-headers))) + (while (eq (char-syntax (char-before (point))) ?\ ) + (delete-char -1)) + (while (eq (char-before (point)) ?:) + (delete-char -1)) + (insert ": " (cdr (car other-headers))) + (if (not (eq (char-before (point)) ?\n)) + (insert "\n")) + (setq other-headers (cdr other-headers))) + (cond ((null to) + (mail-position-on-field "To")) + ((null subject) + (mail-position-on-field "Subject")) + (t + (mail-text))) + (funcall (or switch-function (function switch-to-buffer)) + (current-buffer)) + (if yank-action + (save-excursion + (mail-text) + (apply (car yank-action) (cdr yank-action)) + (push-mark (point)) + (mail-text) + (cond (mail-citation-hook (run-hooks 'mail-citation-hook)) + (mail-yank-hooks (run-hooks 'mail-yank-hooks)) + (t (vm-mail-yank-default))))) + (make-local-variable 'mail-send-actions) + (setq mail-send-actions send-actions) + (make-local-variable 'mail-return-action) + (setq mail-return-action return-action)))) + +;;;###autoload +(defun vm-submit-bug-report (&optional pre-hooks post-hooks) + "Submit a bug report, with pertinent information to the VM bug list." + (interactive) + (require 'reporter) + (vm-session-initialization) + ;; Use VM to send the bug report. Could be trouble if vm-mail + ;; is what the user wants to complain about. But most of the + ;; time we'll be fine and users like to use MIME to attach + ;; stuff to the reports. + (let ((reporter-mailer '(vm-mail)) + (mail-user-agent 'vm-user-agent) + varlist (errors 0)) + (setq varlist (apropos-internal "^\\(vm\\|vmpc\\)-" 'user-variable-p) + varlist (sort varlist + (lambda (v1 v2) + (string-lessp (format "%s" v1) (format "%s" v2))))) + (when (and (eq vm-mime-text/html-handler 'emacs-w3m) + (boundp 'emacs-w3m-version)) + (nconc varlist (list 'emacs-w3m-version 'w3m-version + 'w3m-goto-article-function))) + (let ((fill-column (1- (window-width))) ; turn off auto-fill + (mail-user-agent 'message-user-agent) ; use the default + ; mail-user-agent for bug reports + (vars-to-delete + '(vm-auto-folder-alist ; a bit private + vm-mail-folder-alist ; ditto + vm-virtual-folder-alist ; ditto + ;; vm-mail-fcc-default - is this private? + vmpc-actions vmpc-conditions + vmpc-actions-alist vmpc-reply-alist vmpc-forward-alist + vmpc-resend-alist vmpc-newmail-alist vmpc-automorph-alist + ;; email addresses + vm-mail-header-from + vm-mail-return-receipt-to + vm-summary-uninteresting-senders + ;; obsolete-variables + vm-imap-server-list + )) + ;; delete any passwords stored in maildrop strings + (vm-spool-files + (condition-case nil + (if (listp (car vm-spool-files)) + (vm-mapcar + (lambda (elem-xyz) + (vm-mapcar (function vm-maildrop-sans-personal-info) + elem-xyz))) + (vm-mapcar (function vm-maildrop-sans-personal-info) + vm-spool-files)) + (error (vm-increment errors) vm-spool-files))) + (vm-pop-folder-alist + (condition-case nil + (vm-maildrop-alist-sans-personal-info + vm-pop-folder-alist) + (error (vm-increment errors) vm-pop-folder-alist))) + ;; (vm-imap-server-list + ;; (with-no-warnings + ;; (condition-case nil + ;; (vm-mapcar (function vm-maildrop-sans-personal-info) + ;; vm-imap-server-list) + ;; (error (vm-increment errors) vm-imap-server-list)))) + (vm-imap-account-alist + (condition-case nil + (vm-maildrop-alist-sans-personal-info + vm-imap-account-alist) + (error (vm-increment errors) vm-imap-account-alist))) + (vm-pop-auto-expunge-alist + (condition-case nil + (vm-maildrop-alist-sans-personal-info + vm-pop-auto-expunge-alist) + (error (vm-increment errors) vm-pop-auto-expunge-alist))) + (vm-imap-auto-expunge-alist + (condition-case nil + (vm-maildrop-alist-sans-personal-info + vm-imap-auto-expunge-alist) + (error (vm-increment errors) vm-imap-auto-expunge-alist)))) + (while vars-to-delete + (setq varlist (delete (car vars-to-delete) varlist) + vars-to-delete (cdr vars-to-delete))) + ;; see what the user had loaded + (setq varlist (append (list 'features) varlist)) + (delete-other-windows) + (reporter-submit-bug-report + vm-maintainer-address ; address + (concat "VM " (vm-version)) ; pkgname + varlist ; varlist + pre-hooks ; pre-hooks + post-hooks ; post-hooks + (concat ; salutation + "INSTRUCTIONS: +- Please change the Subject header to a concise bug description. + +- In this report, remember to cover the basics, that is, what you + expected to happen and what in fact did happen and how to reproduce it. + +- You may attach sample messages or attachments that can be used to + reproduce the problem. + +- Mail sent to viewmail-bugs@nongnu.org is only viewed by VM + maintainers and it is not made public. + +- You may remove these instructions and other stuff which is unrelated + to the bug from your message. +" + (if (> errors 0) + " +- The raw definitions for some of the mail configurations are included + below because there were errors in cleaning them. Please replace any + sensitive information by xxxx.")) + ) + (goto-char (point-min)) + (mail-position-on-field "Subject")))) + +(defun vm-edit-init-file () + "Edit the `vm-init-file'." + (interactive) + (find-file-other-frame vm-init-file)) + +(defun vm-check-emacs-version () + "Checks the version of Emacs and gives an error if it is unsupported." + (cond ((and vm-xemacs-p (< emacs-major-version 21)) + (error "VM %s must be run on XEmacs 21 or a later version." + (vm-version))) + ((and vm-fsfemacs-p (< emacs-major-version 21)) + (error "VM %s must be run on GNU Emacs 21 or a later version." + (vm-version))))) + +;; This function is now defunct. USR, 2011-11-12 + +;; (defun vm-set-debug-flags () +;; (or stack-trace-on-error +;; debug-on-error +;; (setq stack-trace-on-error +;; '( +;; wrong-type-argument +;; wrong-number-of-arguments +;; args-out-of-range +;; void-function +;; void-variable +;; invalid-function +;; )))) + +(defun vm-toggle-thread-operations () + "Toggle the variable `vm-enable-thread-operations'. + +If enabled, VM operations on root messages of collapsed threads +will apply to all the messages in the threads. If disabled, VM +operations only apply to individual messages. + +\"Operations\" in this context include deleting, saving, setting +attributes, adding/deleting labels etc." + (interactive) + (setq vm-enable-thread-operations (not vm-enable-thread-operations)) + (if vm-enable-thread-operations + (vm-inform 5 "Thread operations enabled") + (vm-inform 5 "Thread operations disabled"))) + +(defvar vm-postponed-folder) + +(defvar vm-drafts-exist nil) + +(defvar vm-ml-draft-count "" + "The current number of drafts in the `vm-postponed-folder'.") + +(defvar vm-postponed-folder) + +;;;###autoload +(defun vm-update-draft-count () + "Check number of postponed messages in folder `vm-postponed-folder'." + (let ((f (expand-file-name vm-postponed-folder vm-folder-directory))) + (if (or (not (file-exists-p f)) (= (nth 7 (file-attributes f)) 0)) + (setq vm-drafts-exist nil) + (let ((mtime (nth 5 (file-attributes f)))) + (when (not (equal vm-drafts-exist mtime)) + (setq vm-drafts-exist mtime) + (setq vm-ml-draft-count (format "%d postponed" + (vm-count-messages-in-file f)))))))) + +;;;###autoload +(defun vm-session-initialization () + "If this is the first time VM has been run in this Emacs session, +do some necessary preparations. Otherwise, update the count of +draft messages." + ;; (vm-set-debug-flags) + (if (or (not (boundp 'vm-session-beginning)) + vm-session-beginning) + (progn + (vm-check-emacs-version) + (require 'vm-macro) + (require 'vm-vars) + (require 'vm-misc) + (require 'vm-message) + (require 'vm-minibuf) + (require 'vm-motion) + (require 'vm-page) + (require 'vm-mouse) + (require 'vm-summary) + (require 'vm-summary-faces) + (require 'vm-undo) + (require 'vm-mime) + (require 'vm-folder) + (require 'vm-toolbar) + (require 'vm-window) + (require 'vm-menu) + (require 'vm-rfaddons) + ;; The default loading of vm-pgg is disabled because it is an + ;; add-on. If and when it is integrated into VM, without advices + ;; and other add-on features, then it can be loaded by + ;; default. USR, 2010-01-14 + ;; (if (locate-library "pgg") + ;; (require 'vm-pgg) + ;; (message "vm-pgg disabled since pgg is missing!")) + (add-hook 'kill-emacs-hook 'vm-garbage-collect-global) + (vm-load-init-file) + (when vm-enable-addons + (vm-rfaddons-infect-vm 0 vm-enable-addons)) + (if (not vm-window-configuration-file) + (setq vm-window-configurations vm-default-window-configuration) + (or (vm-load-window-configurations vm-window-configuration-file) + (setq vm-window-configurations vm-default-window-configuration))) + (setq vm-buffers-needing-display-update (make-vector 29 0)) + (setq vm-buffers-needing-undo-boundaries (make-vector 29 0)) + (add-hook 'post-command-hook 'vm-add-undo-boundaries) + (if (if vm-xemacs-p + (find-face 'vm-monochrome-image) + (facep 'vm-monochrome-image)) + nil + (make-face 'vm-monochrome-image) + (set-face-background 'vm-monochrome-image "white") + (set-face-foreground 'vm-monochrome-image "black")) + (if (or (not vm-fsfemacs-p) + ;; don't need this face under Emacs 21. + (fboundp 'image-type-available-p) + (facep 'vm-image-placeholder)) + nil + (make-face 'vm-image-placeholder) + (if (fboundp 'set-face-stipple) + (set-face-stipple 'vm-image-placeholder + (list 16 16 + (concat "UU\377\377UU\377\377UU\377\377" + "UU\377\377UU\377\377UU\377\377" + "UU\377\377UU\377\377"))))) + (and (vm-mouse-support-possible-p) + (vm-mouse-install-mouse)) + (and (vm-menu-support-possible-p) + vm-use-menus + (vm-menu-fsfemacs-menus-p) + (vm-menu-initialize-vm-mode-menu-map)) + (setq vm-session-beginning nil))) + ;; check for postponed messages + (vm-update-draft-count)) + +;;;###autoload +(if (fboundp 'define-mail-user-agent) + (define-mail-user-agent 'vm-user-agent + (function vm-compose-mail) ; compose function + (function vm-mail-send-and-exit) ; send function + nil ; abort function (kill-buffer) + nil) ; hook variable (mail-send-hook) +) + +(autoload 'reporter-submit-bug-report "reporter") +(autoload 'timezone-make-date-sortable "timezone") +(autoload 'rfc822-addresses "rfc822") +(autoload 'mail-strip-quoted-names "mail-utils") +(autoload 'mail-fetch-field "mail-utils") +(autoload 'mail-position-on-field "mail-utils") +(autoload 'mail-send "sendmail") +(autoload 'mail-mode "sendmail") +(autoload 'mail-extract-address-components "mail-extr") +(autoload 'set-tapestry "tapestry") +(autoload 'tapestry "tapestry") +(autoload 'tapestry-replace-tapestry-element "tapestry") +(autoload 'tapestry-nullify-tapestry-elements "tapestry") +(autoload 'tapestry-remove-frame-parameters "tapestry") + +;;; vm.el ends here diff --git a/pixmaps/Makefile.in b/pixmaps/Makefile.in new file mode 100755 index 0000000..96712f5 --- /dev/null +++ b/pixmaps/Makefile.in @@ -0,0 +1,56 @@ +@SET_MAKE@ + +# no csh please +SHELL = /bin/sh + +############################################################################## +# location of required programms +prefix = @prefix@ +MKDIR = @MKDIR@ +RM = @RM@ +LS = @LS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ + +srcdir = @srcdir@ +datadir= @datadir@ +datarootdir= @datarootdir@ +pixmapdir = @pixmapdir@ + +SYMLINKS = @SYMLINKS@ +LINKPATH = @LINKPATH@ + +############################################################################## + +all: + +Makefile: @srcdir@/Makefile.in + cd @srcdir@/..; ./config.status + +install: install-pkg + +install-pkg: + $(MKDIR) -p "$(DESTDIR)$(pixmapdir)" + for i in `$(LS) *.xpm` ; do \ + echo "Installing $$i in '$(DESTDIR)$(pixmapdir)'" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(pixmapdir)" ; \ + done ; + $(MKDIR) -p "$(DESTDIR)$(pixmapdir)/mime" + for i in `ls mime/*.xpm` ; do \ + echo "Installing $$i in '$(DESTDIR)$(pixmapdir)'" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(pixmapdir)/mime" ; \ + done ; + $(MKDIR) -p "$(DESTDIR)$(pixmapdir)/gtk" + for i in `ls gtk/*.xpm` ; do \ + echo "Installing $$i in '$(DESTDIR)$(pixmapdir)'" ; \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(pixmapdir)/gtk" ; \ + done ; + @echo VM pixmaps successfully installed\! + +############################################################################## +clean: + -$(RM) -f *~ + +distclean: clean + -$(RM) -f Makefile + diff --git a/pixmaps/autofile-dn.xpm b/pixmaps/autofile-dn.xpm new file mode 100755 index 0000000..bd128d7 --- /dev/null +++ b/pixmaps/autofile-dn.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * autofile_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #808080", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" # # ", +" # # # ", +" # # # # ### ## ", +" ##### # # # # # ", +" # # # # # # # ", +" # # # ## # # # ", +" # # # # # ## ", +" ", +" ", +" "}; diff --git a/pixmaps/autofile-up.xpm b/pixmaps/autofile-up.xpm new file mode 100755 index 0000000..1fec9b0 --- /dev/null +++ b/pixmaps/autofile-up.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * autofile_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" # # ", +" # # # ", +" # # # # ### ## ", +" ##### # # # # # ", +" # # # # # # # ", +" # # # ## # # # ", +" # # # # # ## ", +" ", +" ", +" "}; diff --git a/pixmaps/compose-dn.xpm b/pixmaps/compose-dn.xpm new file mode 100755 index 0000000..cc2e2cb --- /dev/null +++ b/pixmaps/compose-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * compose-up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"+ c #CCCCCC", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"# c #808080", +" ", +" ", +" B ", +" B B B ", +" B B B ", +" BBB ", +" BBBBBBBBB ", +" BBB ", +" B B_B_BBBBBBBBBBBBBBB ", +" B B_.B..............B_ ", +" Bx.............BB.B_x ", +" x.............BB.B_x ", +" B....BBBBBB......B_x ", +" B................B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" # # ", +" ## # ", +" # # # ## # # ", +" # ## # # # # # ", +" # # #### # # # ", +" # # # # # # ", +" # # ### # # ", +" ", +" ", +" "}; diff --git a/pixmaps/compose-up.xpm b/pixmaps/compose-up.xpm new file mode 100755 index 0000000..4a5ec7b --- /dev/null +++ b/pixmaps/compose-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * compose-up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"+ c #CCCCCC", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" B ", +" B B B ", +" B B B ", +" BBB ", +" BBBBBBBBB ", +" BBB ", +" B B_B_BBBBBBBBBBBBBBB ", +" B B_.B..............B_ ", +" Bx.............BB.B_x ", +" x.............BB.B_x ", +" B....BBBBBB......B_x ", +" B................B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" # # ", +" ## # ", +" # # # ## # # ", +" # ## # # # # # ", +" # # #### # # # ", +" # # # # # # ", +" # # ### # # ", +" ", +" ", +" "}; diff --git a/pixmaps/delete-dn.xpm b/pixmaps/delete-dn.xpm new file mode 100755 index 0000000..345b0e2 --- /dev/null +++ b/pixmaps/delete-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * delete_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" BB B...BB BB_x ", +" _BB B%%%B.B BB___x ", +" x__BB%++BBBBB__xxxx ", +" xx_BBB++BBB_xx ", +" xB__BB__B_x ", +" BBB__BBB_x ", +" BB__..__BBx ", +" BB_B..%%%%B_BB ", +" BB__xB%%++++B___BB_x ", +" _xx BBBBBBBB_xx___x ", +" ________x xxxx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" #### # # ", +" # # # # ", +" # # ## # ## ### ## ", +" # # # # # # # # # # ", +" # # #### # #### # #### ", +" # # # # # # # ", +" #### ### # ### # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/delete-up.xpm b/pixmaps/delete-up.xpm new file mode 100755 index 0000000..e893eb8 --- /dev/null +++ b/pixmaps/delete-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * delete_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" BB B...BB BB_x ", +" _BB B%%%B.B BB___x ", +" x__BB%++BBBBB__xxxx ", +" xx_BBB++BBB_xx ", +" xB__BB__B_x ", +" BBB__BBB_x ", +" BB__..__BBx ", +" BB_B..%%%%B_BB ", +" BB__xB%%++++B___BB_x ", +" _xx BBBBBBBB_xx___x ", +" ________x xxxx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" #### # # ", +" # # # # ", +" # # ## # ## ### ## ", +" # # # # # # # # # # ", +" # # #### # #### # #### ", +" # # # # # # # ", +" #### ### # ### # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/file-dn.xpm b/pixmaps/file-dn.xpm new file mode 100755 index 0000000..d3aa629 --- /dev/null +++ b/pixmaps/file-dn.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * file_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #808080", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" #### # ", +" # # ", +" # # # ## ", +" ### # # # ", +" # # # #### ", +" # # # # ", +" # # # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/file-up.xpm b/pixmaps/file-up.xpm new file mode 100755 index 0000000..fae676a --- /dev/null +++ b/pixmaps/file-up.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * file_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" #### # ", +" # # ", +" # # # ## ", +" ### # # # ", +" # # # #### ", +" # # # # ", +" # # # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/followup-dn.xpm b/pixmaps/followup-dn.xpm new file mode 100755 index 0000000..fe98c6d --- /dev/null +++ b/pixmaps/followup-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * followup_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"_ c #888888", +"+ c #CCCCCC", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" B ", +" B B BB_BBBBBBBBBBBBBB ", +" B% B% B.B..............B_ ", +" B%xB%xB.%BBBBBB......BB.B_x ", +" B%xB%xB.%+%%%%%B......BB.B_x ", +" B%xB%xB.%+++++++BxBB......B_x ", +" B%xB%xB%+++++++B_........B_x ", +" _B%xB%xB%%BBBBBB_B.......B_x ", +" _B%xB%xB%B______........B_x ", +" _B%xB%xBB_BBBBBBBBBBBBBB_x ", +" _______B________________x ", +" xx xx __xxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" #### # # ", +" # # # ", +" # ## # # ## # # # ", +" ### # # # # # # # # # ", +" # # # # # # # # # # ", +" # # # # # # # # # # ", +" # ## # # ## ### ", +" ", +" ", +" "}; diff --git a/pixmaps/followup-up.xpm b/pixmaps/followup-up.xpm new file mode 100755 index 0000000..b3f8467 --- /dev/null +++ b/pixmaps/followup-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * followup_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"_ c #888888", +"+ c #CCCCCC", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" B ", +" B B BB_BBBBBBBBBBBBBB ", +" B% B% B.B..............B_ ", +" B%xB%xB.%BBBBBB......BB.B_x ", +" B%xB%xB.%+%%%%%B......BB.B_x ", +" B%xB%xB.%+++++++BxBB......B_x ", +" B%xB%xB%+++++++B_........B_x ", +" _B%xB%xB%%BBBBBB_B.......B_x ", +" _B%xB%xB%B______........B_x ", +" _B%xB%xBB_BBBBBBBBBBBBBB_x ", +" _______B________________x ", +" xx xx __xxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" #### # # ", +" # # # ", +" # ## # # ## # # # ", +" ### # # # # # # # # # ", +" # # # # # # # # # # ", +" # # # # # # # # # # ", +" # ## # # ## ### ", +" ", +" ", +" "}; diff --git a/pixmaps/forward-dn.xpm b/pixmaps/forward-dn.xpm new file mode 100755 index 0000000..b61023c --- /dev/null +++ b/pixmaps/forward-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * forward_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" B ", +" BBBBBBBBBBBBBBBBBB BB ", +" B................B_B%B ", +" B.BB..........BBBBBB%%B ", +" B.............B%%%%%+%%B ", +" B....BBBBBB...B%++++++%%B ", +" B.............B%++++++%B_x ", +" B....BBBBB....BBBBBB+%B_x ", +" B..............____B%B_x ", +" BBBBBBBBBBBBBBBBBB_BB_x ", +" __________________B_x ", +" xxxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" ### # ", +" # # ", +" # # ## # # # ## ## ", +" ## # # # # # # # # # # # # # ", +" # # # # # # # # # # # # ", +" # # # # # # # # # # # # ", +" # # # # # ## # ## ", +" ", +" ", +" "}; diff --git a/pixmaps/forward-up.xpm b/pixmaps/forward-up.xpm new file mode 100755 index 0000000..6f86dd8 --- /dev/null +++ b/pixmaps/forward-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * forward_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" B ", +" BBBBBBBBBBBBBBBBBB BB ", +" B................B_B%B ", +" B.BB..........BBBBBB%%B ", +" B.............B%%%%%+%%B ", +" B....BBBBBB...B%++++++%%B ", +" B.............B%++++++%B_x ", +" B....BBBBB....BBBBBB+%B_x ", +" B..............____B%B_x ", +" BBBBBBBBBBBBBBBBBB_BB_x ", +" __________________B_x ", +" xxxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" ### # ", +" # # ", +" # # ## # # # ## ## ", +" ## # # # # # # # # # # # # # ", +" # # # # # # # # # # # # ", +" # # # # # # # # # # # # ", +" # # # # # ## # ## ", +" ", +" ", +" "}; diff --git a/pixmaps/getmail-dn.xpm b/pixmaps/getmail-dn.xpm new file mode 100755 index 0000000..200983d --- /dev/null +++ b/pixmaps/getmail-dn.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * getmail_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"+ c #CCCCCC", +"x c #AAAAAA", +"% c #EEEEEE", +": c #F2F2F2", +"# c #808080", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B.BB..........BB.B_# ", +" B.............BB.B_# ", +" B....BBBBBB......B_# ", +" B................B_# ", +" B....BBBBBB......B_# ", +" B.....B%%%B_.....B_# ", +" BBBBBBB++%B_#BBBBB_# ", +" _____B++%B_#______# ", +" ####B++%B_######## ", +" BBBB++%BBBB ", +" B:++++%%B_# ", +" B:++%%B_# ", +" B:%%B_# ", +" B:B_# ", +" B_# ", +" # ", +" ", +" ", +" ### # ", +" # # # ", +" # ## ### ", +" # ### # # # ", +" # # #### # ", +" # # # # ", +" ### ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/getmail-up.xpm b/pixmaps/getmail-up.xpm new file mode 100755 index 0000000..465fc76 --- /dev/null +++ b/pixmaps/getmail-up.xpm @@ -0,0 +1,44 @@ +/* XPM */ +static char * getmail_up_xpm[] = { +"32 32 9 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"+ c #CCCCCC", +"x c #AAAAAA", +"% c #EEEEEE", +": c #F2F2F2", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B.BB..........BB.B_# ", +" B.............BB.B_# ", +" B....BBBBBB......B_# ", +" B................B_# ", +" B....BBBBBB......B_# ", +" B.....B%%%B_.....B_# ", +" BBBBBBB++%B_#BBBBB_# ", +" _____B++%B_#______# ", +" ####B++%B_######## ", +" BBBB++%BBBB ", +" B:++++%%B_# ", +" B:++%%B_# ", +" B:%%B_# ", +" B:B_# ", +" B_# ", +" # ", +" ", +" ", +" ### # ", +" # # # ", +" # ## ### ", +" # ### # # # ", +" # # #### # ", +" # # # # ", +" ### ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/autofile-dn.xpm b/pixmaps/gtk/autofile-dn.xpm new file mode 100755 index 0000000..443b72e --- /dev/null +++ b/pixmaps/gtk/autofile-dn.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * autofile_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #808080", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/autofile-up.xpm b/pixmaps/gtk/autofile-up.xpm new file mode 100755 index 0000000..d5fa4e4 --- /dev/null +++ b/pixmaps/gtk/autofile-up.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * autofile_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/compose-dn.xpm b/pixmaps/gtk/compose-dn.xpm new file mode 100755 index 0000000..379427f --- /dev/null +++ b/pixmaps/gtk/compose-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * compose-up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +"+ c #CCCCCC", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"# c #808080", +" ", +" ", +" ", +" B ", +" B B B ", +" B B B ", +" BBB ", +"BBBBBBBBB ", +" BBB ", +" B B_B_BBBBBBBBBBBBBBB ", +" B B_.B..............B_ ", +" Bx.............BB.B_x ", +" x.............BB.B_x ", +" B....BBBBBB......B_x ", +" B................B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/compose-up.xpm b/pixmaps/gtk/compose-up.xpm new file mode 100755 index 0000000..fbd875f --- /dev/null +++ b/pixmaps/gtk/compose-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * compose-up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +"+ c #CCCCCC", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" B ", +" B B B ", +" B B B ", +" BBB ", +"BBBBBBBBB ", +" BBB ", +" B B_B_BBBBBBBBBBBBBBB ", +" B B_.B..............B_ ", +" Bx.............BB.B_x ", +" x.............BB.B_x ", +" B....BBBBBB......B_x ", +" B................B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/delete-dn.xpm b/pixmaps/gtk/delete-dn.xpm new file mode 100755 index 0000000..5ffba01 --- /dev/null +++ b/pixmaps/gtk/delete-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * delete_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" BB B...BB BB_x ", +" _BB B%%%B.B BB___x ", +" x__BB%++BBBBB__xxxx ", +" xx_BBB++BBB_xx ", +" xB__BB__B_x ", +" BBB__BBB_x ", +" BB__..__BBx ", +" BB_B..%%%%B_BB ", +" BB__xB%%++++B___BB_x ", +" _xx BBBBBBBB_xx___x ", +" ________x xxxx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/delete-up.xpm b/pixmaps/gtk/delete-up.xpm new file mode 100755 index 0000000..d068f6f --- /dev/null +++ b/pixmaps/gtk/delete-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * delete_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" BB B...BB BB_x ", +" _BB B%%%B.B BB___x ", +" x__BB%++BBBBB__xxxx ", +" xx_BBB++BBB_xx ", +" xB__BB__B_x ", +" BBB__BBB_x ", +" BB__..__BBx ", +" BB_B..%%%%B_BB ", +" BB__xB%%++++B___BB_x ", +" _xx BBBBBBBB_xx___x ", +" ________x xxxx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/file-dn.xpm b/pixmaps/gtk/file-dn.xpm new file mode 100755 index 0000000..c28d251 --- /dev/null +++ b/pixmaps/gtk/file-dn.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * file_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #808080", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/file-up.xpm b/pixmaps/gtk/file-up.xpm new file mode 100755 index 0000000..6fb88ee --- /dev/null +++ b/pixmaps/gtk/file-up.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * file_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"= c #666666", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBB ", +" B B......B B_ ", +" B B......B_BB_x ", +" B B.%%%%%B_xB_x ", +" B B.%++++B_xB_x ", +" B B.%++++B_xB_x ", +" B BBBBBBBB_xB_x ", +" B ________xB_x ", +" B xxxxxxxxB_x ", +" B BBBBBBBB B_x ", +" B B====B.B B_x ", +" B B====B.B B_x ", +" xB B====B.B B_x ", +" _BBBBBBBBBBBB_x ", +" x_____________x ", +" xxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/followup-dn.xpm b/pixmaps/gtk/followup-dn.xpm new file mode 100755 index 0000000..f6c8df5 --- /dev/null +++ b/pixmaps/gtk/followup-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * followup_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +"_ c #888888", +"+ c #CCCCCC", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" B B BB_BBBBBBBBBBBBBB ", +" B% B% B.B..............B_", +" B%xB%xB.%BBBBBB......BB.B_", +" B%xB%xB.%+%%%%%B......BB.B_", +"B%xB%xB.%+++++++BxBB......B_", +" B%xB%xB%+++++++B_........B_", +" _B%xB%xB%%BBBBBB_B.......B_", +" _B%xB%xB%B______........B_", +" _B%xB%xBB_BBBBBBBBBBBBBB_", +" _______B________________", +" xx xx __xxxxxxxxxxxxxxx", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/followup-up.xpm b/pixmaps/gtk/followup-up.xpm new file mode 100755 index 0000000..fdbe25d --- /dev/null +++ b/pixmaps/gtk/followup-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * followup_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +"_ c #888888", +"+ c #CCCCCC", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" B B BB_BBBBBBBBBBBBBB ", +" B% B% B.B..............B_", +" B%xB%xB.%BBBBBB......BB.B_", +" B%xB%xB.%+%%%%%B......BB.B_", +"B%xB%xB.%+++++++BxBB......B_", +" B%xB%xB%+++++++B_........B_", +" _B%xB%xB%%BBBBBB_B.......B_", +" _B%xB%xB%B______........B_", +" _B%xB%xBB_BBBBBBBBBBBBBB_", +" _______B________________", +" xx xx __xxxxxxxxxxxxxxx", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/forward-dn.xpm b/pixmaps/gtk/forward-dn.xpm new file mode 100755 index 0000000..db2adfe --- /dev/null +++ b/pixmaps/gtk/forward-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * forward_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" BBBBBBBBBBBBBBBBBB BB ", +" B................B_B%B ", +" B.BB..........BBBBBB%%B ", +" B.............B%%%%%+%%B ", +" B....BBBBBB...B%++++++%%B ", +" B.............B%++++++%B_x", +" B....BBBBB....BBBBBB+%B_x ", +" B..............____B%B_x ", +" BBBBBBBBBBBBBBBBBB_BB_x ", +" __________________B_x ", +" xxxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/forward-up.xpm b/pixmaps/gtk/forward-up.xpm new file mode 100755 index 0000000..df90975 --- /dev/null +++ b/pixmaps/gtk/forward-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * forward_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" BBBBBBBBBBBBBBBBBB BB ", +" B................B_B%B ", +" B.BB..........BBBBBB%%B ", +" B.............B%%%%%+%%B ", +" B....BBBBBB...B%++++++%%B ", +" B.............B%++++++%B_x", +" B....BBBBB....BBBBBB+%B_x ", +" B..............____B%B_x ", +" BBBBBBBBBBBBBBBBBB_BB_x ", +" __________________B_x ", +" xxxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/getmail-dn.xpm b/pixmaps/gtk/getmail-dn.xpm new file mode 100755 index 0000000..88f3e8c --- /dev/null +++ b/pixmaps/gtk/getmail-dn.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * getmail_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"+ c #CCCCCC", +"x c #AAAAAA", +"% c #EEEEEE", +": c #F2F2F2", +"# c #808080", +" ", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B.BB..........BB.B_# ", +" B.............BB.B_# ", +" B....BBBBBB......B_# ", +" B................B_# ", +" B....BBBBBB......B_# ", +" B.....B%%%B_.....B_# ", +" BBBBBBB++%B_#BBBBB_# ", +" _____B++%B_#______# ", +" ####B++%B_######## ", +" BBBB++%BBBB ", +" B:++++%%B_# ", +" B:++%%B_# ", +" B:%%B_# ", +" B:B_# ", +" B_# ", +" # ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/getmail-up.xpm b/pixmaps/gtk/getmail-up.xpm new file mode 100755 index 0000000..4e6eb21 --- /dev/null +++ b/pixmaps/gtk/getmail-up.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char * getmail_up_xpm[] = { +"28 24 9 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"+ c #CCCCCC", +"x c #AAAAAA", +"% c #EEEEEE", +": c #F2F2F2", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B.BB..........BB.B_# ", +" B.............BB.B_# ", +" B....BBBBBB......B_# ", +" B................B_# ", +" B....BBBBBB......B_# ", +" B.....B%%%B_.....B_# ", +" BBBBBBB++%B_#BBBBB_# ", +" _____B++%B_#______# ", +" ####B++%B_######## ", +" BBBB++%BBBB ", +" B:++++%%B_# ", +" B:++%%B_# ", +" B:%%B_# ", +" B:B_# ", +" B_# ", +" # ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/help-dn.xpm b/pixmaps/gtk/help-dn.xpm new file mode 100755 index 0000000..86b64b3 --- /dev/null +++ b/pixmaps/gtk/help-dn.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #666666", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" BBBBBBBB_ ", +" BBBxxxxBBBx ", +" BBBxBBBBxBBBx ", +" BBBxBBBBxBBBx ", +" BBBBBBBxBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBBBBBBBx ", +" BBBBBxBBBBx ", +" BBBBBBBBx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/help-up.xpm b/pixmaps/gtk/help-up.xpm new file mode 100755 index 0000000..a9596e2 --- /dev/null +++ b/pixmaps/gtk/help-up.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #330099", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" BBBBBBBB_ ", +" BBBxxxxBBBx ", +" BBBxBBBBxBBBx ", +" BBBxBBBBxBBBx ", +" BBBBBBBxBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBBBBBBBx ", +" BBBBBxBBBBx ", +" BBBBBBBBx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/mime-dn.xpm b/pixmaps/gtk/mime-dn.xpm new file mode 100755 index 0000000..5bc2726 --- /dev/null +++ b/pixmaps/gtk/mime-dn.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #666666", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BB B B ", +" BB BB BB BB BBB BB ", +" B BB B B B ", +" ", +" xx x x x x x x xxx xx x ", +" x x xx xx x ", +" x x x x x x x x x x x ", +" ", +" BB B BBB ", +" BB BB BB BB BBB B BB ", +" B BB B B BBB ", +" ", +" xx x x xxx x x x x xx ", +" xxx x x x x xx x x x x ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/mime-up.xpm b/pixmaps/gtk/mime-up.xpm new file mode 100755 index 0000000..c1ce8ad --- /dev/null +++ b/pixmaps/gtk/mime-up.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #330099", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BB B B ", +" BB BB BB BB BBB BB ", +" B BB B B B ", +" ", +" xx x x x x x x xxx xx x ", +" x x xx xx x ", +" x x x x x x x x x x x ", +" ", +" BB B BBB ", +" BB BB BB BB BBB B BB ", +" B BB B B BBB ", +" ", +" xx x x xxx x x x x xx ", +" xxx x x x x xx x x x x ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/mime-xx.xpm b/pixmaps/gtk/mime-xx.xpm new file mode 100755 index 0000000..ef7d217 --- /dev/null +++ b/pixmaps/gtk/mime-xx.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #330099", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" # # # ", +" # # # ", +" ### ## # # ### # ", +" # # # # # # # ", +" # ### # # # ", +" # # # # # # ", +" # ### # # # # ", +" ", +" ", +" # ", +" # ", +" ### # ## # ### ", +" # # # # # # ", +" # # # ### # # # ", +" # # # # # # # # ", +" ### # ### # # # ", +" # ", +" # ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/next-dn.xpm b/pixmaps/gtk/next-dn.xpm new file mode 100755 index 0000000..5c7e528 --- /dev/null +++ b/pixmaps/gtk/next-dn.xpm @@ -0,0 +1,34 @@ +/* XPM */ +static char * next_up_xpm[] = { +"28 24 7 1", +" c none", +"B c #666666", +"% c #EEEEEE", +"+ c #CCCCCC", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B%B B%B ", +" BBBBBB%%B BBBBBB%%B ", +" B%%%%%+%%B B%%%%%+%%B ", +" B%++++++%%B B%++++++%%B ", +" B%++++++%B_xB%++++++%B_x ", +" BBBBBB+%B_x BBBBBB+%B_x ", +" ____B%B_x ____B%B_x ", +" BB_x BB_x ", +" B_x B_x ", +" x x ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/next-up.xpm b/pixmaps/gtk/next-up.xpm new file mode 100755 index 0000000..6e3a9e7 --- /dev/null +++ b/pixmaps/gtk/next-up.xpm @@ -0,0 +1,34 @@ +/* XPM */ +static char * next_up_xpm[] = { +"28 24 7 1", +" c none", +"B c #330099", +"% c #EEEEEE", +"+ c #CCCCCC", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B%B B%B ", +" BBBBBB%%B BBBBBB%%B ", +" B%%%%%+%%B B%%%%%+%%B ", +" B%++++++%%B B%++++++%%B ", +" B%++++++%B_xB%++++++%B_x ", +" BBBBBB+%B_x BBBBBB+%B_x ", +" ____B%B_x ____B%B_x ", +" BB_x BB_x ", +" B_x B_x ", +" x x ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/previous-dn.xpm b/pixmaps/gtk/previous-dn.xpm new file mode 100755 index 0000000..0627635 --- /dev/null +++ b/pixmaps/gtk/previous-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * previous_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"_ c #888888", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B.B B.B ", +" B.%BBBBBB B.%BBBBBB ", +" B.%+%%%%%Bx B.%+%%%%%Bx ", +" B.%+++++++BxB.%+++++++Bx ", +" xB%+++++++B_xB%+++++++B_ ", +" x_B%+BBBBBB_x_B%+BBBBBB_ ", +" x_B%B______ x_B%B______ ", +" x_BB_ x_BB_ ", +" x_B_ x_B_ ", +" x__ x__ ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/previous-up.xpm b/pixmaps/gtk/previous-up.xpm new file mode 100755 index 0000000..62eef12 --- /dev/null +++ b/pixmaps/gtk/previous-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * previous_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"_ c #888888", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B.B B.B ", +" B.%BBBBBB B.%BBBBBB ", +" B.%+%%%%%Bx B.%+%%%%%Bx ", +" B.%+++++++BxB.%+++++++Bx ", +" xB%+++++++B_xB%+++++++B_ ", +" x_B%+BBBBBB_x_B%+BBBBBB_ ", +" x_B%B______ x_B%B______ ", +" x_BB_ x_BB_ ", +" x_B_ x_B_ ", +" x__ x__ ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/print-dn.xpm b/pixmaps/gtk/print-dn.xpm new file mode 100755 index 0000000..1c477e9 --- /dev/null +++ b/pixmaps/gtk/print-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * print_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"_ c #888888", +"# c #808080", +" ", +" ", +" ", +" ", +" BBBBBBBBB ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" BBBBBBBBBBBBBBB ", +" B.............Bx ", +" B. ++++++++++B_x ", +" B.++++++++++++B_x ", +" B.++++++++++++B_x ", +" BBBBBBBBBBBBBBB_x ", +" B+_+_+_+_+_+B__x ", +" BBBBBBBBBBBBB_xx ", +" x____________x ", +" xxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/print-up.xpm b/pixmaps/gtk/print-up.xpm new file mode 100755 index 0000000..4866056 --- /dev/null +++ b/pixmaps/gtk/print-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * print_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"_ c #888888", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" BBBBBBBBB ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" BBBBBBBBBBBBBBB ", +" B.............Bx ", +" B. ++++++++++B_x ", +" B.++++++++++++B_x ", +" B.++++++++++++B_x ", +" BBBBBBBBBBBBBBB_x ", +" B+_+_+_+_+_+B__x ", +" BBBBBBBBBBBBB_xx ", +" x____________x ", +" xxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/quit-dn.xpm b/pixmaps/gtk/quit-dn.xpm new file mode 100755 index 0000000..fde4542 --- /dev/null +++ b/pixmaps/gtk/quit-dn.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #666666", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" Bx B_ ", +" Bx Bx ", +" Bx BB Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx xx Bx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/quit-up.xpm b/pixmaps/gtk/quit-up.xpm new file mode 100755 index 0000000..cf65002 --- /dev/null +++ b/pixmaps/gtk/quit-up.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"28 24 5 1", +" c none", +"B c #330099", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" Bx B_ ", +" Bx Bx ", +" Bx BB Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx xx Bx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/recover-dn.xpm b/pixmaps/gtk/recover-dn.xpm new file mode 100755 index 0000000..9c8fe6d --- /dev/null +++ b/pixmaps/gtk/recover-dn.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * recover_up_xpm[] = { +"28 24 3 1", +" c none", +"R c #666666", +"# c #808080", +" ", +" ", +" ", +" ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/recover-up.xpm b/pixmaps/gtk/recover-up.xpm new file mode 100755 index 0000000..aa09a30 --- /dev/null +++ b/pixmaps/gtk/recover-up.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * recover_up_xpm[] = { +"28 24 3 1", +" c none", +"R c #FF0000", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/reply-dn.xpm b/pixmaps/gtk/reply-dn.xpm new file mode 100755 index 0000000..5d0a841 --- /dev/null +++ b/pixmaps/gtk/reply-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * reply_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" BB BBBBBBBBBBBBBBBBBB ", +" B.B B................B_ ", +" B.%BBBBBB..........BB.B_x", +" B.%+%%%%%B..........BB.B_x", +" B.%+++++++BxBBBBBB......B_x", +" B%+++++++B_............B_x", +" x_B%+BBBBBB_BBBBB.......B_x", +" x_B%B______............B_x", +" x_BB_BBBBBBBBBBBBBBBBBB_x", +" x_B_ __________________x", +" x__ xxxxxxxxxxxxxxxxxx", +" x_ ", +" x ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/reply-up.xpm b/pixmaps/gtk/reply-up.xpm new file mode 100755 index 0000000..dc61da3 --- /dev/null +++ b/pixmaps/gtk/reply-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * reply_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" B ", +" BB BBBBBBBBBBBBBBBBBB ", +" B.B B................B_ ", +" B.%BBBBBB..........BB.B_x", +" B.%+%%%%%B..........BB.B_x", +" B.%+++++++BxBBBBBB......B_x", +" B%+++++++B_............B_x", +" x_B%+BBBBBB_BBBBB.......B_x", +" x_B%B______............B_x", +" x_BB_BBBBBBBBBBBBBBBBBB_x", +" x_B_ __________________x", +" x__ xxxxxxxxxxxxxxxxxx", +" x_ ", +" x ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/undelete-dn.xpm b/pixmaps/gtk/undelete-dn.xpm new file mode 100755 index 0000000..53323e3 --- /dev/null +++ b/pixmaps/gtk/undelete-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * undelete_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"x c #AAAAAA", +"% c #EEEEEE", +"_ c #888888", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" B B...BB B x ", +" B B%%%B.B B x ", +" BB%..BBBB xx ", +" BB...B.B_x ", +" B..B...B_x ", +" BB...B.B_x ", +" BB.%%%%%B_x ", +" B B%+++++B_B ", +" B B%+++++B_ B x ", +" BBBBBBBB_x x ", +" ________x xx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/undelete-up.xpm b/pixmaps/gtk/undelete-up.xpm new file mode 100755 index 0000000..b875902 --- /dev/null +++ b/pixmaps/gtk/undelete-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * undelete_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"x c #AAAAAA", +"% c #EEEEEE", +"_ c #888888", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" B B...BB B x ", +" B B%%%B.B B x ", +" BB%..BBBB xx ", +" BB...B.B_x ", +" B..B...B_x ", +" BB...B.B_x ", +" BB.%%%%%B_x ", +" B B%+++++B_B ", +" B B%+++++B_ B x ", +" BBBBBBBB_x x ", +" ________x xx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/visit-dn.xpm b/pixmaps/gtk/visit-dn.xpm new file mode 100755 index 0000000..d558bed --- /dev/null +++ b/pixmaps/gtk/visit-dn.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * visit_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BBB ", +" BB BBB..B_ BBB ", +" B..BBB.....BBB__B_ ", +" B........BBB_____B_x ", +" B...%%BBB_______B__x ", +" B..%%+B_____BB__B_xx ", +" B.%++B__BBB____B_x ", +" B%++B_________B__x ", +" B%++B__BBB____B_xx ", +" B++B_______BBB_x ", +" B+B_____BBB____x ", +" B+B__BBB____xxxx ", +" BBBB____xxxx ", +" ____ xxx ", +" xxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/gtk/visit-up.xpm b/pixmaps/gtk/visit-up.xpm new file mode 100755 index 0000000..2969351 --- /dev/null +++ b/pixmaps/gtk/visit-up.xpm @@ -0,0 +1,35 @@ +/* XPM */ +static char * visit_up_xpm[] = { +"28 24 8 1", +" c none", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BBB ", +" BB BBB..B_ BBB ", +" B..BBB.....BBB__B_ ", +" B........BBB_____B_x ", +" B...%%BBB_______B__x ", +" B..%%+B_____BB__B_xx ", +" B.%++B__BBB____B_x ", +" B%++B_________B__x ", +" B%++B__BBB____B_xx ", +" B++B_______BBB_x ", +" B+B_____BBB____x ", +" B+B__BBB____xxxx ", +" BBBB____xxxx ", +" ____ xxx ", +" xxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/help-dn.xpm b/pixmaps/help-dn.xpm new file mode 100755 index 0000000..92149b9 --- /dev/null +++ b/pixmaps/help-dn.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" BBBBBBBB_ ", +" BBBxxxxBBBx ", +" BBBxBBBBxBBBx ", +" BBBxBBBBxBBBx ", +" BBBBBBBxBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBBBBBBBx ", +" BBBBBxBBBBx ", +" BBBBBBBBx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" # # # ", +" # # # ", +" # # ## # ### ", +" ##### # # # # # ", +" # # #### # # # ", +" # # # # # # ", +" # # ### ## ### ", +" # ", +" # ", +" "}; diff --git a/pixmaps/help-up.xpm b/pixmaps/help-up.xpm new file mode 100755 index 0000000..60d4428 --- /dev/null +++ b/pixmaps/help-up.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" BBBBBBBB_ ", +" BBBxxxxBBBx ", +" BBBxBBBBxBBBx ", +" BBBxBBBBxBBBx ", +" BBBBBBBxBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBxBBBBBx ", +" BBBBBBBBBBBBx ", +" BBBBBxBBBBx ", +" BBBBBBBBx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" # # # ", +" # # # ", +" # # ## # ### ", +" ##### # # # # # ", +" # # #### # # # ", +" # # # # # # ", +" # # ### ## ### ", +" # ", +" # ", +" "}; diff --git a/pixmaps/make-gtk-pixmaps.py b/pixmaps/make-gtk-pixmaps.py new file mode 100755 index 0000000..5f1b461 --- /dev/null +++ b/pixmaps/make-gtk-pixmaps.py @@ -0,0 +1,24 @@ +#!/usr/bin/python +# -*- python -*- + +import os, sys + +if not os.path.exists("gtk"): + os.mkdir("gtk") + +for xpmfile in sys.argv[1:]: + fd = open(xpmfile, "r") + xpm = fd.readlines() + fd.close() + xpm[2] = xpm[2].replace("32 32", "28 24") + xpm[3] = xpm[3].replace("#B2B2B2 s backgroundToolBarColor", "none") + for i in range(4, 20): + if xpm[i].startswith('" '): + del xpm[i+22:i+31] + xpm.insert(i, xpm[i]) + for j in range(i, i+24): + xpm[j] = '"' + xpm[j][3:3+28] + '"' + xpm[j][34:] + break + fd = open("gtk/" + xpmfile, "w") + fd.writelines(xpm) + fd.close() diff --git a/pixmaps/mime-dn.xpm b/pixmaps/mime-dn.xpm new file mode 100755 index 0000000..a49aa9f --- /dev/null +++ b/pixmaps/mime-dn.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" BB B B ", +" BB BB BB BB BBB BB ", +" B BB B B B ", +" ", +" xx x x x x x x xxx xx x ", +" x x xx xx x ", +" x x x x x x x x x x x ", +" ", +" BB B BBB ", +" BB BB BB BB BBB B BB ", +" B BB B B BBB ", +" ", +" xx x x xxx x x x x xx ", +" xxx x x x x xx x x x x ", +" ", +" ", +" ", +" ", +" # # ", +" ## ## ", +" # # # # # ###### ## ", +" # # # # # # # # ", +" # # # # # # #### ", +" # # # # # # # ", +" # # # # # # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/mime-up.xpm b/pixmaps/mime-up.xpm new file mode 100755 index 0000000..26190f1 --- /dev/null +++ b/pixmaps/mime-up.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" BB B B ", +" BB BB BB BB BBB BB ", +" B BB B B B ", +" ", +" xx x x x x x x xxx xx x ", +" x x xx xx x ", +" x x x x x x x x x x x ", +" ", +" BB B BBB ", +" BB BB BB BB BBB B BB ", +" B BB B B BBB ", +" ", +" xx x x xxx x x x x xx ", +" xxx x x x x xx x x x x ", +" ", +" ", +" ", +" ", +" # # ", +" ## ## ", +" # # # # # ###### ## ", +" # # # # # # # # ", +" # # # # # # #### ", +" # # # # # # # ", +" # # # # # # ### ", +" ", +" ", +" "}; diff --git a/pixmaps/mime-xx.xpm b/pixmaps/mime-xx.xpm new file mode 100755 index 0000000..1f6df76 --- /dev/null +++ b/pixmaps/mime-xx.xpm @@ -0,0 +1,41 @@ +/* XPM */ +static char * mime_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" # # # ", +" # # # ", +" ### ## # # ### # ", +" # # # # # # # ", +" # ### # # # ", +" # # # # # # ", +" # ### # # # # ", +" ", +" ", +" # ", +" # ", +" ### # ## # ### ", +" # # # # # # ", +" # # # ### # # # ", +" # # # # # # # # ", +" ### # ### # # # ", +" # ", +" # ", +" ", +" ", +" + + ", +" xx xx ", +" + + + + + +x+x+x x+ ", +" x x x x + + + x ", +" + + + + x x x+x+ ", +" x x x x + + + ", +" + + + + x x x+x ", +" ", +" ", +" "}; diff --git a/pixmaps/mime/application.xpm b/pixmaps/mime/application.xpm new file mode 100755 index 0000000..d6bedfb --- /dev/null +++ b/pixmaps/mime/application.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * clip_xpm[] = { +"22 22 5 1", +" c None", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" ", +" ", +" BBB ", +" BB BB ", +" BB BB ", +" BB BB ", +" B_ B_ BB ", +" B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ BB ", +" B_ B_ B_ B_ ", +" B_ B_ B_ B_ ", +" B_ BBBB_ B_ ", +" B_ ____ B_ ", +" B_ B_ ", +" BBBBBBB_ ", +" _______ ", +" ", +" "}; diff --git a/pixmaps/mime/audio.xpm b/pixmaps/mime/audio.xpm new file mode 100755 index 0000000..136c122 --- /dev/null +++ b/pixmaps/mime/audio.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * clip_xpm[] = { +"22 22 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" BB ", +" BBBB ", +" B BBB ", +" B B ", +" B B ", +" B B ", +" BBBB B ", +"_BBBBB____B___________", +" BBB BBBB ", +" BBBBB ", +" BBB ", +"______________________", +" BBB ", +" BBBBB ", +" BBBB ", +"_______________B______", +" B ", +" B ", +" B ", +"_______________B______", +" B ", +" B "}; diff --git a/pixmaps/mime/image.xpm b/pixmaps/mime/image.xpm new file mode 100755 index 0000000..8a088ab --- /dev/null +++ b/pixmaps/mime/image.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * image_xpm[] = { +"22 22 5 1", +" c None", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" ", +" ", +" ", +" ", +" xxx ", +" ___ ", +" BBBBBBBBBBBBBBBB ", +" B B_ ", +" B x x__x BBB B_ ", +" B x x_.._x B.B B_ ", +" B x _.BB._x BBB B_ ", +" B x _.BB._x B_ ", +" B x x_.._x B_ ", +" B x x__x B_ ", +" B B_ ", +" BBBBBBBBBBBBBBBB__ ", +" _________________ ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/mime/message.xpm b/pixmaps/mime/message.xpm new file mode 100755 index 0000000..f5f425b --- /dev/null +++ b/pixmaps/mime/message.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char * message_xpm[] = { +"22 22 8 1", +" c None", +"B c #330099", +"+ c #CCCCCC", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"# c #000000", +" ", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B.............BB.B_x ", +" B.............BB.B_x ", +" B....BBBBBB......B_x ", +" B................B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/mime/multipart.xpm b/pixmaps/mime/multipart.xpm new file mode 100755 index 0000000..279454c --- /dev/null +++ b/pixmaps/mime/multipart.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * documents_xpm[] = { +"32 32 5 1", +" c None", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B..........B.B.B.B_ ", +" B................B_BBBB ", +" B..BB.BB.........B_...B_ ", +" B................B_.B.B_ ", +" B..B.BBB.........B_...B_BBBB ", +" B................B_...B_...B_ ", +" B................B_...B_.B.B_x", +" B..BB.BB.B.B.BB..B_...B_...B_x", +" B................B_...B_...B_x", +" B..B.B.BBB.BB.B..B_...B_...B_x", +" B................B_B..B_...B_x", +" B..BB.BB.BB.B.B..B_...B_...B_x", +" B................B_B..B_...B_x", +" B..B.BB.B..BBBB..B_...B_B..B_x", +" B................B_B..B_...B_x", +" B................B_...B_B..B_x", +" B.........B.BBB..B_B..B_...B_x", +" B....BBBBB.......B_...B_B..B_x", +" B................B_...B_...B_x", +" BBBBBBBBBBBBBBBBBB_B..B_B..B_x", +" __________________...B_...B_x", +" B................B_...B_x", +" BBBBBBBBBBBBBBBBBB_B..B_x", +" __________________...B_x", +" B................B_x", +" BBBBBBBBBBBBBBBBBB_x", +" __________________x", +" xxxxxxxxxxxxxxxxxx", +" "}; diff --git a/pixmaps/mime/text.xpm b/pixmaps/mime/text.xpm new file mode 100755 index 0000000..b8f1561 --- /dev/null +++ b/pixmaps/mime/text.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * document_xpm[] = { +"32 32 5 1", +" c None", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" ", +" ", +" ", +" ", +" BBBBBBBBBBBBBBBBBB ", +" B................B_ ", +" B..........B.B.B.B_x ", +" B................B_x ", +" B..BB.BB.........B_x ", +" B................B_x ", +" B..B.BBB.........B_x ", +" B................B_x ", +" B................B_x ", +" B..BB.BB.B.B.BB..B_x ", +" B................B_x ", +" B..B.B.BBB.BB.B..B_x ", +" B................B_x ", +" B..BB.BB.BB.B.B..B_x ", +" B................B_x ", +" B..B.BB.B..BBBB..B_x ", +" B................B_x ", +" B................B_x ", +" B.........B.BBB..B_x ", +" B....BBBBB.......B_x ", +" B................B_x ", +" BBBBBBBBBBBBBBBBBB_x ", +" __________________x ", +" xxxxxxxxxxxxxxxxxx ", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/mime/video.xpm b/pixmaps/mime/video.xpm new file mode 100755 index 0000000..974fe5f --- /dev/null +++ b/pixmaps/mime/video.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char * video_xpm[] = { +"22 22 5 1", +" c None", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +" ", +" ", +" ", +" ", +" ", +" ", +"BBBBBBBBBBBBBBBBBBBBBB", +"B B B B B B B B B B B ", +"BBBBBBBBBBBBBBBBBBBBBB", +" B B B ", +"_ B _ B ___ B _", +" _ B __ B _ B ", +"_ B _ B ___ B _", +" B B B ", +"BBBBBBBBBBBBBBBBBBBBBB", +"B B B B B B B B B B B ", +"BBBBBBBBBBBBBBBBBBBBBB", +" _____________________", +" ", +" ", +" ", +" "}; diff --git a/pixmaps/next-dn.xpm b/pixmaps/next-dn.xpm new file mode 100755 index 0000000..a89e147 --- /dev/null +++ b/pixmaps/next-dn.xpm @@ -0,0 +1,42 @@ +/* XPM */ +static char * next_up_xpm[] = { +"32 32 7 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"% c #EEEEEE", +"+ c #CCCCCC", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B%B B%B ", +" BBBBBB%%B BBBBBB%%B ", +" B%%%%%+%%B B%%%%%+%%B ", +" B%++++++%%B B%++++++%%B ", +" B%++++++%B_xB%++++++%B_x ", +" BBBBBB+%B_x BBBBBB+%B_x ", +" ____B%B_x ____B%B_x ", +" BB_x BB_x ", +" B_x B_x ", +" x x ", +" ", +" ", +" ", +" ", +" ", +" # # # ", +" ## # # ", +" # # # ## # # ### ", +" # ## # # # # # ", +" # # #### # # ", +" # # # # # # ", +" # # ### # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/next-up.xpm b/pixmaps/next-up.xpm new file mode 100755 index 0000000..6df9557 --- /dev/null +++ b/pixmaps/next-up.xpm @@ -0,0 +1,42 @@ +/* XPM */ +static char * next_up_xpm[] = { +"32 32 7 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"% c #EEEEEE", +"+ c #CCCCCC", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B%B B%B ", +" BBBBBB%%B BBBBBB%%B ", +" B%%%%%+%%B B%%%%%+%%B ", +" B%++++++%%B B%++++++%%B ", +" B%++++++%B_xB%++++++%B_x ", +" BBBBBB+%B_x BBBBBB+%B_x ", +" ____B%B_x ____B%B_x ", +" BB_x BB_x ", +" B_x B_x ", +" x x ", +" ", +" ", +" ", +" ", +" ", +" # # # ", +" ## # # ", +" # # # ## # # ### ", +" # ## # # # # # ", +" # # #### # # ", +" # # # # # # ", +" # # ### # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/previous-dn.xpm b/pixmaps/previous-dn.xpm new file mode 100755 index 0000000..16c9e56 --- /dev/null +++ b/pixmaps/previous-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * previous_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"_ c #888888", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B.B B.B ", +" B.%BBBBBB B.%BBBBBB ", +" B.%+%%%%%Bx B.%+%%%%%Bx ", +" B.%+++++++BxB.%+++++++Bx ", +" xB%+++++++B_xB%+++++++B_ ", +" x_B%+BBBBBB_x_B%+BBBBBB_ ", +" x_B%B______ x_B%B______ ", +" x_BB_ x_BB_ ", +" x_B_ x_B_ ", +" x__ x__ ", +" ", +" ", +" ", +" ", +" ", +" #### ", +" # # ", +" # # ### ## # # ", +" #### # # # # # # ", +" # # #### # # ", +" # # # # # ", +" # # ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/previous-up.xpm b/pixmaps/previous-up.xpm new file mode 100755 index 0000000..5cff544 --- /dev/null +++ b/pixmaps/previous-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * previous_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"% c #EEEEEE", +"+ c #CCCCCC", +"x c #AAAAAA", +"_ c #888888", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" B B ", +" BB BB ", +" B.B B.B ", +" B.%BBBBBB B.%BBBBBB ", +" B.%+%%%%%Bx B.%+%%%%%Bx ", +" B.%+++++++BxB.%+++++++Bx ", +" xB%+++++++B_xB%+++++++B_ ", +" x_B%+BBBBBB_x_B%+BBBBBB_ ", +" x_B%B______ x_B%B______ ", +" x_BB_ x_BB_ ", +" x_B_ x_B_ ", +" x__ x__ ", +" ", +" ", +" ", +" ", +" ", +" #### ", +" # # ", +" # # ### ## # # ", +" #### # # # # # # ", +" # # #### # # ", +" # # # # # ", +" # # ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/print-dn.xpm b/pixmaps/print-dn.xpm new file mode 100755 index 0000000..680c408 --- /dev/null +++ b/pixmaps/print-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * print_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"_ c #888888", +"# c #808080", +" ", +" ", +" ", +" BBBBBBBBB ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" BBBBBBBBBBBBBBB ", +" B.............Bx ", +" B. ++++++++++B_x ", +" B.++++++++++++B_x ", +" B.++++++++++++B_x ", +" BBBBBBBBBBBBBBB_x ", +" B+_+_+_+_+_+B__x ", +" BBBBBBBBBBBBB_xx ", +" x____________x ", +" xxxxxxxxxxxxx ", +" ", +" ", +" ", +" #### # ", +" # # # # ", +" # # # # # # ### ", +" #### ## # # ## # # ", +" # # # # # # ", +" # # # # # # ", +" # # # # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/print-up.xpm b/pixmaps/print-up.xpm new file mode 100755 index 0000000..c9623d6 --- /dev/null +++ b/pixmaps/print-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * print_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"_ c #888888", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" BBBBBBBBB ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" B.BBBBB%B ", +" B.%%%%%%B ", +" BBBBBBBBBBBBBBB ", +" B.............Bx ", +" B. ++++++++++B_x ", +" B.++++++++++++B_x ", +" B.++++++++++++B_x ", +" BBBBBBBBBBBBBBB_x ", +" B+_+_+_+_+_+B__x ", +" BBBBBBBBBBBBB_xx ", +" x____________x ", +" xxxxxxxxxxxxx ", +" ", +" ", +" ", +" #### # ", +" # # # # ", +" # # # # # # ### ", +" #### ## # # ## # # ", +" # # # # # # ", +" # # # # # # ", +" # # # # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/quit-dn.xpm b/pixmaps/quit-dn.xpm new file mode 100755 index 0000000..7229bf7 --- /dev/null +++ b/pixmaps/quit-dn.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +"_ c #888888", +"x c #AAAAAA", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" Bx B_ ", +" Bx Bx ", +" Bx BB Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx xx Bx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" ### # ", +" # # # # ", +" # # # # ### ", +" # # # # # # ", +" # # # # # # # ", +" # # # ## # # ", +" ## # # # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/quit-up.xpm b/pixmaps/quit-up.xpm new file mode 100755 index 0000000..adcdb4c --- /dev/null +++ b/pixmaps/quit-up.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char * quit_up_xpm[] = { +"32 32 5 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +"_ c #888888", +"x c #AAAAAA", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BBBBBB ", +" Bx B_ ", +" Bx Bx ", +" Bx BB Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx BBx Bx ", +" Bx xx Bx ", +" BBBBBBx ", +" xxxxx ", +" ", +" ", +" ", +" ", +" ### # ", +" # # # # ", +" # # # # ### ", +" # # # # # # ", +" # # # # # # # ", +" # # # ## # # ", +" ## # # # # # ", +" ", +" ", +" "}; diff --git a/pixmaps/recover-dn.xpm b/pixmaps/recover-dn.xpm new file mode 100755 index 0000000..d74e483 --- /dev/null +++ b/pixmaps/recover-dn.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char * recover_up_xpm[] = { +"32 32 3 1", +" c #B2B2B2 s backgroundToolBarColor", +"R c #666666", +"# c #808080", +" ", +" ", +" ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" ", +" ", +" ", +" ", +" #### ", +" # # ", +" # # ## ## ## # # ", +" #### # # # # # # # # ", +" # # #### # # # # # ", +" # # # # # # # # # ", +" # # ### ## ## # ", +" ", +" ", +" "}; diff --git a/pixmaps/recover-up.xpm b/pixmaps/recover-up.xpm new file mode 100755 index 0000000..ca661c5 --- /dev/null +++ b/pixmaps/recover-up.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char * recover_up_xpm[] = { +"32 32 3 1", +" c #B2B2B2 s backgroundToolBarColor", +"R c #FF0000", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRRRRRRRRRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" RRRRR ", +" ", +" ", +" ", +" ", +" #### ", +" # # ", +" # # ## ## ## # # ", +" #### # # # # # # # # ", +" # # #### # # # # # ", +" # # # # # # # # # ", +" # # ### ## ## # ", +" ", +" ", +" "}; diff --git a/pixmaps/reply-dn.xpm b/pixmaps/reply-dn.xpm new file mode 100755 index 0000000..17c7451 --- /dev/null +++ b/pixmaps/reply-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * reply_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" B ", +" BB BBBBBBBBBBBBBBBBBB ", +" B.B B................B_ ", +" B.%BBBBBB..........BB.B_x ", +" B.%+%%%%%B..........BB.B_x ", +" B.%+++++++BxBBBBBB......B_x ", +" B%+++++++B_............B_x ", +" x_B%+BBBBBB_BBBBB.......B_x ", +" x_B%B______............B_x ", +" x_BB_BBBBBBBBBBBBBBBBBB_x ", +" x_B_ __________________x ", +" x__ xxxxxxxxxxxxxxxxxx ", +" x_ ", +" x ", +" ", +" ", +" ", +" #### # ", +" # # # ", +" # # ## # # # # # ", +" #### # # ## # # # # ", +" # # #### # # # # # ", +" # # # ## # # # # ", +" # # ### # # # ### ", +" # # ", +" # ### ", +" "}; diff --git a/pixmaps/reply-up.xpm b/pixmaps/reply-up.xpm new file mode 100755 index 0000000..814b2f7 --- /dev/null +++ b/pixmaps/reply-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * reply_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"% c #EEEEEE", +"x c #AAAAAA", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" B ", +" BB BBBBBBBBBBBBBBBBBB ", +" B.B B................B_ ", +" B.%BBBBBB..........BB.B_x ", +" B.%+%%%%%B..........BB.B_x ", +" B.%+++++++BxBBBBBB......B_x ", +" B%+++++++B_............B_x ", +" x_B%+BBBBBB_BBBBB.......B_x ", +" x_B%B______............B_x ", +" x_BB_BBBBBBBBBBBBBBBBBB_x ", +" x_B_ __________________x ", +" x__ xxxxxxxxxxxxxxxxxx ", +" x_ ", +" x ", +" ", +" ", +" ", +" #### # ", +" # # # ", +" # # ## # # # # # ", +" #### # # ## # # # # ", +" # # #### # # # # # ", +" # # # ## # # # # ", +" # # ### # # # ### ", +" # # ", +" # ### ", +" "}; diff --git a/pixmaps/undelete-dn.xpm b/pixmaps/undelete-dn.xpm new file mode 100755 index 0000000..55596ad --- /dev/null +++ b/pixmaps/undelete-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * undelete_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"x c #AAAAAA", +"% c #EEEEEE", +"_ c #888888", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" B B...BB B x ", +" B B%%%B.B B x ", +" BB%..BBBB xx ", +" BB...B.B_x ", +" B..B...B_x ", +" BB...B.B_x ", +" BB.%%%%%B_x ", +" B B%+++++B_B ", +" B B%+++++B_ B x ", +" BBBBBBBB_x x ", +" ________x xx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" # # # # ", +" # # # # ", +" # # # # # ## # ", +" # # ## # ### # # # ", +" # # # # # # #### # ", +" # # # # # # # # ", +" ### # # ### ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/undelete-up.xpm b/pixmaps/undelete-up.xpm new file mode 100755 index 0000000..d9b480c --- /dev/null +++ b/pixmaps/undelete-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * undelete_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"x c #AAAAAA", +"% c #EEEEEE", +"_ c #888888", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" ", +" BBBBB ", +" B B...BB B x ", +" B B%%%B.B B x ", +" BB%..BBBB xx ", +" BB...B.B_x ", +" B..B...B_x ", +" BB...B.B_x ", +" BB.%%%%%B_x ", +" B B%+++++B_B ", +" B B%+++++B_ B x ", +" BBBBBBBB_x x ", +" ________x xx ", +" xxxxxxx ", +" ", +" ", +" ", +" ", +" # # # # ", +" # # # # ", +" # # # # # ## # ", +" # # ## # ### # # # ", +" # # # # # # #### # ", +" # # # # # # # # ", +" ### # # ### ### # ", +" ", +" ", +" "}; diff --git a/pixmaps/visit-dn.xpm b/pixmaps/visit-dn.xpm new file mode 100755 index 0000000..fcdd674 --- /dev/null +++ b/pixmaps/visit-dn.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * visit_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #666666", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #808080", +" ", +" ", +" ", +" ", +" BBB ", +" BB BBB..B_ BBB ", +" B..BBB.....BBB__B_ ", +" B........BBB_____B_x ", +" B...%%BBB_______B__x ", +" B..%%+B_____BB__B_xx ", +" B.%++B__BBB____B_x ", +" B%++B_________B__x ", +" B%++B__BBB____B_xx ", +" B++B_______BBB_x ", +" B+B_____BBB____x ", +" B+B__BBB____xxxx ", +" BBBB____xxxx ", +" ____ xxx ", +" xxxx ", +" ", +" ", +" ", +" # # # ", +" # # # # # ", +" # # ### ### ", +" # # # # # # ", +" # # # ## # # ", +" # # # # # # ", +" # # ### # # ", +" ", +" ", +" "}; diff --git a/pixmaps/visit-up.xpm b/pixmaps/visit-up.xpm new file mode 100755 index 0000000..6909104 --- /dev/null +++ b/pixmaps/visit-up.xpm @@ -0,0 +1,43 @@ +/* XPM */ +static char * visit_up_xpm[] = { +"32 32 8 1", +" c #B2B2B2 s backgroundToolBarColor", +"B c #330099", +". c #FFFFFF", +"_ c #888888", +"x c #AAAAAA", +"% c #EEEEEE", +"+ c #CCCCCC", +"# c #000000 s foregroundToolBarColor", +" ", +" ", +" ", +" ", +" BBB ", +" BB BBB..B_ BBB ", +" B..BBB.....BBB__B_ ", +" B........BBB_____B_x ", +" B...%%BBB_______B__x ", +" B..%%+B_____BB__B_xx ", +" B.%++B__BBB____B_x ", +" B%++B_________B__x ", +" B%++B__BBB____B_xx ", +" B++B_______BBB_x ", +" B+B_____BBB____x ", +" B+B__BBB____xxxx ", +" BBBB____xxxx ", +" ____ xxx ", +" xxxx ", +" ", +" ", +" ", +" # # # ", +" # # # # # ", +" # # ### ### ", +" # # # # # # ", +" # # # ## # # ", +" # # # # # # ", +" # # ### # # ", +" ", +" ", +" "}; diff --git a/src/Makefile.in b/src/Makefile.in new file mode 100755 index 0000000..ef773a6 --- /dev/null +++ b/src/Makefile.in @@ -0,0 +1,54 @@ +@SET_MAKE@ + +############################################################################## +# no csh please +SHELL = /bin/sh + +SOURCES = $(wildcard *.c) + +OBJECTS = $(SOURCES:.c=.o) + +MANS = $(wildcard *.1) + +############################################################################## +# location of required programms +prefix = @prefix@ +exec_prefix = @exec_prefix@ +MKDIR = @MKDIR@ +RM = @RM@ +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_DATA = @INSTALL_DATA@ + +prefix = @prefix@ +top_srcdir = @top_srcdir@ +srcdir = @srcdir@ +bindir= @bindir@ +mandir= @mandir@ + +############################################################################## +all: $(SOURCES:.c=) + +install: + @mkdir -p -m 0755 "$(DESTDIR)$(bindir)"; \ + for i in $(SOURCES:.c=) ; do \ + echo "Installing $$i in $(DESTDIR)$(bindir)" ; \ + $(INSTALL_PROGRAM) $$i "$(DESTDIR)$(bindir)" ; \ + done ; + @test -d $(DESTDIR)$(mandir) || \ + mkdir -p -m 0755 "$(DESTDIR)$(mandir)/man1"; \ + for i in $(MANS) ; do \ + $(INSTALL_DATA) $$i "$(DESTDIR)$(mandir)/man1" ; \ + done + @echo VM helper binaries successfully installed\! + +############################################################################## +Makefile: @srcdir@/Makefile.in + cd ..; ./config.status + +############################################################################## +clean: + -$(RM) -f $(SOURCES:.c=) + +distclean: clean + -$(RM) -f Makefile diff --git a/src/base64-decode.1 b/src/base64-decode.1 new file mode 100644 index 0000000..4ba903c --- /dev/null +++ b/src/base64-decode.1 @@ -0,0 +1,50 @@ +.\" -*- Mode: Nroff -*- +.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. +.\" +.\" Permission is granted to make and distribute verbatim copies of +.\" this manual provided the copyright notice and this permission notice +.\" are preserved on all copies. +.\" +.\" Permission is granted to copy and distribute modified versions of this +.\" manual under the conditions for verbatim copying, provided that the entire +.\" resulting derived work is distributed under the terms of a permission +.\" notice identical to this one. +.\" +.\" Permission is granted to copy and distribute translations of this manual +.\" into another language, under the above conditions for modified versions, +.\" except that this permission notice may be stated in a translation approved +.\" by the Author. +.\" +.\" Author: Manoj Srivastava +.\" +.\" arch-tag: e94acb5a-38da-416b-b01d-9196c0836599 +.\" +.TH BASE64\-DECODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" +.SH NAME +base64\-decode \- Fast BASE64 decoder +.SH SYNOPSIS +.B base64\-decode +< +.I base64\-encoded data +> +.I converted output +.SH DESCRIPTION +The +.B base64\-decode +utility takes BASE64 data on the standard input and converts +it to the standard output. +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. +.SH OPTIONS +.B base64\-encode +does not take any arguments or options. +.SH BUGS +None known. +.SH SEE ALSO +.I base64\-encode (1) +.SH AUTHORS +.B base64\-decode +was written by Kyle Jones. and placed by him into the public domain. +This manual page was written by Manoj Srivastava <srivasta@debian.org>, +for the Debian GNU/Linux system. diff --git a/src/base64-decode.c b/src/base64-decode.c new file mode 100755 index 0000000..1b026f7 --- /dev/null +++ b/src/base64-decode.c @@ -0,0 +1,94 @@ +/* public domain */ + +/* BASE64 on stdin -> converted data on stdout */ + +#include <stdlib.h> +#include <stdio.h> +#include <stdlib.h> + +#ifdef _WIN32 +#ifndef WIN32 +#define WIN32 +#endif +#endif + +#ifdef WIN32 +#include <io.h> +#include <fcntl.h> +#endif + +unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + +int +main(void) +{ + static char inalphabet[256], decoder[256]; + int i, bits, char_count, errors = 0; + +#ifdef WIN32 + _setmode( _fileno(stdout), _O_BINARY); +#endif + + for (i = (sizeof alphabet) - 1; i >= 0 ; i--) { + inalphabet[alphabet[i]] = 1; + decoder[alphabet[i]] = i; + } +#define BUFLEN 72*500 // must be multiple of 4 + + int len; + char buf[BUFLEN]; + char outbuf[BUFLEN]; + + while(!feof(stdin)) { + unsigned char c; + + int pos=0; + char *out=outbuf; + len=fread(buf, sizeof(c), BUFLEN, stdin); + if(!len) continue; + +cont_buffer: + char_count = 0; + bits = 0; + while(pos<len) { + c=buf[pos++]; + if (c == '=') + break; + if (! inalphabet[c]) + continue; + bits += decoder[c]; + char_count++; + if (char_count == 4) { + *out++ = ((bits >> 16)); + *out++ = (((bits >> 8) & 0xff)); + *out++ = ((bits & 0xff)); + bits = 0; + char_count = 0; + } else { + bits <<= 6; + } + } + switch (char_count) { + case 1: + fprintf(stderr, "base64-decode: base64 encoding incomplete: at least 2 bits missing"); + errors++; + break; + case 2: + *out++ = ((bits >> 10)); + break; + case 3: + *out++ = ((bits >> 16)); + *out++ = (((bits >> 8) & 0xff)); + break; + case 0: + break; + default: + fprintf(stderr, "base64-decode: base64 encoding incomplete: at least %d bits truncated", + ((4 - char_count) * 6)); + } + if(pos<len) // did not proceed the whole thing, continue + goto cont_buffer; + fwrite(outbuf, sizeof(char), (out-outbuf), stdout); + } + exit(errors ? 1 : 0); +} diff --git a/src/base64-encode.1 b/src/base64-encode.1 new file mode 100644 index 0000000..ba0e95a --- /dev/null +++ b/src/base64-encode.1 @@ -0,0 +1,51 @@ +.\" -*- Mode: Nroff -*- +.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. +.\" +.\" Permission is granted to make and distribute verbatim copies of +.\" this manual provided the copyright notice and this permission notice +.\" are preserved on all copies. +.\" +.\" Permission is granted to copy and distribute modified versions of this +.\" manual under the conditions for verbatim copying, provided that the entire +.\" resulting derived work is distributed under the terms of a permission +.\" notice identical to this one. +.\" +.\" Permission is granted to copy and distribute translations of this manual +.\" into another language, under the above conditions for modified versions, +.\" except that this permission notice may be stated in a translation approved +.\" by the Author. +.\" +.\" Author: Manoj Srivastava +.\" +.\" arch-tag: 6563f4a9-302a-4d17-986a-42be5fb1d1c9 +.\" +.TH BASE64\-ENCODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" +.SH NAME +base64\-encode \- Fast Base 64 encoder +.SH SYNOPSIS +.B base64\-encode +< +.I input +> +.I base64\-encoded output +.SH DESCRIPTION +The +.B base64\-encode +utility takes arbitrary data on the standard input and converts +it to BASE64 data on standard output. UNIX's newline convention is +used, i.e. one ASCII control-j (10 decimal). +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. +.SH OPTIONS +.B base64\-encode +does not take any arguments or options. +.SH BUGS +None known. +.SH SEE ALSO +.I base64\-decode (1) +.SH AUTHORS +.B base64\-encode +was written by Kyle Jones. and placed by him into the public domain. +This manual page was written by Manoj Srivastava <srivasta@debian.org>, +for the Debian GNU/Linux system. diff --git a/src/base64-encode.c b/src/base64-encode.c new file mode 100755 index 0000000..d9c6651 --- /dev/null +++ b/src/base64-encode.c @@ -0,0 +1,77 @@ +/* public domain */ + +/* + * arbitrary data on stdin -> BASE64 data on stdout + * + * UNIX's newline convention is used, i.e. one ASCII control-j (10 decimal). + */ + +#include <stdlib.h> +#include <stdio.h> +#include <stdlib.h> + +#ifdef _WIN32 +#ifndef WIN32 +#define WIN32 +#endif +#endif + +#ifdef WIN32 +#include <io.h> +#include <fcntl.h> +#endif + +unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + +int +main(void) +{ + int cols, bits, c, char_count; + +#ifdef WIN32 + _setmode( _fileno(stdin), _O_BINARY); +#endif + + char_count = 0; + bits = 0; + cols = 0; + while ((c = getchar()) != EOF) { + if (c > 255) { + fprintf(stderr, "encountered char > 255 (decimal %d)", c); + exit(1); + } + bits += c; + char_count++; + if (char_count == 3) { + putchar(alphabet[bits >> 18]); + putchar(alphabet[(bits >> 12) & 0x3f]); + putchar(alphabet[(bits >> 6) & 0x3f]); + putchar(alphabet[bits & 0x3f]); + cols += 4; + if (cols == 72) { + putchar('\n'); + cols = 0; + } + bits = 0; + char_count = 0; + } else { + bits <<= 8; + } + } + if (char_count != 0) { + bits <<= 16 - (8 * char_count); + putchar(alphabet[bits >> 18]); + putchar(alphabet[(bits >> 12) & 0x3f]); + if (char_count == 1) { + putchar('='); + putchar('='); + } else { + putchar(alphabet[(bits >> 6) & 0x3f]); + putchar('='); + } + if (cols > 0) + putchar('\n'); + } + + exit(0); +} diff --git a/src/qp-decode.1 b/src/qp-decode.1 new file mode 100644 index 0000000..a9a60d8 --- /dev/null +++ b/src/qp-decode.1 @@ -0,0 +1,51 @@ +.\" -*- Mode: Nroff -*- +.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. +.\" +.\" Permission is granted to make and distribute verbatim copies of +.\" this manual provided the copyright notice and this permission notice +.\" are preserved on all copies. +.\" +.\" Permission is granted to copy and distribute modified versions of this +.\" manual under the conditions for verbatim copying, provided that the entire +.\" resulting derived work is distributed under the terms of a permission +.\" notice identical to this one. +.\" +.\" Permission is granted to copy and distribute translations of this manual +.\" into another language, under the above conditions for modified versions, +.\" except that this permission notice may be stated in a translation approved +.\" by the Author. +.\" +.\" Author: Manoj Srivastava +.\" +.\" arch-tag: cfe27e82-b7a5-4171-bef6-f7bc28306374 +.\" +.TH QP\-DECODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" +.SH NAME +qp\-decode \- Fast Quoted Printable decoder +.SH SYNOPSIS +.B qp\-decode +< +.I qp\-encoded data +> +.I converted output +.SH DESCRIPTION +The +.B qp\-decode +utility takes Quoted Printable data on the standard input and converts +it to the standard output. +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. +.SH OPTIONS +.B qp\-encode +does not take any arguments or options. +.SH BUGS +None known. +.SH SEE ALSO +.I qp\-encode (1) +.SH AUTHORS +.B qp\-decode +was written by Kyle Jones. and placed by him into the public domain. +This manual page was written by Manoj Srivastava <srivasta@debian.org>, +for the Debian GNU/Linux system. + diff --git a/src/qp-decode.c b/src/qp-decode.c new file mode 100755 index 0000000..9861f7b --- /dev/null +++ b/src/qp-decode.c @@ -0,0 +1,105 @@ +/* public domain */ + +/* Quoted Printable on stdin -> converted data on stdout */ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <stdlib.h> + +#ifdef _WIN32 +#ifndef WIN32 +#define WIN32 +#endif +#endif + +#ifdef WIN32 +#include <io.h> +#include <fcntl.h> +#endif + +const char *hexdigits = "0123456789ABCDEF"; +const char *hexdigits2 = "0123456789abcdef"; + +int +main(void) +{ + char line[2000], *start, *stop, *copy; + char *d1, *d2, c; + int lineno; + +#ifdef WIN32 + _setmode( _fileno(stdout), _O_BINARY); +#endif + + line[sizeof line - 1] = 0; + lineno = 1; + while (fgets(line, sizeof line - 1, stdin)) { + lineno++; + start = line; + keep_processing: + for (stop = start; *stop && *stop != '=' && *stop != '\n'; stop++) + ; + if (stop != line && *stop == '\n') { + copy = stop; + do { + copy--; + if (*copy != ' ' && *copy != '\t') { + copy++; + break; + } + } while (copy != line); + } else { + copy = stop; + } + while (start != copy) { + putchar(*start); + start++; + } + if (*stop == '\n') { + putchar(*stop); + lineno++; + continue; + } else if (*stop == 0) { + continue; + } else { /* *stop == '=' */ + stop++; + if (*stop == 0) { + continue; + } else if ((d1 = strchr(hexdigits, *(stop))) && + (d2 = strchr(hexdigits, *(stop+1)))) { + c = (d1 - hexdigits) * 16 + (d2 - hexdigits); + putchar(c); + stop += 2; + } else if ((d1 = strchr(hexdigits2, *(stop))) && + (d2 = strchr(hexdigits2, *(stop+1)))) { + c = (d1 - hexdigits2) * 16 + (d2 - hexdigits2); + putchar(c); + stop += 2; + } else if (*stop == '\n') { + /* soft line break */ + stop++; + } else if (*stop == '\r') { + /* + * Assume the user's lousy delivery software + * didn't convert from Internet's CRLF newline + * convention to the local LF convention. + */ + stop++; + } else if (*stop == ' ' || *stop == '\t') { + /* garbage added in transit */ + for (stop++; *stop && (*stop == ' ' || *stop == '\t'); stop++) + ; + } else { + fprintf(stderr, "Error: qp-decode: line %d: '%c' is something other than line break or hex digit after = in quoted-printable encoding\n", lineno, *stop); + putchar('='); + putchar(*stop); + stop++; + /* exit(1); */ + } + start = stop; + goto keep_processing; + } + } + exit(0); +} diff --git a/src/qp-encode.1 b/src/qp-encode.1 new file mode 100644 index 0000000..c3dc52b --- /dev/null +++ b/src/qp-encode.1 @@ -0,0 +1,51 @@ +.\" -*- Mode: Nroff -*- +.\" Copyright (C) 2000 Manoj Srivastava <srivasta@debian.org>. +.\" +.\" Permission is granted to make and distribute verbatim copies of +.\" this manual provided the copyright notice and this permission notice +.\" are preserved on all copies. +.\" +.\" Permission is granted to copy and distribute modified versions of this +.\" manual under the conditions for verbatim copying, provided that the entire +.\" resulting derived work is distributed under the terms of a permission +.\" notice identical to this one. +.\" +.\" Permission is granted to copy and distribute translations of this manual +.\" into another language, under the above conditions for modified versions, +.\" except that this permission notice may be stated in a translation approved +.\" by the Author. +.\" +.\" Author: Manoj Srivastava +.\" +.\" arch-tag: bc2b7485-8846-4a92-9e54-8fd22a778663 +.\" +.TH QP\-ENCODE 1 "Sep 2 2000" "Debian" "Debian GNU/Linux manual" +.SH NAME +qp\-encode \- Fast Quoted Printable encoder +.SH SYNOPSIS +.B qp\-encode +< +.I input +> +.I qp\-encoded output +.SH DESCRIPTION +The +.B qp\-encode +utility takes arbitrary data on the standard input and converts +it to Quoted Printable data on standard output. +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. +.SH OPTIONS +.B qp\-encode +does not take any arguments or options. +.SH BUGS +None known. +.SH SEE ALSO +.I qp\-decode (1) +.SH AUTHORS +.B qp\-encode +was written by Kyle Jones. and placed by him into the public domain. +This manual page was written by Manoj Srivastava <srivasta@debian.org>, +for the Debian GNU/Linux system. + diff --git a/src/qp-encode.c b/src/qp-encode.c new file mode 100755 index 0000000..8014d02 --- /dev/null +++ b/src/qp-encode.c @@ -0,0 +1,84 @@ +/* public domain */ + +/* + * arbitrary data on stdin -> Quoted-Printable data on stdout + * + * UNIX's newline convention is used, i.e. one ASCII control-j (10 decimal). + */ + +#include <stdlib.h> +#include <stdio.h> +#include <stdlib.h> + +#ifdef _WIN32 +#ifndef WIN32 +#define WIN32 +#endif +#endif + +#ifdef WIN32 +#include <io.h> +#include <fcntl.h> +#endif + +const char *hexdigits = "0123456789ABCDEF"; + +int +main(void) +{ + int c; + int cols = 0; + +#ifdef WIN32 + _setmode( _fileno(stdout), _O_BINARY); +#endif + + while ((c = getchar()) != EOF) { + if (c == '\n') { + putchar(c); + cols = 0; + } else if (c == ' ') { + int nextc = getchar(); + if (nextc != '\n' && nextc != EOF) { + putchar(c); + cols++; + } else { + putchar('='); + putchar(hexdigits[c >> 4]); + putchar(hexdigits[c & 0xf]); + cols += 3; + } + if (nextc != EOF) + ungetc(nextc, stdin); + } else if (c < 33 || c > 126 || c == '=' || + /* these are for RFC 2047 Q encoding */ + c == '?' || c == '_') { + putchar('='); + putchar(hexdigits[c >> 4]); + putchar(hexdigits[c & 0xf]); + cols += 3; + } else if (c == '.' && cols == 0) { + int nextc = getchar(); + if (nextc == EOF || nextc == '\n') { + putchar('='); + putchar(hexdigits[c >> 4]); + putchar(hexdigits[c & 0xf]); + cols += 3; + } else { + putchar(c); + cols++; + } + if (nextc != EOF) + ungetc(nextc, stdin); + } else { + putchar(c); + cols++; + } + if (cols > 70) { + putchar('='); + putchar('\n'); + cols = 0; + } + } + exit(0); +} diff --git a/src/vm-mail b/src/vm-mail new file mode 100755 index 0000000..a6fc6ef --- /dev/null +++ b/src/vm-mail @@ -0,0 +1,38 @@ +#!/bin/sh +# -*- shell-script -*- + +# Copyright (C) 2006 Robert Widhopf-Fenk +# +# Author: Robert Widhopf-Fenk +# Status: Tested with XEmacs 21.4.19 & VM 7.19 +# Keywords: VM helpers +# X-URL: http://www.robf.de/Hacking/elisp +# Version: $Id$ + +# This is a wrapper shell script which can be used to pass mailto: links with +# the mozex Firefox plugin to VM. +# +# Grab version 1.9.3 or higher from http://mozex.mozdev.org/installation.html +# +# In mozex you should give the path to this script with the %a and %s args, e.g. +# +# /home/yourlogin/bin/vm-mail %a %s +# +# Set "cmd" below to your Emacs binary. You have three choices. + +# 1) XEmacs uncomment the next line +#cmd=xemacs + +# 2) GNU Emacs uncomment the next line +#cmd=emacs + +# 3) If you always have a VM-Emacs running you might consider to start gnuserv, +# by adding the following to the end of your ~/.vm +# +# (if (not (gnuserv-running-p)) (gnuserv-start)) +# +# This will allow you to connect to your running XEmacs with gnuclient and brings up a +# composition buffer really instantly. +cmd=gnuclient + +$cmd -eval "(let (vm-frame-per-composition) (vm-mail \"$1\" \"$2\"))" diff --git a/vm-load.el.in b/vm-load.el.in new file mode 100755 index 0000000..e817720 --- /dev/null +++ b/vm-load.el.in @@ -0,0 +1,6 @@ +; -*- mode: emacs-lisp -*- +;; Load VM easily + +(add-to-list 'load-path "@abs_top_builddir@/lisp") + +(load "vm-autoloads") |