comparison lisp/menubar-items.el @ 5882:bbe4146603db

Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp lisp/ChangeLog addition: 2015-04-01 Aidan Kehoe <kehoea@parhasard.net> When calling #'string-match with a REGEXP without regular expression special characters, call #'search, #'mismatch, #'find, etc. instead, making our code less likely to side-effect other functions' match data and a little faster. * apropos.el (apropos-command): * apropos.el (apropos): Call (position ?\n ...) rather than (string-match "\n" ...) here. * buff-menu.el: * buff-menu.el (buffers-menu-omit-invisible-buffers): Don't fire up the regexp engine just to check if a string starts with a space. * buff-menu.el (select-buffers-tab-buffers-by-mode): Don't fire up the regexp engine just to compare mode basenames. * buff-menu.el (format-buffers-tab-line): * buff-menu.el (build-buffers-tab-internal): Moved to being a label within the following. * buff-menu.el (buffers-tab-items): Use the label. * bytecomp.el (byte-compile-log-1): Don't fire up the regexp engine just to look for a newline. * cus-edit.el (get): Ditto. * cus-edit.el (custom-variable-value-create): Ditto, but for a colon. * descr-text.el (describe-text-sexp): Ditto. * descr-text.el (describe-char-unicode-data): Use #'split-string-by-char given that we're just looking for a semicolon. * descr-text.el (describe-char): Don't fire up the regexp engine just to look for a newline. * disass.el (disassemble-internal): Ditto. * files.el (file-name-sans-extension): Implement this using #'position. * files.el (file-name-extension): Correct this function's docstring, implement it in terms of #'position. * files.el (insert-directory): Don't fire up the regexp engine to split a string by space; don't reverse the list of switches, this is actually a longstand bug as far as I can see. * gnuserv.el (gnuserv-process-filter): Use #'position here, instead of consing inside #'split-string needlessly. * gtk-file-dialog.el (gtk-file-dialog-update-dropdown): Use #'split-string-by-char here, don't fire up #'split-string for directory-sep-char. * gtk-font-menu.el (hack-font-truename): Implement this more cheaply in terms of #'find, #'split-string-by-char, #'equal, rather than #'string-match, #'split-string, #'string-equal. * hyper-apropos.el (hyper-apropos-grok-functions): * hyper-apropos.el (hyper-apropos-grok-variables): Look for a newline using #'position rather than #'string-match in these functions. * info.el (Info-insert-dir): * info.el (Info-insert-file-contents): * info.el (Info-follow-reference): * info.el (Info-extract-menu-node-name): * info.el (Info-menu): Look for fixed strings using #'position or #'search as appropriate in this file. * ldap.el (ldap-decode-string): * ldap.el (ldap-encode-string): #'encode-coding-string, #'decode-coding-string are always available, don't check if they're fboundp. * ldap.el (ldap-decode-address): * ldap.el (ldap-encode-address): Use #'split-string-by-char in these functions. * lisp-mnt.el (lm-creation-date): * lisp-mnt.el (lm-last-modified-date): Don't fire up the regexp engine just to look for spaces in this file. * menubar-items.el (default-menubar): Use (not (mismatch ...)) rather than #'string-match here, for simple regexp. Use (search "beta" ...) rather than (string-match "beta" ...) * menubar-items.el (sort-buffers-menu-alphabetically): * menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically): * menubar-items.el (group-buffers-menu-by-mode-then-alphabetically): Don't fire up the regexp engine to check if a string starts with a space or an asterisk. Use the more fine-grained results of #'compare-strings; compare case-insensitively for the buffer menu. * menubar-items.el (list-all-buffers): * menubar-items.el (tutorials-menu-filter): Use #'equal rather than #'string-equal, which, in this context, has the drawback of not having a bytecode, and no redeeming features. * minibuf.el: * minibuf.el (un-substitute-in-file-name): Use #'count, rather than counting the occurences of $ using the regexp engine. * minibuf.el (read-file-name-internal-1): Don't fire up the regexp engine to search for ?=. * mouse.el (mouse-eval-sexp): Check for newline with #'find. * msw-font-menu.el (mswindows-reset-device-font-menus): Split a string by newline with #'split-string-by-char. * mule/japanese.el: * mule/japanese.el ("Japanese"): Use #'search rather than #'string-match; canoncase before comparing; fix a bug I had introduced where I had been making case insensitive comparisons where the case mattered. * mule/korea-util.el (default-korean-keyboard): Look for ?3 using #'find, not #'string-march. * mule/korea-util.el (quail-hangul-switch-hanja): Search for a fixed string using #'search. * mule/mule-cmds.el (set-locale-for-language-environment): #'position, #'substitute rather than #'string-match, #'replace-in-string. * newcomment.el (comment-make-extra-lines): Use #'search rather than #'string-match for a simple string. * package-get.el (package-get-remote-filename): Use #'position when looking for ?@ * process.el (setenv): * process.el (read-envvar-name): Use #'position when looking for ?=. * replace.el (map-query-replace-regexp): Use #'split-string-by-char instead of using an inline implementation of it. * select.el (select-convert-from-cf-text): * select.el (select-convert-from-cf-unicodetext): Use #'position rather than #'string-match in these functions. * setup-paths.el (paths-emacs-data-root-p): Use #'search when looking for simple string. * sound.el (load-sound-file): Use #'split-string-by-char rather than an inline reimplementation of same. * startup.el (splash-screen-window-body): * startup.el (splash-screen-tty-body): Search for simple strings using #'search. * version.el (emacs-version): Ditto. * x-font-menu.el (hack-font-truename): Implement this more cheaply in terms of #'find, #'split-string-by-char, #'equal, rather than #'string-match, #'split-string, #'string-equal. * x-font-menu.el (x-reset-device-font-menus-core): Use #'split-string-by-char here. * x-init.el (x-initialize-keyboard): Search for a simple string using #'search.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 01 Apr 2015 14:28:20 +0100
parents 40fbceabaafd
children
comparison
equal deleted inserted replaced
5881:31dd275fa683 5882:bbe4146603db
1437 ["Edit Fa%_ces..." (customize-face nil)] 1437 ["Edit Fa%_ces..." (customize-face nil)]
1438 "-----" 1438 "-----"
1439 ["Edit I%_nit File" 1439 ["Edit I%_nit File"
1440 ;; #### there should be something that holds the name that the init 1440 ;; #### there should be something that holds the name that the init
1441 ;; file should be created as, when it's not present. 1441 ;; file should be created as, when it's not present.
1442 (let ((el-file (or user-init-file "~/.xemacs/init.el")) 1442 (let* ((el-file (or user-init-file "~/.xemacs/init.el"))
1443 el-file-directory) 1443 (position (position ?. el-file :from-end t))
1444 (if (string-match "\\.elc$" el-file) 1444 el-file-directory)
1445 (if (not (mismatch el-file ".elc"
1446 :start1 (or position (length el-file))))
1445 (setq el-file 1447 (setq el-file
1446 (substring user-init-file 0 (1- (length el-file))))) 1448 (subseq user-init-file 0 -1)))
1447 (unless (file-directory-p 1449 (unless (file-directory-p
1448 (setq el-file-directory (file-name-directory el-file))) 1450 (setq el-file-directory (file-name-directory el-file)))
1449 (message "Creating %s... " el-file-directory) 1451 (message "Creating %s... " el-file-directory)
1450 (make-directory el-file-directory t) 1452 (make-directory el-file-directory t)
1451 (message "Creating %s... done." el-file-directory)) 1453 (message "Creating %s... done." el-file-directory))
1477 ["%_Obtaining the Latest Version" describe-distribution] 1479 ["%_Obtaining the Latest Version" describe-distribution]
1478 ["View %_Splash Screen" xemacs-splash-buffer] 1480 ["View %_Splash Screen" xemacs-splash-buffer]
1479 ["%_Home Page (www.xemacs.org)" xemacs-www-page 1481 ["%_Home Page (www.xemacs.org)" xemacs-www-page
1480 :active (fboundp 'browse-url)]) 1482 :active (fboundp 'browse-url)])
1481 ["B%_eta Info" describe-beta 1483 ["B%_eta Info" describe-beta
1482 :included (string-match "beta" emacs-version)] 1484 :included (search "beta" emacs-version)]
1483 "-----" 1485 "-----"
1484 ("%_Info (Online Docs)" 1486 ("%_Info (Online Docs)"
1485 ["%_Info Contents" (Info-goto-node "(dir)")] 1487 ["%_Info Contents" (Info-goto-node "(dir)")]
1486 ["%_How to Use Info" (Info-goto-node "(Info)")] 1488 ["%_How to Use Info" (Info-goto-node "(Info)")]
1487 "-----" 1489 "-----"
1709 "For use as a value of `buffers-menu-sort-function'. 1711 "For use as a value of `buffers-menu-sort-function'.
1710 Sorts the buffers in alphabetical order by name, but puts buffers beginning 1712 Sorts the buffers in alphabetical order by name, but puts buffers beginning
1711 with a star at the end of the list." 1713 with a star at the end of the list."
1712 (let* ((nam1 (buffer-name buf1)) 1714 (let* ((nam1 (buffer-name buf1))
1713 (nam2 (buffer-name buf2)) 1715 (nam2 (buffer-name buf2))
1714 (inv1p (not (null (string-match "\\` " nam1)))) 1716 (len1 (length nam1))
1715 (inv2p (not (null (string-match "\\` " nam2)))) 1717 (len2 (length nam2))
1716 (star1p (not (null (string-match "\\`*" nam1)))) 1718 (inv1p (eql ?\ (and (> len1 0) (aref nam1 0))))
1717 (star2p (not (null (string-match "\\`*" nam2))))) 1719 (inv2p (eql ?\ (and (> len2 0) (aref nam2 0))))
1720 (star1p (eql ?* (and (> len1 0) (aref nam1 0))))
1721 (star2p (eql ?* (and (> len2 0) (aref nam2 0)))))
1718 (cond ((not (eq inv1p inv2p)) 1722 (cond ((not (eq inv1p inv2p))
1719 (not inv1p)) 1723 (not inv1p))
1720 ((not (eq star1p star2p)) 1724 ((not (eq star1p star2p))
1721 (not star1p)) 1725 (not star1p))
1722 (t 1726 (t
1726 "For use as a value of `buffers-menu-sort-function'. 1730 "For use as a value of `buffers-menu-sort-function'.
1727 Sorts first by major mode and then alphabetically by name, but puts buffers 1731 Sorts first by major mode and then alphabetically by name, but puts buffers
1728 beginning with a star at the end of the list." 1732 beginning with a star at the end of the list."
1729 (let* ((nam1 (buffer-name buf1)) 1733 (let* ((nam1 (buffer-name buf1))
1730 (nam2 (buffer-name buf2)) 1734 (nam2 (buffer-name buf2))
1731 (inv1p (not (null (string-match "\\` " nam1)))) 1735 (first1 (elt nam1 0))
1732 (inv2p (not (null (string-match "\\` " nam2)))) 1736 (first2 (elt nam2 0))
1733 (star1p (not (null (string-match "\\`*" nam1)))) 1737 (inv1p (eql ?\ first1))
1734 (star2p (not (null (string-match "\\`*" nam2)))) 1738 (inv2p (eql ?\ first2))
1735 (mode1 (symbol-value-in-buffer 'major-mode buf1)) 1739 (star1p (eql ?* first1))
1736 (mode2 (symbol-value-in-buffer 'major-mode buf2))) 1740 (star2p (eql ?* first2))
1741 compare-strings)
1737 (cond ((not (eq inv1p inv2p)) 1742 (cond ((not (eq inv1p inv2p))
1738 (not inv1p)) 1743 (not inv1p))
1739 ((not (eq star1p star2p)) 1744 ((not (eq star1p star2p))
1740 (not star1p)) 1745 (not star1p))
1741 ((and star1p star2p (string-lessp nam1 nam2))) 1746 ((and star1p star2p (prog2
1742 ((string-lessp mode1 mode2) 1747 (setq compare-strings
1743 t) 1748 (compare-strings nam1 0 nil
1744 ((string-lessp mode2 mode1) 1749 nam2 0 nil t))
1745 nil) 1750 (and (fixnump compare-strings)
1746 (t 1751 (minusp compare-strings)))))
1747 (string-lessp nam1 nam2))))) 1752 ((eq (setq compare-strings
1753 (compare-strings (symbol-name
1754 (symbol-value-in-buffer
1755 'major-mode buf1))
1756 0 nil
1757 (symbol-name
1758 (symbol-value-in-buffer
1759 'major-mode buf2))
1760 0 nil t))
1761 t)
1762 (setq compare-strings (compare-strings nam1 0 nil
1763 nam2 0 nil t))
1764 (and (fixnump compare-strings) (minusp compare-strings)))
1765 (t (minusp compare-strings)))))
1748 1766
1749 ;; this version is too slow on some machines. 1767 ;; this version is too slow on some machines.
1750 ;; (vintage 1990, that is) 1768 ;; (vintage 1990, that is)
1751 (defun slow-format-buffers-menu-line (buffer n) 1769 (defun slow-format-buffers-menu-line (buffer n)
1752 "For use as a value of `buffers-menu-format-buffer-line-function'. 1770 "For use as a value of `buffers-menu-format-buffer-line-function'.
1770 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2) 1788 (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
1771 "For use as a value of `buffers-menu-grouping-function'. 1789 "For use as a value of `buffers-menu-grouping-function'.
1772 This groups buffers by major mode. It only really makes sense if 1790 This groups buffers by major mode. It only really makes sense if
1773 `buffers-menu-sorting-function' is 1791 `buffers-menu-sorting-function' is
1774 `sort-buffers-menu-by-mode-then-alphabetically'." 1792 `sort-buffers-menu-by-mode-then-alphabetically'."
1775 (cond ((string-match "\\`*" (buffer-name buf1)) 1793 (let* ((nam1 (buffer-name buf1))
1776 (and (null buf2) "*Misc*")) 1794 (nam2 (buffer-name buf2))
1777 ((or (null buf2) 1795 (len1 (length nam1))
1778 (string-match "\\`*" (buffer-name buf2)) 1796 (len2 (length nam2)))
1779 (not (eq (symbol-value-in-buffer 'major-mode buf1) 1797 (cond ((eql ?* (and (> len1 0) (aref nam1 0)))
1780 (symbol-value-in-buffer 'major-mode buf2)))) 1798 (and (null buf2) "*Misc*"))
1781 (symbol-value-in-buffer 'mode-name buf1)) 1799 ((or (null buf2)
1782 (t nil))) 1800 (eql ?* (and (> len2 0) (aref nam2 0)))
1801 (not (eq (symbol-value-in-buffer 'major-mode buf1)
1802 (symbol-value-in-buffer 'major-mode buf2))))
1803 (symbol-value-in-buffer 'mode-name buf1))
1804 (t nil))))
1783 1805
1784 (defun buffer-menu-save-buffer (buffer) 1806 (defun buffer-menu-save-buffer (buffer)
1785 (save-excursion 1807 (save-excursion
1786 (set-buffer buffer) 1808 (set-buffer buffer)
1787 (save-buffer))) 1809 (save-buffer)))
1900 )) 1922 ))
1901 1923
1902 (defun list-all-buffers () 1924 (defun list-all-buffers ()
1903 "Display a list of buffers. Calls `list-all-buffers-function'." 1925 "Display a list of buffers. Calls `list-all-buffers-function'."
1904 (interactive) 1926 (interactive)
1905 (funcall (if (fboundp list-all-buffers-function) 1927 (funcall (if (functionp list-all-buffers-function)
1906 list-all-buffers-function 1928 list-all-buffers-function
1907 'list-buffers))) 1929 'list-buffers)))
1908 1930
1909 1931
1910 ;;; The Help menu 1932 ;;; The Help menu
1924 (if (featurep 'mule) 1946 (if (featurep 'mule)
1925 ;; Mule tutorials. 1947 ;; Mule tutorials.
1926 (mapcan #'(lambda (lang) 1948 (mapcan #'(lambda (lang)
1927 (let ((tut (assq 'tutorial lang))) 1949 (let ((tut (assq 'tutorial lang)))
1928 (and tut 1950 (and tut
1929 (not (string= (car lang) "ASCII")) 1951 (not (equal (car lang) "ASCII"))
1930 ;; skip current language, since we already 1952 ;; skip current language, since we already
1931 ;; included it first 1953 ;; included it first
1932 (not (string= (car lang) 1954 (not (equal (car lang)
1933 current-language-environment)) 1955 current-language-environment))
1934 ;; Hackish approach; if a language environment 1956 ;; Hackish approach; if a language environment
1935 ;; doesn't have associated locale information, 1957 ;; doesn't have associated locale information,
1936 ;; it's not the preferred implementation for that 1958 ;; it's not the preferred implementation for that
1937 ;; language. Don't use it. 1959 ;; language. Don't use it.