From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 3 Jun 2001 06:03:47 +0000 (+0000)
Subject: Change commands used to enter browser.  Now the primary command is M-x
X-Git-Tag: 20090517-FFI~2732
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=113d7b955eccb30af3979340468c7a15907c3bfd;p=mit-scheme.git

Change commands used to enter browser.  Now the primary command is M-x
imail-browser-view-container (bound to ^ in all IMAIL buffers), which
browses the container of the resource being viewed in the current
buffer.  This command will prompt for a container URL if given a
prefix argument.
---

diff --git a/v7/src/imail/imail-browser.scm b/v7/src/imail/imail-browser.scm
index 8e3b9f96e..0db2ca36d 100644
--- a/v7/src/imail/imail-browser.scm
+++ b/v7/src/imail/imail-browser.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-browser.scm,v 1.5 2001/06/03 01:37:57 cph Exp $
+;;; $Id: imail-browser.scm,v 1.6 2001/06/03 06:02:48 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -35,26 +35,23 @@ To do:
 
 (declare (usual-integrations))
 
-(define-command imail-browse-container
-  "Visit a buffer showing the contents of an IMAIL container."
-  (lambda ()
-    (list (prompt-for-container "Browse container" #f
-				'HISTORY 'IMAIL-BROWSE-CONTAINER
-				'HISTORY-INDEX 0
-				'REQUIRE-MATCH? #t)))
-  (lambda (url-string)
-    (let* ((url (imail-parse-partial-url url-string))
-	   (container (open-resource url))
-	   (buffer
-	    (new-buffer
-	     (string-append (url-presentation-name url)
-			    "-browser"))))
-      (set-buffer-imail-container! buffer container)
-      (add-kill-buffer-hook buffer close-browser-container)
-      (set-buffer-imail-url-selector! buffer browser-selected-url)
-      (receive-modification-events container notice-container-events)
-      (rebuild-imail-browser-buffer buffer)
-      (select-buffer buffer))))
+(define (imail-browse-container url)
+  (select-buffer (get-imail-browser-buffer url)))
+
+(define (get-imail-browser-buffer url)
+  (or (list-search-positive (buffer-list)
+	(lambda (buffer)
+	  (eq? (selected-container-url #f buffer) url)))
+      (let ((container (open-resource url))
+	    (buffer
+	     (new-buffer
+	      (string-append (url-presentation-name url) "-browser"))))
+	(set-buffer-imail-container! buffer container)
+	(add-kill-buffer-hook buffer close-browser-container)
+	(set-buffer-imail-url-selector! buffer browser-selected-url)
+	(receive-modification-events container notice-container-events)
+	(rebuild-imail-browser-buffer buffer)
+	buffer)))
 
 (define (close-browser-container buffer)
   (let ((container (selected-container #f buffer)))
@@ -298,9 +295,9 @@ Each line summarizes a single mail folder.
 (define-key 'imail-browser #\R 'imail-browser-do-rename)
 
 (define-key 'imail-browser #\? 'describe-mode)
-(define-key 'imail-browser #\c 'imail-browser-view-container)
+(define-key 'imail-browser #\c 'imail-browser-view-selected-container)
 (define-key 'imail-browser #\d 'imail-browser-flag-folder-deletion)
-(define-key 'imail-browser #\f 'imail-browser-view-folder)
+(define-key 'imail-browser #\f 'imail-browser-view-selected-folder)
 (define-key 'imail-browser #\g 'imail-browser-revert)
 (define-key 'imail-browser #\h 'describe-mode)
 (define-key 'imail-browser #\m 'imail-browser-mark-folder)
@@ -308,11 +305,12 @@ Each line summarizes a single mail folder.
 (define-key 'imail-browser #\t 'imail-browser-toggle-container)
 (define-key 'imail-browser #\u 'imail-browser-unmark)
 (define-key 'imail-browser #\x 'imail-browser-do-flagged-delete)
+(define-key 'imail-browser #\^ 'imail-browser-view-container)
 
 (define-key 'imail-browser #\rubout 'imail-browser-backup-unmark)
 (define-key 'imail-browser #\M-rubout 'imail-browser-unmark-all-folders)
 
-(define-command imail-browser-view-folder
+(define-command imail-browser-view-selected-folder
   ""
   ()
   (lambda ()
@@ -321,16 +319,34 @@ Each line summarizes a single mail folder.
 	  ((ref-command imail) (url->string url))
 	  (editor-error "Not a selectable folder.")))))
 
-(define-command imail-browser-view-container
+(define-command imail-browser-view-selected-container
   ""
   ()
   (lambda ()
     (let ((info (browser-line-info)))
       (let ((container (browser-line-info-container-url info)))
 	(if container
-	    ((ref-command imail-browse-container) (url->string container))
+	    (imail-browse-container container)
 	    (editor-error "Not a selectable container."))))))
 
+(define-command imail-browser-view-container
+  ""
+  (lambda ()
+    (list
+     (and (command-argument)
+	  (prompt-for-container "Browse IMAIL container" #f
+				'HISTORY 'IMAIL-BROWSER-VIEW-CONTAINER
+				'REQUIRE-MATCH? #t))))
+  (lambda (url-string)
+    (imail-browse-container
+     (or (and url-string (imail-parse-partial-url url-string))
+	 (let ((resource
+		(or (selected-container #f)
+		    (selected-folder #f))))
+	   (if resource
+	       (container-url-for-prompt resource)
+	       (editor-error "This is not an IMAIL buffer.")))))))
+
 (define-command imail-browser-mouse-toggle-container
   ""
   ()
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 58b10755c..20ace1ebb 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.262 2001/06/03 01:23:45 cph Exp $
+;;; $Id: imail-top.scm,v 1.263 2001/06/03 06:02:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -480,6 +480,7 @@ Instead, these commands are available:
 (define-key 'imail #\space	'scroll-up)
 (define-key 'imail #\rubout	'scroll-down)
 (define-key 'imail #\?		'describe-mode)
+(define-key 'imail #\^		'imail-browser-view-container)
 (define-key 'imail '(#\c-c #\c-n)	'imail-next-same-subject)
 (define-key 'imail '(#\c-c #\c-p)	'imail-previous-same-subject)
 (define-key 'imail '(#\c-c #\c-t #\c-e)	'imail-toggle-mime-entity)
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index fdad02374..ff9131d30 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.85 2001/06/02 05:55:51 cph Exp $
+;;; $Id: imail.pkg,v 1.86 2001/06/03 06:02:45 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -358,8 +358,9 @@
 (define-package (edwin imail front-end folder-browser)
   (files "imail-browser")
   (parent (edwin imail front-end))
+  (export (edwin imail front-end)
+	  imail-browse-container)
   (export (edwin)
-	  edwin-command$imail-browse-container
 	  edwin-command$imail-browser-backup-unmark
 	  edwin-command$imail-browser-do-copy
 	  edwin-command$imail-browser-do-delete
@@ -374,6 +375,7 @@
 	  edwin-command$imail-browser-unmark
 	  edwin-command$imail-browser-unmark-all-folders
 	  edwin-command$imail-browser-view-container
-	  edwin-command$imail-browser-view-folder
+	  edwin-command$imail-browser-view-selected-container
+	  edwin-command$imail-browser-view-selected-folder
 	  edwin-mode$imail-browser
 	  edwin-variable$imail-browser-mode-hook))
\ No newline at end of file
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index c7bcf4d44..29bb55660 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,11 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.127 2001/06/03 01:41:49 cph Exp $
+$Id: todo.txt,v 1.128 2001/06/03 06:03:47 cph Exp $
 
 Bug fixes
 ---------
 
-* Add key binding for M-x imail-browse-container to imail-mode.
-
 * Various changes to Dired that might affect our browsers: RET selects
   the current object (preferred to f).  D command does immediate
   delete.  t command means toggle sense of marked lines (*t also does