git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/menubar-items.el

   1 ;;; menubar-items.el --- Menubar and popup-menu content for XEmacs.
   2
   3 ;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
   5 ;; Copyright (C) 1995 Sun Microsystems.
   6 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
   7 ;; Copyright (C) 1997 MORIOKA Tomohiko.
   8
   9 ;; Maintainer: XEmacs Development Team
  10 ;; Keywords: frames, extensions, internal, dumped
  11
  12 ;; This file is part of XEmacs.
  13
  14 ;; XEmacs is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; XEmacs is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with Xmacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Authorship:
  30
  31 ;; Created c. 1991 for Lucid Emacs.  Originally called x-menubar.el.
  32 ;;   Contained four menus -- File, Edit, Buffers, Help.
  33 ;;   Dynamic menu changes possible only through activate-menubar-hook.
  34 ;;   Also contained menu manipulation funs, e.g. find-menu-item, add-menu.
  35 ;; Options menu added for 19.9 by Jamie Zawinski, late 1993.
  36 ;; Major reorganization c. 1994 by Ben Wing; added many items and moved
  37 ;;   some items to two new menus, Apps and Tools. (for 19.10?)
  38 ;; Generic menubar functions moved to new file, menubar.el, by Ben Wing,
  39 ;;   1995, for 19.12; also, creation of current buffers menu options,
  40 ;;   and buffers menu changed from purely most-recent to sorted alphabetical,
  41 ;;   by mode.  Also added mode-popup-menu support.
  42 ;; New API (add-submenu, add-menu-button) and menu filter support added
  43 ;;   late summer 1995 by Stig, for 19.13.  Also popup-menubar-menu.
  44 ;; Renamed to menubar-items.el c. 1998, with MS Win support.
  45 ;; Options menu rewritten to use custom c. 1999 by ? (Jan Vroonhof?).
  46 ;; Major reorganization Mar. 2000 by Ben Wing; added many items and changed
  47 ;;   top-level menus to File, Edit, View, Cmds, Tools, Options, Buffers.
  48 ;; Accelerator spec functionality added Mar. 2000 by Ben Wing.
  49
  50 ;;; Commentary:
  51
  52 ;; This file is dumped with XEmacs (when window system and menubar support is
  53 ;; compiled in).
  54
  55 ;;; Code:
  56
  57 ;;; Warning-free compile
  58 (eval-when-compile
  59   (defvar language-environment-list)
  60   (defvar bookmark-alist)
  61   (defvar language-info-alist)
  62   (defvar current-language-environment)
  63   (defvar tutorial-supported-languages))
  64
  65 (defun menu-truncate-list (list n)
  66   (if (<= (length list) n)
  67       list
  68     (butlast list (- (length list) n))))
  69
  70 (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
  71   "Add auto-generated accelerator specifications to a submenu.
  72 This can be used to add accelerators to the return value of a menu filter
  73 function.  It correctly ignores unselectable items.  It will destructively
  74 modify the list passed to it.  If an item already has an auto-generated
  75 accelerator spec, this will be removed before the new one is added, making
  76 this function idempotent.
  77
  78 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
  79 which will not be used as accelerators."
  80   (let ((n 0))
  81     (dolist (item list list)
  82       (cond
  83        ((vectorp item)
  84         (setq n (1+ n))
  85         (aset item 0
  86               (concat
  87                (menu-item-generate-accelerator-spec n omit-chars-list)
  88                (menu-item-strip-accelerator-spec (aref item 0)))))
  89        ((consp item)
  90         (setq n (1+ n))
  91         (setcar item
  92                 (concat
  93                  (menu-item-generate-accelerator-spec n omit-chars-list)
  94                  (menu-item-strip-accelerator-spec (car item)))))))))
  95
  96 (defun menu-item-strip-accelerator-spec (item)
  97   "Strip an auto-generated accelerator spec off of ITEM.
  98 ITEM should be a string.  This removes specs added by
  99 `menu-item-generate-accelerator-spec' and `submenu-generate-accelerator-spec'."
 100   (if (string-match "%_. " item)
 101       (substring item 4)
 102     item))
 103
 104 (defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
 105   "Return an accelerator specification for use with auto-generated menus.
 106 This should be concat'd onto the beginning of each menu line.  The spec
 107 allows the Nth line to be selected by the number N.  '0' is used for the
 108 10th line, and 'a' through 'z' are used for the following 26 lines.
 109
 110 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
 111 which will not be used as accelerators."
 112   (cond ((< n 10) (concat "%_" (int-to-string n) " "))
 113         ((= n 10) "%_0 ")
 114         ((<= n 36)
 115          (setq n (- n 10))
 116          (let ((m 0))
 117            (while (> n 0)
 118              (setq m (1+ m))
 119              (while (memq (int-to-char (+ m (- (char-to-int ?a) 1)))
 120                           omit-chars-list)
 121                (setq m (1+ m)))
 122              (setq n (1- n)))
 123            (if (<= m 26)
 124                (concat
 125                 "%_"
 126                 (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1))))
 127                 " ")
 128              "")))
 129         (t "")))
 130
 131 (defconst default-menubar
 132   (purecopy-menubar
 133    ;; note backquote.
 134    `(
 135      ("%_File"
 136       ["%_Open..." find-file]
 137       ["Open in Other %_Window..." find-file-other-window]
 138       ["Open in New %_Frame..." find-file-other-frame]
 139       ["%_Hex Edit File..." hexl-find-file
 140        :active (fboundp 'hexl-find-file)]
 141       ["%_Insert File..." insert-file]
 142       ["%_View File..." view-file]
 143       "------"
 144       ["%_Save" save-buffer
 145        :active (buffer-modified-p)
 146        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 147       ["Save %_As..." write-file]
 148       ["Save So%_me Buffers" save-some-buffers]
 149       "-----"
 150       ["%_Print Buffer" generic-print-buffer
 151        :active (or (valid-specifier-tag-p 'msprinter)
 152                    (and (not (eq system-type 'windows-nt))
 153                         (fboundp 'lpr-buffer)))
 154        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 155       ["Prett%_y-Print Buffer" ps-print-buffer-with-faces
 156        :active (fboundp 'ps-print-buffer-with-faces)
 157        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 158       "-----"
 159       ["%_Revert Buffer" revert-buffer
 160        :active (or buffer-file-name revert-buffer-function)
 161        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
 162       ["Re%_cover File..." recover-file]
 163       ["Recover S%_ession..." recover-session]
 164       "-----"
 165       ["E%_xit XEmacs" save-buffers-kill-emacs]
 166       )
 167
 168      ("%_Edit"
 169       ["%_Undo" advertised-undo
 170        :active (and (not (eq buffer-undo-list t))
 171                     (or buffer-undo-list pending-undo-list))
 172        :suffix (if (or (eq last-command 'undo)
 173                        (eq last-command 'advertised-undo))
 174                    "More" "")]
 175       ["%_Redo" redo
 176        :included (fboundp 'redo)
 177        :active (not (or (eq buffer-undo-list t)
 178                         (eq last-buffer-undo-list nil)
 179                         (not (or (eq last-buffer-undo-list buffer-undo-list)
 180                                  (and (null (car-safe buffer-undo-list))
 181                                       (eq last-buffer-undo-list
 182                                           (cdr-safe buffer-undo-list)))))
 183                         (or (eq buffer-undo-list pending-undo-list)
 184                             (eq (cdr buffer-undo-list) pending-undo-list))))
 185        :suffix (if (eq last-command 'redo) "More" "")]
 186       "----"
 187       ["Cu%_t" kill-primary-selection
 188        :active (selection-owner-p)]
 189       ["%_Copy" copy-primary-selection
 190        :active (selection-owner-p)]
 191       ["%_Paste" yank-clipboard-selection
 192        :active (selection-exists-p 'CLIPBOARD)]
 193       ["%_Delete" delete-primary-selection
 194        :active (selection-owner-p)]
 195       "----"
 196       ["Select %_All" mark-whole-buffer]
 197       ["Select %_Page" mark-page]
 198       "----"
 199       ["%_Search..." make-search-dialog]
 200       ["%_1 Replace..." query-replace]
 201       "----"
 202       ["%_2 Search (Regexp)..." isearch-forward-regexp]
 203       ["%_3 Search Backward (Regexp)..." isearch-backward-regexp]
 204       ["%_4 Replace (Regexp)..." query-replace-regexp]
 205
 206       ,@(when (featurep 'mule)
 207          '("----"
 208            ("%_Multilingual (\"Mule\")"
 209             ("%_Describe Language Support")
 210             ("%_Set Language Environment")
 211             "--"
 212             ["T%_oggle Input Method" toggle-input-method]
 213             ["Select %_Input Method" set-input-method]
 214             ["D%_escribe Input Method" describe-input-method]
 215             "--"
 216             ["Describe Current %_Coding Systems"
 217              describe-current-coding-system]
 218             ["Set Coding System of %_Buffer File..."
 219              set-buffer-file-coding-system]
 220             ;; not implemented yet
 221             ["Set Coding System of %_Terminal..."
 222              set-terminal-coding-system :active nil]
 223             ;; not implemented yet
 224             ["Set Coding System of %_Keyboard..."
 225              set-keyboard-coding-system :active nil]
 226             ["Set Coding System of %_Process..."
 227              set-buffer-process-coding-system
 228              :active (get-buffer-process (current-buffer))]
 229             "--"
 230             ["Show Cha%_racter Table" view-charset-by-menu]
 231             ;; not implemented yet
 232             ["Show Dia%_gnosis for MULE" mule-diag :active nil]
 233             ["Show \"%_hello\" in Many Languages" view-hello-file]))
 234          )
 235       )
 236
 237      ("%_View"
 238       ["%_New Frame" make-frame]
 239       ["Frame on Other Displa%_y..." make-frame-on-display]
 240       ["%_Delete Frame" delete-frame
 241        :active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
 242                         (selected-frame)))]
 243       "-----"
 244       ["%_Split Window" split-window-vertically]
 245       ["S%_plit Window (Side by Side)" split-window-horizontally]
 246       ["%_Un-Split (Keep This)" delete-other-windows
 247        :active (not (one-window-p t))]
 248       ["Un-Split (Keep %_Others)" delete-window
 249        :active (not (one-window-p t))]
 250       "----"
 251       ("N%_arrow"
 252        ["%_Narrow to Region" narrow-to-region :active (region-exists-p)]
 253        ["Narrow to %_Page" narrow-to-page]
 254        ["Narrow to %_Defun" narrow-to-defun]
 255       "----"
 256        ["%_Widen" widen :active (or (/= (point-min) 1)
 257                                     (/= (point-max) (1+ (buffer-size))))]
 258        )
 259       "----"
 260       ["Show Message %_Log" show-message-log]
 261       "----"
 262       ["%_Goto Line..." goto-line]
 263       ["%_What Line" what-line]
 264       ("%_Bookmarks"
 265        :filter bookmark-menu-filter)
 266       "----"
 267       ["%_Jump to Previous Mark" (set-mark-command t)
 268        :active (mark t)]
 269       )
 270
 271      ("C%_mds"
 272       ["Repeat %_Last Complex Command..." repeat-complex-command]
 273       ["E%_valuate Lisp Expression..." eval-expression]
 274       ["Execute %_Named Command..." execute-extended-command]
 275       "----"
 276       ["Start %_Macro Recording" start-kbd-macro
 277        :included (not defining-kbd-macro)]
 278       ["End %_Macro Recording" end-kbd-macro
 279        :included defining-kbd-macro]
 280       ["E%_xecute Last Macro" call-last-kbd-macro
 281        :active last-kbd-macro]
 282       ("%_Other Macro"
 283        ["%_Append to Last Macro" (start-kbd-macro t)
 284         :active (and (not defining-kbd-macro) last-kbd-macro)]
 285        ["%_Query User During Macro" kbd-macro-query
 286         :active defining-kbd-macro]
 287        ["Enter %_Recursive Edit During Macro" (kbd-macro-query t)
 288         :active defining-kbd-macro]
 289        "---"
 290        ["E%_xecute Last Macro on Region Lines"
 291         :active (and last-kbd-macro (region-exists-p))]
 292        "---"
 293        ["%_Name Last Macro..." name-last-kbd-macro
 294         :active last-kbd-macro]
 295        ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key
 296         :active (and last-kbd-macro
 297                      (fboundp 'assign-last-kbd-macro-to-key))]
 298        "---"
 299        ["%_Edit Macro..." edit-kbd-macro]
 300        ["Edit %_Last Macro" edit-last-kbd-macro
 301         :active last-kbd-macro]
 302        "---"
 303        ["%_Insert Named Macro into Buffer..." insert-kbd-macro]
 304        ["Read Macro from Re%_gion" read-kbd-macro
 305         :active (region-exists-p)]
 306        )
 307       "----"
 308       ("%_Abbrev"
 309        ["D%_ynamic Abbrev Expand" dabbrev-expand]
 310        ["Dynamic Abbrev %_Complete" dabbrev-completion]
 311        ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)]
 312        "----"
 313        "----"
 314        ["%_Define Global Abbrev for " add-global-abbrev
 315         :suffix (abbrev-string-to-be-defined nil)
 316         :active abbrev-mode]
 317        ["Define %_Mode-Specific Abbrev for " add-mode-abbrev
 318         :suffix (abbrev-string-to-be-defined nil)
 319         :active abbrev-mode]
 320        ["Define Global Ex%_pansion for " inverse-add-global-abbrev
 321         :suffix (inverse-abbrev-string-to-be-defined 1)
 322         :active abbrev-mode]
 323        ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev
 324         :suffix (inverse-abbrev-string-to-be-defined 1)
 325         :active abbrev-mode]
 326        "---"
 327        ["E%_xpand Abbrev" expand-abbrev]
 328        ["Expand Abbrevs in Re%_gion" expand-region-abbrevs
 329         :active (region-exists-p)]
 330        ["%_Unexpand Last Abbrev" unexpand-abbrev
 331         :active (and (stringp last-abbrev-text)
 332                      (> last-abbrev-location 0))]
 333        "---"
 334        ["%_Kill All Abbrevs" kill-all-abbrevs]
 335        ["%_Insert All Abbrevs into Buffer" insert-abbrevs]
 336        ["%_List Abbrevs" list-abbrevs]
 337        "---"
 338        ["%_Edit Abbrevs" edit-abbrevs]
 339        ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine
 340         :active (eq major-mode 'edit-abbrevs-mode)]
 341        "---"
 342        ["%_Save Abbrevs As..." write-abbrev-file]
 343        ["L%_oad Abbrevs..." read-abbrev-file]
 344        )
 345       ("%_Register"
 346        ["%_Copy to Register..." copy-to-register :active (region-exists-p)]
 347        ["%_Paste Register..." insert-register]
 348        "---"
 349        ["%_Save Point to Register" point-to-register]
 350        ["%_Jump to Register"  register-to-point]
 351        )
 352       ("R%_ectangles"
 353        ["%_Kill Rectangle" kill-rectangle]
 354        ["%_Yank Rectangle" yank-rectangle]
 355        ["Rectangle %_to Register" copy-rectangle-to-register]
 356        ["Rectangle %_from Register" insert-register]
 357        ["%_Clear Rectangle" clear-rectangle]
 358        ["%_Open Rectangle" open-rectangle]
 359        ["%_Prefix Rectangle..." string-rectangle]
 360        ["Rectangle %_Mousing"
 361         (customize-set-variable 'mouse-track-rectangle-p
 362                                 (not mouse-track-rectangle-p))
 363         :style toggle :selected mouse-track-rectangle-p]
 364        )
 365       ("%_Sort"
 366        ["%_Lines" sort-lines :active (region-exists-p)]
 367        ["%_Paragraphs" sort-paragraphs :active (region-exists-p)]
 368        ["P%_ages" sort-pages :active (region-exists-p)]
 369        ["%_Columns" sort-columns :active (region-exists-p)]
 370        ["%_Regexp..." sort-regexp-fields :active (region-exists-p)]
 371        )
 372       ("%_Center"
 373        ["%_Line" center-line]
 374        ["%_Paragraph" center-paragraph]
 375        ["%_Region" center-region :active (region-exists-p)]
 376        )
 377       ("%_Indent"
 378        ["%_As Previous Line" indent-relative]
 379        ["%_To Column..." indent-to-column]
 380        "---"
 381        ["%_Region" indent-region :active (region-exists-p)]
 382        ["%_Balanced Expression" indent-sexp]
 383        ["%_C Expression" indent-c-exp]
 384        )
 385       ("S%_pell-Check"
 386        ["%_Buffer" ispell-buffer
 387         :active (fboundp 'ispell-buffer)]
 388        "---"
 389        ["%_Word" ispell-word]
 390        ["%_Complete Word" ispell-complete-word]
 391        ["%_Region" ispell-region]
 392        )
 393       )
 394
 395      ("%_Tools"
 396       ("%_Internet"
 397        ["Read Mail %_1 (VM)..." vm
 398         :active (fboundp 'vm)]
 399        ["Read Mail %_2 (MH)..." (mh-rmail t)
 400         :active (fboundp 'mh-rmail)]
 401        ["Send %_Mail..." compose-mail
 402         :active (fboundp 'compose-mail)]
 403        ["Usenet %_News" gnus
 404         :active (fboundp 'gnus)]
 405        ["Browse the %_Web" w3
 406         :active (fboundp 'w3)])
 407       "---"
 408       ("%_Grep"
 409        :filter
 410        (lambda (menu)
 411          (if (or (not (boundp 'grep-history)) (null grep-history))
 412              menu
 413            (let ((items
 414                   (submenu-generate-accelerator-spec
 415                    (mapcar #'(lambda (string)
 416                                (vector string
 417                                        (list 'grep string)))
 418                            (menu-truncate-list grep-history 10)))))
 419              (append menu '("---") items))))
 420        ["%_Grep..." grep :active (fboundp 'grep)]
 421        ["%_Kill Grep" kill-compilation
 422         :active (and (fboundp 'kill-compilation)
 423                      (fboundp 'compilation-find-buffer)
 424                      (let ((buffer (condition-case nil
 425                                        (compilation-find-buffer)
 426                                      (error nil))))
 427                        (and buffer (get-buffer-process buffer))))]
 428        "---"
 429        ["Grep %_All Files in Current Directory..."
 430         (progn
 431           (require 'compile)
 432           (let ((grep-command
 433                  (cons (concat grep-command " *")
 434                        (length grep-command))))
 435             (call-interactively 'grep)))
 436         :active (fboundp 'grep)]
 437        ["Grep %_C and C Header Files in Current Directory..."
 438         (progn
 439           (require 'compile)
 440           (let ((grep-command
 441                  (cons (concat grep-command " *.[chCH]"
 442                                         ; i wanted to also use *.cc and *.hh.
 443                                         ; see long comment below under Perl.
 444                                )
 445                        (length grep-command))))
 446             (call-interactively 'grep)))
 447         :active (fboundp 'grep)]
 448        ["Grep C Hea%_der Files in Current Directory..."
 449         (progn
 450           (require 'compile)
 451           (let ((grep-command
 452                  (cons (concat grep-command " *.[hH]"
 453                                         ; i wanted to also use *.hh.
 454                                         ; see long comment below under Perl.
 455                                )
 456                        (length grep-command))))
 457             (call-interactively 'grep)))
 458         :active (fboundp 'grep)]
 459        ["Grep %_E-Lisp Files in Current Directory..."
 460         (progn
 461           (require 'compile)
 462           (let ((grep-command
 463                  (cons (concat grep-command " *.el")
 464                        (length grep-command))))
 465             (call-interactively 'grep)))
 466         :active (fboundp 'grep)]
 467        ["Grep %_Perl Files in Current Directory..."
 468         (progn
 469           (require 'compile)
 470           (let ((grep-command
 471                  (cons (concat grep-command " *.pl"
 472                                         ; i wanted to use this:
 473                                         ; " *.pl *.pm *.am"
 474                                         ; but grep complains if it can't
 475                                         ; match anything in a glob, and
 476                                         ; that screws other things up.
 477                                         ; perhaps we need to first scan
 478                                         ; each separate glob in the directory
 479                                         ; to see if there are any files in
 480                                         ; that glob, and if not, omit it.
 481                                )
 482                        (length grep-command))))
 483             (call-interactively 'grep)))
 484         :active (fboundp 'grep)]
 485        ["Grep %_HTML Files in Current Directory..."
 486         (progn
 487           (require 'compile)
 488           (let ((grep-command
 489                  (cons (concat grep-command " *.*htm*")
 490                        (length grep-command))))
 491             (call-interactively 'grep)))
 492         :active (fboundp 'grep)]
 493        "---"
 494        ["%_Next Match" next-error
 495         :active (and (fboundp 'compilation-errors-exist-p)
 496                      (compilation-errors-exist-p))]
 497        ["Pre%_vious Match" previous-error
 498         :active (and (fboundp 'compilation-errors-exist-p)
 499                      (compilation-errors-exist-p))]
 500        ["%_First Match" first-error
 501         :active (and (fboundp 'compilation-errors-exist-p)
 502                      (compilation-errors-exist-p))]
 503        ["G%_oto Match" compile-goto-error
 504         :active (and (fboundp 'compilation-errors-exist-p)
 505                      (compilation-errors-exist-p))]
 506        "---"
 507        ["%_Set Grep Command..."
 508         (progn
 509           (require 'compile)
 510           (customize-set-variable
 511            'grep-command
 512            (read-shell-command "Default Grep Command: " grep-command)))
 513         :active (fboundp 'grep)
 514         ]
 515        )
 516       ("%_Compile"
 517        :filter
 518        (lambda (menu)
 519          (if (or (not (boundp 'compile-history)) (null compile-history))
 520              menu
 521            (let ((items
 522                   (submenu-generate-accelerator-spec
 523                    (mapcar #'(lambda (string)
 524                                (vector string
 525                                        (list 'compile string)))
 526                            (menu-truncate-list compile-history 10)))))
 527              (append menu '("---") items))))
 528        ["%_Compile..." compile :active (fboundp 'compile)]
 529        ["%_Repeat Compilation" recompile :active (fboundp 'recompile)]
 530        ["%_Kill Compilation" kill-compilation
 531         :active (and (fboundp 'kill-compilation)
 532                      (fboundp 'compilation-find-buffer)
 533                      (let ((buffer (condition-case nil
 534                                        (compilation-find-buffer)
 535                                      (error nil))))
 536                        (and buffer (get-buffer-process buffer))))]
 537        "---"
 538        ["%_Next Error" next-error
 539         :active (and (fboundp 'compilation-errors-exist-p)
 540                      (compilation-errors-exist-p))]
 541        ["Pre%_vious Error" previous-error
 542         :active (and (fboundp 'compilation-errors-exist-p)
 543                      (compilation-errors-exist-p))]
 544        ["%_First Error" first-error
 545         :active (and (fboundp 'compilation-errors-exist-p)
 546                      (compilation-errors-exist-p))]
 547        ["G%_oto Error" compile-goto-error
 548         :active (and (fboundp 'compilation-errors-exist-p)
 549                      (compilation-errors-exist-p))]
 550        )
 551       ("%_Debug"
 552        ["%_GDB..." gdb
 553         :active (fboundp 'gdb)]
 554        ["%_DBX..." dbx
 555         :active (fboundp 'dbx)])
 556       ("%_Shell"
 557        ["%_Shell" shell
 558         :active (fboundp 'shell)]
 559        ["S%_hell Command..." shell-command
 560         :active (fboundp 'shell-command)]
 561        ["Shell Command on %_Region..." shell-command-on-region
 562        :active (and (fboundp 'shell-command-on-region) (region-exists-p))])
 563
 564       ("%_Tags"
 565        ["%_Find Tag..." find-tag]
 566        ["Find %_Other Window..." find-tag-other-window]
 567        ["%_Next Tag..." (find-tag nil)]
 568        ["N%_ext Other Window..." (find-tag-other-window nil)]
 569        ["Next %_File" next-file]
 570        "-----"
 571        ["Tags %_Search..." tags-search]
 572        ["Tags %_Replace..." tags-query-replace]
 573        ["%_Continue Search/Replace" tags-loop-continue]
 574        "-----"
 575        ["%_Pop stack" pop-tag-mark]
 576        ["%_Apropos..." tags-apropos]
 577        "-----"
 578        ["%_Set Tags Table File..." visit-tags-table]
 579        )
 580
 581       "----"
 582
 583       ("Ca%_lendar"
 584        ["%_3-Month Calendar" calendar
 585         :active (fboundp 'calendar)]
 586        ["%_Diary" diary
 587         :active (fboundp 'diary)]
 588        ["%_Holidays" holidays
 589         :active (fboundp 'holidays)]
 590        ;; we're all pagans at heart ...
 591        ["%_Phases of the Moon" phases-of-moon
 592         :active (fboundp 'phases-of-moon)]
 593        ["%_Sunrise/Sunset" sunrise-sunset
 594         :active (fboundp 'sunrise-sunset)])
 595
 596       ("Ga%_mes"
 597        ["%_Mine Game" xmine
 598         :active (fboundp 'xmine)]
 599        ["%_Tetris" tetris
 600         :active (fboundp 'tetris)]
 601        ["%_Sokoban" sokoban
 602         :active (fboundp 'sokoban)]
 603        ["Quote from %_Zippy" yow
 604         :active (fboundp 'yow)]
 605        ["%_Psychoanalyst" doctor
 606         :active (fboundp 'doctor)]
 607        ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead
 608         :active (fboundp 'psychoanalyze-pinhead)]
 609        ["%_Random Flames" flame
 610         :active (fboundp 'flame)]
 611        ["%_Dunnet (Adventure)" dunnet
 612         :active (fboundp 'dunnet)]
 613        ["Towers of %_Hanoi" hanoi
 614         :active (fboundp 'hanoi)]
 615        ["Game of %_Life" life
 616         :active (fboundp 'life)]
 617        ["M%_ultiplication Puzzle" mpuz
 618         :active (fboundp 'mpuz)])
 619
 620       "----"
 621       )
 622
 623      ("%_Options"
 624       ("%_Advanced (Customize)"
 625        ("%_Emacs" :filter (lambda (&rest junk)
 626                             (cdr (custom-menu-create 'emacs))))
 627        ["%_Group..." customize-group]
 628        ["%_Variable..." customize-variable]
 629        ["%_Face..." customize-face]
 630        ["%_Saved..." customize-saved]
 631        ["Se%_t..." customize-customized]
 632        ["%_Apropos..." customize-apropos]
 633        ["%_Browse..." customize-browse])
 634       ("Manage %_Packages"
 635        ("%_Add Download Site"
 636         :filter (lambda (&rest junk)
 637                   (submenu-generate-accelerator-spec
 638                    (package-get-download-menu))))
 639        ["%_Update Package Index" package-get-update-base]
 640        ["%_List and Install" pui-list-packages]
 641        ["U%_pdate Installed Packages" package-get-update-all]
 642        ;; hack-o-matic, we can't force a load of package-base here
 643        ;; since it triggers dialog box interactions which we can't
 644        ;; deal with while using a menu
 645        ("Using %_Custom"
 646         :filter (lambda (&rest junk)
 647                   (if package-get-base
 648                       (submenu-generate-accelerator-spec
 649                        (cdr (custom-menu-create 'packages)))
 650                     '(["Please load Package Index"
 651                        (lamda (&rest junk) ()) nil]))))
 652
 653        ["%_Help" (Info-goto-node "(xemacs)Packages")])
 654       "---"
 655       ("%_Keyboard and Mouse"
 656        ["%_Abbrev Mode"
 657         (customize-set-variable 'abbrev-mode
 658                                 (not (default-value 'abbrev-mode)))
 659         :style toggle
 660         :selected (default-value 'abbrev-mode)]
 661        ["%_Delete Key Deletes Selection"
 662         (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
 663         :style toggle
 664         :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
 665         :active (boundp 'pending-delete-mode)]
 666        ["%_Yank/Kill Interact With Clipboard"
 667         (if (eq interprogram-cut-function 'own-clipboard)
 668             (progn
 669               (customize-set-variable 'interprogram-cut-function nil)
 670               (customize-set-variable 'interprogram-paste-function nil))
 671           (customize-set-variable 'interprogram-cut-function 'own-clipboard)
 672           (customize-set-variable 'interprogram-paste-function 'get-clipboard))
 673         :style toggle
 674         :selected (eq interprogram-cut-function 'own-clipboard)]
 675        ["%_Overstrike"
 676         (progn
 677           (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
 678           (customize-set-variable 'overwrite-mode overwrite-mode))
 679         :style toggle :selected overwrite-mode]
 680        ("`%_kill-line' Behavior..."
 681         ["Kill %_Whole Line"
 682          (customize-set-variable 'kill-whole-line 'always)
 683          :style radio :selected (eq kill-whole-line 'always)]
 684         ["Kill to %_End of Line"
 685          (customize-set-variable 'kill-whole-line nil)
 686          :style radio :selected (eq kill-whole-line nil)]
 687         ["Kill Whole Line at %_Beg, Otherwise to End"
 688          (customize-set-variable 'kill-whole-line t)
 689          :style radio :selected (eq kill-whole-line t)])
 690        ["Size for %_Block-Movement Commands..."
 691         (customize-set-variable 'block-movement-size
 692                                 (read-number "Block Movement Size: "
 693                                               t block-movement-size))]
 694        ["%_VI Emulation"
 695         (progn
 696           (toggle-viper-mode)
 697           (customize-set-variable 'viper-mode viper-mode))
 698         :style toggle :selected (and (boundp 'viper-mode) viper-mode)
 699         :active (fboundp 'toggle-viper-mode)]
 700        ["Active Re%_gions"
 701         (customize-set-variable 'zmacs-regions (not zmacs-regions))
 702         :style toggle :selected zmacs-regions]
 703        "----"
 704        ["%_Set Key..." global-set-key]
 705        ["%_Unset Key..." global-unset-key]
 706        "---"
 707        ["%_Case Sensitive Search"
 708         (customize-set-variable 'case-fold-search
 709                                 (setq case-fold-search (not case-fold-search)))
 710         :style toggle :selected (not case-fold-search)]
 711        ["Case Matching %_Replace"
 712         (customize-set-variable 'case-replace (not case-replace))
 713         :style toggle :selected case-replace]
 714        "---"
 715        ("%_Newline at End of File..."
 716         ["%_Don't Require"
 717          (customize-set-variable 'require-final-newline nil)
 718          :style radio :selected (not require-final-newline)]
 719         ["%_Require"
 720          (customize-set-variable 'require-final-newline t)
 721          :style radio :selected (eq require-final-newline t)]
 722         ["%_Ask"
 723          (customize-set-variable 'require-final-newline 'ask)
 724          :style radio :selected (and require-final-newline
 725                                      (not (eq require-final-newline t)))])
 726        ["Add Newline When Moving Past %_End"
 727         (customize-set-variable 'next-line-add-newlines
 728                                 (not next-line-add-newlines))
 729         :style toggle :selected next-line-add-newlines]
 730        "---"
 731        ["%_Mouse Paste at Text Cursor"
 732         (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
 733         :style toggle :selected mouse-yank-at-point]
 734        ["A%_void Text..."
 735         (customize-set-variable 'mouse-avoidance-mode
 736                                 (if mouse-avoidance-mode nil 'banish))
 737         :style toggle
 738         :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode)
 739         :active (and (boundp 'mouse-avoidance-mode)
 740                      (device-on-window-system-p))]
 741        ["%_Strokes Mode"
 742         (customize-set-variable 'strokes-mode (not strokes-mode))
 743         :style toggle
 744         :selected (and (boundp 'strokes-mode) strokes-mode)
 745         :active (and (boundp 'strokes-mode)
 746                      (device-on-window-system-p))]
 747        )
 748       ("%_General"
 749        ["This Buffer %_Read Only" (toggle-read-only)
 750         :style toggle :selected buffer-read-only]
 751        ["%_Teach Extended Commands"
 752         (customize-set-variable 'teach-extended-commands-p
 753                                 (not teach-extended-commands-p))
 754         :style toggle :selected teach-extended-commands-p]
 755        ["Debug on %_Error"
 756         (customize-set-variable 'debug-on-error (not debug-on-error))
 757         :style toggle :selected debug-on-error]
 758        ["Debug on %_Quit"
 759         (customize-set-variable 'debug-on-quit (not debug-on-quit))
 760         :style toggle :selected debug-on-quit]
 761        ["Debug on %_Signal"
 762         (customize-set-variable 'debug-on-signal (not debug-on-signal))
 763         :style toggle :selected debug-on-signal]
 764        )
 765
 766       ("%_Printing"
 767        ["Set Printer %_Name for Generic Print Support..."
 768         (customize-set-variable
 769          'printer-name
 770          (read-string "Set printer name: " printer-name))]
 771        "---"
 772        ["Command-Line %_Switches for `lpr'/`lp'..."
 773         ;; better to directly open a customization buffer, since the value
 774         ;; must be a list of strings, which is somewhat complex to prompt for.
 775         (customize-variable 'lpr-switches)
 776         (boundp 'lpr-switches)]
 777        ("%_Pretty-Print Paper Size"
 778         ["%_Letter"
 779          (customize-set-variable 'ps-paper-type 'letter)
 780          :style radio
 781          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
 782          :active (boundp 'ps-paper-type)]
 783         ["Lette%_r-Small"
 784          (customize-set-variable 'ps-paper-type 'letter-small)
 785          :style radio
 786          :selected (and (boundp 'ps-paper-type)
 787                         (eq ps-paper-type 'letter-small))
 788          :active (boundp 'ps-paper-type)]
 789         ["Le%_gal"
 790          (customize-set-variable 'ps-paper-type 'legal)
 791          :style radio
 792          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
 793          :active (boundp 'ps-paper-type)]
 794         ["%_Statement"
 795          (customize-set-variable 'ps-paper-type 'statement)
 796          :style radio
 797          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
 798          :active (boundp 'ps-paper-type)]
 799         ["%_Executive"
 800          (customize-set-variable 'ps-paper-type 'executive)
 801          :style radio
 802          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
 803          :active (boundp 'ps-paper-type)]
 804         ["%_Tabloid"
 805          (customize-set-variable 'ps-paper-type 'tabloid)
 806          :style radio
 807          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
 808          :active (boundp 'ps-paper-type)]
 809         ["Le%_dger"
 810          (customize-set-variable 'ps-paper-type 'ledger)
 811          :style radio
 812          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
 813          :active (boundp 'ps-paper-type)]
 814         ["A%_3"
 815          (customize-set-variable 'ps-paper-type 'a3)
 816          :style radio
 817          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
 818          :active (boundp 'ps-paper-type)]
 819         ["%_A4"
 820          (customize-set-variable 'ps-paper-type 'a4)
 821          :style radio
 822          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
 823          :active (boundp 'ps-paper-type)]
 824         ["A4s%_mall"
 825          (customize-set-variable 'ps-paper-type 'a4small)
 826          :style radio
 827          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
 828          :active (boundp 'ps-paper-type)]
 829         ["B%_4"
 830          (customize-set-variable 'ps-paper-type 'b4)
 831          :style radio
 832          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
 833          :active (boundp 'ps-paper-type)]
 834         ["%_B5"
 835          (customize-set-variable 'ps-paper-type 'b5)
 836          :style radio
 837          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
 838          :active (boundp 'ps-paper-type)]
 839         )
 840        ["%_Color Printing"
 841         (cond (ps-print-color-p
 842                (customize-set-variable 'ps-print-color-p nil)
 843                ;; I'm wondering whether all this muck is useful.
 844                (and (boundp 'original-face-background)
 845                     original-face-background
 846                     (set-face-background 'default original-face-background)))
 847               (t
 848                (customize-set-variable 'ps-print-color-p t)
 849                (setq original-face-background
 850                      (face-background-instance 'default))
 851                (set-face-background 'default "white")))
 852         :style toggle
 853         :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
 854         :active (boundp 'ps-print-color-p)])
 855       ("%_Internet"
 856        ("%_Compose Mail With"
 857         ["Default Emacs Mailer"
 858          (customize-set-variable 'mail-user-agent 'sendmail-user-agent)
 859          :style radio
 860          :selected (eq mail-user-agent 'sendmail-user-agent)]
 861         ["MH"
 862          (customize-set-variable 'mail-user-agent 'mh-e-user-agent)
 863          :style radio
 864          :selected (eq mail-user-agent 'mh-e-user-agent)
 865          :active (get 'mh-e-user-agent 'composefunc)]
 866         ["GNUS"
 867          (customize-set-variable 'mail-user-agent 'message-user-agent)
 868          :style radio
 869          :selected (eq mail-user-agent 'message-user-agent)
 870          :active (get 'message-user-agent 'composefunc)]
 871         )
 872        ["Set My %_Email Address..."
 873         (customize-set-variable
 874          'user-mail-address
 875          (read-string "Set email address: " user-mail-address))]
 876        ["Set %_Machine Email Name..."
 877         (customize-set-variable
 878          'mail-host-address
 879          (read-string "Set machine email name: " mail-host-address))]
 880        ["Set %_SMTP Server..."
 881         (progn
 882           (require 'smtpmail)
 883           (customize-set-variable
 884            'smtpmail-smtp-server
 885            (read-string "Set SMTP server: " smtpmail-smtp-server)))
 886         :active (and (boundp 'send-mail-function)
 887                      (eq send-mail-function 'smtpmail-send-it))]
 888        ["SMTP %_Debug Info"
 889         (progn
 890           (require 'smtpmail)
 891           (customize-set-variable 'smtpmail-debug-info
 892                                   (not smtpmail-debug-info)))
 893         :style toggle
 894         :selected (and (boundp 'smtpmail-debug-info) smtpmail-debug-info)
 895         :active (and (boundp 'send-mail-function)
 896                      (eq send-mail-function 'smtpmail-send-it))]
 897        "---"
 898        ("%_Open URLs With"
 899         ["%_Emacs-W3"
 900          (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
 901          :style radio
 902          :selected (and (boundp 'browse-url-browser-function)
 903                         (eq browse-url-browser-function 'browse-url-w3))
 904          :active (and (boundp 'browse-url-browser-function)
 905                       (fboundp 'browse-url-w3)
 906                       (fboundp 'w3-fetch))]
 907         ["%_Netscape"
 908          (customize-set-variable 'browse-url-browser-function
 909                                  'browse-url-netscape)
 910          :style radio
 911          :selected (and (boundp 'browse-url-browser-function)
 912                         (eq browse-url-browser-function 'browse-url-netscape))
 913          :active (and (boundp 'browse-url-browser-function)
 914                       (fboundp 'browse-url-netscape))]
 915         ["%_Mosaic"
 916          (customize-set-variable 'browse-url-browser-function
 917                                  'browse-url-mosaic)
 918          :style radio
 919          :selected (and (boundp 'browse-url-browser-function)
 920                         (eq browse-url-browser-function 'browse-url-mosaic))
 921          :active (and (boundp 'browse-url-browser-function)
 922                       (fboundp 'browse-url-mosaic))]
 923         ["Mosaic (%_CCI)"
 924          (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
 925          :style radio
 926          :selected (and (boundp 'browse-url-browser-function)
 927                         (eq browse-url-browser-function 'browse-url-cci))
 928          :active (and (boundp 'browse-url-browser-function)
 929                       (fboundp 'browse-url-cci))]
 930         ["%_IXI Mosaic"
 931          (customize-set-variable 'browse-url-browser-function
 932                                  'browse-url-iximosaic)
 933          :style radio
 934          :selected (and (boundp 'browse-url-browser-function)
 935                         (eq browse-url-browser-function 'browse-url-iximosaic))
 936          :active (and (boundp 'browse-url-browser-function)
 937                       (fboundp 'browse-url-iximosaic))]
 938         ["%_Lynx (xterm)"
 939          (customize-set-variable 'browse-url-browser-function
 940                                  'browse-url-lynx-xterm)
 941          :style radio
 942          :selected (and (boundp 'browse-url-browser-function)
 943                         (eq browse-url-browser-function 'browse-url-lynx-xterm))
 944          :active (and (boundp 'browse-url-browser-function)
 945                       (fboundp 'browse-url-lynx-xterm))]
 946         ["L%_ynx (xemacs)"
 947          (customize-set-variable 'browse-url-browser-function
 948                                  'browse-url-lynx-emacs)
 949          :style radio
 950          :selected (and (boundp 'browse-url-browser-function)
 951                         (eq browse-url-browser-function 'browse-url-lynx-emacs))
 952          :active (and (boundp 'browse-url-browser-function)
 953                       (fboundp 'browse-url-lynx-emacs))]
 954         ["%_Grail"
 955          (customize-set-variable 'browse-url-browser-function
 956                                  'browse-url-grail)
 957          :style radio
 958          :selected (and (boundp 'browse-url-browser-function)
 959                         (eq browse-url-browser-function 'browse-url-grail))
 960          :active (and (boundp 'browse-url-browser-function)
 961                       (fboundp 'browse-url-grail))]
 962         ["%_Kfm"
 963          (customize-set-variable 'browse-url-browser-function
 964                                  'browse-url-kfm)
 965          :style radio
 966          :selected (and (boundp 'browse-url-browser-function)
 967                         (eq browse-url-browser-function 'browse-url-kfm))
 968          :active (and (boundp 'browse-url-browser-function)
 969                       (fboundp 'browse-url-kfm))]
 970         ))
 971
 972
 973       "-----"
 974       ("Display"
 975        ,@(if (featurep 'scrollbar)
 976              '(["%_Scrollbars"
 977                 (customize-set-variable 'scrollbars-visible-p
 978                                         (not scrollbars-visible-p))
 979                 :style toggle
 980                 :selected scrollbars-visible-p]))
 981        ;; I don't think this is of any interest. - dverna apr. 98
 982        ;; #### I beg to differ!  Many FSFmacs converts hate the 3D
 983        ;; modeline, and it was perfectly fine to be able to turn them
 984        ;; off through the Options menu.  I would have uncommented this
 985        ;; source, but the code for saving options would not save the
 986        ;; modeline 3D-ness.  Grrr.  --hniksic
 987        ;;        ["%_3D Modeline"
 988        ;;         (progn
 989        ;;           (if (zerop (specifier-instance modeline-shadow-thickness))
 990        ;;               (set-specifier modeline-shadow-thickness 2)
 991        ;;             (set-specifier modeline-shadow-thickness 0))
 992        ;;           (redraw-modeline t))
 993        ;;         :style toggle
 994        ;;         :selected (let ((thickness
 995        ;;                          (specifier-instance modeline-shadow-thickness)))
 996        ;;                     (and (integerp thickness)
 997        ;;                          (> thickness 0)))]
 998        ["%_Truncate Lines"
 999         (progn;; becomes buffer-local
1000           (setq truncate-lines (not truncate-lines))
1001           (customize-set-variable 'truncate-lines truncate-lines))
1002         :style toggle
1003         :selected truncate-lines]
1004        ["%_Blinking Cursor"
1005         (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
1006         :style toggle
1007         :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
1008         :active (boundp 'blink-cursor-mode)]
1009        "-----"
1010        ["Bl%_ock Cursor"
1011         (progn
1012           (customize-set-variable 'bar-cursor nil)
1013           (force-cursor-redisplay))
1014         :style radio
1015         :selected (null bar-cursor)]
1016        ["Bar Cursor (%_1 Pixel)"
1017         (progn
1018           (customize-set-variable 'bar-cursor t)
1019           (force-cursor-redisplay))
1020         :style radio
1021         :selected (eq bar-cursor t)]
1022        ["Bar Cursor (%_2 Pixels)"
1023         (progn
1024           (customize-set-variable 'bar-cursor 2)
1025           (force-cursor-redisplay))
1026         :style radio
1027         :selected (and bar-cursor (not (eq bar-cursor t)))]
1028        "------"
1029        ["%_Line Numbers"
1030         (progn
1031           (customize-set-variable 'line-number-mode (not line-number-mode))
1032           (redraw-modeline))
1033         :style toggle :selected line-number-mode]
1034        ["%_Column Numbers"
1035         (progn
1036           (customize-set-variable 'column-number-mode
1037                                   (not column-number-mode))
1038           (redraw-modeline))
1039         :style toggle :selected column-number-mode]
1040
1041        ("\"Other %_Window\" Location"
1042         ["%_Always in Same Frame"
1043          (customize-set-variable
1044           'get-frame-for-buffer-default-instance-limit nil)
1045          :style radio
1046          :selected (null get-frame-for-buffer-default-instance-limit)]
1047         ["Other Frame (%_2 Frames Max)"
1048          (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2)
1049          :style radio
1050          :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
1051         ["Other Frame (%_3 Frames Max)"
1052          (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3)
1053          :style radio
1054          :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
1055         ["Other Frame (%_4 Frames Max)"
1056          (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4)
1057          :style radio
1058          :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
1059         ["Other Frame (%_5 Frames Max)"
1060          (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5)
1061          :style radio
1062          :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
1063         ["Always Create %_New Frame"
1064          (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0)
1065          :style radio
1066          :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
1067         "-----"
1068         ["%_Temp Buffers Always in Same Frame"
1069          (customize-set-variable 'temp-buffer-show-function
1070                                  'show-temp-buffer-in-current-frame)
1071          :style radio
1072          :selected (eq temp-buffer-show-function
1073                        'show-temp-buffer-in-current-frame)]
1074         ["Temp Buffers %_Like Other Buffers"
1075          (customize-set-variable 'temp-buffer-show-function nil)
1076          :style radio
1077          :selected (null temp-buffer-show-function)]
1078         "-----"
1079         ["%_Make Current Frame Gnuserv Target"
1080          (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
1081          :style toggle
1082          :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
1083          :active (boundp 'gnuserv-frame)]
1084         )
1085        )
1086       ("%_Menubars"
1087        ["%_Frame-Local Font Menu"
1088         (customize-set-variable 'font-menu-this-frame-only-p
1089                                 (not font-menu-this-frame-only-p))
1090         :style toggle
1091         :selected (and (boundp 'font-menu-this-frame-only-p)
1092                        font-menu-this-frame-only-p)]
1093        ["%_Alt/Meta Selects Menu Items"
1094         (if (eq menu-accelerator-enabled 'menu-force)
1095             (customize-set-variable 'menu-accelerator-enabled nil)
1096           (customize-set-variable 'menu-accelerator-enabled 'menu-force))
1097         :style toggle
1098         :selected (eq menu-accelerator-enabled 'menu-force)]
1099        "----"
1100        ["Buffers Menu %_Length..."
1101         (customize-set-variable
1102          'buffers-menu-max-size
1103          ;; would it be better to open a customization buffer ?
1104          (let ((val
1105                 (read-number
1106                  "Enter number of buffers to display (or 0 for unlimited): ")))
1107            (if (eq val 0) nil val)))]
1108        ["%_Multi-Operation Buffers Sub-Menus"
1109         (customize-set-variable 'complex-buffers-menu-p
1110                                 (not complex-buffers-menu-p))
1111         :style toggle
1112         :selected complex-buffers-menu-p]
1113        ["S%_ubmenus for Buffer Groups"
1114         (customize-set-variable 'buffers-menu-submenus-for-groups-p
1115                                 (not buffers-menu-submenus-for-groups-p))
1116         :style toggle
1117         :selected buffers-menu-submenus-for-groups-p]
1118        ["%_Verbose Buffer Menu Entries"
1119         (if (eq buffers-menu-format-buffer-line-function
1120                 'slow-format-buffers-menu-line)
1121             (customize-set-variable 'buffers-menu-format-buffer-line-function
1122                                     'format-buffers-menu-line)
1123           (customize-set-variable 'buffers-menu-format-buffer-line-function
1124                                   'slow-format-buffers-menu-line))
1125         :style toggle
1126         :selected (eq buffers-menu-format-buffer-line-function
1127                       'slow-format-buffers-menu-line)]
1128        ("Buffers Menu %_Sorting"
1129         ["%_Most Recently Used"
1130          (progn
1131            (customize-set-variable 'buffers-menu-sort-function nil)
1132            (customize-set-variable 'buffers-menu-grouping-function nil))
1133          :style radio
1134          :selected (null buffers-menu-sort-function)]
1135         ["%_Alphabetically"
1136          (progn
1137            (customize-set-variable 'buffers-menu-sort-function
1138                                    'sort-buffers-menu-alphabetically)
1139            (customize-set-variable 'buffers-menu-grouping-function nil))
1140          :style radio
1141          :selected (eq 'sort-buffers-menu-alphabetically
1142                        buffers-menu-sort-function)]
1143         ["%_By Major Mode, Then Alphabetically"
1144          (progn
1145            (customize-set-variable
1146             'buffers-menu-sort-function
1147             'sort-buffers-menu-by-mode-then-alphabetically)
1148            (customize-set-variable
1149             'buffers-menu-grouping-function
1150             'group-buffers-menu-by-mode-then-alphabetically))
1151          :style radio
1152          :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
1153                        buffers-menu-sort-function)])
1154        "---"
1155        ["%_Ignore Scaled Fonts"
1156         (customize-set-variable 'font-menu-ignore-scaled-fonts
1157                                 (not font-menu-ignore-scaled-fonts))
1158         :style toggle
1159         :selected (and (boundp 'font-menu-ignore-scaled-fonts)
1160                        font-menu-ignore-scaled-fonts)]
1161        )
1162       ,@(if (featurep 'toolbar)
1163             '(("%_Toolbars"
1164                ["%_Visible"
1165                 (customize-set-variable 'toolbar-visible-p
1166                                         (not toolbar-visible-p))
1167                 :style toggle
1168                 :selected toolbar-visible-p]
1169                ["%_Captioned"
1170                 (customize-set-variable 'toolbar-captioned-p
1171                                         (not toolbar-captioned-p))
1172                 :style toggle
1173                 :selected toolbar-captioned-p]
1174                ("%_Default Location"
1175                 ["%_Top"
1176                  (customize-set-variable 'default-toolbar-position 'top)
1177                  :style radio
1178                  :selected (eq default-toolbar-position 'top)]
1179                 ["%_Bottom"
1180                  (customize-set-variable 'default-toolbar-position 'bottom)
1181                  :style radio
1182                  :selected (eq default-toolbar-position 'bottom)]
1183                 ["%_Left"
1184                  (customize-set-variable 'default-toolbar-position 'left)
1185                  :style radio
1186                  :selected (eq default-toolbar-position 'left)]
1187                 ["%_Right"
1188                  (customize-set-variable 'default-toolbar-position 'right)
1189                  :style radio
1190                  :selected (eq default-toolbar-position 'right)]
1191                 )
1192                )))
1193       ,@(if (featurep 'gutter)
1194             '(("G%_utters"
1195                ["Buffers Tab %_Visible"
1196                 (customize-set-variable 'gutter-buffers-tab-visible-p
1197                                         (not gutter-buffers-tab-visible-p))
1198                 :style toggle
1199                 :selected gutter-buffers-tab-visible-p]
1200                ("%_Default Location"
1201                 ["%_Top"
1202                  (customize-set-variable 'default-gutter-position 'top)
1203                  :style radio
1204                  :selected (eq default-gutter-position 'top)]
1205                 ["%_Bottom"
1206                  (customize-set-variable 'default-gutter-position 'bottom)
1207                  :style radio
1208                  :selected (eq default-gutter-position 'bottom)]
1209                 ["%_Left"
1210                  (customize-set-variable 'default-gutter-position 'left)
1211                  :style radio
1212                  :selected (eq default-gutter-position 'left)]
1213                 ["%_Right"
1214                  (customize-set-variable 'default-gutter-position 'right)
1215                  :style radio
1216                  :selected (eq default-gutter-position 'right)]
1217                 )
1218                )))
1219       "-----"
1220       ("S%_yntax Highlighting"
1221        ["%_In This Buffer"
1222         (progn;; becomes buffer local
1223           (font-lock-mode)
1224           (customize-set-variable 'font-lock-mode font-lock-mode))
1225         :style toggle
1226         :selected (and (boundp 'font-lock-mode) font-lock-mode)
1227         :active (boundp 'font-lock-mode)]
1228        ["%_Automatic"
1229         (customize-set-variable 'font-lock-auto-fontify
1230                                 (not font-lock-auto-fontify))
1231         :style toggle
1232         :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
1233         :active (fboundp 'font-lock-mode)]
1234        "-----"
1235        ["%_Fonts"
1236         (progn
1237           (require 'font-lock)
1238           (font-lock-use-default-fonts)
1239           (customize-set-variable 'font-lock-use-fonts t)
1240           (customize-set-variable 'font-lock-use-colors nil)
1241           (font-lock-mode 1))
1242         :style radio
1243         :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
1244         :active (fboundp 'font-lock-mode)]
1245        ["%_Colors"
1246         (progn
1247           (require 'font-lock)
1248           (font-lock-use-default-colors)
1249           (customize-set-variable 'font-lock-use-colors t)
1250           (customize-set-variable 'font-lock-use-fonts nil)
1251           (font-lock-mode 1))
1252         :style radio
1253         :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
1254         :active (boundp 'font-lock-mode)]
1255        "-----"
1256        ["%_Least"
1257         (progn
1258           (require 'font-lock)
1259           (if (or (and (not (integerp font-lock-maximum-decoration))
1260                        (not (eq t font-lock-maximum-decoration)))
1261                   (and (integerp font-lock-maximum-decoration)
1262                        (<= font-lock-maximum-decoration 0)))
1263               nil
1264             (customize-set-variable 'font-lock-maximum-decoration nil)
1265             (font-lock-recompute-variables)))
1266         :style radio
1267         :active (fboundp 'font-lock-mode)
1268         :selected (and (boundp 'font-lock-maximium-decoration)
1269                        (or (and (not (integerp font-lock-maximum-decoration))
1270                                 (not (eq t font-lock-maximum-decoration)))
1271                            (and (integerp font-lock-maximum-decoration)
1272                                 (<= font-lock-maximum-decoration 0))))]
1273        ["M%_ore"
1274         (progn
1275           (require 'font-lock)
1276           (if (and (integerp font-lock-maximum-decoration)
1277                    (= 1 font-lock-maximum-decoration))
1278               nil
1279             (customize-set-variable 'font-lock-maximum-decoration 1)
1280             (font-lock-recompute-variables)))
1281         :style radio
1282         :active (fboundp 'font-lock-mode)
1283         :selected (and (boundp 'font-lock-maximium-decoration)
1284                        (integerp font-lock-maximum-decoration)
1285                        (= 1 font-lock-maximum-decoration))]
1286        ["%_Even More"
1287         (progn
1288           (require 'font-lock)
1289           (if (and (integerp font-lock-maximum-decoration)
1290                    (= 2 font-lock-maximum-decoration))
1291               nil
1292             (customize-set-variable 'font-lock-maximum-decoration 2)
1293             (font-lock-recompute-variables)))
1294         :style radio
1295         :active (fboundp 'font-lock-mode)
1296         :selected (and (boundp 'font-lock-maximum-decoration)
1297                        (integerp font-lock-maximum-decoration)
1298                        (= 2 font-lock-maximum-decoration))]
1299        ["%_Most"
1300         (progn
1301           (require 'font-lock)
1302           (if (or (eq font-lock-maximum-decoration t)
1303                   (and (integerp font-lock-maximum-decoration)
1304                        (>= font-lock-maximum-decoration 3)))
1305               nil
1306             (customize-set-variable 'font-lock-maximum-decoration t)
1307             (font-lock-recompute-variables)))
1308         :style radio
1309         :active (fboundp 'font-lock-mode)
1310         :selected (and (boundp 'font-lock-maximum-decoration)
1311                        (or (eq font-lock-maximum-decoration t)
1312                            (and (integerp font-lock-maximum-decoration)
1313                                 (>= font-lock-maximum-decoration 3))))]
1314        "-----"
1315        ["La%_zy"
1316         (progn;; becomes buffer local
1317           (lazy-shot-mode)
1318           (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
1319           ;; this shouldn't be necessary so there has to
1320           ;; be a redisplay bug lurking somewhere (or
1321           ;; possibly another event handler bug)
1322           (redraw-modeline))
1323         :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
1324                      font-lock-mode)
1325         :style toggle
1326         :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
1327        ["Cac%_hing"
1328         (progn;; becomes buffer local
1329           (fast-lock-mode)
1330           (customize-set-variable 'fast-lock-mode fast-lock-mode)
1331           ;; this shouldn't be necessary so there has to
1332           ;; be a redisplay bug lurking somewhere (or
1333           ;; possibly another event handler bug)
1334           (redraw-modeline))
1335         :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
1336                      font-lock-mode)
1337         :style toggle
1338         :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
1339        )
1340       ("Pa%_ren Highlighting"
1341        ["%_None"
1342         (customize-set-variable 'paren-mode nil)
1343         :style radio
1344         :selected (and (boundp 'paren-mode) (not paren-mode))
1345         :active (boundp 'paren-mode)]
1346        ["%_Blinking Paren"
1347         (customize-set-variable 'paren-mode 'blink-paren)
1348         :style radio
1349         :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
1350         :active (boundp 'paren-mode)]
1351        ["%_Steady Paren"
1352         (customize-set-variable 'paren-mode 'paren)
1353         :style radio
1354         :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
1355         :active (boundp 'paren-mode)]
1356        ["%_Expression"
1357         (customize-set-variable 'paren-mode 'sexp)
1358         :style radio
1359         :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
1360         :active (boundp 'paren-mode)]
1361        ;;        ["Nes%_ted Shading"
1362        ;;         (customize-set-variable 'paren-mode 'nested)
1363        ;;         :style radio
1364        ;;         :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
1365        ;;         :active (boundp 'paren-mode)]
1366        )
1367       "-----"
1368       ["Edit Fa%_ces..." (customize-face nil)]
1369       ("Fo%_nt" :filter font-menu-family-constructor)
1370       ("Si%_ze" :filter font-menu-size-constructor)
1371       ;;      ("Weig%_ht" :filter font-menu-weight-constructor)
1372       "-----"
1373       ["%_Edit Init (.emacs) File"
1374        ;; #### there should be something that holds the name that the init
1375        ;; file should be created as, when it's not present.
1376        (progn (find-file (or user-init-file "~/.emacs"))
1377               (or (eq major-mode 'emacs-lisp-mode)
1378                   (emacs-lisp-mode)))]
1379       ["%_Save Options to .emacs File" customize-save-customized]
1380       )
1381
1382      ("%_Buffers"
1383       :filter buffers-menu-filter
1384       ["Go To %_Previous Buffer" switch-to-other-buffer]
1385       ["Go To %_Buffer..." switch-to-buffer]
1386       "----"
1387       ["%_List All Buffers" list-buffers]
1388       ["%_Delete Buffer" kill-this-buffer
1389        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
1390       "----"
1391       )
1392
1393      nil        ; the partition: menus after this are flushright
1394
1395      ("%_Help"
1396       ["%_About XEmacs..." about-xemacs]
1397       "-----"
1398       ["XEmacs %_News" view-emacs-news]
1399       ["%_Obtaining XEmacs" describe-distribution]
1400       "-----"
1401       ("%_Info (Online Docs)"
1402        ["%_Info Contents" info]
1403        ["Lookup %_Key Binding..." Info-goto-emacs-key-command-node]
1404        ["Lookup %_Command..." Info-goto-emacs-command-node]
1405        ["Lookup %_Function..." Info-elisp-ref]
1406        ["Lookup %_Topic..." Info-query])
1407       ("XEmacs %_FAQ"
1408        ["%_FAQ (local)" xemacs-local-faq]
1409        ["FAQ via %_WWW" xemacs-www-faq
1410         :active (boundp 'browse-url-browser-function)]
1411        ["%_Home Page" xemacs-www-page
1412         :active (boundp 'browse-url-browser-function)])
1413       ("%_Tutorials"
1414        :filter tutorials-menu-filter)
1415       ("%_Samples"
1416        ["Sample .%_emacs"
1417         (find-file (locate-data-file "sample.emacs"))
1418         :active (locate-data-file "sample.emacs")]
1419        ["Sample .%_Xdefaults"
1420         (find-file (locate-data-file "sample.Xdefaults"))
1421         :active (locate-data-file "sample.Xdefaults")]
1422        ["Sample e%_nriched"
1423         (find-file (locate-data-file "enriched.doc"))
1424         :active (locate-data-file "enriched.doc")])
1425       ("%_Commands & Keys"
1426        ["%_Mode" describe-mode]
1427        ["%_Apropos..." hyper-apropos]
1428        ["Apropos %_Docs..." apropos-documentation]
1429        "-----"
1430        ["%_Key..." describe-key]
1431        ["%_Bindings" describe-bindings]
1432        ["%_Mouse Bindings" describe-pointer]
1433        ["%_Recent Keys" view-lossage]
1434        "-----"
1435        ["%_Function..." describe-function]
1436        ["%_Variable..." describe-variable]
1437        ["%_Locate Command..." where-is])
1438       "-----"
1439       ["%_Recent Messages" view-lossage]
1440       ("%_Misc"
1441        ["%_Current Installation Info" describe-installation
1442         :active (boundp 'Installation-string)]
1443        ["%_No Warranty" describe-no-warranty]
1444        ["XEmacs %_License" describe-copying]
1445        ["Find %_Packages" finder-by-keyword]
1446        ["View %_Splash Screen" xemacs-splash-buffer]
1447        ["%_Unix Manual..." manual-entry])
1448       ["Send %_Bug Report..." report-emacs-bug
1449        :active (fboundp 'report-emacs-bug)]))))
1450
1451 \f
1452 (defun maybe-add-init-button ()
1453   "Don't call this.
1454 Adds `Load .emacs' button to menubar when starting up with -q."
1455   (when (and (not load-user-init-file-p)
1456              (file-exists-p (expand-file-name ".emacs" "~")))
1457     (add-menu-button
1458      nil
1459      ["%_Load .emacs"
1460       (progn
1461         (mapc #'(lambda (buf)
1462                  (with-current-buffer buf
1463                    (delete-menu-item '("Load .emacs"))))
1464               (buffer-list))
1465         (load-user-init-file))
1466       ]
1467      "Help")))
1468
1469 (add-hook 'before-init-hook 'maybe-add-init-button)
1470
1471 \f
1472 ;;; The File menu
1473
1474 (defvar put-buffer-names-in-file-menu t)
1475
1476 \f
1477 ;;; The Bookmarks menu
1478
1479 (defun bookmark-menu-filter (&rest ignore)
1480   (let ((definedp (and (boundp 'bookmark-alist)
1481                        bookmark-alist
1482                        t)))
1483     `(,(if definedp
1484            '("%_Jump to Bookmark"
1485              :filter (lambda (&rest junk)
1486                        (mapcar #'(lambda (bmk)
1487                                    `[,bmk (bookmark-jump ',bmk)])
1488                                (bookmark-all-names))))
1489          ["%_Jump to Bookmark" nil nil])
1490       ["Set %_Bookmark" bookmark-set
1491        :active (fboundp 'bookmark-set)]
1492       "---"
1493       ["Insert %_Contents" bookmark-menu-insert
1494        :active (fboundp 'bookmark-menu-insert)]
1495       ["Insert L%_ocation" bookmark-menu-locate
1496        :active (fboundp 'bookmark-menu-locate)]
1497       "---"
1498       ["%_Rename Bookmark" bookmark-menu-rename
1499        :active (fboundp 'bookmark-menu-rename)]
1500       ,(if definedp
1501            '("%_Delete Bookmark"
1502              :filter (lambda (&rest junk)
1503                        (mapcar #'(lambda (bmk)
1504                                    `[,bmk (bookmark-delete ',bmk)])
1505                                (bookmark-all-names))))
1506          ["%_Delete Bookmark" nil nil])
1507       ["%_Edit Bookmark List" bookmark-bmenu-list       ,definedp]
1508       "---"
1509       ["%_Save Bookmarks"        bookmark-save          ,definedp]
1510       ["Save Bookmarks %_As..."  bookmark-write         ,definedp]
1511       ["%_Load a Bookmark File" bookmark-load
1512        :active (fboundp 'bookmark-load)])))
1513
1514 ;;; The Buffers menu
1515
1516 (defgroup buffers-menu nil
1517   "Customization of `Buffers' menu."
1518   :group 'menu)
1519
1520 (defvar buffers-menu-omit-chars-list '(?b ?p ?l))
1521
1522 (defcustom buffers-menu-max-size 25
1523   "*Maximum number of entries which may appear on the \"Buffers\" menu.
1524 If this is 10, then only the ten most-recently-selected buffers will be
1525 shown.  If this is nil, then all buffers will be shown.  Setting this to
1526 a large number or nil will slow down menu responsiveness."
1527   :type '(choice (const :tag "Show all" nil)
1528                  (integer 10))
1529   :group 'buffers-menu)
1530
1531 (defcustom complex-buffers-menu-p nil
1532   "*If non-nil, the buffers menu will contain several commands.
1533 Commands will be presented as submenus of each buffer line.  If this
1534 is false, then there will be only one command: select that buffer."
1535   :type 'boolean
1536   :group 'buffers-menu)
1537
1538 (defcustom buffers-menu-submenus-for-groups-p nil
1539   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1540 The grouping function is specified in `buffers-menu-grouping-function'.
1541 If this is an integer, do not build submenus if the number of buffers
1542 is not larger than this value."
1543   :type '(choice (const :tag "No Subgroups" nil)
1544                  (integer :tag "Max. submenus" 10)
1545                  (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1546   :group 'buffers-menu)
1547
1548 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1549   "*The function to call to select a buffer from the buffers menu.
1550 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1551   :type '(radio (function-item switch-to-buffer)
1552                 (function-item pop-to-buffer)
1553                 (function :tag "Other"))
1554   :group 'buffers-menu)
1555
1556 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1557   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1558 This is passed a buffer and should return non-nil if the buffer should be
1559 omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
1560 buffers that are normally considered \"invisible\" (those whose name
1561 begins with a space)."
1562   :type '(choice (const :tag "None" nil)
1563                  function)
1564   :group 'buffers-menu)
1565
1566 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1567   "*The function to call to return a string to represent a buffer in
1568 the buffers menu.  The function is passed a buffer and a number
1569 (starting with 1) indicating which buffer line in the menu is being
1570 processed and should return a string containing an accelerator
1571 spec. (Check out `menu-item-generate-accelerator-spec' as a convenient
1572 way of generating the accelerator specs.) The default value
1573 `format-buffers-menu-line' just returns the name of the buffer and
1574 uses the number as the accelerator.  Also check out
1575 `slow-format-buffers-menu-line' which returns a whole bunch of info
1576 about a buffer.
1577
1578 Note: Gross Compatibility Hack: Older versions of this function prototype
1579 only expected one argument, not two.  We deal gracefully with such
1580 functions by simply calling them with one argument and leaving out the
1581 line number.  However, this may go away at any time, so make sure to
1582 update all of your functions of this type."
1583   :type 'function
1584   :group 'buffers-menu)
1585
1586 (defcustom buffers-menu-sort-function
1587   'sort-buffers-menu-by-mode-then-alphabetically
1588   "*If non-nil, a function to sort the list of buffers in the buffers menu.
1589 It will be passed two arguments (two buffers to compare) and should return
1590 t if the first is \"less\" than the second.  One possible value is
1591 `sort-buffers-menu-alphabetically'; another is
1592 `sort-buffers-menu-by-mode-then-alphabetically'."
1593   :type '(choice (const :tag "None" nil)
1594                  function)
1595   :group 'buffers-menu)
1596
1597 (defcustom buffers-menu-grouping-function
1598   'group-buffers-menu-by-mode-then-alphabetically
1599   "*If non-nil, a function to group buffers in the buffers menu together.
1600 It will be passed two arguments, successive members of the sorted buffers
1601 list after being passed through `buffers-menu-sort-function'.  It should
1602 return non-nil if the second buffer begins a new group.  The return value
1603 should be the name of the old group, which may be used in hierarchical
1604 buffers menus.  The last invocation of the function contains nil as the
1605 second argument, so that the name of the last group can be determined.
1606
1607 The sensible values of this function are dependent on the value specified
1608 for `buffers-menu-sort-function'."
1609   :type '(choice (const :tag "None" nil)
1610                  function)
1611   :group 'buffers-menu)
1612
1613 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1614   "For use as a value of `buffers-menu-sort-function'.
1615 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1616 with a star at the end of the list."
1617   (let* ((nam1 (buffer-name buf1))
1618          (nam2 (buffer-name buf2))
1619          (inv1p (not (null (string-match "\\` " nam1))))
1620          (inv2p (not (null (string-match "\\` " nam2))))
1621          (star1p (not (null (string-match "\\`*" nam1))))
1622          (star2p (not (null (string-match "\\`*" nam2)))))
1623     (cond ((not (eq inv1p inv2p))
1624            (not inv1p))
1625           ((not (eq star1p star2p))
1626            (not star1p))
1627           (t
1628            (string-lessp nam1 nam2)))))
1629
1630 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1631   "For use as a value of `buffers-menu-sort-function'.
1632 Sorts first by major mode and then alphabetically by name, but puts buffers
1633 beginning with a star at the end of the list."
1634   (let* ((nam1 (buffer-name buf1))
1635          (nam2 (buffer-name buf2))
1636          (inv1p (not (null (string-match "\\` " nam1))))
1637          (inv2p (not (null (string-match "\\` " nam2))))
1638          (star1p (not (null (string-match "\\`*" nam1))))
1639          (star2p (not (null (string-match "\\`*" nam2))))
1640          (mode1 (symbol-value-in-buffer 'major-mode buf1))
1641          (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1642     (cond ((not (eq inv1p inv2p))
1643            (not inv1p))
1644           ((not (eq star1p star2p))
1645            (not star1p))
1646           ((and star1p star2p (string-lessp nam1 nam2)))
1647           ((string-lessp mode1 mode2)
1648            t)
1649           ((string-lessp mode2 mode1)
1650            nil)
1651           (t
1652            (string-lessp nam1 nam2)))))
1653
1654 ;; this version is too slow on some machines.
1655 ;; (vintage 1990, that is)
1656 (defun slow-format-buffers-menu-line (buffer n)
1657   "For use as a value of `buffers-menu-format-buffer-line-function'.
1658 This returns a string containing a bunch of info about the buffer."
1659   (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1660           (format "%s%s %-19s %6s %-15s %s"
1661                   (if (buffer-modified-p buffer) "*" " ")
1662                   (if (symbol-value-in-buffer 'buffer-read-only buffer)
1663                       "%" " ")
1664                   (buffer-name buffer)
1665                   (buffer-size buffer)
1666                   (symbol-value-in-buffer 'mode-name buffer)
1667                   (or (buffer-file-name buffer) ""))))
1668
1669 (defun format-buffers-menu-line (buffer n)
1670   "For use as a value of `buffers-menu-format-buffer-line-function'.
1671 This just returns the buffer's name."
1672   (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1673           (buffer-name buffer)))
1674
1675 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1676   "For use as a value of `buffers-menu-grouping-function'.
1677 This groups buffers by major mode.  It only really makes sense if
1678 `buffers-menu-sorting-function' is
1679 `sort-buffers-menu-by-mode-then-alphabetically'."
1680   (cond ((string-match "\\`*" (buffer-name buf1))
1681          (and (null buf2) "*Misc*"))
1682         ((or (null buf2)
1683              (string-match "\\`*" (buffer-name buf2))
1684              (not (eq (symbol-value-in-buffer 'major-mode buf1)
1685                       (symbol-value-in-buffer 'major-mode buf2))))
1686          (symbol-value-in-buffer 'mode-name buf1))
1687         (t nil)))
1688
1689 (defun buffer-menu-save-buffer (buffer)
1690   (save-excursion
1691     (set-buffer buffer)
1692     (save-buffer)))
1693
1694 (defun buffer-menu-write-file (buffer)
1695   (save-excursion
1696     (set-buffer buffer)
1697     (write-file (read-file-name
1698                  (format "Write %s to file: "
1699                          (buffer-name (current-buffer)))))))
1700
1701 (defsubst build-buffers-menu-internal (buffers)
1702   (let (name line (n 0))
1703     (mapcar
1704      #'(lambda (buffer)
1705          (if (eq buffer t)
1706              "---"
1707            (setq n (1+ n))
1708            (setq line
1709                  ; #### a truly Kyle-friendly hack.
1710                  (let ((fn buffers-menu-format-buffer-line-function))
1711                    (if (= (function-max-args fn) 1)
1712                        (funcall fn buffer)
1713                      (funcall fn buffer n))))
1714            (if complex-buffers-menu-p
1715                (delq nil
1716                      (list line
1717                            (vector "S%_witch to Buffer"
1718                                    (list buffers-menu-switch-to-buffer-function
1719                                          (setq name (buffer-name buffer)))
1720                                    t)
1721                            (if (eq buffers-menu-switch-to-buffer-function
1722                                    'switch-to-buffer)
1723                                (vector "Switch to Buffer, Other %_Frame"
1724                                        (list 'switch-to-buffer-other-frame
1725                                              (setq name (buffer-name buffer)))
1726                                        t)
1727                              nil)
1728                            (if (and (buffer-modified-p buffer)
1729                                     (buffer-file-name buffer))
1730                                (vector "%_Save Buffer"
1731                                        (list 'buffer-menu-save-buffer name) t)
1732                              ["%_Save Buffer" nil nil]
1733                              )
1734                            (vector "Save %_As..."
1735                                    (list 'buffer-menu-write-file name) t)
1736                            (vector "%_Delete Buffer" (list 'kill-buffer name)
1737                                    t)))
1738              ;; #### We don't want buffer names to be translated,
1739              ;; #### so we put the buffer name in the suffix.
1740              ;; #### Also, avoid losing with non-ASCII buffer names.
1741              ;; #### We still lose, however, if complex-buffers-menu-p. --mrb
1742              (vector ""
1743                      (list buffers-menu-switch-to-buffer-function
1744                            (buffer-name buffer))
1745                      t line))))
1746      buffers)))
1747
1748 (defun buffers-menu-filter (menu)
1749   "This is the menu filter for the top-level buffers \"Buffers\" menu.
1750 It dynamically creates a list of buffers to use as the contents of the menu.
1751 Only the most-recently-used few buffers will be listed on the menu, for
1752 efficiency reasons.  You can control how many buffers will be shown by
1753 setting `buffers-menu-max-size'.  You can control the text of the menu
1754 items by redefining the function `format-buffers-menu-line'."
1755   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1756     (and (integerp buffers-menu-max-size)
1757          (> buffers-menu-max-size 1)
1758          (> (length buffers) buffers-menu-max-size)
1759          ;; shorten list of buffers (not with submenus!)
1760          (not (and buffers-menu-grouping-function
1761                    buffers-menu-submenus-for-groups-p))
1762          (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1763     (if buffers-menu-sort-function
1764         (setq buffers (sort buffers buffers-menu-sort-function)))
1765     (if (and buffers-menu-grouping-function
1766              buffers-menu-submenus-for-groups-p
1767              (or (not (integerp buffers-menu-submenus-for-groups-p))
1768                  (> (length buffers) buffers-menu-submenus-for-groups-p)))
1769         (let (groups groupnames current-group)
1770           (mapl
1771            #'(lambda (sublist)
1772                (let ((groupname (funcall buffers-menu-grouping-function
1773                                          (car sublist) (cadr sublist))))
1774                  (setq current-group (cons (car sublist) current-group))
1775                  (if groupname
1776                      (progn
1777                        (setq groups (cons (nreverse current-group)
1778                                           groups))
1779                        (setq groupnames (cons groupname groupnames))
1780                        (setq current-group nil)))))
1781            buffers)
1782           (setq buffers
1783                 (mapcar*
1784                  #'(lambda (groupname group)
1785                      (cons groupname (build-buffers-menu-internal group)))
1786                  (nreverse groupnames)
1787                  (nreverse groups))))
1788       (if buffers-menu-grouping-function
1789           (progn
1790             (setq buffers
1791                   (mapcon
1792                    #'(lambda (sublist)
1793                        (cond ((funcall buffers-menu-grouping-function
1794                                        (car sublist) (cadr sublist))
1795                               (list (car sublist) t))
1796                              (t (list (car sublist)))))
1797                    buffers))
1798             ;; remove a trailing separator.
1799             (and (>= (length buffers) 2)
1800                  (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1801                    (if (eq t (cadr lastcdr))
1802                        (setcdr lastcdr nil))))))
1803       (setq buffers (build-buffers-menu-internal buffers)))
1804     (append menu buffers)
1805     ))
1806
1807 (defun language-environment-menu-filter (menu)
1808   "This is the menu filter for the \"Language Environment\" submenu."
1809   (let ((n 0))
1810     (mapcar (lambda (env-sym)
1811               (setq n (1+ n))
1812               `[ ,(concat (menu-item-generate-accelerator-spec n)
1813                           (capitalize (symbol-name env-sym)))
1814                  (set-language-environment ',env-sym)])
1815             language-environment-list)))
1816
1817 \f
1818 ;;; The Options menu
1819
1820 ;; We'll keep those variables here for a while, in order to provide a
1821 ;; function for porting the old options file that a user may own to Custom.
1822
1823 (defvar options-save-faces nil
1824   "*Non-nil value means save-options will save information about faces.
1825 A nil value means save-options will not save face information.
1826 Set this non-nil only if you use M-x edit-faces to change face
1827 settings.  If you use M-x customize-face or the \"Browse Faces...\"
1828 menu entry, you will see a button in the Customize Face buffer that you
1829 can use to permanently save your face changes.
1830
1831 M-x edit-faces is deprecated.  Support for it and this variable will
1832 be discontinued in a future release.")
1833
1834 (defvar save-options-init-file nil
1835   "File into which to save forms to load the options file (nil for .emacs).
1836 Normally this is nil, which means save into your .emacs file (the value
1837 of `user-init-file'.")
1838
1839 (defvar save-options-file ".xemacs-options"
1840   "File to save options into.
1841 This file is loaded from your .emacs file.
1842 If this is a relative filename, it is put into the same directory as your
1843 .emacs file.")
1844
1845
1846 \f
1847 ;;; The Help menu
1848
1849 (defun tutorials-menu-filter (menu-items)
1850    (append
1851     (if (featurep 'mule)
1852         (if (assq 'tutorial
1853                   (assoc current-language-environment language-info-alist))
1854             `([,(concat "%_Default (" current-language-environment ")")
1855                help-with-tutorial]))
1856       '(["%_English" help-with-tutorial]))
1857     (submenu-generate-accelerator-spec
1858      (if (featurep 'mule)
1859          ;; Mule tutorials.
1860          (mapcan #'(lambda (lang)
1861                      (let ((tut (assq 'tutorial lang)))
1862                        (and tut
1863                             (not (string= (car lang) "ASCII"))
1864                             ;; skip current language, since we already
1865                             ;; included it first
1866                             (not (string= (car lang)
1867                                           current-language-environment))
1868                             `([,(car lang)
1869                                (help-with-tutorial nil ,(cdr tut))]))))
1870                  language-info-alist)
1871        ;; Non mule tutorials.
1872        (mapcar #'(lambda (lang)
1873                    `[,(car lang)
1874                      (help-with-tutorial ,(format "TUTORIAL.%s"
1875                                                   (cadr lang)))])
1876                tutorial-supported-languages)))))
1877
1878 \f
1879 (set-menubar default-menubar)
1880
1881 \f
1882 ;;; Popup menus.
1883
1884 (defconst default-popup-menu
1885   '("XEmacs Commands"
1886     ["%_Undo" advertised-undo
1887      :active (and (not (eq buffer-undo-list t))
1888                   (or buffer-undo-list pending-undo-list))
1889      :suffix (if (or (eq last-command 'undo)
1890                      (eq last-command 'advertised-undo))
1891                  "More" "")]
1892     ["Cu%_t" kill-primary-selection
1893      :active (selection-owner-p)]
1894     ["%_Copy" copy-primary-selection
1895      :active (selection-owner-p)]
1896     ["%_Paste" yank-clipboard-selection
1897      :active (selection-exists-p 'CLIPBOARD)]
1898     ["%_Delete" delete-primary-selection
1899      :active (selection-owner-p)]
1900     "-----"
1901     ["Select %_Block" mark-paragraph]
1902     ["Sp%_lit Window" split-window-vertically]
1903     ["U%_nsplit Window" delete-other-windows]
1904     ))
1905
1906 (defvar global-popup-menu nil
1907   "The global popup menu.  This is present in all modes.
1908 See the function `popup-menu' for a description of menu syntax.")
1909
1910 (defvar mode-popup-menu nil
1911   "The mode-specific popup menu.  Automatically buffer local.
1912 This is appended to the default items in `global-popup-menu'.
1913 See the function `popup-menu' for a description of menu syntax.")
1914 (make-variable-buffer-local 'mode-popup-menu)
1915
1916 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1917 ;; superseded by any local popup menu...
1918 (setq-default mode-popup-menu default-popup-menu)
1919
1920 (defvar activate-popup-menu-hook nil
1921   "Function or functions run before a mode-specific popup menu is made visible.
1922 These functions are called with no arguments, and should interrogate and
1923 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1924 Note: this hook is only run if you use `popup-mode-menu' for activating the
1925 global and mode-specific commands; if you have your own binding for button3,
1926 this hook won't be run.")
1927
1928 (defun popup-mode-menu ()
1929   "Pop up a menu of global and mode-specific commands.
1930 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1931   (interactive "@_")
1932   (run-hooks 'activate-popup-menu-hook)
1933   (popup-menu
1934    (cond ((and global-popup-menu mode-popup-menu)
1935           ;; Merge global-popup-menu and mode-popup-menu
1936           (check-menu-syntax mode-popup-menu)
1937           (let* ((title (car mode-popup-menu))
1938                  (items (cdr mode-popup-menu))
1939                  mode-filters)
1940             ;; Strip keywords from local menu for attaching them at the top
1941             (while (and items
1942                         (keywordp (car items)))
1943               ;; Push both keyword and its argument.
1944               (push (pop items) mode-filters)
1945               (push (pop items) mode-filters))
1946             (setq mode-filters (nreverse mode-filters))
1947             ;; If mode-filters contains a keyword already present in
1948             ;; `global-popup-menu', you will probably lose.
1949             (append (list (car global-popup-menu))
1950                     mode-filters
1951                     (cdr global-popup-menu)
1952                     '("---" "---")
1953                     (if popup-menu-titles (list title))
1954                     (if popup-menu-titles '("---" "---"))
1955                     items)))
1956          (t
1957           (or mode-popup-menu
1958               global-popup-menu
1959               (error "No menu defined in this buffer"))))))
1960
1961 (defun popup-buffer-menu (event)
1962   "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1963   (interactive "e")
1964   (let ((window (and (event-over-text-area-p event) (event-window event)))
1965         (bmenu nil))
1966     (or window
1967         (error "Pointer must be in a normal window"))
1968     (select-window window)
1969     (if current-menubar
1970         (setq bmenu (assoc "%_Buffers" current-menubar)))
1971     (if (null bmenu)
1972         (setq bmenu (assoc "%_Buffers" default-menubar)))
1973     (if (null bmenu)
1974         (error "Can't find the Buffers menu"))
1975     (popup-menu bmenu)))
1976
1977 (defun popup-menubar-menu (event)
1978   "Pop up a copy of menu that also appears in the menubar."
1979   (interactive "e")
1980   (let ((window (and (event-over-text-area-p event) (event-window event)))
1981         popup-menubar)
1982     (or window
1983         (error "Pointer must be in a normal window"))
1984     (select-window window)
1985     (and current-menubar (run-hooks 'activate-menubar-hook))
1986     ;; #### Instead of having to copy this just to safely get rid of
1987     ;; any nil what we should really do is fix up the internal menubar
1988     ;; code to just ignore nil if generating a popup menu
1989     (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1990                                                        default-menubar))))
1991     (popup-menu (cons "%_Menubar Menu" popup-menubar))
1992     ))
1993
1994 (global-set-key 'button3 'popup-mode-menu)
1995 ;; shift button3 and shift button2 are reserved for Hyperbole
1996 (global-set-key '(meta control button3) 'popup-buffer-menu)
1997 ;; The following command is way too dangerous with Custom.
1998 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1999
2000 ;; Here's a test of the cool new menu features (from Stig).
2001
2002 ;;(setq mode-popup-menu
2003 ;;      '("Test Popup Menu"
2004 ;;        :filter cdr
2005 ;;        ["this item won't appear because of the menu filter" ding t]
2006 ;;        "--:singleLine"
2007 ;;        "singleLine"
2008 ;;        "--:doubleLine"
2009 ;;        "doubleLine"
2010 ;;        "--:singleDashedLine"
2011 ;;        "singleDashedLine"
2012 ;;        "--:doubleDashedLine"
2013 ;;        "doubleDashedLine"
2014 ;;        "--:noLine"
2015 ;;        "noLine"
2016 ;;        "--:shadowEtchedIn"
2017 ;;        "shadowEtchedIn"
2018 ;;        "--:shadowEtchedOut"
2019 ;;        "shadowEtchedOut"
2020 ;;        "--:shadowDoubleEtchedIn"
2021 ;;        "shadowDoubleEtchedIn"
2022 ;;        "--:shadowDoubleEtchedOut"
2023 ;;        "shadowDoubleEtchedOut"
2024 ;;        "--:shadowEtchedInDash"
2025 ;;        "shadowEtchedInDash"
2026 ;;        "--:shadowEtchedOutDash"
2027 ;;        "shadowEtchedOutDash"
2028 ;;        "--:shadowDoubleEtchedInDash"
2029 ;;        "shadowDoubleEtchedInDash"
2030 ;;        "--:shadowDoubleEtchedOutDash"
2031 ;;        "shadowDoubleEtchedOutDash"
2032 ;;        ))
2033
2034 (defun xemacs-splash-buffer ()
2035   "Redisplay XEmacs splash screen in a buffer."
2036   (interactive)
2037   (let ((buffer (get-buffer-create "*Splash*"))
2038         tmout)
2039     (set-buffer buffer)
2040     (setq buffer-read-only t)
2041     (erase-buffer buffer)
2042     (setq tmout (display-splash-frame))
2043     (when tmout
2044       (make-local-hook 'kill-buffer-hook)
2045       (add-hook 'kill-buffer-hook
2046                 `(lambda ()
2047                    (disable-timeout ,tmout))
2048                 nil t))
2049     (pop-to-buffer buffer)
2050     (delete-other-windows)))
2051
2052 \f
2053 ;;; backwards compatibility
2054 (provide 'x-menubar)
2055 (provide 'menubar-items)
2056
2057 ;;; menubar-items.el ends here.