From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 19 May 2000 21:25:31 +0000 (+0000)
Subject: Define MOVE-RELATIVE-ANY.
X-Git-Tag: 20090517-FFI~3779
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=95c0e6005076d307ab437e4bf2e74fbfa2756f34;p=mit-scheme.git

Define MOVE-RELATIVE-ANY.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 8b66c3cc0..734b394e0 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.76 2000/05/19 21:24:12 cph Exp $
+;;; $Id: imail-top.scm,v 1.77 2000/05/19 21:25:31 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -360,7 +360,7 @@ With prefix argument N, moves forward N messages,
 or backward if N is negative."
   "p"
   (lambda (delta)
-    (move-relative delta #f "message" #f)))
+    (move-relative-any delta #f)))
 
 (define-command imail-previous-message
   "Show previous message whether deleted or not.
@@ -432,6 +432,9 @@ With prefix argument N moves backward N messages with these flags."
 		     'HISTORY 'IMAIL-PROMPT-FOR-FLAGS
 		     'HISTORY-INDEX 0))
 
+(define (move-relative-any delta operation)
+  (move-relative delta #f "message" operation))
+
 (define (move-relative-undeleted delta operation)
   (move-relative delta message-undeleted? "undeleted message" operation))
 
@@ -758,7 +761,7 @@ Deleted messages stay in the file until the \\[imail-expunge] command is given."
 With prefix argument N, undeletes forward N messages,
  or backward if N is negative."
   "p"
-  (lambda (delta) (move-relative delta #f "message" undelete-message)))
+  (lambda (delta) (move-relative-any delta undelete-message)))
 
 (define-command imail-undelete-backward
   "Undelete this message and move to previous one.
@@ -794,8 +797,8 @@ With prefix argument N, removes FLAG to next N messages,
     (list (command-argument-numeric-value (command-argument))
 	  (imail-read-flag "Add flag" #f)))
   (lambda (delta flag)
-    (move-relative delta #f "message"
-		   (lambda (message) (set-message-flag message flag)))))
+    (move-relative-any delta
+		       (lambda (message) (set-message-flag message flag)))))
 
 (define-command imail-kill-flag
   "Remove FLAG from flags associated with current IMAIL message.
@@ -806,8 +809,8 @@ With prefix argument N, removes FLAG from next N messages,
     (list (command-argument-numeric-value (command-argument))
 	  (imail-read-flag "Remove flag" #t)))
   (lambda (delta flag)
-    (move-relative delta #f "message"
-		   (lambda (message) (clear-message-flag message flag)))))
+    (move-relative-any delta
+		       (lambda (message) (clear-message-flag message flag)))))
 
 (define (imail-read-flag prompt require-match?)
   (prompt-for-string-table-name