-;;; filesets.el --- handle group of files
+;;; filesets.el --- handle group of files -*- coding: utf-8 -*-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
-;; Author: Thomas Link <t.link@gmx.at>
-;; Maintainer: FSF
+;; Author: Thomas Link <sanobast-emacs@yahoo.de>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: filesets convenience
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;; A copy of the GNU General Public License can be obtained from this
-;; program's author or from the Free Software Foundation, Inc.,
-;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
(defvar filesets-version "1.8.4")
(defvar filesets-homepage
;; inclusion group (i.e. a base file including other files).
;; Usage:
-;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
+;; 1. Put (require 'filesets) and (filesets-init) in your init file.
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
;; programs. See `filesets-external-viewers'.
;; BTW, if you close a fileset, files, which have been changed, will
-;; be silently saved. Change this behaviour by setting
+;; be silently saved. Change this behavior by setting
;; `filesets-save-buffer-fn'.
;;; Supported modes for inclusion groups (`filesets-ingroup-patterns'):
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl-lib))
;;; Some variables
So, when should you think about setting this value to t? If filesets.el
is loaded before user customizations. Thus, if (require 'filesets)
-precedes the custom-set-variables command or, for XEmacs, if init.el is
-loaded before custom.el, set this variable to t.")
+precedes the `custom-set-variables' command or, for XEmacs, if init.el
+is loaded before custom.el, set this variable to t.")
;;; utils
(defun filesets-filter-list (lst cond-fn)
"Remove all elements not conforming to COND-FN from list LST.
COND-FN takes one argument: the current element."
-; (remove* 'dummy lst :test (lambda (dummy elt)
+; (cl-remove 'dummy lst :test (lambda (dummy elt)
; (not (funcall cond-fn elt)))))
(let ((rv nil))
(dolist (elt lst rv)
(let ((fss-rv (funcall fss-pred fss-this)))
(when fss-rv
(throw 'exit fss-rv))))))
-;(fset 'filesets-some 'some) ;; or use the cl function
+;(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.
(filesets-ormap (lambda (fsm-this)
(funcall fsm-test fsm-item fsm-this))
fsm-lst)))
-;(fset 'filesets-member 'member*) ;; or use the cl function
+;(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."
(defun filesets-which-command-p (cmd)
"Call \"which CMD\" and return non-nil if the command was found."
- (when (string-match (format "\\(/[^/]+\\)?/%s" cmd)
- (filesets-which-command cmd))
+ (when (string-match-p (format "\\(/[^/]+\\)?/%s" cmd)
+ (filesets-which-command cmd))
cmd))
(defun filesets-message (level &rest args)
(not ignore-flag)))
(defun filesets-set-default! (sym val)
- "Call `filestes-set-default' and reset cached data (i.e. rebuild menu)."
+ "Call `filesets-set-default' and reset cached data (i.e. rebuild menu)."
(when (filesets-set-default sym val)
(filesets-reset-fileset)))
(defun filesets-set-default+ (sym val)
- "Call `filestes-set-default' and reset filesets' standard menu."
+ "Call `filesets-set-default' and reset filesets' standard menu."
(when (filesets-set-default sym val)
(setq filesets-has-changed-flag t)))
; (filesets-reset-fileset nil t)))
(defcustom filesets-menu-name "Filesets"
"Filesets' menu name."
:set (function filesets-set-default)
- :type 'sexp
+ :type 'string
:group 'filesets)
-(defcustom filesets-menu-path nil
+(defcustom filesets-menu-path '("File") ; cf recentf-menu-path
"The menu under which the filesets menu should be inserted.
See `add-submenu' for documentation."
:set (function filesets-set-default)
- :type 'sexp
+ :type '(choice (const :tag "Top Level" nil)
+ (sexp :tag "Menu Path"))
+ :version "23.1" ; was nil
:group 'filesets)
-(defcustom filesets-menu-before "File"
+(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
"The name of a menu before which this menu should be added.
See `add-submenu' for documentation."
:set (function filesets-set-default)
- :type 'sexp
+ :type '(choice (string :tag "Name")
+ (const :tag "Last" nil))
+ :version "23.1" ; was "File"
:group 'filesets)
(defcustom filesets-menu-in-menu nil
:group 'filesets)
;;(defcustom filesets-menu-cnvfp-flag nil
-;; "*Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
+;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
;; :set (function filesets-set-default!)
;; :type 'boolean
;; :group 'filesets)
(defcustom filesets-menu-cache-file
- (if (featurep 'xemacs)
- "~/.xemacs/filesets-cache.el"
- (concat user-emacs-directory "filesets-cache.el"))
+ (locate-user-emacs-file "filesets-cache.el")
"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'."
(sexp :tag "Other" :value nil)))
:group 'filesets)
-(defcustom filesets-cache-fill-content-hooks nil
- "Hooks to run when writing the contents of filesets' cache file.
+(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
+ 'filesets-cache-fill-content-hook "24.3")
+(defcustom filesets-cache-fill-content-hook nil
+ "Hook run when writing the contents of filesets' cache file.
The hook is called with the cache file as current buffer and the cursor
at the last position. I.e. each hook has to make sure that the cursor is
:group 'filesets)
(defcustom filesets-max-entry-length 50
- "Truncate names of splitted submenus to this length."
+ "Truncate names of split submenus to this length."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
-Set this to 0, if you don't use XEmacs' buffer tabs."
+Set this to 0, if you don't use XEmacs's buffer tabs."
:set (function filesets-set-default)
:type 'number
:group 'filesets)
:group 'filesets)
(defcustom filesets-commands
- `(("Query Replace"
- query-replace
+ `(("Isearch"
+ multi-isearch-files
+ (filesets-cmd-isearch-getargs))
+ ("Isearch (regexp)"
+ multi-isearch-files-regexp
+ (filesets-cmd-isearch-getargs))
+ ("Query Replace"
+ perform-replace
(filesets-cmd-query-replace-getargs))
("Query Replace (regexp)"
- query-replace-regexp
- (filesets-cmd-query-replace-getargs))
+ perform-replace
+ (filesets-cmd-query-replace-regexp-getargs))
("Grep <<selection>>"
"grep"
("-n " filesets-get-quoted-selection " " "<<file-name>>"))
(:match-number 2)
(:get-file-name (lambda (master file)
(filesets-which-file master file load-path))))))
- ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
- (((:pattern "\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
+ ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
+ (((:pattern "\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
(:scan-depth 5)
(:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
(:case-sensitive t)
in the pattern holding the subfile's name. 0 refers the whole
match, 1 to the first group.
-:stubp FUNCTION ... if (FUNCTION MASTER INCLUDED-FILE) returns non-nil,
+:stubp FUNCTION ... If (FUNCTION MASTER INCLUDED-FILE) returns non-nil,
INCLUDED-FILE is a stub -- see below.
-:stub-flag ... files of this type are stubs -- see below.
+:stub-flag ... Files of this type are stubs -- see below.
:scan-depth INTEGER (default: 0) ... Whether included files should be
rescanned. Set this to 0 to disable re-scanning of included file.
:tree ROOT-DIR PATTERN ... a base directory and a file pattern
-:pattern DIR PATTERN ... PATTERN is a regular expression comprising path
-and file pattern -- e.g. 'PATH/^REGEXP$'. Note the `^' at the beginning
-of the file name pattern.
+:pattern DIR PATTERN ... a base directory and a regexp matching
+ files in that directory. Usually,
+ PATTERN has the form '^REGEXP$'. Unlike
+ :tree, this form does not descend
+ recursively into subdirectories.
:filter-dirs-flag BOOLEAN ... is only used in conjunction with :tree.
(require 'easymenu)
- (defun filesets-error (class &rest args)
+ (defun filesets-error (_class &rest args)
"`error' wrapper."
(error "%s" (mapconcat 'identity args " ")))
If NEGATIVE is non-nil, remove all directory names."
(filesets-filter-list lst
(lambda (x)
- (and (not (string-match "^\\.+/$" x))
+ (and (not (string-match-p "^\\.+/$" x))
(if negative
- (not (string-match "[:/\\]$" x))
- (string-match "[:/\\]$" x))))))
+ (not (string-match-p "[:/\\]$" x))
+ (string-match-p "[:/\\]$" x))))))
(defun filesets-conditional-sort (lst &optional access-fn)
"Return a sorted copy of LST, LST being a list of strings.
(dirs nil))
(dolist (this (file-name-all-completions "" dir))
(cond
- ((string-match "^\\.+/$" this)
+ ((string-match-p "^\\.+/$" this)
nil)
- ((string-match "[:/\\]$" this)
+ ((string-match-p "[:/\\]$" this)
(when (or (not match-dirs-flag)
(not pattern)
- (string-match pattern this))
+ (string-match-p pattern this))
(filesets-message 5 "Filesets: matched dir %S with pattern %S"
this pattern)
(setq dirs (cons this dirs))))
(t
(when (or (not pattern)
- (string-match pattern this))
+ (string-match-p pattern this))
(filesets-message 5 "Filesets: matched file %S with pattern %S"
this pattern)
(setq files (cons (if full-flag
(let ((filename (file-name-nondirectory file)))
(filesets-some
(lambda (entry)
- (when (and (string-match (nth 0 entry) filename)
+ (when (and (string-match-p (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
entry))
filesets-external-viewers)))
on-capture-output (:capture-output) ... Capture output of an external viewer
-on-ls ... not used
+on-ls ... Not used
-on-cmd ... not used
+on-cmd ... Not used
-on-close-all ... not used"
+on-close-all ... Not used"
(let ((def (filesets-eviewer-get-props
(or entry
(filesets-get-external-viewer filename)))))
(filesets-alist-get def
- (case event
- ((on-open-all) ':ignore-on-open-all)
- ((on-grep) ':ignore-on-read-text)
- ((on-cmd) nil)
- ((on-close-all) nil))
+ (pcase event
+ (`on-open-all ':ignore-on-open-all)
+ (`on-grep ':ignore-on-read-text)
+ (`on-cmd nil)
+ (`on-close-all nil))
nil t)))
(defun filesets-filetype-get-prop (property filename &optional entry)
if `buffer-modified-p' returns nil.
SAVE-FUNCTION takes no argument, but works on the current buffer."
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(if (buffer-modified-p)
(funcall save-function))
(if (not (buffer-modified-p))
(defun filesets-get-fileset-from-name (name &optional mode)
"Get fileset definition for NAME."
- (case mode
- ((:ingroup :tree)
- name)
- (t
- (assoc name filesets-data))))
+ (pcase mode
+ ((or `:ingroup `:tree) name)
+ (_ (assoc name filesets-data))))
;;; commands
(when files
(let ((fn (filesets-cmd-get-fn cmd-name))
(args (filesets-cmd-get-args cmd-name)))
- (dolist (this files nil)
- (save-excursion
- (save-restriction
- (let ((buffer (filesets-find-file this)))
- (when buffer
- (goto-char (point-min))
- (let ()
- (cond
- ((stringp fn)
- (let* ((args
- (let ((txt ""))
- (dolist (this args txt)
- (setq txt
- (concat txt
- (filesets-run-cmd--repl-fn
- this
- (lambda (this)
- (if (equal txt "") "" " ")
- (format "%s" this))))))))
- (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))))))))))))))))
+ (if (memq fn '(multi-isearch-files multi-isearch-files-regexp))
+ (apply fn args)
+ (dolist (this files nil)
+ (save-excursion
+ (save-restriction
+ (let ((buffer (filesets-find-file this)))
+ (when buffer
+ (goto-char (point-min))
+ (progn
+ (cond
+ ((stringp fn)
+ (let* ((args
+ (let ((txt ""))
+ (dolist (this args txt)
+ (setq txt
+ (concat txt
+ (filesets-run-cmd--repl-fn
+ this
+ (lambda (this)
+ (if (equal txt "") "" " ")
+ (format "%s" this))))))))
+ (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)))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
;;; sample commands
(defun filesets-cmd-query-replace-getargs ()
"Get arguments for `query-replace' and `query-replace-regexp'."
- (let* ((from-string (read-string "Filesets query replace: "
- ""
- 'query-replace-history))
- (to-string (read-string
- (format "Filesets query replace %s with: " from-string)
- ""
- 'query-replace-history))
- (delimited (y-or-n-p
- "Filesets query replace: respect word boundaries? ")))
- (list from-string to-string delimited)))
+ (let ((common (query-replace-read-args "Filesets query replace" nil t)))
+ (list (nth 0 common) (nth 1 common) t nil (nth 2 common) nil
+ multi-query-replace-map)))
+
+(defun filesets-cmd-query-replace-regexp-getargs ()
+ "Get arguments for `query-replace' and `query-replace-regexp'."
+ (let ((common (query-replace-read-args "Filesets query replace" t t)))
+ (list (nth 0 common) (nth 1 common) t t (nth 2 common) nil
+ multi-query-replace-map)))
+
+(defun filesets-cmd-isearch-getargs ()
+ "Get arguments for `multi-isearch-files' and `multi-isearch-files-regexp'."
+ (and (boundp 'files) (list files)))
(defun filesets-cmd-shell-command-getargs ()
"Get arguments for `filesets-cmd-shell-command'."
Assume MODE (see `filesets-entry-mode'), if provided."
(let* ((mode (or mode
(filesets-entry-mode entry)))
- (fl (case mode
- ((:files)
+ (fl (pcase mode
+ (:files
(filesets-entry-get-files entry))
- ((:file)
+ (:file
(list (filesets-entry-get-file entry)))
- ((:ingroup)
+ (:ingroup
(let ((entry (expand-file-name
(if (stringp entry)
entry
(filesets-entry-get-master entry)))))
(cons entry (filesets-ingroup-cache-get entry))))
- ((:tree)
+ (:tree
(let ((dir (nth 0 entry))
(patt (nth 1 entry)))
(filesets-directory-files dir patt ':files t)))
- ((:pattern)
+ (:pattern
(let ((dirpatt (filesets-entry-get-pattern entry)))
(if dirpatt
(let ((dir (filesets-entry-get-pattern--dir dirpatt))
n name)))
(dolist (this files nil)
(filesets-file-open open-function this))
- (message "Filesets: cancelled")))
+ (message "Filesets: canceled")))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(defun filesets-close (&optional mode name lookup-name)
(let* ((result nil)
(factor (ceiling (/ (float bl)
filesets-max-submenu-length))))
- (do ((data submenu-body (cdr data))
- (n 1 (+ n 1))
- (count 0 (+ count factor)))
+ (cl-do ((data submenu-body (cdr data))
+ (n 1 (+ n 1))
+ (count 0 (+ count factor)))
((or (> count bl)
(null data)))
-; (let ((sl (subseq submenu-body count
+ ;; (let ((sl (subseq submenu-body count
(let ((sl (filesets-sublist submenu-body count
(let ((x (+ count factor)))
(if (>= bl x)
`((,(concat
(filesets-get-shortcut n)
(let ((rv ""))
- (do ((x sl (cdr x)))
+ (cl-do ((x sl (cdr x)))
((null x))
(let ((y (concat (elt (car x) 0)
(if (null (cdr x))
"Get submenu epilog for SOMETHING (usually a fileset).
If mode is :tree or :ingroup, SOMETHING is some weird construct and
LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
- (case mode
- ((:tree)
+ (pcase mode
+ (:tree
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:ingroup)
+ (:ingroup
`("---"
["Close all files" (filesets-close ',mode ',something ',lookup-name)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:pattern)
+ (:pattern
`("---"
["Close all files" (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- ((:files)
+ (:files
`("---"
[,(concat "Close all files") (filesets-close ',mode ',something)]
["Run Command" (filesets-run-cmd nil ',something ',mode)]
,@(when rebuild-flag
`(["Rebuild this submenu"
(filesets-rebuild-this-submenu ',lookup-name)]))))
- (t
+ (_
(filesets-error 'error "Filesets: malformed definition of " something))))
(defun filesets-ingroup-get-data (master pos &optional fun)
(fn (or fun (lambda (a b)
(and (stringp a)
(stringp b)
- (string-match a b))))))
+ (string-match-p a b))))))
(filesets-some (lambda (x)
(if (funcall fn (car x) masterfile)
(nth pos x)
(filesets-verbosity (filesets-entry-get-verbosity entry))
(this-lookup-name (concat (filesets-get-shortcut count)
lookup-name)))
- (case mode
- ((:file)
+ (pcase mode
+ (:file
(let* ((file (filesets-entry-get-file entry)))
`[,this-lookup-name
(filesets-file-open nil ',file ',lookup-name)]))
- (t
+ (_
`(,this-lookup-name
- ,@(case mode
- ((:pattern)
+ ,@(pcase mode
+ (:pattern
(let* ((files (filesets-get-filelist entry mode 'on-ls))
(dirpatt (filesets-entry-get-pattern entry))
(pattname (apply 'concat (cons "Pattern: " dirpatt)))
files))
,@(filesets-get-menu-epilog lookup-name mode
lookup-name t))))
- ((:ingroup)
+ (:ingroup
(let* ((master (filesets-entry-get-master entry)))
;;(filesets-message 3 "Filesets: parsing %S" master)
`([,(concat "Inclusion Group: "
,@(filesets-wrap-submenu
(filesets-build-ingroup-submenu lookup-name master))
,@(filesets-get-menu-epilog master mode lookup-name t))))
- ((:tree)
+ (:tree
(let* ((dirpatt (filesets-entry-get-tree entry))
(dir (car dirpatt))
(patt (cadr dirpatt)))
(filesets-build-dir-submenu entry lookup-name dir patt)))
- ((:files)
+ (:files
(let ((files (filesets-get-filelist entry mode 'on-open-all))
(count 0))
`([,(concat "Files: " lookup-name)
(setq filesets-has-changed-flag nil)
(setq filesets-updated-buffers nil)
(setq filesets-update-cache-file-flag t)
- (do ((data (filesets-conditional-sort filesets-data (function car))
- (cdr data))
- (count 1 (+ count 1)))
+ (cl-do ((data (filesets-conditional-sort filesets-data (function car))
+ (cdr data))
+ (count 1 (+ count 1)))
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
(when filesets-cache-hostname-flag
(insert (format "(setq filesets-cache-hostname %S)" (system-name)))
(newline 2))
- (run-hooks 'filesets-cache-fill-content-hooks)
+ (run-hooks 'filesets-cache-fill-content-hook)
(write-file filesets-menu-cache-file))
(setq filesets-has-changed-flag nil)
(setq filesets-update-cache-file-flag nil)))
;; sentence-end-double-space:t
;; End:
-;; arch-tag: 2c03f85f-c3df-4cec-b0a3-b46fd5592d70
;;; filesets.el ends here
HCoop / bpt / emacs.git / blobdiff