A number of usability improvements.
authorChris Hanson <org/chris-hanson/cph>
Fri, 19 May 2000 05:03:44 +0000 (05:03 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 19 May 2000 05:03:44 +0000 (05:03 +0000)
v7/src/imail/imail-summary.scm
v7/src/imail/imail-top.scm

index a4829e477482f28f8620af229d87ba81cc739412..7a391f80d3bad868e58994cd015b28a1e1cf63a8 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-summary.scm,v 1.7 2000/05/18 21:27:59 cph Exp $
+;;; $Id: imail-summary.scm,v 1.8 2000/05/19 05:03:42 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -361,6 +361,7 @@ with some additions to make navigation more natural.
 (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 #\u         'imail-summary-undelete-forward)
 (define-key 'imail-summary #\m-<       'imail-select-message)
 (define-key 'imail-summary #\m->       'imail-last-message)
 \f
@@ -393,6 +394,14 @@ or forward if N is negative."
   (lambda (delta)
     ((ref-command imail-summary-next-message) (- delta))))
 
+(define-command imail-summary-undelete-forward
+  "Undelete following message whether deleted or not.
+With prefix argument N, undeletes forward N messages,
+or backward if N is negative."
+  "p"
+  (lambda (delta)
+    (move-relative delta #f "message" undelete-message)))
+
 (define-command imail-summary-quit
   "Quit out of IMAIL."
   ()
index 247a2ad8e56824e2abb5eadc620d339f6d05e336..ae365a5628b75aef5b0d1d278b737d3c29b5d8e5 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.66 2000/05/19 04:15:41 cph Exp $
+;;; $Id: imail-top.scm,v 1.67 2000/05/19 05:03:44 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -104,7 +104,10 @@ May be called with an IMAIL folder URL as argument;
  but does not copy any new mail into the folder."
   (lambda ()
     (list (and (command-argument)
-              (prompt-for-string "Run IMAIL on folder" #f))))
+              (prompt-for-string "Run IMAIL on folder" #f
+                                 'DEFAULT-TYPE 'VISIBLE-DEFAULT
+                                 'HISTORY 'IMAIL
+                                 'HISTORY-INDEX 0))))
   (lambda (url-string)
     (let ((folder
           (open-folder
@@ -350,7 +353,7 @@ With prefix argument N, moves forward N messages,
 or backward if N is negative."
   "p"
   (lambda (delta)
-    (move-relative delta (lambda (message) message #t) "message")))
+    (move-relative delta #f "message" #f)))
 
 (define-command imail-previous-message
   "Show previous message whether deleted or not.
@@ -366,7 +369,7 @@ With prefix argument N, moves forward N non-deleted messages,
 or backward if N is negative."
   "p"
   (lambda (delta)
-    (move-relative delta message-undeleted? "undeleted message")))
+    (move-relative delta message-undeleted? "undeleted message" #f)))
 
 (define-command imail-previous-undeleted-message
   "Show previous non-deleted message.
@@ -400,7 +403,8 @@ With prefix argument N moves forward N messages with these flags."
                                    (if (fix:= 1 (length flags)) "" "s")
                                    " "
                                    (decorated-string-append "" ", " ""
-                                                            flags))))))
+                                                            flags))
+                    #f))))
 
 (define-command imail-previous-flagged-message
   "Show previous message with one of the flags FLAGS.
@@ -420,26 +424,28 @@ With prefix argument N moves backward N messages with these flags."
                           'HISTORY 'IMAIL-NEXT-FLAGGED-MESSAGE
                           'HISTORY-INDEX 0)))
 
-(define (move-relative delta predicate noun)
+(define (move-relative delta predicate noun operation)
   (if (not (= 0 delta))
       (call-with-values
          (lambda ()
            (if (< delta 0)
                (values (- delta) previous-message "previous")
                (values delta next-message "next")))
-       (lambda (delta step direction)
-         (let loop
-             ((delta delta)
-              (msg (selected-message))
-              (winner #f))
-           (let ((next (step msg predicate)))
-             (cond ((not next)
-                    (if winner (select-message (selected-folder) winner))
-                    (message "No " direction " " noun))
-                   ((= delta 1)
-                    (select-message (selected-folder) next))
-                   (else
-                    (loop (- delta 1) next next)))))))))
+       (lambda (n step direction)
+         (let ((folder (selected-folder))
+               (msg (selected-message)))
+           (if (and operation (> delta 0))
+               (operation msg))
+           (let loop ((n n) (msg msg) (winner #f))
+             (let ((next (step msg predicate)))
+               (cond ((not next)
+                      (if winner (select-message folder winner))
+                      (message "No " direction " " noun))
+                     ((= n 1)
+                      (select-message folder next))
+                     (else
+                      (if operation (operation next))
+                      (loop (- n 1) next next))))))))))
 \f
 (define (select-message folder selector #!optional force? full-headers?)
   (let ((buffer (imail-folder->buffer folder #t))
@@ -755,13 +761,28 @@ Completion is performed over known flags when reading."
 
 (define-command imail-output
   "Append this message to a specified folder."
-  "sOutput to folder"
-  (lambda (url-string)
-    (let ((message (selected-message)))
-      (append-message message (imail-parse-partial-url url-string))
-      (message-filed message)
-      (if (ref-variable imail-delete-after-output)
-         ((ref-command imail-delete-forward) #f)))))
+  (lambda ()
+    (list (prompt-for-string "Output to folder" #f
+                            'DEFAULT-TYPE 'INSERTED-DEFAULT
+                            'HISTORY 'IMAIL-OUTPUT
+                            'HISTORY-INDEX 0)
+         (command-argument)))
+  (lambda (url-string argument)
+    (let ((do-one
+          (lambda ()
+            (let ((message (selected-message)))
+              (append-message message (imail-parse-partial-url url-string))
+              (message-filed message)
+              (cond ((ref-variable imail-delete-after-output)
+                     ((ref-command imail-delete-forward) 1))
+                    (argument
+                     ((ref-command imail-next-undeleted-message) 1)))))))
+      (if argument
+         (let ((n (command-argument-value argument)))
+           (do ((i 0 (+ i 1)))
+               ((>= i n))
+             (do-one)))
+         (do-one)))))
 
 (define-command imail-create-folder
   "Create a new folder with the specified name.