Mercurial > hg > xemacs-beta
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. |