|
2
|
1 ;;; w3-menu.el --- Menu functions for emacs-w3
|
|
0
|
2 ;; Author: wmperry
|
|
189
|
3 ;; Created: 1997/08/20 13:57:38
|
|
|
4 ;; Version: 1.42
|
|
0
|
5 ;; Keywords: menu, hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
82
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
|
0
|
10 ;;;
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12 ;;;
|
|
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
80
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
0
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
|
29 (require 'w3-vars)
|
|
114
|
30 (require 'w3-mouse)
|
|
165
|
31 (require 'widget)
|
|
|
32
|
|
|
33 (define-widget-keywords :href :src :title)
|
|
|
34
|
|
|
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
36 ;;; InfoDock stuff
|
|
|
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
189
|
38 (if (fboundp 'id-menubar-set)
|
|
|
39 (id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar))
|
|
165
|
40
|
|
0
|
41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
42 ;;; Spiffy new menus (for both Emacs and XEmacs)
|
|
|
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
44 (defvar w3-menu-fsfemacs-bookmark-menu nil)
|
|
|
45 (defvar w3-menu-fsfemacs-debug-menu nil)
|
|
|
46 (defvar w3-menu-fsfemacs-edit-menu nil)
|
|
|
47 (defvar w3-menu-fsfemacs-file-menu nil)
|
|
|
48 (defvar w3-menu-fsfemacs-go-menu nil)
|
|
|
49 (defvar w3-menu-fsfemacs-help-menu nil)
|
|
|
50 (defvar w3-menu-fsfemacs-view-menu nil)
|
|
|
51 (defvar w3-menu-fsfemacs-options-menu nil)
|
|
|
52 (defvar w3-menu-fsfemacs-style-menu nil)
|
|
80
|
53 (defvar w3-menu-fsfemacs-search-menu nil)
|
|
0
|
54 (defvar w3-menu-w3-menubar nil)
|
|
|
55 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
|
|
|
56 (make-variable-buffer-local 'w3-links-menu)
|
|
|
57
|
|
116
|
58 (defcustom w3-use-menus '(file edit view go bookmark options buffers style
|
|
|
59 emacs nil help)
|
|
0
|
60 "*Non-nil value causes W3 to provide a menu interface.
|
|
|
61 A value that is a list causes W3 to install its own menubar.
|
|
|
62 A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar.
|
|
|
63
|
|
|
64 If the value of w3-use-menus is a list, it should be a list of symbols.
|
|
|
65 The symbols and the order that they are listed determine what menus
|
|
|
66 will be in the menubar and how they are ordered. Valid symbol values
|
|
|
67 are:
|
|
|
68
|
|
|
69 file -- A list of file related commands
|
|
|
70 edit -- Various standard editing commands (copy/paste)
|
|
|
71 view -- Controlling various things about the document view
|
|
|
72 go -- Navigation control
|
|
|
73 bookmark -- Bookmark / hotlist control
|
|
|
74 options -- Various options
|
|
|
75 buffers -- The standard buffers menu
|
|
|
76 emacs -- A toggle button to switch back to normal emacs menus
|
|
80
|
77 style -- Control style information and who gets to set what
|
|
|
78 search -- Various search engines
|
|
|
79 help -- The help menu
|
|
0
|
80 nil -- ** special **
|
|
|
81
|
|
|
82 If nil appears in the list, it should appear exactly once. All
|
|
|
83 menus after nil in the list will be displayed flushright in the
|
|
98
|
84 menubar.
|
|
|
85
|
|
|
86 NOTE! The current port of Emacs to Windows NT/95 does not support
|
|
|
87 buttons in the menubar, so the 'emacs' keyword is currently ignored
|
|
116
|
88 on that platform."
|
|
|
89 :group 'w3-menus
|
|
|
90 :type '(set (const :tag "File related commands" :value file)
|
|
|
91 (const :tag "Standard editing commands" :value edit)
|
|
|
92 (const :tag "View document information" :value view)
|
|
|
93 (const :tag "Navigation" :value go)
|
|
|
94 (const :tag "Bookmarks" :value bookmark)
|
|
|
95 (const :tag "Options" :value options)
|
|
|
96 (const :tag "Buffer list" :value buffers)
|
|
|
97 (const :tag "Stylesheet information" :value style)
|
|
|
98 (const :tag "Search engines" :value search)
|
|
|
99 (const :tag "Toggle to default menus" :value emacs)
|
|
|
100 (const :tag "Separator" :value nil)
|
|
|
101 (const :tag "Help" :value help)))
|
|
0
|
102
|
|
|
103 (defun w3-menu-hotlist-constructor (menu-items)
|
|
|
104 (or (cdr w3-html-bookmarks)
|
|
|
105 (let ((hot-menu nil)
|
|
|
106 (hot w3-hotlist))
|
|
|
107 (while hot
|
|
|
108 (setq hot-menu (cons (vector
|
|
|
109 (w3-truncate-menu-item (car (car hot)))
|
|
|
110 (list 'w3-fetch (car (cdr (car hot))))
|
|
|
111 t) hot-menu)
|
|
|
112 hot (cdr hot)))
|
|
80
|
113 (or hot-menu '(["No Hotlist" nil nil])))))
|
|
|
114
|
|
|
115 (defun w3-menu-html-links-constructor (menu-items)
|
|
|
116 (or menu-items
|
|
|
117 (let ((links (mapcar 'cdr w3-current-links))
|
|
|
118 (menu nil))
|
|
|
119 (if links
|
|
|
120 (setq links (delete*
|
|
|
121 nil
|
|
|
122 (reduce 'append links)
|
|
|
123 :test-not (function
|
|
|
124 (lambda (a b) ; arg order unknown
|
|
|
125 (member
|
|
|
126 (car (or a b))
|
|
|
127 w3-defined-link-types))))))
|
|
|
128 (while links
|
|
|
129 (let ((name (caar links))
|
|
|
130 (vals (cdar links))
|
|
|
131 (href nil)
|
|
|
132 (new nil))
|
|
|
133 (if (= (length vals) 1)
|
|
|
134 (setq vals (car vals)
|
|
|
135 new (vector (or (plist-get vals 'title)
|
|
|
136 (capitalize name))
|
|
|
137 (list 'w3-fetch (plist-get vals 'href)) t))
|
|
|
138 (setq new (cons (capitalize name)
|
|
|
139 (mapcar (function
|
|
|
140 (lambda (x)
|
|
|
141 (setq href (plist-get x 'href))
|
|
|
142 (vector (or (plist-get x 'title) href)
|
|
|
143 (list 'w3-fetch href) t)))
|
|
|
144 vals))))
|
|
|
145 (setq links (cdr links)
|
|
|
146 menu (cons new menu))))
|
|
|
147 (or menu '(["None" nil nil])))))
|
|
0
|
148
|
|
|
149 (defun w3-menu-links-constructor (menu-items)
|
|
|
150 (or menu-items
|
|
|
151 (let ((widgets (w3-only-links))
|
|
|
152 widget href menu)
|
|
|
153 (while widgets
|
|
|
154 (setq widget (car widgets)
|
|
|
155 widgets (cdr widgets)
|
|
165
|
156 href (widget-get widget :href)
|
|
0
|
157 menu (cons
|
|
|
158 (vector (w3-truncate-menu-item
|
|
165
|
159 (or (widget-get widget :title)
|
|
80
|
160 (w3-fix-spaces
|
|
|
161 (buffer-substring
|
|
|
162 (widget-get widget :from)
|
|
|
163 (widget-get widget :to)))))
|
|
0
|
164 (list 'url-maybe-relative href) t) menu)))
|
|
|
165 (setq menu (w3-breakup-menu menu w3-max-menu-length))
|
|
80
|
166 (or menu '(["No Links" nil nil])))))
|
|
0
|
167
|
|
|
168 (defun w3-toggle-minibuffer ()
|
|
|
169 (interactive)
|
|
|
170 (cond
|
|
|
171 (w3-running-xemacs
|
|
82
|
172 (if (equal (frame-property (selected-frame) 'minibuffer) t)
|
|
|
173
|
|
|
174 ;; frame has a minibuffer, so remove it
|
|
|
175 ;; unfortunately, we must delete and redraw the frame
|
|
|
176 (let ((fp (frame-properties (selected-frame)))
|
|
|
177 (frame (selected-frame))
|
|
|
178 (buf (current-buffer)))
|
|
|
179 (select-frame
|
|
|
180 (make-frame (plist-put
|
|
|
181 (plist-remprop
|
|
|
182 (plist-remprop fp 'window-id) 'minibuffer)
|
|
|
183 'minibuffer nil)))
|
|
|
184 (delete-frame frame)
|
|
|
185 (switch-to-buffer buf))
|
|
|
186 ;; no minibuffer so add one
|
|
|
187 (set-frame-property (selected-frame) 'minibuffer t)))
|
|
0
|
188 (t nil)))
|
|
|
189
|
|
|
190 (defun w3-toggle-location ()
|
|
|
191 (interactive)
|
|
|
192 (cond
|
|
|
193 (w3-running-xemacs
|
|
|
194 (let ((on (specifier-instance has-modeline-p (selected-window))))
|
|
|
195 (set-specifier has-modeline-p (not on) (selected-window))))
|
|
|
196 (t nil)))
|
|
|
197
|
|
|
198 (defun w3-toggle-menubar ()
|
|
|
199 (interactive)
|
|
|
200 (cond
|
|
|
201 ;; XEmacs style
|
|
|
202 (w3-running-xemacs
|
|
2
|
203 (set-specifier menubar-visible-p (cons (current-buffer)
|
|
|
204 (not (specifier-instance
|
|
|
205 menubar-visible-p)))))
|
|
0
|
206 ;; Emacs 19 style
|
|
|
207 (t
|
|
|
208 (menu-bar-mode (if (w3-menubar-active) -1 1)))))
|
|
|
209
|
|
|
210 (defun w3-location-active ()
|
|
|
211 (if w3-running-xemacs
|
|
|
212 (specifier-instance has-modeline-p (selected-window))
|
|
|
213 t))
|
|
|
214
|
|
|
215 (defun w3-menubar-active ()
|
|
|
216 (if w3-running-xemacs
|
|
2
|
217 (and (featurep 'menubar) (specifier-instance menubar-visible-p))
|
|
0
|
218 (and (boundp 'menu-bar-mode) menu-bar-mode)))
|
|
|
219
|
|
|
220 (defun w3-menu-global-menubar ()
|
|
|
221 (if w3-running-xemacs
|
|
|
222 (default-value 'default-menubar)
|
|
|
223 (lookup-key (current-global-map) [menu-bar])))
|
|
|
224
|
|
|
225 (defconst w3-menu-file-menu
|
|
|
226 (list
|
|
|
227 "File"
|
|
|
228 ["Open Location..." w3-fetch t]
|
|
|
229 ["Open File..." w3-open-local t]
|
|
|
230 ["Open in New Window..." w3-fetch-other-frame t]
|
|
|
231 ["New Window" make-frame t]
|
|
|
232 "---"
|
|
|
233 ["Save" save-buffer t nil]
|
|
|
234 (list
|
|
|
235 "Save As..."
|
|
|
236 ["HTML" (w3-save-as "HTML Source") t]
|
|
|
237 ["Formatted Text" (w3-save-as "Formatted Text") t]
|
|
|
238 ["LaTeX" (w3-save-as "LaTeX Source") t]
|
|
|
239 ["PostScript" (w3-save-as "PostScript") t]
|
|
|
240 ["Binary" (w3-save-as "Binary") t]
|
|
|
241 )
|
|
|
242 "---"
|
|
|
243 (list
|
|
|
244 "Print As..."
|
|
|
245 ["PostScript" (w3-print-this-url nil "PostScript") t]
|
|
|
246 ["Formatted Text" (w3-print-this-url nil "Formatted Text") t]
|
|
|
247 ["HTML Source" (w3-print-this-url nil "HTML Source") t]
|
|
|
248 ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t]
|
|
|
249 )
|
|
|
250 (list
|
|
|
251 "Mail Document..."
|
|
|
252 ["HTML" (w3-mail-current-document nil "HTML Source") t]
|
|
|
253 ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t]
|
|
|
254 ["PostScript" (w3-mail-current-document nil "PostScript") t]
|
|
|
255 ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t]
|
|
|
256 )
|
|
|
257 (if w3-running-xemacs
|
|
|
258 "---:shadowDoubleEtchedIn"
|
|
|
259 "---")
|
|
|
260 ["Close" delete-frame (not (eq (next-frame) (selected-frame)))]
|
|
|
261 ["Exit" save-buffers-kill-emacs t]
|
|
|
262 )
|
|
|
263 "W3 file menu list.")
|
|
|
264
|
|
|
265 (defconst w3-menu-edit-menu
|
|
|
266 (list
|
|
|
267 "Edit"
|
|
|
268 ["Undo" advertised-undo nil]
|
|
|
269 ["Cut" kill-region nil]
|
|
|
270 ["Copy" copy-region-as-kill t]
|
|
|
271 "----"
|
|
|
272 ["Search..." w3-search-forward t]
|
|
|
273 ["Search Again..." w3-search-again w3-last-search-item]
|
|
134
|
274 "----"
|
|
|
275 (list
|
|
|
276 "Preferences"
|
|
|
277 (if (fboundp 'custom-menu-create)
|
|
|
278 (custom-menu-create 'w3)
|
|
|
279 ["W3" ignore nil])
|
|
|
280 (if (fboundp 'custom-menu-create)
|
|
|
281 (custom-menu-create 'url)
|
|
|
282 ["URL" ignore nil])
|
|
|
283 )
|
|
0
|
284 )
|
|
|
285 "W3 edit menu list.")
|
|
|
286
|
|
|
287 (defconst w3-menu-view-menu
|
|
|
288 (list
|
|
|
289 "View"
|
|
|
290 ["Document Information" w3-document-information t]
|
|
|
291 ["Document Source" w3-source-document t]
|
|
173
|
292 ["Document Errors" w3-display-errors w3-current-badhtml]
|
|
0
|
293 ["Load Images" w3-load-delayed-images w3-delayed-images]
|
|
|
294 "----"
|
|
|
295 ["Refresh" w3-refresh-buffer w3-current-parse]
|
|
|
296 ["Reload" w3-reload-document (and (url-view-url t)
|
|
|
297 (not (equal (url-view-url t) "")))]
|
|
|
298 "----"
|
|
|
299 ["Show URL" url-view-url t]
|
|
|
300 ["Show URL At Point" w3-view-this-url t]
|
|
|
301 "----"
|
|
|
302 )
|
|
|
303 "W3 menu view list.")
|
|
|
304
|
|
|
305 (defconst w3-menu-debug-menu
|
|
|
306 (list
|
|
|
307 "Debugging"
|
|
|
308 ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
|
|
|
309 w3-current-parse]
|
|
|
310 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
|
|
80
|
311 ["Reload Stylesheets" w3-refresh-stylesheets t]
|
|
0
|
312 )
|
|
|
313 "W3 menu debug list.")
|
|
|
314
|
|
|
315 (defconst w3-menu-go-menu
|
|
|
316 (list
|
|
|
317 "Go"
|
|
98
|
318 ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))]
|
|
|
319 ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))]
|
|
0
|
320 ["Home" w3 w3-default-homepage]
|
|
|
321 ["View History..." w3-show-history-list url-keep-history]
|
|
|
322 "----"
|
|
|
323 (if w3-running-xemacs
|
|
|
324 '("Links" :filter w3-menu-links-constructor)
|
|
80
|
325 ["Links..." w3-e19-show-links-menu t])
|
|
|
326 (if w3-running-xemacs
|
|
|
327 '("Navigate" :filter w3-menu-html-links-constructor)
|
|
|
328 ["Navigate..." w3-e19-show-navigate-menu t])
|
|
0
|
329 )
|
|
|
330 "W3 menu go list.")
|
|
|
331
|
|
|
332 (defconst w3-menu-bookmark-menu
|
|
|
333 (list
|
|
|
334 "Bookmark"
|
|
|
335 ["View Bookmarks..." w3-show-hotlist w3-hotlist]
|
|
|
336 ["Add Bookmark" w3-hotlist-add-document t]
|
|
|
337 ["Delete Bookmark" w3-hotlist-delete t]
|
|
|
338 ["Rename Bookmark" w3-hotlist-rename-entry t]
|
|
|
339 ["Append Bookmark List" w3-hotlist-append t]
|
|
|
340 "----"
|
|
|
341 (if w3-running-xemacs
|
|
|
342 '("Bookmarks" :filter w3-menu-hotlist-constructor)
|
|
|
343 ["Bookmarks" w3-e19-show-hotlist-menu t])
|
|
|
344 )
|
|
|
345 "W3 menu bookmark list.")
|
|
|
346
|
|
|
347 (defconst w3-menu-options-menu
|
|
|
348 (list "Options"
|
|
2
|
349 ["Edit Preferences" w3-preferences-edit t]
|
|
|
350 "---"
|
|
0
|
351 ["Show Menubar" w3-toggle-menubar
|
|
|
352 :style toggle :selected (w3-menubar-active)]
|
|
|
353 (if (and w3-running-xemacs (featurep 'toolbar))
|
|
|
354 ["Show Toolbar" w3-toggle-toolbar
|
|
|
355 :style toggle :selected (w3-toolbar-active)]
|
|
110
|
356 ["Show Toolbar" w3-toggle-toolbar nil])
|
|
0
|
357 (if w3-running-xemacs
|
|
|
358 ["Show Location" w3-toggle-location
|
|
|
359 :style toggle :selected (w3-location-active)]
|
|
110
|
360 ["Show Location" w3-toggle-location nil])
|
|
0
|
361 (if w3-running-xemacs
|
|
|
362 ["Show Status Bar" w3-toggle-minibuffer
|
|
82
|
363 :style toggle
|
|
|
364 :selected (eq (frame-property (selected-frame) 'minibuffer) t)
|
|
|
365 ])
|
|
0
|
366 ["Incremental Display"
|
|
|
367 (setq w3-do-incremental-display (not w3-do-incremental-display))
|
|
|
368 :style toggle :selected w3-do-incremental-display]
|
|
|
369 "----"
|
|
|
370 ["Auto Load Images"
|
|
|
371 (setq w3-delay-image-loads (not w3-delay-image-loads))
|
|
|
372 :style toggle :selected (not w3-delay-image-loads)]
|
|
|
373 ["Flush Image Cache" (setq w3-graphics-list nil) w3-graphics-list]
|
|
|
374 "----"
|
|
|
375 ["Download to disk" (setq w3-dump-to-disk (not w3-dump-to-disk))
|
|
|
376 :style toggle :selected w3-dump-to-disk]
|
|
|
377 ["Caching" (setq url-automatic-caching (not url-automatic-caching))
|
|
|
378 :style toggle :selected url-automatic-caching]
|
|
|
379 ["Use Cache Only"
|
|
|
380 (setq url-standalone-mode (not url-standalone-mode))
|
|
|
381 :style toggle :selected url-standalone-mode]
|
|
|
382 "----"
|
|
|
383 ["Save Options" w3-menu-save-options t]
|
|
|
384 )
|
|
|
385 "W3 menu options list.")
|
|
|
386
|
|
|
387 (defconst w3-menu-style-menu
|
|
|
388 (list
|
|
|
389 "Style"
|
|
|
390 ["Allow Document Stylesheets" (setq w3-honor-stylesheets
|
|
|
391 (not w3-honor-stylesheets))
|
|
|
392 :style toggle :selected w3-honor-stylesheets]
|
|
|
393 ["Honor Color Requests" (setq w3-user-colors-take-precedence
|
|
|
394 (not w3-user-colors-take-precedence))
|
|
|
395 :style toggle :selected (not w3-user-colors-take-precedence)]
|
|
2
|
396 "---"
|
|
|
397 ["Reload Stylesheets" w3-refresh-stylesheets t]
|
|
0
|
398 )
|
|
|
399 "W3 menu style list.")
|
|
|
400
|
|
|
401 (defconst w3-menu-buffer-menu
|
|
|
402 (if w3-running-xemacs
|
|
|
403 '("Buffers"
|
|
|
404 :filter buffers-menu-filter
|
|
|
405 ["List All Buffers" list-buffers t]
|
|
|
406 "--!here")
|
|
|
407 nil)
|
|
|
408 "W3 menu buffer list.")
|
|
|
409
|
|
80
|
410 (defconst w3-menu-search-menu
|
|
|
411 (list
|
|
|
412 "Search"
|
|
|
413 ["Yahoo!" (w3-fetch "http://www.yahoo.com/") t]
|
|
|
414 ["Excite" (w3-fetch "http://www.excite.com/") t]
|
|
|
415 ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t]
|
|
|
416 "---"
|
|
|
417 )
|
|
|
418 "W3 search menu")
|
|
|
419
|
|
0
|
420 (defconst w3-menu-emacs-button
|
|
|
421 (vector
|
|
|
422 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
|
|
|
423
|
|
|
424 (defconst w3-menu-help-menu
|
|
|
425 (list
|
|
|
426 "Help"
|
|
|
427 ["About Emacs-w3" (w3-fetch "about:") t]
|
|
82
|
428 ["Manual" (w3-fetch (concat w3-documentation-root "docs/w3_toc.html")) t]
|
|
0
|
429 "---"
|
|
|
430 ["Version Information..."
|
|
|
431 (w3-fetch
|
|
82
|
432 (concat w3-documentation-root "help/version_" w3-version-number ".html"))
|
|
0
|
433 t]
|
|
82
|
434 ["On FAQ" (w3-fetch (concat w3-documentation-root "help/FAQ.html")) t]
|
|
0
|
435 "---"
|
|
|
436 ["Mail Developer(s)" w3-submit-bug t]
|
|
|
437 )
|
|
|
438 "W3 menu help list.")
|
|
|
439
|
|
|
440 (defvar w3-mode-menu-map nil)
|
|
|
441
|
|
|
442 (defun w3-menu-initialize-w3-mode-menu-map ()
|
|
|
443 (if (null w3-mode-menu-map)
|
|
|
444 (let ((map (make-sparse-keymap))
|
|
|
445 (dummy (make-sparse-keymap)))
|
|
|
446 (require 'easymenu)
|
|
|
447 ;; initialize all the w3-menu-fsfemacs-*-menu variables
|
|
|
448 ;; with the menus.
|
|
|
449 (easy-menu-define w3-menu-fsfemacs-bookmark-menu (list dummy) nil
|
|
|
450 w3-menu-bookmark-menu)
|
|
|
451 (easy-menu-define w3-menu-fsfemacs-debug-menu (list dummy) nil
|
|
|
452 w3-menu-debug-menu)
|
|
|
453 (easy-menu-define w3-menu-fsfemacs-edit-menu (list dummy) nil
|
|
|
454 w3-menu-edit-menu)
|
|
|
455 (easy-menu-define w3-menu-fsfemacs-file-menu (list dummy) nil
|
|
|
456 w3-menu-file-menu)
|
|
|
457 (easy-menu-define w3-menu-fsfemacs-go-menu (list dummy) nil
|
|
|
458 w3-menu-go-menu)
|
|
|
459 (easy-menu-define w3-menu-fsfemacs-help-menu (list dummy) nil
|
|
|
460 w3-menu-help-menu)
|
|
|
461 (easy-menu-define w3-menu-fsfemacs-view-menu (list dummy) nil
|
|
|
462 w3-menu-view-menu)
|
|
|
463 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil
|
|
|
464 w3-menu-options-menu)
|
|
|
465 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
|
|
|
466 w3-menu-style-menu)
|
|
80
|
467 (easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil
|
|
|
468 w3-menu-search-menu)
|
|
0
|
469
|
|
|
470 ;; block the global menubar entries in the map so that W3
|
|
|
471 ;; can take over the menubar if necessary.
|
|
|
472 (define-key map [rootmenu] (make-sparse-keymap))
|
|
|
473 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3")))
|
|
|
474 (define-key map [rootmenu w3 file] 'undefined)
|
|
|
475 (define-key map [rootmenu w3 files] 'undefined)
|
|
|
476 (define-key map [rootmenu w3 search] 'undefined)
|
|
|
477 (define-key map [rootmenu w3 edit] 'undefined)
|
|
|
478 (define-key map [rootmenu w3 options] 'undefined)
|
|
|
479 (define-key map [rootmenu w3 buffer] 'undefined)
|
|
|
480 (define-key map [rootmenu w3 tools] 'undefined)
|
|
|
481 (define-key map [rootmenu w3 help] 'undefined)
|
|
|
482 (define-key map [rootmenu w3 help-menu] 'undefined)
|
|
|
483 ;; now build W3's menu tree.
|
|
|
484 (let ((menu-alist
|
|
|
485 '(
|
|
|
486 (bookmark
|
|
|
487 (cons "Bookmark" w3-menu-fsfemacs-bookmark-menu))
|
|
|
488 (debug
|
|
|
489 (cons "Debug" w3-menu-fsfemacs-debug-menu))
|
|
|
490 (edit
|
|
|
491 (cons "Edit" w3-menu-fsfemacs-edit-menu))
|
|
|
492 (file
|
|
|
493 (cons "File" w3-menu-fsfemacs-file-menu))
|
|
|
494 (go
|
|
|
495 (cons "Go" w3-menu-fsfemacs-go-menu))
|
|
|
496 (help
|
|
|
497 (cons "Help" w3-menu-fsfemacs-help-menu))
|
|
|
498 (options
|
|
|
499 (cons "Options" w3-menu-fsfemacs-options-menu))
|
|
|
500 (view
|
|
|
501 (cons "View" w3-menu-fsfemacs-view-menu))
|
|
|
502 (style
|
|
|
503 (cons "Style" w3-menu-fsfemacs-style-menu))
|
|
80
|
504 (search
|
|
|
505 (cons "Search" w3-menu-fsfemacs-search-menu))
|
|
0
|
506 (emacs
|
|
98
|
507 ;; FIXME!!! Currently, win32 doesn't support buttons
|
|
|
508 ;; in menubars, so we hack around it and ignore the
|
|
|
509 ;; 'emacs keyword on that platform. REMOVE THIS CODE
|
|
|
510 ;; as soon as that is fixed. 19.35 timeframe?
|
|
|
511 (if (eq (device-type) 'win32)
|
|
|
512 nil
|
|
|
513 (cons "[Emacs]" 'w3-menu-toggle-menubar)))))
|
|
0
|
514 cons
|
|
|
515 (vec (vector 'rootmenu 'w3 nil))
|
|
|
516 ;; menus appear in the opposite order that we
|
|
|
517 ;; define-key them.
|
|
|
518 (menu-list
|
|
|
519 (if (consp w3-use-menus)
|
|
|
520 (reverse w3-use-menus)
|
|
|
521 (list 'help nil 'emacs 'buffers 'options 'bookmark
|
|
|
522 'go 'view 'edit 'file))))
|
|
|
523 (while menu-list
|
|
|
524 (if (null (car menu-list))
|
|
|
525 nil;; no flushright support in FSF Emacs
|
|
|
526 (aset vec 2 (intern (concat "w3-menu-fsfemacs-"
|
|
|
527 (symbol-name
|
|
|
528 (car menu-list)) "-menu")))
|
|
|
529 (setq cons (assq (car menu-list) menu-alist))
|
|
|
530 (if cons
|
|
|
531 (define-key map vec (eval (car (cdr cons))))))
|
|
|
532 (setq menu-list (cdr menu-list))))
|
|
|
533 (setq w3-mode-menu-map map)
|
|
|
534 (run-hooks 'w3-menu-setup-hook))))
|
|
|
535
|
|
|
536 (defun w3-menu-make-xemacs-menubar ()
|
|
|
537 (let ((menu-alist
|
|
|
538 '((bookmark . w3-menu-bookmark-menu)
|
|
|
539 (style . w3-menu-style-menu)
|
|
|
540 (buffer . w3-menu-buffer-menu)
|
|
|
541 (debug . w3-menu-debug-menu)
|
|
|
542 (edit . w3-menu-edit-menu)
|
|
|
543 (emacs . w3-menu-emacs-button)
|
|
|
544 (file . w3-menu-file-menu)
|
|
|
545 (go . w3-menu-go-menu)
|
|
|
546 (help . w3-menu-help-menu)
|
|
|
547 (options . w3-menu-options-menu)
|
|
80
|
548 (search . w3-menu-search-menu)
|
|
0
|
549 (view . w3-menu-view-menu)
|
|
|
550 )
|
|
|
551 )
|
|
|
552 cons
|
|
|
553 (menubar nil)
|
|
|
554 (menu-list w3-use-menus))
|
|
|
555 (while menu-list
|
|
|
556 (if (null (car menu-list))
|
|
|
557 (setq menubar (cons nil menubar))
|
|
|
558 (setq cons (assq (car menu-list) menu-alist))
|
|
|
559 (if cons
|
|
|
560 (setq menubar (cons (symbol-value (cdr cons)) menubar))))
|
|
|
561 (setq menu-list (cdr menu-list)))
|
|
|
562 (nreverse menubar)))
|
|
|
563
|
|
|
564 (defun w3-menu-install-menubar ()
|
|
|
565 (cond
|
|
|
566 (w3-running-xemacs
|
|
165
|
567 (cond
|
|
|
568 ((not (featurep 'menubar)) nil) ; No menus available
|
|
|
569 ((featurep 'infodock) nil) ; InfoDock does it automatically
|
|
|
570 (t
|
|
0
|
571 (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar))
|
|
165
|
572 (set-buffer-menubar w3-menu-w3-menubar))))
|
|
0
|
573 ((not (fboundp 'vm-menu-undo-menu))
|
|
|
574 (w3-menu-initialize-w3-mode-menu-map)
|
|
|
575 (define-key w3-mode-map [menu-bar]
|
|
|
576 (lookup-key w3-mode-menu-map [rootmenu w3])))))
|
|
|
577
|
|
|
578 (defun w3-menu-install-menubar-item ()
|
|
|
579 (cond
|
|
|
580 (w3-running-xemacs
|
|
|
581 (if (not (featurep 'menubar))
|
|
|
582 nil ; No menus available
|
|
|
583 (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
|
|
|
584 (add-menu nil "W3" (cdr w3-menu-w3-menubar))))
|
|
|
585 ((not (fboundp 'w3-menu-fsfemacs-edit-menu))
|
|
|
586 (w3-menu-initialize-w3-mode-menu-map)
|
|
|
587 (define-key w3-mode-map [menu-bar]
|
|
|
588 (lookup-key w3-mode-menu-map [rootmenu])))))
|
|
|
589
|
|
|
590 (defun w3-menu-install-menus ()
|
|
2
|
591 (cond ((= emacs-minor-version 28) ; Hey, get with the times people!!
|
|
|
592 nil)
|
|
|
593 ((consp w3-use-menus)
|
|
0
|
594 (w3-menu-install-menubar))
|
|
|
595 ((eq w3-use-menus 1)
|
|
|
596 (w3-menu-install-menubar-item))
|
|
|
597 (t nil)))
|
|
|
598
|
|
|
599 (defun w3-menu-set-menubar-dirty-flag ()
|
|
|
600 (cond (w3-running-xemacs
|
|
|
601 (set-menubar-dirty-flag))
|
|
|
602 (t
|
|
|
603 (force-mode-line-update))))
|
|
|
604
|
|
|
605 (defun w3-menu-toggle-menubar ()
|
|
|
606 (interactive)
|
|
|
607 (cond
|
|
|
608 ;;((eq w3-use-menus 1)
|
|
|
609 ;;nil)
|
|
|
610 (w3-running-xemacs
|
|
|
611 (if (null (car (find-menu-item current-menubar '("XEmacs"))))
|
|
|
612 (set-buffer-menubar w3-menu-w3-menubar)
|
|
|
613 (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
|
|
|
614 (condition-case ()
|
|
|
615 (add-menu-button nil ["W3" w3-menu-toggle-menubar t] nil)
|
|
|
616 (void-function
|
|
|
617 (add-menu-item nil "W3" 'w3-menu-toggle-menubar t))))
|
|
|
618 (w3-menu-set-menubar-dirty-flag))
|
|
|
619 (t
|
|
|
620 (if (not (eq (lookup-key w3-mode-map [menu-bar])
|
|
|
621 (lookup-key w3-mode-menu-map [rootmenu w3])))
|
|
|
622 (define-key w3-mode-map [menu-bar]
|
|
|
623 (lookup-key w3-mode-menu-map [rootmenu w3]))
|
|
|
624 (define-key w3-mode-map [menu-bar]
|
|
|
625 (make-sparse-keymap))
|
|
|
626 (define-key w3-mode-map [menu-bar w3]
|
|
|
627 (cons "[W3]" 'w3-menu-toggle-menubar)))
|
|
|
628 (w3-menu-set-menubar-dirty-flag))))
|
|
|
629
|
|
|
630 (defun w3-menu-save-options ()
|
|
|
631 (interactive)
|
|
|
632 (let ((output-buffer (find-file-noselect w3-default-configuration-file))
|
|
|
633 output-marker)
|
|
|
634 (save-excursion
|
|
|
635 (set-buffer output-buffer)
|
|
|
636 ;;
|
|
|
637 ;; Find and delete the previously saved data, and position to write.
|
|
|
638 ;;
|
|
|
639 (goto-char (point-min))
|
|
|
640 (if (re-search-forward "^;; W3 Options Settings *\n" nil 'move)
|
|
|
641 (let ((p (match-beginning 0)))
|
|
|
642 (goto-char p)
|
|
|
643 (or (re-search-forward
|
|
|
644 "^;; End of W3 Options Settings *\\(\n\\|\\'\\)"
|
|
|
645 nil t)
|
|
|
646 (error "can't find END of saved state in .emacs"))
|
|
|
647 (delete-region p (match-end 0)))
|
|
|
648 (goto-char (point-max))
|
|
|
649 (insert "\n"))
|
|
|
650 (setq output-marker (point-marker))
|
|
|
651 (let ((print-readably t)
|
|
|
652 (print-escape-newlines t)
|
|
|
653 (standard-output output-marker))
|
|
|
654 (princ ";; W3 Options Settings\n")
|
|
|
655 (princ ";; ===================\n")
|
|
|
656 (mapcar (function
|
|
|
657 (lambda (var)
|
|
|
658 (princ " ")
|
|
|
659 (if (and (symbolp var) (boundp var))
|
|
|
660 (prin1 (list 'setq-default var
|
|
|
661 (let ((val (symbol-value var)))
|
|
|
662 (if (or (memq val '(t nil))
|
|
|
663 (and (not (symbolp val))
|
|
|
664 (not (listp val))))
|
|
|
665 val
|
|
|
666 (list 'quote val))))))
|
|
|
667 (if var (princ "\n"))))
|
|
|
668 '(
|
|
|
669 ps-print-color-p
|
|
|
670 url-automatic-caching
|
|
2
|
671 url-be-asynchronous
|
|
|
672 url-honor-refresh-requests
|
|
|
673 url-privacy-level
|
|
110
|
674 url-cookie-confirmation
|
|
0
|
675 url-proxy-services
|
|
2
|
676 url-standalone-mode
|
|
|
677 url-use-hypertext-gopher
|
|
0
|
678 w3-default-homepage
|
|
2
|
679 w3-default-stylesheet
|
|
|
680 w3-delay-image-loads
|
|
|
681 w3-do-incremental-display
|
|
|
682 w3-dump-to-disk
|
|
|
683 w3-honor-stylesheets
|
|
|
684 w3-image-mappings
|
|
|
685 w3-load-hook
|
|
|
686 w3-mode-hook
|
|
|
687 w3-netscape-compatible-comments
|
|
|
688 w3-preferences-cancel-hook
|
|
|
689 w3-preferences-default-hook
|
|
|
690 w3-preferences-ok-hook
|
|
|
691 w3-preferences-setup-hook
|
|
|
692 w3-source-file-hook
|
|
0
|
693 w3-toolbar-orientation
|
|
2
|
694 w3-toolbar-type
|
|
|
695 w3-use-menus
|
|
|
696 w3-user-colors-take-precedence
|
|
0
|
697 )
|
|
|
698 )
|
|
|
699 (princ ";; ==========================\n")
|
|
|
700 (princ ";; End of W3 Options Settings\n")))
|
|
|
701 (set-marker output-marker nil)
|
|
|
702 (save-excursion
|
|
|
703 (set-buffer output-buffer)
|
|
|
704 (save-buffer))
|
|
|
705 ))
|
|
|
706
|
|
|
707 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
708 ;;; Context-sensitive popup menu
|
|
|
709 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
710 (if (not (fboundp 'event-glyph))
|
|
|
711 (fset 'event-glyph 'ignore))
|
|
|
712
|
|
|
713 (defun w3-popup-menu (e)
|
|
|
714 "Pop up a menu of common w3 commands"
|
|
|
715 (interactive "e")
|
|
114
|
716 (if (not w3-popup-menu-on-mouse-3)
|
|
|
717 (call-interactively (lookup-key global-map (vector w3-mouse-button3)))
|
|
|
718 (mouse-set-point e)
|
|
|
719 (let* ((glyph (event-glyph e))
|
|
|
720 (widget (or (and glyph (glyph-property glyph 'widget))
|
|
|
721 (widget-at (point))))
|
|
|
722 (parent (and widget (widget-get widget :parent)))
|
|
165
|
723 (href (or (and widget (widget-get widget :href))
|
|
|
724 (and parent (widget-get parent :href))))
|
|
|
725 (imag (or (and widget (widget-get widget :src))
|
|
|
726 (and parent (widget-get parent :src))))
|
|
114
|
727 (menu (copy-tree w3-popup-menu))
|
|
|
728 url val trunc-url)
|
|
|
729 (if href
|
|
|
730 (progn
|
|
|
731 (setq url href)
|
|
|
732 (if url (setq trunc-url (url-truncate-url-for-viewing
|
|
|
733 url
|
|
|
734 w3-max-menu-width)))
|
|
|
735 (setcdr menu (append (cdr menu)
|
|
|
736 '("---")
|
|
|
737 (mapcar
|
|
|
738 (function
|
|
|
739 (lambda (x)
|
|
|
740 (vector (format (car x) trunc-url)
|
|
|
741 (list (cdr x) url) t)))
|
|
|
742 w3-hyperlink-menu)))))
|
|
|
743 (if imag
|
|
|
744 (progn
|
|
|
745 (setq url imag
|
|
|
746 trunc-url (url-truncate-url-for-viewing url
|
|
|
747 w3-max-menu-width))
|
|
|
748 (setcdr menu (append (cdr menu)
|
|
|
749 '("---")
|
|
|
750 (mapcar
|
|
|
751 (function
|
|
|
752 (lambda (x)
|
|
|
753 (vector (format (car x) trunc-url)
|
|
|
754 (list (cdr x) url) t)))
|
|
|
755 w3-graphlink-menu)))))
|
|
|
756 (if (not (w3-menubar-active))
|
|
0
|
757 (setcdr menu (append (cdr menu)
|
|
114
|
758 '("---" ["Show Menubar" w3-toggle-menubar t]))))
|
|
|
759 (popup-menu menu))))
|
|
0
|
760
|
|
|
761 (provide 'w3-menu)
|
