[COMMIT] Move #'normalize-menu-text to Lisp, given calls on non-menubar builds

APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1530774769 -3600 # Thu Jul 05 08:12:49 2018 +0100 # Node ID 79bef0ac9919c5b37620c5dc80a75d1a8bf64b00 # Parent 518dac37640275f3d01a24e41d1ac1880e47be9c Move #'normalize-menu-text to Lisp, given calls on non-menubar builds lisp/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; * map-ynp.el (normalize-menu-text): Add an autoload for this function, now it's available in Lisp when C menubar support isn't available. * menubar.el (normalize-menu-text): Implement this function, moved from C. src/ChangeLog addition: 2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; * menubar.c: * menubar.c (vars_of_menubar): Move #'normalize-menu-text to Lisp, it's not called much and the occasional use of the function in builds without C menubar support is much more practical with it in Lisp. diff -r 518dac376402 -r 79bef0ac9919 lisp/ChangeLog --- a/lisp/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,11 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * map-ynp.el (normalize-menu-text): Add an autoload for this + function, now it's available in Lisp when C menubar support isn't + available. + * menubar.el (normalize-menu-text): Implement this function, moved + from C. + 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net&gt; * loadup.el (source-lisp): diff -r 518dac376402 -r 79bef0ac9919 lisp/map-ynp.el --- a/lisp/map-ynp.el Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/map-ynp.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -36,6 +36,10 ＠＠ ;;; Code: +;; We use normalize-menu-text even if the menubar files aren't dumped. Make +;; sure XEmacs knows where to find it: +(autoload 'normalize-menu-text "menubar") + (defun map-y-or-n-p (prompter actor list &optional help action-alist no-cursor-in-echo-area) "Ask a series of boolean questions. diff -r 518dac376402 -r 79bef0ac9919 lisp/menubar.el --- a/lisp/menubar.el Wed Jul 04 18:35:31 2018 +0100 +++ b/lisp/menubar.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -164,6 +164,38 ＠＠  ;;; basic menu manipulation functions +(defun normalize-menu-text (name) + "Convert NAME, a menu string, into menu normal form. + +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. + +See `compare-menu-text', which does this comparison without creating new +strings, and so is free in terms of garbage-collection." + (let (stream (position 0) (last 0) (length (length name))) + (while (setq position (position ?% name :start position)) + (incf position) + (when (< position length) + (cond + ((eql ?% (aref name position)) + (write-sequence name (or stream + (setq stream (make-string-output-stream))) + :start last :end position) + (setq last (1+ position) + position last)) + ((eql ?_ (aref name position)) + (write-sequence name (or stream + (setq stream (make-string-output-stream))) + :start last :end (1- position)) + (setq last (1+ position) + position last)) + (t (incf position))))) + (if (not stream) + name + (write-sequence name stream :start last) + (get-output-stream-string stream)))) + (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, ＠＠ -885,7 +917,4 ＠＠ (define-key menu-accelerator-map [kp-enter] 'menu-select) (define-key menu-accelerator-map "\C-g" 'menu-quit))) - -(provide 'menubar) - ;;; menubar.el ends here diff -r 518dac376402 -r 79bef0ac9919 src/ChangeLog --- a/src/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/src/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,11 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * menubar.c: + * menubar.c (vars_of_menubar): + Move #'normalize-menu-text to Lisp, it's not called much and the + occasional use of the function in builds without C menubar support + is much more practical with it in Lisp. + 2018-07-04 Aidan Kehoe <kehoea(a)parhasard.net&gt; * eval.c (Fdefmacro): diff -r 518dac376402 -r 79bef0ac9919 src/menubar.c --- a/src/menubar.c Wed Jul 04 18:35:31 2018 +0100 +++ b/src/menubar.c Thu Jul 05 08:12:49 2018 +0100 ＠＠ -41,6 +41,7 ＠＠ #include "specifier.h" #include "window-impl.h" #include "lstream.h" +#include "text.h" int menubar_show_keybindings; Lisp_Object Vmenubar_configuration; ＠＠ -362,94 +363,6 ＠＠ } } -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)) -{ - const Ibyte *name_data, *pend, *lastp; - Lisp_Object stream = Qnil; - - CHECK_STRING (name); - - name_data = lastp = XSTRING_DATA (name); - pend = name_data + XSTRING_LENGTH (name); - - while (name_data < pend) - { - name_data = (const Ibyte *) memchr (name_data, '%', pend - name_data); - - if (!name_data) - { - break; - } - - name_data += ichar_len ('%'); - - if (name_data >= pend) - { - break; - } - - if (itext_ichar_eql (name_data, '%')) - { - /* Allow `%%' to mean `%'. */ - if (NILP (stream)) - { - /* Writing to this cannot GC. */ - stream = make_resizing_buffer_output_stream (); - } - - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), - name_data - lastp); - - name_data += ichar_len ('%'); - lastp = name_data; - } - else if (itext_ichar_eql (name_data, '_')) - { - if (NILP (stream)) - { - stream = make_resizing_buffer_output_stream (); - } - - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), - name_data - lastp - - ichar_len ('%')); - - name_data += ichar_len ('_'); - lastp = name_data; - } - else - { - INC_IBYTEPTR (name_data); - INC_IBYTEPTR (name_data); - /* No need to modify LASTP. */ - } - } - - if (NILP (stream)) - { - /* No %_ or %% encountered. */ - return name; - } - - if (lastp < pend) - { - Lstream_write_with_extents (XLSTREAM (stream), name, - lastp - XSTRING_DATA (name), pend - lastp); - } - - name = resizing_buffer_to_lisp_string (XLSTREAM (stream)); - Lstream_delete (XLSTREAM (stream)); - return name; -} - void syms_of_menubar (void) { ＠＠ -468,7 +381,6 ＠＠ DEFSUBR (Fpopup_menu); DEFSUBR (Fcompare_menu_text); - DEFSUBR (Fnormalize_menu_text); DEFSUBR (Fmenu_find_real_submenu); } diff -r 518dac376402 -r 79bef0ac9919 tests/ChangeLog --- a/tests/ChangeLog Wed Jul 04 18:35:31 2018 +0100 +++ b/tests/ChangeLog Thu Jul 05 08:12:49 2018 +0100 ＠＠ -1,3 +1,9 ＠＠ +2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/extent-tests.el: + #'normalize-menu-text is now available even on builds without the + menubar feature, test it even then. + 2018-06-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/format-tests.el: diff -r 518dac376402 -r 79bef0ac9919 tests/automated/extent-tests.el --- a/tests/automated/extent-tests.el Wed Jul 04 18:35:31 2018 +0100 +++ b/tests/automated/extent-tests.el Thu Jul 05 08:12:49 2018 +0100 ＠＠ -674,23 +674,22 ＠＠ "ME\xc4\xb0NE"))) (set-language-environment env)))) - (when (featurep 'menubar) - (Assert - (equal - "So bist du meine Tochter nimmer% mehr!" - (setf normalize - (normalize-menu-text - (mapconcat #'identity - (sublis '(("du" . "d%_u") ("nimmer" . "nimmer%%")) - split :test #'equal) - " "))))) - (Assert (extentp - (setf pE - (car (extent-list normalize nil nil nil property-name)))) - "checking extent copied, \"Tochter\", normalize-menu-text") - (Assert (extentp - (setf pEE - (car (extent-list normalize nil nil nil 'count)))) - "checking extent copied, \"mehr!\""))) + (Assert + (equal + "So bist du meine Tochter nimmer% mehr!" + (setf normalize + (normalize-menu-text + (mapconcat #'identity + (sublis '(("du" . "d%_u") ("nimmer" . "nimmer%%")) + split :test #'equal) + " "))))) + (Assert (extentp + (setf pE + (car (extent-list normalize nil nil nil property-name)))) + "checking extent copied, \"Tochter\", normalize-menu-text") + (Assert (extentp + (setf pEE + (car (extent-list normalize nil nil nil 'count)))) + "checking extent copied, \"mehr!\"")) ;;; end of extent-tests.el -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)