Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/hui-menu.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents c53a95d3c46d
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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: InfoDock Associates 9 ;; ORG: Motorola, Inc., PPG
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: 14-Mar-97 at 01:35:02 by Bob Weiner 12 ;; LAST-MOD: 26-Oct-95 at 23:10:38 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. 14 ;; Copyright (C) 1994-1995 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 '("----"
122 ["Toggle-Rolodex-Dates" rolo-toggle-datestamps
123 :style toggle :selected (and (boundp 'wrolo-add-hook)
124 (listp wrolo-add-hook)
125 (memq 'rolo-set-date wrolo-add-hook))]
126 ))
127 "Untitled menu of Hyperbole options.")
128
129 ;;; Don't change this name; doing so will break the way InfoDock 50 ;;; Don't change this name; doing so will break the way InfoDock
130 ;;; initializes the Hyperbole menu. 51 ;;; initializes the Hyperbole menu.
131 (defconst infodock-hyperbole-menu 52 (defconst infodock-hyperbole-menu
132 (delq nil 53 (delq nil
133 (list 54 (list
134 "Hyperbole" 55 "Hyperbole"
135 :config 'Hyperbole 56 '["Browse-Manual" (id-info "(hyperbole.info)Top") t]
136 '["About" (hypb:display-file-with-logo
137 (expand-file-name "ABOUT" hyperb:dir)) t]
138 '["Manual" (id-info "(hyperbole.info)Top") t]
139 "----" 57 "----"
140 '["Activate-Button-at-Point" hui:hbut-current-act t] 58 '["Activate-Button-at-Point" hui:hbut-act t]
141 '["Back-to-Prior-Location" (hhist:remove current-prefix-arg) t] 59 '["Back-to-Prior-Location" (hhist:remove current-prefix-arg) t]
142 '("Button-File" 60 '("Button-File"
143 ["Manual" (id-info "(hyperbole.info)Button Files") t] 61 ["Manual" (id-info "(hyperbole.info)Button Files") t]
144 "----" 62 "----"
145 ["Edit-Per-Directory-File" (find-file hbmap:filename) t] 63 ["Edit-Per-Directory-File" (find-file hbmap:filename) t]
146 ["Edit-Personal-File" (find-file 64 ["Edit-Personal-File" (find-file
147 (expand-file-name 65 (expand-file-name
148 hbmap:filename hbmap:dir-user)) t] 66 hbmap:filename hbmap:dir-user)) t]
149 ) 67 )
150 (cons "Customization" hui-menu-options)
151 '("Documentation" 68 '("Documentation"
152 ["Manual" (id-info "(hyperbole.info)Top") t] 69 ["Manual" (id-info "(hyperbole.info)Top") t]
153 "----" 70 "----"
154 ["Copyright" (id-info "(hyperbole.info)Top") t] 71 ["Copyright" (id-info "(hyperbole.info)Top") t]
155 ["Demonstration" (find-file-read-only 72 ["Demonstration" (find-file-read-only
165 (setq buffer-read-only nil) 82 (setq buffer-read-only nil)
166 (toggle-read-only)) t] 83 (toggle-read-only)) t]
167 ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t] 84 ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t]
168 ) 85 )
169 '("Explicit-Button" 86 '("Explicit-Button"
170 :filter hui-menu-explicit-buttons 87 ["Manual" (id-info "(hyperbole.info)Explicit Buttons") t]
171 ["Activate" hui:hbut-act t] 88 "----"
89 ["Activate-at-Point" hui:hbut-act t]
172 ["Create" hui:ebut-create t] 90 ["Create" hui:ebut-create t]
173 ["Delete" hui:ebut-delete t] 91 ["Delete" hui:ebut-delete t]
174 ["Edit" hui:ebut-modify t] 92 ["Edit" hui:ebut-modify t]
175 ("Help" 93 ("Help"
176 ["Manual" (id-info "(hyperbole.info)Location") t] 94 ["Manual" (id-info "(hyperbole.info)Location") t]
182 ["Modify" hui:ebut-modify t] 100 ["Modify" hui:ebut-modify t]
183 ["Rename" hui:ebut-rename t] 101 ["Rename" hui:ebut-rename t]
184 ["Search" hui:ebut-search t] 102 ["Search" hui:ebut-search t]
185 ) 103 )
186 '("Global-Button" 104 '("Global-Button"
187 :filter hui-menu-global-buttons 105 ["Manual" (id-info "(hyperbole.info)Global Buttons") t]
106 "----"
107 ["Activate" gbut:act t]
188 ["Create" hui:gbut-create t] 108 ["Create" hui:gbut-create t]
189 ["Edit" hui:gbut-modify t] 109 ["Edit" hui:gbut-modify t]
190 ["Help" gbut:help t] 110 ["Help" gbut:help t]
191 ["Modify" hui:gbut-modify t] 111 ["Modify" hui:gbut-modify t]
192 ) 112 )
193 '("Implicit-Button" 113 '("Implicit-Button"
194 ["Manual" (id-info "(hyperbole.info)Implicit Buttons") t] 114 ["Manual" (id-info "(hyperbole.info)Implicit Buttons") t]
195 "----" 115 "----"
196 ["Activate-at-Point" hui:hbut-current-act t] 116 ["Activate-at-Point" hui:hbut-act t]
197 ["Delete-Type" (hui:htype-delete 'ibtypes) t] 117 ["Delete-Type" (hui:htype-delete 'ibtypes) t]
198 ["Help" hui:hbut-help t] 118 ["Help" hui:hbut-help t]
199 ["Types" (hui:htype-help 'ibtypes 'no-sort) t] 119 ["Types" (hui:htype-help 'ibtypes 'no-sort) t]
200 ) 120 )
201 '("Mail-Lists" 121 '("Mail-Lists"
202 ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting") 122 ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting")
203 t] 123 t]
204 "----" 124 "----"
205 ["Change-Hyperbole-Address" 125 ["Change-Hyperbole-Address"
206 (hmail:compose "hyperbole-request@infodock.com" 126 (hmail:compose "hyperbole-request@hub.ucsb.edu"
207 '(hact 'hyp-request)) t] 127 '(hact 'hyp-request)) t]
208 ["Change-Hyperbole-Announce-Address" 128 ["Change-Hyperbole-Announce-Address"
209 (hmail:compose "hyperbole-request@infodock.com" 129 (hmail:compose "hyperbole-request@hub.ucsb.edu"
210 '(hact 'hyp-request)) t] 130 '(hact 'hyp-request)) t]
211 ["Mail-to-Hyperbole-List" 131 ["Mail-to-Hyperbole-List"
212 (hmail:compose "hyperbole@infodock.com" '(hact 'hyp-config)) t] 132 (hmail:compose "hyperbole@hub.ucsb.edu" '(hact 'hyp-config)) t]
213 ) 133 )
214 (if hyperb:kotl-p 134 (if hyperb:kotl-p
215 '("Outline" 135 '("Outline"
216 ["Manual" (id-info "(hyperbole.info)Outliner") t] 136 ["Manual" (id-info "(hyperbole.info)Outliner") t]
217 ["Example" (find-file-read-only 137 ["Example" (find-file-read-only
269 (setq smail:comment ""))) 189 (setq smail:comment "")))
270 t] 190 t]
271 ))) 191 )))
272 192
273 ;;; ************************************************************************ 193 ;;; ************************************************************************
274 ;;; Private functions
275 ;;; ************************************************************************
276
277 (defvar hui-menu-max-list-length 24
278 "Positive integer that caps the length of a dynamic menu list.")
279
280 (defvar hui-menu-order-explicit-buttons t
281 "When non-nil (default), explicit button menu list is lexicographically ordered.
282 Otherwise, explicit buttons are listed in their order of appearance within
283 the current buffer.")
284
285 ;; List explicit buttons in the current buffer for menu activation.
286 (defun hui-menu-explicit-buttons (rest-of-menu)
287 (delq nil
288 (append
289 '(["Manual" (id-info "(hyperbole.info)Explicit Buttons") t]
290 "----")
291 (let ((labels (ebut:list))
292 (cutoff))
293 (if labels
294 (progn
295 ;; Cutoff list if too long.
296 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
297 (setcdr cutoff nil))
298 (delq nil
299 (append
300 '("----"
301 ["Alphabetize-List"
302 (setq hui-menu-order-explicit-buttons
303 (not hui-menu-order-explicit-buttons))
304 :style toggle :selected hui-menu-order-explicit-buttons]
305 "Activate:")
306 (mapcar (function (lambda (label)
307 (vector label `(ebut:act ,label) t)))
308 (if hui-menu-order-explicit-buttons
309 (sort labels 'string-lessp)
310 labels))
311 (if cutoff '(". . ."))
312 '("----" "----"))))))
313 rest-of-menu)))
314
315 ;; List existing global buttons for menu activation.
316 (defun hui-menu-global-buttons (rest-of-menu)
317 (delq nil
318 (append
319 '(["Manual" (id-info "(hyperbole.info)Global Buttons") t]
320 "----")
321 (let ((labels (gbut:label-list))
322 (cutoff))
323 (if labels
324 (progn
325 ;; Cutoff list if too long.
326 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
327 (setcdr cutoff nil))
328 (delq nil
329 (append
330 '("----" "Activate:")
331 (mapcar (function (lambda (label)
332 (vector label `(gbut:act ,label) t)))
333 (sort labels 'string-lessp))
334 (if cutoff '(". . ."))
335 '("----" "----"))))))
336 rest-of-menu)))
337
338 ;;; ************************************************************************
339 ;;; Private variables 194 ;;; Private variables
340 ;;; ************************************************************************ 195 ;;; ************************************************************************
341 196
342 (provide 'hui-menu) 197 (provide 'hui-menu)