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