comparison lisp/buff-menu.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 cc6f0266bc36
children
comparison
equal deleted inserted replaced
5881:31dd275fa683 5882:bbe4146603db
647 (t 647 (t
648 t)))) 648 t))))
649 files-only)) 649 files-only))
650 buffer)) 650 buffer))
651 651
652 (defun buffers-menu-omit-invisible-buffers (buf) 652 (defun buffers-menu-omit-invisible-buffers (buffer)
653 "For use as a value of `buffers-menu-omit-function'. 653 "For use as a value of `buffers-menu-omit-function'.
654 Omits normally invisible buffers (those whose name begins with a space)." 654 Omits normally invisible buffers (those whose name begins with a space)."
655 (not (null (string-match "\\` " (buffer-name buf))))) 655 (eql ?\ (elt (buffer-name buffer) 0)))
656 656
657 ;;; The Buffers tab 657 ;;; The Buffers tab
658 658
659 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el 659 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el
660 660
786 This selects buffers by major mode `buffers-tab-grouping-regexp'." 786 This selects buffers by major mode `buffers-tab-grouping-regexp'."
787 (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1))) 787 (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1)))
788 (mode2 (symbol-name (symbol-value-in-buffer 'major-mode 788 (mode2 (symbol-name (symbol-value-in-buffer 'major-mode
789 buffer-to-select))) 789 buffer-to-select)))
790 (modenm1 (symbol-value-in-buffer 'mode-name buf1)) 790 (modenm1 (symbol-value-in-buffer 'mode-name buf1))
791 (modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select))) 791 (modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select))
792 position mismatch)
792 (cond ((or (eq mode1 mode2) 793 (cond ((or (eq mode1 mode2)
793 (eq modenm1 modenm2) 794 (eq modenm1 modenm2)
794 (and (string-match "^[^-]+-" mode1) 795 (and (setq position (position ?- mode1)) (> position 0)
795 (string-match 796 (prog2
796 (concat "^" (regexp-quote 797 (setq mismatch (mismatch mode1 mode2 :end1 position))
797 (substring mode1 0 (match-end 0)))) 798 (not (or (null mismatch) (eql mismatch position)))))
798 mode2))
799 (and buffers-tab-grouping-regexp 799 (and buffers-tab-grouping-regexp
800 (find-if #'(lambda (x) 800 (find-if #'(lambda (x)
801 (or 801 (or
802 (and (string-match x mode1) 802 (and (string-match x mode1)
803 (string-match x mode2)) 803 (string-match x mode2))
808 (t nil)))) 808 (t nil))))
809 809
810 (defun format-buffers-tab-line (buffer) 810 (defun format-buffers-tab-line (buffer)
811 "For use as a value of `buffers-tab-format-buffer-line-function'. 811 "For use as a value of `buffers-tab-format-buffer-line-function'.
812 This just returns the buffer's name, optionally truncated." 812 This just returns the buffer's name, optionally truncated."
813 (let ((len (specifier-instance buffers-tab-default-buffer-line-length))) 813 (let* ((len (specifier-instance buffers-tab-default-buffer-line-length))
814 (if (and (> len 0) 814 (buffer-name (buffer-name buffer))
815 (> (length (buffer-name buffer)) len)) 815 (len1 (length buffer-name)))
816 (if (string-match ".*<.>$" (buffer-name buffer)) 816 (if (and (> len 0) (> len1 len))
817 (concat (substring (buffer-name buffer) 817 (if (and (> len1 3) (eql ?< (aref buffer-name (- len1 3)))
818 0 (- len 6)) "..." 818 (eql ?> (aref buffer-name (1- len1))))
819 (substring (buffer-name buffer) -3)) 819 (concat (subseq buffer-name 0 (- len 6))
820 (concat (substring (buffer-name buffer) 820 "..." (subseq buffer-name -3))
821 0 (- len 3)) "...")) 821 (concat (subseq buffer-name 0 (- len 3)) "..."))
822 (buffer-name buffer)))) 822 buffer-name)))
823
824 (defsubst build-buffers-tab-internal (buffers)
825 (let ((selected t))
826 (mapcar
827 #'(lambda (buffer)
828 (prog1
829 (vector
830 (funcall buffers-tab-format-buffer-line-function
831 buffer)
832 (list buffers-tab-switch-to-buffer-function
833 (buffer-name buffer))
834 :selected selected)
835 (when selected (setq selected nil))))
836 buffers)))
837 823
838 ;;; #### SJT would like this function to have a sort function list. I 824 ;;; #### SJT would like this function to have a sort function list. I
839 ;;; don't see how this could work given that sorting is not 825 ;;; don't see how this could work given that sorting is not
840 ;;; cumulative --andyp. 826 ;;; cumulative --andyp.
841 (defun buffers-tab-items (&optional in-deletion frame force-selection) 827 (defun buffers-tab-items (&optional in-deletion frame force-selection)
866 (setq buffers (delete* (current-buffer) buffers)) 852 (setq buffers (delete* (current-buffer) buffers))
867 (setq first-buf (car buffers))) 853 (setq first-buf (car buffers)))
868 ;; filter buffers 854 ;; filter buffers
869 (when buffers-tab-filter-functions 855 (when buffers-tab-filter-functions
870 (setq buffers 856 (setq buffers
871 (delete-if 857 (mapcan #'(lambda (buf)
872 #'null 858 (let ((tmp-buf buf))
873 (mapcar #'(lambda (buf) 859 (mapc #'(lambda (fun)
874 (let ((tmp-buf buf)) 860 (unless (funcall fun buf first-buf)
875 (mapc #'(lambda (fun) 861 (setq tmp-buf nil)))
876 (unless (funcall fun buf first-buf) 862 buffers-tab-filter-functions)
877 (setq tmp-buf nil))) 863 (and tmp-buf (list tmp-buf))))
878 buffers-tab-filter-functions) 864 buffers)))
879 tmp-buf))
880 buffers))))
881 ;; maybe shorten list of buffers 865 ;; maybe shorten list of buffers
882 (and (integerp buffers-tab-max-size) 866 (and (integerp buffers-tab-max-size)
883 (> buffers-tab-max-size 1) 867 (> buffers-tab-max-size 1)
884 (> (length buffers) buffers-tab-max-size) 868 (> (length buffers) buffers-tab-max-size)
885 (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil)) 869 (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil))
886 ;; sort buffers in group (default is most-recently-selected) 870 ;; sort buffers in group (default is most-recently-selected)
887 (when buffers-tab-sort-function 871 (when buffers-tab-sort-function
888 (setq buffers (funcall buffers-tab-sort-function buffers))) 872 (setq buffers (funcall buffers-tab-sort-function buffers)))
889 ;; convert list of buffers to list of structures used by tab widget 873 (labels
890 (setq buffers (build-buffers-tab-internal buffers)) 874 ((build-buffers-tab-internal (buffers)
891 buffers))) 875 (let ((selected t))
876 (mapcar
877 #'(lambda (buffer)
878 (prog1
879 (vector
880 (funcall buffers-tab-format-buffer-line-function
881 buffer)
882 (list buffers-tab-switch-to-buffer-function
883 (buffer-name buffer))
884 :selected selected)
885 (when selected (setq selected nil))))
886 buffers))))
887 ;; convert list of buffers to list of structures used by tab widget
888 (setq buffers (build-buffers-tab-internal buffers))
889 buffers))))
892 890
893 (provide 'buff-menu) 891 (provide 'buff-menu)
894 892
895 ;;; buff-menu.el ends here 893 ;;; buff-menu.el ends here