;;; Commands to move around within a VM message;;; Copyright (C) 1989-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 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.;;(provide 'vm-page)(defunvm-scroll-forward(&optionalarg)"Scroll 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 thevalue of vm-auto-next-message is non-nil.Prefix argument N means scroll forward N lines."(interactive"P")(let((mp-changed(vm-follow-summary-cursor))needs-decoding(was-invisiblenil))(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(setqneeds-decoding(andvm-display-using-mime(notvm-mime-decoded)(not(vm-mime-plain-message-p(carvm-message-pointer)))vm-auto-decode-mime-messages(eqvm-system-state'previewing)))(andvm-presentation-buffer(set-buffervm-presentation-buffer))(let((point(point))(w(vm-get-visible-buffer-window(current-buffer))))(if(or(nullw)(not(vm-frame-totally-visible-p(vm-window-framew))))(progn(vm-display(current-buffer)t'(vm-scroll-forwardvm-scroll-backward)(listthis-command'reading-message));; window start sticks to end of clip region when clip;; region moves back past it in the buffer. fix it.(setqw(vm-get-visible-buffer-window(current-buffer)))(if(=(window-startw)(point-max))(set-window-startw(point-min)))(setqwas-invisiblet))))(if(ormp-changedwas-invisibleneeds-decoding(and(eqvm-system-state'previewing)(pos-visible-in-window-p(point-max)(vm-get-visible-buffer-window(current-buffer)))))(progn(if(notwas-invisible)(let((w(vm-get-visible-buffer-window(current-buffer)))old-w-start)(setqold-w-start(window-startw));; save-excursion to avoid possible buffer change(save-excursion(vm-select-frame(window-framew)))(vm-raise-frame(window-framew))(vm-displaynilnil'(vm-scroll-forwardvm-scroll-backward)(listthis-command'reading-message))(setqw(vm-get-visible-buffer-window(current-buffer)))(andw(set-window-startwold-w-start))))(cond((eqvm-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-startw(point-min)))))(vm-howl-if-eom))(let((vmpvm-message-pointer)(msg-buf(current-buffer))(h-diff0)wold-wold-w-heightold-w-startresult)(if(eqvm-system-state'previewing)(vm-show-current-message))(setqvm-system-state'reading)(setqold-w(vm-get-visible-buffer-windowmsg-buf)old-w-height(window-heightold-w)old-w-start(window-startold-w))(setqw(vm-get-visible-buffer-windowmsg-buf))(vm-select-frame(window-framew))(vm-raise-frame(window-framew))(vm-displaynilnil'(vm-scroll-forwardvm-scroll-backward)(listthis-command'reading-message))(setqw(vm-get-visible-buffer-windowmsg-buf))(if(nullw)(error"current window configuration hides the message buffer.")(setqh-diff(-(window-heightw)old-w-height)));; must restore this since it gets clobbered by window;; teardown and rebuild done by the window config stuff.(set-window-startwold-w-start)(setqold-w(selected-window))(unwind-protect(progn(select-windoww)(let((next-screen-context-lines(+next-screen-context-linesh-diff)))(while(eq(setqresult(vm-scroll-forward-internalarg))'tryagain))(cond((and(not(eqresult'next-message))vm-honor-page-delimiters)(vm-narrow-to-page)(goto-char(max(window-startw)(vm-text-of(carvmp))));; 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-for0);; 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-up0)))))(select-windowold-w))(set-buffermsg-buf)(cond((eqresult'next-message)(vm-next-message))((eqresult'end-of-message)(let((vm-message-pointervmp))(vm-emit-eom-blurb)))(t(and(>(prefix-numeric-valuearg)0)(vm-howl-if-eom)))))))(if(notvm-startup-message-displayed)(vm-display-startup-message)))(defunvm-scroll-forward-internal(arg)(let((direction(prefix-numeric-valuearg))(w(selected-window)))(condition-caseerror-data(progn(scroll-uparg)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(<direction0)(>(point-min)(vm-text-of(carvm-message-pointer))))(and(>=direction0)(/=(point-max)(vm-text-end-of(carvm-message-pointer)))))(progn(vm-widen-page)(if(>=direction0)(progn(forward-page1)(set-window-startw(point))nil)(if(or(bolp)(not(save-excursion(beginning-of-line)(looking-atpage-delimiter))))(forward-page-1))(beginning-of-line)(set-window-startw(point))'tryagain))(if(eq(carerror-data)'end-of-buffer)(ifvm-auto-next-message'next-message(set-window-pointw(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.(defunvm-howl-if-eom()(let((w(get-buffer-window(current-buffer))))(andw(save-excursion(save-window-excursion(condition-case()(let((next-screen-context-lines0))(select-windoww)(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-originalnil))(scroll-upnil))))nil)(errort))))(=(vm-text-end-of(carvm-message-pointer))(point-max))(vm-emit-eom-blurb))))(defunvm-emit-eom-blurb()(let((vm-summary-uninteresting-senders-arrow"")(case-fold-searchnil))(message(if(and(stringpvm-summary-uninteresting-senders)(string-matchvm-summary-uninteresting-senders(vm-su-from(carvm-message-pointer))))"End of message %s to %s""End of message %s from %s")(vm-number-of(carvm-message-pointer))(vm-summary-sprintf"%F"(carvm-message-pointer)))))(defunvm-scroll-backward(&optionalarg)"Scroll backward a screenful of text.Prefix N scrolls backward N lines."(interactive"P")(vm-scroll-forward(cond((nullarg)'-)((consparg)(list(-(cararg))))((numberparg)(-arg))((symbolparg)nil)(targ))))(defunvm-scroll-forward-one-line(&optionalcount)"Scroll forward one line.Prefix arg N means scroll forward N lines.Negative arg means scroll backward."(interactive"p")(vm-scroll-forwardcount))(defunvm-scroll-backward-one-line(&optionalcount)"Scroll backward one line.Prefix arg N means scroll backward N lines.Negative arg means scroll forward."(interactive"p")(vm-scroll-forward(-count)))(defunvm-highlight-headers()(cond((andvm-xemacs-pvm-use-lucid-highlighting)(require'highlight-headers);; disable the url marking stuff, since VM has its own interface.(let((highlight-headers-mark-urlsnil)(highlight-headers-regexp(orvm-highlighted-header-regexphighlight-headers-regexp)))(highlight-headers(point-min)(point-max)t)))(vm-xemacs-p(let(e)(map-extents(function(lambda(eignore)(if(extent-propertye'vm-highlight)(delete-extente))nil))(current-buffer)(point-min)(point-max))(goto-char(point-min))(while(vm-match-header)(cond((vm-match-headervm-highlighted-header-regexp)(setqe(make-extent(vm-matched-header-contents-start)(vm-matched-header-contents-end)))(set-extent-propertye'facevm-highlighted-header-face)(set-extent-propertye'vm-highlightt)))(goto-char(vm-matched-header-end)))))((fboundp'overlay-put)(let(o-listsp)(setqo-lists(overlay-lists)p(caro-lists))(whilep(and(overlay-get(carp)'vm-highlight)(delete-overlay(carp)))(setqp(cdrp)))(setqp(cdro-lists))(whilep(and(overlay-get(carp)'vm-highlight)(delete-overlay(carp)))(setqp(cdrp)))(goto-char(point-min))(while(vm-match-header)(cond((vm-match-headervm-highlighted-header-regexp)(setqp(make-overlay(vm-matched-header-contents-start)(vm-matched-header-contents-end)))(overlay-putp'facevm-highlighted-header-face)(overlay-putp'vm-highlightt)))(goto-char(vm-matched-header-end)))))))(defunvm-energize-urls();; 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-limitvm-url-search-limit)search-pairsn)(if(andsearch-limit(>(-(point-max)(point-min))search-limit))(setqsearch-pairs(list(cons(point-min)(+(point-min)(/search-limit2)))(cons(-(point-max)(/search-limit2))(point-max))))(setqsearch-pairs(list(cons(point-min)(point-max)))))(cond(vm-xemacs-p(let(e)(map-extents(function(lambda(eignore)(if(extent-propertye'vm-url)(delete-extente))nil))(current-buffer)(point-min)(point-max))(whilesearch-pairs(goto-char(car(carsearch-pairs)))(while(re-search-forwardvm-url-regexp(cdr(carsearch-pairs))t)(setqn1)(while(null(match-beginningn))(vm-incrementn))(setqe(make-extent(match-beginningn)(match-endn)))(set-extent-propertye'vm-urlt)(ifvm-highlight-url-face(set-extent-propertye'facevm-highlight-url-face))(ifvm-url-browser(let((keymap(make-sparse-keymap))(popup-function(if(save-excursion(goto-char(match-beginningn))(looking-at"mailto:"))'vm-menu-popup-mailto-url-browser-menu'vm-menu-popup-url-browser-menu)))(define-keykeymap'button2'vm-mouse-send-url-at-event)(ifvm-popup-menu-on-mouse-3(define-keykeymap'button3popup-function))(define-keykeymap"\r"(function(lambda()(interactive)(vm-mouse-send-url-at-position(point)))))(set-extent-propertye'vm-buttont)(set-extent-propertye'keymapkeymap)(set-extent-propertye'balloon-help'vm-url-help)(set-extent-propertye'highlightt))))(setqsearch-pairs(cdrsearch-pairs)))))((andvm-fsfemacs-p(fboundp'overlay-put))(let(o-listsop)(setqo-lists(overlay-lists)p(caro-lists))(whilep(and(overlay-get(carp)'vm-url)(delete-overlay(carp)))(setqp(cdrp)))(setqp(cdro-lists))(whilep(and(overlay-get(carp)'vm-url)(delete-overlay(carp)))(setqp(cdrp)))(whilesearch-pairs(goto-char(car(carsearch-pairs)))(while(re-search-forwardvm-url-regexp(cdr(carsearch-pairs))t)(setqn1)(while(null(match-beginningn))(vm-incrementn))(setqo(make-overlay(match-beginningn)(match-endn)))(overlay-puto'vm-urlt)(ifvm-highlight-url-face(overlay-puto'facevm-highlight-url-face))(ifvm-url-browser(let((keymap(make-sparse-keymap))(popup-function(if(save-excursion(goto-char(match-beginningn))(looking-at"mailto:"))'vm-menu-popup-mailto-url-browser-menu'vm-menu-popup-url-browser-menu)))(overlay-puto'vm-buttont)(overlay-puto'mouse-face'highlight)(setqkeymap(nconckeymap(current-local-map)))(ifvm-popup-menu-on-mouse-3(define-keykeymap[mouse-3]popup-function))(define-keykeymap"\r"(function(lambda()(interactive)(vm-mouse-send-url-at-position(point)))))(overlay-puto'local-mapkeymap))))(setqsearch-pairs(cdrsearch-pairs))))))))(defunvm-energize-headers()(cond(vm-xemacs-p(let((search-tuples'(("^From:"vm-menu-author-menu)("^Subject:"vm-menu-subject-menu)))regexpmenukeymape)(map-extents(function(lambda(eignore)(if(extent-propertye'vm-header)(delete-extente))nil))(current-buffer)(point-min)(point-max))(whilesearch-tuples(goto-char(point-min))(setqregexp(nth0(carsearch-tuples))menu(symbol-value(nth1(carsearch-tuples))))(while(re-search-forwardregexpnilt)(save-excursion(goto-char(match-beginning0))(vm-match-header))(setqe(make-extent(vm-matched-header-contents-start)(vm-matched-header-contents-end)))(set-extent-propertye'vm-headert)(setqkeymap(make-sparse-keymap));; Might as well make button2 do what button3 does in;; this case, since there is no default 'select';; action.(define-keykeymap'button2(list'lambda()'(interactive)(list'popup-menu(list'quotemenu))))(ifvm-popup-menu-on-mouse-3(define-keykeymap'button3(list'lambda()'(interactive)(list'popup-menu(list'quotemenu)))))(set-extent-propertye'keymapkeymap)(set-extent-propertye'balloon-help'vm-mouse-3-help)(set-extent-propertye'highlightt))(setqsearch-tuples(cdrsearch-tuples)))))((andvm-fsfemacs-p(fboundp'overlay-put))(let((search-tuples'(("^From:"vm-menu-fsfemacs-author-menu)("^Subject:"vm-menu-fsfemacs-subject-menu)))regexpmenuo-listsop)(setqo-lists(overlay-lists)p(caro-lists))(whilep(and(overlay-get(carp)'vm-header)(delete-overlay(carp)))(setqp(cdrp)))(setqp(cdro-lists))(whilep(and(overlay-get(carp)'vm-header)(delete-overlay(carp)))(setqp(cdrp)))(whilesearch-tuples(goto-char(point-min))(setqregexp(nth0(carsearch-tuples))menu(symbol-value(nth1(carsearch-tuples))))(while(re-search-forwardregexpnilt)(goto-char(match-end0))(save-excursion(goto-char(match-beginning0))(vm-match-header))(setqo(make-overlay(vm-matched-header-contents-start)(vm-matched-header-contents-end)))(overlay-puto'vm-headermenu)(overlay-puto'mouse-face'highlight))(setqsearch-tuples(cdrsearch-tuples)))))))(defunvm-display-xface()(cond(vm-xemacs-p(vm-display-xface-xemacs))((andvm-fsfemacs-p(and(stringpvm-uncompface-program)(fboundp'create-image)))(vm-display-xface-fsfemacs))))(defunvm-display-xface-xemacs()(let((case-fold-searcht)egh)(if(map-extents(function(lambda(eignore)(if(extent-propertye'vm-xface)tnil)))(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:"nilt)(progn(goto-char(match-beginning0))(vm-match-header)(setqh(concat"X-Face: "(vm-matched-header-contents)))(setqg(internhvm-xface-cache))(if(boundpg)(setqg(symbol-valueg))(setg(make-glyph(list(list'global(cons'(tty)[nothing]))(list'global(cons'(win)(vector'xface':datah))))))(setqg(symbol-valueg));; XXX broken. Gives extra pixel lines at the;; bottom of the glyph in 19.12;;(set-glyph-baseline g 100)(set-glyph-faceg'vm-xface))(setqe(make-extent(vm-vheaders-of(carvm-message-pointer))(vm-vheaders-of(carvm-message-pointer))))(set-extent-propertye'vm-xfacet)(set-extent-begin-glypheg))))))(defunvm-display-xface-fsfemacs()(catch'done(let((case-fold-searcht)ighooo)(setqooo(overlays-in(point-min)(point-max)))(whileooo(if(overlay-get(carooo)'vm-xface)(delete-overlay(carooo)))(setqooo(cdrooo)))(goto-char(point-min))(if(re-search-forward"^X-Face:"nilt)(progn(goto-char(match-beginning0))(vm-match-header)(setqh(vm-matched-header-contents))(setqg(internhvm-xface-cache))(if(boundpg)(setqg(symbol-valueg))(setqi(vm-convert-xface-to-fsfemacs-image-instantiatorh))(cond(i(setgi)(setqg(symbol-valueg)))(t(throw'donenil))))(let((pos(vm-vheaders-of(carvm-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.(setqo(make-overlay(+0pos)(+1pos)))(overlay-puto'vm-xfacet)(overlay-puto'evaporatet)(overlay-puto'after-string(char-to-string(char-afterpos)))(overlay-puto'displayg)))))))(defunvm-convert-xface-to-fsfemacs-image-instantiator(data)(let((work-buffernil)retval)(catch'done(unwind-protect(save-excursion(if(not(stringpvm-uncompface-program))(throw'donenil))(setqwork-buffer(vm-make-work-buffer))(set-bufferwork-buffer)(insertdata)(setqretval(apply'call-process-region(point-min)(point-max)vm-uncompface-programttnil(ifvm-uncompface-accepts-dash-x'("-X")nil)))(if(not(eqretval0))(throw'donenil))(ifvm-uncompface-accepts-dash-x(throw'done(list'image':type'xbm':ascent80':foreground"black"':background"white"':data(buffer-string))))(if(not(stringpvm-icontopbm-program))(throw'donenil))(goto-char(point-min))(insert"/* Width=48, Height=48 */\n");(setqretval(call-process-region(point-min)(point-max)vm-icontopbm-programttnil))(if(not(eqretval0))nil(list'image':type'pbm':ascent80':foreground"black"':background"white"':data(buffer-string))))(andwork-buffer(kill-bufferwork-buffer))))))(defunvm-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((stringpvm-url-browser)vm-url-browser)((eqvm-url-browser'w3-fetch)"Emacs W3")((eqvm-url-browser'w3-fetch-other-frame)"Emacs W3")((eqvm-url-browser'vm-mouse-send-url-to-mosaic)"Mosaic")((eqvm-url-browser'vm-mouse-send-url-to-netscape)"Netscape")(t(symbol-namevm-url-browser)))))(defunvm-energize-urls-in-message-region(&optionalstartend)(save-excursion(orstart(setqstart(vm-headers-of(carvm-message-pointer))))(orend(setqend(vm-text-end-of(carvm-message-pointer))));; energize the URLs(if(orvm-highlight-url-facevm-url-browser)(save-restriction(widen)(narrow-to-regionstartend)(vm-energize-urls)))))(defunvm-highlight-headers-maybe();; highlight the headers(if(orvm-highlighted-header-regexp(andvm-xemacs-pvm-use-lucid-highlighting))(save-restriction(widen)(narrow-to-region(vm-headers-of(carvm-message-pointer))(vm-text-end-of(carvm-message-pointer)))(vm-highlight-headers))))(defunvm-energize-headers-and-xfaces();; energize certain headers(if(andvm-use-menus(vm-menu-support-possible-p))(save-restriction(widen)(narrow-to-region(vm-headers-of(carvm-message-pointer))(vm-text-of(carvm-message-pointer)))(vm-energize-headers)));; display xfaces, if we can(if(andvm-display-xfaces(or(andvm-xemacs-p(featurep'xface))(andvm-fsfemacs-p(fboundp'create-image)(stringpvm-uncompface-program))))(save-restriction(widen)(narrow-to-region(vm-headers-of(carvm-message-pointer))(vm-text-of(carvm-message-pointer)))(vm-display-xface))))(defunvm-narrow-for-preview(&optionaljust-passing-through)(widen);; hide as much of the message body as vm-preview-lines specifies(narrow-to-region(vm-vheaders-of(carvm-message-pointer))(cond((not(eqvm-preview-linest))(min(vm-text-end-of(carvm-message-pointer))(save-excursion(goto-char(vm-text-of(carvm-message-pointer)))(forward-line(if(natnumpvm-preview-lines)vm-preview-lines0));; 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(notjust-passing-through)vm-xemacs-pvm-mail-buffer; in presentation buffervm-auto-decode-mime-messagesvm-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(carvm-message-pointer))))(let((buffer-read-onlynil))(insert" ")(forward-char-1)))(point))))(t(vm-text-end-of(carvm-message-pointer))))))(defunvm-preview-current-message();; Set just-passing-through if the user will never see the;; message in the previewed state. Save some time later by not;; doing preview action that the user will never see anyway.(let((just-passing-through(or(nullvm-preview-lines)(and(notvm-preview-read-messages)(not(vm-new-flag(carvm-message-pointer)))(not(vm-unread-flag(carvm-message-pointer)))))))(vm-save-buffer-excursion(setqvm-system-state'previewingvm-mime-decodednil)(ifvm-real-buffers(vm-make-virtual-copy(carvm-message-pointer)));; run the message select hooks.(save-excursion(vm-select-folder-buffer)(vm-run-message-hook(carvm-message-pointer)'vm-select-message-hook)(andvm-select-new-message-hook(vm-new-flag(carvm-message-pointer))(vm-run-message-hook(carvm-message-pointer)'vm-select-new-message-hook))(andvm-select-unread-message-hook(vm-unread-flag(carvm-message-pointer))(vm-run-message-hook(carvm-message-pointer)'vm-select-unread-message-hook)))(vm-narrow-for-previewjust-passing-through)(if(orvm-mime-display-function(natnumpvm-fill-paragraphs-containing-long-lines)(andvm-display-using-mime(not(vm-mime-plain-message-p(carvm-message-pointer)))))(let((layout(vm-mm-layout(carvm-message-pointer))))(vm-make-presentation-copy(carvm-message-pointer))(vm-save-buffer-excursion(vm-replace-buffer-in-windows(current-buffer)vm-presentation-buffer))(set-buffervm-presentation-buffer)(setqvm-system-state'previewing)(vm-narrow-for-preview))(setqvm-presentation-buffernil)(andvm-presentation-buffer-handle(vm-replace-buffer-in-windowsvm-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))(if(andvm-display-using-mimevm-auto-decode-mime-messagesvm-mime-decode-for-preview(notjust-passing-through)(ifvm-mail-buffer(not(vm-buffer-variable-valuevm-mail-buffer'vm-mime-decoded))(notvm-mime-decoded))(not(vm-mime-plain-message-p(carvm-message-pointer))))(if(eqvm-preview-lines0)(progn(vm-decode-mime-message-headers(carvm-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.(let((vm-auto-displayed-mime-content-type-exceptions(cons"message/external-body"vm-auto-displayed-mime-content-type-exceptions))(vm-mime-external-content-types-alistnil))(condition-casedata(progn(vm-decode-mime-message);; reset vm-mime-decoded so that when the user;; opens the message completely, the full MIME;; display will happen.(andvm-mail-buffer(vm-set-buffer-variablevm-mail-buffer'vm-mime-decodednil)))(vm-mime-error(vm-set-mime-layout-of(carvm-message-pointer)(car(cdrdata)))(message"%s"(car(cdrdata)))))(vm-narrow-for-preview)))(vm-energize-urls-in-message-region)(vm-highlight-headers-maybe)(vm-energize-headers-and-xfaces))(if(andvm-honor-page-delimiters(notjust-passing-through))(vm-narrow-to-page))(goto-char(vm-text-of(carvm-message-pointer)));; If we have a window, set window start appropriately.(let((w(vm-get-visible-buffer-window(current-buffer))))(ifw(progn(set-window-startw(point-min))(set-window-pointw(vm-text-of(carvm-message-pointer))))))(ifjust-passing-through(vm-show-current-message)(vm-update-summary-and-mode-line)))))(defunvm-show-current-message()(andvm-display-using-mimevm-auto-decode-mime-messages(ifvm-mail-buffer(not(vm-buffer-variable-valuevm-mail-buffer'vm-mime-decoded))(notvm-mime-decoded))(not(vm-mime-plain-message-p(carvm-message-pointer)))(condition-casedata(vm-decode-mime-message)(vm-mime-error(vm-set-mime-layout-of(carvm-message-pointer)(car(cdrdata)))(message"%s"(car(cdrdata))))))(if(and(natnumpvm-fill-paragraphs-containing-long-lines)(vm-mime-plain-message-p(carvm-message-pointer)))(let((needmsg(>(-(vm-text-end-of(carvm-message-pointer))(vm-text-of(carvm-message-pointer)))12000)))(ifneedmsg(message"Searching for paragraphs to fill..."))(vm-fill-paragraphs-containing-long-linesvm-fill-paragraphs-containing-long-lines(vm-text-of(carvm-message-pointer))(vm-text-end-of(carvm-message-pointer)))(ifneedmsg(message"Searching for paragraphs to fill... done"))))(vm-save-buffer-excursion(save-excursion(save-excursion(goto-char(point-min))(widen)(narrow-to-region(point)(vm-text-end-of(carvm-message-pointer))))(ifvm-honor-page-delimiters(progn(if(looking-atpage-delimiter)(forward-page1))(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(setqvm-system-state'showing)(ifvm-mail-buffer(vm-set-buffer-variablevm-mail-buffer'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)(cond((vm-new-flag(carvm-message-pointer))(vm-set-new-flag(carvm-message-pointer)nil)))(cond((vm-unread-flag(carvm-message-pointer))(vm-set-unread-flag(carvm-message-pointer)nil))))(vm-update-summary-and-mode-line)(vm-howl-if-eom))(vm-update-summary-and-mode-line))))(defunvm-expose-hidden-headers()"Toggle exposing and hiding message headers that are normally not visible."(interactive)(vm-follow-summary-cursor)(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(andvm-presentation-buffer(set-buffervm-presentation-buffer))(vm-display(current-buffer)t'(vm-expose-hidden-headers)'(vm-expose-hidden-headersreading-message))(let*((exposed(=(point-min)(vm-start-of(carvm-message-pointer)))))(vm-widen-page)(goto-char(point-max))(widen)(ifexposed(narrow-to-region(point)(vm-vheaders-of(carvm-message-pointer)))(narrow-to-region(point)(vm-start-of(carvm-message-pointer))))(goto-char(point-min))(let(w)(setqw(vm-get-visible-buffer-window(current-buffer)))(andw(set-window-pointw(point-min)))(andw(=(window-startw)(vm-vheaders-of(carvm-message-pointer)))(notexposed)(set-window-startw(vm-start-of(carvm-message-pointer)))))(ifvm-honor-page-delimiters(vm-narrow-to-page))))(defunvm-widen-page()(if(or(>(point-min)(vm-text-of(carvm-message-pointer)))(/=(point-max)(vm-text-end-of(carvm-message-pointer))))(narrow-to-region(vm-vheaders-of(carvm-message-pointer))(if(or(vm-new-flag(carvm-message-pointer))(vm-unread-flag(carvm-message-pointer)))(vm-text-of(carvm-message-pointer))(vm-text-end-of(carvm-message-pointer))))))(defunvm-narrow-to-page()(cond(vm-fsfemacs-p(if(not(andvm-page-end-overlay(overlay-buffervm-page-end-overlay)))(let((gvm-page-continuation-glyph))(setqvm-page-end-overlay(make-overlay(point)(point)))(vm-set-extent-propertyvm-page-end-overlay'vm-glyphg)(vm-set-extent-propertyvm-page-end-overlay'before-stringg)(overlay-putvm-page-end-overlay'evaporatenil))))(vm-xemacs-p(if(not(andvm-page-end-overlay(extent-end-positionvm-page-end-overlay)))(let((gvm-page-continuation-glyph))(cond((not(glyphpg))(setqg(make-glyphg))(set-glyph-faceg'italic)))(setqvm-page-end-overlay(make-extent(point)(point)))(vm-set-extent-propertyvm-page-end-overlay'vm-glyphg)(vm-set-extent-propertyvm-page-end-overlay'begin-glyphg)(set-extent-propertyvm-page-end-overlay'detachablenil)))))(save-excursion(let(minmax(evm-page-end-overlay))(if(or(bolp)(not(save-excursion(beginning-of-line)(looking-atpage-delimiter))))(forward-page-1))(setqmin(point))(forward-page1)(if(not(eobp))(beginning-of-line))(cond((/=(point)(vm-text-end-of(carvm-message-pointer)))(vm-set-extent-propertyevm-begin-glyph-property(vm-extent-propertye'vm-glyph))(vm-set-extent-endpointse(point)(point)))(t(vm-set-extent-propertyevm-begin-glyph-propertynil)))(setqmax(point))(narrow-to-regionminmax))))(defunvm-beginning-of-message()"Moves to the beginning of the current message."(interactive)(vm-follow-summary-cursor)(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(andvm-presentation-buffer(set-buffervm-presentation-buffer))(vm-widen-page)(push-mark)(vm-display(current-buffer)t'(vm-beginning-of-message)'(vm-beginning-of-messagereading-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(eqosw(selected-window)))(select-windowosw)))))(ifvm-honor-page-delimiters(vm-narrow-to-page)))(defunvm-end-of-message()"Moves to the end of the current message, exposing and flagging it readas necessary."(interactive)(vm-follow-summary-cursor)(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(andvm-presentation-buffer(set-buffervm-presentation-buffer))(if(eqvm-system-state'previewing)(vm-show-current-message))(setqvm-system-state'reading)(vm-widen-page)(push-mark)(vm-display(current-buffer)t'(vm-end-of-message)'(vm-end-of-messagereading-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(eqosw(selected-window)))(select-windowosw)))))(ifvm-honor-page-delimiters(vm-narrow-to-page)))(defunvm-move-to-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 RETURNwill produce an action. If the message is being previewed, it isexposed and marked as read."(interactive"p")(vm-follow-summary-cursor)(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(andvm-presentation-buffer(set-buffervm-presentation-buffer))(if(eqvm-system-state'previewing)(vm-show-current-message))(setqvm-system-state'reading)(vm-widen-page)(vm-display(current-buffer)t'(vm-move-to-next-button)'(vm-move-to-next-buttonreading-message))(select-window(vm-get-visible-buffer-window(current-buffer)))(unwind-protect(vm-move-to-xxxx-button(vm-abscount)(>=count0))(ifvm-honor-page-delimiters(vm-narrow-to-page))))(defunvm-move-to-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 RETURNwill produce an action. If the message is being previewed, it isexposed and marked as read."(interactive"p")(vm-follow-summary-cursor)(vm-select-folder-buffer)(vm-check-for-killed-summary)(vm-check-for-killed-presentation)(vm-error-if-folder-empty)(andvm-presentation-buffer(set-buffervm-presentation-buffer))(if(eqvm-system-state'previewing)(vm-show-current-message))(setqvm-system-state'reading)(vm-widen-page)(vm-display(current-buffer)t'(vm-move-to-previous-button)'(vm-move-to-previous-buttonreading-message))(select-window(vm-get-visible-buffer-window(current-buffer)))(unwind-protect(vm-move-to-xxxx-button(vm-abscount)(<count0))(ifvm-honor-page-delimiters(vm-narrow-to-page))))(defunvm-move-to-xxxx-button(countnext)(let((old-point(point))(endp(ifnext'eobp'bobp))(extent-end-position(ifvm-xemacs-p(ifnext'extent-end-position'extent-start-position)(ifnext'overlay-end'overlay-start)))(next-extent-change(ifvm-xemacs-p(ifnext'next-extent-change'previous-extent-change)(ifnext'next-overlay-change'previous-overlay-change)))e)(while(and(>count0)(not(funcallendp)))(goto-char(funcallnext-extent-change(+(point)(ifnext0-1))))(setqe(vm-extent-at(point)))(ife(progn(if(vm-extent-propertye'vm-button)(vm-decrementcount))(goto-char(funcallextent-end-positione)))))(ife(goto-char(vm-extent-start-positione))(goto-charold-point)(error"No more buttons"))))(provide'vm-page)