User: ben
Date: 05/02/03 06:03:47
Modified: xemacs/src ChangeLog menubar.c
Log:
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.
Revision Changes Path
1.622 +54 -49 XEmacs/xemacs/lisp/ChangeLog
(In the diff below, changes in quantity of whitespace are not shown.)
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.621
retrieving revision 1.622
diff -u -b -r1.621 -r1.622
--- ChangeLog 2005/02/03 04:29:32 1.621
+++ ChangeLog 2005/02/03 05:03:36 1.622
@@ -1,5 +1,59 @@
2005-02-02 Ben Wing <ben(a)xemacs.org>
+ * easymenu.el (easy-menu-add):
+ * easymenu.el (easy-menu-remove):
+ * map-ynp.el (map-y-or-n-p):
+ Use normalize-menu-text not normalize-menu-item-name.
+
+ * menubar-items.el (submenu-generate-accelerator-spec): Removed.
+ * menubar.el (submenu-generate-accelerator-spec): New.
+ Move to menubar.el and rewrite for cleanliness.
+
+ * menubar-items.el (coding-system-menu-filter):
+ Use menu-split-long-menu-and-sort.
+
+ * menubar-items.el (menu-item-strip-accelerator-spec): Removed.
+ * menubar-items.el (menu-item-generate-accelerator-spec): Removed.
+ * menubar-items.el (menu-max-items): Removed.
+ * menubar-items.el (menu-submenu-max-items): Removed.
+ * menubar-items.el (menu-submenu-name-format): Removed.
+ * menubar-items.el (menu-split-long-menu): Removed.
+ * menubar-items.el (menu-sort-menu): Removed.
+ * menubar.el (menu-item-strip-accelerator-spec): New.
+ * menubar.el (menu-item-generate-accelerator-spec): New.
+ * menubar.el (menu-max-items): New.
+ * menubar.el (menu-submenu-max-items): New.
+ * menubar.el (menu-submenu-name-format): New.
+ * menubar.el (menu-split-long-menu): New.
+ * menubar.el (menu-sort-menu): New.
+ Move to menubar.el.
+
+ * menubar.el (menu-item-text): New.
+ * menubar.el (menu-split-long-menu-and-sort): New.
+ New funs.
+
+ * menubar.el (find-menu-item):
+ * menubar.el (find-menu-item-1): New.
+ 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 (add-menu-item-1):
+ Don't normalize items as find-menu-item does not need it.
+
+ * menubar-items.el (default-menubar):
+ 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.
+
+2005-02-02 Ben Wing <ben(a)xemacs.org>
+
* cus-dep.el (Custom-make-dependencies-1):
If a directory has no custom dependencies, write a blank
custom-load file rather than deleting the file, so that
@@ -182,55 +236,6 @@
* behavior.el (behavior-menu-filter-1): New.
* behavior.el (behavior-menu-filter): New.
Major update. Add documentation of how it works.
-
- * easymenu.el (easy-menu-add):
- * easymenu.el (easy-menu-remove):
- * map-ynp.el (map-y-or-n-p):
- Use normalize-menu-text not normalize-menu-item-name.
-
- * menubar-items.el (submenu-generate-accelerator-spec): Removed.
- * menubar.el (submenu-generate-accelerator-spec): New.
- Move to menubar.el and rewrite for cleanliness.
-
- * menubar-items.el (coding-system-menu-filter):
- Use menu-split-long-menu-and-sort.
-
- * menubar-items.el (menu-item-strip-accelerator-spec): Removed.
- * menubar-items.el (menu-item-generate-accelerator-spec): Removed.
- * menubar-items.el (menu-max-items): Removed.
- * menubar-items.el (menu-submenu-max-items): Removed.
- * menubar-items.el (menu-submenu-name-format): Removed.
- * menubar-items.el (menu-split-long-menu): Removed.
- * menubar-items.el (menu-sort-menu): Removed.
- * menubar.el (menu-item-strip-accelerator-spec): New.
- * menubar.el (menu-item-generate-accelerator-spec): New.
- * menubar.el (menu-max-items): New.
- * menubar.el (menu-submenu-max-items): New.
- * menubar.el (menu-submenu-name-format): New.
- * menubar.el (menu-split-long-menu): New.
- * menubar.el (menu-sort-menu): New.
- Move to menubar.el.
-
- * menubar.el (menu-item-text): New.
- * menubar.el (menu-split-long-menu-and-sort): New.
- New funs.
-
- * menubar-items.el (default-menubar):
- Delete many menus from Tools menu -- they have been integrated
- as part of the behavior system.
-
- Delete old Behavior menu defn. Use behavior-menu-filter.
-
- Use menu-split-long-menu-and-sort.
-
- * menubar.el (find-menu-item):
- * menubar.el (find-menu-item-1): New.
- 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 (add-menu-item-1):
- Don't normalize items as find-menu-item does not need it.
* mwheel.el:
* mwheel.el ('mwheel): New.
1.11 +164 -15 XEmacs/xemacs/lisp/menubar.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: menubar.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/menubar.el,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- menubar.el 2001/12/20 05:49:31 1.10
+++ menubar.el 2005/02/03 05:03:37 1.11
@@ -2,7 +2,7 @@
;; Copyright (C) 1991-4, 1997-1998 Free Software Foundation, Inc.
;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1995, 1996 Ben Wing.
+;; Copyright (C) 1995, 1996, 2003 Ben Wing.
;; Maintainer: XEmacs Development Team
;; Keywords: internal, extensions, dumped
@@ -163,17 +163,27 @@
(setq menu (cdr menu)))))
-;;; menu manipulation functions
+;;; basic menu manipulation functions
-(defun find-menu-item (menubar item-path-list &optional parent)
- "Search MENUBAR for item given by ITEM-PATH-LIST starting from PARENT.
+(defun menu-item-text (item &optional normalize)
+ "Return the text that is displayed for a menu item.
+If ITEM is a string (unselectable text), it is returned; otherwise,
+the first element of the cons or vector is returned.
+If NORMALIZE is non-nil, pass the text through `normalize-menu-text'
+before being returned, to remove accelerator specs and convert %% to %."
+ (let ((val (if (stringp item) item (elt item 0))))
+ (if normalize (normalize-menu-text val) val)))
+
+(defun find-menu-item (menubar item-path-list)
+ "Search MENUBAR for item given by ITEM-PATH-LIST.
Returns (ITEM . PARENT), where PARENT is the immediate parent of
the item found.
If the item does not exist, the car of the returned value is nil.
If some menu in the ITEM-PATH-LIST does not exist, an error is signalled."
+ (find-menu-item-1 menubar item-path-list))
+
+(defun find-menu-item-1 (menubar item-path-list &optional parent)
(check-argument-type 'listp item-path-list)
- (unless parent
- (setq item-path-list (mapcar 'normalize-menu-item-name item-path-list)))
(if (not (consp menubar))
nil
(let ((rest menubar)
@@ -184,14 +194,9 @@
(setq rest (cddr rest)))
(while rest
(if (and (car rest)
- (equal (car item-path-list)
- (normalize-menu-item-name
- (cond ((vectorp (car rest))
- (aref (car rest) 0))
- ((stringp (car rest))
- (car rest))
- (t
- (caar rest))))))
+ (stringp (car item-path-list))
+ (= 0 (compare-menu-text (car item-path-list)
+ (menu-item-text (car rest)))))
(setq result (car rest)
rest nil)
(setq rest (cdr rest))))
@@ -208,7 +213,6 @@
(defun add-menu-item-1 (leaf-p menu-path new-item before in-menu)
;; This code looks like it could be cleaned up some more
;; Do we really need 6 calls to find-menu-item?
- (when before (setq before (normalize-menu-item-name before)))
(let* ((item-name
(cond ((vectorp new-item) (aref new-item 0))
((consp new-item) (car new-item))
@@ -463,6 +467,151 @@
menu item called \"Item\" under the \"Foo\" submenu of
\"Menu\"."
(enable-menu-item-1 path t nil))
+
+;;; functions for manipulating whole menus -- adding accelerators, sorting,
+;;; splitting long menus, etc.
+
+(defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
+ "Add auto-generated accelerator specifications to a submenu.
+This can be used to add accelerators to the return value of a menu filter
+function. It correctly ignores unselectable items. It will destructively
+modify the list passed to it. If an item already has an auto-generated
+accelerator spec, this will be removed before the new one is added, making
+this function idempotent.
+
+If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
+which will not be used as accelerators."
+ (let ((n 0))
+ (dolist (item list list)
+ (cond
+ ((or (vectorp item) (consp item))
+ (incf n)
+ (setf (elt item 0)
+ (concat
+ (menu-item-generate-accelerator-spec n omit-chars-list)
+ (menu-item-strip-accelerator-spec (elt item 0)))))))))
+
+(defun menu-item-strip-accelerator-spec (item)
+ "Strip an auto-generated accelerator spec off of ITEM.
+ITEM should be a string. This removes specs added by
+`menu-item-generate-accelerator-spec' and
`submenu-generate-accelerator-spec'."
+ (if (string-match "%_. " item)
+ (substring item 4)
+ item))
+
+(defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
+ "Return an accelerator specification for use with auto-generated menus.
+This should be concat'd onto the beginning of each menu line. The spec
+allows the Nth line to be selected by the number N. '0' is used for the
+10th line, and 'a' through 'z' are used for the following 26 lines.
+
+If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
+which will not be used as accelerators."
+ (cond ((< n 10) (concat "%_" (int-to-string n) " "))
+ ((= n 10) "%_0 ")
+ ((<= n 36)
+ (setq n (- n 10))
+ (let ((m 0))
+ (while (> n 0)
+ (setq m (1+ m))
+ (while (memq (int-to-char (+ m (- (char-to-int ?a) 1)))
+ omit-chars-list)
+ (setq m (1+ m)))
+ (setq n (1- n)))
+ (if (<= m 26)
+ (concat
+ "%_"
+ (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1))))
+ " ")
+ "")))
+ (t "")))
+
+(defcustom menu-max-items 25
+ "*Maximum number of items in generated menus.
+If number of entries in such a menu is larger than this value, split menu
+into submenus of nearly equal length (see `menu-submenu-max-items'). If
+nil, never split menu into submenus."
+ :group 'menu
+ :type '(choice (const :tag "no submenus" nil)
+ (integer)))
+
+(defcustom menu-submenu-max-items 20
+ "*Maximum number of items in submenus when splitting menus.
+We split large menus into submenus of this many items, and then balance
+them out as much as possible (otherwise the last submenu may have very few
+items)."
+ :group 'menu
+ :type 'integer)
+
+(defcustom menu-submenu-name-format "%-12.12s ... %.12s"
+ "*Format specification of the submenu name when splitting menus.
+Used by `menu-split-long-menu' if the number of entries in a menu is
+larger than `menu-menu-max-items'.
+This string should contain one %s for the name of the first entry and
+one %s for the name of the last entry in the submenu.
+If the value is a function, it should return the submenu name. The
+function is be called with two arguments, the names of the first and
+the last entry in the menu."
+ :group 'menu
+ :type '(choice (string :tag "Format string")
+ (function)))
+
+(defun menu-split-long-menu-and-sort (menu)
+ "Sort MENU, split according to `menu-max-items' and add accelerator specs.
+This is useful for menus generated by filter functions, to make them look
+nice. This is equivalent to
+
+\(menu-split-long-menu (menu-sort-menu menu))
+
+and you can call those functions individually if necessary.
+You can also call `submenu-generate-accelerator-spec' yourself to add
+accelerator specs -- this works even if the specs have already been added."
+ (menu-split-long-menu (menu-sort-menu menu)))
+
+(defun menu-split-long-menu (menu)
+ "Split MENU according to `menu-max-items' and add accelerator specs.
+If MENU already has accelerator specs, they will be removed and new ones
+generated. You should normally use `menu-split-long-menu-and-sort' instead.
+The menu should already be sorted to get meaningful results when it is
+split, since the outer menus are of the format `FROM ... TO'."
+ (let ((len (length menu)))
+ (if (or (null menu-max-items)
+ (<= len menu-max-items))
+ (submenu-generate-accelerator-spec menu)
+ (let* ((outer (/ (+ len (1- menu-submenu-max-items))
+ menu-submenu-max-items))
+ (inner (/ (+ len (1- outer)) outer))
+ (result nil))
+ (while menu
+ (let ((sub nil)
+ (from (car menu)))
+ (dotimes (foo (min inner len))
+ (setq sub (cons (car menu) sub)
+ menu (cdr menu)))
+ (setq len (- len inner))
+ (let* ((to (car sub))
+ (ftext (menu-item-strip-accelerator-spec
+ (menu-item-text from)))
+ (ttext (menu-item-strip-accelerator-spec
+ (menu-item-text to))))
+ (setq sub (nreverse sub))
+ (setq result
+ (cons (cons (if (stringp menu-submenu-name-format)
+ (format menu-submenu-name-format
+ ftext ttext)
+ (funcall menu-submenu-name-format
+ ftext ttext))
+ (submenu-generate-accelerator-spec sub))
+ result)))))
+ (submenu-generate-accelerator-spec (nreverse result))))))
+
+(defun menu-sort-menu (menu)
+ "Sort MENU alphabetically.
+You should normally use `menu-split-long-menu-and-sort' instead."
+ (sort menu
+ #'(lambda (a b) (< (compare-menu-text
+ (menu-item-text a) (menu-item-text b))
+ 0))))
;;;;;;; popup menus
1.46 +53 -203 XEmacs/xemacs/lisp/menubar-items.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: menubar-items.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/menubar-items.el,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -b -r1.45 -r1.46
--- menubar-items.el 2005/01/26 04:56:18 1.45
+++ menubar-items.el 2005/02/03 05:03:38 1.46
@@ -67,149 +67,7 @@
list
(butlast list (- (length list) count)))))
-(defun submenu-generate-accelerator-spec (list &optional omit-chars-list)
- "Add auto-generated accelerator specifications to a submenu.
-This can be used to add accelerators to the return value of a menu filter
-function. It correctly ignores unselectable items. It will destructively
-modify the list passed to it. If an item already has an auto-generated
-accelerator spec, this will be removed before the new one is added, making
-this function idempotent.
-If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
-which will not be used as accelerators."
- (let ((n 0))
- (dolist (item list list)
- (cond
- ((vectorp item)
- (setq n (1+ n))
- (aset item 0
- (concat
- (menu-item-generate-accelerator-spec n omit-chars-list)
- (menu-item-strip-accelerator-spec (aref item 0)))))
- ((consp item)
- (setq n (1+ n))
- (setcar item
- (concat
- (menu-item-generate-accelerator-spec n omit-chars-list)
- (menu-item-strip-accelerator-spec (car item)))))))))
-
-(defun menu-item-strip-accelerator-spec (item)
- "Strip an auto-generated accelerator spec off of ITEM.
-ITEM should be a string. This removes specs added by
-`menu-item-generate-accelerator-spec' and
`submenu-generate-accelerator-spec'."
- (if (string-match "%_. " item)
- (substring item 4)
- item))
-
-(defun menu-item-generate-accelerator-spec (n &optional omit-chars-list)
- "Return an accelerator specification for use with auto-generated menus.
-This should be concat'd onto the beginning of each menu line. The spec
-allows the Nth line to be selected by the number N. '0' is used for the
-10th line, and 'a' through 'z' are used for the following 26 lines.
-
-If OMIT-CHARS-LIST is given, it should be a list of lowercase characters,
-which will not be used as accelerators."
- (cond ((< n 10) (concat "%_" (int-to-string n) " "))
- ((= n 10) "%_0 ")
- ((<= n 36)
- (setq n (- n 10))
- (let ((m 0))
- (while (> n 0)
- (setq m (1+ m))
- (while (memq (int-to-char (+ m (- (char-to-int ?a) 1)))
- omit-chars-list)
- (setq m (1+ m)))
- (setq n (1- n)))
- (if (<= m 26)
- (concat
- "%_"
- (char-to-string (int-to-char (+ m (- (char-to-int ?a) 1))))
- " ")
- "")))
- (t "")))
-
-(defcustom menu-max-items 25
- "*Maximum number of items in generated menus.
-If number of entries in such a menu is larger than this value, split menu
-into submenus of nearly equal length (see `menu-submenu-max-items'). If
-nil, never split menu into submenus."
- :group 'menu
- :type '(choice (const :tag "no submenus" nil)
- (integer)))
-
-(defcustom menu-submenu-max-items 20
- "*Maximum number of items in submenus when splitting menus.
-We split large menus into submenus of this many items, and then balance
-them out as much as possible (otherwise the last submenu may have very few
-items)."
- :group 'menu
- :type 'integer)
-
-(defcustom menu-submenu-name-format "%-12.12s ... %.12s"
- "*Format specification of the submenu name when splitting menus.
-Used by `menu-split-long-menu' if the number of entries in a menu is
-larger than `menu-menu-max-items'.
-This string should contain one %s for the name of the first entry and
-one %s for the name of the last entry in the submenu.
-If the value is a function, it should return the submenu name. The
-function is be called with two arguments, the names of the first and
-the last entry in the menu."
- :group 'menu
- :type '(choice (string :tag "Format string")
- (function)))
-
-(defun menu-split-long-menu (menu)
- "Split MENU according to `menu-max-items' and add accelerator specs.
-
-You should normally use the idiom
-
-\(menu-split-long-menu (menu-sort-menu menu))
-
-See also `menu-sort-menu'."
- (let ((len (length menu)))
- (if (or (null menu-max-items)
- (<= len menu-max-items))
- (submenu-generate-accelerator-spec menu)
- (let* ((outer (/ (+ len (1- menu-submenu-max-items))
- menu-submenu-max-items))
- (inner (/ (+ len (1- outer)) outer))
- (result nil))
- (while menu
- (let ((sub nil)
- (from (car menu)))
- (dotimes (foo (min inner len))
- (setq sub (cons (car menu) sub)
- menu (cdr menu)))
- (setq len (- len inner))
- (let ((to (car sub)))
- (setq sub (nreverse sub))
- (setq result
- (cons (cons (if (stringp menu-submenu-name-format)
- (format menu-submenu-name-format
- (menu-item-strip-accelerator-spec
- (aref from 0))
- (menu-item-strip-accelerator-spec
- (aref to 0)))
- (funcall menu-submenu-name-format
- (menu-item-strip-accelerator-spec
- (aref from 0))
- (menu-item-strip-accelerator-spec
- (aref to 0))))
- (submenu-generate-accelerator-spec sub))
- result)))))
- (submenu-generate-accelerator-spec (nreverse result))))))
-
-(defun menu-sort-menu (menu)
- "Sort MENU alphabetically.
-
-You should normally use the idiom
-
-\(menu-split-long-menu (menu-sort-menu menu))
-
-See also `menu-split-long-menu'."
- (sort menu
- #'(lambda (a b) (string-lessp (aref a 0) (aref b 0)))))
-
(defun coding-system-menu-filter (fun active &optional dots)
"Filter for menu entries with a submenu listing all coding systems.
This is for operations that take a coding system as an argument. FUN
@@ -225,8 +83,7 @@
(lambda (entry) ...)
(lambda (entry) ...))
"
- (menu-split-long-menu
- (menu-sort-menu
+ (menu-split-long-menu-and-sort
(mapcar
#'(lambda (_csmf_entry)
`[ ,(concat (coding-system-description _csmf_entry)
@@ -239,7 +96,7 @@
(or (coding-system-alias-p name)
(not (eq name (coding-system-name
(coding-system-base name))))))
- (coding-system-list))))))
+ (coding-system-list)))))
(defconst default-menubar
; (purecopy-menubar ;purespace is dead
@@ -422,7 +279,6 @@
)
)
-
("C%_mds"
["Repeat Last Comple%_x Command..." repeat-complex-command]
["E%_valuate Lisp Expression..." eval-expression]
@@ -555,16 +411,26 @@
["Edit Ta%_b Stops" edit-tab-stops]
)
"---"
- ("Spell-Chec%_k"
- ["%_Buffer" ispell-buffer
- :active (fboundp 'ispell-buffer)]
- "---"
- ["%_Word" ispell-word]
- ["%_Complete Word" ispell-complete-word]
- ["%_Region" ispell-region]
+ ("%_Tags"
+ ["%_Find Tag..." find-tag]
+ ["Find %_Other Window..." find-tag-other-window]
+ ["%_Next Tag..." (find-tag nil)]
+ ["N%_ext Other Window..." (find-tag-other-window nil)]
+ ["Next %_File" next-file]
+ "-----"
+ ["Tags %_Search..." tags-search]
+ ["Tags %_Replace..." tags-query-replace]
+ ["%_Continue Search/Replace" tags-loop-continue]
+ "-----"
+ ["%_Pop stack" pop-tag-mark]
+ ["%_Apropos..." tags-apropos]
+ "-----"
+ ["%_Set Tags Table File..." visit-tags-table]
)
)
+ ;; #### Delete this entire menu as soon as the new package source is
+ ;; committed.
("%_Tools"
("%_Packages"
("%_Set Download Site"
@@ -816,24 +682,10 @@
"----"
)
- ("%_Options"
- ("%_Behaviors"
- :filter
- (lambda (menu)
- (menu-split-long-menu
- (menu-sort-menu
- (loop for behavior being the hash-keys in behavior-hash-table
- using (hash-value plist)
- collect (vector (format "%s (%s)" behavior
- (getf plist :short-doc))
- `(if (memq ',behavior enabled-behavior-list)
- (disable-behavior ',behavior)
- (enable-behavior ',behavior))
- :style 'toggle
- :selected `(memq ',behavior
- enabled-behavior-list))
- )))))
+; ("%_Tools"
+; :filter behavior-menu-filter)
+ ("%_Options"
("%_Advanced (Customize)"
("%_Emacs" :filter (lambda (&rest junk)
(cdr (custom-menu-create 'emacs))))
@@ -1142,8 +994,7 @@
("Set %_Language Environment"
:filter
(lambda (menu)
- (menu-split-long-menu
- (menu-sort-menu
+ (menu-split-long-menu-and-sort
(mapcar #'(lambda (entry)
`[ ,(car entry)
(set-language-environment ',(car entry))
@@ -1152,7 +1003,7 @@
,(equal (car entry)
current-language-environment)])
language-info-alist)
- ))))
+ )))
["%_Toggle Input Method" toggle-input-method]
["Select %_Input Method" set-input-method]
)))
@@ -1681,8 +1532,7 @@
("Describe %_Language Support"
:filter
(lambda (menu)
- (menu-split-long-menu
- (menu-sort-menu
+ (menu-split-long-menu-and-sort
(mapcar #'(lambda (entry)
`[ ,(car entry)
(describe-language-environment
@@ -1692,7 +1542,7 @@
,(equal (car entry)
current-language-environment)])
language-info-alist)
- ))))
+ )))
["Describe %_Input Method" describe-input-method]
["Describe Current %_Coding Systems"
describe-current-coding-system]
1.7 +2 -2 XEmacs/xemacs/lisp/easymenu.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: easymenu.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/easymenu.el,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- easymenu.el 2001/05/04 22:42:01 1.6
+++ easymenu.el 2005/02/03 05:03:38 1.7
@@ -181,7 +181,7 @@
(reverse easy-menu-all-popups))
(let ((same-as-menu
(car easy-menu-all-popups)))
- (cons (normalize-menu-item-name
+ (cons (normalize-menu-text
(car same-as-menu))
(cdr same-as-menu)))))
@@ -208,7 +208,7 @@
(reverse easy-menu-all-popups))
(let ((same-as-menu
(car easy-menu-all-popups)))
- (cons (normalize-menu-item-name
+ (cons (normalize-menu-text
(car same-as-menu))
(cdr same-as-menu)))))
1.4 +3 -2 XEmacs/xemacs/lisp/map-ynp.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: map-ynp.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/map-ynp.el,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- map-ynp.el 2001/04/12 18:21:30 1.3
+++ map-ynp.el 2005/02/03 05:03:38 1.4
@@ -231,8 +231,9 @@
(lambda (elt)
(format "%c to %s"
(nth 0 elt)
- (normalize-menu-item-name
- (nth 2 elt)))))
+ (downcase
+ (normalize-menu-text
+ (nth 2 elt))))))
action-alist
";\n")
(if action-alist ";\n")
1.783 +53 -0 XEmacs/xemacs/src/ChangeLog
(In the diff below, changes in quantity of whitespace are not shown.)
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.782
retrieving revision 1.783
diff -u -b -r1.782 -r1.783
--- ChangeLog 2005/01/31 19:29:47 1.782
+++ ChangeLog 2005/02/03 05:03:43 1.783
@@ -1,3 +1,56 @@
+2005-02-02 Ben Wing <ben(a)xemacs.org>
+
+ * menubar.c:
+ * menubar.c (Fcompare_menu_text):
+ New fun to compare menu itext as if the two were normalized.
+
+ * menubar.c (Fnormalize_menu_text):
+ * menubar.c (syms_of_menubar):
+ 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.
+
+2005-02-02 Ben Wing <ben(a)xemacs.org>
+
+ * lread.c:
+ * lread.c (check_if_suppressed):
+ * lread.c (Fload_internal):
+ * lread.c (locate_file_in_directory_mapper):
+ * lread.c (readevalloop):
+ * lread.c (syms_of_lread):
+ * lread.c (vars_of_lread):
+ * menubar.c:
+ * menubar.c (Fcompare_menu_text):
+ * menubar.c (Fnormalize_menu_text):
+ * menubar.c (syms_of_menubar):
+ * menubar.c (vars_of_menubar):
+
+2004-11-09 Ben Wing <ben(a)xemacs.org>
+
+ * lisp.h:
+
+ * lread.c:
+ * lread.c (check_if_suppressed):
+ * lread.c (Fload_internal):
+ * lread.c (locate_file_in_directory_mapper):
+ * lread.c (readevalloop):
+ * lread.c (syms_of_lread):
+ * lread.c (vars_of_lread):
+ Remove undeeded Vload_file_name_internal_the_purecopy,
+ Qload_file_name -- use internal_bind_lisp_object instead of
+ specbind.
+
+ Add load-suppress-alist.
+
+2003-02-15 Ben Wing <ben(a)xemacs.org>
+
+ * syswindows.h: Define W32API_2_2 for w32api.h v2.2 or higher.
+ Use it when defining a missing structure that is present in this
+ version of w32api.h.
+ * event-msw.c (mswindows_wnd_proc): Conditionalize bug fix on
+ !W32API_2_2.
+
2005-01-31 Ben Wing <ben(a)xemacs.org>
* emacs.c:
1.29 +43 -6 XEmacs/xemacs/src/menubar.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: menubar.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/menubar.c,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -b -r1.28 -r1.29
--- menubar.c 2004/11/04 23:06:41 1.28
+++ menubar.c 2005/02/03 05:03:45 1.29
@@ -1,7 +1,7 @@
/* Implements an elisp-programmable menubar.
Copyright (C) 1993, 1994 Free Software Foundation, Inc.
Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
- Copyright (C) 2001, 2002 Ben Wing.
+ Copyright (C) 2001, 2002, 2003 Ben Wing.
This file is part of XEmacs.
@@ -326,14 +326,51 @@
return Qnil;
}
-DEFUN ("normalize-menu-item-name", Fnormalize_menu_item_name, 1, 2, 0, /*
+DEFUN ("compare-menu-text", Fcompare_menu_text, 2, 2, 0, /*
+Compare the text of two menu items, ignoring accelerator specs and case.
+Also treat %% as a single %. Return < 0 if STRING1 is less than STRING2,
+0 if equal, > 0 if STRING1 is greater than STRING2.
+*/
+ (string1, string2))
+{
+ Ibyte *p;
+ Ibyte *q;
+
+ CHECK_STRING (string1);
+ CHECK_STRING (string2);
+
+ p = XSTRING_DATA (string1);
+ q = XSTRING_DATA (string2);
+
+ for (;;)
+ {
+ Ichar val;
+ if (*p == '%' && *(p + 1) == '%')
+ p++;
+ else if (*p == '%' && *(p + 1) == '_')
+ p += 2;
+ if (*q == '%' && *(q + 1) == '%')
+ q++;
+ else if (*q == '%' && *(q + 1) == '_')
+ q += 2;
+ if (!*p || !*q)
+ return make_int (*p - *q);
+ val = DOWNCASE (0, itext_ichar (p)) - DOWNCASE (0, itext_ichar (q));
+ if (val)
+ return make_int (val);
+ INC_IBYTEPTR (p);
+ INC_IBYTEPTR (q);
+ }
+}
+
+DEFUN ("normalize-menu-text", Fnormalize_menu_text, 1, 1, 0, /*
Convert a menu item name string into normal form, and return the new string.
Menu item names should be converted to normal form before being compared.
This removes %_'s (accelerator indications) and converts %% to %.
+The returned string may be the same string as the original.
*/
- (name, buffer))
+ (name))
{
- struct buffer *buf = decode_buffer (buffer, 0);
Charcount end;
int i;
Ibyte *name_data;
@@ -352,7 +389,6 @@
for (i = 0; i < end; i++)
{
elt = itext_ichar (name_data);
- elt = DOWNCASE (buf, elt);
if (expecting_underscore)
{
expecting_underscore = 0;
@@ -400,7 +436,8 @@
DEFSYMBOL (Qmenu_escape);
DEFSUBR (Fpopup_menu);
- DEFSUBR (Fnormalize_menu_item_name);
+ DEFSUBR (Fcompare_menu_text);
+ DEFSUBR (Fnormalize_menu_text);
DEFSUBR (Fmenu_find_real_submenu);
}