Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-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 8d2a9b52c682
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; w3-menu.el --- Menu functions for emacs-w3 1 ;;; w3-menu.el --- Menu functions for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/22 17:31:47 3 ;; Created: 1996/07/21 18:29:01
4 ;; Version: 1.35 4 ;; Version: 1.7
5 ;; Keywords: menu, hypermedia 5 ;; Keywords: menu, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;; 9 ;;;
11 ;;; This file is part of GNU Emacs. 10 ;;; This file is part of GNU Emacs.
12 ;;; 11 ;;;
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;;; 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 13 ;;; it under the terms of the GNU General Public License as published by
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details. 20 ;;; GNU General Public License for more details.
22 ;;; 21 ;;;
23 ;;; You should have received a copy of the GNU General Public License 22 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 26
29 (require 'w3-vars) 27 (require 'w3-vars)
30 (require 'w3-mouse)
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 ;;; Spiffy new menus (for both Emacs and XEmacs) 29 ;;; Spiffy new menus (for both Emacs and XEmacs)
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 (defvar w3-menu-fsfemacs-bookmark-menu nil) 31 (defvar w3-menu-fsfemacs-bookmark-menu nil)
35 (defvar w3-menu-fsfemacs-debug-menu nil) 32 (defvar w3-menu-fsfemacs-debug-menu nil)
38 (defvar w3-menu-fsfemacs-go-menu nil) 35 (defvar w3-menu-fsfemacs-go-menu nil)
39 (defvar w3-menu-fsfemacs-help-menu nil) 36 (defvar w3-menu-fsfemacs-help-menu nil)
40 (defvar w3-menu-fsfemacs-view-menu nil) 37 (defvar w3-menu-fsfemacs-view-menu nil)
41 (defvar w3-menu-fsfemacs-options-menu nil) 38 (defvar w3-menu-fsfemacs-options-menu nil)
42 (defvar w3-menu-fsfemacs-style-menu nil) 39 (defvar w3-menu-fsfemacs-style-menu nil)
43 (defvar w3-menu-fsfemacs-search-menu nil)
44 (defvar w3-menu-w3-menubar nil) 40 (defvar w3-menu-w3-menubar nil)
45 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.") 41 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
46 (make-variable-buffer-local 'w3-links-menu) 42 (make-variable-buffer-local 'w3-links-menu)
47 43
48 (defcustom w3-use-menus '(file edit view go bookmark options buffers style 44 (defvar w3-use-menus '(file edit view go bookmark options
49 emacs nil help) 45 buffers style emacs nil help)
50 "*Non-nil value causes W3 to provide a menu interface. 46 "*Non-nil value causes W3 to provide a menu interface.
51 A value that is a list causes W3 to install its own menubar. 47 A value that is a list causes W3 to install its own menubar.
52 A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar. 48 A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar.
53 49
54 If the value of w3-use-menus is a list, it should be a list of symbols. 50 If the value of w3-use-menus is a list, it should be a list of symbols.
62 go -- Navigation control 58 go -- Navigation control
63 bookmark -- Bookmark / hotlist control 59 bookmark -- Bookmark / hotlist control
64 options -- Various options 60 options -- Various options
65 buffers -- The standard buffers menu 61 buffers -- The standard buffers menu
66 emacs -- A toggle button to switch back to normal emacs menus 62 emacs -- A toggle button to switch back to normal emacs menus
67 style -- Control style information and who gets to set what 63 style -- Control fonts and who gets to set them
68 search -- Various search engines 64 help -- The help
69 help -- The help menu
70 nil -- ** special ** 65 nil -- ** special **
71 66
72 If nil appears in the list, it should appear exactly once. All 67 If nil appears in the list, it should appear exactly once. All
73 menus after nil in the list will be displayed flushright in the 68 menus after nil in the list will be displayed flushright in the
74 menubar. 69 menubar.")
75
76 NOTE! The current port of Emacs to Windows NT/95 does not support
77 buttons in the menubar, so the 'emacs' keyword is currently ignored
78 on that platform."
79 :group 'w3-menus
80 :type '(set (const :tag "File related commands" :value file)
81 (const :tag "Standard editing commands" :value edit)
82 (const :tag "View document information" :value view)
83 (const :tag "Navigation" :value go)
84 (const :tag "Bookmarks" :value bookmark)
85 (const :tag "Options" :value options)
86 (const :tag "Buffer list" :value buffers)
87 (const :tag "Stylesheet information" :value style)
88 (const :tag "Search engines" :value search)
89 (const :tag "Toggle to default menus" :value emacs)
90 (const :tag "Separator" :value nil)
91 (const :tag "Help" :value help)))
92 70
93 (defun w3-menu-hotlist-constructor (menu-items) 71 (defun w3-menu-hotlist-constructor (menu-items)
94 (or (cdr w3-html-bookmarks) 72 (or (cdr w3-html-bookmarks)
95 (let ((hot-menu nil) 73 (let ((hot-menu nil)
96 (hot w3-hotlist)) 74 (hot w3-hotlist))
98 (setq hot-menu (cons (vector 76 (setq hot-menu (cons (vector
99 (w3-truncate-menu-item (car (car hot))) 77 (w3-truncate-menu-item (car (car hot)))
100 (list 'w3-fetch (car (cdr (car hot)))) 78 (list 'w3-fetch (car (cdr (car hot))))
101 t) hot-menu) 79 t) hot-menu)
102 hot (cdr hot))) 80 hot (cdr hot)))
103 (or hot-menu '(["No Hotlist" nil nil]))))) 81 (or hot-menu '(["No Hotlist" undefined nil])))))
104
105 (defun w3-menu-html-links-constructor (menu-items)
106 (or menu-items
107 (let ((links (mapcar 'cdr w3-current-links))
108 (menu nil))
109 (if links
110 (setq links (delete*
111 nil
112 (reduce 'append links)
113 :test-not (function
114 (lambda (a b) ; arg order unknown
115 (member
116 (car (or a b))
117 w3-defined-link-types))))))
118 (while links
119 (let ((name (caar links))
120 (vals (cdar links))
121 (href nil)
122 (new nil))
123 (if (= (length vals) 1)
124 (setq vals (car vals)
125 new (vector (or (plist-get vals 'title)
126 (capitalize name))
127 (list 'w3-fetch (plist-get vals 'href)) t))
128 (setq new (cons (capitalize name)
129 (mapcar (function
130 (lambda (x)
131 (setq href (plist-get x 'href))
132 (vector (or (plist-get x 'title) href)
133 (list 'w3-fetch href) t)))
134 vals))))
135 (setq links (cdr links)
136 menu (cons new menu))))
137 (or menu '(["None" nil nil])))))
138 82
139 (defun w3-menu-links-constructor (menu-items) 83 (defun w3-menu-links-constructor (menu-items)
140 (or menu-items 84 (or menu-items
141 (let ((widgets (w3-only-links)) 85 (let ((widgets (w3-only-links))
142 widget href menu) 86 widget href menu)
144 (setq widget (car widgets) 88 (setq widget (car widgets)
145 widgets (cdr widgets) 89 widgets (cdr widgets)
146 href (widget-get widget 'href) 90 href (widget-get widget 'href)
147 menu (cons 91 menu (cons
148 (vector (w3-truncate-menu-item 92 (vector (w3-truncate-menu-item
149 (or (widget-get widget 'title) 93 (w3-fix-spaces
150 (w3-fix-spaces 94 (buffer-substring
151 (buffer-substring 95 (widget-get widget :from)
152 (widget-get widget :from) 96 (widget-get widget :to))))
153 (widget-get widget :to)))))
154 (list 'url-maybe-relative href) t) menu))) 97 (list 'url-maybe-relative href) t) menu)))
155 (setq menu (w3-breakup-menu menu w3-max-menu-length)) 98 (setq menu (w3-breakup-menu menu w3-max-menu-length))
156 (or menu '(["No Links" nil nil]))))) 99 (or menu '(["No Links" undefined nil])))))
157 100
158 (defun w3-toggle-minibuffer () 101 (defun w3-toggle-minibuffer ()
159 (interactive) 102 (interactive)
160 (cond 103 (cond
161 (w3-running-xemacs 104 (w3-running-xemacs
162 (if (equal (frame-property (selected-frame) 'minibuffer) t) 105 (set-frame-property (selected-frame) 'minibuffer
163 106 (not (frame-property (selected-frame) 'minibuffer))))
164 ;; frame has a minibuffer, so remove it
165 ;; unfortunately, we must delete and redraw the frame
166 (let ((fp (frame-properties (selected-frame)))
167 (frame (selected-frame))
168 (buf (current-buffer)))
169 (select-frame
170 (make-frame (plist-put
171 (plist-remprop
172 (plist-remprop fp 'window-id) 'minibuffer)
173 'minibuffer nil)))
174 (delete-frame frame)
175 (switch-to-buffer buf))
176 ;; no minibuffer so add one
177 (set-frame-property (selected-frame) 'minibuffer t)))
178 (t nil))) 107 (t nil)))
179 108
180 (defun w3-toggle-location () 109 (defun w3-toggle-location ()
181 (interactive) 110 (interactive)
182 (cond 111 (cond
242 ["HTML" (w3-mail-current-document nil "HTML Source") t] 171 ["HTML" (w3-mail-current-document nil "HTML Source") t]
243 ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t] 172 ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t]
244 ["PostScript" (w3-mail-current-document nil "PostScript") t] 173 ["PostScript" (w3-mail-current-document nil "PostScript") t]
245 ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t] 174 ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t]
246 ) 175 )
176 ["Add Annotation" w3-annotation-add w3-personal-annotation-directory]
247 (if w3-running-xemacs 177 (if w3-running-xemacs
248 "---:shadowDoubleEtchedIn" 178 "---:shadowDoubleEtchedIn"
249 "---") 179 "---")
250 ["Close" delete-frame (not (eq (next-frame) (selected-frame)))] 180 ["Close" delete-frame (not (eq (next-frame) (selected-frame)))]
251 ["Exit" save-buffers-kill-emacs t] 181 ["Exit" save-buffers-kill-emacs t]
285 (list 215 (list
286 "Debugging" 216 "Debugging"
287 ["View Parse Tree" (w3-display-parse-tree w3-current-parse) 217 ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
288 w3-current-parse] 218 w3-current-parse]
289 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet] 219 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
290 ["Reload Stylesheets" w3-refresh-stylesheets t]
291 ) 220 )
292 "W3 menu debug list.") 221 "W3 menu debug list.")
293 222
294 (defconst w3-menu-go-menu 223 (defconst w3-menu-go-menu
295 (list 224 (list
296 "Go" 225 "Go"
297 ["Forward" w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t)))] 226 ["Forward" w3-forward-in-history t]
298 ["Back" w3-history-backward (car (w3-history-find-url-internal (url-view-url t)))] 227 ["Backward" w3-backward-in-history t]
299 ["Home" w3 w3-default-homepage] 228 ["Home" w3 w3-default-homepage]
300 ["View History..." w3-show-history-list url-keep-history] 229 ["View History..." w3-show-history-list url-keep-history]
301 "----" 230 "----"
302 (if w3-running-xemacs 231 (if w3-running-xemacs
303 '("Links" :filter w3-menu-links-constructor) 232 '("Links" :filter w3-menu-links-constructor)
304 ["Links..." w3-e19-show-links-menu t]) 233 ["Link..." w3-e19-show-links-menu t])
305 (if w3-running-xemacs
306 '("Navigate" :filter w3-menu-html-links-constructor)
307 ["Navigate..." w3-e19-show-navigate-menu t])
308 ) 234 )
309 "W3 menu go list.") 235 "W3 menu go list.")
310 236
311 (defconst w3-menu-bookmark-menu 237 (defconst w3-menu-bookmark-menu
312 (list 238 (list
330 ["Show Menubar" w3-toggle-menubar 256 ["Show Menubar" w3-toggle-menubar
331 :style toggle :selected (w3-menubar-active)] 257 :style toggle :selected (w3-menubar-active)]
332 (if (and w3-running-xemacs (featurep 'toolbar)) 258 (if (and w3-running-xemacs (featurep 'toolbar))
333 ["Show Toolbar" w3-toggle-toolbar 259 ["Show Toolbar" w3-toggle-toolbar
334 :style toggle :selected (w3-toolbar-active)] 260 :style toggle :selected (w3-toolbar-active)]
335 ["Show Toolbar" w3-toggle-toolbar nil]) 261 nil)
336 (if w3-running-xemacs 262 (if w3-running-xemacs
337 ["Show Location" w3-toggle-location 263 ["Show Location" w3-toggle-location
338 :style toggle :selected (w3-location-active)] 264 :style toggle :selected (w3-location-active)]
339 ["Show Location" w3-toggle-location nil]) 265 nil)
340 (if w3-running-xemacs 266 (if w3-running-xemacs
341 ["Show Status Bar" w3-toggle-minibuffer 267 ["Show Status Bar" w3-toggle-minibuffer
342 :style toggle 268 :style toggle :selected nil]
343 :selected (eq (frame-property (selected-frame) 'minibuffer) t) 269 nil)
344 ])
345 ["Incremental Display" 270 ["Incremental Display"
346 (setq w3-do-incremental-display (not w3-do-incremental-display)) 271 (setq w3-do-incremental-display (not w3-do-incremental-display))
347 :style toggle :selected w3-do-incremental-display] 272 :style toggle :selected w3-do-incremental-display]
348 "----" 273 "----"
349 ["Auto Load Images" 274 ["Auto Load Images"
367 (list 292 (list
368 "Style" 293 "Style"
369 ["Allow Document Stylesheets" (setq w3-honor-stylesheets 294 ["Allow Document Stylesheets" (setq w3-honor-stylesheets
370 (not w3-honor-stylesheets)) 295 (not w3-honor-stylesheets))
371 :style toggle :selected w3-honor-stylesheets] 296 :style toggle :selected w3-honor-stylesheets]
297 ["IE 3.0 Compatible Parsing" (setq w3-style-ie-compatibility
298 (not w3-style-ie-compatibility))
299 :style toggle :selected (and w3-honor-stylesheets
300 w3-style-ie-compatibility)]
372 ["Honor Color Requests" (setq w3-user-colors-take-precedence 301 ["Honor Color Requests" (setq w3-user-colors-take-precedence
373 (not w3-user-colors-take-precedence)) 302 (not w3-user-colors-take-precedence))
374 :style toggle :selected (not w3-user-colors-take-precedence)] 303 :style toggle :selected (not w3-user-colors-take-precedence)]
375 "---" 304 "---"
376 ["Reload Stylesheets" w3-refresh-stylesheets t] 305 ["Reload Stylesheets" w3-refresh-stylesheets t]
384 ["List All Buffers" list-buffers t] 313 ["List All Buffers" list-buffers t]
385 "--!here") 314 "--!here")
386 nil) 315 nil)
387 "W3 menu buffer list.") 316 "W3 menu buffer list.")
388 317
389 (defconst w3-menu-search-menu
390 (list
391 "Search"
392 ["Yahoo!" (w3-fetch "http://www.yahoo.com/") t]
393 ["Excite" (w3-fetch "http://www.excite.com/") t]
394 ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t]
395 "---"
396 )
397 "W3 search menu")
398
399 (defconst w3-menu-emacs-button 318 (defconst w3-menu-emacs-button
400 (vector 319 (vector
401 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t)) 320 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
402 321
403 (defconst w3-menu-help-menu 322 (defconst w3-menu-help-menu
404 (list 323 (list
405 "Help" 324 "Help"
406 ["About Emacs-w3" (w3-fetch "about:") t] 325 ["About Emacs-w3" (w3-fetch "about:") t]
407 ["Manual" (w3-fetch (concat w3-documentation-root "docs/w3_toc.html")) t] 326 ["Manual" (w3-fetch (concat w3-documentation-root "w3_toc.html")) t]
408 "---" 327 "---"
409 ["Version Information..." 328 ["Version Information..."
410 (w3-fetch 329 (w3-fetch
411 (concat w3-documentation-root "help/version_" w3-version-number ".html")) 330 (concat w3-documentation-root "help_on_" w3-version-number ".html"))
412 t] 331 t]
413 ["On FAQ" (w3-fetch (concat w3-documentation-root "help/FAQ.html")) t] 332 ["On Window" (w3-fetch (concat w3-documentation-root "help/window.html")) t]
333 ["On FAQ" (w3-fetch (concat w3-documentation-root"help/FAQ.html")) t]
414 "---" 334 "---"
415 ["Mail Developer(s)" w3-submit-bug t] 335 ["Mail Developer(s)" w3-submit-bug t]
416 ) 336 )
417 "W3 menu help list.") 337 "W3 menu help list.")
418 338
441 w3-menu-view-menu) 361 w3-menu-view-menu)
442 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil 362 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil
443 w3-menu-options-menu) 363 w3-menu-options-menu)
444 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil 364 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
445 w3-menu-style-menu) 365 w3-menu-style-menu)
446 (easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil
447 w3-menu-search-menu)
448 366
449 ;; block the global menubar entries in the map so that W3 367 ;; block the global menubar entries in the map so that W3
450 ;; can take over the menubar if necessary. 368 ;; can take over the menubar if necessary.
451 (define-key map [rootmenu] (make-sparse-keymap)) 369 (define-key map [rootmenu] (make-sparse-keymap))
452 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3"))) 370 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3")))
478 (cons "Options" w3-menu-fsfemacs-options-menu)) 396 (cons "Options" w3-menu-fsfemacs-options-menu))
479 (view 397 (view
480 (cons "View" w3-menu-fsfemacs-view-menu)) 398 (cons "View" w3-menu-fsfemacs-view-menu))
481 (style 399 (style
482 (cons "Style" w3-menu-fsfemacs-style-menu)) 400 (cons "Style" w3-menu-fsfemacs-style-menu))
483 (search
484 (cons "Search" w3-menu-fsfemacs-search-menu))
485 (emacs 401 (emacs
486 ;; FIXME!!! Currently, win32 doesn't support buttons 402 (cons "[Emacs]" 'w3-menu-toggle-menubar))))
487 ;; in menubars, so we hack around it and ignore the
488 ;; 'emacs keyword on that platform. REMOVE THIS CODE
489 ;; as soon as that is fixed. 19.35 timeframe?
490 (if (eq (device-type) 'win32)
491 nil
492 (cons "[Emacs]" 'w3-menu-toggle-menubar)))))
493 cons 403 cons
494 (vec (vector 'rootmenu 'w3 nil)) 404 (vec (vector 'rootmenu 'w3 nil))
495 ;; menus appear in the opposite order that we 405 ;; menus appear in the opposite order that we
496 ;; define-key them. 406 ;; define-key them.
497 (menu-list 407 (menu-list
522 (emacs . w3-menu-emacs-button) 432 (emacs . w3-menu-emacs-button)
523 (file . w3-menu-file-menu) 433 (file . w3-menu-file-menu)
524 (go . w3-menu-go-menu) 434 (go . w3-menu-go-menu)
525 (help . w3-menu-help-menu) 435 (help . w3-menu-help-menu)
526 (options . w3-menu-options-menu) 436 (options . w3-menu-options-menu)
527 (search . w3-menu-search-menu)
528 (view . w3-menu-view-menu) 437 (view . w3-menu-view-menu)
529 ) 438 )
530 ) 439 )
531 cons 440 cons
532 (menubar nil) 441 (menubar nil)
646 ps-print-color-p 555 ps-print-color-p
647 url-automatic-caching 556 url-automatic-caching
648 url-be-asynchronous 557 url-be-asynchronous
649 url-honor-refresh-requests 558 url-honor-refresh-requests
650 url-privacy-level 559 url-privacy-level
651 url-cookie-confirmation
652 url-proxy-services 560 url-proxy-services
653 url-standalone-mode 561 url-standalone-mode
562 url-use-hypertext-dired
654 url-use-hypertext-gopher 563 url-use-hypertext-gopher
564 w3-color-filter
565 w3-color-use-reducing
655 w3-default-homepage 566 w3-default-homepage
656 w3-default-stylesheet 567 w3-default-stylesheet
657 w3-delay-image-loads 568 w3-delay-image-loads
658 w3-do-incremental-display 569 w3-do-incremental-display
659 w3-dump-to-disk 570 w3-dump-to-disk
571 w3-file-done-hook
572 w3-file-prepare-hook
660 w3-honor-stylesheets 573 w3-honor-stylesheets
661 w3-image-mappings 574 w3-image-mappings
662 w3-load-hook 575 w3-load-hook
663 w3-mode-hook 576 w3-mode-hook
664 w3-netscape-compatible-comments 577 w3-netscape-compatible-comments
665 w3-preferences-cancel-hook 578 w3-preferences-cancel-hook
666 w3-preferences-default-hook 579 w3-preferences-default-hook
667 w3-preferences-ok-hook 580 w3-preferences-ok-hook
668 w3-preferences-setup-hook 581 w3-preferences-setup-hook
669 w3-source-file-hook 582 w3-source-file-hook
583 w3-style-ie-compatibility
670 w3-toolbar-orientation 584 w3-toolbar-orientation
671 w3-toolbar-type 585 w3-toolbar-type
672 w3-use-menus 586 w3-use-menus
673 w3-user-colors-take-precedence 587 w3-user-colors-take-precedence
674 ) 588 )
688 (fset 'event-glyph 'ignore)) 602 (fset 'event-glyph 'ignore))
689 603
690 (defun w3-popup-menu (e) 604 (defun w3-popup-menu (e)
691 "Pop up a menu of common w3 commands" 605 "Pop up a menu of common w3 commands"
692 (interactive "e") 606 (interactive "e")
693 (if (not w3-popup-menu-on-mouse-3) 607 (mouse-set-point e)
694 (call-interactively (lookup-key global-map (vector w3-mouse-button3))) 608 (let* ((glyph (event-glyph e))
695 (mouse-set-point e) 609 (widget (or (and glyph (glyph-property glyph 'widget))
696 (let* ((glyph (event-glyph e)) 610 (widget-at (point))))
697 (widget (or (and glyph (glyph-property glyph 'widget)) 611 (href (and widget (widget-get widget 'href)))
698 (widget-at (point)))) 612 (imag (and widget (widget-get widget 'src)))
699 (parent (and widget (widget-get widget :parent))) 613 (menu (copy-tree w3-popup-menu))
700 (href (or (and widget (widget-get widget 'href)) 614 url val trunc-url)
701 (and parent (widget-get parent 'href)))) 615 (if href
702 (imag (or (and widget (widget-get widget 'src)) 616 (progn
703 (and parent (widget-get parent 'src)))) 617 (setq url href)
704 (menu (copy-tree w3-popup-menu)) 618 (if url (setq trunc-url (url-truncate-url-for-viewing
705 url val trunc-url) 619 url
706 (if href 620 w3-max-menu-width)))
707 (progn
708 (setq url href)
709 (if url (setq trunc-url (url-truncate-url-for-viewing
710 url
711 w3-max-menu-width)))
712 (setcdr menu (append (cdr menu)
713 '("---")
714 (mapcar
715 (function
716 (lambda (x)
717 (vector (format (car x) trunc-url)
718 (list (cdr x) url) t)))
719 w3-hyperlink-menu)))))
720 (if imag
721 (progn
722 (setq url imag
723 trunc-url (url-truncate-url-for-viewing url
724 w3-max-menu-width))
725 (setcdr menu (append (cdr menu)
726 '("---")
727 (mapcar
728 (function
729 (lambda (x)
730 (vector (format (car x) trunc-url)
731 (list (cdr x) url) t)))
732 w3-graphlink-menu)))))
733 (if (not (w3-menubar-active))
734 (setcdr menu (append (cdr menu) 621 (setcdr menu (append (cdr menu)
735 '("---" ["Show Menubar" w3-toggle-menubar t])))) 622 '("---")
736 (popup-menu menu)))) 623 (mapcar
624 (function
625 (lambda (x)
626 (vector (format (car x) trunc-url)
627 (list (cdr x) url) t)))
628 w3-hyperlink-menu)))))
629 (if imag
630 (progn
631 (setq url imag
632 trunc-url (url-truncate-url-for-viewing url
633 w3-max-menu-width))
634 (setcdr menu (append (cdr menu)
635 '("---")
636 (mapcar
637 (function
638 (lambda (x)
639 (vector (format (car x) trunc-url)
640 (list (cdr x) url) t)))
641 w3-graphlink-menu)))))
642 (if (not (w3-menubar-active))
643 (setcdr menu (append (cdr menu)
644 '("---" ["Show Menubar" w3-toggle-menubar t]))))
645 (popup-menu menu)))
737 646
738 (provide 'w3-menu) 647 (provide 'w3-menu)