Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-menu.el @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents ac2d302a0011
children 0293115a14e9
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
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: 1996/07/21 18:29:01 3 ;; Created: 1996/12/31 15:37:49
4 ;; Version: 1.7 4 ;; Version: 1.19
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 Free Software Foundation, Inc.
9 ;;; 10 ;;;
10 ;;; This file is part of GNU Emacs. 11 ;;; This file is part of GNU Emacs.
11 ;;; 12 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by 14 ;;; it under the terms of the GNU General Public License as published by
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details. 21 ;;; GNU General Public License for more details.
21 ;;; 22 ;;;
22 ;;; You should have received a copy of the GNU General Public License 23 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 28
27 (require 'w3-vars) 29 (require 'w3-vars)
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;;; Spiffy new menus (for both Emacs and XEmacs) 31 ;;; Spiffy new menus (for both Emacs and XEmacs)
35 (defvar w3-menu-fsfemacs-go-menu nil) 37 (defvar w3-menu-fsfemacs-go-menu nil)
36 (defvar w3-menu-fsfemacs-help-menu nil) 38 (defvar w3-menu-fsfemacs-help-menu nil)
37 (defvar w3-menu-fsfemacs-view-menu nil) 39 (defvar w3-menu-fsfemacs-view-menu nil)
38 (defvar w3-menu-fsfemacs-options-menu nil) 40 (defvar w3-menu-fsfemacs-options-menu nil)
39 (defvar w3-menu-fsfemacs-style-menu nil) 41 (defvar w3-menu-fsfemacs-style-menu nil)
42 (defvar w3-menu-fsfemacs-search-menu nil)
40 (defvar w3-menu-w3-menubar nil) 43 (defvar w3-menu-w3-menubar nil)
41 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.") 44 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
42 (make-variable-buffer-local 'w3-links-menu) 45 (make-variable-buffer-local 'w3-links-menu)
43 46
44 (defvar w3-use-menus '(file edit view go bookmark options 47 (defvar w3-use-menus '(file edit view go bookmark options
58 go -- Navigation control 61 go -- Navigation control
59 bookmark -- Bookmark / hotlist control 62 bookmark -- Bookmark / hotlist control
60 options -- Various options 63 options -- Various options
61 buffers -- The standard buffers menu 64 buffers -- The standard buffers menu
62 emacs -- A toggle button to switch back to normal emacs menus 65 emacs -- A toggle button to switch back to normal emacs menus
63 style -- Control fonts and who gets to set them 66 style -- Control style information and who gets to set what
64 help -- The help 67 search -- Various search engines
68 help -- The help menu
65 nil -- ** special ** 69 nil -- ** special **
66 70
67 If nil appears in the list, it should appear exactly once. All 71 If nil appears in the list, it should appear exactly once. All
68 menus after nil in the list will be displayed flushright in the 72 menus after nil in the list will be displayed flushright in the
69 menubar.") 73 menubar.")
76 (setq hot-menu (cons (vector 80 (setq hot-menu (cons (vector
77 (w3-truncate-menu-item (car (car hot))) 81 (w3-truncate-menu-item (car (car hot)))
78 (list 'w3-fetch (car (cdr (car hot)))) 82 (list 'w3-fetch (car (cdr (car hot))))
79 t) hot-menu) 83 t) hot-menu)
80 hot (cdr hot))) 84 hot (cdr hot)))
81 (or hot-menu '(["No Hotlist" undefined nil]))))) 85 (or hot-menu '(["No Hotlist" nil nil])))))
86
87 (defun w3-menu-html-links-constructor (menu-items)
88 (or menu-items
89 (let ((links (mapcar 'cdr w3-current-links))
90 (menu nil))
91 (if links
92 (setq links (delete*
93 nil
94 (reduce 'append links)
95 :test-not (function
96 (lambda (a b) ; arg order unknown
97 (member
98 (car (or a b))
99 w3-defined-link-types))))))
100 (while links
101 (let ((name (caar links))
102 (vals (cdar links))
103 (href nil)
104 (new nil))
105 (if (= (length vals) 1)
106 (setq vals (car vals)
107 new (vector (or (plist-get vals 'title)
108 (capitalize name))
109 (list 'w3-fetch (plist-get vals 'href)) t))
110 (setq new (cons (capitalize name)
111 (mapcar (function
112 (lambda (x)
113 (setq href (plist-get x 'href))
114 (vector (or (plist-get x 'title) href)
115 (list 'w3-fetch href) t)))
116 vals))))
117 (setq links (cdr links)
118 menu (cons new menu))))
119 (or menu '(["None" nil nil])))))
82 120
83 (defun w3-menu-links-constructor (menu-items) 121 (defun w3-menu-links-constructor (menu-items)
84 (or menu-items 122 (or menu-items
85 (let ((widgets (w3-only-links)) 123 (let ((widgets (w3-only-links))
86 widget href menu) 124 widget href menu)
88 (setq widget (car widgets) 126 (setq widget (car widgets)
89 widgets (cdr widgets) 127 widgets (cdr widgets)
90 href (widget-get widget 'href) 128 href (widget-get widget 'href)
91 menu (cons 129 menu (cons
92 (vector (w3-truncate-menu-item 130 (vector (w3-truncate-menu-item
93 (w3-fix-spaces 131 (or (widget-get widget 'title)
94 (buffer-substring 132 (w3-fix-spaces
95 (widget-get widget :from) 133 (buffer-substring
96 (widget-get widget :to)))) 134 (widget-get widget :from)
135 (widget-get widget :to)))))
97 (list 'url-maybe-relative href) t) menu))) 136 (list 'url-maybe-relative href) t) menu)))
98 (setq menu (w3-breakup-menu menu w3-max-menu-length)) 137 (setq menu (w3-breakup-menu menu w3-max-menu-length))
99 (or menu '(["No Links" undefined nil]))))) 138 (or menu '(["No Links" nil nil])))))
100 139
101 (defun w3-toggle-minibuffer () 140 (defun w3-toggle-minibuffer ()
102 (interactive) 141 (interactive)
103 (cond 142 (cond
104 (w3-running-xemacs 143 (w3-running-xemacs
215 (list 254 (list
216 "Debugging" 255 "Debugging"
217 ["View Parse Tree" (w3-display-parse-tree w3-current-parse) 256 ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
218 w3-current-parse] 257 w3-current-parse]
219 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet] 258 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
259 ["Reload Stylesheets" w3-refresh-stylesheets t]
220 ) 260 )
221 "W3 menu debug list.") 261 "W3 menu debug list.")
222 262
223 (defconst w3-menu-go-menu 263 (defconst w3-menu-go-menu
224 (list 264 (list
228 ["Home" w3 w3-default-homepage] 268 ["Home" w3 w3-default-homepage]
229 ["View History..." w3-show-history-list url-keep-history] 269 ["View History..." w3-show-history-list url-keep-history]
230 "----" 270 "----"
231 (if w3-running-xemacs 271 (if w3-running-xemacs
232 '("Links" :filter w3-menu-links-constructor) 272 '("Links" :filter w3-menu-links-constructor)
233 ["Link..." w3-e19-show-links-menu t]) 273 ["Links..." w3-e19-show-links-menu t])
274 (if w3-running-xemacs
275 '("Navigate" :filter w3-menu-html-links-constructor)
276 ["Navigate..." w3-e19-show-navigate-menu t])
234 ) 277 )
235 "W3 menu go list.") 278 "W3 menu go list.")
236 279
237 (defconst w3-menu-bookmark-menu 280 (defconst w3-menu-bookmark-menu
238 (list 281 (list
292 (list 335 (list
293 "Style" 336 "Style"
294 ["Allow Document Stylesheets" (setq w3-honor-stylesheets 337 ["Allow Document Stylesheets" (setq w3-honor-stylesheets
295 (not w3-honor-stylesheets)) 338 (not w3-honor-stylesheets))
296 :style toggle :selected w3-honor-stylesheets] 339 :style toggle :selected w3-honor-stylesheets]
297 ["IE 3.0 Compatible Parsing" (setq w3-style-ie-compatibility 340 ["IE 3.0 Compatible Parsing" (setq css-ie-compatibility
298 (not w3-style-ie-compatibility)) 341 (not css-ie-compatibility))
299 :style toggle :selected (and w3-honor-stylesheets 342 :style toggle :selected (and w3-honor-stylesheets
300 w3-style-ie-compatibility)] 343 css-ie-compatibility)]
301 ["Honor Color Requests" (setq w3-user-colors-take-precedence 344 ["Honor Color Requests" (setq w3-user-colors-take-precedence
302 (not w3-user-colors-take-precedence)) 345 (not w3-user-colors-take-precedence))
303 :style toggle :selected (not w3-user-colors-take-precedence)] 346 :style toggle :selected (not w3-user-colors-take-precedence)]
304 "---" 347 "---"
305 ["Reload Stylesheets" w3-refresh-stylesheets t] 348 ["Reload Stylesheets" w3-refresh-stylesheets t]
312 :filter buffers-menu-filter 355 :filter buffers-menu-filter
313 ["List All Buffers" list-buffers t] 356 ["List All Buffers" list-buffers t]
314 "--!here") 357 "--!here")
315 nil) 358 nil)
316 "W3 menu buffer list.") 359 "W3 menu buffer list.")
360
361 (defconst w3-menu-search-menu
362 (list
363 "Search"
364 ["Yahoo!" (w3-fetch "http://www.yahoo.com/") t]
365 ["Excite" (w3-fetch "http://www.excite.com/") t]
366 ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t]
367 "---"
368 )
369 "W3 search menu")
317 370
318 (defconst w3-menu-emacs-button 371 (defconst w3-menu-emacs-button
319 (vector 372 (vector
320 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t)) 373 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
321 374
361 w3-menu-view-menu) 414 w3-menu-view-menu)
362 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil 415 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil
363 w3-menu-options-menu) 416 w3-menu-options-menu)
364 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil 417 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
365 w3-menu-style-menu) 418 w3-menu-style-menu)
419 (easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil
420 w3-menu-search-menu)
366 421
367 ;; block the global menubar entries in the map so that W3 422 ;; block the global menubar entries in the map so that W3
368 ;; can take over the menubar if necessary. 423 ;; can take over the menubar if necessary.
369 (define-key map [rootmenu] (make-sparse-keymap)) 424 (define-key map [rootmenu] (make-sparse-keymap))
370 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3"))) 425 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3")))
396 (cons "Options" w3-menu-fsfemacs-options-menu)) 451 (cons "Options" w3-menu-fsfemacs-options-menu))
397 (view 452 (view
398 (cons "View" w3-menu-fsfemacs-view-menu)) 453 (cons "View" w3-menu-fsfemacs-view-menu))
399 (style 454 (style
400 (cons "Style" w3-menu-fsfemacs-style-menu)) 455 (cons "Style" w3-menu-fsfemacs-style-menu))
456 (search
457 (cons "Search" w3-menu-fsfemacs-search-menu))
401 (emacs 458 (emacs
402 (cons "[Emacs]" 'w3-menu-toggle-menubar)))) 459 (cons "[Emacs]" 'w3-menu-toggle-menubar))))
403 cons 460 cons
404 (vec (vector 'rootmenu 'w3 nil)) 461 (vec (vector 'rootmenu 'w3 nil))
405 ;; menus appear in the opposite order that we 462 ;; menus appear in the opposite order that we
432 (emacs . w3-menu-emacs-button) 489 (emacs . w3-menu-emacs-button)
433 (file . w3-menu-file-menu) 490 (file . w3-menu-file-menu)
434 (go . w3-menu-go-menu) 491 (go . w3-menu-go-menu)
435 (help . w3-menu-help-menu) 492 (help . w3-menu-help-menu)
436 (options . w3-menu-options-menu) 493 (options . w3-menu-options-menu)
494 (search . w3-menu-search-menu)
437 (view . w3-menu-view-menu) 495 (view . w3-menu-view-menu)
438 ) 496 )
439 ) 497 )
440 cons 498 cons
441 (menubar nil) 499 (menubar nil)
578 w3-preferences-cancel-hook 636 w3-preferences-cancel-hook
579 w3-preferences-default-hook 637 w3-preferences-default-hook
580 w3-preferences-ok-hook 638 w3-preferences-ok-hook
581 w3-preferences-setup-hook 639 w3-preferences-setup-hook
582 w3-source-file-hook 640 w3-source-file-hook
583 w3-style-ie-compatibility 641 css-ie-compatibility
584 w3-toolbar-orientation 642 w3-toolbar-orientation
585 w3-toolbar-type 643 w3-toolbar-type
586 w3-use-menus 644 w3-use-menus
587 w3-user-colors-take-precedence 645 w3-user-colors-take-precedence
588 ) 646 )
606 (interactive "e") 664 (interactive "e")
607 (mouse-set-point e) 665 (mouse-set-point e)
608 (let* ((glyph (event-glyph e)) 666 (let* ((glyph (event-glyph e))
609 (widget (or (and glyph (glyph-property glyph 'widget)) 667 (widget (or (and glyph (glyph-property glyph 'widget))
610 (widget-at (point)))) 668 (widget-at (point))))
611 (href (and widget (widget-get widget 'href))) 669 (parent (and widget (widget-get widget :parent)))
612 (imag (and widget (widget-get widget 'src))) 670 (href (or (and widget (widget-get widget 'href))
671 (and parent (widget-get parent 'href))))
672 (imag (or (and widget (widget-get widget 'src))
673 (and parent (widget-get parent 'src))))
613 (menu (copy-tree w3-popup-menu)) 674 (menu (copy-tree w3-popup-menu))
614 url val trunc-url) 675 url val trunc-url)
615 (if href 676 (if href
616 (progn 677 (progn
617 (setq url href) 678 (setq url href)