From 113d7b955eccb30af3979340468c7a15907c3bfd Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 3 Jun 2001 06:03:47 +0000 Subject: [PATCH] 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. --- v7/src/imail/imail-browser.scm | 68 +++++++++++++++++++++------------- v7/src/imail/imail-top.scm | 3 +- v7/src/imail/imail.pkg | 8 ++-- v7/src/imail/todo.txt | 4 +- 4 files changed, 50 insertions(+), 33 deletions(-) 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 -- 2.25.1