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