cgit.sxemacs.org Git - packages/blob - xemacs-packages/w3/lisp/w3-menu.el

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