Mercurial > hg > xemacs-beta

comparison lisp/menubar-items.el @ 2545:9caf26dd924f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-02-03 05:03:36 by ben] behavior ws #2: menu-related changes menubar.c: New fun to compare menu itext as if the two were normalized. menubar.c: Rename; there are no external callers of this function. Remove unneeded BUFFER argument. Don't downcase. (This will be done in compare-menu-text.) Document that return value may be same string. easymenu.el, map-ynp.el: Use normalize-menu-text not normalize-menu-item-name. menubar-items.el, menubar.el: Move to menubar.el and rewrite for cleanliness. menubar-items.el: Use menu-split-long-menu-and-sort. menubar-items.el, menubar.el: Move to menubar.el. menubar.el: New funs. menubar.el: Split up find-menu-item w/find-menu-item-1, since PARENT is not an external item. Rewrite to use compare-menu-text. menubar.el: Don't normalize items as find-menu-item does not need it. menubar-items.el: Delete old Behavior menu defn, replaced by behavior-menu-filter. Planning to [[Delete many menus from Tools menu -- they have been integrated as part of the behavior system.]] Currently the new Tools menu (very short, just a call to the behavior-menu-filter) is commented out, and the old Toold menu defn remains. Once the new packages are in place (c. 1 or 2 weeks), I'll make the switchover. Use menu-split-long-menu-and-sort.
author ben
date Thu, 03 Feb 2005 05:03:45 +0000
parents 3e5a2d0d57e1
children feeb145e30f4
comparison
equal deleted inserted replaced
2544:b4a8cd0dd8df 2545:9caf26dd924f
65 (concat "..." (substring x (- label-length))) x))) 65 (concat "..." (substring x (- label-length))) x)))
66 (if (<= (length list) count) 66 (if (<= (length list) count)
67 list 67 list
68 (butlast list (- (length list) count))))) 68 (butlast list (- (length list) count)))))
69 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 (defcustom menu-max-items 25
132 "*Maximum number of items in generated menus.
133 If number of entries in such a menu is larger than this value, split menu
134 into submenus of nearly equal length (see `menu-submenu-max-items'). If
135 nil, never split menu into submenus."
136 :group 'menu
137 :type '(choice (const :tag "no submenus" nil)
138 (integer)))
139
140 (defcustom menu-submenu-max-items 20
141 "*Maximum number of items in submenus when splitting menus.
142 We split large menus into submenus of this many items, and then balance
143 them out as much as possible (otherwise the last submenu may have very few
144 items)."
145 :group 'menu
146 :type 'integer)
147
148 (defcustom menu-submenu-name-format "%-12.12s ... %.12s"
149 "*Format specification of the submenu name when splitting menus.
150 Used by `menu-split-long-menu' if the number of entries in a menu is
151 larger than `menu-menu-max-items'.
152 This string should contain one %s for the name of the first entry and
153 one %s for the name of the last entry in the submenu.
154 If the value is a function, it should return the submenu name. The
155 function is be called with two arguments, the names of the first and
156 the last entry in the menu."
157 :group 'menu
158 :type '(choice (string :tag "Format string")
159 (function)))
160
161 (defun menu-split-long-menu (menu)
162 "Split MENU according to `menu-max-items' and add accelerator specs.
163
164 You should normally use the idiom
165
166 \(menu-split-long-menu (menu-sort-menu menu))
167
168 See also `menu-sort-menu'."
169 (let ((len (length menu)))
170 (if (or (null menu-max-items)
171 (<= len menu-max-items))
172 (submenu-generate-accelerator-spec menu)
173 (let* ((outer (/ (+ len (1- menu-submenu-max-items))
174 menu-submenu-max-items))
175 (inner (/ (+ len (1- outer)) outer))
176 (result nil))
177 (while menu
178 (let ((sub nil)
179 (from (car menu)))
180 (dotimes (foo (min inner len))
181 (setq sub (cons (car menu) sub)
182 menu (cdr menu)))
183 (setq len (- len inner))
184 (let ((to (car sub)))
185 (setq sub (nreverse sub))
186 (setq result
187 (cons (cons (if (stringp menu-submenu-name-format)
188 (format menu-submenu-name-format
189 (menu-item-strip-accelerator-spec
190 (aref from 0))
191 (menu-item-strip-accelerator-spec
192 (aref to 0)))
193 (funcall menu-submenu-name-format
194 (menu-item-strip-accelerator-spec
195 (aref from 0))
196 (menu-item-strip-accelerator-spec
197 (aref to 0))))
198 (submenu-generate-accelerator-spec sub))
199 result)))))
200 (submenu-generate-accelerator-spec (nreverse result))))))
201
202 (defun menu-sort-menu (menu)
203 "Sort MENU alphabetically.
204
205 You should normally use the idiom
206
207 \(menu-split-long-menu (menu-sort-menu menu))
208
209 See also `menu-split-long-menu'."
210 (sort menu
211 #'(lambda (a b) (string-lessp (aref a 0) (aref b 0)))))
212 70
213 (defun coding-system-menu-filter (fun active &optional dots) 71 (defun coding-system-menu-filter (fun active &optional dots)
214 "Filter for menu entries with a submenu listing all coding systems. 72 "Filter for menu entries with a submenu listing all coding systems.
215 This is for operations that take a coding system as an argument. FUN 73 This is for operations that take a coding system as an argument. FUN
216 should be a function of one argument, which will be a coding system symbol. 74 should be a function of one argument, which will be a coding system symbol.
223 :filter 81 :filter
224 (lambda (menu) 82 (lambda (menu)
225 (lambda (entry) ...) 83 (lambda (entry) ...)
226 (lambda (entry) ...)) 84 (lambda (entry) ...))
227 " 85 "
228 (menu-split-long-menu 86 (menu-split-long-menu-and-sort
229 (menu-sort-menu 87 (mapcar
230 (mapcar 88 #'(lambda (_csmf_entry)
231 #'(lambda (_csmf_entry) 89 `[ ,(concat (coding-system-description _csmf_entry)
232 `[ ,(concat (coding-system-description _csmf_entry) 90 (if dots "..." ""))
233 (if dots "..." "")) 91 (funcall ,fun ',_csmf_entry)
234 (funcall ,fun ',_csmf_entry) 92 :active (funcall ,active ',_csmf_entry)
235 :active (funcall ,active ',_csmf_entry) 93 ])
236 ]) 94 (delete-if
237 (delete-if 95 #'(lambda (name)
238 #'(lambda (name) 96 (or (coding-system-alias-p name)
239 (or (coding-system-alias-p name) 97 (not (eq name (coding-system-name
240 (not (eq name (coding-system-name 98 (coding-system-base name))))))
241 (coding-system-base name)))))) 99 (coding-system-list)))))
242 (coding-system-list))))))
243 100
244 (defconst default-menubar 101 (defconst default-menubar
245 ; (purecopy-menubar ;purespace is dead 102 ; (purecopy-menubar ;purespace is dead
246 ;; note backquote. 103 ;; note backquote.
247 `( 104 `(
420 ["%_Load a Bookmark File" bookmark-load 277 ["%_Load a Bookmark File" bookmark-load
421 :active (fboundp 'bookmark-load)] 278 :active (fboundp 'bookmark-load)]
422 ) 279 )
423 ) 280 )
424 281
425
426 ("C%_mds" 282 ("C%_mds"
427 ["Repeat Last Comple%_x Command..." repeat-complex-command] 283 ["Repeat Last Comple%_x Command..." repeat-complex-command]
428 ["E%_valuate Lisp Expression..." eval-expression] 284 ["E%_valuate Lisp Expression..." eval-expression]
429 ["Execute %_Named Command..." execute-extended-command] 285 ["Execute %_Named Command..." execute-extended-command]
430 "----" 286 "----"
552 ["%_Tabify (Spaces to Tabs)" tabify :active (and (region-exists-p) 408 ["%_Tabify (Spaces to Tabs)" tabify :active (and (region-exists-p)
553 (fboundp 'tabify))] 409 (fboundp 'tabify))]
554 ["Tab to Tab %_Stop" tab-to-tab-stop] 410 ["Tab to Tab %_Stop" tab-to-tab-stop]
555 ["Edit Ta%_b Stops" edit-tab-stops] 411 ["Edit Ta%_b Stops" edit-tab-stops]
556 ) 412 )
557 "---" 413 "---"
558 ("Spell-Chec%_k" 414 ("%_Tags"
559 ["%_Buffer" ispell-buffer 415 ["%_Find Tag..." find-tag]
560 :active (fboundp 'ispell-buffer)] 416 ["Find %_Other Window..." find-tag-other-window]
561 "---" 417 ["%_Next Tag..." (find-tag nil)]
562 ["%_Word" ispell-word] 418 ["N%_ext Other Window..." (find-tag-other-window nil)]
563 ["%_Complete Word" ispell-complete-word] 419 ["Next %_File" next-file]
564 ["%_Region" ispell-region] 420 "-----"
421 ["Tags %_Search..." tags-search]
422 ["Tags %_Replace..." tags-query-replace]
423 ["%_Continue Search/Replace" tags-loop-continue]
424 "-----"
425 ["%_Pop stack" pop-tag-mark]
426 ["%_Apropos..." tags-apropos]
427 "-----"
428 ["%_Set Tags Table File..." visit-tags-table]
565 ) 429 )
566 ) 430 )
567 431
432 ;; #### Delete this entire menu as soon as the new package source is
433 ;; committed.
568 ("%_Tools" 434 ("%_Tools"
569 ("%_Packages" 435 ("%_Packages"
570 ("%_Set Download Site" 436 ("%_Set Download Site"
571 ("%_Official Releases" 437 ("%_Official Releases"
572 :filter (lambda (&rest junk) 438 :filter (lambda (&rest junk)
814 :active (fboundp 'mpuz)]) 680 :active (fboundp 'mpuz)])
815 681
816 "----" 682 "----"
817 ) 683 )
818 684
685 ; ("%_Tools"
686 ; :filter behavior-menu-filter)
687
819 ("%_Options" 688 ("%_Options"
820 ("%_Behaviors"
821 :filter
822 (lambda (menu)
823 (menu-split-long-menu
824 (menu-sort-menu
825 (loop for behavior being the hash-keys in behavior-hash-table
826 using (hash-value plist)
827 collect (vector (format "%s (%s)" behavior
828 (getf plist :short-doc))
829 `(if (memq ',behavior enabled-behavior-list)
830 (disable-behavior ',behavior)
831 (enable-behavior ',behavior))
832 :style 'toggle
833 :selected `(memq ',behavior
834 enabled-behavior-list))
835 )))))
836
837 ("%_Advanced (Customize)" 689 ("%_Advanced (Customize)"
838 ("%_Emacs" :filter (lambda (&rest junk) 690 ("%_Emacs" :filter (lambda (&rest junk)
839 (cdr (custom-menu-create 'emacs)))) 691 (cdr (custom-menu-create 'emacs))))
840 ["%_Group..." customize-group] 692 ["%_Group..." customize-group]
841 ["%_Variable..." customize-variable] 693 ["%_Variable..." customize-variable]
1140 ,@(when (featurep 'mule) 992 ,@(when (featurep 'mule)
1141 '(("Internationa%_l" 993 '(("Internationa%_l"
1142 ("Set %_Language Environment" 994 ("Set %_Language Environment"
1143 :filter 995 :filter
1144 (lambda (menu) 996 (lambda (menu)
1145 (menu-split-long-menu 997 (menu-split-long-menu-and-sort
1146 (menu-sort-menu 998 (mapcar #'(lambda (entry)
1147 (mapcar #'(lambda (entry) 999 `[ ,(car entry)
1148 `[ ,(car entry) 1000 (set-language-environment ',(car entry))
1149 (set-language-environment ',(car entry)) 1001 :style radio
1150 :style radio 1002 :selected
1151 :selected 1003 ,(equal (car entry)
1152 ,(equal (car entry) 1004 current-language-environment)])
1153 current-language-environment)]) 1005 language-info-alist)
1154 language-info-alist) 1006 )))
1155 ))))
1156 ["%_Toggle Input Method" toggle-input-method] 1007 ["%_Toggle Input Method" toggle-input-method]
1157 ["Select %_Input Method" set-input-method] 1008 ["Select %_Input Method" set-input-method]
1158 ))) 1009 )))
1159 "-----" 1010 "-----"
1160 ("%_Display" 1011 ("%_Display"
1679 ,@(when (featurep 'mule) 1530 ,@(when (featurep 'mule)
1680 '(("Internationa%_l" 1531 '(("Internationa%_l"
1681 ("Describe %_Language Support" 1532 ("Describe %_Language Support"
1682 :filter 1533 :filter
1683 (lambda (menu) 1534 (lambda (menu)
1684 (menu-split-long-menu 1535 (menu-split-long-menu-and-sort
1685 (menu-sort-menu 1536 (mapcar #'(lambda (entry)
1686 (mapcar #'(lambda (entry) 1537 `[ ,(car entry)
1687 `[ ,(car entry) 1538 (describe-language-environment
1688 (describe-language-environment 1539 ',(car entry))
1689 ',(car entry))
1690 :style radio 1540 :style radio
1691 :selected 1541 :selected
1692 ,(equal (car entry) 1542 ,(equal (car entry)
1693 current-language-environment)]) 1543 current-language-environment)])
1694 language-info-alist) 1544 language-info-alist)
1695 )))) 1545 )))
1696 ["Describe %_Input Method" describe-input-method] 1546 ["Describe %_Input Method" describe-input-method]
1697 ["Describe Current %_Coding Systems" 1547 ["Describe Current %_Coding Systems"
1698 describe-current-coding-system] 1548 describe-current-coding-system]
1699 ["Show Character %_Table" view-charset-by-menu] 1549 ["Show Character %_Table" view-charset-by-menu]
1700 ;; not implemented yet 1550 ;; not implemented yet