Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-menu.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; $RCSFile: w3-menu.el,v $ --- menu functions for emacs-w3
2 ;; Author: wmperry
3 ;; Created: 1996/06/03 17:35:14
4 ;; Version: 1.28
5 ;; Keywords: menu, hypermedia
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.com)
9 ;;;
10 ;;; This file is part of GNU Emacs.
11 ;;;
12 ;;; 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 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version.
16 ;;;
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; 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 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27 (require 'w3-vars)
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;;; Spiffy new menus (for both Emacs and XEmacs)
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 (defvar w3-menu-fsfemacs-bookmark-menu nil)
32 (defvar w3-menu-fsfemacs-debug-menu nil)
33 (defvar w3-menu-fsfemacs-edit-menu nil)
34 (defvar w3-menu-fsfemacs-file-menu nil)
35 (defvar w3-menu-fsfemacs-go-menu nil)
36 (defvar w3-menu-fsfemacs-help-menu nil)
37 (defvar w3-menu-fsfemacs-view-menu nil)
38 (defvar w3-menu-fsfemacs-options-menu nil)
39 (defvar w3-menu-fsfemacs-style-menu nil)
40 (defvar w3-menu-w3-menubar nil)
41 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
42 (make-variable-buffer-local 'w3-links-menu)
43
44 (defvar w3-use-menus '(file edit view go bookmark options
45 buffers style emacs nil help)
46 "*Non-nil value causes W3 to provide a menu interface.
47 A value that is a list causes W3 to install its own menubar.
48 A value of 1 causes W3 to install a \"W3\" item in the Emacs menubar.
49
50 If the value of w3-use-menus is a list, it should be a list of symbols.
51 The symbols and the order that they are listed determine what menus
52 will be in the menubar and how they are ordered. Valid symbol values
53 are:
54
55 file -- A list of file related commands
56 edit -- Various standard editing commands (copy/paste)
57 view -- Controlling various things about the document view
58 go -- Navigation control
59 bookmark -- Bookmark / hotlist control
60 options -- Various options
61 buffers -- The standard buffers menu
62 emacs -- A toggle button to switch back to normal emacs menus
63 style -- Control fonts and who gets to set them
64 help -- The help
65 nil -- ** special **
66
67 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
69 menubar.")
70
71 (defun w3-menu-hotlist-constructor (menu-items)
72 (or (cdr w3-html-bookmarks)
73 (let ((hot-menu nil)
74 (hot w3-hotlist))
75 (while hot
76 (setq hot-menu (cons (vector
77 (w3-truncate-menu-item (car (car hot)))
78 (list 'w3-fetch (car (cdr (car hot))))
79 t) hot-menu)
80 hot (cdr hot)))
81 (or hot-menu '(["No Hotlist" undefined nil])))))
82
83 (defun w3-menu-links-constructor (menu-items)
84 (or menu-items
85 (let ((widgets (w3-only-links))
86 widget href menu)
87 (while widgets
88 (setq widget (car widgets)
89 widgets (cdr widgets)
90 href (widget-get widget 'href)
91 menu (cons
92 (vector (w3-truncate-menu-item
93 (w3-fix-spaces
94 (buffer-substring
95 (widget-get widget :from)
96 (widget-get widget :to))))
97 (list 'url-maybe-relative href) t) menu)))
98 (setq menu (w3-breakup-menu menu w3-max-menu-length))
99 (or menu '(["No Links" undefined nil])))))
100
101 (defun w3-toggle-minibuffer ()
102 (interactive)
103 (cond
104 (w3-running-xemacs
105 (set-frame-property (selected-frame) 'minibuffer
106 (not (frame-property (selected-frame) 'minibuffer))))
107 (t nil)))
108
109 (defun w3-toggle-location ()
110 (interactive)
111 (cond
112 (w3-running-xemacs
113 (let ((on (specifier-instance has-modeline-p (selected-window))))
114 (set-specifier has-modeline-p (not on) (selected-window))))
115 (t nil)))
116
117 (defun w3-toggle-menubar ()
118 (interactive)
119 (cond
120 ;; XEmacs style
121 ((and w3-running-xemacs (w3-menubar-active))
122 ;; Turn the menubar off
123 (setq current-menubar nil))
124 (w3-running-xemacs
125 ;; Turn the menubar on
126 (w3-menu-install-menus))
127 ;; Emacs 19 style
128 (t
129 (menu-bar-mode (if (w3-menubar-active) -1 1)))))
130
131 (defun w3-location-active ()
132 (if w3-running-xemacs
133 (specifier-instance has-modeline-p (selected-window))
134 t))
135
136 (defun w3-menubar-active ()
137 (if w3-running-xemacs
138 (and (featurep 'menubar) current-menubar)
139 (and (boundp 'menu-bar-mode) menu-bar-mode)))
140
141 (defun w3-menu-global-menubar ()
142 (if w3-running-xemacs
143 (default-value 'default-menubar)
144 (lookup-key (current-global-map) [menu-bar])))
145
146 (defconst w3-menu-file-menu
147 (list
148 "File"
149 ["Open Location..." w3-fetch t]
150 ["Open File..." w3-open-local t]
151 ["Open in New Window..." w3-fetch-other-frame t]
152 ["New Window" make-frame t]
153 "---"
154 ["Save" save-buffer t nil]
155 (list
156 "Save As..."
157 ["HTML" (w3-save-as "HTML Source") t]
158 ["Formatted Text" (w3-save-as "Formatted Text") t]
159 ["LaTeX" (w3-save-as "LaTeX Source") t]
160 ["PostScript" (w3-save-as "PostScript") t]
161 ["Binary" (w3-save-as "Binary") t]
162 )
163 "---"
164 (list
165 "Print As..."
166 ["PostScript" (w3-print-this-url nil "PostScript") t]
167 ["Formatted Text" (w3-print-this-url nil "Formatted Text") t]
168 ["HTML Source" (w3-print-this-url nil "HTML Source") t]
169 ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t]
170 )
171 (list
172 "Mail Document..."
173 ["HTML" (w3-mail-current-document nil "HTML Source") t]
174 ["Formatted Text" (w3-mail-current-document nil "Formatted Text") t]
175 ["PostScript" (w3-mail-current-document nil "PostScript") t]
176 ["LaTeX Source" (w3-mail-current-document nil "LaTeX Source") t]
177 )
178 ["Add Annotation" w3-annotation-add w3-personal-annotation-directory]
179 (if w3-running-xemacs
180 "---:shadowDoubleEtchedIn"
181 "---")
182 ["Close" delete-frame (not (eq (next-frame) (selected-frame)))]
183 ["Exit" save-buffers-kill-emacs t]
184 )
185 "W3 file menu list.")
186
187 (defconst w3-menu-edit-menu
188 (list
189 "Edit"
190 ["Undo" advertised-undo nil]
191 ["Cut" kill-region nil]
192 ["Copy" copy-region-as-kill t]
193 "----"
194 ["Search..." w3-search-forward t]
195 ["Search Again..." w3-search-again w3-last-search-item]
196 )
197 "W3 edit menu list.")
198
199 (defconst w3-menu-view-menu
200 (list
201 "View"
202 ["Document Information" w3-document-information t]
203 ["Document Source" w3-source-document t]
204 ["Load Images" w3-load-delayed-images w3-delayed-images]
205 "----"
206 ["Refresh" w3-refresh-buffer w3-current-parse]
207 ["Reload" w3-reload-document (and (url-view-url t)
208 (not (equal (url-view-url t) "")))]
209 "----"
210 ["Show URL" url-view-url t]
211 ["Show URL At Point" w3-view-this-url t]
212 "----"
213 )
214 "W3 menu view list.")
215
216 (defconst w3-menu-debug-menu
217 (list
218 "Debugging"
219 ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
220 w3-current-parse]
221 ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
222 )
223 "W3 menu debug list.")
224
225 (defconst w3-menu-go-menu
226 (list
227 "Go"
228 ["Forward" w3-forward-in-history t]
229 ["Backward" w3-backward-in-history t]
230 ["Home" w3 w3-default-homepage]
231 ["View History..." w3-show-history-list url-keep-history]
232 "----"
233 (if w3-running-xemacs
234 '("Links" :filter w3-menu-links-constructor)
235 ["Link..." w3-e19-show-links-menu t])
236 )
237 "W3 menu go list.")
238
239 (defconst w3-menu-bookmark-menu
240 (list
241 "Bookmark"
242 ["View Bookmarks..." w3-show-hotlist w3-hotlist]
243 ["Add Bookmark" w3-hotlist-add-document t]
244 ["Delete Bookmark" w3-hotlist-delete t]
245 ["Rename Bookmark" w3-hotlist-rename-entry t]
246 ["Append Bookmark List" w3-hotlist-append t]
247 "----"
248 (if w3-running-xemacs
249 '("Bookmarks" :filter w3-menu-hotlist-constructor)
250 ["Bookmarks" w3-e19-show-hotlist-menu t])
251 )
252 "W3 menu bookmark list.")
253
254 (defconst w3-menu-options-menu
255 (list "Options"
256 ["Show Menubar" w3-toggle-menubar
257 :style toggle :selected (w3-menubar-active)]
258 (if (and w3-running-xemacs (featurep 'toolbar))
259 ["Show Toolbar" w3-toggle-toolbar
260 :style toggle :selected (w3-toolbar-active)]
261 nil)
262 (if w3-running-xemacs
263 ["Show Location" w3-toggle-location
264 :style toggle :selected (w3-location-active)]
265 nil)
266 (if w3-running-xemacs
267 ["Show Status Bar" w3-toggle-minibuffer
268 :style toggle :selected nil]
269 nil)
270 ["Incremental Display"
271 (setq w3-do-incremental-display (not w3-do-incremental-display))
272 :style toggle :selected w3-do-incremental-display]
273 "----"
274 ["Auto Load Images"
275 (setq w3-delay-image-loads (not w3-delay-image-loads))
276 :style toggle :selected (not w3-delay-image-loads)]
277 ["Flush Image Cache" (setq w3-graphics-list nil) w3-graphics-list]
278 "----"
279 ["Privacy Mode" (progn
280 (setq url-privacy-level
281 (if (eq 'paranoid url-privacy-level)
282 'none
283 'paranoid))
284 (url-setup-privacy-info))
285 :style toggle :selected (not (eq url-privacy-level 'none))]
286 ["Color Printing" (setq ps-print-color-p (not ps-print-color-p))
287 :style toggle :selected (and (boundp 'ps-print-color-p)
288 ps-print-color-p)]
289 ["Honor Automatic Refreshes"
290 (setq url-honor-refresh-requests (not url-honor-refresh-requests))
291 :style toggle :selected (not (null url-honor-refresh-requests))]
292 "----"
293 ["Download to disk" (setq w3-dump-to-disk (not w3-dump-to-disk))
294 :style toggle :selected w3-dump-to-disk]
295 ["Caching" (setq url-automatic-caching (not url-automatic-caching))
296 :style toggle :selected url-automatic-caching]
297 ["Use Cache Only"
298 (setq url-standalone-mode (not url-standalone-mode))
299 :style toggle :selected url-standalone-mode]
300 "----"
301 ["Fancy Gopher"
302 (setq url-use-hypertext-gopher (not url-use-hypertext-gopher))
303 :style toggle :selected url-use-hypertext-gopher]
304 ["Fancy Directory Listings"
305 (setq url-use-hypertext-dired (not url-use-hypertext-dired))
306 :style toggle :selected url-use-hypertext-dired]
307 "----"
308 ["Save Options" w3-menu-save-options t]
309 )
310 "W3 menu options list.")
311
312 (defconst w3-menu-style-menu
313 (list
314 "Style"
315 ["Allow Document Stylesheets" (setq w3-honor-stylesheets
316 (not w3-honor-stylesheets))
317 :style toggle :selected w3-honor-stylesheets]
318 ["IE 3.0 Compatible Parsing" (setq w3-style-ie-compatibility
319 (not w3-style-ie-compatibility))
320 :style toggle :selected (and w3-honor-stylesheets
321 w3-style-ie-compatibility)]
322 ["Honor Color Requests" (setq w3-user-colors-take-precedence
323 (not w3-user-colors-take-precedence))
324 :style toggle :selected (not w3-user-colors-take-precedence)]
325 )
326 "W3 menu style list.")
327
328 (defconst w3-menu-buffer-menu
329 (if w3-running-xemacs
330 '("Buffers"
331 :filter buffers-menu-filter
332 ["List All Buffers" list-buffers t]
333 "--!here")
334 nil)
335 "W3 menu buffer list.")
336
337 (defconst w3-menu-emacs-button
338 (vector
339 (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
340
341 (defconst w3-menu-help-menu
342 (list
343 "Help"
344 ["About Emacs-w3" (w3-fetch "about:") t]
345 ["Manual" (w3-fetch (concat w3-documentation-root "w3_toc.html")) t]
346 "---"
347 ["Version Information..."
348 (w3-fetch
349 (concat w3-documentation-root "help_on_" w3-version-number ".html"))
350 t]
351 ["On Window" (w3-fetch (concat w3-documentation-root "help/window.html")) t]
352 ["On FAQ" (w3-fetch (concat w3-documentation-root"help/FAQ.html")) t]
353 "---"
354 ["Mail Developer(s)" w3-submit-bug t]
355 )
356 "W3 menu help list.")
357
358 (defvar w3-mode-menu-map nil)
359
360 (defun w3-menu-initialize-w3-mode-menu-map ()
361 (if (null w3-mode-menu-map)
362 (let ((map (make-sparse-keymap))
363 (dummy (make-sparse-keymap)))
364 (require 'easymenu)
365 ;; initialize all the w3-menu-fsfemacs-*-menu variables
366 ;; with the menus.
367 (easy-menu-define w3-menu-fsfemacs-bookmark-menu (list dummy) nil
368 w3-menu-bookmark-menu)
369 (easy-menu-define w3-menu-fsfemacs-debug-menu (list dummy) nil
370 w3-menu-debug-menu)
371 (easy-menu-define w3-menu-fsfemacs-edit-menu (list dummy) nil
372 w3-menu-edit-menu)
373 (easy-menu-define w3-menu-fsfemacs-file-menu (list dummy) nil
374 w3-menu-file-menu)
375 (easy-menu-define w3-menu-fsfemacs-go-menu (list dummy) nil
376 w3-menu-go-menu)
377 (easy-menu-define w3-menu-fsfemacs-help-menu (list dummy) nil
378 w3-menu-help-menu)
379 (easy-menu-define w3-menu-fsfemacs-view-menu (list dummy) nil
380 w3-menu-view-menu)
381 (easy-menu-define w3-menu-fsfemacs-options-menu (list dummy) nil
382 w3-menu-options-menu)
383 (easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
384 w3-menu-style-menu)
385
386 ;; block the global menubar entries in the map so that W3
387 ;; can take over the menubar if necessary.
388 (define-key map [rootmenu] (make-sparse-keymap))
389 (define-key map [rootmenu w3] (cons "W3" (make-sparse-keymap "W3")))
390 (define-key map [rootmenu w3 file] 'undefined)
391 (define-key map [rootmenu w3 files] 'undefined)
392 (define-key map [rootmenu w3 search] 'undefined)
393 (define-key map [rootmenu w3 edit] 'undefined)
394 (define-key map [rootmenu w3 options] 'undefined)
395 (define-key map [rootmenu w3 buffer] 'undefined)
396 (define-key map [rootmenu w3 tools] 'undefined)
397 (define-key map [rootmenu w3 help] 'undefined)
398 (define-key map [rootmenu w3 help-menu] 'undefined)
399 ;; now build W3's menu tree.
400 (let ((menu-alist
401 '(
402 (bookmark
403 (cons "Bookmark" w3-menu-fsfemacs-bookmark-menu))
404 (debug
405 (cons "Debug" w3-menu-fsfemacs-debug-menu))
406 (edit
407 (cons "Edit" w3-menu-fsfemacs-edit-menu))
408 (file
409 (cons "File" w3-menu-fsfemacs-file-menu))
410 (go
411 (cons "Go" w3-menu-fsfemacs-go-menu))
412 (help
413 (cons "Help" w3-menu-fsfemacs-help-menu))
414 (options
415 (cons "Options" w3-menu-fsfemacs-options-menu))
416 (view
417 (cons "View" w3-menu-fsfemacs-view-menu))
418 (style
419 (cons "Style" w3-menu-fsfemacs-style-menu))
420 (emacs
421 (cons "[Emacs]" 'w3-menu-toggle-menubar))))
422 cons
423 (vec (vector 'rootmenu 'w3 nil))
424 ;; menus appear in the opposite order that we
425 ;; define-key them.
426 (menu-list
427 (if (consp w3-use-menus)
428 (reverse w3-use-menus)
429 (list 'help nil 'emacs 'buffers 'options 'bookmark
430 'go 'view 'edit 'file))))
431 (while menu-list
432 (if (null (car menu-list))
433 nil;; no flushright support in FSF Emacs
434 (aset vec 2 (intern (concat "w3-menu-fsfemacs-"
435 (symbol-name
436 (car menu-list)) "-menu")))
437 (setq cons (assq (car menu-list) menu-alist))
438 (if cons
439 (define-key map vec (eval (car (cdr cons))))))
440 (setq menu-list (cdr menu-list))))
441 (setq w3-mode-menu-map map)
442 (run-hooks 'w3-menu-setup-hook))))
443
444 (defun w3-menu-make-xemacs-menubar ()
445 (let ((menu-alist
446 '((bookmark . w3-menu-bookmark-menu)
447 (style . w3-menu-style-menu)
448 (buffer . w3-menu-buffer-menu)
449 (debug . w3-menu-debug-menu)
450 (edit . w3-menu-edit-menu)
451 (emacs . w3-menu-emacs-button)
452 (file . w3-menu-file-menu)
453 (go . w3-menu-go-menu)
454 (help . w3-menu-help-menu)
455 (options . w3-menu-options-menu)
456 (view . w3-menu-view-menu)
457 )
458 )
459 cons
460 (menubar nil)
461 (menu-list w3-use-menus))
462 (while menu-list
463 (if (null (car menu-list))
464 (setq menubar (cons nil menubar))
465 (setq cons (assq (car menu-list) menu-alist))
466 (if cons
467 (setq menubar (cons (symbol-value (cdr cons)) menubar))))
468 (setq menu-list (cdr menu-list)))
469 (nreverse menubar)))
470
471 (defun w3-menu-install-menubar ()
472 (cond
473 (w3-running-xemacs
474 (if (not (featurep 'menubar))
475 nil ; No menus available
476 (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar))
477 (set-buffer-menubar w3-menu-w3-menubar)))
478 ((not (fboundp 'vm-menu-undo-menu))
479 (w3-menu-initialize-w3-mode-menu-map)
480 (define-key w3-mode-map [menu-bar]
481 (lookup-key w3-mode-menu-map [rootmenu w3])))))
482
483 (defun w3-menu-install-menubar-item ()
484 (cond
485 (w3-running-xemacs
486 (if (not (featurep 'menubar))
487 nil ; No menus available
488 (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
489 (add-menu nil "W3" (cdr w3-menu-w3-menubar))))
490 ((not (fboundp 'w3-menu-fsfemacs-edit-menu))
491 (w3-menu-initialize-w3-mode-menu-map)
492 (define-key w3-mode-map [menu-bar]
493 (lookup-key w3-mode-menu-map [rootmenu])))))
494
495 (defun w3-menu-install-menus ()
496 (cond ((consp w3-use-menus)
497 (w3-menu-install-menubar))
498 ((eq w3-use-menus 1)
499 (w3-menu-install-menubar-item))
500 (t nil)))
501
502 (defun w3-menu-set-menubar-dirty-flag ()
503 (cond (w3-running-xemacs
504 (set-menubar-dirty-flag))
505 (t
506 (force-mode-line-update))))
507
508 (defun w3-menu-toggle-menubar ()
509 (interactive)
510 (cond
511 ;;((eq w3-use-menus 1)
512 ;;nil)
513 (w3-running-xemacs
514 (if (null (car (find-menu-item current-menubar '("XEmacs"))))
515 (set-buffer-menubar w3-menu-w3-menubar)
516 (set-buffer-menubar (copy-sequence (w3-menu-global-menubar)))
517 (condition-case ()
518 (add-menu-button nil ["W3" w3-menu-toggle-menubar t] nil)
519 (void-function
520 (add-menu-item nil "W3" 'w3-menu-toggle-menubar t))))
521 (w3-menu-set-menubar-dirty-flag))
522 (t
523 (if (not (eq (lookup-key w3-mode-map [menu-bar])
524 (lookup-key w3-mode-menu-map [rootmenu w3])))
525 (define-key w3-mode-map [menu-bar]
526 (lookup-key w3-mode-menu-map [rootmenu w3]))
527 (define-key w3-mode-map [menu-bar]
528 (make-sparse-keymap))
529 (define-key w3-mode-map [menu-bar w3]
530 (cons "[W3]" 'w3-menu-toggle-menubar)))
531 (w3-menu-set-menubar-dirty-flag))))
532
533 (defun w3-menu-save-options ()
534 (interactive)
535 (let ((output-buffer (find-file-noselect w3-default-configuration-file))
536 output-marker)
537 (save-excursion
538 (set-buffer output-buffer)
539 ;;
540 ;; Find and delete the previously saved data, and position to write.
541 ;;
542 (goto-char (point-min))
543 (if (re-search-forward "^;; W3 Options Settings *\n" nil 'move)
544 (let ((p (match-beginning 0)))
545 (goto-char p)
546 (or (re-search-forward
547 "^;; End of W3 Options Settings *\\(\n\\|\\'\\)"
548 nil t)
549 (error "can't find END of saved state in .emacs"))
550 (delete-region p (match-end 0)))
551 (goto-char (point-max))
552 (insert "\n"))
553 (setq output-marker (point-marker))
554 (let ((print-readably t)
555 (print-escape-newlines t)
556 (standard-output output-marker))
557 (princ ";; W3 Options Settings\n")
558 (princ ";; ===================\n")
559 (mapcar (function
560 (lambda (var)
561 (princ " ")
562 (if (and (symbolp var) (boundp var))
563 (prin1 (list 'setq-default var
564 (let ((val (symbol-value var)))
565 (if (or (memq val '(t nil))
566 (and (not (symbolp val))
567 (not (listp val))))
568 val
569 (list 'quote val))))))
570 (if var (princ "\n"))))
571 '(
572 w3-delay-image-loads
573 w3-delay-mpeg-loads
574 ps-print-color-p
575 w3-color-use-reducing
576 w3-color-filter
577 w3-dump-to-disk
578 w3-user-colors-take-precedence
579 w3-do-incremental-display
580 url-automatic-caching
581 url-standalone-mode
582 url-use-hypertext-gopher
583 url-use-hypertext-dired
584 url-proxy-services
585 url-be-asynchronous
586 w3-default-homepage
587 url-privacy-level
588 w3-toolbar-orientation
589 )
590 )
591 (princ ";; ==========================\n")
592 (princ ";; End of W3 Options Settings\n")))
593 (set-marker output-marker nil)
594 (save-excursion
595 (set-buffer output-buffer)
596 (save-buffer))
597 ))
598
599 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
600 ;;; Context-sensitive popup menu
601 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
602 (if (not (fboundp 'event-glyph))
603 (fset 'event-glyph 'ignore))
604
605 (defun w3-popup-menu (e)
606 "Pop up a menu of common w3 commands"
607 (interactive "e")
608 (mouse-set-point e)
609 (let* ((glyph (event-glyph e))
610 (widget (or (and glyph (glyph-property glyph 'widget))
611 (widget-at (point))))
612 (href (and widget (widget-get widget 'href)))
613 (imag (and widget (widget-get widget 'src)))
614 (menu (copy-tree w3-popup-menu))
615 url val trunc-url)
616 (if href
617 (progn
618 (setq url href)
619 (if url (setq trunc-url (url-truncate-url-for-viewing
620 url
621 w3-max-menu-width)))
622 (setcdr menu (append (cdr menu)
623 '("---")
624 (mapcar
625 (function
626 (lambda (x)
627 (vector (format (car x) trunc-url)
628 (list (cdr x) url) t)))
629 w3-hyperlink-menu)))))
630 (if imag
631 (progn
632 (setq url imag
633 trunc-url (url-truncate-url-for-viewing url
634 w3-max-menu-width))
635 (setcdr menu (append (cdr menu)
636 '("---")
637 (mapcar
638 (function
639 (lambda (x)
640 (vector (format (car x) trunc-url)
641 (list (cdr x) url) t)))
642 w3-graphlink-menu)))))
643 (if (not (w3-menubar-active))
644 (setcdr menu (append (cdr menu)
645 '("---" ["Show Menubar" w3-toggle-menubar t]))))
646 (popup-menu menu)))
647
648 (provide 'w3-menu)