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 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 (defconst default-menubar
  45   (purecopy-menubar
  46    ;; note backquote.
  47    `(
  48      ("File"
  49       ["Open..." find-file]
  50       ["Open in Other Window..." find-file-other-window]
  51       ["Open in New Frame..." find-file-other-frame]
  52       ["Insert File..." insert-file]
  53       ["View File..." view-file]
  54       "------"
  55       ["Save" save-buffer
  56        :active (buffer-modified-p)
  57        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  58       ["Save As..." write-file]
  59       ["Save Some Buffers" save-some-buffers]
  60       "-----"
  61       ["Print Buffer" lpr-buffer
  62        :active (fboundp 'lpr-buffer)
  63        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  64       ["Pretty-Print Buffer" ps-print-buffer-with-faces
  65        :active (fboundp 'ps-print-buffer-with-faces)
  66        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  67       "-----"
  68       ["New Frame" make-frame]
  69       ["Frame on Other Display..." make-frame-on-display]
  70       ["Delete Frame" delete-frame
  71        :active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
  72                         (selected-frame)))]
  73       "-----"
  74       ["Split Window" split-window-vertically]
  75       ["Un-Split (Keep This)" delete-other-windows
  76        :active (not (one-window-p t))]
  77       ["Un-Split (Keep Others)" delete-window
  78        :active (not (one-window-p t))]
  79       "-----"
  80       ["Revert Buffer" revert-buffer
  81        :active (or buffer-file-name revert-buffer-function)
  82        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  83       ["Delete Buffer" kill-this-buffer
  84        :active t
  85        :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
  86       "-----"
  87       ["Exit XEmacs" save-buffers-kill-emacs]
  88       )
  89
  90      ("Edit"
  91       ["Undo" advertised-undo
  92        :active (and (not (eq buffer-undo-list t))
  93                     (or buffer-undo-list pending-undo-list))
  94        :suffix (if (or (eq last-command 'undo)
  95                        (eq last-command 'advertised-undo))
  96                        "More" "")]
  97       ["Redo" redo
  98        :included (fboundp 'redo)
  99        :active (not (or (eq buffer-undo-list t)
 100                          (eq last-buffer-undo-list nil)
 101                          (not (or (eq last-buffer-undo-list buffer-undo-list)
 102                                   (and (null (car-safe buffer-undo-list))
 103                                        (eq last-buffer-undo-list
 104                                            (cdr-safe buffer-undo-list)))))
 105                          (or (eq buffer-undo-list pending-undo-list)
 106                              (eq (cdr buffer-undo-list) pending-undo-list))))
 107        :suffix (if (eq last-command 'redo) "More" "")]
 108       ["Cut" kill-primary-selection
 109        :active (selection-owner-p)]
 110       ["Copy" copy-primary-selection
 111        :active (selection-owner-p)]
 112       ["Paste" yank-clipboard-selection
 113        :active (selection-exists-p 'CLIPBOARD)]
 114       ["Clear" delete-primary-selection
 115        :active (selection-owner-p)]
 116       "----"
 117       ["Search..." isearch-forward]
 118       ["Search Backward..." isearch-backward]
 119       ["Replace..." query-replace]
 120       "----"
 121       ["Search (Regexp)..." isearch-forward-regexp]
 122       ["Search Backward (Regexp)..." isearch-backward-regexp]
 123       ["Replace (Regexp)..." query-replace-regexp]
 124       "----"
 125       ["Goto Line..." goto-line]
 126       ["What Line" what-line]
 127       ("Bookmarks"
 128        :filter bookmark-menu-filter)
 129       "----"
 130       ["Start Macro Recording" start-kbd-macro
 131        :active (not defining-kbd-macro)]
 132       ["End Macro Recording" end-kbd-macro
 133        :active defining-kbd-macro]
 134       ["Execute Last Macro" call-last-kbd-macro
 135        :active last-kbd-macro]
 136       "----"
 137       ["Show Message Log" show-message-log]
 138       )
 139
 140      ,@(if (featurep 'mule)
 141            '(("Mule"
 142               ("Describe language support")
 143               ("Set language environment")
 144               "--"
 145               ["Toggle input method" toggle-input-method]
 146               ["Select input method" select-input-method]
 147               ["Describe input method" describe-input-method]
 148               "--"
 149               ["Describe current coding systems"
 150                describe-current-coding-system]
 151               ["Set coding system of buffer file"
 152                set-buffer-file-coding-system]
 153               ;; not implemented yet
 154               ["Set coding system of terminal"
 155                set-terminal-coding-system :active nil]
 156               ;; not implemented yet
 157               ["Set coding system of keyboard"
 158                set-keyboard-coding-system :active nil]
 159               ;; not implemented yet
 160               ["Set coding system of process"
 161                set-current-process-coding-system :active nil]
 162               "--"
 163               ["Show character table" view-charset-by-menu]
 164               ;; not implemented yet
 165               ["Show diagnosis for MULE" mule-diag :active nil]
 166               ["Show many languages" view-hello-file])))
 167
 168      ("Apps"
 169       ["Read Mail (VM)..." vm
 170        :active (fboundp 'vm)]
 171       ["Read Mail (MH)..." (mh-rmail t)
 172        :active (fboundp 'mh-rmail)]
 173       ["Send mail..." compose-mail
 174        :active (fboundp 'compose-mail)]
 175       ["Usenet News" gnus
 176        :active (fboundp 'gnus)]
 177       ["Browse the Web" w3
 178        :active (fboundp 'w3)]
 179       "----"
 180       ["Spell-Check Buffer" ispell-buffer
 181        :active (fboundp 'ispell-buffer)]
 182       ["Toggle VI emulation" toggle-viper-mode
 183        :active (fboundp 'toggle-viper-mode)]
 184       "----"
 185       ("Calendar"
 186        ["3-Month Calendar" calendar
 187         :active (fboundp 'calendar)]
 188        ["Diary" diary
 189         :active (fboundp 'diary)]
 190        ["Holidays" holidays
 191         :active (fboundp 'holidays)]
 192        ;; we're all pagans at heart ...
 193        ["Phases of the Moon" phases-of-moon
 194         :active (fboundp 'phases-of-moon)]
 195        ["Sunrise/Sunset" sunrise-sunset
 196         :active (fboundp 'sunrise-sunset)])
 197
 198       ("Games"
 199        ["Mine Game" xmine
 200         :active (fboundp 'xmine)]
 201        ["Tetris" tetris
 202         :active (fboundp 'tetris)]
 203        ["Sokoban" sokoban
 204         :active (fboundp 'sokoban)]
 205        ["Quote from Zippy" yow
 206         :active (fboundp 'yow)]
 207        ["Psychoanalyst" doctor
 208         :active (fboundp 'doctor)]
 209        ["Psychoanalyze Zippy!" psychoanalyze-pinhead
 210         :active (fboundp 'psychoanalyze-pinhead)]
 211        ["Random Flames" flame
 212         :active (fboundp 'flame)]
 213        ["Dunnet (Adventure)" dunnet
 214         :active (fboundp 'dunnet)]
 215        ["Towers of Hanoi" hanoi
 216         :active (fboundp 'hanoi)]
 217        ["Game of Life" life
 218         :active (fboundp 'life)]
 219        ["Multiplication Puzzle" mpuz
 220         :active (fboundp 'mpuz)]))
 221
 222      ("Options"
 223       ("Customize"
 224        ("Emacs" :filter (lambda (&rest junk)
 225                           (cdr (custom-menu-create 'emacs))))
 226        ["Group..." customize-group]
 227        ["Variable..." customize-variable]
 228        ["Face..." customize-face]
 229        ["Saved..." customize-saved]
 230        ["Set..." customize-customized]
 231        ["Apropos..." customize-apropos]
 232        ["Browse..." customize-browse])
 233
 234       ("Manage Packages"
 235        ("Add Download Site"
 236         :filter (lambda (&rest junk)
 237                   (package-get-download-menu)))
 238        ["Update Package Index" package-get-update-base]
 239        ["List & Install" pui-list-packages]
 240        ("Using Custom"
 241         ("Select" :filter (lambda (&rest junk)
 242                           (cdr (custom-menu-create 'packages))))
 243         ["Update" package-get-custom])
 244        ["Help" (Info-goto-node "(xemacs)Packages")])
 245
 246       "---"
 247
 248       ("Editing Options"
 249        ["Overstrike"
 250         (progn
 251           (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
 252           (customize-set-variable 'overwrite-mode overwrite-mode))
 253         :style toggle :selected overwrite-mode]
 254        ["Case Sensitive Search"
 255         (customize-set-variable 'case-fold-search
 256                                 (setq case-fold-search (not case-fold-search)))
 257         :style toggle :selected (not case-fold-search)]
 258        ["Case Matching Replace"
 259         (customize-set-variable 'case-replace (not case-replace))
 260         :style toggle :selected case-replace]
 261        ["Auto Delete Selection"
 262         (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
 263         :style toggle
 264         :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
 265         :active (boundp 'pending-delete-mode)]
 266        ["Active Regions"
 267         (customize-set-variable 'zmacs-regions (not zmacs-regions))
 268         :style toggle :selected zmacs-regions]
 269        ["Mouse Paste At Text Cursor"
 270         (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
 271         :style toggle :selected mouse-yank-at-point]
 272        ("Newline at end of file..."
 273         ["Don't require"
 274          (customize-set-variable 'require-final-newline nil)
 275          :style radio :selected (not require-final-newline)]
 276         ["Require"
 277          (customize-set-variable 'require-final-newline t)
 278          :style radio :selected (eq require-final-newline t)]
 279         ["Ask"
 280          (customize-set-variable 'require-final-newline 'ask)
 281          :style radio :selected (and require-final-newline
 282                                      (not (eq require-final-newline t)))])
 283        ["Add Newline When Moving Past End"
 284         (customize-set-variable 'next-line-add-newlines
 285                                 (not next-line-add-newlines))
 286         :style toggle :selected next-line-add-newlines]
 287        )
 288       ("General Options"
 289        ["Teach Extended Commands"
 290         (customize-set-variable 'teach-extended-commands-p
 291                                 (not teach-extended-commands-p))
 292         :style toggle :selected teach-extended-commands-p]
 293        ["Debug On Error"
 294         (customize-set-variable 'debug-on-error (not debug-on-error))
 295         :style toggle :selected debug-on-error]
 296        ["Debug On Quit"
 297         (customize-set-variable 'debug-on-quit (not debug-on-quit))
 298         :style toggle :selected debug-on-quit]
 299        )
 300       ("Printing Options"
 301        ["Command-Line Switches for `lpr'/`lp'..."
 302         ;; better to directly open a customization buffer, since the value
 303         ;; must be a list of strings, which is somewhat complex to prompt for.
 304         (customize-variable 'lpr-switches)
 305         (boundp 'lpr-switches)]
 306        ("Pretty-Print Paper Size"
 307         ["Letter"
 308          (customize-set-variable 'ps-paper-type 'letter)
 309          :style radio
 310          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
 311          :active (boundp 'ps-paper-type)]
 312         ["Letter-small"
 313          (customize-set-variable 'ps-paper-type 'letter-small)
 314          :style radio
 315          :selected (and (boundp 'ps-paper-type)
 316                         (eq ps-paper-type 'letter-small))
 317          :active (boundp 'ps-paper-type)]
 318         ["Legal"
 319          (customize-set-variable 'ps-paper-type 'legal)
 320          :style radio
 321          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
 322          :active (boundp 'ps-paper-type)]
 323         ["Statement"
 324          (customize-set-variable 'ps-paper-type 'statement)
 325          :style radio
 326          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
 327          :active (boundp 'ps-paper-type)]
 328         ["Executive"
 329          (customize-set-variable 'ps-paper-type 'executive)
 330          :style radio
 331          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
 332          :active (boundp 'ps-paper-type)]
 333         ["Tabloid"
 334          (customize-set-variable 'ps-paper-type 'tabloid)
 335          :style radio
 336          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
 337          :active (boundp 'ps-paper-type)]
 338         ["Ledger"
 339          (customize-set-variable 'ps-paper-type 'ledger)
 340          :style radio
 341          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
 342          :active (boundp 'ps-paper-type)]
 343         ["A3"
 344          (customize-set-variable 'ps-paper-type 'a3)
 345          :style radio
 346          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
 347          :active (boundp 'ps-paper-type)]
 348         ["A4"
 349          (customize-set-variable 'ps-paper-type 'a4)
 350          :style radio
 351          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
 352          :active (boundp 'ps-paper-type)]
 353         ["A4small"
 354          (customize-set-variable 'ps-paper-type 'a4small)
 355          :style radio
 356          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
 357          :active (boundp 'ps-paper-type)]
 358         ["B4"
 359          (customize-set-variable 'ps-paper-type 'b4)
 360          :style radio
 361          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
 362          :active (boundp 'ps-paper-type)]
 363         ["B5"
 364          (customize-set-variable 'ps-paper-type 'b5)
 365          :style radio
 366          :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
 367          :active (boundp 'ps-paper-type)]
 368         )
 369        ["Color Printing"
 370         (cond (ps-print-color-p
 371                (customize-set-variable 'ps-print-color-p nil)
 372                ;; I'm wondering whether all this muck is usefull.
 373                (and (boundp 'original-face-background)
 374                     original-face-background
 375                     (set-face-background 'default original-face-background)))
 376               (t
 377                (customize-set-variable 'ps-print-color-p t)
 378                (setq original-face-background
 379                      (face-background-instance 'default))
 380                (set-face-background 'default "white")))
 381         :style toggle
 382         :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
 383         :active (boundp 'ps-print-color-p)])
 384       ("\"Other Window\" Location"
 385        ["Always in Same Frame"
 386         (customize-set-variable
 387          'get-frame-for-buffer-default-instance-limit nil)
 388         :style radio
 389         :selected (null get-frame-for-buffer-default-instance-limit)]
 390        ["Other Frame (2 Frames Max)"
 391         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2)
 392         :style radio
 393         :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
 394        ["Other Frame (3 Frames Max)"
 395         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3)
 396         :style radio
 397         :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
 398        ["Other Frame (4 Frames Max)"
 399         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4)
 400         :style radio
 401         :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
 402        ["Other Frame (5 Frames Max)"
 403         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5)
 404         :style radio
 405         :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
 406        ["Always Create New Frame"
 407         (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0)
 408         :style radio
 409         :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
 410        "-----"
 411        ["Temp Buffers Always in Same Frame"
 412         (customize-set-variable 'temp-buffer-show-function
 413                                 'show-temp-buffer-in-current-frame)
 414         :style radio
 415         :selected (eq temp-buffer-show-function
 416                       'show-temp-buffer-in-current-frame)]
 417        ["Temp Buffers Like Other Buffers"
 418         (customize-set-variable 'temp-buffer-show-function nil)
 419         :style radio
 420         :selected (null temp-buffer-show-function)]
 421        "-----"
 422        ["Make current frame gnuserv target"
 423         (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
 424         :style toggle
 425         :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
 426         :active (boundp 'gnuserv-frame)]
 427        )
 428       "-----"
 429       ("Syntax Highlighting"
 430        ["In This Buffer"
 431         (progn ;; becomes buffer local
 432           (font-lock-mode)
 433           (customize-set-variable 'font-lock-mode font-lock-mode))
 434         :style toggle
 435         :selected (and (boundp 'font-lock-mode) font-lock-mode)
 436         :active (boundp 'font-lock-mode)]
 437        ["Automatic"
 438         (customize-set-variable 'font-lock-auto-fontify
 439                                 (not font-lock-auto-fontify))
 440         :style toggle
 441         :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
 442         :active (fboundp 'font-lock-mode)]
 443        "-----"
 444        ["Fonts"
 445         (progn
 446           (require 'font-lock)
 447           (font-lock-use-default-fonts)
 448           (customize-set-variable 'font-lock-use-fonts t)
 449           (customize-set-variable 'font-lock-use-colors nil)
 450           (font-lock-mode 1))
 451         :style radio
 452         :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
 453         :active (fboundp 'font-lock-mode)]
 454        ["Colors"
 455         (progn
 456           (require 'font-lock)
 457           (font-lock-use-default-colors)
 458           (customize-set-variable 'font-lock-use-colors t)
 459           (customize-set-variable 'font-lock-use-fonts nil)
 460           (font-lock-mode 1))
 461         :style radio
 462         :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
 463         :active (boundp 'font-lock-mode)]
 464        "-----"
 465        ["Least"
 466         (progn
 467           (require 'font-lock)
 468           (if (or (and (not (integerp font-lock-maximum-decoration))
 469                        (not (eq t font-lock-maximum-decoration)))
 470                   (and (integerp font-lock-maximum-decoration)
 471                        (<= font-lock-maximum-decoration 0)))
 472               nil
 473             (customize-set-variable 'font-lock-maximum-decoration nil)
 474             (font-lock-recompute-variables)))
 475         :style radio
 476         :active (fboundp 'font-lock-mode)
 477         :selected (and (boundp 'font-lock-maximium-decoration)
 478                        (or (and (not (integerp font-lock-maximum-decoration))
 479                                 (not (eq t font-lock-maximum-decoration)))
 480                            (and (integerp font-lock-maximum-decoration)
 481                                 (<= font-lock-maximum-decoration 0))))]
 482        ["More"
 483         (progn
 484           (require 'font-lock)
 485           (if (and (integerp font-lock-maximum-decoration)
 486                    (= 1 font-lock-maximum-decoration))
 487               nil
 488             (customize-set-variable 'font-lock-maximum-decoration 1)
 489             (font-lock-recompute-variables)))
 490         :style radio
 491         :active (fboundp 'font-lock-mode)
 492         :selected (and (boundp 'font-lock-maximium-decoration)
 493                        (integerp font-lock-maximum-decoration)
 494                        (= 1 font-lock-maximum-decoration))]
 495        ["Even More"
 496         (progn
 497           (require 'font-lock)
 498           (if (and (integerp font-lock-maximum-decoration)
 499                    (= 2 font-lock-maximum-decoration))
 500               nil
 501             (customize-set-variable 'font-lock-maximum-decoration 2)
 502             (font-lock-recompute-variables)))
 503         :style radio
 504         :active (fboundp 'font-lock-mode)
 505         :selected (and (boundp 'font-lock-maximum-decoration)
 506                        (integerp font-lock-maximum-decoration)
 507                        (= 2 font-lock-maximum-decoration))]
 508        ["Most"
 509         (progn
 510           (require 'font-lock)
 511           (if (or (eq font-lock-maximum-decoration t)
 512                   (and (integerp font-lock-maximum-decoration)
 513                        (>= font-lock-maximum-decoration 3)))
 514               nil
 515             (customize-set-variable 'font-lock-maximum-decoration t)
 516             (font-lock-recompute-variables)))
 517         :style radio
 518         :active (fboundp 'font-lock-mode)
 519         :selected (and (boundp 'font-lock-maximum-decoration)
 520                        (or (eq font-lock-maximum-decoration t)
 521                            (and (integerp font-lock-maximum-decoration)
 522                                 (>= font-lock-maximum-decoration 3))))]
 523        "-----"
 524        ["Lazy"
 525         (progn ;; becomes buffer local
 526           (lazy-shot-mode)
 527           (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
 528           ;; this shouldn't be necessary so there has to
 529           ;; be a redisplay bug lurking somewhere (or
 530           ;; possibly another event handler bug)
 531           (redraw-modeline))
 532         :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
 533                      font-lock-mode)
 534         :style toggle
 535         :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
 536        ["Caching"
 537         (progn ;; becomes buffer local
 538           (fast-lock-mode)
 539           (customize-set-variable 'fast-lock-mode fast-lock-mode)
 540           ;; this shouldn't be necessary so there has to
 541           ;; be a redisplay bug lurking somewhere (or
 542           ;; possibly another event handler bug)
 543           (redraw-modeline))
 544         :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
 545                      font-lock-mode)
 546         :style toggle
 547         :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
 548        )
 549       ("Paren Highlighting"
 550        ["None"
 551         (customize-set-variable 'paren-mode nil)
 552         :style radio
 553         :selected (and (boundp 'paren-mode) (not paren-mode))
 554         :active (boundp 'paren-mode)]
 555        ["Blinking Paren"
 556         (customize-set-variable 'paren-mode 'blink-paren)
 557         :style radio
 558         :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
 559         :active (boundp 'paren-mode)]
 560        ["Steady Paren"
 561         (customize-set-variable 'paren-mode 'paren)
 562         :style radio
 563         :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
 564         :active (boundp 'paren-mode)]
 565        ["Expression"
 566         (customize-set-variable 'paren-mode 'sexp)
 567         :style radio
 568         :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
 569         :active (boundp 'paren-mode)]
 570 ;;       ["Nested Shading"
 571 ;;        (customize-set-variable 'paren-mode 'nested)
 572 ;;        :style radio
 573 ;;        :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
 574 ;;        :active (boundp 'paren-mode)]
 575        )
 576       "-----"
 577       ("Frame Appearance"
 578        ["Frame-Local Font Menu"
 579         (customize-set-variable 'font-menu-this-frame-only-p
 580                                 (not font-menu-this-frame-only-p))
 581         :style toggle
 582         :selected (and (boundp 'font-menu-this-frame-only-p)
 583                        font-menu-this-frame-only-p)]
 584        ,@(if (featurep 'scrollbar)
 585              '(["Scrollbars"
 586                 (customize-set-variable 'scrollbars-visible-p
 587                                         (not scrollbars-visible-p))
 588                 :style toggle
 589                 :selected scrollbars-visible-p]))
 590        ;; I don't think this is of any interest. - dverna apr. 98
 591        ;; #### I beg to differ!  Many FSFmacs converts hate the 3D
 592        ;; modeline, and it was perfectly fine to be able to turn them
 593        ;; off through the Options menu.  I would have uncommented this
 594        ;; source, but the code for saving options would not save the
 595        ;; modeline 3D-ness.  Grrr.  --hniksic
 596 ;;       ["3D Modeline"
 597 ;;        (progn
 598 ;;          (if (zerop (specifier-instance modeline-shadow-thickness))
 599 ;;              (set-specifier modeline-shadow-thickness 2)
 600 ;;            (set-specifier modeline-shadow-thickness 0))
 601 ;;          (redraw-modeline t))
 602 ;;        :style toggle
 603 ;;        :selected (let ((thickness
 604 ;;                         (specifier-instance modeline-shadow-thickness)))
 605 ;;                    (and (integerp thickness)
 606 ;;                         (> thickness 0)))]
 607        ["Truncate Lines"
 608         (progn ;; becomes buffer-local
 609           (setq truncate-lines (not truncate-lines))
 610           (customize-set-variable 'truncate-lines truncate-lines))
 611         :style toggle
 612         :selected truncate-lines]
 613        ["Blinking Cursor"
 614         (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
 615         :style toggle
 616         :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
 617         :active (boundp 'blink-cursor-mode)]
 618        "-----"
 619        ["Block cursor"
 620         (progn
 621           (customize-set-variable 'bar-cursor nil)
 622           (force-cursor-redisplay))
 623         :style radio
 624         :selected (null bar-cursor)]
 625        ["Bar cursor (1 pixel)"
 626         (progn
 627           (customize-set-variable 'bar-cursor t)
 628           (force-cursor-redisplay))
 629         :style radio
 630         :selected (eq bar-cursor t)]
 631         ["Bar cursor (2 pixels)"
 632          (progn
 633            (customize-set-variable 'bar-cursor 2)
 634            (force-cursor-redisplay))
 635          :style radio
 636          :selected (and bar-cursor (not (eq bar-cursor t)))]
 637         "------"
 638         ["Line Numbers"
 639          (progn
 640            (customize-set-variable 'line-number-mode (not line-number-mode))
 641            (redraw-modeline))
 642          :style toggle :selected line-number-mode]
 643         ["Column Numbers"
 644          (progn
 645            (customize-set-variable 'column-number-mode
 646                                    (not column-number-mode))
 647            (redraw-modeline))
 648          :style toggle :selected column-number-mode]
 649        )
 650       ("Menubar Appearance"
 651        ["Buffers Menu Length..."
 652         (customize-set-variable
 653          'buffers-menu-max-size
 654          ;; would it be better to open a customization buffer ?
 655          (let ((val
 656                 (read-number
 657                  "Enter number of buffers to display (or 0 for unlimited): ")))
 658            (if (eq val 0) nil val)))]
 659        ["Multi-Operation Buffers Sub-Menus"
 660         (customize-set-variable 'complex-buffers-menu-p
 661                                 (not complex-buffers-menu-p))
 662         :style toggle
 663         :selected complex-buffers-menu-p]
 664        ("Buffers Menu Sorting"
 665         ["Most Recently Used"
 666          (progn
 667            (customize-set-variable 'buffers-menu-sort-function nil)
 668            (customize-set-variable 'buffers-menu-grouping-function nil))
 669          :style radio
 670          :selected (null buffers-menu-sort-function)]
 671         ["Alphabetically"
 672          (progn
 673            (customize-set-variable 'buffers-menu-sort-function
 674                                    'sort-buffers-menu-alphabetically)
 675            (customize-set-variable 'buffers-menu-grouping-function nil))
 676          :style radio
 677          :selected (eq 'sort-buffers-menu-alphabetically
 678                        buffers-menu-sort-function)]
 679         ["By Major Mode, Then Alphabetically"
 680          (progn
 681            (customize-set-variable
 682             'buffers-menu-sort-function
 683             'sort-buffers-menu-by-mode-then-alphabetically)
 684            (customize-set-variable
 685             'buffers-menu-grouping-function
 686             'group-buffers-menu-by-mode-then-alphabetically))
 687          :style radio
 688          :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
 689                        buffers-menu-sort-function)])
 690        ["Submenus for Buffer Groups"
 691         (customize-set-variable 'buffers-menu-submenus-for-groups-p
 692                                 (not buffers-menu-submenus-for-groups-p))
 693         :style toggle
 694         :selected buffers-menu-submenus-for-groups-p]
 695        "---"
 696        ["Ignore Scaled Fonts"
 697         (customize-set-variable 'font-menu-ignore-scaled-fonts
 698                                 (not font-menu-ignore-scaled-fonts))
 699         :style toggle
 700         :selected (and (boundp 'font-menu-ignore-scaled-fonts)
 701                        font-menu-ignore-scaled-fonts)]
 702        )
 703       ,@(if (featurep 'toolbar)
 704             '(("Toolbar Appearance"
 705                ["Visible"
 706                 (customize-set-variable 'toolbar-visible-p
 707                                         (not toolbar-visible-p))
 708                 :style toggle
 709                 :selected toolbar-visible-p]
 710                ["Captioned"
 711                 (customize-set-variable 'toolbar-captioned-p
 712                                         (not toolbar-captioned-p))
 713                 :style toggle
 714                 :selected toolbar-captioned-p]
 715                ("Default Location"
 716                 ["Top"
 717                  (customize-set-variable 'default-toolbar-position 'top)
 718                  :style radio
 719                  :selected (eq default-toolbar-position 'top)]
 720                 ["Bottom"
 721                  (customize-set-variable 'default-toolbar-position 'bottom)
 722                  :style radio
 723                  :selected (eq default-toolbar-position 'bottom)]
 724                 ["Left"
 725                  (customize-set-variable 'default-toolbar-position 'left)
 726                  :style radio
 727                  :selected (eq default-toolbar-position 'left)]
 728                 ["Right"
 729                  (customize-set-variable 'default-toolbar-position 'right)
 730                  :style radio
 731                  :selected (eq default-toolbar-position 'right)]
 732                 )
 733                )))
 734       ("Mouse"
 735        ["Avoid Text..."
 736         (customize-set-variable 'mouse-avoidance-mode
 737                                 (if mouse-avoidance-mode nil 'banish))
 738         :style toggle
 739         :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode)
 740         :active (and (boundp 'mouse-avoidance-mode)
 741                      (device-on-window-system-p))]
 742        ["strokes-mode"
 743         (customize-set-variable 'strokes-mode (not strokes-mode))
 744         :style toggle
 745         :selected (and (boundp 'strokes-mode) strokes-mode)
 746         :active (and (boundp 'strokes-mode)
 747                      (device-on-window-system-p))]
 748        )
 749       ("Open URLs With"
 750        ["Emacs-W3"
 751         (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
 752         :style radio
 753         :selected (and (boundp 'browse-url-browser-function)
 754                        (eq browse-url-browser-function 'browse-url-w3))
 755         :active (and (boundp 'browse-url-browser-function)
 756                      (fboundp 'browse-url-w3)
 757                      (fboundp 'w3-fetch))]
 758        ["Netscape"
 759         (customize-set-variable 'browse-url-browser-function
 760                                 'browse-url-netscape)
 761         :style radio
 762         :selected (and (boundp 'browse-url-browser-function)
 763                        (eq browse-url-browser-function 'browse-url-netscape))
 764         :active (and (boundp 'browse-url-browser-function)
 765                      (fboundp 'browse-url-netscape))]
 766        ["Mosaic"
 767         (customize-set-variable 'browse-url-browser-function
 768                                 'browse-url-mosaic)
 769         :style radio
 770         :selected (and (boundp 'browse-url-browser-function)
 771                        (eq browse-url-browser-function 'browse-url-mosaic))
 772         :active (and (boundp 'browse-url-browser-function)
 773                      (fboundp 'browse-url-mosaic))]
 774        ["Mosaic (CCI)"
 775         (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
 776         :style radio
 777         :selected (and (boundp 'browse-url-browser-function)
 778                        (eq browse-url-browser-function 'browse-url-cci))
 779         :active (and (boundp 'browse-url-browser-function)
 780                      (fboundp 'browse-url-cci))]
 781        ["IXI Mosaic"
 782         (customize-set-variable 'browse-url-browser-function
 783                                 'browse-url-iximosaic)
 784         :style radio
 785         :selected (and (boundp 'browse-url-browser-function)
 786                        (eq browse-url-browser-function 'browse-url-iximosaic))
 787         :active (and (boundp 'browse-url-browser-function)
 788                      (fboundp 'browse-url-iximosaic))]
 789        ["Lynx (xterm)"
 790         (customize-set-variable 'browse-url-browser-function
 791                                 'browse-url-lynx-xterm)
 792         :style radio
 793         :selected (and (boundp 'browse-url-browser-function)
 794                        (eq browse-url-browser-function 'browse-url-lynx-xterm))
 795         :active (and (boundp 'browse-url-browser-function)
 796                      (fboundp 'browse-url-lynx-xterm))]
 797        ["Lynx (xemacs)"
 798         (customize-set-variable 'browse-url-browser-function
 799                                 'browse-url-lynx-emacs)
 800         :style radio
 801         :selected (and (boundp 'browse-url-browser-function)
 802                        (eq browse-url-browser-function 'browse-url-lynx-emacs))
 803         :active (and (boundp 'browse-url-browser-function)
 804                      (fboundp 'browse-url-lynx-emacs))]
 805        ["Grail"
 806         (customize-set-variable 'browse-url-browser-function
 807                                 'browse-url-grail)
 808         :style radio
 809         :selected (and (boundp 'browse-url-browser-function)
 810                        (eq browse-url-browser-function 'browse-url-grail))
 811         :active (and (boundp 'browse-url-browser-function)
 812                      (fboundp 'browse-url-grail))]
 813        )
 814       "-----"
 815       ["Edit Faces..." (customize-face nil)]
 816       ("Font"   :filter font-menu-family-constructor)
 817       ("Size"   :filter font-menu-size-constructor)
 818 ;      ("Weight"        :filter font-menu-weight-constructor)
 819       "-----"
 820       ["Save Options" customize-save-customized]
 821       )
 822
 823      ("Buffers"
 824       :filter buffers-menu-filter
 825       ["Read Only" (toggle-read-only)
 826        :style toggle :selected buffer-read-only]
 827       ["List All Buffers" list-buffers]
 828       "--"
 829       )
 830
 831      ("Tools"
 832       ["Grep..." grep
 833        :active (fboundp 'grep)]
 834       ["Compile..." compile
 835        :active (fboundp 'compile)]
 836       ["Shell" shell
 837        :active (fboundp 'shell)]
 838       ["Shell Command..." shell-command
 839        :active (fboundp 'shell-command)]
 840       ["Shell Command on Region..." shell-command-on-region
 841        :active (and (fboundp 'shell-command-on-region) (region-exists-p))]
 842       ["Debug (GDB)..." gdb
 843        :active (fboundp 'gdb)]
 844       ["Debug (DBX)..." dbx
 845        :active (fboundp 'dbx)]
 846       "-----"
 847       ("Tags"
 848        ["Find Tag..." find-tag]
 849        ["Find Other Window..." find-tag-other-window]
 850        ["Next Tag..." (find-tag nil)]
 851        ["Next Other Window..." (find-tag-other-window nil)]
 852        ["Next File" next-file]
 853        "-----"
 854        ["Tags Search..." tags-search]
 855        ["Tags Replace..." tags-query-replace]
 856        ["Continue Search/Replace" tags-loop-continue]
 857        "-----"
 858        ["Pop stack" pop-tag-mark]
 859        ["Apropos..." tags-apropos]
 860        "-----"
 861        ["Set Tags Table File..." visit-tags-table]
 862        ))
 863
 864      nil                                ; the partition: menus after this are flushright
 865
 866      ("Help"
 867       ["About XEmacs..." about-xemacs]
 868       ("Basics"
 869        ["Installation" describe-installation
 870         :active (boundp 'Installation-string)]
 871        ;; Tutorials.
 872        ,(if (featurep 'mule)
 873             ;; Mule tutorials.
 874             (let ((lang language-info-alist)
 875                   submenu tut)
 876               (while lang
 877                 (and (setq tut (assq 'tutorial (car lang)))
 878                      (not (string= (caar lang) "ASCII"))
 879                      (setq
 880                       submenu
 881                       (cons
 882                        `[,(caar lang) (help-with-tutorial nil ,(cdr tut))]
 883                        submenu)))
 884                 (setq lang (cdr lang)))
 885               (append `("Tutorials"
 886                         :filter tutorials-menu-filter
 887                         ["Default" help-with-tutorial t
 888                          ,(concat "(" current-language-environment ")")])
 889                       submenu))
 890           ;; Non mule tutorials.
 891           (let ((lang tutorial-supported-languages)
 892                 submenu)
 893             (while lang
 894               (setq submenu
 895                     (cons
 896                      `[,(caar lang)
 897                        (help-with-tutorial ,(format "TUTORIAL.%s"
 898                                                     (cadr (car lang))))]
 899                      submenu))
 900               (setq lang (cdr lang)))
 901             (append '("Tutorials"
 902                       ["English" help-with-tutorial])
 903                     submenu)))
 904        ["News" view-emacs-news]
 905        ["Packages" finder-by-keyword]
 906        ["Splash" xemacs-splash-buffer])
 907       "-----"
 908       ("XEmacs FAQ"
 909        ["FAQ (local)" xemacs-local-faq]
 910        ["FAQ via WWW" xemacs-www-faq    (boundp 'browse-url-browser-function)]
 911        ["Home Page" xemacs-www-page             (boundp 'browse-url-browser-function)])
 912       ("Samples"
 913        ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")]
 914        ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")]
 915        ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")])
 916       "-----"
 917       ("Lookup in Info"
 918        ["Key Binding..." Info-goto-emacs-key-command-node]
 919        ["Command..." Info-goto-emacs-command-node]
 920        ["Function..." Info-elisp-ref]
 921        ["Topic..." Info-query])
 922       ("Manuals"
 923        ["Info" info]
 924        ["Unix Manual..." manual-entry])
 925       ("Commands & Keys"
 926        ["Mode" describe-mode]
 927        ["Apropos..." hyper-apropos]
 928        ["Apropos Docs..." apropos-documentation]
 929        "-----"
 930        ["Key..." describe-key]
 931        ["Bindings" describe-bindings]
 932        ["Mouse Bindings" describe-pointer]
 933        ["Recent Keys" view-lossage]
 934        "-----"
 935        ["Function..." describe-function]
 936        ["Variable..." describe-variable]
 937        ["Locate Command..." where-is])
 938       "-----"
 939       ["Recent Messages" view-lossage]
 940       ("Misc"
 941        ["No Warranty" describe-no-warranty]
 942        ["XEmacs License" describe-copying]
 943        ["The Latest Version" describe-distribution])
 944       ["Send Bug Report..." report-emacs-bug]))))
 945
 946 \f
 947 (defun maybe-add-init-button ()
 948   "Don't call this.
 949 Adds `Load .emacs' button to menubar when starting up with -q."
 950   ;; by Stig@hackvan.com
 951   (cond
 952    (init-file-user nil)
 953    ((file-exists-p (expand-file-name ".emacs" "~"))
 954     (add-menu-button nil
 955                      ["Load .emacs"
 956                       (progn (delete-menu-item '("Load .emacs"))
 957                              (load-user-init-file (user-login-name)))
 958                       ]
 959                      "Help"))
 960    (t nil)))
 961
 962 (add-hook 'before-init-hook 'maybe-add-init-button)
 963
 964 \f
 965 ;;; The File menu
 966
 967 (defvar put-buffer-names-in-file-menu t)
 968
 969 \f
 970 ;;; The Bookmarks menu
 971
 972 (defun bookmark-menu-filter (&rest ignore)
 973   (let ((definedp (and (boundp 'bookmark-alist)
 974                        bookmark-alist
 975                        t)))
 976     `(,(if definedp
 977            '("Jump to Bookmark"
 978              :filter (lambda (&rest junk)
 979                        (mapcar #'(lambda (bmk)
 980                                    `[,bmk (bookmark-jump ',bmk)])
 981                                (bookmark-all-names))))
 982          ["Jump to Bookmark" nil nil])
 983       ["Set bookmark" bookmark-set
 984        :active (fboundp 'bookmark-set)]
 985       "---"
 986       ["Insert contents" bookmark-menu-insert
 987        :active (fboundp 'bookmark-menu-insert)]
 988       ["Insert location" bookmark-menu-locate
 989        :active (fboundp 'bookmark-menu-locate)]
 990       "---"
 991       ["Rename bookmark" bookmark-menu-rename
 992        :active (fboundp 'bookmark-menu-rename)]
 993       ,(if definedp
 994            '("Delete Bookmark"
 995              :filter (lambda (&rest junk)
 996                        (mapcar #'(lambda (bmk)
 997                                    `[,bmk (bookmark-delete ',bmk)])
 998                                (bookmark-all-names))))
 999          ["Delete Bookmark" nil nil])
1000       ["Edit Bookmark List" bookmark-bmenu-list ,definedp]
1001       "---"
1002       ["Save bookmarks"        bookmark-save            ,definedp]
1003       ["Save bookmarks as..."  bookmark-write           ,definedp]
1004       ["Load a bookmark file" bookmark-load
1005        :active (fboundp 'bookmark-load)])))
1006
1007 ;;; The Buffers menu
1008
1009 (defgroup buffers-menu nil
1010   "Customization of `Buffers' menu."
1011   :group 'menu)
1012
1013 (defcustom buffers-menu-max-size 25
1014   "*Maximum number of entries which may appear on the \"Buffers\" menu.
1015 If this is 10, then only the ten most-recently-selected buffers will be
1016 shown.  If this is nil, then all buffers will be shown.  Setting this to
1017 a large number or nil will slow down menu responsiveness."
1018   :type '(choice (const :tag "Show all" nil)
1019                  (integer 10))
1020   :group 'buffers-menu)
1021
1022 (defcustom complex-buffers-menu-p nil
1023   "*If non-nil, the buffers menu will contain several commands.
1024 Commands will be presented as submenus of each buffer line.  If this
1025 is false, then there will be only one command: select that buffer."
1026   :type 'boolean
1027   :group 'buffers-menu)
1028
1029 (defcustom buffers-menu-submenus-for-groups-p nil
1030   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1031 The grouping function is specified in `buffers-menu-grouping-function'.
1032 If this is an integer, do not build submenus if the number of buffers
1033 is not larger than this value."
1034   :type '(choice (const :tag "No Subgroups" nil)
1035                  (integer :tag "Max. submenus" 10)
1036                  (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1037   :group 'buffers-menu)
1038
1039 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1040   "*The function to call to select a buffer from the buffers menu.
1041 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1042   :type '(radio (function-item switch-to-buffer)
1043                 (function-item pop-to-buffer)
1044                 (function :tag "Other"))
1045   :group 'buffers-menu)
1046
1047 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1048   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1049 This is passed a buffer and should return non-nil if the buffer should be
1050 omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
1051 buffers that are normally considered \"invisible\" (those whose name
1052 begins with a space)."
1053   :type '(choice (const :tag "None" nil)
1054                  function)
1055   :group 'buffers-menu)
1056
1057 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1058   "*The function to call to return a string to represent a buffer in the
1059 buffers menu.  The function is passed a buffer and should return a string.
1060 The default value `format-buffers-menu-line' just returns the name of
1061 the buffer.  Also check out `slow-format-buffers-menu-line' which
1062 returns a whole bunch of info about a buffer."
1063   :type 'function
1064   :group 'buffers-menu)
1065
1066 (defcustom buffers-menu-sort-function
1067   'sort-buffers-menu-by-mode-then-alphabetically
1068   "*If non-nil, a function to sort the list of buffers in the buffers menu.
1069 It will be passed two arguments (two buffers to compare) and should return
1070 T if the first is \"less\" than the second.  One possible value is
1071 `sort-buffers-menu-alphabetically'; another is
1072 `sort-buffers-menu-by-mode-then-alphabetically'."
1073   :type '(choice (const :tag "None" nil)
1074                  function)
1075   :group 'buffers-menu)
1076
1077 (defcustom buffers-menu-grouping-function
1078   'group-buffers-menu-by-mode-then-alphabetically
1079   "*If non-nil, a function to group buffers in the buffers menu together.
1080 It will be passed two arguments, successive members of the sorted buffers
1081 list after being passed through `buffers-menu-sort-function'.  It should
1082 return non-nil if the second buffer begins a new group.  The return value
1083 should be the name of the old group, which may be used in hierarchical
1084 buffers menus.  The last invocation of the function contains nil as the
1085 second argument, so that the name of the last group can be determined.
1086
1087 The sensible values of this function are dependent on the value specified
1088 for `buffers-menu-sort-function'."
1089   :type '(choice (const :tag "None" nil)
1090                  function)
1091   :group 'buffers-menu)
1092
1093 (defun buffers-menu-omit-invisible-buffers (buf)
1094   "For use as a value of `buffers-menu-omit-function'.
1095 Omits normally invisible buffers (those whose name begins with a space)."
1096   (not (null (string-match "\\` " (buffer-name buf)))))
1097
1098 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1099   "For use as a value of `buffers-menu-sort-function'.
1100 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1101 with a star at the end of the list."
1102   (let* ((nam1 (buffer-name buf1))
1103          (nam2 (buffer-name buf2))
1104          (star1p (not (null (string-match "\\`*" nam1))))
1105          (star2p (not (null (string-match "\\`*" nam2)))))
1106     (if (not (eq star1p star2p))
1107         (not star1p)
1108       (string-lessp nam1 nam2))))
1109
1110 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1111   "For use as a value of `buffers-menu-sort-function'.
1112 Sorts first by major mode and then alphabetically by name, but puts buffers
1113 beginning with a star at the end of the list."
1114   (let* ((nam1 (buffer-name buf1))
1115          (nam2 (buffer-name buf2))
1116          (star1p (not (null (string-match "\\`*" nam1))))
1117          (star2p (not (null (string-match "\\`*" nam2))))
1118          (mode1 (symbol-value-in-buffer 'major-mode buf1))
1119          (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1120     (cond ((not (eq star1p star2p)) (not star1p))
1121           ((and star1p star2p (string-lessp nam1 nam2)))
1122           ((string-lessp mode1 mode2) t)
1123           ((string-lessp mode2 mode1) nil)
1124           (t (string-lessp nam1 nam2)))))
1125
1126 ;; this version is too slow on some machines.
1127 (defun slow-format-buffers-menu-line (buffer)
1128   "For use as a value of `buffers-menu-format-buffer-line-function'.
1129 This returns a string containing a bunch of info about the buffer."
1130   (format "%s%s %-19s %6s %-15s %s"
1131           (if (buffer-modified-p buffer) "*" " ")
1132           (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ")
1133           (buffer-name buffer)
1134           (buffer-size buffer)
1135           (symbol-value-in-buffer 'mode-name buffer)
1136           (or (buffer-file-name buffer) "")))
1137
1138 (defun format-buffers-menu-line (buffer)
1139   "For use as a value of `buffers-menu-format-buffer-line-function'.
1140 This just returns the buffer's name."
1141   (buffer-name buffer))
1142
1143 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1144   "For use as a value of `buffers-menu-grouping-function'.
1145 This groups buffers by major mode.  It only really makes sense if
1146 `buffers-menu-sorting-function' is
1147 `sort-buffers-menu-by-mode-then-alphabetically'."
1148   (cond ((string-match "\\`*" (buffer-name buf1))
1149          (and (null buf2) "*Misc*"))
1150         ((or (null buf2)
1151              (string-match "\\`*" (buffer-name buf2))
1152              (not (eq (symbol-value-in-buffer 'major-mode buf1)
1153                       (symbol-value-in-buffer 'major-mode buf2))))
1154          (symbol-value-in-buffer 'mode-name buf1))
1155         (t nil)))
1156
1157 (defun buffer-menu-save-buffer (buffer)
1158   (save-excursion
1159     (set-buffer buffer)
1160     (save-buffer)))
1161
1162 (defun buffer-menu-write-file (buffer)
1163   (save-excursion
1164     (set-buffer buffer)
1165     (write-file (read-file-name
1166                  (format "Write %s to file: "
1167                          (buffer-name (current-buffer)))))))
1168
1169 (defsubst build-buffers-menu-internal (buffers)
1170   (let (name line)
1171     (mapcar
1172      #'(lambda (buffer)
1173          (if (eq buffer t)
1174              "---"
1175            (setq line (funcall buffers-menu-format-buffer-line-function
1176                                buffer))
1177            (if complex-buffers-menu-p
1178                (delq nil
1179                      (list line
1180                            (vector "Switch to Buffer"
1181                                    (list buffers-menu-switch-to-buffer-function
1182                                          (setq name (buffer-name buffer)))
1183                                    t)
1184                            (if (eq buffers-menu-switch-to-buffer-function
1185                                    'switch-to-buffer)
1186                                (vector "Switch to Buffer, Other Frame"
1187                                        (list 'switch-to-buffer-other-frame
1188                                              (setq name (buffer-name buffer)))
1189                                        t)
1190                              nil)
1191                            (if (and (buffer-modified-p buffer)
1192                                     (buffer-file-name buffer))
1193                                (vector "Save Buffer"
1194                                        (list 'buffer-menu-save-buffer name) t)
1195                              ["Save Buffer" nil nil]
1196                              )
1197                            (vector "Save As..."
1198                                    (list 'buffer-menu-write-file name) t)
1199                            (vector "Delete Buffer" (list 'kill-buffer name)
1200                                    t)))
1201              ;; ### We don't want buffer names to be translated,
1202              ;; ### so we put the buffer name in the suffix.
1203              ;; ### Also, avoid losing with non-ASCII buffer names.
1204              ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
1205              (vector ""
1206                      (list buffers-menu-switch-to-buffer-function
1207                            (buffer-name buffer))
1208                      t line))))
1209      buffers)))
1210
1211 (defun buffers-menu-filter (menu)
1212   "This is the menu filter for the top-level buffers \"Buffers\" menu.
1213 It dynamically creates a list of buffers to use as the contents of the menu.
1214 Only the most-recently-used few buffers will be listed on the menu, for
1215 efficiency reasons.  You can control how many buffers will be shown by
1216 setting `buffers-menu-max-size'.  You can control the text of the menu
1217 items by redefining the function `format-buffers-menu-line'."
1218   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1219     (and (integerp buffers-menu-max-size)
1220          (> buffers-menu-max-size 1)
1221          (> (length buffers) buffers-menu-max-size)
1222          ;; shorten list of buffers (not with submenus!)
1223          (not (and buffers-menu-grouping-function
1224                    buffers-menu-submenus-for-groups-p))
1225          (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1226     (if buffers-menu-sort-function
1227         (setq buffers (sort buffers buffers-menu-sort-function)))
1228     (if (and buffers-menu-grouping-function
1229              buffers-menu-submenus-for-groups-p
1230              (or (not (integerp buffers-menu-submenus-for-groups-p))
1231                  (> (length buffers) buffers-menu-submenus-for-groups-p)))
1232         (let (groups groupnames current-group)
1233           (mapl
1234            #'(lambda (sublist)
1235                (let ((groupname (funcall buffers-menu-grouping-function
1236                                          (car sublist) (cadr sublist))))
1237                  (setq current-group (cons (car sublist) current-group))
1238                  (if groupname
1239                      (progn
1240                        (setq groups (cons (nreverse current-group)
1241                                           groups))
1242                        (setq groupnames (cons groupname groupnames))
1243                        (setq current-group nil)))))
1244            buffers)
1245           (setq buffers
1246                 (mapcar*
1247                  #'(lambda (groupname group)
1248                      (cons groupname (build-buffers-menu-internal group)))
1249                  (nreverse groupnames)
1250                  (nreverse groups))))
1251       (if buffers-menu-grouping-function
1252           (progn
1253             (setq buffers
1254                   (mapcon
1255                    #'(lambda (sublist)
1256                        (cond ((funcall buffers-menu-grouping-function
1257                                        (car sublist) (cadr sublist))
1258                               (list (car sublist) t))
1259                              (t (list (car sublist)))))
1260                    buffers))
1261             ;; remove a trailing separator.
1262             (and (>= (length buffers) 2)
1263                  (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1264                    (if (eq t (cadr lastcdr))
1265                        (setcdr lastcdr nil))))))
1266       (setq buffers (build-buffers-menu-internal buffers)))
1267     (append menu buffers)
1268     ))
1269
1270 (defun language-environment-menu-filter (menu)
1271   "This is the menu filter for the \"Language Environment\" submenu."
1272   (mapcar (lambda (env-sym)
1273             `[ ,(capitalize (symbol-name env-sym))
1274                (set-language-environment ',env-sym)])
1275           language-environment-list))
1276
1277 \f
1278 ;;; The Options menu
1279
1280 ;; We'll keep those variables here for a while, in order to provide a
1281 ;; function for porting the old options file that a user may own to Custom.
1282
1283 (defvar options-save-faces nil
1284   "*Non-nil value means save-options will save information about faces.
1285 A nil value means save-options will not save face information.
1286 Set this non-nil only if you use M-x edit-faces to change face
1287 settings.  If you use M-x customize-face or the \"Browse Faces...\"
1288 menu entry, you will see a button in the Customize Face buffer that you
1289 can use to permanently save your face changes.
1290
1291 M-x edit-faces is deprecated.  Support for it and this variable will
1292 be discontinued in a future release.")
1293
1294 (defvar save-options-init-file nil
1295   "File into which to save forms to load the options file (nil for .emacs).
1296 Normally this is nil, which means save into your .emacs file (the value
1297 of `user-init-file'.")
1298
1299 (defvar save-options-file ".xemacs-options"
1300   "File to save options into.
1301 This file is loaded from your .emacs file.
1302 If this is a relative filename, it is put into the same directory as your
1303 .emacs file.")
1304
1305
1306 \f
1307 ;;; The Help menu
1308
1309 (if (featurep 'mule)
1310     (defun tutorials-menu-filter (menu-items)
1311       ;; If there's a tutorial for the current language environment, make it
1312       ;; appear first as the default one. Otherwise, use the english one.
1313       (let* ((menu menu-items)
1314              (item (pop menu-items)))
1315         (aset
1316          item 3
1317          (concat "("
1318                  (if (assoc
1319                       'tutorial
1320                       (assoc current-language-environment language-info-alist))
1321                      current-language-environment
1322                    "English")
1323                  ")"))
1324         menu)))
1325
1326 \f
1327 (set-menubar default-menubar)
1328
1329 \f
1330 ;;; Popup menus.
1331
1332 (defconst default-popup-menu
1333   '("XEmacs Commands"
1334     ["Undo" advertised-undo
1335      :active (and (not (eq buffer-undo-list t))
1336                   (or buffer-undo-list pending-undo-list))
1337      :suffix (if (or (eq last-command 'undo)
1338                      (eq last-command 'advertised-undo))
1339                  "More" "")]
1340     ["Cut" kill-primary-selection
1341      :active (selection-owner-p)]
1342     ["Copy" copy-primary-selection
1343      :active (selection-owner-p)]
1344     ["Paste" yank-clipboard-selection
1345      :active (selection-exists-p 'CLIPBOARD)]
1346     ["Clear" delete-primary-selection
1347      :active (selection-owner-p)]
1348     "-----"
1349     ["Select Block" mark-paragraph]
1350     ["Split Window" split-window-vertically]
1351     ["Unsplit Window" delete-other-windows]
1352     ))
1353
1354 (defvar global-popup-menu nil
1355   "The global popup menu.  This is present in all modes.
1356 See the function `popup-menu' for a description of menu syntax.")
1357
1358 (defvar mode-popup-menu nil
1359   "The mode-specific popup menu.  Automatically buffer local.
1360 This is appended to the default items in `global-popup-menu'.
1361 See the function `popup-menu' for a description of menu syntax.")
1362 (make-variable-buffer-local 'mode-popup-menu)
1363
1364 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1365 ;; superceded by any local popup menu...
1366 (setq-default mode-popup-menu default-popup-menu)
1367
1368 (defvar activate-popup-menu-hook nil
1369   "Function or functions run before a mode-specific popup menu is made visible.
1370 These functions are called with no arguments, and should interrogate and
1371 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1372 Note: this hook is only run if you use `popup-mode-menu' for activating the
1373 global and mode-specific commands; if you have your own binding for button3,
1374 this hook won't be run.")
1375
1376 (defun popup-mode-menu ()
1377   "Pop up a menu of global and mode-specific commands.
1378 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1379   (interactive "@_")
1380   (run-hooks 'activate-popup-menu-hook)
1381   (popup-menu
1382    (cond ((and global-popup-menu mode-popup-menu)
1383           ;; Merge global-popup-menu and mode-popup-menu
1384           (check-menu-syntax mode-popup-menu)
1385           (let* ((title (car mode-popup-menu))
1386                  (items (cdr mode-popup-menu))
1387                  mode-filters)
1388             ;; Strip keywords from local menu for attaching them at the top
1389             (while (and items
1390                         (keywordp (car items)))
1391               ;; Push both keyword and its argument.
1392               (push (pop items) mode-filters)
1393               (push (pop items) mode-filters))
1394             (setq mode-filters (nreverse mode-filters))
1395             ;; If mode-filters contains a keyword already present in
1396             ;; `global-popup-menu', you will probably lose.
1397             (append (list (car global-popup-menu))
1398                     mode-filters
1399                     (cdr global-popup-menu)
1400                     '("---" "---")
1401                     (if popup-menu-titles (list title))
1402                     (if popup-menu-titles '("---" "---"))
1403                     items)))
1404          (t
1405           (or mode-popup-menu
1406               global-popup-menu
1407               (error "No menu defined in this buffer"))))))
1408
1409 (defun popup-buffer-menu (event)
1410   "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1411   (interactive "e")
1412   (let ((window (and (event-over-text-area-p event) (event-window event)))
1413         (bmenu nil))
1414     (or window
1415         (error "Pointer must be in a normal window"))
1416     (select-window window)
1417     (if current-menubar
1418         (setq bmenu (assoc "Buffers" current-menubar)))
1419     (if (null bmenu)
1420         (setq bmenu (assoc "Buffers" default-menubar)))
1421     (if (null bmenu)
1422         (error "Can't find the Buffers menu"))
1423     (popup-menu bmenu)))
1424
1425 (defun popup-menubar-menu (event)
1426   "Pop up a copy of menu that also appears in the menubar"
1427   ;; by Stig@hackvan.com
1428   (interactive "e")
1429   (let ((window (and (event-over-text-area-p event) (event-window event)))
1430         popup-menubar)
1431     (or window
1432         (error "Pointer must be in a normal window"))
1433     (select-window window)
1434     (and current-menubar (run-hooks 'activate-menubar-hook))
1435     ;; ##### Instead of having to copy this just to safely get rid of
1436     ;; any nil what we should really do is fix up the internal menubar
1437     ;; code to just ignore nil if generating a popup menu
1438     (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1439                                                        default-menubar))))
1440     (popup-menu (cons "Menubar Menu" popup-menubar))
1441     ))
1442
1443 (global-set-key 'button3 'popup-mode-menu)
1444 ;; shift button3 and shift button2 are reserved for Hyperbole
1445 (global-set-key '(meta control button3) 'popup-buffer-menu)
1446 ;; The following command is way too dangerous with Custom.
1447 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1448
1449 ;; Here's a test of the cool new menu features (from Stig).
1450
1451 ;;(setq mode-popup-menu
1452 ;;      '("Test Popup Menu"
1453 ;;        :filter cdr
1454 ;;        ["this item won't appear because of the menu filter" ding t]
1455 ;;        "--:singleLine"
1456 ;;        "singleLine"
1457 ;;        "--:doubleLine"
1458 ;;        "doubleLine"
1459 ;;        "--:singleDashedLine"
1460 ;;        "singleDashedLine"
1461 ;;        "--:doubleDashedLine"
1462 ;;        "doubleDashedLine"
1463 ;;        "--:noLine"
1464 ;;        "noLine"
1465 ;;        "--:shadowEtchedIn"
1466 ;;        "shadowEtchedIn"
1467 ;;        "--:shadowEtchedOut"
1468 ;;        "shadowEtchedOut"
1469 ;;        "--:shadowDoubleEtchedIn"
1470 ;;        "shadowDoubleEtchedIn"
1471 ;;        "--:shadowDoubleEtchedOut"
1472 ;;        "shadowDoubleEtchedOut"
1473 ;;        "--:shadowEtchedInDash"
1474 ;;        "shadowEtchedInDash"
1475 ;;        "--:shadowEtchedOutDash"
1476 ;;        "shadowEtchedOutDash"
1477 ;;        "--:shadowDoubleEtchedInDash"
1478 ;;        "shadowDoubleEtchedInDash"
1479 ;;        "--:shadowDoubleEtchedOutDash"
1480 ;;        "shadowDoubleEtchedOutDash"
1481 ;;        ))
1482
1483 (defun xemacs-splash-buffer ()
1484   "Redisplay XEmacs splash screen in a buffer."
1485   (interactive)
1486   (let ((buffer (get-buffer-create "*Splash*")))
1487     (set-buffer buffer)
1488     (erase-buffer buffer)
1489     (startup-splash-frame)
1490     (pop-to-buffer buffer)
1491     (delete-other-windows)))
1492
1493 \f
1494 ;;; backwards compatibility
1495 (provide 'x-menubar)
1496 (provide 'menubar-items)
1497
1498 ;;; x-menubar.el ends here.