Mercurial > hg > xemacs-beta

comparison lisp/x11/x-menubar.el @ 74:54cc21c15cbb r20-0b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children c0c698873ce1
comparison
equal deleted inserted replaced
73:e2d7a37b7c8d 74:54cc21c15cbb
542 ["XEmacs WWW Page" xemacs-www-page t] 542 ["XEmacs WWW Page" xemacs-www-page t]
543 ["Newest XEmacs FAQ via WWW" xemacs-www-faq t] 543 ["Newest XEmacs FAQ via WWW" xemacs-www-faq t]
544 ["XEmacs FAQ (local)" xemacs-local-faq t] 544 ["XEmacs FAQ (local)" xemacs-local-faq t]
545 ["XEmacs Tutorial" help-with-tutorial t] 545 ["XEmacs Tutorial" help-with-tutorial t]
546 ["XEmacs News" view-emacs-news t] 546 ["XEmacs News" view-emacs-news t]
547 ["Sample" 547 ["Sample" (find-file
548 (find-file (expand-file-name "sample.emacs" data-directory)) 548 (expand-file-name "sample.emacs"
549 data-directory))
549 t ".emacs"] 550 t ".emacs"]
550 ["Sample" 551 ["Sample" (find-file
551 (find-file (expand-file-name "sample.Xdefaults" data-directory)) 552 (expand-file-name "sample.Xdefaults"
553 data-directory))
552 t ".Xdefaults"] 554 t ".Xdefaults"]
553 "-----" 555 "-----"
554 ["Info (Detailed Docs)" info t] 556 ["Info (Detailed Docs)" info t]
555 ("Lookup in Info" 557 ("Lookup in Info"
556 ["Key/Mouse Binding..." Info-goto-emacs-key-command-node t] 558 ["Key/Mouse Binding..." Info-goto-emacs-key-command-node t]
726 of each buffer line. If this is false, then there will be only one command: 728 of each buffer line. If this is false, then there will be only one command:
727 select that buffer.") 729 select that buffer.")
728 730
729 (defvar buffers-menu-submenus-for-groups-p nil 731 (defvar buffers-menu-submenus-for-groups-p nil
730 "*If true, the buffers menu will contain one submenu per group of buffers, 732 "*If true, the buffers menu will contain one submenu per group of buffers,
731 if a grouping function is specified in `buffers-menu-grouping-function'.") 733 if a grouping function is specified in `buffers-menu-grouping-function'.
734 If this is an integer, do not build submenus if the number of buffers
735 is not larger than this value.")
732 736
733 (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer 737 (defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer
734 "*The function to call to select a buffer from the buffers menu. 738 "*The function to call to select a buffer from the buffers menu.
735 `switch-to-buffer' is a good choice, as is `pop-to-buffer'.") 739 `switch-to-buffer' is a good choice, as is `pop-to-buffer'.")
736 740
846 (buffer-name (current-buffer))))))) 850 (buffer-name (current-buffer)))))))
847 851
848 (defsubst build-buffers-menu-internal (buffers) 852 (defsubst build-buffers-menu-internal (buffers)
849 (let (name line) 853 (let (name line)
850 (mapcar 854 (mapcar
851 (lambda (buffer) 855 #'(lambda (buffer)
852 (if (eq buffer t) 856 (if (eq buffer t)
853 "---" 857 "---"
854 (setq line (funcall buffers-menu-format-buffer-line-function 858 (setq line (funcall buffers-menu-format-buffer-line-function
855 buffer)) 859 buffer))
856 (if complex-buffers-menu-p 860 (if complex-buffers-menu-p
857 (delq nil 861 (delq nil
858 (list line 862 (list line
859 (vector "Switch to Buffer" 863 (vector "Switch to Buffer"
860 (list buffers-menu-switch-to-buffer-function 864 (list buffers-menu-switch-to-buffer-function
861 (setq name (buffer-name buffer))) 865 (setq name (buffer-name buffer)))
862 t) 866 t)
863 (if (eq buffers-menu-switch-to-buffer-function 867 (if (eq buffers-menu-switch-to-buffer-function
864 'switch-to-buffer) 868 'switch-to-buffer)
865 (vector "Switch to Buffer, Other Frame" 869 (vector "Switch to Buffer, Other Frame"
866 (list 'switch-to-buffer-other-frame 870 (list 'switch-to-buffer-other-frame
867 (setq name (buffer-name buffer))) 871 (setq name (buffer-name buffer)))
868 t) 872 t)
869 nil) 873 nil)
870 (if (and (buffer-modified-p buffer) 874 (if (and (buffer-modified-p buffer)
871 (buffer-file-name buffer)) 875 (buffer-file-name buffer))
872 (vector "Save Buffer" 876 (vector "Save Buffer"
873 (list 'buffer-menu-save-buffer name) t) 877 (list 'buffer-menu-save-buffer name) t)
874 ["Save Buffer" nil nil] 878 ["Save Buffer" nil nil]
875 ) 879 )
876 (vector "Save As..." 880 (vector "Save As..."
877 (list 'buffer-menu-write-file name) t) 881 (list 'buffer-menu-write-file name) t)
878 (vector "Delete Buffer" (list 'kill-buffer name) 882 (vector "Delete Buffer" (list 'kill-buffer name)
879 t))) 883 t)))
880 ;; ### We don't want buffer names to be translated, 884 ;; ### We don't want buffer names to be translated,
881 ;; ### so we put the buffer name in the suffix. 885 ;; ### so we put the buffer name in the suffix.
882 ;; ### Also, avoid losing with non-ASCII buffer names. 886 ;; ### Also, avoid losing with non-ASCII buffer names.
883 ;; ### We still lose, however, if complex-buffers-menu-p. --mrb 887 ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
884 (vector "" 888 (vector ""
885 (list buffers-menu-switch-to-buffer-function 889 (list buffers-menu-switch-to-buffer-function
886 (buffer-name buffer)) 890 (buffer-name buffer))
887 t line)))) 891 t line))))
888 buffers))) 892 buffers)))
889 893
890 (defun buffers-menu-filter (menu) 894 (defun buffers-menu-filter (menu)
891 "This is the menu filter for the top-level buffers \"Buffers\" menu. 895 "This is the menu filter for the top-level buffers \"Buffers\" menu.
892 It dynamically creates a list of buffers to use as the contents of the menu. 896 It dynamically creates a list of buffers to use as the contents of the menu.
896 items by redefining the function `format-buffers-menu-line'." 900 items by redefining the function `format-buffers-menu-line'."
897 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list)))) 901 (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
898 (and (integerp buffers-menu-max-size) 902 (and (integerp buffers-menu-max-size)
899 (> buffers-menu-max-size 1) 903 (> buffers-menu-max-size 1)
900 (> (length buffers) buffers-menu-max-size) 904 (> (length buffers) buffers-menu-max-size)
901 ;; shorten list of buffers 905 ;; shorten list of buffers (not with submenus!)
906 (not (and buffers-menu-grouping-function
907 buffers-menu-submenus-for-groups-p))
902 (setcdr (nthcdr buffers-menu-max-size buffers) nil)) 908 (setcdr (nthcdr buffers-menu-max-size buffers) nil))
903 (if buffers-menu-sort-function 909 (if buffers-menu-sort-function
904 (setq buffers (sort buffers buffers-menu-sort-function))) 910 (setq buffers (sort buffers buffers-menu-sort-function)))
905 (if (and buffers-menu-grouping-function 911 (if (and buffers-menu-grouping-function
906 buffers-menu-submenus-for-groups-p) 912 buffers-menu-submenus-for-groups-p
913 (or (not (integerp buffers-menu-submenus-for-groups-p))
914 (> (length buffers) buffers-menu-submenus-for-groups-p)))
907 (let (groups groupnames current-group) 915 (let (groups groupnames current-group)
908 (mapl 916 (mapl
909 #'(lambda (sublist) 917 #'(lambda (sublist)
910 (let ((groupname (funcall buffers-menu-grouping-function 918 (let ((groupname (funcall buffers-menu-grouping-function
911 (car sublist) (cadr sublist)))) 919 (car sublist) (cadr sublist))))
1088 (face-property face property)) 1096 (face-property face property))
1089 `(add-spec-list-to-specifier 1097 `(add-spec-list-to-specifier
1090 (face-property ',face ',property) 1098 (face-property ',face ',property)
1091 ',(save-options-specifier-spec-list 1099 ',(save-options-specifier-spec-list
1092 face property)))) 1100 face property))))
1093 built-in-face-specifiers))) 1101 (delq 'display-table
1102 (copy-sequence
1103 built-in-face-specifiers)))))
1094 (face-list)))) 1104 (face-list))))
1095 1105
1096 ;; Mule-specific: 1106 ;; Mule-specific:
1097 (if (featurep 'mule) 1107 (if (featurep 'mule)
1098 `(if (featurep 'mule) 1108 `(if (featurep 'mule)