Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hui-menu.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children 8619ce7e4c50
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
4 ;; SUMMARY: InfoDock/Emacs menubar menu of Hyperbole commands. 4 ;; SUMMARY: InfoDock/Emacs menubar menu of Hyperbole commands.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: hypermedia, mouse 6 ;; KEYWORDS: hypermedia, mouse
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola, Inc., PPG 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 28-Oct-94 at 10:59:44 11 ;; ORIG-DATE: 28-Oct-94 at 10:59:44
12 ;; LAST-MOD: 26-Oct-95 at 23:10:38 by Bob Weiner 12 ;; LAST-MOD: 19-Feb-97 at 10:50:57 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1994-1995 Free Software Foundation, Inc. 14 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
15 ;; 15 ;;
16 ;; This file is part of Hyperbole. 16 ;; This file is part of Hyperbole.
17 ;; 17 ;;
18 ;; DESCRIPTION: 18 ;; DESCRIPTION:
19 ;; DESCRIP-END. 19 ;; DESCRIP-END.
45 45
46 ;;; ************************************************************************ 46 ;;; ************************************************************************
47 ;;; Public variables 47 ;;; Public variables
48 ;;; ************************************************************************ 48 ;;; ************************************************************************
49 49
50 ;; Ensure that this variable is defined to avert any error within
51 ;; the Customization menu.
52 (defvar highlight-headers-follow-url-netscape-new-window nil
53 "*Whether to make Netscape create a new window when a URL is sent to it.")
54
55 (defconst hui-menu-options
56 (append '("Display-Referents-in"
57 "----"
58 "----")
59 (mapcar (function (lambda (sym)
60 (vector
61 (capitalize (symbol-name sym))
62 (` (setq hpath:display-where '(, sym)))
63 :style 'radio
64 :selected (` (eq hpath:display-where
65 '(, sym))))))
66 (mapcar 'car hpath:display-where-alist))
67 '("----"
68 "Display-URLs-in"
69 "----"
70 "----"
71 ["Here"
72 (setq action-key-url-function 'w3-fetch
73 highlight-headers-follow-url-function
74 action-key-url-function)
75 :style radio
76 :selected (eq action-key-url-function 'w3-fetch)]
77 ["Current-Netscape-Window"
78 (setq action-key-url-function
79 'highlight-headers-follow-url-netscape
80 highlight-headers-follow-url-function
81 action-key-url-function
82 highlight-headers-follow-url-netscape-new-window
83 nil)
84 :style radio
85 :selected
86 (and (eq action-key-url-function
87 'highlight-headers-follow-url-netscape)
88 (not highlight-headers-follow-url-netscape-new-window))]
89 ["New-Netscape-Window"
90 (setq action-key-url-function
91 'highlight-headers-follow-url-netscape
92 highlight-headers-follow-url-function
93 action-key-url-function
94 highlight-headers-follow-url-netscape-new-window
95 t)
96 :style radio
97 :selected
98 (and (eq action-key-url-function
99 'highlight-headers-follow-url-netscape)
100 highlight-headers-follow-url-netscape-new-window)]
101 ["Mosaic"
102 (setq action-key-url-function
103 'highlight-headers-follow-url-mosaic
104 highlight-headers-follow-url-function
105 action-key-url-function)
106 :style radio
107 :selected (eq action-key-url-function
108 'highlight-headers-follow-url-mosaic)]
109 )
110 '("----"
111 "Smart-Key-Press-at-Eol"
112 "----"
113 "----"
114 ["Scrolls-a-Windowful"
115 (setq smart-scroll-proportional nil)
116 :style radio :selected (null smart-scroll-proportional)]
117 ["Scrolls-Proportionally"
118 (setq smart-scroll-proportional t)
119 :style radio :selected smart-scroll-proportional]
120 ))
121 "Untitled menu of Hyperbole options.")
122
50 ;;; Don't change this name; doing so will break the way InfoDock 123 ;;; Don't change this name; doing so will break the way InfoDock
51 ;;; initializes the Hyperbole menu. 124 ;;; initializes the Hyperbole menu.
52 (defconst infodock-hyperbole-menu 125 (defconst infodock-hyperbole-menu
53 (delq nil 126 (delq nil
54 (list 127 (list
55 "Hyperbole" 128 "Hyperbole"
56 '["Browse-Manual" (id-info "(hyperbole.info)Top") t] 129 '["About" (hypb:display-file-with-logo
130 (expand-file-name "ABOUT" hyperb:dir)) t]
131 '["Manual" (id-info "(hyperbole.info)Top") t]
57 "----" 132 "----"
58 '["Activate-Button-at-Point" hui:hbut-act t] 133 '["Activate-Button-at-Point" hui:hbut-current-act t]
59 '["Back-to-Prior-Location" (hhist:remove current-prefix-arg) t] 134 '["Back-to-Prior-Location" (hhist:remove current-prefix-arg) t]
60 '("Button-File" 135 '("Button-File"
61 ["Manual" (id-info "(hyperbole.info)Button Files") t] 136 ["Manual" (id-info "(hyperbole.info)Button Files") t]
62 "----" 137 "----"
63 ["Edit-Per-Directory-File" (find-file hbmap:filename) t] 138 ["Edit-Per-Directory-File" (find-file hbmap:filename) t]
64 ["Edit-Personal-File" (find-file 139 ["Edit-Personal-File" (find-file
65 (expand-file-name 140 (expand-file-name
66 hbmap:filename hbmap:dir-user)) t] 141 hbmap:filename hbmap:dir-user)) t]
67 ) 142 )
143 (cons "Customization" hui-menu-options)
68 '("Documentation" 144 '("Documentation"
69 ["Manual" (id-info "(hyperbole.info)Top") t] 145 ["Manual" (id-info "(hyperbole.info)Top") t]
70 "----" 146 "----"
71 ["Copyright" (id-info "(hyperbole.info)Top") t] 147 ["Copyright" (id-info "(hyperbole.info)Top") t]
72 ["Demonstration" (find-file-read-only 148 ["Demonstration" (find-file-read-only
82 (setq buffer-read-only nil) 158 (setq buffer-read-only nil)
83 (toggle-read-only)) t] 159 (toggle-read-only)) t]
84 ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t] 160 ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t]
85 ) 161 )
86 '("Explicit-Button" 162 '("Explicit-Button"
87 ["Manual" (id-info "(hyperbole.info)Explicit Buttons") t] 163 :filter hui-menu-explicit-buttons
88 "----" 164 ["Activate" hui:hbut-act t]
89 ["Activate-at-Point" hui:hbut-act t]
90 ["Create" hui:ebut-create t] 165 ["Create" hui:ebut-create t]
91 ["Delete" hui:ebut-delete t] 166 ["Delete" hui:ebut-delete t]
92 ["Edit" hui:ebut-modify t] 167 ["Edit" hui:ebut-modify t]
93 ("Help" 168 ("Help"
94 ["Manual" (id-info "(hyperbole.info)Location") t] 169 ["Manual" (id-info "(hyperbole.info)Location") t]
100 ["Modify" hui:ebut-modify t] 175 ["Modify" hui:ebut-modify t]
101 ["Rename" hui:ebut-rename t] 176 ["Rename" hui:ebut-rename t]
102 ["Search" hui:ebut-search t] 177 ["Search" hui:ebut-search t]
103 ) 178 )
104 '("Global-Button" 179 '("Global-Button"
105 ["Manual" (id-info "(hyperbole.info)Global Buttons") t] 180 :filter hui-menu-global-buttons
106 "----"
107 ["Activate" gbut:act t]
108 ["Create" hui:gbut-create t] 181 ["Create" hui:gbut-create t]
109 ["Edit" hui:gbut-modify t] 182 ["Edit" hui:gbut-modify t]
110 ["Help" gbut:help t] 183 ["Help" gbut:help t]
111 ["Modify" hui:gbut-modify t] 184 ["Modify" hui:gbut-modify t]
112 ) 185 )
113 '("Implicit-Button" 186 '("Implicit-Button"
114 ["Manual" (id-info "(hyperbole.info)Implicit Buttons") t] 187 ["Manual" (id-info "(hyperbole.info)Implicit Buttons") t]
115 "----" 188 "----"
116 ["Activate-at-Point" hui:hbut-act t] 189 ["Activate-at-Point" hui:hbut-current-act t]
117 ["Delete-Type" (hui:htype-delete 'ibtypes) t] 190 ["Delete-Type" (hui:htype-delete 'ibtypes) t]
118 ["Help" hui:hbut-help t] 191 ["Help" hui:hbut-help t]
119 ["Types" (hui:htype-help 'ibtypes 'no-sort) t] 192 ["Types" (hui:htype-help 'ibtypes 'no-sort) t]
120 ) 193 )
121 '("Mail-Lists" 194 '("Mail-Lists"
122 ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting") 195 ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting")
123 t] 196 t]
124 "----" 197 "----"
125 ["Change-Hyperbole-Address" 198 ["Change-Hyperbole-Address"
126 (hmail:compose "hyperbole-request@hub.ucsb.edu" 199 (hmail:compose "hyperbole-request@infodock.com"
127 '(hact 'hyp-request)) t] 200 '(hact 'hyp-request)) t]
128 ["Change-Hyperbole-Announce-Address" 201 ["Change-Hyperbole-Announce-Address"
129 (hmail:compose "hyperbole-request@hub.ucsb.edu" 202 (hmail:compose "hyperbole-request@infodock.com"
130 '(hact 'hyp-request)) t] 203 '(hact 'hyp-request)) t]
131 ["Mail-to-Hyperbole-List" 204 ["Mail-to-Hyperbole-List"
132 (hmail:compose "hyperbole@hub.ucsb.edu" '(hact 'hyp-config)) t] 205 (hmail:compose "hyperbole@infodock.com" '(hact 'hyp-config)) t]
133 ) 206 )
134 (if hyperb:kotl-p 207 (if hyperb:kotl-p
135 '("Outline" 208 '("Outline"
136 ["Manual" (id-info "(hyperbole.info)Outliner") t] 209 ["Manual" (id-info "(hyperbole.info)Outliner") t]
137 ["Example" (find-file-read-only 210 ["Example" (find-file-read-only
189 (setq smail:comment ""))) 262 (setq smail:comment "")))
190 t] 263 t]
191 ))) 264 )))
192 265
193 ;;; ************************************************************************ 266 ;;; ************************************************************************
267 ;;; Private functions
268 ;;; ************************************************************************
269
270 (defvar hui-menu-max-list-length 24
271 "Positive integer that caps the length of a dynamic menu list.")
272
273 (defvar hui-menu-order-explicit-buttons t
274 "When non-nil (default), explicit button menu list is lexicographically ordered.
275 Otherwise, explicit buttons are listed in their order of appearance within
276 the current buffer.")
277
278 ;; List explicit buttons in the current buffer for menu activation.
279 (defun hui-menu-explicit-buttons (rest-of-menu)
280 (delq nil
281 (append
282 '(["Manual" (id-info "(hyperbole.info)Explicit Buttons") t]
283 "----")
284 (let ((labels (ebut:list))
285 (cutoff))
286 (if labels
287 (progn
288 ;; Cutoff list if too long.
289 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
290 (setcdr cutoff nil))
291 (delq nil
292 (append
293 '("----"
294 ["Alphabetize-List"
295 (setq hui-menu-order-explicit-buttons
296 (not hui-menu-order-explicit-buttons))
297 :style toggle :selected hui-menu-order-explicit-buttons]
298 "Activate:")
299 (mapcar (function (lambda (label)
300 (vector label `(ebut:act ,label) t)))
301 (if hui-menu-order-explicit-buttons
302 (sort labels 'string-lessp)
303 labels))
304 (if cutoff '(". . ."))
305 '("----" "----"))))))
306 rest-of-menu)))
307
308 ;; List existing global buttons for menu activation.
309 (defun hui-menu-global-buttons (rest-of-menu)
310 (delq nil
311 (append
312 '(["Manual" (id-info "(hyperbole.info)Global Buttons") t]
313 "----")
314 (let ((labels (gbut:label-list))
315 (cutoff))
316 (if labels
317 (progn
318 ;; Cutoff list if too long.
319 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
320 (setcdr cutoff nil))
321 (delq nil
322 (append
323 '("----" "Activate:")
324 (mapcar (function (lambda (label)
325 (vector label `(gbut:act ,label) t)))
326 (sort labels 'string-lessp))
327 (if cutoff '(". . ."))
328 '("----" "----"))))))
329 rest-of-menu)))
330
331 ;;; ************************************************************************
194 ;;; Private variables 332 ;;; Private variables
195 ;;; ************************************************************************ 333 ;;; ************************************************************************
196 334
197 (provide 'hui-menu) 335 (provide 'hui-menu)