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