[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 80e2647: * lisp/filesets.el: Use lexical-binding
|
From: |
Stefan Monnier |
|
Subject: |
master 80e2647: * lisp/filesets.el: Use lexical-binding |
|
Date: |
Mon, 4 Jan 2021 18:23:48 -0500 (EST) |
branch: master
commit 80e26472206cc44837521ba594cd50e724d9af5c
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/filesets.el: Use lexical-binding
Remove redundant `:group` args. Require cl-lib and seq.
Fix various O(n²) bug and flag a few remaining ones.
(filesets-external-viewers): Simplify regexps. Use \' instead of $.
Remove useless :constraint-flag properties.
(filesets-convert-path-list): η-reduce.
(filesets-eviewer-constraint-p): Mark :constraint-flag as obsolete.
(filesets-spawn-external-viewer): Can't use `run-hooks` on
lexical variable.
(filesets-filter-list): Fix O(n²) bug.
(filesets-ormap): Simplify.
(filesets-some, filesets-member, filesets-sublist): Make them
obsolete aliases.
(filesets-reset-fileset): Simplify.
(filesets-directory-files): Use `push`.
(filesets-spawn-external-viewer): Use `mapconcat` to fix O(n²) bug.
(filesets-cmd-get-args): Use `mapcan` to fix O(n²) bug.
(filesets-run-cmd): Use `mapconcat` and `mapcan` to fix O(n²) bugs.
(filesets-ingroup-collect-finder): Use dynamic scoping.
(filesets-ingroup-collect-files): Use `nreverse` to fix O(n²) bug.
(filesets-ingroup-collect-build-menu): Use `mapcan` to fix O(n²) bug.
---
lisp/filesets.el | 477 +++++++++++++++++++++++++------------------------------
1 file changed, 214 insertions(+), 263 deletions(-)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 7c01b15..661a93e 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,4 +1,4 @@
-;;; filesets.el --- handle group of files
+;;; filesets.el --- handle group of files -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -88,7 +88,8 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'seq)
(require 'easymenu)
;;; Some variables
@@ -153,52 +154,25 @@ COND-FN takes one argument: the current element."
; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
- (dolist (elt lst rv)
+ (dolist (elt lst)
(when (funcall cond-fn elt)
- (setq rv (append rv (list elt)))))))
+ (push elt rv)))
+ (nreverse rv)))
(defun filesets-ormap (fsom-pred lst)
"Return the tail of LST for the head of which FSOM-PRED is non-nil."
(let ((fsom-lst lst)
(fsom-rv nil))
- (while (and (not (null fsom-lst))
+ (while (and fsom-lst
(null fsom-rv))
(if (funcall fsom-pred (car fsom-lst))
(setq fsom-rv fsom-lst)
(setq fsom-lst (cdr fsom-lst))))
fsom-rv))
-(defun filesets-some (fss-pred fss-lst)
- "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
-Like `some', return the first value of FSS-PRED that is non-nil."
- (catch 'exit
- (dolist (fss-this fss-lst nil)
- (let ((fss-rv (funcall fss-pred fss-this)))
- (when fss-rv
- (throw 'exit fss-rv))))))
-;(fset 'filesets-some 'cl-some) ;; or use the cl function
-
-(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
- "Find the first occurrence of FSM-ITEM in FSM-LST.
-It is supposed to work like cl's `member*'. At the moment only the :test
-key is supported."
- (let ((fsm-test (or (plist-get fsm-keys ':test)
- (function equal))))
- (filesets-ormap (lambda (fsm-this)
- (funcall fsm-test fsm-item fsm-this))
- fsm-lst)))
-;(fset 'filesets-member 'cl-member) ;; or use the cl function
-
-(defun filesets-sublist (lst beg &optional end)
- "Get the sublist of LST from BEG to END - 1."
- (let ((rv nil)
- (i beg)
- (top (or end
- (length lst))))
- (while (< i top)
- (setq rv (append rv (list (nth i lst))))
- (setq i (+ i 1)))
- rv))
+(define-obsolete-function-alias 'filesets-some #'cl-some "28.1")
+(define-obsolete-function-alias 'filesets-member #'cl-member "28.1")
+(define-obsolete-function-alias 'filesets-sublist #'seq-subseq "28.1")
(defun filesets-select-command (cmd-list)
"Select one command from CMD-LIST -- a string with space separated names."
@@ -222,7 +196,7 @@ key is supported."
(defun filesets-message (level &rest args)
"Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
(when (<= level (abs filesets-verbosity))
- (apply 'message args)))
+ (apply #'message args)))
;;; config file
@@ -233,9 +207,9 @@ key is supported."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
- (if fileset
- (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
- (setq filesets-submenus nil))
+ (setq filesets-submenus (if fileset
+ (lax-plist-put filesets-submenus fileset nil)
+ nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
(not no-cache))))
@@ -303,50 +277,46 @@ SYM to VAL and return t. If INIT-FLAG is non-nil, set
with
(defcustom filesets-menu-name "Filesets"
"Filesets' menu name."
- :set (function filesets-set-default)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'string)
(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice (const :tag "Top Level" nil)
(sexp :tag "Menu Path"))
:version "23.1" ; was nil
- :group 'filesets)
+ )
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice (string :tag "Name")
(const :tag "Last" nil))
:version "23.1" ; was "File"
- :group 'filesets)
+ )
(defcustom filesets-menu-in-menu nil
"Use that instead of `current-menubar' as the menu to change.
See `easy-menu-add-item' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'sexp)
(defcustom filesets-menu-shortcuts-flag t
"Non-nil means to prepend menus with hopefully unique shortcuts."
- :set (function filesets-set-default!)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'boolean)
(defcustom filesets-menu-shortcuts-marker "%_"
"String for marking menu shortcuts."
- :set (function filesets-set-default!)
- :type 'string
- :group 'filesets)
+ :set #'filesets-set-default!
+ :type 'string)
;;(defcustom filesets-menu-cnvfp-flag nil
;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern
menus."
-;; :set (function filesets-set-default!)
+;; :set #'filesets-set-default!
;; :type 'boolean
;; :group 'filesets)
@@ -355,9 +325,8 @@ See `easy-menu-add-item' for documentation."
"File to be used for saving the filesets menu between sessions.
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'file
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'file)
(put 'filesets-menu-cache-file 'risky-local-variable t)
(defcustom filesets-menu-cache-contents
@@ -383,7 +352,7 @@ If you want caching to work properly, at least
`filesets-submenus',
list.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
(choice :tag "Variable"
(const :tag "filesets-submenus"
@@ -400,8 +369,7 @@ Don't forget to check out
`filesets-menu-ensure-use-cached'."
:value filesets-ingroup-patterns)
(const :tag "filesets-be-docile-flag"
:value filesets-be-docile-flag)
- (sexp :tag "Other" :value nil)))
- :group 'filesets)
+ (sexp :tag "Other" :value nil))))
(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
'filesets-cache-fill-content-hook "24.3")
@@ -423,48 +391,43 @@ configuration file, you can add a something like this
to this hook.
Don't forget to check out `filesets-menu-ensure-use-cached'."
- :set (function filesets-set-default)
- :type 'hook
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'hook)
(defcustom filesets-cache-hostname-flag nil
"Non-nil means cache the hostname.
If the current name differs from the cached one,
rebuild the menu and create a new cache file."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-cache-save-often-flag nil
"Non-nil means save buffer on every change of the filesets menu.
If this variable is set to nil and if Emacs crashes, the cache and
filesets-data could get out of sync. Set this to t if this happens from
time to time or if the fileset cache causes troubles."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-max-submenu-length 25
"Maximum length of submenus.
Set this value to 0 to turn menu splitting off. BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-max-entry-length 50
"Truncate names of split submenus to this length."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
-(defcustom filesets-browse-dir-function 'dired
+(defcustom filesets-browse-dir-function #'dired
"A function or command used for browsing directories.
When using an external command, \"%s\" will be replaced with the
directory's name.
Note: You have to manually rebuild the menu if you change this value."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "dired"
:value dired)
@@ -473,10 +436,9 @@ Note: You have to manually rebuild the menu if you change
this value."
(string :tag "Name")
(string :tag "Arguments"))
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-open-file-function 'filesets-find-or-display-file
+(defcustom filesets-open-file-function #'filesets-find-or-display-file
"The function used for opening files.
`filesets-find-or-display-file' ... Filesets' default function for
@@ -489,26 +451,24 @@ for a specific file type. Either this viewer, if
defined, or
readable, will not be opened.
Caveat: Changes will take effect only after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "filesets-find-or-display-file"
:value filesets-find-or-display-file)
(const :tag "filesets-find-file"
:value filesets-find-file)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
-(defcustom filesets-save-buffer-function 'save-buffer
+(defcustom filesets-save-buffer-function #'save-buffer
"The function used to save a buffer.
Caveat: Changes will take effect after rebuilding the menu."
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(choice :tag "Function:"
(const :tag "save-buffer"
:value save-buffer)
(function :tag "Function"
- :value nil))
- :group 'filesets)
+ :value nil)))
(defcustom filesets-find-file-delay
(if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
@@ -519,29 +479,25 @@ This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
Set this to 0, if you don't use XEmacs's buffer tabs."
- :set (function filesets-set-default)
- :type 'number
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'number)
(defcustom filesets-be-docile-flag nil
"Non-nil means don't complain if a file or a directory doesn't exist.
This is useful if you want to use the same startup files in different
computer environments."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-menu-flag t
"Non-nil means sort the filesets menu alphabetically."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-sort-case-sensitive-flag t
"Non-nil means sorting of the filesets menu is case sensitive."
- :set (function filesets-set-default)
- :type 'boolean
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'boolean)
(defcustom filesets-tree-max-level 3
"Maximum scan depth for directory trees.
@@ -561,9 +517,8 @@ i.e. how deep the menu should be. Try something like
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defcustom filesets-commands
'(("Isearch"
@@ -590,7 +545,7 @@ function that returns one) to be run on a filesets' files.
The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
- :set (function filesets-set-default+)
+ :set #'filesets-set-default+
:type '(repeat :tag "Commands"
(list :tag "Definition" :value ("")
(string "Name")
@@ -606,8 +561,7 @@ the filename."
(string :tag "Quoted File Name"
:value "<<file-name>>")
(function :tag "Function"
- :value nil)))))
- :group 'filesets)
+ :value nil))))))
(put 'filesets-commands 'risky-local-variable t)
(defcustom filesets-external-viewers
@@ -627,28 +581,33 @@ the filename."
(dvi-cmd "xdvi")
(doc-cmd "antiword")
(pic-cmd "gqview"))
- `(("^.+\\..?html?$" browse-url
+ `((".\\..?html?\\'" browse-url
((:ignore-on-open-all t)))
- ("^.+\\.pdf$" ,pdf-cmd
+ (".\\.pdf\\'" ,pdf-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pdf-cmd)))
- ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
+ ;; (:constraintp ,pdf-cmd)
+ ))
+ (".\\.e?ps\\(.gz\\)?\\'" ,ps-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,ps-cmd)))
- ("^.+\\.dvi$" ,dvi-cmd
+ ;; (:constraintp ,ps-cmd)
+ ))
+ (".\\.dvi\\'" ,dvi-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,dvi-cmd)))
- ("^.+\\.doc$" ,doc-cmd
+ ;; (:constraintp ,dvi-cmd)
+ ))
+ (".\\.doc\\'" ,doc-cmd
((:capture-output t)
(:ignore-on-read-text t)
- (:constraint-flag ,doc-cmd)))
- ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
+ ;; (:constraintp ,doc-cmd)
+ ))
+ (".\\.\\(tiff\\|xpm\\|gif\\|pgn\\)\\'" ,pic-cmd
((:ignore-on-open-all t)
(:ignore-on-read-text t)
- (:constraint-flag ,pic-cmd)))))
+ ;; (:constraintp ,pic-cmd)
+ ))))
"Association list of file patterns and external viewers for use with
`filesets-find-or-display-file'.
@@ -665,10 +624,8 @@ i.e. on open-all-files-events or when running commands
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
-:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
-
-:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
-in conjunction with :capture-output
+:open-hook FUNCTIONs ... run FUNCTIONs after spawning the viewer -- mainly
+useful in conjunction with :capture-output
:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
\(defaults to (list \"%S\")) when using shell commands
@@ -693,7 +650,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
(:constraintp (lambda ()
(and (filesets-which-command-p \"rtf2htm\")
(filesets-which-command-p \"w3m\"))))))"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value ("^.+\\.suffix$" "")
@@ -708,7 +665,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
(const :format ""
:value :constraintp)
(function :tag "Function"))
- (list :tag ":constraint-flag"
+ (list :tag ":constraint-flag (obsolete)"
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
@@ -749,8 +706,7 @@ In order to view pdf or rtf files in an Emacs buffer, you
could use these:
:value (:capture-output t)
(const :format ""
:value :capture-output)
- (boolean :tag "Boolean"))))))
- :group 'filesets)
+ (boolean :tag "Boolean")))))))
(put 'filesets-external-viewers 'risky-local-variable t)
(defcustom filesets-ingroup-patterns
@@ -891,7 +847,7 @@ With duplicates removed, it would be:
M + A - X
B"
- :set (function filesets-set-default)
+ :set #'filesets-set-default
:type '(repeat
:tag "Include"
(list
@@ -937,8 +893,7 @@ With duplicates removed, it would be:
(list :tag ":preprocess"
:value (:preprocess)
(const :format "" :value :preprocess)
- (function :tag "Function")))))))
- :group 'filesets)
+ (function :tag "Function"))))))))
(put 'filesets-ingroup-patterns 'risky-local-variable t)
(defcustom filesets-data nil
@@ -1009,8 +964,7 @@ is used.
Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
- :group 'filesets
- :set (function filesets-data-set-default)
+ :set #'filesets-data-set-default
:type '(repeat
(cons :tag "Fileset"
(string :tag "Name" :value "")
@@ -1072,9 +1026,8 @@ defined in `filesets-ingroup-patterns'."
(defcustom filesets-query-user-limit 15
"Query the user before opening a fileset with that many files."
- :set (function filesets-set-default)
- :type 'integer
- :group 'filesets)
+ :set #'filesets-set-default
+ :type 'integer)
(defun filesets-filter-dir-names (lst &optional negative)
@@ -1127,16 +1080,16 @@ Return full path if FULL-FLAG is non-nil."
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
- (setq dirs (cons this dirs))))
+ (push this dirs)))
(t
(when (or (not pattern)
(string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
- (setq files (cons (if full-flag
- (concat (file-name-as-directory dir) this)
- this)
- files))))))
+ (push (if full-flag
+ (concat (file-name-as-directory dir) this)
+ this)
+ files)))))
(cond
((equal what ':dirs)
(filesets-conditional-sort dirs))
@@ -1193,7 +1146,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-convert-path-list (string)
"Return a path-list given as STRING as list."
(if string
- (mapcar (lambda (x) (file-name-as-directory x))
+ (mapcar #'file-name-as-directory
(split-string string path-separator))
nil))
@@ -1203,17 +1156,17 @@ Return full path if FULL-FLAG is non-nil."
filename)))
(if (file-exists-p f)
f
- (filesets-some
+ (cl-some
(lambda (dir)
(let ((dir (file-name-as-directory dir))
(files (if (file-exists-p dir)
(filesets-directory-files dir nil ':files)
nil)))
- (filesets-some (lambda (file)
- (if (equal filename (file-name-nondirectory file))
- (concat dir file)
- nil))
- files)))
+ (cl-some (lambda (file)
+ (if (equal filename (file-name-nondirectory file))
+ (concat dir file)
+ nil))
+ files)))
path-list))))
@@ -1223,12 +1176,14 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-eviewer-constraint-p (entry)
(let* ((props (filesets-eviewer-get-props entry))
- (constraint (assoc ':constraintp props))
- (constraint-flag (assoc ':constraint-flag props)))
+ (constraint (assoc :constraintp props))
+ (constraint-flag (assoc :constraint-flag props)))
(cond
(constraint
(funcall (cadr constraint)))
(constraint-flag
+ (message "Obsolete :constraint-flag %S, use :constraintp instead"
+ (cadr constraint-flag))
(eval (cadr constraint-flag)))
(t
t))))
@@ -1236,7 +1191,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
@@ -1246,7 +1201,7 @@ Return full path if FULL-FLAG is non-nil."
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
- (filesets-some
+ (cl-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
@@ -1308,17 +1263,13 @@ Use the viewer defined in EV-ENTRY (a valid element of
(oh (filesets-filetype-get-prop ':open-hook file entry))
(args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
(if fmt
- (let ((rv ""))
- (dolist (this fmt rv)
- (setq rv (concat rv
- (cond
- ((stringp this)
- (format this file))
- ((and (symbolp this)
- (fboundp this))
- (format "%S" (funcall this)))
- (t
- (format "%S" this)))))))
+ (mapconcat
+ (lambda (this)
+ (if (stringp this) (format this file)
+ (format "%S" (if (functionp this)
+ (funcall this)
+ this))))
+ fmt "")
(format "%S" file))))
(output
(cond
@@ -1338,13 +1289,15 @@ Use the viewer defined in EV-ENTRY (a valid element of
(insert output)
(setq-local filesets-output-buffer-flag t)
(set-visited-file-name file t)
- (when oh
- (run-hooks 'oh))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(goto-char (point-min)))
- (when oh
- (run-hooks 'oh))))
+ (if (functionp oh)
+ (funcall oh)
+ (mapc #'funcall oh))))
(error "Filesets: general error when spawning external viewer"))))
(defun filesets-find-file (file)
@@ -1355,7 +1308,8 @@ not be opened."
(when (or (file-readable-p file)
(not filesets-be-docile-flag))
(sit-for filesets-find-file-delay)
- (find-file file)))
+ (with-suppressed-warnings ((interactive-only find-file))
+ (find-file file))))
(defun filesets-find-or-display-file (&optional file viewer)
"Visit FILE using an external VIEWER or open it in an Emacs buffer."
@@ -1394,7 +1348,8 @@ not be opened."
(if (functionp filesets-browse-dir-function)
(funcall filesets-browse-dir-function dir)
(let ((name (car filesets-browse-dir-function))
- (args (format (cadr filesets-browse-dir-function) (expand-file-name
dir))))
+ (args (format (cadr filesets-browse-dir-function)
+ (expand-file-name dir))))
(with-temp-buffer
(start-process (concat "Filesets:" name)
"*Filesets external directory browser*"
@@ -1445,7 +1400,7 @@ Return DEFAULT if not found. Return (car VALUE) if CARP
is non-nil."
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
- (filesets-some
+ (cl-some
(lambda (x)
(if (assoc x data)
x))
@@ -1557,16 +1512,15 @@ SAVE-FUNCTION takes no argument, but works on the
current buffer."
(assoc cmd-name filesets-commands))
(defun filesets-cmd-get-args (cmd-name)
- (let ((args (let ((def (filesets-cmd-get-def cmd-name)))
- (nth 2 def)))
- (rv nil))
- (dolist (this args rv)
- (cond
- ((and (symbolp this) (fboundp this))
- (let ((x (funcall this)))
- (setq rv (append rv (if (listp x) x (list x))))))
- (t
- (setq rv (append rv (list this))))))))
+ (mapcan (lambda (this)
+ (cond
+ ((and (symbolp this) (fboundp this))
+ (let ((x (funcall this)))
+ (if (listp x) x (list x))))
+ (t
+ (list this))))
+ (let ((def (filesets-cmd-get-def cmd-name)))
+ (nth 2 def))))
(defun filesets-cmd-get-fn (cmd-name)
(let ((def (filesets-cmd-get-def cmd-name)))
@@ -1628,28 +1582,24 @@ Replace <file-name> or <<file-name>> with filename."
(cond
((stringp fn)
(let* ((args
- (let ((txt ""))
- (dolist (this args txt)
- (setq txt
- (concat txt
- (if (equal txt "") "" " ")
- (filesets-run-cmd--repl-fn
+ (mapconcat
+ (lambda (this)
+ (filesets-run-cmd--repl-fn
this
(lambda (this)
- (format "%s"
this))))))))
+ (format "%s" this))))
+ args
+ " "))
(cmd (concat fn " " args)))
(filesets-cmd-show-result
cmd (shell-command-to-string cmd))))
((symbolp fn)
- (let ((args
- (let ((argl nil))
- (dolist (this args argl)
- (setq argl
- (append argl
- (filesets-run-cmd--repl-fn
- this
- 'list)))))))
- (apply fn args)))))))))))))))))
+ (apply fn
+ (mapcan (lambda (this)
+ (filesets-run-cmd--repl-fn
+ this
+ 'list))
+ args)))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
@@ -1832,8 +1782,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: `%s' is already in `%s'" this name))
@@ -1858,8 +1808,8 @@ User will be queried, if no fileset name is provided."
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (filesets-member this files
- :test 'filesets-files-equalp)))
+ (inlist (cl-member this files
+ :test #'filesets-files-equalp)))
;;(message "%s %s %s" files this inlist)
(if (and files this inlist)
(let ((new (list (cons ':files (delete (car inlist) files)))))
@@ -1908,7 +1858,7 @@ User will be queried, if no fileset name is provided."
(substring (elt submenu 0) 2))))
(if (listp submenu)
(cons name (cdr submenu))
- (apply 'vector (list name (cadr (append submenu nil)))))))
+ (apply #'vector (list name (cadr (append submenu nil)))))))
; (vconcat `[,name] (subseq submenu 1)))))
(defun filesets-wrap-submenu (submenu-body)
@@ -1926,12 +1876,14 @@ User will be queried, if no fileset name is provided."
((or (> count bl)
(null data)))
;; (let ((sl (subseq submenu-body count
- (let ((sl (filesets-sublist submenu-body count
- (let ((x (+ count factor)))
- (if (>= bl x)
- x
- nil)))))
+ (let ((sl (seq-subseq submenu-body count
+ (let ((x (+ count factor)))
+ (if (>= bl x)
+ x
+ nil)))))
(when sl
+ ;; FIXME: O(n²) performance bug because of repeated `append':
+ ;; use `mapcan'?
(setq result
(append
result
@@ -1948,6 +1900,8 @@ User will be queried, if no fileset name is provided."
(if (null (cdr x))
""
", "))))
+ ;; FIXME: O(n²) performance bug because of
+ ;; repeated `concat': use `mapconcat'?
(setq rv
(concat
rv
@@ -2023,11 +1977,11 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(and (stringp a)
(stringp b)
(string-match-p a b))))))
- (filesets-some (lambda (x)
- (if (funcall fn (car x) masterfile)
- (nth pos x)
- nil))
- filesets-ingroup-patterns)))
+ (cl-some (lambda (x)
+ (if (funcall fn (car x) masterfile)
+ (nth pos x)
+ nil))
+ filesets-ingroup-patterns)))
(defun filesets-ingroup-get-pattern (master)
"Access to `filesets-ingroup-patterns'. Extract patterns."
@@ -2039,12 +1993,8 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(defun filesets-ingroup-collect-finder (patt case-sensitivep)
"Helper function for `filesets-ingroup-collect'. Find pattern PATT."
- (let ((cfs case-fold-search)
- (rv (progn
- (setq case-fold-search (not case-sensitivep))
- (re-search-forward patt nil t))))
- (setq case-fold-search cfs)
- rv))
+ (let ((case-fold-search (not case-sensitivep)))
+ (re-search-forward patt nil t)))
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
@@ -2102,9 +2052,9 @@ LOOKUP-NAME is used as lookup name for retrieving fileset
specific settings."
(when (and f
(not (member f flist))
(or (not remdupl-flag)
- (not (filesets-member
+ (not (cl-member
f filesets-ingroup-files
- :test 'filesets-files-equalp))))
+ :test #'filesets-files-equalp))))
(let ((no-stub-flag
(and (not this-stub-flag)
(if this-stubp
@@ -2116,16 +2066,18 @@ LOOKUP-NAME is used as lookup name for retrieving
fileset specific settings."
(cons f filesets-ingroup-files))
(when no-stub-flag
(filesets-ingroup-cache-put master f))
- (setq lst (append lst (list f))))))))
+ (push f lst))))))
(when lst
(setq rv
+ ;; FIXME: O(n²) performance bug because of repeated
+ ;; `nconc'.
(nconc rv
(mapcar (lambda (this)
`((,this ,this-name)
,@(filesets-ingroup-collect-files
fs remdupl-flag this
(- this-sd 1))))
- lst))))))))
+ (nreverse lst)))))))))
(filesets-message 2 "Filesets: no patterns defined for %S" master)))))
(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
@@ -2135,42 +2087,41 @@ FS is a fileset's name. FLIST is a list returned by
(if (null flist)
nil
(let ((count 0)
- (fsn fs)
- (rv nil))
- (dolist (this flist rv)
- (setq count (+ count 1))
- (let* ((def (if (listp this) (car this) (list this "")))
- (files (if (listp this) (cdr this) nil))
- (master (nth 0 def))
- (name (nth 1 def))
- (nm (concat (filesets-get-shortcut (if (or (not other-count)
files)
- count other-count))
- (if (or (null name) (equal name ""))
- ""
- (format "%s: " name))
- (file-name-nondirectory master))))
- (setq rv
- (append rv
- (if files
- `((,nm
- [,(concat "Inclusion Group: "
- (file-name-nondirectory master))
- (filesets-open ':ingroup ',master ',fsn)]
- "---"
- [,master (filesets-file-open nil ',master ',fsn)]
- "---"
- ,@(let ((count 0))
- (mapcar
- (lambda (this)
- (setq count (+ count 1))
- (let ((ff
(filesets-ingroup-collect-build-menu
- fs (list this) count)))
- (if (= (length ff) 1)
- (car ff)
- ff)))
- files))
- ,@(filesets-get-menu-epilog master ':ingroup
fsn)))
- `([,nm (filesets-file-open nil ',master
',fsn)])))))))))
+ (fsn fs))
+ (mapcan (lambda (this)
+ (setq count (+ count 1))
+ (let* ((def (if (listp this) (car this) (list this "")))
+ (files (if (listp this) (cdr this) nil))
+ (master (nth 0 def))
+ (name (nth 1 def))
+ (nm (concat (filesets-get-shortcut
+ (if (or (not other-count) files)
+ count other-count))
+ (if (or (null name) (equal name ""))
+ ""
+ (format "%s: " name))
+ (file-name-nondirectory master))))
+ (if files
+ `((,nm
+ [,(concat "Inclusion Group: "
+ (file-name-nondirectory master))
+ (filesets-open ':ingroup ',master ',fsn)]
+ "---"
+ [,master (filesets-file-open nil ',master ',fsn)]
+ "---"
+ ,@(let ((count 0))
+ (mapcar
+ (lambda (this)
+ (setq count (+ count 1))
+ (let ((ff (filesets-ingroup-collect-build-menu
+ fs (list this) count)))
+ (if (= (length ff) 1)
+ (car ff)
+ ff)))
+ files))
+ ,@(filesets-get-menu-epilog master ':ingroup fsn)))
+ `([,nm (filesets-file-open nil ',master ',fsn)]))))
+ flist))))
(defun filesets-ingroup-collect (fs remdupl-flag master)
"Collect names of included files and build submenu."
@@ -2275,7 +2226,7 @@ Construct a shortcut from COUNT."
(:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
- (pattname (apply 'concat (cons "Pattern: " dirpatt)))
+ (pattname (apply #'concat (cons "Pattern: " dirpatt)))
(count 0))
;;(filesets-message 3 "Filesets: scanning %S" pattname)
`([,pattname
@@ -2418,14 +2369,14 @@ fileset thinks this is necessary or not."
(dolist (this filesets-menu-cache-contents)
(if (get this 'custom-type)
(progn
- (insert (format "(setq-default %s '%S)" this (eval this)))
+ (insert (format "(setq-default %s '%S)" this (eval this t)))
(when filesets-menu-ensure-use-cached
(newline)
(insert (format "(setq %s (cons '%s %s))"
'filesets-ignore-next-set-default
this
'filesets-ignore-next-set-default))))
- (insert (format "(setq %s '%S)" this (eval this))))
+ (insert (format "(setq %s '%S)" this (eval this t))))
(newline 2))
(insert (format "(setq filesets-cache-version %S)" filesets-version))
(newline 2)
@@ -2526,9 +2477,9 @@ We apologize for the inconvenience.")))
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
(add-hook 'menu-bar-update-hook #'filesets-build-menu-maybe)
- (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
- (add-hook 'first-change-hook (function filesets-reset-filename-on-change))
- (add-hook 'kill-emacs-hook (function filesets-exit))
+ (add-hook 'kill-buffer-hook #'filesets-remove-from-ubl)
+ (add-hook 'first-change-hook #'filesets-reset-filename-on-change)
+ (add-hook 'kill-emacs-hook #'filesets-exit)
(if (filesets-menu-cache-file-load)
(progn
(filesets-build-menu-maybe)
@@ -2542,7 +2493,7 @@ Set up hooks, load the cache file -- if existing -- and
build the menu."
(defun filesets-error (_class &rest args)
"`error' wrapper."
(declare (obsolete error "28.1"))
- (error "%s" (mapconcat 'identity args " ")))
+ (error "%s" (mapconcat #'identity args " ")))
(provide 'filesets)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 80e2647: * lisp/filesets.el: Use lexical-binding,
Stefan Monnier <=