1 ;;; menubar-items.el --- Menubar and popup-menu content for XEmacs.
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
9 ;; Maintainer: XEmacs Development Team
10 ;; Keywords: frames, extensions, internal, dumped
12 ;; This file is part of XEmacs.
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)
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.
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.
31 ;; This file is dumped with XEmacs (when window system and menubar support is
36 ;;; Warning-free compile
38 (defvar language-environment-list)
39 (defvar bookmark-alist)
40 (defvar language-info-alist)
41 (defvar current-language-environment)
42 (defvar tutorial-supported-languages))
44 (defun menu-truncate-list (list n)
45 (if (<= (length list) n)
47 (butlast list (- (length list) n))))
49 (defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
50 "Add auto-generated accelerator specifications to a submenu.
51 This can be used to add accelerators to the return value of a menu filter
52 function. It correctly ignores unselectable items. It will destructively
53 modify the list passed to it. If an item already has an auto-generated
54 accelerator spec, this will be removed before the new one is added, making
55 this function idempotent.
57 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
58 which will not be used as accelerators."
60 (dolist (item list list)
66 (menu-item-generate-accelerator-spec n omit-chars-list)
67 (menu-item-strip-accelerator-spec (aref item 0)))))
72 (menu-item-generate-accelerator-spec n omit-chars-list)
73 (menu-item-strip-accelerator-spec (car item)))))))))
75 (defun menu-item-strip-accelerator-spec (item)
76 "Strip an auto-generated accelerator spec off of ITEM.
77 ITEM should be a string. This removes specs added by
78 `menu-item-generate-accelerator-spec' and `submenu-generate-accelerator-spec'."
79 (if (string-match "%_. " item)
83 (defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
84 "Return an accelerator specification for use with auto-generated menus.
85 This should be concat'd onto the beginning of each menu line. The spec
86 allows the Nth line to be selected by the number N. '0' is used for the
87 10th line, and 'a' through 'z' are used for the following 26 lines.
89 If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
90 which will not be used as accelerators."
91 (cond ((< n 10) (concat "%_" (int-to-string n) " "))
98 (while (memq (int-to-char (+ m (- (char-to-int ?a) 1)))
105 (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1))))
110 (defconst default-menubar
115 ["%_Open..." find-file]
116 ["Open in Other %_Window..." find-file-other-window]
117 ["Open in New %_Frame..." find-file-other-frame]
118 ["%_Hex Edit File..." hexl-find-file
119 :active (fboundp 'hexl-find-file)]
120 ["%_Insert File..." insert-file]
121 ["%_View File..." view-file]
123 ["%_Save" save-buffer
124 :active (buffer-modified-p)
125 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
126 ["Save %_As..." write-file]
127 ["Save So%_me Buffers" save-some-buffers]
129 ["%_Print Buffer" lpr-buffer
130 :active (fboundp 'lpr-buffer)
131 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
132 ["Prett%_y-Print Buffer" ps-print-buffer-with-faces
133 :active (fboundp 'ps-print-buffer-with-faces)
134 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
136 ["%_Revert Buffer" revert-buffer
137 :active (or buffer-file-name revert-buffer-function)
138 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
139 ["Re%_cover File..." recover-file]
140 ["Recover S%_ession..." recover-session]
142 ["E%_xit XEmacs" save-buffers-kill-emacs]
146 ["%_Undo" advertised-undo
147 :active (and (not (eq buffer-undo-list t))
148 (or buffer-undo-list pending-undo-list))
149 :suffix (if (or (eq last-command 'undo)
150 (eq last-command 'advertised-undo))
153 :included (fboundp 'redo)
154 :active (not (or (eq buffer-undo-list t)
155 (eq last-buffer-undo-list nil)
156 (not (or (eq last-buffer-undo-list buffer-undo-list)
157 (and (null (car-safe buffer-undo-list))
158 (eq last-buffer-undo-list
159 (cdr-safe buffer-undo-list)))))
160 (or (eq buffer-undo-list pending-undo-list)
161 (eq (cdr buffer-undo-list) pending-undo-list))))
162 :suffix (if (eq last-command 'redo) "More" "")]
164 ["Cu%_t" kill-primary-selection
165 :active (selection-owner-p)]
166 ["%_Copy" copy-primary-selection
167 :active (selection-owner-p)]
168 ["%_Paste" yank-clipboard-selection
169 :active (selection-exists-p 'CLIPBOARD)]
170 ["%_Delete" delete-primary-selection
171 :active (selection-owner-p)]
173 ["Select %_All" mark-whole-buffer]
174 ["Select %_Page" mark-page]
176 ["%_1 Search..." isearch-forward]
177 ["%_2 Search Backward..." isearch-backward]
178 ["%_3 Replace..." query-replace]
180 ["%_4 Search (Regexp)..." isearch-forward-regexp]
181 ["%_5 Search Backward (Regexp)..." isearch-backward-regexp]
182 ["%_6 Replace (Regexp)..." query-replace-regexp]
184 ,@(when (featurep 'mule)
186 ("%_Multilingual (\"Mule\")"
187 ("%_Describe Language Support")
188 ("%_Set Language Environment")
190 ["T%_oggle Input Method" toggle-input-method]
191 ["Select %_Input Method" set-input-method]
192 ["D%_escribe Input Method" describe-input-method]
194 ["Describe Current %_Coding Systems"
195 describe-current-coding-system]
196 ["Set Coding System of %_Buffer File..."
197 set-buffer-file-coding-system]
198 ;; not implemented yet
199 ["Set Coding System of %_Terminal..."
200 set-terminal-coding-system :active nil]
201 ;; not implemented yet
202 ["Set Coding System of %_Keyboard..."
203 set-keyboard-coding-system :active nil]
204 ["Set Coding System of %_Process..."
205 set-buffer-process-coding-system
206 :active (get-buffer-process (current-buffer))]
208 ["Show Cha%_racter Table" view-charset-by-menu]
209 ;; not implemented yet
210 ["Show Dia%_gnosis for MULE" mule-diag :active nil]
211 ["Show \"%_hello\" in Many Languages" view-hello-file]))
216 ["%_New Frame" make-frame]
217 ["Frame on Other Displa%_y..." make-frame-on-display]
218 ["%_Delete Frame" delete-frame
219 :active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
222 ["%_Split Window" split-window-vertically]
223 ["S%_plit Window (Side by Side)" split-window-horizontally]
224 ["%_Un-Split (Keep This)" delete-other-windows
225 :active (not (one-window-p t))]
226 ["Un-Split (Keep %_Others)" delete-window
227 :active (not (one-window-p t))]
230 ["%_Narrow to Region" narrow-to-region :active (region-exists-p)]
231 ["Narrow to %_Page" narrow-to-page]
232 ["Narrow to %_Defun" narrow-to-defun]
234 ["%_Widen" widen :active (or (/= (point-min) 1)
235 (/= (point-max) (1+ (buffer-size))))]
238 ["Show Message %_Log" show-message-log]
240 ["%_Goto Line..." goto-line]
241 ["%_What Line" what-line]
243 :filter bookmark-menu-filter)
245 ["%_Jump to Previous Mark" (set-mark-command t)
250 ["Repeat %_Last Complex Command..." repeat-complex-command]
251 ["E%_valuate Lisp Expression..." eval-expression]
252 ["Execute %_Named Command..." execute-extended-command]
254 ["Start %_Macro Recording" start-kbd-macro
255 :included (not defining-kbd-macro)]
256 ["End %_Macro Recording" end-kbd-macro
257 :included defining-kbd-macro]
258 ["E%_xecute Last Macro" call-last-kbd-macro
259 :active last-kbd-macro]
261 ["%_Append to Last Macro" (start-kbd-macro t)
262 :active (and (not defining-kbd-macro) last-kbd-macro)]
263 ["%_Query User During Macro" kbd-macro-query
264 :active defining-kbd-macro]
265 ["Enter %_Recursive Edit During Macro" (kbd-macro-query t)
266 :active defining-kbd-macro]
268 ["E%_xecute Last Macro on Region Lines"
269 :active (and last-kbd-macro (region-exists-p))]
271 ["%_Name Last Macro..." name-last-kbd-macro
272 :active last-kbd-macro]
273 ["Assign Last Macro to %_Key..." assign-last-kbd-macro-to-key
274 :active (and last-kbd-macro
275 (fboundp 'assign-last-kbd-macro-to-key))]
277 ["%_Edit Macro..." edit-kbd-macro]
278 ["Edit %_Last Macro" edit-last-kbd-macro
279 :active last-kbd-macro]
281 ["%_Insert Named Macro into Buffer..." insert-kbd-macro]
282 ["Read Macro from Re%_gion" read-kbd-macro
283 :active (region-exists-p)]
287 ["D%_ynamic Abbrev Expand" dabbrev-expand]
288 ["Dynamic Abbrev %_Complete" dabbrev-completion]
289 ["Dynamic Abbrev Complete in %_All Buffers" (dabbrev-completion 16)]
292 ["%_Define Global Abbrev for " add-global-abbrev
293 :suffix (abbrev-string-to-be-defined nil)
295 ["Define %_Mode-Specific Abbrev for " add-mode-abbrev
296 :suffix (abbrev-string-to-be-defined nil)
298 ["Define Global Ex%_pansion for " inverse-add-global-abbrev
299 :suffix (inverse-abbrev-string-to-be-defined 1)
301 ["Define Mode-Specific Expa%_nsion for " inverse-add-mode-abbrev
302 :suffix (inverse-abbrev-string-to-be-defined 1)
305 ["E%_xpand Abbrev" expand-abbrev]
306 ["Expand Abbrevs in Re%_gion" expand-region-abbrevs
307 :active (region-exists-p)]
308 ["%_Unexpand Last Abbrev" unexpand-abbrev
309 :active (and (stringp last-abbrev-text)
310 (> last-abbrev-location 0))]
312 ["%_Kill All Abbrevs" kill-all-abbrevs]
313 ["%_Insert All Abbrevs into Buffer" insert-abbrevs]
314 ["%_List Abbrevs" list-abbrevs]
316 ["%_Edit Abbrevs" edit-abbrevs]
317 ["%_Redefine Abbrevs from Buffer" edit-abbrevs-redefine
318 :active (eq major-mode 'edit-abbrevs-mode)]
320 ["%_Save Abbrevs As..." write-abbrev-file]
321 ["L%_oad Abbrevs..." read-abbrev-file]
324 ["%_Copy to Register..." copy-to-register :active (region-exists-p)]
325 ["%_Paste Register..." insert-register]
327 ["%_Save Point to Register" point-to-register]
328 ["%_Jump to Register" register-to-point]
331 ["%_Kill Rectangle" kill-rectangle]
332 ["%_Yank Rectangle" yank-rectangle]
333 ["Rectangle %_to Register" copy-rectangle-to-register]
334 ["Rectangle %_from Register" insert-register]
335 ["%_Clear Rectangle" clear-rectangle]
336 ["%_Open Rectangle" open-rectangle]
337 ["%_Prefix Rectangle..." string-rectangle]
338 ["Rectangle %_Mousing"
339 (customize-set-variable
340 mouse-track-rectangle-p (not mouse-track-rectangle-p))
341 :style toggle :selected mouse-track-rectangle-p]
344 ["%_Lines" sort-lines :active (region-exists-p)]
345 ["%_Paragraphs" sort-paragraphs :active (region-exists-p)]
346 ["P%_ages" sort-pages :active (region-exists-p)]
347 ["%_Columns" sort-columns :active (region-exists-p)]
348 ["%_Regexp..." sort-regexp-fields :active (region-exists-p)]
351 ["%_Line" center-line]
352 ["%_Paragraph" center-paragraph]
353 ["%_Region" center-region :active (region-exists-p)]
356 ["%_As Previous Line" indent-relative]
357 ["%_To Column..." indent-to-column]
359 ["%_Region" indent-region :active (region-exists-p)]
360 ["%_Balanced Expression" indent-sexp]
361 ["%_C Expression" indent-c-exp]
364 ["%_Buffer" ispell-buffer
365 :active (fboundp 'ispell-buffer)]
367 ["%_Word" ispell-word]
368 ["%_Complete Word" ispell-complete-word]
369 ["%_Region" ispell-region]
375 ["Read Mail %_1 (VM)..." vm
376 :active (fboundp 'vm)]
377 ["Read Mail %_2 (MH)..." (mh-rmail t)
378 :active (fboundp 'mh-rmail)]
379 ["Send %_Mail..." compose-mail
380 :active (fboundp 'compose-mail)]
381 ["Usenet %_News" gnus
382 :active (fboundp 'gnus)]
383 ["Browse the %_Web" w3
384 :active (fboundp 'w3)])
389 (if (or (not (boundp 'grep-history)) (null grep-history))
392 (submenu-generate-accelerator-spec
393 (mapcar #'(lambda (string)
395 (list 'grep string)))
396 (menu-truncate-list grep-history 10)))))
397 (append menu '("---") items))))
398 ["%_Grep..." grep :active (fboundp 'grep)]
399 ["%_Repeat Grep" recompile :active (fboundp 'recompile)]
400 ["%_Kill Grep" kill-compilation
401 :active (and (fboundp 'kill-compilation)
402 (fboundp 'compilation-find-buffer)
403 (let ((buffer (condition-case nil
404 (compilation-find-buffer)
406 (and buffer (get-buffer-process buffer))))]
408 ["Grep %_All Files in Current Directory..."
412 (cons (concat grep-command " *") (length grep-command))))
413 (call-interactively 'grep)))
414 :active (fboundp 'grep)]
415 ["Grep %_C Files in Current Directory..."
419 (cons (concat grep-command " *.[ch]") (length grep-command))))
420 (call-interactively 'grep)))
421 :active (fboundp 'grep)]
422 ["Grep %_E-Lisp Files in Current Directory..."
426 (cons (concat grep-command " *.el") (length grep-command))))
427 (call-interactively 'grep)))
428 :active (fboundp 'grep)]
430 ["%_Next Match" next-error
431 :active (and (fboundp 'compilation-errors-exist-p)
432 (compilation-errors-exist-p))]
433 ["%_Previous Match" previous-error
434 :active (and (fboundp 'compilation-errors-exist-p)
435 (compilation-errors-exist-p))]
436 ["%_First Match" first-error
437 :active (and (fboundp 'compilation-errors-exist-p)
438 (compilation-errors-exist-p))]
439 ["G%_oto Match" compile-goto-error
440 :active (and (fboundp 'compilation-errors-exist-p)
441 (compilation-errors-exist-p))]
443 ["%_Set Grep Command..."
446 (customize-set-variable
448 (read-shell-command "Default Grep Command: " grep-command)))
449 :active (fboundp 'grep)
455 (if (or (not (boundp 'compile-history)) (null compile-history))
458 (submenu-generate-accelerator-spec
459 (mapcar #'(lambda (string)
461 (list 'compile string)))
462 (menu-truncate-list compile-history 10)))))
463 (append menu '("---") items))))
464 ["%_Compile..." compile :active (fboundp 'compile)]
465 ["%_Repeat Compilation" recompile :active (fboundp 'recompile)]
466 ["%_Kill Compilation" kill-compilation
467 :active (and (fboundp 'kill-compilation)
468 (fboundp 'compilation-find-buffer)
469 (let ((buffer (condition-case nil
470 (compilation-find-buffer)
472 (and buffer (get-buffer-process buffer))))]
474 ["%_Next Error" next-error
475 :active (and (fboundp 'compilation-errors-exist-p)
476 (compilation-errors-exist-p))]
477 ["%_Previous Error" previous-error
478 :active (and (fboundp 'compilation-errors-exist-p)
479 (compilation-errors-exist-p))]
480 ["%_First Error" first-error
481 :active (and (fboundp 'compilation-errors-exist-p)
482 (compilation-errors-exist-p))]
483 ["G%_oto Error" compile-goto-error
484 :active (and (fboundp 'compilation-errors-exist-p)
485 (compilation-errors-exist-p))]
489 :active (fboundp 'gdb)]
491 :active (fboundp 'dbx)])
494 :active (fboundp 'shell)]
495 ["S%_hell Command..." shell-command
496 :active (fboundp 'shell-command)]
497 ["Shell Command on %_Region..." shell-command-on-region
498 :active (and (fboundp 'shell-command-on-region) (region-exists-p))])
501 ["%_Find Tag..." find-tag]
502 ["Find %_Other Window..." find-tag-other-window]
503 ["%_Next Tag..." (find-tag nil)]
504 ["N%_ext Other Window..." (find-tag-other-window nil)]
505 ["Next %_File" next-file]
507 ["Tags %_Search..." tags-search]
508 ["Tags %_Replace..." tags-query-replace]
509 ["%_Continue Search/Replace" tags-loop-continue]
511 ["%_Pop stack" pop-tag-mark]
512 ["%_Apropos..." tags-apropos]
514 ["%_Set Tags Table File..." visit-tags-table]
520 ["%_3-Month Calendar" calendar
521 :active (fboundp 'calendar)]
523 :active (fboundp 'diary)]
524 ["%_Holidays" holidays
525 :active (fboundp 'holidays)]
526 ;; we're all pagans at heart ...
527 ["%_Phases of the Moon" phases-of-moon
528 :active (fboundp 'phases-of-moon)]
529 ["%_Sunrise/Sunset" sunrise-sunset
530 :active (fboundp 'sunrise-sunset)])
534 :active (fboundp 'xmine)]
536 :active (fboundp 'tetris)]
538 :active (fboundp 'sokoban)]
539 ["Quote from %_Zippy" yow
540 :active (fboundp 'yow)]
541 ["%_Psychoanalyst" doctor
542 :active (fboundp 'doctor)]
543 ["Ps%_ychoanalyze Zippy!" psychoanalyze-pinhead
544 :active (fboundp 'psychoanalyze-pinhead)]
545 ["%_Random Flames" flame
546 :active (fboundp 'flame)]
547 ["%_Dunnet (Adventure)" dunnet
548 :active (fboundp 'dunnet)]
549 ["Towers of %_Hanoi" hanoi
550 :active (fboundp 'hanoi)]
551 ["Game of %_Life" life
552 :active (fboundp 'life)]
553 ["M%_ultiplication Puzzle" mpuz
554 :active (fboundp 'mpuz)])
560 ("%_Advanced (Customize)"
561 ("%_Emacs" :filter (lambda (&rest junk)
562 (cdr (custom-menu-create 'emacs))))
563 ["%_Group..." customize-group]
564 ["%_Variable..." customize-variable]
565 ["%_Face..." customize-face]
566 ["%_Saved..." customize-saved]
567 ["Se%_t..." customize-customized]
568 ["%_Apropos..." customize-apropos]
569 ["%_Browse..." customize-browse])
571 ("%_Add Download Site"
572 :filter (lambda (&rest junk)
573 (submenu-generate-accelerator-spec
574 (package-get-download-menu))))
575 ["%_Update Package Index" package-get-update-base]
576 ["%_List and Install" pui-list-packages]
577 ["U%_pdate Installed Packages" package-get-update-all]
578 ;; hack-o-matic, we can't force a load of package-base here
579 ;; since it triggers dialog box interactions which we can't
580 ;; deal with while using a menu
582 :filter (lambda (&rest junk)
584 (submenu-generate-accelerator-spec
585 (cdr (custom-menu-create 'packages)))
586 '(["Please load Package Index"
587 (lamda (&rest junk) ()) nil]))))
589 ["%_Help" (Info-goto-node "(xemacs)Packages")])
591 ("%_Keyboard and Mouse"
593 (customize-set-variable 'abbrev-mode
594 (not (default-value 'abbrev-mode)))
596 :selected (default-value 'abbrev-mode)]
597 ["%_Delete Key Deletes Selection"
598 (customize-set-variable 'pending-delete-mode (not pending-delete-mode))
600 :selected (and (boundp 'pending-delete-mode) pending-delete-mode)
601 :active (boundp 'pending-delete-mode)]
602 ["%_Yank/Kill Interact With Clipboard"
603 (if (eq interprogram-cut-function 'own-clipboard)
605 (customize-set-variable 'interprogram-cut-function nil)
606 (customize-set-variable 'interprogram-paste-function nil))
607 (customize-set-variable 'interprogram-cut-function 'own-clipboard)
608 (customize-set-variable 'interprogram-paste-function 'get-clipboard))
610 :selected (eq interprogram-cut-function 'own-clipboard)]
613 (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual))
614 (customize-set-variable 'overwrite-mode overwrite-mode))
615 :style toggle :selected overwrite-mode]
616 ("`%_kill-line' Behavior..."
618 (customize-set-variable 'kill-whole-line 'always)
619 :style radio :selected (eq kill-whole-line 'always)]
620 ["Kill to %_End of Line"
621 (customize-set-variable 'kill-whole-line nil)
622 :style radio :selected (eq kill-whole-line nil)]
623 ["Kill Whole Line at %_Beg, Otherwise to End"
624 (customize-set-variable 'kill-whole-line t)
625 :style radio :selected (eq kill-whole-line t)])
626 ["Size for %_Block-Movement Commands..."
627 (customize-set-variable 'block-movement-size
628 (read-number "Block Movement Size: "
629 t block-movement-size))]
633 (customize-set-variable 'viper-mode viper-mode))
634 :style toggle :selected (and (boundp 'viper-mode) viper-mode)
635 :active (fboundp 'toggle-viper-mode)]
637 (customize-set-variable 'zmacs-regions (not zmacs-regions))
638 :style toggle :selected zmacs-regions]
640 ["%_Set Key..." global-set-key]
641 ["%_Unset Key..." global-unset-key]
643 ["%_Case Sensitive Search"
644 (customize-set-variable 'case-fold-search
645 (setq case-fold-search (not case-fold-search)))
646 :style toggle :selected (not case-fold-search)]
647 ["Case Matching %_Replace"
648 (customize-set-variable 'case-replace (not case-replace))
649 :style toggle :selected case-replace]
651 ("%_Newline at End of File..."
653 (customize-set-variable 'require-final-newline nil)
654 :style radio :selected (not require-final-newline)]
656 (customize-set-variable 'require-final-newline t)
657 :style radio :selected (eq require-final-newline t)]
659 (customize-set-variable 'require-final-newline 'ask)
660 :style radio :selected (and require-final-newline
661 (not (eq require-final-newline t)))])
662 ["Add Newline When Moving Past %_End"
663 (customize-set-variable 'next-line-add-newlines
664 (not next-line-add-newlines))
665 :style toggle :selected next-line-add-newlines]
667 ["%_Mouse Paste at Text Cursor"
668 (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point))
669 :style toggle :selected mouse-yank-at-point]
671 (customize-set-variable 'mouse-avoidance-mode
672 (if mouse-avoidance-mode nil 'banish))
674 :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode)
675 :active (and (boundp 'mouse-avoidance-mode)
676 (device-on-window-system-p))]
678 (customize-set-variable 'strokes-mode (not strokes-mode))
680 :selected (and (boundp 'strokes-mode) strokes-mode)
681 :active (and (boundp 'strokes-mode)
682 (device-on-window-system-p))]
685 ["This Buffer %_Read Only" (toggle-read-only)
686 :style toggle :selected buffer-read-only]
687 ["%_Teach Extended Commands"
688 (customize-set-variable 'teach-extended-commands-p
689 (not teach-extended-commands-p))
690 :style toggle :selected teach-extended-commands-p]
692 (customize-set-variable 'debug-on-error (not debug-on-error))
693 :style toggle :selected debug-on-error]
695 (customize-set-variable 'debug-on-quit (not debug-on-quit))
696 :style toggle :selected debug-on-quit]
698 (customize-set-variable 'debug-on-signal (not debug-on-signal))
699 :style toggle :selected debug-on-signal]
703 ["Command-Line %_Switches for `lpr'/`lp'..."
704 ;; better to directly open a customization buffer, since the value
705 ;; must be a list of strings, which is somewhat complex to prompt for.
706 (customize-variable 'lpr-switches)
707 (boundp 'lpr-switches)]
708 ("%_Pretty-Print Paper Size"
710 (customize-set-variable 'ps-paper-type 'letter)
712 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter))
713 :active (boundp 'ps-paper-type)]
715 (customize-set-variable 'ps-paper-type 'letter-small)
717 :selected (and (boundp 'ps-paper-type)
718 (eq ps-paper-type 'letter-small))
719 :active (boundp 'ps-paper-type)]
721 (customize-set-variable 'ps-paper-type 'legal)
723 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal))
724 :active (boundp 'ps-paper-type)]
726 (customize-set-variable 'ps-paper-type 'statement)
728 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement))
729 :active (boundp 'ps-paper-type)]
731 (customize-set-variable 'ps-paper-type 'executive)
733 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive))
734 :active (boundp 'ps-paper-type)]
736 (customize-set-variable 'ps-paper-type 'tabloid)
738 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid))
739 :active (boundp 'ps-paper-type)]
741 (customize-set-variable 'ps-paper-type 'ledger)
743 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger))
744 :active (boundp 'ps-paper-type)]
746 (customize-set-variable 'ps-paper-type 'a3)
748 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3))
749 :active (boundp 'ps-paper-type)]
751 (customize-set-variable 'ps-paper-type 'a4)
753 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4))
754 :active (boundp 'ps-paper-type)]
756 (customize-set-variable 'ps-paper-type 'a4small)
758 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small))
759 :active (boundp 'ps-paper-type)]
761 (customize-set-variable 'ps-paper-type 'b4)
763 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4))
764 :active (boundp 'ps-paper-type)]
766 (customize-set-variable 'ps-paper-type 'b5)
768 :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5))
769 :active (boundp 'ps-paper-type)]
772 (cond (ps-print-color-p
773 (customize-set-variable 'ps-print-color-p nil)
774 ;; I'm wondering whether all this muck is useful.
775 (and (boundp 'original-face-background)
776 original-face-background
777 (set-face-background 'default original-face-background)))
779 (customize-set-variable 'ps-print-color-p t)
780 (setq original-face-background
781 (face-background-instance 'default))
782 (set-face-background 'default "white")))
784 :selected (and (boundp 'ps-print-color-p) ps-print-color-p)
785 :active (boundp 'ps-print-color-p)])
787 ("%_Compose Mail With"
788 ["Default Emacs Mailer"
789 (customize-set-variable 'mail-user-agent 'sendmail-user-agent)
791 :selected (eq mail-user-agent 'sendmail-user-agent)]
793 (customize-set-variable 'mail-user-agent 'mh-e-user-agent)
795 :selected (eq mail-user-agent 'mh-e-user-agent)
796 :active (get 'mh-e-user-agent 'composefunc)]
798 (customize-set-variable 'mail-user-agent 'message-user-agent)
800 :selected (eq mail-user-agent 'message-user-agent)
801 :active (get 'message-user-agent 'composefunc)]
803 ["Set My %_Email Address..."
804 (customize-set-variable
806 (read-string "Set email address: " user-mail-address))]
807 ["Set %_Machine Email Name..."
808 (customize-set-variable
810 (read-string "Set machine email name: " mail-host-address))]
814 (customize-set-variable 'browse-url-browser-function 'browse-url-w3)
816 :selected (and (boundp 'browse-url-browser-function)
817 (eq browse-url-browser-function 'browse-url-w3))
818 :active (and (boundp 'browse-url-browser-function)
819 (fboundp 'browse-url-w3)
820 (fboundp 'w3-fetch))]
822 (customize-set-variable 'browse-url-browser-function
823 'browse-url-netscape)
825 :selected (and (boundp 'browse-url-browser-function)
826 (eq browse-url-browser-function 'browse-url-netscape))
827 :active (and (boundp 'browse-url-browser-function)
828 (fboundp 'browse-url-netscape))]
830 (customize-set-variable 'browse-url-browser-function
833 :selected (and (boundp 'browse-url-browser-function)
834 (eq browse-url-browser-function 'browse-url-mosaic))
835 :active (and (boundp 'browse-url-browser-function)
836 (fboundp 'browse-url-mosaic))]
838 (customize-set-variable 'browse-url-browser-function 'browse-url-cci)
840 :selected (and (boundp 'browse-url-browser-function)
841 (eq browse-url-browser-function 'browse-url-cci))
842 :active (and (boundp 'browse-url-browser-function)
843 (fboundp 'browse-url-cci))]
845 (customize-set-variable 'browse-url-browser-function
846 'browse-url-iximosaic)
848 :selected (and (boundp 'browse-url-browser-function)
849 (eq browse-url-browser-function 'browse-url-iximosaic))
850 :active (and (boundp 'browse-url-browser-function)
851 (fboundp 'browse-url-iximosaic))]
853 (customize-set-variable 'browse-url-browser-function
854 'browse-url-lynx-xterm)
856 :selected (and (boundp 'browse-url-browser-function)
857 (eq browse-url-browser-function 'browse-url-lynx-xterm))
858 :active (and (boundp 'browse-url-browser-function)
859 (fboundp 'browse-url-lynx-xterm))]
861 (customize-set-variable 'browse-url-browser-function
862 'browse-url-lynx-emacs)
864 :selected (and (boundp 'browse-url-browser-function)
865 (eq browse-url-browser-function 'browse-url-lynx-emacs))
866 :active (and (boundp 'browse-url-browser-function)
867 (fboundp 'browse-url-lynx-emacs))]
869 (customize-set-variable 'browse-url-browser-function
872 :selected (and (boundp 'browse-url-browser-function)
873 (eq browse-url-browser-function 'browse-url-grail))
874 :active (and (boundp 'browse-url-browser-function)
875 (fboundp 'browse-url-grail))]
877 (customize-set-variable 'browse-url-browser-function
880 :selected (and (boundp 'browse-url-browser-function)
881 (eq browse-url-browser-function 'browse-url-kfm))
882 :active (and (boundp 'browse-url-browser-function)
883 (fboundp 'browse-url-kfm))]
889 ,@(if (featurep 'scrollbar)
891 (customize-set-variable 'scrollbars-visible-p
892 (not scrollbars-visible-p))
894 :selected scrollbars-visible-p]))
895 ;; I don't think this is of any interest. - dverna apr. 98
896 ;; #### I beg to differ! Many FSFmacs converts hate the 3D
897 ;; modeline, and it was perfectly fine to be able to turn them
898 ;; off through the Options menu. I would have uncommented this
899 ;; source, but the code for saving options would not save the
900 ;; modeline 3D-ness. Grrr. --hniksic
903 ;; (if (zerop (specifier-instance modeline-shadow-thickness))
904 ;; (set-specifier modeline-shadow-thickness 2)
905 ;; (set-specifier modeline-shadow-thickness 0))
906 ;; (redraw-modeline t))
908 ;; :selected (let ((thickness
909 ;; (specifier-instance modeline-shadow-thickness)))
910 ;; (and (integerp thickness)
911 ;; (> thickness 0)))]
913 (progn;; becomes buffer-local
914 (setq truncate-lines (not truncate-lines))
915 (customize-set-variable 'truncate-lines truncate-lines))
917 :selected truncate-lines]
919 (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode))
921 :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)
922 :active (boundp 'blink-cursor-mode)]
926 (customize-set-variable 'bar-cursor nil)
927 (force-cursor-redisplay))
929 :selected (null bar-cursor)]
930 ["Bar Cursor (%_1 Pixel)"
932 (customize-set-variable 'bar-cursor t)
933 (force-cursor-redisplay))
935 :selected (eq bar-cursor t)]
936 ["Bar Cursor (%_2 Pixels)"
938 (customize-set-variable 'bar-cursor 2)
939 (force-cursor-redisplay))
941 :selected (and bar-cursor (not (eq bar-cursor t)))]
945 (customize-set-variable 'line-number-mode (not line-number-mode))
947 :style toggle :selected line-number-mode]
950 (customize-set-variable 'column-number-mode
951 (not column-number-mode))
953 :style toggle :selected column-number-mode]
955 ("\"Other %_Window\" Location"
956 ["%_Always in Same Frame"
957 (customize-set-variable
958 'get-frame-for-buffer-default-instance-limit nil)
960 :selected (null get-frame-for-buffer-default-instance-limit)]
961 ["Other Frame (%_2 Frames Max)"
962 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2)
964 :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
965 ["Other Frame (%_3 Frames Max)"
966 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3)
968 :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
969 ["Other Frame (%_4 Frames Max)"
970 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4)
972 :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
973 ["Other Frame (%_5 Frames Max)"
974 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5)
976 :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
977 ["Always Create %_New Frame"
978 (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0)
980 :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
982 ["%_Temp Buffers Always in Same Frame"
983 (customize-set-variable 'temp-buffer-show-function
984 'show-temp-buffer-in-current-frame)
986 :selected (eq temp-buffer-show-function
987 'show-temp-buffer-in-current-frame)]
988 ["Temp Buffers %_Like Other Buffers"
989 (customize-set-variable 'temp-buffer-show-function nil)
991 :selected (null temp-buffer-show-function)]
993 ["%_Make Current Frame Gnuserv Target"
994 (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t))
996 :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t))
997 :active (boundp 'gnuserv-frame)]
1001 ["%_Frame-Local Font Menu"
1002 (customize-set-variable 'font-menu-this-frame-only-p
1003 (not font-menu-this-frame-only-p))
1005 :selected (and (boundp 'font-menu-this-frame-only-p)
1006 font-menu-this-frame-only-p)]
1007 ["%_Alt/Meta Selects Menu Items"
1008 (if (eq menu-accelerator-enabled 'menu-force)
1009 (customize-set-variable 'menu-accelerator-enabled nil)
1010 (customize-set-variable 'menu-accelerator-enabled 'menu-force))
1012 :selected (eq menu-accelerator-enabled 'menu-force)]
1014 ["Buffers Menu %_Length..."
1015 (customize-set-variable
1016 'buffers-menu-max-size
1017 ;; would it be better to open a customization buffer ?
1020 "Enter number of buffers to display (or 0 for unlimited): ")))
1021 (if (eq val 0) nil val)))]
1022 ["%_Multi-Operation Buffers Sub-Menus"
1023 (customize-set-variable 'complex-buffers-menu-p
1024 (not complex-buffers-menu-p))
1026 :selected complex-buffers-menu-p]
1027 ["S%_ubmenus for Buffer Groups"
1028 (customize-set-variable 'buffers-menu-submenus-for-groups-p
1029 (not buffers-menu-submenus-for-groups-p))
1031 :selected buffers-menu-submenus-for-groups-p]
1032 ["%_Verbose Buffer Menu Entries"
1033 (if (eq buffers-menu-format-buffer-line-function
1034 'slow-format-buffers-menu-line)
1035 (customize-set-variable 'buffers-menu-format-buffer-line-function
1036 'format-buffers-menu-line)
1037 (customize-set-variable 'buffers-menu-format-buffer-line-function
1038 'slow-format-buffers-menu-line))
1040 :selected (eq buffers-menu-format-buffer-line-function
1041 'slow-format-buffers-menu-line)]
1042 ("Buffers Menu %_Sorting"
1043 ["%_Most Recently Used"
1045 (customize-set-variable 'buffers-menu-sort-function nil)
1046 (customize-set-variable 'buffers-menu-grouping-function nil))
1048 :selected (null buffers-menu-sort-function)]
1051 (customize-set-variable 'buffers-menu-sort-function
1052 'sort-buffers-menu-alphabetically)
1053 (customize-set-variable 'buffers-menu-grouping-function nil))
1055 :selected (eq 'sort-buffers-menu-alphabetically
1056 buffers-menu-sort-function)]
1057 ["%_By Major Mode, Then Alphabetically"
1059 (customize-set-variable
1060 'buffers-menu-sort-function
1061 'sort-buffers-menu-by-mode-then-alphabetically)
1062 (customize-set-variable
1063 'buffers-menu-grouping-function
1064 'group-buffers-menu-by-mode-then-alphabetically))
1066 :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
1067 buffers-menu-sort-function)])
1069 ["%_Ignore Scaled Fonts"
1070 (customize-set-variable 'font-menu-ignore-scaled-fonts
1071 (not font-menu-ignore-scaled-fonts))
1073 :selected (and (boundp 'font-menu-ignore-scaled-fonts)
1074 font-menu-ignore-scaled-fonts)]
1076 ,@(if (featurep 'toolbar)
1079 (customize-set-variable 'toolbar-visible-p
1080 (not toolbar-visible-p))
1082 :selected toolbar-visible-p]
1084 (customize-set-variable 'toolbar-captioned-p
1085 (not toolbar-captioned-p))
1087 :selected toolbar-captioned-p]
1088 ("%_Default Location"
1090 (customize-set-variable 'default-toolbar-position 'top)
1092 :selected (eq default-toolbar-position 'top)]
1094 (customize-set-variable 'default-toolbar-position 'bottom)
1096 :selected (eq default-toolbar-position 'bottom)]
1098 (customize-set-variable 'default-toolbar-position 'left)
1100 :selected (eq default-toolbar-position 'left)]
1102 (customize-set-variable 'default-toolbar-position 'right)
1104 :selected (eq default-toolbar-position 'right)]
1107 ,@(if (featurep 'gutter)
1109 ["Buffers Tab %_Visible"
1110 (customize-set-variable 'gutter-buffers-tab-visible-p
1111 (not gutter-buffers-tab-visible-p))
1113 :selected gutter-buffers-tab-visible-p]
1114 ("%_Default Location"
1116 (customize-set-variable 'default-gutter-position 'top)
1118 :selected (eq default-gutter-position 'top)]
1120 (customize-set-variable 'default-gutter-position 'bottom)
1122 :selected (eq default-gutter-position 'bottom)]
1124 (customize-set-variable 'default-gutter-position 'left)
1126 :selected (eq default-gutter-position 'left)]
1128 (customize-set-variable 'default-gutter-position 'right)
1130 :selected (eq default-gutter-position 'right)]
1134 ("S%_yntax Highlighting"
1136 (progn;; becomes buffer local
1138 (customize-set-variable 'font-lock-mode font-lock-mode))
1140 :selected (and (boundp 'font-lock-mode) font-lock-mode)
1141 :active (boundp 'font-lock-mode)]
1143 (customize-set-variable 'font-lock-auto-fontify
1144 (not font-lock-auto-fontify))
1146 :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)
1147 :active (fboundp 'font-lock-mode)]
1151 (require 'font-lock)
1152 (font-lock-use-default-fonts)
1153 (customize-set-variable 'font-lock-use-fonts t)
1154 (customize-set-variable 'font-lock-use-colors nil)
1157 :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts)
1158 :active (fboundp 'font-lock-mode)]
1161 (require 'font-lock)
1162 (font-lock-use-default-colors)
1163 (customize-set-variable 'font-lock-use-colors t)
1164 (customize-set-variable 'font-lock-use-fonts nil)
1167 :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors)
1168 :active (boundp 'font-lock-mode)]
1172 (require 'font-lock)
1173 (if (or (and (not (integerp font-lock-maximum-decoration))
1174 (not (eq t font-lock-maximum-decoration)))
1175 (and (integerp font-lock-maximum-decoration)
1176 (<= font-lock-maximum-decoration 0)))
1178 (customize-set-variable 'font-lock-maximum-decoration nil)
1179 (font-lock-recompute-variables)))
1181 :active (fboundp 'font-lock-mode)
1182 :selected (and (boundp 'font-lock-maximium-decoration)
1183 (or (and (not (integerp font-lock-maximum-decoration))
1184 (not (eq t font-lock-maximum-decoration)))
1185 (and (integerp font-lock-maximum-decoration)
1186 (<= font-lock-maximum-decoration 0))))]
1189 (require 'font-lock)
1190 (if (and (integerp font-lock-maximum-decoration)
1191 (= 1 font-lock-maximum-decoration))
1193 (customize-set-variable 'font-lock-maximum-decoration 1)
1194 (font-lock-recompute-variables)))
1196 :active (fboundp 'font-lock-mode)
1197 :selected (and (boundp 'font-lock-maximium-decoration)
1198 (integerp font-lock-maximum-decoration)
1199 (= 1 font-lock-maximum-decoration))]
1202 (require 'font-lock)
1203 (if (and (integerp font-lock-maximum-decoration)
1204 (= 2 font-lock-maximum-decoration))
1206 (customize-set-variable 'font-lock-maximum-decoration 2)
1207 (font-lock-recompute-variables)))
1209 :active (fboundp 'font-lock-mode)
1210 :selected (and (boundp 'font-lock-maximum-decoration)
1211 (integerp font-lock-maximum-decoration)
1212 (= 2 font-lock-maximum-decoration))]
1215 (require 'font-lock)
1216 (if (or (eq font-lock-maximum-decoration t)
1217 (and (integerp font-lock-maximum-decoration)
1218 (>= font-lock-maximum-decoration 3)))
1220 (customize-set-variable 'font-lock-maximum-decoration t)
1221 (font-lock-recompute-variables)))
1223 :active (fboundp 'font-lock-mode)
1224 :selected (and (boundp 'font-lock-maximum-decoration)
1225 (or (eq font-lock-maximum-decoration t)
1226 (and (integerp font-lock-maximum-decoration)
1227 (>= font-lock-maximum-decoration 3))))]
1230 (progn;; becomes buffer local
1232 (customize-set-variable 'lazy-shot-mode lazy-shot-mode)
1233 ;; this shouldn't be necessary so there has to
1234 ;; be a redisplay bug lurking somewhere (or
1235 ;; possibly another event handler bug)
1237 :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode)
1240 :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
1242 (progn;; becomes buffer local
1244 (customize-set-variable 'fast-lock-mode fast-lock-mode)
1245 ;; this shouldn't be necessary so there has to
1246 ;; be a redisplay bug lurking somewhere (or
1247 ;; possibly another event handler bug)
1249 :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode)
1252 :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
1254 ("Pa%_ren Highlighting"
1256 (customize-set-variable 'paren-mode nil)
1258 :selected (and (boundp 'paren-mode) (not paren-mode))
1259 :active (boundp 'paren-mode)]
1261 (customize-set-variable 'paren-mode 'blink-paren)
1263 :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren))
1264 :active (boundp 'paren-mode)]
1266 (customize-set-variable 'paren-mode 'paren)
1268 :selected (and (boundp 'paren-mode) (eq paren-mode 'paren))
1269 :active (boundp 'paren-mode)]
1271 (customize-set-variable 'paren-mode 'sexp)
1273 :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp))
1274 :active (boundp 'paren-mode)]
1275 ;; ["Nes%_ted Shading"
1276 ;; (customize-set-variable 'paren-mode 'nested)
1278 ;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested))
1279 ;; :active (boundp 'paren-mode)]
1282 ["Edit Fa%_ces..." (customize-face nil)]
1283 ("Fo%_nt" :filter font-menu-family-constructor)
1284 ("Si%_ze" :filter font-menu-size-constructor)
1285 ;; ("Weig%_ht" :filter font-menu-weight-constructor)
1287 ["%_Edit Init (.emacs) File"
1288 ;; #### there should be something that holds the name that the init
1289 ;; file should be created as, when it's not present.
1290 (progn (find-file (or user-init-file "~/.emacs"))
1292 ["%_Save Options to .emacs File" customize-save-customized]
1296 :filter buffers-menu-filter
1297 ["Go To %_Previous Buffer" switch-to-other-buffer]
1298 ["Go To %_Buffer..." switch-to-buffer]
1300 ["%_List All Buffers" list-buffers]
1301 ["%_Delete Buffer" kill-this-buffer
1302 :suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
1306 nil ; the partition: menus after this are flushright
1309 ["%_About XEmacs..." about-xemacs]
1311 ["%_Installation" describe-installation
1312 :active (boundp 'Installation-string)]
1314 ,(if (featurep 'mule)
1316 (let ((lang language-info-alist) (n 0)
1320 (and (setq tut (assq 'tutorial (car lang)))
1321 (not (string= (caar lang) "ASCII"))
1325 `[,(concat (menu-item-generate-accelerator-spec n)
1327 (help-with-tutorial nil ,(cdr tut))]
1329 (setq lang (cdr lang)))
1330 (append `("%_Tutorials"
1331 :filter tutorials-menu-filter
1332 ["%_Default" help-with-tutorial t
1333 ,(concat "(" current-language-environment ")")])
1335 ;; Non mule tutorials.
1336 (let ((lang tutorial-supported-languages)
1343 `[,(concat (menu-item-generate-accelerator-spec n)
1345 (help-with-tutorial ,(format "TUTORIAL.%s"
1346 (cadr (car lang))))]
1348 (setq lang (cdr lang)))
1349 (append '("%_Tutorials"
1350 ["%_English" help-with-tutorial])
1352 ["%_News" view-emacs-news]
1353 ["%_Packages" finder-by-keyword]
1354 ["%_Splash" xemacs-splash-buffer])
1357 ["%_FAQ (local)" xemacs-local-faq]
1358 ["FAQ via %_WWW" xemacs-www-faq (boundp 'browse-url-browser-function)]
1359 ["%_Home Page" xemacs-www-page (boundp 'browse-url-browser-function)])
1361 ["Sample .%_emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")]
1362 ["Sample .%_Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")]
1363 ["Sample e%_nriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")])
1366 ["%_Key Binding..." Info-goto-emacs-key-command-node]
1367 ["%_Command..." Info-goto-emacs-command-node]
1368 ["%_Function..." Info-elisp-ref]
1369 ["%_Topic..." Info-query])
1372 ["%_Unix Manual..." manual-entry])
1373 ("%_Commands & Keys"
1374 ["%_Mode" describe-mode]
1375 ["%_Apropos..." hyper-apropos]
1376 ["Apropos %_Docs..." apropos-documentation]
1378 ["%_Key..." describe-key]
1379 ["%_Bindings" describe-bindings]
1380 ["%_Mouse Bindings" describe-pointer]
1381 ["%_Recent Keys" view-lossage]
1383 ["%_Function..." describe-function]
1384 ["%_Variable..." describe-variable]
1385 ["%_Locate Command..." where-is])
1387 ["%_Recent Messages" view-lossage]
1389 ["%_No Warranty" describe-no-warranty]
1390 ["XEmacs %_License" describe-copying]
1391 ["The Latest %_Version" describe-distribution])
1392 ["%_Send Bug Report..." report-emacs-bug
1393 :active (fboundp 'report-emacs-bug)]))))
1396 (defun maybe-add-init-button ()
1398 Adds `Load .emacs' button to menubar when starting up with -q."
1399 (when (and (not load-user-init-file-p)
1400 (file-exists-p (expand-file-name ".emacs" "~")))
1405 (mapc #'(lambda (buf)
1406 (with-current-buffer buf
1407 (delete-menu-item '("Load .emacs"))))
1409 (load-user-init-file))
1413 (add-hook 'before-init-hook 'maybe-add-init-button)
1418 (defvar put-buffer-names-in-file-menu t)
1421 ;;; The Bookmarks menu
1423 (defun bookmark-menu-filter (&rest ignore)
1424 (let ((definedp (and (boundp 'bookmark-alist)
1428 '("%_Jump to Bookmark"
1429 :filter (lambda (&rest junk)
1430 (mapcar #'(lambda (bmk)
1431 `[,bmk (bookmark-jump ',bmk)])
1432 (bookmark-all-names))))
1433 ["%_Jump to Bookmark" nil nil])
1434 ["Set %_Bookmark" bookmark-set
1435 :active (fboundp 'bookmark-set)]
1437 ["Insert %_Contents" bookmark-menu-insert
1438 :active (fboundp 'bookmark-menu-insert)]
1439 ["Insert L%_ocation" bookmark-menu-locate
1440 :active (fboundp 'bookmark-menu-locate)]
1442 ["%_Rename Bookmark" bookmark-menu-rename
1443 :active (fboundp 'bookmark-menu-rename)]
1445 '("%_Delete Bookmark"
1446 :filter (lambda (&rest junk)
1447 (mapcar #'(lambda (bmk)
1448 `[,bmk (bookmark-delete ',bmk)])
1449 (bookmark-all-names))))
1450 ["%_Delete Bookmark" nil nil])
1451 ["%_Edit Bookmark List" bookmark-bmenu-list ,definedp]
1453 ["%_Save Bookmarks" bookmark-save ,definedp]
1454 ["Save Bookmarks %_As..." bookmark-write ,definedp]
1455 ["%_Load a Bookmark File" bookmark-load
1456 :active (fboundp 'bookmark-load)])))
1458 ;;; The Buffers menu
1460 (defgroup buffers-menu nil
1461 "Customization of `Buffers' menu."
1464 (defvar buffers-menu-omit-chars-list '(?b ?p ?l))
1466 (defcustom buffers-menu-max-size 25
1467 "*Maximum number of entries which may appear on the \"Buffers\" menu.
1468 If this is 10, then only the ten most-recently-selected buffers will be
1469 shown. If this is nil, then all buffers will be shown. Setting this to
1470 a large number or nil will slow down menu responsiveness."
1471 :type '(choice (const :tag "Show all" nil)
1473 :group 'buffers-menu)
1475 (defcustom complex-buffers-menu-p nil
1476 "*If non-nil, the buffers menu will contain several commands.
1477 Commands will be presented as submenus of each buffer line. If this
1478 is false, then there will be only one command: select that buffer."
1480 :group 'buffers-menu)
1482 (defcustom buffers-menu-submenus-for-groups-p nil
1483 "*If non-nil, the buffers menu will contain one submenu per group of buffers.
1484 The grouping function is specified in `buffers-menu-grouping-function'.
1485 If this is an integer, do not build submenus if the number of buffers
1486 is not larger than this value."
1487 :type '(choice (const :tag "No Subgroups" nil)
1488 (integer :tag "Max. submenus" 10)
1489 (sexp :format "%t\n" :tag "Allow Subgroups" :value t))
1490 :group 'buffers-menu)
1492 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
1493 "*The function to call to select a buffer from the buffers menu.
1494 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
1495 :type '(radio (function-item switch-to-buffer)
1496 (function-item pop-to-buffer)
1497 (function :tag "Other"))
1498 :group 'buffers-menu)
1500 (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
1501 "*If non-nil, a function specifying the buffers to omit from the buffers menu.
1502 This is passed a buffer and should return non-nil if the buffer should be
1503 omitted. The default value `buffers-menu-omit-invisible-buffers' omits
1504 buffers that are normally considered \"invisible\" (those whose name
1505 begins with a space)."
1506 :type '(choice (const :tag "None" nil)
1508 :group 'buffers-menu)
1510 (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
1511 "*The function to call to return a string to represent a buffer in
1512 the buffers menu. The function is passed a buffer and a number
1513 (starting with 1) indicating which buffer line in the menu is being
1514 processed and should return a string containing an accelerator
1515 spec. (Check out `menu-item-generate-accelerator-spec' as a convenient
1516 way of generating the accelerator specs.) The default value
1517 `format-buffers-menu-line' just returns the name of the buffer and
1518 uses the number as the accelerator. Also check out
1519 `slow-format-buffers-menu-line' which returns a whole bunch of info
1522 Note: Gross Compatibility Hack: Older versions of this function prototype
1523 only expected one argument, not two. We deal gracefully with such
1524 functions by simply calling them with one argument and leaving out the
1525 line number. However, this may go away at any time, so make sure to
1526 update all of your functions of this type."
1528 :group 'buffers-menu)
1530 (defcustom buffers-menu-sort-function
1531 'sort-buffers-menu-by-mode-then-alphabetically
1532 "*If non-nil, a function to sort the list of buffers in the buffers menu.
1533 It will be passed two arguments (two buffers to compare) and should return
1534 t if the first is \"less\" than the second. One possible value is
1535 `sort-buffers-menu-alphabetically'; another is
1536 `sort-buffers-menu-by-mode-then-alphabetically'."
1537 :type '(choice (const :tag "None" nil)
1539 :group 'buffers-menu)
1541 (defcustom buffers-menu-grouping-function
1542 'group-buffers-menu-by-mode-then-alphabetically
1543 "*If non-nil, a function to group buffers in the buffers menu together.
1544 It will be passed two arguments, successive members of the sorted buffers
1545 list after being passed through `buffers-menu-sort-function'. It should
1546 return non-nil if the second buffer begins a new group. The return value
1547 should be the name of the old group, which may be used in hierarchical
1548 buffers menus. The last invocation of the function contains nil as the
1549 second argument, so that the name of the last group can be determined.
1551 The sensible values of this function are dependent on the value specified
1552 for `buffers-menu-sort-function'."
1553 :type '(choice (const :tag "None" nil)
1555 :group 'buffers-menu)
1557 (defun sort-buffers-menu-alphabetically (buf1 buf2)
1558 "For use as a value of `buffers-menu-sort-function'.
1559 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1560 with a star at the end of the list."
1561 (let* ((nam1 (buffer-name buf1))
1562 (nam2 (buffer-name buf2))
1563 (inv1p (not (null (string-match "\\` " nam1))))
1564 (inv2p (not (null (string-match "\\` " nam2))))
1565 (star1p (not (null (string-match "\\`*" nam1))))
1566 (star2p (not (null (string-match "\\`*" nam2)))))
1567 (cond ((not (eq inv1p inv2p))
1569 ((not (eq star1p star2p))
1572 (string-lessp nam1 nam2)))))
1574 (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1575 "For use as a value of `buffers-menu-sort-function'.
1576 Sorts first by major mode and then alphabetically by name, but puts buffers
1577 beginning with a star at the end of the list."
1578 (let* ((nam1 (buffer-name buf1))
1579 (nam2 (buffer-name buf2))
1580 (inv1p (not (null (string-match "\\` " nam1))))
1581 (inv2p (not (null (string-match "\\` " nam2))))
1582 (star1p (not (null (string-match "\\`*" nam1))))
1583 (star2p (not (null (string-match "\\`*" nam2))))
1584 (mode1 (symbol-value-in-buffer 'major-mode buf1))
1585 (mode2 (symbol-value-in-buffer 'major-mode buf2)))
1586 (cond ((not (eq inv1p inv2p))
1588 ((not (eq star1p star2p))
1590 ((and star1p star2p (string-lessp nam1 nam2)))
1591 ((string-lessp mode1 mode2)
1593 ((string-lessp mode2 mode1)
1596 (string-lessp nam1 nam2)))))
1598 ;; this version is too slow on some machines.
1599 ;; (vintage 1990, that is)
1600 (defun slow-format-buffers-menu-line (buffer n)
1601 "For use as a value of `buffers-menu-format-buffer-line-function'.
1602 This returns a string containing a bunch of info about the buffer."
1603 (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1604 (format "%s%s %-19s %6s %-15s %s"
1605 (if (buffer-modified-p buffer) "*" " ")
1606 (if (symbol-value-in-buffer 'buffer-read-only buffer)
1608 (buffer-name buffer)
1609 (buffer-size buffer)
1610 (symbol-value-in-buffer 'mode-name buffer)
1611 (or (buffer-file-name buffer) ""))))
1613 (defun format-buffers-menu-line (buffer n)
1614 "For use as a value of `buffers-menu-format-buffer-line-function'.
1615 This just returns the buffer's name."
1616 (concat (menu-item-generate-accelerator-spec n buffers-menu-omit-chars-list)
1617 (buffer-name buffer)))
1619 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1620 "For use as a value of `buffers-menu-grouping-function'.
1621 This groups buffers by major mode. It only really makes sense if
1622 `buffers-menu-sorting-function' is
1623 `sort-buffers-menu-by-mode-then-alphabetically'."
1624 (cond ((string-match "\\`*" (buffer-name buf1))
1625 (and (null buf2) "*Misc*"))
1627 (string-match "\\`*" (buffer-name buf2))
1628 (not (eq (symbol-value-in-buffer 'major-mode buf1)
1629 (symbol-value-in-buffer 'major-mode buf2))))
1630 (symbol-value-in-buffer 'mode-name buf1))
1633 (defun buffer-menu-save-buffer (buffer)
1638 (defun buffer-menu-write-file (buffer)
1641 (write-file (read-file-name
1642 (format "Write %s to file: "
1643 (buffer-name (current-buffer)))))))
1645 (defsubst build-buffers-menu-internal (buffers)
1646 (let (name line (n 0))
1653 ; #### a truly Kyle-friendly hack.
1654 (let ((fn buffers-menu-format-buffer-line-function))
1655 (if (= (function-max-args fn) 1)
1657 (funcall fn buffer n))))
1658 (if complex-buffers-menu-p
1661 (vector "S%_witch to Buffer"
1662 (list buffers-menu-switch-to-buffer-function
1663 (setq name (buffer-name buffer)))
1665 (if (eq buffers-menu-switch-to-buffer-function
1667 (vector "Switch to Buffer, Other %_Frame"
1668 (list 'switch-to-buffer-other-frame
1669 (setq name (buffer-name buffer)))
1672 (if (and (buffer-modified-p buffer)
1673 (buffer-file-name buffer))
1674 (vector "%_Save Buffer"
1675 (list 'buffer-menu-save-buffer name) t)
1676 ["%_Save Buffer" nil nil]
1678 (vector "Save %_As..."
1679 (list 'buffer-menu-write-file name) t)
1680 (vector "%_Delete Buffer" (list 'kill-buffer name)
1682 ;; #### We don't want buffer names to be translated,
1683 ;; #### so we put the buffer name in the suffix.
1684 ;; #### Also, avoid losing with non-ASCII buffer names.
1685 ;; #### We still lose, however, if complex-buffers-menu-p. --mrb
1687 (list buffers-menu-switch-to-buffer-function
1688 (buffer-name buffer))
1692 (defun buffers-menu-filter (menu)
1693 "This is the menu filter for the top-level buffers \"Buffers\" menu.
1694 It dynamically creates a list of buffers to use as the contents of the menu.
1695 Only the most-recently-used few buffers will be listed on the menu, for
1696 efficiency reasons. You can control how many buffers will be shown by
1697 setting `buffers-menu-max-size'. You can control the text of the menu
1698 items by redefining the function `format-buffers-menu-line'."
1699 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
1700 (and (integerp buffers-menu-max-size)
1701 (> buffers-menu-max-size 1)
1702 (> (length buffers) buffers-menu-max-size)
1703 ;; shorten list of buffers (not with submenus!)
1704 (not (and buffers-menu-grouping-function
1705 buffers-menu-submenus-for-groups-p))
1706 (setcdr (nthcdr buffers-menu-max-size buffers) nil))
1707 (if buffers-menu-sort-function
1708 (setq buffers (sort buffers buffers-menu-sort-function)))
1709 (if (and buffers-menu-grouping-function
1710 buffers-menu-submenus-for-groups-p
1711 (or (not (integerp buffers-menu-submenus-for-groups-p))
1712 (> (length buffers) buffers-menu-submenus-for-groups-p)))
1713 (let (groups groupnames current-group)
1716 (let ((groupname (funcall buffers-menu-grouping-function
1717 (car sublist) (cadr sublist))))
1718 (setq current-group (cons (car sublist) current-group))
1721 (setq groups (cons (nreverse current-group)
1723 (setq groupnames (cons groupname groupnames))
1724 (setq current-group nil)))))
1728 #'(lambda (groupname group)
1729 (cons groupname (build-buffers-menu-internal group)))
1730 (nreverse groupnames)
1731 (nreverse groups))))
1732 (if buffers-menu-grouping-function
1737 (cond ((funcall buffers-menu-grouping-function
1738 (car sublist) (cadr sublist))
1739 (list (car sublist) t))
1740 (t (list (car sublist)))))
1742 ;; remove a trailing separator.
1743 (and (>= (length buffers) 2)
1744 (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
1745 (if (eq t (cadr lastcdr))
1746 (setcdr lastcdr nil))))))
1747 (setq buffers (build-buffers-menu-internal buffers)))
1748 (append menu buffers)
1751 (defun language-environment-menu-filter (menu)
1752 "This is the menu filter for the \"Language Environment\" submenu."
1754 (mapcar (lambda (env-sym)
1756 `[ ,(concat (menu-item-generate-accelerator-spec n)
1757 (capitalize (symbol-name env-sym)))
1758 (set-language-environment ',env-sym)])
1759 language-environment-list)))
1762 ;;; The Options menu
1764 ;; We'll keep those variables here for a while, in order to provide a
1765 ;; function for porting the old options file that a user may own to Custom.
1767 (defvar options-save-faces nil
1768 "*Non-nil value means save-options will save information about faces.
1769 A nil value means save-options will not save face information.
1770 Set this non-nil only if you use M-x edit-faces to change face
1771 settings. If you use M-x customize-face or the \"Browse Faces...\"
1772 menu entry, you will see a button in the Customize Face buffer that you
1773 can use to permanently save your face changes.
1775 M-x edit-faces is deprecated. Support for it and this variable will
1776 be discontinued in a future release.")
1778 (defvar save-options-init-file nil
1779 "File into which to save forms to load the options file (nil for .emacs).
1780 Normally this is nil, which means save into your .emacs file (the value
1781 of `user-init-file'.")
1783 (defvar save-options-file ".xemacs-options"
1784 "File to save options into.
1785 This file is loaded from your .emacs file.
1786 If this is a relative filename, it is put into the same directory as your
1793 (if (featurep 'mule)
1794 (defun tutorials-menu-filter (menu-items)
1795 ;; If there's a tutorial for the current language environment, make it
1796 ;; appear first as the default one. Otherwise, use the english one.
1797 (let* ((menu menu-items)
1798 (item (pop menu-items)))
1804 (assoc current-language-environment language-info-alist))
1805 current-language-environment
1811 (set-menubar default-menubar)
1816 (defconst default-popup-menu
1818 ["%_Undo" advertised-undo
1819 :active (and (not (eq buffer-undo-list t))
1820 (or buffer-undo-list pending-undo-list))
1821 :suffix (if (or (eq last-command 'undo)
1822 (eq last-command 'advertised-undo))
1824 ["Cu%_t" kill-primary-selection
1825 :active (selection-owner-p)]
1826 ["%_Copy" copy-primary-selection
1827 :active (selection-owner-p)]
1828 ["%_Paste" yank-clipboard-selection
1829 :active (selection-exists-p 'CLIPBOARD)]
1830 ["%_Delete" delete-primary-selection
1831 :active (selection-owner-p)]
1833 ["Select %_Block" mark-paragraph]
1834 ["Sp%_lit Window" split-window-vertically]
1835 ["U%_nsplit Window" delete-other-windows]
1838 (defvar global-popup-menu nil
1839 "The global popup menu. This is present in all modes.
1840 See the function `popup-menu' for a description of menu syntax.")
1842 (defvar mode-popup-menu nil
1843 "The mode-specific popup menu. Automatically buffer local.
1844 This is appended to the default items in `global-popup-menu'.
1845 See the function `popup-menu' for a description of menu syntax.")
1846 (make-variable-buffer-local 'mode-popup-menu)
1848 ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
1849 ;; superseded by any local popup menu...
1850 (setq-default mode-popup-menu default-popup-menu)
1852 (defvar activate-popup-menu-hook nil
1853 "Function or functions run before a mode-specific popup menu is made visible.
1854 These functions are called with no arguments, and should interrogate and
1855 modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
1856 Note: this hook is only run if you use `popup-mode-menu' for activating the
1857 global and mode-specific commands; if you have your own binding for button3,
1858 this hook won't be run.")
1860 (defun popup-mode-menu ()
1861 "Pop up a menu of global and mode-specific commands.
1862 The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
1864 (run-hooks 'activate-popup-menu-hook)
1866 (cond ((and global-popup-menu mode-popup-menu)
1867 ;; Merge global-popup-menu and mode-popup-menu
1868 (check-menu-syntax mode-popup-menu)
1869 (let* ((title (car mode-popup-menu))
1870 (items (cdr mode-popup-menu))
1872 ;; Strip keywords from local menu for attaching them at the top
1874 (keywordp (car items)))
1875 ;; Push both keyword and its argument.
1876 (push (pop items) mode-filters)
1877 (push (pop items) mode-filters))
1878 (setq mode-filters (nreverse mode-filters))
1879 ;; If mode-filters contains a keyword already present in
1880 ;; `global-popup-menu', you will probably lose.
1881 (append (list (car global-popup-menu))
1883 (cdr global-popup-menu)
1885 (if popup-menu-titles (list title))
1886 (if popup-menu-titles '("---" "---"))
1891 (error "No menu defined in this buffer"))))))
1893 (defun popup-buffer-menu (event)
1894 "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
1896 (let ((window (and (event-over-text-area-p event) (event-window event)))
1899 (error "Pointer must be in a normal window"))
1900 (select-window window)
1902 (setq bmenu (assoc "%_Buffers" current-menubar)))
1904 (setq bmenu (assoc "%_Buffers" default-menubar)))
1906 (error "Can't find the Buffers menu"))
1907 (popup-menu bmenu)))
1909 (defun popup-menubar-menu (event)
1910 "Pop up a copy of menu that also appears in the menubar"
1911 ;; by Stig@hackvan.com
1913 (let ((window (and (event-over-text-area-p event) (event-window event)))
1916 (error "Pointer must be in a normal window"))
1917 (select-window window)
1918 (and current-menubar (run-hooks 'activate-menubar-hook))
1919 ;; #### Instead of having to copy this just to safely get rid of
1920 ;; any nil what we should really do is fix up the internal menubar
1921 ;; code to just ignore nil if generating a popup menu
1922 (setq popup-menubar (delete nil (copy-sequence (or current-menubar
1924 (popup-menu (cons "%_Menubar Menu" popup-menubar))
1927 (global-set-key 'button3 'popup-mode-menu)
1928 ;; shift button3 and shift button2 are reserved for Hyperbole
1929 (global-set-key '(meta control button3) 'popup-buffer-menu)
1930 ;; The following command is way too dangerous with Custom.
1931 ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
1933 ;; Here's a test of the cool new menu features (from Stig).
1935 ;;(setq mode-popup-menu
1936 ;; '("Test Popup Menu"
1938 ;; ["this item won't appear because of the menu filter" ding t]
1943 ;; "--:singleDashedLine"
1944 ;; "singleDashedLine"
1945 ;; "--:doubleDashedLine"
1946 ;; "doubleDashedLine"
1949 ;; "--:shadowEtchedIn"
1951 ;; "--:shadowEtchedOut"
1952 ;; "shadowEtchedOut"
1953 ;; "--:shadowDoubleEtchedIn"
1954 ;; "shadowDoubleEtchedIn"
1955 ;; "--:shadowDoubleEtchedOut"
1956 ;; "shadowDoubleEtchedOut"
1957 ;; "--:shadowEtchedInDash"
1958 ;; "shadowEtchedInDash"
1959 ;; "--:shadowEtchedOutDash"
1960 ;; "shadowEtchedOutDash"
1961 ;; "--:shadowDoubleEtchedInDash"
1962 ;; "shadowDoubleEtchedInDash"
1963 ;; "--:shadowDoubleEtchedOutDash"
1964 ;; "shadowDoubleEtchedOutDash"
1967 (defun xemacs-splash-buffer ()
1968 "Redisplay XEmacs splash screen in a buffer."
1970 (let ((buffer (get-buffer-create "*Splash*"))
1973 (setq buffer-read-only t)
1974 (erase-buffer buffer)
1975 (setq tmout (display-splash-frame))
1977 (make-local-hook 'kill-buffer-hook)
1978 (add-hook 'kill-buffer-hook
1980 (disable-timeout ,tmout))
1982 (pop-to-buffer buffer)
1983 (delete-other-windows)))
1986 ;;; backwards compatibility
1987 (provide 'x-menubar)
1988 (provide 'menubar-items)
1990 ;;; menubar-items.el ends here.