From: Chris Hanson Date: Thu, 18 May 2000 17:16:28 +0000 (+0000) Subject: Additional round of debugging and expansion. This version seems to X-Git-Tag: 20090517-FFI~3821 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=579a33535d0045397b3e88108a6cc01a62388217;p=mit-scheme.git Additional round of debugging and expansion. This version seems to work pretty well. --- diff --git a/v7/src/imail/imail-summary.scm b/v7/src/imail/imail-summary.scm index dd66814bc..a88700b5e 100644 --- a/v7/src/imail/imail-summary.scm +++ b/v7/src/imail/imail-summary.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-summary.scm,v 1.3 2000/05/18 05:19:00 cph Exp $ +;;; $Id: imail-summary.scm,v 1.4 2000/05/18 17:16:28 cph Exp $ ;;; ;;; Copyright (c) 2000 Massachusetts Institute of Technology ;;; @@ -22,6 +22,13 @@ (declare (usual-integrations)) +(define-variable imail-summary-pop-up-message + "If true, selecting a message in the IMAIL summary buffer pops up the + message buffer in a separate window. +If false, the message buffer is updated but not popped up." + #t + boolean?) + (define-command imail-summary "Display a summary of the selected folder, one line per message." () @@ -89,23 +96,34 @@ The recipients are specified as a comma-separated list of names." "-summary")))) (without-interrupts (lambda () + (add-kill-buffer-hook buffer imail-summary-detach) (add-event-receiver! (folder-modification-event folder) imail-summary-modification-event) + (buffer-put! folder-buffer 'IMAIL-SUMMARY-BUFFER buffer) (associate-buffer-with-imail-buffer folder-buffer buffer) (buffer-put! buffer 'IMAIL-MESSAGE-METHOD - imail-summary-selected-message) - (buffer-put! folder-buffer 'IMAIL-SUMMARY-BUFFER buffer) - (add-kill-buffer-hook buffer imail-summary-detach))) + imail-summary-selected-message))) buffer))))) (buffer-put! buffer 'IMAIL-SUMMARY-DESCRIPTION description) (buffer-put! buffer 'IMAIL-SUMMARY-PREDICATE predicate) (rebuild-imail-summary-buffer buffer) - (select-buffer buffer))) + (if (not (selected-buffer? buffer)) + (let ((windows (buffer-windows buffer))) + (if (pair? windows) + (select-window (car windows)) + (select-buffer buffer)))) + (if (ref-variable imail-summary-pop-up-message buffer) + (imail-summary-pop-up-message-buffer buffer)))) (define (imail-summary-detach buffer) (let ((folder-buffer (buffer-get buffer 'IMAIL-FOLDER-BUFFER #f))) (if folder-buffer - (buffer-remove! folder-buffer 'IMAIL-SUMMARY-BUFFER)))) + (begin + (buffer-remove! folder-buffer 'IMAIL-SUMMARY-BUFFER) + (let ((folder (buffer-get folder-buffer 'IMAIL-FOLDER #f))) + (if folder + (add-event-receiver! (folder-modification-event folder) + imail-summary-modification-event))))))) (define (imail-summary-modification-event folder type parameters) (let ((buffer (imail-folder->summary-buffer folder #f))) @@ -114,23 +132,25 @@ The recipients are specified as a comma-separated list of names." ((FLAGS) (let ((mark (imail-summary-message-mark buffer (car parameters)))) (if mark - (with-read-only-defeated mark - (lambda () - (group-replace-char! - (mark-group mark) - (mark-index mark) - (if (message-deleted? (car parameters)) - #\D - #\space))))))) + (begin + (with-read-only-defeated mark + (lambda () + (group-replace-char! + (mark-group mark) + (mark-index mark) + (if (message-deleted? (car parameters)) + #\D + #\space)))) + (buffer-not-modified! buffer))))) ((SELECT-MESSAGE) (let ((mark (imail-summary-message-mark buffer (car parameters)))) (if mark - (set-buffer-point! buffer mark)))) - ((EXPUNGE) - (maybe-add-command-suffix! rebuild-imail-summary-buffer buffer)) - ((INCREASE-LENGTH SET-LENGTH) - (rebuild-imail-summary-buffer buffer)))))) - + (set-buffer-point! buffer mark))) + (if (ref-variable imail-summary-pop-up-message buffer) + (imail-summary-pop-up-message-buffer buffer))) + ((EXPUNGE INCREASE-LENGTH SET-LENGTH) + (maybe-add-command-suffix! rebuild-imail-summary-buffer buffer)))))) + (define (imail-folder->summary-buffer folder error?) (let ((buffer (imail-folder->buffer folder error?))) (and buffer @@ -138,44 +158,35 @@ The recipients are specified as a comma-separated list of names." (and error? (error:bad-range-argument folder 'IMAIL-FOLDER->SUMMARY-BUFFER)))))) - + (define (imail-summary-message-mark buffer message) (let ((index (message-index message))) (and index (line-start (buffer-start buffer) index)))) +(define (imail-summary-pop-up-message-buffer buffer) + (let ((folder-buffer (buffer-get buffer 'IMAIL-FOLDER-BUFFER #f))) + (if (and folder-buffer (selected-buffer? buffer)) + (pop-up-buffer folder-buffer)))) + (define (rebuild-imail-summary-buffer buffer) - (set-buffer-writeable! buffer) (buffer-widen! buffer) - (region-delete! (buffer-region buffer)) - (fill-imail-summary-buffer! buffer - (selected-folder #f buffer) - (buffer-get buffer - 'IMAIL-SUMMARY-PREDICATE - #f)) - (set-buffer-major-mode! buffer (ref-mode-object imail)) - (buffer-put! buffer 'REVERT-BUFFER-METHOD imail-summary-revert-buffer) - (remove-kill-buffer-hook buffer imail-kill-buffer) + (with-read-only-defeated (buffer-start buffer) + (lambda () + (region-delete! (buffer-region buffer)) + (fill-imail-summary-buffer! buffer + (selected-folder #f buffer) + (buffer-get buffer + 'IMAIL-SUMMARY-PREDICATE + #f)))) + (set-buffer-major-mode! buffer (ref-mode-object imail-summary)) (buffer-not-modified! buffer) (set-buffer-point! buffer (buffer-start buffer)) - (local-set-variable! truncate-lines #t buffer) - (local-set-variable! mode-line-process - (list ": " - (buffer-get buffer - 'IMAIL-SUMMARY-DESCRIPTION - "All")) - buffer) (let ((message (selected-message #f (buffer-get buffer 'IMAIL-FOLDER-BUFFER)))) (if message (imail-summary-select-message buffer message)))) -(define (imail-summary-revert-buffer buffer dont-use-auto-save? dont-confirm?) - dont-use-auto-save? dont-confirm? - (if (or dont-confirm? - (prompt-for-yes-or-no? "Revert summary buffer")) - (rebuild-imail-summary-buffer buffer))) - (define (imail-summary-selected-message buffer) (let ((folder (selected-folder #f buffer)) (index @@ -210,15 +221,16 @@ The recipients are specified as a comma-separated list of names." 4 #\space mark) (insert-string " " mark) (insert-string-pad-right (message-summary-date-string message) - 11 #\space mark) + 6 #\space mark) + (insert-string " " mark) + (let ((target-column (+ (mark-column mark) 40))) + (insert-string (message-summary-subject-string message) mark) + (if (> (mark-column mark) target-column) + (delete-string (move-to-column mark target-column) mark)) + (if (< (mark-column mark) target-column) + (insert-chars #\space (- target-column (mark-column mark)) mark))) (insert-string " " mark) - (insert-string-pad-right (let ((s (message-summary-from-string message))) - (if (> (string-length s) 24) - (string-head s 24) - s)) - 24 #\space mark) - (insert-string " " mark) - (insert-string (message-summary-subject-string message) mark) + (insert-string (message-summary-from-string message) mark) (insert-newline mark)) (define (message-summary-date-string message) @@ -228,9 +240,7 @@ The recipients are specified as a comma-separated list of names." (string-append (string-pad-left (number->string (decoded-time/day dt)) 2) " " - (month/short-string (decoded-time/month dt)) - " " - (number->string (decoded-time/year dt)))) + (month/short-string (decoded-time/month dt)))) ""))) (define (message-summary-from-string message) @@ -259,4 +269,75 @@ The recipients are specified as a comma-separated list of names." (let ((i (string-find-next-char s #\newline))) (if i (string-head s i) - s)))) \ No newline at end of file + s)))) + +(define-major-mode imail-summary imail "IMAIL Summary" + "Major mode in effect in IMAIL summary buffer. +This mode is like IMAIL mode, with the addition of some specialized commands. + +\\{imail-summary}" + (lambda (buffer) + (buffer-put! buffer 'REVERT-BUFFER-METHOD imail-summary-revert-buffer) + (remove-kill-buffer-hook buffer imail-kill-buffer) + (local-set-variable! truncate-lines #t buffer) + (local-set-variable! mode-line-process + (list ": " + (buffer-get buffer + 'IMAIL-SUMMARY-DESCRIPTION + "All")) + buffer))) + +(define (imail-summary-revert-buffer buffer dont-use-auto-save? dont-confirm?) + dont-use-auto-save? dont-confirm? + (if (or dont-confirm? + (prompt-for-yes-or-no? "Revert summary buffer")) + (rebuild-imail-summary-buffer buffer))) + +(define-key 'imail-summary #\space 'imail-summary-select-message) +(define-key 'imail-summary #\rubout 'imail-undelete-previous-message) +(define-key 'imail-summary #\c-n 'imail-summary-next-message) +(define-key 'imail-summary #\c-p 'imail-summary-previous-message) +(define-key 'imail-summary #\. 'undefined) +(define-key 'imail-summary #\q 'imail-summary-quit) +(define-key 'imail-summary #\m-< 'imail-select-message) +(define-key 'imail-summary #\m-> 'imail-last-message) + +(define-command imail-summary-select-message + "Select the message that point is on and show it in another window." + () + (lambda () + (select-message (selected-folder) (selected-message) #t) + (imail-summary-pop-up-message-buffer (selected-buffer)))) + +(define-command imail-summary-next-message + "Show following message whether deleted or not. +With prefix argument N, moves forward N messages, +or backward if N is negative." + "p" + (lambda (delta) + (if (selected-message #f) + ((ref-command imail-next-message) delta) + (begin + ((ref-command next-line) delta) + (let ((message (selected-message #f))) + (if message + (select-message (selected-folder) message))))))) + +(define-command imail-summary-previous-message + "Show previous message whether deleted or not. +With prefix argument N, moves backward N messages, +or forward if N is negative." + "p" + (lambda (delta) + ((ref-command imail-summary-next-message) (- delta)))) + +(define-command imail-summary-quit + "Quit out of IMAIL." + () + (lambda () + (let ((folder-buffer + (buffer-get (selected-buffer) 'IMAIL-FOLDER-BUFFER #f))) + (if folder-buffer + (for-each window-delete! (buffer-windows folder-buffer)))) + ((ref-command imail-quit)) + ((ref-command bury-buffer)))) \ No newline at end of file