diff options
Diffstat (limited to 'lisp/filesets.el')
| -rw-r--r-- | lisp/filesets.el | 477 |
1 files changed, 214 insertions, 263 deletions
diff --git a/lisp/filesets.el b/lisp/filesets.el index 7c01b15b345..661a93edf19 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) |