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