From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Fri, 18 Oct 1991 16:03:02 +0000 (+0000)
Subject: Make "m" key in Info mode default to the current menu item, if there is one.
X-Git-Tag: 20090517-FFI~10140
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8e312536a795f64451338db89643fecd8e669399;p=mit-scheme.git

Make "m" key in Info mode default to the current menu item, if there is one.
---

diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm
index 9ed047862..6949d88fb 100644
--- a/v7/src/edwin/info.scm
+++ b/v7/src/edwin/info.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.106 1991/10/04 06:14:14 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.107 1991/10/18 16:02:39 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -393,7 +393,13 @@ except for \\[info-cease-edit] to return to Info."
        (menu-item-name
 	(make-mark
 	 (mark-group menu)
-	 (prompt-for-alist-value "Menu item" (collect-menu-items menu))))))))
+	 (let ((current-item (current-menu-item (current-point))))
+	   (if current-item
+	       (prompt-for-alist-value "Menu item"
+				       (collect-menu-items menu)
+				       (menu-item-name current-item))
+	       (prompt-for-alist-value "Menu item"
+				       (collect-menu-items menu))))))))))
 
 (define (nth-menu-item n)
   (lambda ()
@@ -461,6 +467,17 @@ except for \\[info-cease-edit] to return to Info."
   (and (re-search-forward menu-item-regexp mark (group-end mark) false)
        (re-match-start 1)))
 
+(define (current-menu-item mark)
+  (let ((menu (find-menu))
+	(start (mark-1+ (line-start mark 0) 'LIMIT)))
+    (and menu
+	 (mark> start menu)
+	 (re-search-forward menu-item-regexp
+			    (mark-1+ (line-start mark 0) 'LIMIT)
+			    (line-end mark 0)
+			    false)
+	 (re-match-start 1))))
+
 (define (menu-item-name item)
   (let ((colon (char-search-forward #\: item (line-end item 0) false)))
     (if (not colon)
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index f28d3135b..7f818ea3e 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.148 1991/08/06 15:54:57 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.149 1991/10/18 16:03:02 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -299,14 +299,20 @@
 						  string-table
 						  require-match?)))
 
-(define (prompt-for-alist-value prompt alist)
+(define (prompt-for-alist-value prompt alist #!optional default)
   (fluid-let ((map-name/external->internal identity-procedure)
 	      (map-name/internal->external identity-procedure))
-    (prompt-for-string-table-value prompt
-				   false
-				   'NO-DEFAULT
-				   (alist->string-table alist)
-				   true)))
+    (if (default-object? default)
+	(prompt-for-string-table-value prompt
+				       false
+				       'NO-DEFAULT
+				       (alist->string-table alist)
+				       true)
+	(prompt-for-string-table-value prompt
+				       default
+				       'VISIBLE-DEFAULT
+				       (alist->string-table alist)
+				       true))))
 
 (define (prompt-for-command prompt)
   (fluid-let ((map-name/external->internal editor-name/external->internal)