* 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.
This commit is contained in:
parent
57e872ac75
commit
80e2647220
1 changed files with 214 additions and 263 deletions
477
lisp/filesets.el
477
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)
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue