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      ,@(when (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             ["Set coding system of process"
 160              set-buffer-process-coding-system
 161              :active (get-buffer-process (current-buffer))]
 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        ["Kfm"
 814         (customize-set-variable 'browse-url-browser-function
 815                                 'browse-url-kfm)
 816         :style radio
 817         :selected (and (boundp 'browse-url-browser-function)
 818                        (eq browse-url-browser-function 'browse-url-kfm))
 819         :active (and (boundp 'browse-url-browser-function)
 820                      (fboundp 'browse-url-kfm))]
 821        )
 822       "-----"
 823       ["Edit Faces..." (customize-face nil)]
 824       ("Font"   :filter font-menu-family-constructor)
 825       ("Size"   :filter font-menu-size-constructor)
 826 ;      ("Weight"        :filter font-menu-weight-constructor)
 827       "-----"
 828       ["Save Options" customize-save-customized]
 829       )
 830
 831      ("Buffers"
 832       :filter buffers-menu-filter
 833       ["Read Only" (toggle-read-only)
 834        :style toggle :selected buffer-read-only]
 835       ["List All Buffers" list-buffers]
 836       "--"
 837       )
 838
 839      ("Tools"
 840       ["Grep..." grep
 841        :active (fboundp 'grep)]
 842       ["Compile..." compile
 843        :active (fboundp 'compile)]
 844       ["Shell" shell
 845        :active (fboundp 'shell)]
 846       ["Shell Command..." shell-command
 847        :active (fboundp 'shell-command)]
 848       ["Shell Command on Region..." shell-command-on-region
 849        :active (and (fboundp 'shell-command-on-region) (region-exists-p))]
 850       ["Debug (GDB)..." gdb
 851        :active (fboundp 'gdb)]
 852       ["Debug (DBX)..." dbx
 853        :active (fboundp 'dbx)]
 854       "-----"
 855       ("Tags"
 856        ["Find Tag..." find-tag]
 857        ["Find Other Window..." find-tag-other-window]
 858        ["Next Tag..." (find-tag nil)]
 859        ["Next Other Window..." (find-tag-other-window nil)]
 860        ["Next File" next-file]
 861        "-----"
 862        ["Tags Search..." tags-search]
 863        ["Tags Replace..." tags-query-replace]
 864        ["Continue Search/Replace" tags-loop-continue]
 865        "-----"
 866        ["Pop stack" pop-tag-mark]
 867        ["Apropos..." tags-apropos]
 868        "-----"
 869        ["Set Tags Table File..." visit-tags-table]
 870        ))
 871
 872      nil                                ; the partition: menus after this are flushright
 873
 874      ("Help"
 875       ["About XEmacs..." about-xemacs]
 876       ("Basics"
 877        ["Installation" describe-installation
 878         :active (boundp 'Installation-string)]
 879        ;; Tutorials.
 880        ,(if (featurep 'mule)
 881             ;; Mule tutorials.
 882             (let ((lang language-info-alist)
 883                   submenu tut)
 884               (while lang
 885                 (and (setq tut (assq 'tutorial (car lang)))
 886                      (not (string= (caar lang) "ASCII"))
 887                      (setq
 888                       submenu
 889                       (cons
 890                        `[,(caar lang) (help-with-tutorial nil ,(cdr tut))]
 891                        submenu)))
 892                 (setq lang (cdr lang)))
 893               (append `("Tutorials"
 894                         :filter tutorials-menu-filter
 895                         ["Default" help-with-tutorial t
 896                          ,(concat "(" current-language-environment ")")])
 897                       submenu))
 898           ;; Non mule tutorials.
 899           (let ((lang tutorial-supported-languages)
 900                 submenu)
 901             (while lang
 902               (setq submenu
 903                     (cons
 904                      `[,(caar lang)
 905                        (help-with-tutorial ,(format "TUTORIAL.%s"
 906                                                     (cadr (car lang))))]
 907                      submenu))
 908               (setq lang (cdr lang)))
 909             (append '("Tutorials"
 910                       ["English" help-with-tutorial])
 911                     submenu)))
 912        ["News" view-emacs-news]
 913        ["Packages" finder-by-keyword]
 914        ["Splash" xemacs-splash-buffer])
 915       "-----"
 916       ("XEmacs FAQ"
 917        ["FAQ (local)" xemacs-local-faq]
 918        ["FAQ via WWW" xemacs-www-faq    (boundp 'browse-url-browser-function)]
 919        ["Home Page" xemacs-www-page             (boundp 'browse-url-browser-function)])
 920       ("Samples"
 921        ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")]
 922        ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")]
 923        ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")])
 924       "-----"
 925       ("Lookup in Info"
 926        ["Key Binding..." Info-goto-emacs-key-command-node]
 927        ["Command..." Info-goto-emacs-command-node]
 928        ["Function..." Info-elisp-ref]
 929        ["Topic..." Info-query])
 930       ("Manuals"
 931        ["Info" info]
 932        ["Unix Manual..." manual-entry])
 933       ("Commands & Keys"
 934        ["Mode" describe-mode]
 935        ["Apropos..." hyper-apropos]
 936        ["Apropos Docs..." apropos-documentation]
 937        "-----"
 938        ["Key..." describe-key]
 939        ["Bindings" describe-bindings]
 940        ["Mouse Bindings" describe-pointer]
 941        ["Recent Keys" view-lossage]
 942        "-----"
 943        ["Function..." describe-function]
 944        ["Variable..." describe-variable]
 945        ["Locate Command..." where-is])
 946       "-----"
 947       ["Recent Messages" view-lossage]
 948       ("Misc"
 949        ["No Warranty" describe-no-warranty]
 950        ["XEmacs License" describe-copying]
 951        ["The Latest Version" describe-distribution])
 952       ["Send Bug Report..." report-emacs-bug]))))
 953
 954 \f
 955 (defun maybe-add-init-button ()
 956   "Don't call this.
 957 Adds `Load .emacs' button to menubar when starting up with -q."
 958   ;; by Stig@hackvan.com
 959   (cond
 960    (init-file-user nil)
 961    ((file-exists-p (expand-file-name ".emacs" "~"))
 962     (add-menu-button nil
 963                      ["Load .emacs"
 964                       (progn (delete-menu-item '("Load .emacs"))
 965                              (load-user-init-file (user-login-name)))
 966                       ]
 967                      "Help"))
 968    (t nil)))
 969
 970 (add-hook 'before-init-hook 'maybe-add-init-button)
 971
 972 \f
 973 ;;; The File menu
 974
 975 (defvar put-buffer-names-in-file-menu t)
 976
 977 \f
 978 ;;; The Bookmarks menu
 979
 980 (defun bookmark-menu-filter (&rest ignore)
 981   (let ((definedp (and (boundp 'bookmark-alist)
 982                        bookmark-alist
 983                        t)))
 984     `(,(if definedp
 985            '("Jump to Bookmark"
 986              :filter (lambda (&rest junk)
 987                        (mapcar #'(lambda (bmk)
 988                                    `[,bmk (bookmark-jump ',bmk)])
 989                                (bookmark-all-names))))
 990          ["Jump to Bookmark" nil nil])
 991       ["Set bookmark" bookmark-set
 992        :active (fboundp 'bookmark-set)]
 993       "---"
 994       ["Insert contents" bookmark-menu-insert
 995        :active (fboundp 'bookmark-menu-insert)]
 996       ["Insert location" bookmark-menu-locate
 997        :active (fboundp 'bookmark-menu-locate)]
 998       "---"
 999       ["Rename bookmark" bookmark-menu-rename
1000        :active (fboundp 'bookmark-menu-rename)]
1001       ,(if definedp
1002            '("Delete Bookmark"
1003              :filter (lambda (&rest junk)
1004                        (mapcar #'(lambda (bmk)
1005                                    `[,bmk (bookmark-delete ',bmk)])
1006                                (bookmark-all-names))))
1007          ["Delete Bookmark" nil nil])
1008       ["Edit Bookmark List" bookmark-bmenu-list ,definedp]
1009       "---"
1010       ["Save bookmarks"        bookmark-save            ,definedp]
1011       ["Save bookmarks as..."  bookmark-write           ,definedp]
1012       ["Load a bookmark file" bookmark-load
1013        :active (fboundp 'bookmark-load)])))
1014
1015 ;;; The Buffers menu
1016
1017 (defgroup buffers-menu nil
1018   "Customization of `Buffers' menu."
1019   :group 'menu)
1020
1021 (defcustom buffers-menu-max-size 25
1022   "*Maximum number of entries which may appear on the \"Buffers\" menu.
1023 If this is 10, then only the ten most-recently-selected buffers will be
1024 shown.  If this is nil, then all buffers will be shown.  Setting this to
1025 a large number or nil will slow down menu responsiveness."
1026   :type '(choice (const :tag "Show all" nil)
1027                  (integer 10))
1028   :group 'buffers-menu)
1029
1030 (defcustom complex-buffers-menu-p nil
1031   "*If non-nil, the buffers menu will contain several commands.
1032 Commands will be presented as submenus of each buffer line.  If this
1033 is false, then there will be only one command: select that buffer."
1034   :type 'boolean
1035   :group 'buffers-menu)
1036
1037 (defcustom buffers-menu-submenus-for-groups-p nil
1038   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1039 The grouping function is specified in `buffers-menu-grouping-function'.
1040 If this is an integer, do not build submenus if the number of buffers
1041 is not larger than this value."
1042   :type '(choice (const :tag "No Subgroups" nil)
1043                  (integer :tag "Max. submenus" 10)
1044                  (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1045   :group 'buffers-menu)
1046
1047 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1048   "*The function to call to select a buffer from the buffers menu.
1049 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1050   :type '(radio (function-item switch-to-buffer)
1051                 (function-item pop-to-buffer)
1052                 (function :tag "Other"))
1053   :group 'buffers-menu)
1054
1055 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1056   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1057 This is passed a buffer and should return non-nil if the buffer should be
1058 omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
1059 buffers that are normally considered \"invisible\" (those whose name
1060 begins with a space)."
1061   :type '(choice (const :tag "None" nil)
1062                  function)
1063   :group 'buffers-menu)
1064
1065 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1066   "*The function to call to return a string to represent a buffer in the
1067 buffers menu.  The function is passed a buffer and should return a string.
1068 The default value `format-buffers-menu-line' just returns the name of
1069 the buffer.  Also check out `slow-format-buffers-menu-line' which
1070 returns a whole bunch of info about a buffer."
1071   :type 'function
1072   :group 'buffers-menu)
1073
1074 (defcustom buffers-menu-sort-function
1075   'sort-buffers-menu-by-mode-then-alphabetically
1076   "*If non-nil, a function to sort the list of buffers in the buffers menu.
1077 It will be passed two arguments (two buffers to compare) and should return
1078 T if the first is \"less\" than the second.  One possible value is
1079 `sort-buffers-menu-alphabetically'; another is
1080 `sort-buffers-menu-by-mode-then-alphabetically'."
1081   :type '(choice (const :tag "None" nil)
1082                  function)
1083   :group 'buffers-menu)
1084
1085 (defcustom buffers-menu-grouping-function
1086   'group-buffers-menu-by-mode-then-alphabetically
1087   "*If non-nil, a function to group buffers in the buffers menu together.
1088 It will be passed two arguments, successive members of the sorted buffers
1089 list after being passed through `buffers-menu-sort-function'.  It should
1090 return non-nil if the second buffer begins a new group.  The return value
1091 should be the name of the old group, which may be used in hierarchical
1092 buffers menus.  The last invocation of the function contains nil as the
1093 second argument, so that the name of the last group can be determined.
1094
1095 The sensible values of this function are dependent on the value specified
1096 for `buffers-menu-sort-function'."
1097   :type '(choice (const :tag "None" nil)
1098                  function)
1099   :group 'buffers-menu)
1100
1101 (defun buffers-menu-omit-invisible-buffers (buf)
1102   "For use as a value of `buffers-menu-omit-function'.
1103 Omits normally invisible buffers (those whose name begins with a space)."
1104   (not (null (string-match "\\` " (buffer-name buf)))))
1105
1106 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1107   "For use as a value of `buffers-menu-sort-function'.
1108 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1109 with a star at the end of the list."
1110   (let* ((nam1 (buffer-name buf1))
1111          (nam2 (buffer-name buf2))
1112          (star1p (not (null (string-match "\\`*" nam1))))
1113          (star2p (not (null (string-match "\\`*" nam2)))))
1114     (if (not (eq star1p star2p))
1115         (not star1p)
1116       (string-lessp nam1 nam2))))
1117
1118 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1119   "For use as a value of `buffers-menu-sort-function'.
1120 Sorts first by major mode and then alphabetically by name, but puts buffers
1121 beginning with a star at the end of the list."
1122   (let* ((nam1 (buffer-name buf1))
1123          (nam2 (buffer-name buf2))
1124          (star1p (not (null (string-match "\\`*" nam1))))
1125          (star2p (not (null (string-match "\\`*" nam2))))
1126          (mode1 (symbol-value-in-buffer 'major-mode buf1))
1127          (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1128     (cond ((not (eq star1p star2p)) (not star1p))
1129           ((and star1p star2p (string-lessp nam1 nam2)))
1130           ((string-lessp mode1 mode2) t)
1131           ((string-lessp mode2 mode1) nil)
1132           (t (string-lessp nam1 nam2)))))
1133
1134 ;; this version is too slow on some machines.
1135 (defun slow-format-buffers-menu-line (buffer)
1136   "For use as a value of `buffers-menu-format-buffer-line-function'.
1137 This returns a string containing a bunch of info about the buffer."
1138   (format "%s%s %-19s %6s %-15s %s"
1139           (if (buffer-modified-p buffer) "*" " ")
1140           (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ")
1141           (buffer-name buffer)
1142           (buffer-size buffer)
1143           (symbol-value-in-buffer 'mode-name buffer)
1144           (or (buffer-file-name buffer) "")))
1145
1146 (defun format-buffers-menu-line (buffer)
1147   "For use as a value of `buffers-menu-format-buffer-line-function'.
1148 This just returns the buffer's name."
1149   (buffer-name buffer))
1150
1151 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1152   "For use as a value of `buffers-menu-grouping-function'.
1153 This groups buffers by major mode.  It only really makes sense if
1154 `buffers-menu-sorting-function' is
1155 `sort-buffers-menu-by-mode-then-alphabetically'."
1156   (cond ((string-match "\\`*" (buffer-name buf1))
1157          (and (null buf2) "*Misc*"))
1158         ((or (null buf2)
1159              (string-match "\\`*" (buffer-name buf2))
1160              (not (eq (symbol-value-in-buffer 'major-mode buf1)
1161                       (symbol-value-in-buffer 'major-mode buf2))))
1162          (symbol-value-in-buffer 'mode-name buf1))
1163         (t nil)))
1164
1165 (defun buffer-menu-save-buffer (buffer)
1166   (save-excursion
1167     (set-buffer buffer)
1168     (save-buffer)))
1169
1170 (defun buffer-menu-write-file (buffer)
1171   (save-excursion
1172     (set-buffer buffer)
1173     (write-file (read-file-name
1174                  (format "Write %s to file: "
1175                          (buffer-name (current-buffer)))))))
1176
1177 (defsubst build-buffers-menu-internal (buffers)
1178   (let (name line)
1179     (mapcar
1180      #'(lambda (buffer)
1181          (if (eq buffer t)
1182              "---"
1183            (setq line (funcall buffers-menu-format-buffer-line-function
1184                                buffer))
1185            (if complex-buffers-menu-p
1186                (delq nil
1187                      (list line
1188                            (vector "Switch to Buffer"
1189                                    (list buffers-menu-switch-to-buffer-function
1190                                          (setq name (buffer-name buffer)))
1191                                    t)
1192                            (if (eq buffers-menu-switch-to-buffer-function
1193                                    'switch-to-buffer)
1194                                (vector "Switch to Buffer, Other Frame"
1195                                        (list 'switch-to-buffer-other-frame
1196                                              (setq name (buffer-name buffer)))
1197                                        t)
1198                              nil)
1199                            (if (and (buffer-modified-p buffer)
1200                                     (buffer-file-name buffer))
1201                                (vector "Save Buffer"
1202                                        (list 'buffer-menu-save-buffer name) t)
1203                              ["Save Buffer" nil nil]
1204                              )
1205                            (vector "Save As..."
1206                                    (list 'buffer-menu-write-file name) t)
1207                            (vector "Delete Buffer" (list 'kill-buffer name)
1208                                    t)))
1209              ;; ### We don't want buffer names to be translated,
1210              ;; ### so we put the buffer name in the suffix.
1211              ;; ### Also, avoid losing with non-ASCII buffer names.
1212              ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
1213              (vector ""
1214                      (list buffers-menu-switch-to-buffer-function
1215                            (buffer-name buffer))
1216                      t line))))
1217      buffers)))
1218
1219 (defun buffers-menu-filter (menu)
1220   "This is the menu filter for the top-level buffers \"Buffers\" menu.
1221 It dynamically creates a list of buffers to use as the contents of the menu.
1222 Only the most-recently-used few buffers will be listed on the menu, for
1223 efficiency reasons.  You can control how many buffers will be shown by
1224 setting `buffers-menu-max-size'.  You can control the text of the menu
1225 items by redefining the function `format-buffers-menu-line'."
1226   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1227     (and (integerp buffers-menu-max-size)
1228          (> buffers-menu-max-size 1)
1229          (> (length buffers) buffers-menu-max-size)
1230          ;; shorten list of buffers (not with submenus!)
1231          (not (and buffers-menu-grouping-function
1232                    buffers-menu-submenus-for-groups-p))
1233          (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1234     (if buffers-menu-sort-function
1235         (setq buffers (sort buffers buffers-menu-sort-function)))
1236     (if (and buffers-menu-grouping-function
1237              buffers-menu-submenus-for-groups-p
1238              (or (not (integerp buffers-menu-submenus-for-groups-p))
1239                  (> (length buffers) buffers-menu-submenus-for-groups-p)))
1240         (let (groups groupnames current-group)
1241           (mapl
1242            #'(lambda (sublist)
1243                (let ((groupname (funcall buffers-menu-grouping-function
1244                                          (car sublist) (cadr sublist))))
1245                  (setq current-group (cons (car sublist) current-group))
1246                  (if groupname
1247                      (progn
1248                        (setq groups (cons (nreverse current-group)
1249                                           groups))
1250                        (setq groupnames (cons groupname groupnames))
1251                        (setq current-group nil)))))
1252            buffers)
1253           (setq buffers
1254                 (mapcar*
1255                  #'(lambda (groupname group)
1256                      (cons groupname (build-buffers-menu-internal group)))
1257                  (nreverse groupnames)
1258                  (nreverse groups))))
1259       (if buffers-menu-grouping-function
1260           (progn
1261             (setq buffers
1262                   (mapcon
1263                    #'(lambda (sublist)
1264                        (cond ((funcall buffers-menu-grouping-function
1265                                        (car sublist) (cadr sublist))
1266                               (list (car sublist) t))
1267                              (t (list (car sublist)))))
1268                    buffers))
1269             ;; remove a trailing separator.
1270             (and (>= (length buffers) 2)
1271                  (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1272                    (if (eq t (cadr lastcdr))
1273                        (setcdr lastcdr nil))))))
1274       (setq buffers (build-buffers-menu-internal buffers)))
1275     (append menu buffers)
1276     ))
1277
1278 (defun language-environment-menu-filter (menu)
1279   "This is the menu filter for the \"Language Environment\" submenu."
1280   (mapcar (lambda (env-sym)
1281             `[ ,(capitalize (symbol-name env-sym))
1282                (set-language-environment ',env-sym)])
1283           language-environment-list))
1284
1285 \f
1286 ;;; The Options menu
1287
1288 ;; We'll keep those variables here for a while, in order to provide a
1289 ;; function for porting the old options file that a user may own to Custom.
1290
1291 (defvar options-save-faces nil
1292   "*Non-nil value means save-options will save information about faces.
1293 A nil value means save-options will not save face information.
1294 Set this non-nil only if you use M-x edit-faces to change face
1295 settings.  If you use M-x customize-face or the \"Browse Faces...\"
1296 menu entry, you will see a button in the Customize Face buffer that you
1297 can use to permanently save your face changes.
1298
1299 M-x edit-faces is deprecated.  Support for it and this variable will
1300 be discontinued in a future release.")
1301
1302 (defvar save-options-init-file nil
1303   "File into which to save forms to load the options file (nil for .emacs).
1304 Normally this is nil, which means save into your .emacs file (the value
1305 of `user-init-file'.")
1306
1307 (defvar save-options-file ".xemacs-options"
1308   "File to save options into.
1309 This file is loaded from your .emacs file.
1310 If this is a relative filename, it is put into the same directory as your
1311 .emacs file.")
1312
1313
1314 \f
1315 ;;; The Help menu
1316
1317 (if (featurep 'mule)
1318     (defun tutorials-menu-filter (menu-items)
1319       ;; If there's a tutorial for the current language environment, make it
1320       ;; appear first as the default one. Otherwise, use the english one.
1321       (let* ((menu menu-items)
1322              (item (pop menu-items)))
1323         (aset
1324          item 3
1325          (concat "("
1326                  (if (assoc
1327                       'tutorial
1328                       (assoc current-language-environment language-info-alist))
1329                      current-language-environment
1330                    "English")
1331                  ")"))
1332         menu)))
1333
1334 \f
1335 (set-menubar default-menubar)
1336
1337 \f
1338 ;;; Popup menus.
1339
1340 (defconst default-popup-menu
1341   '("XEmacs Commands"
1342     ["Undo" advertised-undo
1343      :active (and (not (eq buffer-undo-list t))
1344                   (or buffer-undo-list pending-undo-list))
1345      :suffix (if (or (eq last-command 'undo)
1346                      (eq last-command 'advertised-undo))
1347                  "More" "")]
1348     ["Cut" kill-primary-selection
1349      :active (selection-owner-p)]
1350     ["Copy" copy-primary-selection
1351      :active (selection-owner-p)]
1352     ["Paste" yank-clipboard-selection
1353      :active (selection-exists-p 'CLIPBOARD)]
1354     ["Clear" delete-primary-selection
1355      :active (selection-owner-p)]
1356     "-----"
1357     ["Select Block" mark-paragraph]
1358     ["Split Window" split-window-vertically]
1359     ["Unsplit Window" delete-other-windows]
1360     ))
1361
1362 (defvar global-popup-menu nil
1363   "The global popup menu.  This is present in all modes.
1364 See the function `popup-menu' for a description of menu syntax.")
1365
1366 (defvar mode-popup-menu nil
1367   "The mode-specific popup menu.  Automatically buffer local.
1368 This is appended to the default items in `global-popup-menu'.
1369 See the function `popup-menu' for a description of menu syntax.")
1370 (make-variable-buffer-local 'mode-popup-menu)
1371
1372 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1373 ;; superceded by any local popup menu...
1374 (setq-default mode-popup-menu default-popup-menu)
1375
1376 (defvar activate-popup-menu-hook nil
1377   "Function or functions run before a mode-specific popup menu is made visible.
1378 These functions are called with no arguments, and should interrogate and
1379 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1380 Note: this hook is only run if you use `popup-mode-menu' for activating the
1381 global and mode-specific commands; if you have your own binding for button3,
1382 this hook won't be run.")
1383
1384 (defun popup-mode-menu ()
1385   "Pop up a menu of global and mode-specific commands.
1386 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1387   (interactive "@_")
1388   (run-hooks 'activate-popup-menu-hook)
1389   (popup-menu
1390    (cond ((and global-popup-menu mode-popup-menu)
1391           ;; Merge global-popup-menu and mode-popup-menu
1392           (check-menu-syntax mode-popup-menu)
1393           (let* ((title (car mode-popup-menu))
1394                  (items (cdr mode-popup-menu))
1395                  mode-filters)
1396             ;; Strip keywords from local menu for attaching them at the top
1397             (while (and items
1398                         (keywordp (car items)))
1399               ;; Push both keyword and its argument.
1400               (push (pop items) mode-filters)
1401               (push (pop items) mode-filters))
1402             (setq mode-filters (nreverse mode-filters))
1403             ;; If mode-filters contains a keyword already present in
1404             ;; `global-popup-menu', you will probably lose.
1405             (append (list (car global-popup-menu))
1406                     mode-filters
1407                     (cdr global-popup-menu)
1408                     '("---" "---")
1409                     (if popup-menu-titles (list title))
1410                     (if popup-menu-titles '("---" "---"))
1411                     items)))
1412          (t
1413           (or mode-popup-menu
1414               global-popup-menu
1415               (error "No menu defined in this buffer"))))))
1416
1417 (defun popup-buffer-menu (event)
1418   "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1419   (interactive "e")
1420   (let ((window (and (event-over-text-area-p event) (event-window event)))
1421         (bmenu nil))
1422     (or window
1423         (error "Pointer must be in a normal window"))
1424     (select-window window)
1425     (if current-menubar
1426         (setq bmenu (assoc "Buffers" current-menubar)))
1427     (if (null bmenu)
1428         (setq bmenu (assoc "Buffers" default-menubar)))
1429     (if (null bmenu)
1430         (error "Can't find the Buffers menu"))
1431     (popup-menu bmenu)))
1432
1433 (defun popup-menubar-menu (event)
1434   "Pop up a copy of menu that also appears in the menubar"
1435   ;; by Stig@hackvan.com
1436   (interactive "e")
1437   (let ((window (and (event-over-text-area-p event) (event-window event)))
1438         popup-menubar)
1439     (or window
1440         (error "Pointer must be in a normal window"))
1441     (select-window window)
1442     (and current-menubar (run-hooks 'activate-menubar-hook))
1443     ;; ##### Instead of having to copy this just to safely get rid of
1444     ;; any nil what we should really do is fix up the internal menubar
1445     ;; code to just ignore nil if generating a popup menu
1446     (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1447                                                        default-menubar))))
1448     (popup-menu (cons "Menubar Menu" popup-menubar))
1449     ))
1450
1451 (global-set-key 'button3 'popup-mode-menu)
1452 ;; shift button3 and shift button2 are reserved for Hyperbole
1453 (global-set-key '(meta control button3) 'popup-buffer-menu)
1454 ;; The following command is way too dangerous with Custom.
1455 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1456
1457 ;; Here's a test of the cool new menu features (from Stig).
1458
1459 ;;(setq mode-popup-menu
1460 ;;      '("Test Popup Menu"
1461 ;;        :filter cdr
1462 ;;        ["this item won't appear because of the menu filter" ding t]
1463 ;;        "--:singleLine"
1464 ;;        "singleLine"
1465 ;;        "--:doubleLine"
1466 ;;        "doubleLine"
1467 ;;        "--:singleDashedLine"
1468 ;;        "singleDashedLine"
1469 ;;        "--:doubleDashedLine"
1470 ;;        "doubleDashedLine"
1471 ;;        "--:noLine"
1472 ;;        "noLine"
1473 ;;        "--:shadowEtchedIn"
1474 ;;        "shadowEtchedIn"
1475 ;;        "--:shadowEtchedOut"
1476 ;;        "shadowEtchedOut"
1477 ;;        "--:shadowDoubleEtchedIn"
1478 ;;        "shadowDoubleEtchedIn"
1479 ;;        "--:shadowDoubleEtchedOut"
1480 ;;        "shadowDoubleEtchedOut"
1481 ;;        "--:shadowEtchedInDash"
1482 ;;        "shadowEtchedInDash"
1483 ;;        "--:shadowEtchedOutDash"
1484 ;;        "shadowEtchedOutDash"
1485 ;;        "--:shadowDoubleEtchedInDash"
1486 ;;        "shadowDoubleEtchedInDash"
1487 ;;        "--:shadowDoubleEtchedOutDash"
1488 ;;        "shadowDoubleEtchedOutDash"
1489 ;;        ))
1490
1491 (defun xemacs-splash-buffer ()
1492   "Redisplay XEmacs splash screen in a buffer."
1493   (interactive)
1494   (let ((buffer (get-buffer-create "*Splash*")))
1495     (set-buffer buffer)
1496     (erase-buffer buffer)
1497     (startup-splash-frame)
1498     (pop-to-buffer buffer)
1499     (delete-other-windows)))
1500
1501 \f
1502 ;;; backwards compatibility
1503 (provide 'x-menubar)
1504 (provide 'menubar-items)
1505
1506 ;;; x-menubar.el ends here.