LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031616. :SYSTEM-TYPE :LOGICAL :VERSION 7. :TYPE "LISP" :NAME "DISPLAY" :DIRECTORY ("REL3-SOURCE" "MAIL-READER") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758716413. :AUTHOR "REL3" :LENGTH-IN-BYTES 12228. :LENGTH-IN-BLOCKS 12. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;; -*- Mode:Common-Lisp; Package:ZWEI; Base:10 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;;;;; Display related functions for the Mail Reader.;;;(defun MUST-REDISPLAY-MAIL-BUFFER (buffer sequence-degree &optional summary-degree window)  "Update window displaying the current message sequence as well as any windowsshowing its summary."    (unless (message-sequence-p buffer)    (must-redisplay-buffer buffer sequence-degree)    (return-from must-redisplay-mail-buffer))  (unless sequence-degree (setq sequence-degree dis-text))  (unless summary-degree (setq summary-degree dis-text))    (let ((message (current-message buffer)))    (when (messagep message)      (make-message-current nil buffer)      (setq *msg* message)            ;; Much of the following code is taken from (:method zmacs-window :set-interval-internal)      (let ((first-bp (interval-first-bp message)))(unless window  (setq window (mail-buffer-window buffer)))(cond (window       ;; Make sure that point and start-bp of window are within the same message.       (unless (eq (bp-message (window-point window))   (bp-message (window-start-bp window))) (move-bp (window-start-bp window) (interval-first-bp (bp-message (window-point window)))))              (cond ((eq (bp-message (window-point window)) message)      ;; Window is at correct message, just do specified redisplay      (must-redisplay window sequence-degree))     (t      ;; Switching to new message... update unseen attibute.      (let ((old-msg (bp-node (window-point window))))(and (messagep old-msg) (delete-message-attribute :unseen old-msg)))      ;; Change window pointers       (move-bp (window-point window) first-bp)      (move-bp (window-mark window) first-bp)      (move-bp (window-start-bp window) first-bp)      ;; Lose the region, if any.      (setf (window-mark-p window) nil)      ;; If this is the current selected window, update global vars.      ;;(when (eq window *window*)      ;;(setq *point* (window-point window)      ;;*mark* (window-mark window)))      (must-redisplay window (max dis-text sequence-degree)))))      (t       (must-redisplay-buffer buffer sequence-degree))))            ;; Update the summary buffer and any windows it is in.      (let* ((summary-buffer (mail-summary-of buffer)))(when summary-buffer   (let ((window (mail-buffer-window summary-buffer))(new-bp (and summary-buffer (summary-make-message-current message summary-buffer buffer))))    (cond ((and window new-bp)   (if (bp-= new-bp (window-point window))       (must-redisplay window summary-degree)     ;; Point moved, ensure degree is not less than dis-bps     (move-bp (window-point window) new-bp)     (must-redisplay window (max dis-bps summary-degree))))  (t   (must-redisplay-buffer summary-buffer summary-degree)))))))))(defmethod (window :before :redisplay) (&rest ignore)  ;;; This is a kludge and I'd like to get rid of it.  For a message  ;;; sequence, ensure that the point and the start bp of the window  ;;; both refer to the same message, otherwise redisplay will go into  ;;; the EH.  One place this is known to happen is when one aborts from  ;;; com-mail-incremental-search (because the ABORT key is intercepted  ;;; and incremental-search doesn't get to do its cleanup, which causes  ;;; problems for mail).    (when (typep interval 'message-sequence)    (let ((msg (bp-message (interval-first-bp interval))))      (unless (and (eq msg (bp-message point))   (eq msg (bp-message start-bp)))(if (neq self (mail-buffer-window interval))    ;; Suppress redisplaying extra message sequence window    (setq redisplay-degree dis-none)  ;; Attempt to select the message that window is pointing to  (select-message (bp-message point) interval)  (setq *msg* (current-message interval))  (setq *mail-buffer* interval)  (must-redisplay-mail-buffer interval dis-text dis-bps self))))))(defun TWO-MAIL-READER-WINDOWS-P (buffer)    (let ((window-list (frame-exposed-windows)))    (when (>= (length window-list) 2)      (loopwith (summary-window message-window)with summary-buffer = (or (mail-summary-of buffer) (return-from two-mail-reader-windows-p nil))with message-buffer = (message-sequence-of buffer)with filter-summary-p = (filter-summary-p summary-buffer)for window in window-listdo(cond (filter-summary-p       (cond ((eq (window-interval window) summary-buffer)      (setq summary-window window)      (if message-window  (return summary-window message-window)))     ((and (message-sequence-p (window-interval window))   (lisp:find (window-interval window) (buffer-filter-list summary-buffer) :test #'(lambda (buffer filter) (eq buffer (get filter :message-sequence)))))      (setq message-window window)      (if summary-window  (return summary-window message-window)))))      ((eq (window-interval window) summary-buffer)       (setq summary-window window)       (if message-window   (return summary-window message-window)))      ((eq (window-interval window) message-buffer)       (setq message-window window)       (if summary-window   (return summary-window message-window))))finally(return nil)))))(defun CURRENT-MAIL-WINDOW-CONFIGURATION (&optional (standard-only t))    (let ((window-list (frame-exposed-windows))(interval (window-interval *window*)))    (cond ((= (length window-list) 1)   (cond ((mail-summary-p interval)  :summary) ((message-sequence-p interval)  :message) (t  (if standard-only nil :one))))  ((= (length window-list) 2)   (if (and (mail-reader-buffer-p interval)    (two-mail-reader-windows-p interval))       :both     (if standard-only nil :two)))  (t   (if standard-only nil :multi)))))(defun TWO-MAIL-READER-WINDOWS (buffer)    (let ((*mail-buffer-selection-mode* :both))    (send buffer :select));;  (multiple-value-bind (top bottom);;      (two-windows-by-fraction *mail-summary-window-fraction*);;    (if (eq *window* top);;(select-window);;      (make-window-current top));;    (send bottom :set-interval-internal buffer);;    (send (mail-summary-of buffer t) :select);;    (push-remove-on-history buffer (send bottom :buffer-history)));;  (setf (get buffer :prev-mail-window-configuration) :both);;  (must-redisplay-mail-buffer buffer dis-text dis-text)  )(defun TWO-WINDOWS-BY-FRACTION (top-fraction)    (let ((windows (frame-exposed-windows)))    ;; If more than 2 windows present, reduce to 1 and start from there    (when (> 2 (length windows))      (make-window-full-screen *window*)      (setq windows (frame-exposed-windows)))    (cond ((= 1 (length windows))   (multiple-value-bind (top-window bottom-window)       (send (window-frame *window*) :two-editor-windows)     (let ((w1 (window-sheet top-window))   (w2 (window-sheet bottom-window))   (frame (window-frame top-window)))       (multiple-value-bind (left top right bottom)   (send frame :inside-edges-without-mode-line-window) (tv:preserve-substitute-status frame   (tv:delaying-screen-management     (send w1 :deexpose)     (send w2 :deexpose)     (let ((w1-height (ceiling (* (- bottom top) top-fraction))))       (send w1 :set-edges left top right (+ top w1-height))       (send w2 :set-edges left (+ top w1-height) right bottom))     (send w1 :set-label nil)     (send w2 :set-label nil)     (send w1 :expose nil :clean);Make sure they are both there     (send w2 :expose nil :clean))))       (send frame :update-labels)       (values w1 w2))))  ;; Already have two windows... adjusting current ones is quicker than starting from scratch  (t    (let* ((w1 (window-sheet (first windows)))  (w2 (window-sheet (second windows)))  (frame (window-frame (first windows)))  w1-height)     (multiple-value-bind (left top right bottom) (send frame :inside-edges-without-mode-line-window)       (setq w1-height (ceiling (* (- bottom top) top-fraction)))       (multiple-value-bind (nil top1 nil bottom1)   (send w1 :edges) (unless (= w1-height (- bottom1 top1))   (send w1 :set-edges left top right (+ top w1-height))   (send w2 :set-edges left (+ top w1-height) right bottom))))     (send frame :update-labels)     (values w1 w2))))))(defun CLEAN-UP-MAIL-WINDOWS-FOR-EXIT ()  (when (= (length (frame-exposed-windows)) 2)    (let ((summary-window (two-mail-reader-windows-p *mail-buffer*)))      (when summary-window; That is, we have two windows.  (make-window-current summary-window); Want to keep the summary window for history, etc.  (make-window-full-screen *window*)))))(defun MAIL-BUFFER-WINDOW (buffer)  "Return an exposed zmacs pane currently displaying BUFFER or nil."    (and (boundp '*window*) *window*       (or ;; First preference to currently select window (if (eq buffer (window-interval *window*)) *window*) ;; Second preference to any window in current frame (lisp:find buffer (the list (frame-exposed-windows)) :test #'(lambda (b w) (eq b (window-interval w)))))))(defun (:property *MESSAGE-NUMBER* mode-line-recalculate) ()  (if *mail-buffer*      (setf *message-number* (format nil "~D" (1+ (buffer-current-message-index *mail-buffer*))))      (setf *message-number* "0")))(defun (:property *MESSAGE-COUNT* mode-line-recalculate) ()  (if *mail-buffer*      (setf *message-count* (format nil "~D" (total-messages *mail-buffer*)))      (setf *message-count* "0")))(defun (:property *MESSAGE-KEYWORDS-CHECK* mode-line-recalculate) ()  (if *msg*      (let ((str (message-keywords-string *msg*)))(cond ((or (null str) (zerop (length str)))       (setq *message-keywords-check* ""     *message-keywords* ""))      (t       (setq *message-keywords-check* " "     *message-keywords* str))))))(defun (:property *MESSAGE-REMINDER* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :remind *msg*))       (setf *message-reminder* " Reminder")       (setf *message-reminder* "")))(defun (:property *MESSAGE-FILED* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :filed *msg*))       (setf *message-filed* " Filed")       (setf *message-filed* "")))(defun (:property *MESSAGE-DELETED* mode-line-recalculate) ()   (if (and *msg* (message-attribute-p :deleted *msg*))       (setf *message-deleted* " Deleted")       (setf *message-deleted* "")))(defun (:property *MESSAGE-ANSWERED* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :answered *msg*))      (setf *message-answered* " Answered")      (setf *message-answered* "")))(defun (:property *MESSAGE-UNSEEN* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :unseen *msg*))      (setf *message-unseen* " Unseen")      (setf *message-unseen* "")))(defun (:property *MESSAGE-PRINT* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :print *msg*))      (setf *message-print* " Print")      (setf *message-print* "")))(defun (:property *MESSAGE-APPLY* mode-line-recalculate) ()  (if (and *msg* (message-attribute-p :apply *msg*))      (setf *message-apply* " Marked")      (setf *message-apply* "")))(defun (:property *MAIL-FILE-MODIFIED-P* mode-line-recalculate) ()   (if (and *mail-buffer* (buffer-mail-file-buffer *mail-buffer*)    (send (buffer-mail-file-buffer *mail-buffer*) :needs-saving-p))       (setf *mail-file-modified-p* " *")       (setf *mail-file-modified-p* "")));;  Box summary lines.(defun (:property read-mail-mode mouse-line-box-predicate) (line)   (and *box-summary-lines*(getf (line-plist line) :summary-message)))tem)))    (if user-filter?(setf (get id :user-mail-filter