;;; filesets.el --- handle group of files
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; Free Software Foundation, Inc.
-;; Author: Thomas Link <t.link@gmx.at>
+;; Author: Thomas Link <sanobast-emacs@yahoo.de>
+;; Maintainer: FSF
;; 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 2, 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., 675 Mass
-;; Ave, Cambridge, MA 02139, 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/>.
-(defvar filesets-version "1.8.1")
+;;; Code:
+
+(defvar filesets-version "1.8.4")
(defvar filesets-homepage
"http://members.a1.net/t.link/CompEmacsFilesets.html")
;; pattern, a base directory and a search pattern (for files), or an
;; inclusion group (i.e. a base file including other files).
-;; Usage: 1. Put (require 'filesets) into your start-up file. 2. Type
-;; M-x filesets-edit or choose "Edit Filesets" from the menu. 3. Save
-;; your customizations.
+;; Usage:
+;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
+;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
+;; 3. Save your customizations.
;; Caveat: Fileset names have to be unique.
;; 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'):
;;- better handling of different customization scenarios
+;; Data gathering should be better separated from building the menu
+;; so that one could (1) use filesets without installing the menu
+;; and (2) create new "frontends" to speedbar and others.
+
+;; The functionality to call external viewers should be isolated in
+;; an extra package and possibly integrated with the MIME
+;; handling.
;;; Credits:
;;; Some variables
-(eval-and-compile
- (defvar filesets-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
- "Non-nil means we are running XEmacs."))
(defvar filesets-menu-cache nil
"The whole filesets menu.")
(defvar filesets-updated-buffers nil
"A list of buffers with updated menu bars.")
(defvar filesets-menu-use-cached-flag nil
- "Use cached data. See `filesets-menu-ensure-use-cached' for details.")
+ "Use cached data. See `filesets-menu-ensure-use-cached' for details.")
(defvar filesets-update-cache-file-flag nil
"Non-nil means the cache needs updating.")
(defvar filesets-ignore-next-set-default nil
- "A list of custom variables for which the next `set-default' will be
-ignored.")
+ "List of custom variables for which the next `set-default' will be ignored.")
(defvar filesets-output-buffer-flag nil
"Non-nil means the current buffer is an output buffer created by filesets.
Is buffer local variable.")
(defvar filesets-verbosity 1
- "An integer defining the level of verbosity. 0 means no messages
-at all.")
+ "An integer defining the level of verbosity.
+0 means no messages at all.")
(defvar filesets-menu-ensure-use-cached
- (and filesets-running-xemacs
- (not (emacs-version>= 21 5)))
+ (and (featurep 'xemacs)
+ (if (fboundp 'emacs-version>=)
+ (not (emacs-version>= 21 5))))
"Make sure (X)Emacs uses filesets' cache.
Well, if you use XEmacs (prior to 21.5?) custom.el is loaded after
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
(when (funcall cond-fn elt)
(setq rv (append rv (list elt)))))))
+(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))
+ (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 '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 '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)
(let ((this (shell-command-to-string
(format "which --skip-alias %s 2> /dev/null | head -n 1"
cmd-list))))
- (if (equal this "")
+ (if (equal this "")
nil
(file-name-nondirectory (substring this 0 (- (length this) 1))))))
(defun filesets-which-command (cmd)
- "Calls \"which CMD\"."
+ "Call \"which CMD\"."
(shell-command-to-string (format "which %s" cmd)))
(defun filesets-which-command-p (cmd)
- "Calls \"which CMD\" and returns non-nil if the command was found."
+ "Call \"which CMD\" and return non-nil if the command was found."
(when (string-match (format "\\(/[^/]+\\)?/%s" cmd)
(filesets-which-command cmd))
cmd))
; (customize-set-variable var val))
; (filesets-build-menu))
+;; It seems this is a workaround for the XEmacs issue described in the
+;; doc-string of filesets-menu-ensure-use-cached. Under Emacs this is
+;; essentially just `set-default'.
(defun filesets-set-default (sym val &optional init-flag)
- "Set-default wrapper function used in conjunction with `defcustom'."
+ "Set-default wrapper function used in conjunction with `defcustom'.
+If SYM is in the list `filesets-ignore-next-set-default', delete
+it from that list, and return nil. Otherwise, set the value of
+SYM to VAL and return t. If INIT-FLAG is non-nil, set with
+`custom-initialize-set', otherwise with `set-default'."
(let ((ignore-flag (member sym filesets-ignore-next-set-default)))
(if ignore-flag
(setq filesets-ignore-next-set-default
(setq filesets-has-changed-flag t)))
; (filesets-reset-fileset nil t)))
+(defvar filesets-data)
+
(defun filesets-data-set-default (sym val)
"Set the default for `filesets-data'."
(if filesets-menu-use-cached-flag
(dolist (x modified-filesets)
(filesets-reset-fileset (car x))))))
(filesets-set-default sym val))
-
-
-
+\f
;;; configuration
(defgroup filesets nil
"The fileset swapper."
:prefix "filesets-"
- :group 'convenience)
+ :group 'convenience
+ :version "22.1")
(defcustom filesets-menu-name "Filesets"
- "*Filesets' menu name."
+ "Filesets' menu name."
:set (function filesets-set-default)
- :type 'sexp
+ :type 'string
+ :group 'filesets)
+
+(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 '(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 `add-submenu' for documentation."
+ :set (function filesets-set-default)
+ :type '(choice (string :tag "Name")
+ (const :tag "Last" nil))
+ :version "23.1" ; was "File"
:group 'filesets)
-(when filesets-running-xemacs
- (defcustom filesets-menu-path nil
- "*The menu under which the filesets menu should be inserted.
-XEmacs specific; see `add-submenu' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets)
-
- (defcustom filesets-menu-before "File"
- "*The name of a menu before which this menu should be added.
-XEmacs specific; see `add-submenu' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets)
-
- (defcustom filesets-menu-in-menu nil
- "*Use that instead of `current-menubar' as the menu to change.
-XEmacs specific; see `add-submenu' for documentation."
- :set (function filesets-set-default)
- :type 'sexp
- :group 'filesets))
+(defcustom filesets-menu-in-menu nil
+ "Use that instead of `current-menubar' as the menu to change.
+See `add-submenu' for documentation."
+ :set (function filesets-set-default)
+ :type 'sexp
+ :group 'filesets)
(defcustom filesets-menu-shortcuts-flag t
- "*Non-nil means to prepend menus with hopefully unique shortcuts."
+ "Non-nil means to prepend menus with hopefully unique shortcuts."
:set (function filesets-set-default!)
:type 'boolean
:group 'filesets)
(defcustom filesets-menu-shortcuts-marker "%_"
- "*String for marking menu shortcuts."
+ "String for marking menu shortcuts."
:set (function filesets-set-default!)
:type 'string
:group 'filesets)
-;(defcustom filesets-menu-cnvfp-flag nil
-; "*Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
-; :set (function filesets-set-default!)
-; :type 'boolean
-; :group 'filesets)
+;;(defcustom filesets-menu-cnvfp-flag nil
+;; "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 filesets-running-xemacs
- "~/.xemacs/filesets-cache.el"
- "~/.filesets-cache.el")
- "*File to be used for saving the filesets menu between sessions.
+ (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'."
:set (function filesets-set-default)
(defcustom filesets-menu-cache-contents
'(filesets-be-docile-flag
filesets-submenus
- filesets-menu-cache
+ filesets-menu-cache
filesets-ingroup-cache)
- "*Stuff we want to save in `filesets-menu-cache-file'.
+ "Stuff we want to save in `filesets-menu-cache-file'.
Possible uses: don't save configuration data in the main startup files
but in filesets's own cache. In this case add `filesets-data' to this
list.
-There is a second reason for putting `filesets-data' on this list. If
+There is a second reason for putting `filesets-data' on this list. If
you frequently add and remove buffers on the fly to :files filesets, you
don't need to save your customizations if `filesets-data' is being
-mirrored in the cache file. In this case the version in the cache file
+mirrored in the cache file. In this case the version in the cache file
is the current one, and the version in your startup file will be
silently updated later on.
:group 'filesets)
(defcustom filesets-cache-fill-content-hooks nil
- "*Hooks to run when writing the contents of filesets' cache file.
+ "Hooks to 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-cache-hostname-flag nil
- "*Non-nil means cache the hostname.
+ "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)
:group 'filesets)
(defcustom filesets-cache-save-often-flag nil
- "*Non-nil means save buffer on every change of the filesets menu.
+ "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
+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)
(defcustom filesets-max-submenu-length 25
- "*Maximum length of submenus.
+ "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)
:group 'filesets)
(defcustom filesets-max-entry-length 50
- "*Truncate names of splitted submenus to this length."
+ "Truncate names of splitted submenus to this length."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
(defcustom filesets-browse-dir-function 'dired
- "*A function or command used for browsing directories.
+ "A function or command used for browsing directories.
When using an external command, \"%s\" will be replaced with the
directory's name.
:group 'filesets)
(defcustom filesets-open-file-function 'filesets-find-or-display-file
- "*The function used for opening files.
+ "The function used for opening files.
`filesets-find-or-display-file' ... Filesets' default function for
visiting files. This function checks if an external viewer is defined
`find-file' will be used to visit a file.
`filesets-find-file' ... An alternative function that always uses
-`find-file'. If `filesets-be-docile-flag' is true, a file, which isn't
+`find-file'. If `filesets-be-docile-flag' is true, a file, which isn't
readable, will not be opened.
Caveat: Changes will take effect only after rebuilding the menu."
:group 'filesets)
(defcustom filesets-save-buffer-function 'save-buffer
- "*The function used to save a buffer.
+ "The function used to save a buffer.
Caveat: Changes will take effect after rebuilding the menu."
:set (function filesets-set-default)
:type '(choice :tag "Function:"
:group 'filesets)
(defcustom filesets-find-file-delay
- (if (and filesets-running-xemacs gutter-buffers-tab-visible-p)
+ (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
0.5
0)
- "*Delay before calling find-file.
+ "Delay before calling `find-file'.
This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.
:group 'filesets)
(defcustom filesets-be-docile-flag nil
- "*Non-nil means don't complain if a file or a directory doesn't exist.
+ "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)
:group 'filesets)
(defcustom filesets-sort-menu-flag t
- "*Non-nil means sort the filesets menu alphabetically."
+ "Non-nil means sort the filesets menu alphabetically."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
(defcustom filesets-sort-case-sensitive-flag t
- "*Non-nil means sorting of the filesete menu is case sensitive."
+ "Non-nil means sorting of the filesets menu is case sensitive."
:set (function filesets-set-default)
:type 'boolean
:group 'filesets)
(defcustom filesets-tree-max-level 3
- "*Maximum scan depth for directory trees.
+ "Maximum scan depth for directory trees.
A :tree fileset is defined by a base directory the contents of which
will be recursively added to the menu. `filesets-tree-max-level' tells up
to which level the directory structure should be scanned/listed,
: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>>"))
("Run Shell Command"
filesets-cmd-shell-command
(filesets-cmd-shell-command-getargs)))
- "*Commands to run on filesets.
+ "Commands to run on filesets.
An association list of names, functions, and an argument list (or a
function that returns one) to be run on a filesets' files.
(defcustom filesets-external-viewers
(let
-; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
-; (filesets-select-command "ggv gv")))
-; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
-; (filesets-select-command "xpdf acroread")))
-; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
-; (filesets-select-command "xdvi tkdvi")))
-; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
-; (filesets-select-command "antiword")))
-; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
-; (filesets-select-command "gqview ee display"))))
+ ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
+ ;; (filesets-select-command "ggv gv")))
+ ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
+ ;; (filesets-select-command "xpdf acroread")))
+ ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
+ ;; (filesets-select-command "xdvi tkdvi")))
+ ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
+ ;; (filesets-select-command "antiword")))
+ ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
+ ;; (filesets-select-command "gqview ee display"))))
((ps-cmd "ggv")
(pdf-cmd "xpdf")
(dvi-cmd "xdvi")
((:ignore-on-open-all t)
(:ignore-on-read-text t)
(:constraint-flag ,pic-cmd)))))
- "*Association list of file patterns and external viewers for use with
+ "Association list of file patterns and external viewers for use with
`filesets-find-or-display-file'.
Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a
function or a command name as string.
-Properties is an association list determining filesets' behaviour in
-several conditions. Choose one from this list:
+Properties is an association list determining filesets' behavior in
+several conditions. Choose one from this list:
:ignore-on-open-all ... Don't open files of this type automatically --
i.e. on open-all-files-events or when running commands
:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
-:constraint-flag SYMBOL ... use this viewer only if SYMBOL is 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
In order to view pdf or rtf files in an Emacs buffer, you could use these:
- \(\"^.+\\.pdf$\" \"pdftotext\"
+ \(\"^.+\\\\.pdf\\\\'\" \"pdftotext\"
\((:capture-output t)
\(:args (\"%S - | fmt -w \" window-width))
\(:ignore-on-read-text t)
\(:constraintp (lambda ()
\(and \(filesets-which-command-p \"pdftotext\")
\(filesets-which-command-p \"fmt\"))))))
- \(\"^.+\\.rtf$\" \"rtf2htm\"
+ \(\"^.+\\\\.rtf\\\\'\" \"rtf2htm\"
\((:capture-output t)
\(:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
\(:ignore-on-read-text t)
\(:constraintp (lambda ()
\(and (filesets-which-command-p \"rtf2htm\")
- \(filesets-which-command-p \"w3m\"))))))
-"
+ \(filesets-which-command-p \"w3m\"))))))"
:set (function filesets-set-default)
:type '(repeat :tag "Viewer"
(list :tag "Definition"
:value (:constraint-flag)
(const :format ""
:value :constraint-flag)
- (symbol :tag "Symbol"))
+ (sexp :tag "Symbol"))
(list :tag ":ignore-on-open-all"
:value (:ignore-on-open-all t)
(const :format ""
(:get-file-name (lambda (master file)
(filesets-which-file master
(concat file ".sty")
- (filesets-convert-path-list
+ (filesets-convert-path-list
(or (getenv "MY_TEXINPUTS")
(getenv "TEXINPUTS")))))))
((:name "Include")
(:get-file-name (lambda (master file)
(filesets-which-file master
(concat file ".tex")
- (filesets-convert-path-list
+ (filesets-convert-path-list
(or (getenv "MY_TEXINPUTS")
(getenv "TEXINPUTS"))))))
(:scan-depth 5))
(:get-file-name (lambda (master file)
(filesets-which-file master
(concat file ".tex")
- (filesets-convert-path-list
+ (filesets-convert-path-list
(or (getenv "MY_TEXINPUTS")
(getenv "TEXINPUTS"))))))
(:scan-depth 5))
(:get-file-name (lambda (master file)
(filesets-which-file master
(concat file ".bib")
- (filesets-convert-path-list
+ (filesets-convert-path-list
(or (getenv "MY_BIBINPUTS")
(getenv "BIBINPUTS")))))))))
("^.+\\.el$" t
emacs-wiki-directories
nil))))))))
- "*Inclusion group definitions.
+ "Inclusion group definitions.
Define how to find included file according to a file's mode (being
defined by a file pattern).
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.
First, a stub is a file that shows up in the menu but will not be
included in an ingroup's file listing -- i.e. filesets will never
-operate on this file automatically. Secondly, in opposition to normal
-files stubs are not scanned for new inclusion groups. This is useful if
+operate on this file automatically. Secondly, in opposition to normal
+files stubs are not scanned for new inclusion groups. This is useful if
you want to have quick access to library headers.
In the menu, an asterisk is appended to the stub's name.
:group 'filesets)
(put 'filesets-ingroup-patterns 'risky-local-variable t)
-(defcustom filesets-data
- nil
- "*Fileset definitions.
+(defcustom filesets-data nil
+ "Fileset definitions.
A fileset is either a list of files, a file pattern, a base directory
and a search pattern (for files), or a base file. Changes to this
: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.
(defcustom filesets-query-user-limit 15
- "*Query the user before opening a fileset with that many files."
+ "Query the user before opening a fileset with that many files."
:set (function filesets-set-default)
:type 'integer
:group 'filesets)
-
-
+\f
;;; Emacs compatibility
(eval-and-compile
- (if filesets-running-xemacs
- (progn
- (fset 'filesets-error 'error)
- (fset 'filesets-add-submenu 'add-submenu))
+ (if (featurep 'xemacs)
+ (fset 'filesets-error 'error)
(require 'easymenu)
-
+
(defun filesets-error (class &rest args)
"`error' wrapper."
- (error (mapconcat 'identity args " ")))
-
- ;; This should work for 21.1 Emacs
- (defun filesets-add-submenu (menu-path submenu &optional
- before in-menu)
- "`easy-menu-define' wrapper."
- (easy-menu-define
- filesets-submenu global-map "Filesets menu" submenu))
+ (error "%s" (mapconcat 'identity args " ")))
+
))
(defun filesets-filter-dir-names (lst &optional negative)
- "Remove non-directory names from a list of strings. If NEGATIVE is
-non-nil, remove all directory names."
+ "Remove non-directory names from a list of strings.
+If NEGATIVE is non-nil, remove all directory names."
(filesets-filter-list lst
(lambda (x)
(and (not (string-match "^\\.+/$" x))
(not (string-match "[:/\\]$" x))
(string-match "[:/\\]$" x))))))
-(defun filesets-conditional-sort (lst &optional access-fn simply-do-it)
+(defun filesets-conditional-sort (lst &optional access-fn)
"Return a sorted copy of LST, LST being a list of strings.
If `filesets-sort-menu-flag' is nil, return LST itself.
-ACCESS-FN ... function to get the string value of LST's elements.
-
-If SIMPLY-DO-IT is non-nil, the list is sorted regardless of
-`filesets-sort-menu-flag'."
+ACCESS-FN ... function to get the string value of LST's elements."
(if filesets-sort-menu-flag
(let* ((fni (or access-fn
(function identity)))
(lambda (a b)
(string< (upcase (funcall fni a))
(upcase (funcall fni b)))))))
- (sort (copy-list lst) fn))
+ (sort (copy-sequence lst) fn))
lst))
(defun filesets-directory-files (dir &optional
pattern what full-flag match-dirs-flag)
- "Get WHAT (:files or :dirs) in DIR. If PATTERN is provided return only
-those entries matching this regular expression. If MATCH-DIRS-FLAG is
-non-nil, also match directory entries. Return full path if FULL-FLAG is
-non-nil."
+ "Get WHAT (:files or :dirs) in DIR.
+If PATTERN is provided return only those entries matching this
+regular expression.
+If MATCH-DIRS-FLAG is non-nil, also match directory entries.
+Return full path if FULL-FLAG is non-nil."
(filesets-message 2 "Filesets: scanning %S" dir)
(cond
((file-exists-p dir)
(let ((files nil)
(dirs nil))
(dolist (this (file-name-all-completions "" dir))
- (cond
+ (cond
((string-match "^\\.+/$" this)
nil)
((string-match "[:/\\]$" this)
(when (or (not match-dirs-flag)
(not pattern)
(string-match pattern this))
- (filesets-message 5 "Filesets: matched dir %S with pattern %S"
+ (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))
- (filesets-message 5 "Filesets: matched file %S with pattern %S"
+ (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)
filename)))
(if (file-exists-p f)
f
- (some (lambda (dir)
- (let ((dir (file-name-as-directory dir))
- (files (if (file-exists-p dir)
- (filesets-directory-files dir nil ':files)
- nil)))
- (some (lambda (file)
- (if (equal filename (file-name-nondirectory file))
- (concat dir file)
- nil))
- files)))
- path-list))))
+ (filesets-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)))
+ path-list))))
(defun filesets-eviewer-get-props (entry)
(defun filesets-get-external-viewer (file)
"Find an external viewer for FILE."
(let ((filename (file-name-nondirectory file)))
- (some
+ (filesets-some
(lambda (entry)
(when (and (string-match (nth 0 entry) filename)
(filesets-eviewer-constraint-p entry))
(defun filesets-get-external-viewer-by-name (name)
"Get the external viewer definition called NAME."
(when name
- (some
+ (filesets-some
(lambda (entry)
(when (and (string-equal (nth 1 entry) name)
(filesets-eviewer-constraint-p entry))
filesets-external-viewers)))
(defun filesets-filetype-property (filename event &optional entry)
- "Returns non-nil if a file of a specific type has special flags/tags.
+ "Return non-nil if a file of a specific type has special flags/tags.
Events (corresponding tag):
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)))))
nil t)))
(defun filesets-filetype-get-prop (property filename &optional entry)
- "Returns PROPERTY for filename -- use ENTRY if provided."
+ "Return PROPERTY for filename -- use ENTRY if provided."
(let ((def (filesets-eviewer-get-props
(or entry
(filesets-get-external-viewer filename)))))
(when def
(filesets-alist-get def property nil t))))
-
+
(defun filesets-reset-filename-on-change ()
"Reset a buffer's filename if the buffer is being modified."
(when filesets-output-buffer-flag
(run-hooks 'oh))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
- (beginning-of-buffer))
+ (goto-char (point-min)))
(when oh
(run-hooks 'oh))))
(filesets-error 'error
(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."
+ "Visit FILE using an external VIEWER or open it in an Emacs buffer."
(interactive)
(let* ((file (or file
(read-file-name "Find file: " nil nil viewer)))
name args)))))
(defun filesets-get-fileset-name (something)
- "Get SOMETHING's name. (Don't ask.)"
+ "Get SOMETHING's name (Don't ask)."
(cond
((listp something)
(car something))
something)))
(defun filesets-data-get-name (entry)
- "Access to `filesets-data'. Get the entry's name"
+ "Access to `filesets-data'. Get the ENTRY's name."
(car entry))
(defun filesets-data-get-data (entry)
- "Access to `filesets-data'. Get the entry's data section"
+ "Access to `filesets-data'. Get the ENTRY's data section."
(cdr entry))
(defun filesets-alist-get (alist key &optional default carp)
"Get KEY's value in the association list ALIST.
Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
- (let* ((elt (assoc key alist)))
+ (let ((elt (assoc key alist)))
(cond
- (elt
- (if carp
- (cadr elt)
- (cdr elt)))
- (default default)
- (t nil))))
+ (elt
+ (if carp
+ (cadr elt)
+ (cdr elt)))
+ (default default)
+ (t nil))))
(defun filesets-data-get (entry key &optional default carp)
"Extract the value for KEY in the data part of fileset ENTRY.
(filesets-alist-get (filesets-data-get-data entry) key default carp))
(defun filesets-data-set (entry key value)
- "Set the value for KEY in the data part of fileset ENTRY."
+ "Set the VALUE for KEY in the data part of fileset ENTRY."
(let* ((alist (filesets-data-get-data entry))
(elt (assoc key alist)))
(if elt
"Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
See `filesets-data'."
(let ((data (filesets-data-get-data entry)))
- (some (lambda (x)
- (if (assoc x data)
- x))
- '(:files :tree :pattern :ingroup :file))))
+ (filesets-some
+ (lambda (x)
+ (if (assoc x data)
+ x))
+ '(:files :tree :pattern :ingroup :file))))
(defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)
"Get the open-function for FILESET-NAME.
(filesets-data-get entry ':ingroup nil t))
(defun filesets-file-open (open-function file-name &optional fileset-name)
- "Open FILE-NAME using OPEN-FUNCTION. If OPEN-FUNCTION is nil, it's
-value will be deduced from FILESET-NAME"
+ "Open FILE-NAME using OPEN-FUNCTION.
+If OPEN-FUNCTION is nil, its value will be deduced from FILESET-NAME."
(let ((open-function (or open-function
(filesets-entry-get-open-fn fileset-name))))
(if (file-readable-p file-name)
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))
(cond
((and (symbolp this) (fboundp this))
(let ((x (funcall this)))
- (setq rv (append rv (if (listp x) x (list x))))))
+ (setq rv (append rv (if (listp x) x (list x))))))
(t
(setq rv (append rv (list this))))))))
(defun filesets-cmd-show-result (cmd output)
"Show OUTPUT of CMD (a shell command)."
(pop-to-buffer "*Filesets: Shell Command Output*")
- (end-of-buffer)
+ (with-no-warnings
+ (end-of-buffer))
(insert "*** ")
(insert cmd)
(newline)
(newline))
(defun filesets-run-cmd--repl-fn (arg &optional format-fn)
- "Helper function for `filesets-run-cmd'. Apply FORMAT-FN to arg.
+ "Helper function for `filesets-run-cmd'. Apply FORMAT-FN to arg.
Replace <file-name> or <<file-name>> with filename."
(funcall format-fn (cond
((equal arg "<file-name>")
(buffer-file-name))
((equal arg "<<file-name>>")
- (filesets-quote (buffer-file-name)))
+ (shell-quote-argument (buffer-file-name)))
(t
arg))))
(or (equal mode ':ingroup)
(equal mode ':tree)))
(filesets-get-filelist fileset mode event)
- (filesets-get-filelist
+ (filesets-get-filelist
(filesets-get-fileset-from-name name)
mode event))))
(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
- (beginning-of-buffer)
- (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."
filesets-commands)))
-;;; sampe commands
+;;; sample commands
(defun filesets-cmd-query-replace-getargs ()
- "Get arguments for `filesets-cmd-query-replace'."
- (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)))
+ "Get arguments for `query-replace' and `query-replace-regexp'."
+ (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'."
ok)
t)))
(when ok
- (let ((cmd (format txt (buffer-file-name))))
+ (let ((cmd (format txt (shell-quote-argument (buffer-file-name)))))
(message "Filesets: %s" cmd)
(filesets-cmd-show-result cmd
(shell-command-to-string cmd))))))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(defun filesets-add-buffer (&optional name buffer)
- "Add BUFFER (or current-buffer) to the fileset called NAME.
+ "Add BUFFER (or current buffer) to the fileset called NAME.
User will be queried, if no fileset name is provided."
(interactive)
(let* ((buffer (or buffer
(name (or name
(completing-read
(format "Add '%s' to fileset: " buffer)
- filesets-data nil t)))
- (entry (assoc name filesets-data)))
+ filesets-data nil)))
+ (entry (or (assoc name filesets-data)
+ (when (y-or-n-p
+ (format "Fileset %s does not exist. Create it? "
+ name))
+ (progn
+ (add-to-list 'filesets-data (list name '(:files)))
+ (message
+ "Fileset %s created. Call `M-x filesets-save-config' to save."
+ name)
+ (car filesets-data))))))
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (member* this files :test 'filesets-files-equalp)))
+ (inlist (filesets-member this files
+ :test 'filesets-files-equalp)))
(cond
(inlist
(message "Filesets: '%s' is already in '%s'" this name))
- ((and (equal (filesets-entry-mode entry) ':files)
+ ((and (equal (filesets-entry-mode entry) ':files)
this)
(filesets-entry-set-files entry (cons this files) t)
(filesets-set-config name 'filesets-data filesets-data))
(message "Filesets: Can't add '%s' to fileset '%s'" this name)))))))
(defun filesets-remove-buffer (&optional name buffer)
- "Remove BUFFER (or current-buffer) to fileset NAME.
+ "Remove BUFFER (or current buffer) to fileset NAME.
User will be queried, if no fileset name is provided."
(interactive)
(let* ((buffer (or buffer
(if entry
(let* ((files (filesets-entry-get-files entry))
(this (buffer-file-name buffer))
- (inlist (member* this files :test 'filesets-files-equalp)))
+ (inlist (filesets-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)))))
(browse-url filesets-homepage))
(defun filesets-remake-shortcut (count submenu)
- "Remake a submenus shortcut when wrapping long menus."
+ "Remake a submenu's shortcut when wrapping long menus."
(let* ((name (concat (filesets-get-shortcut count)
(substring (elt submenu 0) 2))))
(if (listp submenu)
(if (null (cdr x))
""
", "))))
- (setq rv
+ (setq rv
(concat
rv
(if filesets-menu-shortcuts-flag
(and (stringp a)
(stringp b)
(string-match a b))))))
- (some (lambda (x)
- (if (funcall fn (car x) masterfile)
- (nth pos x)
- nil))
- filesets-ingroup-patterns)))
+ (filesets-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."
"Access to `filesets-ingroup-patterns'. Extract remove-duplicates-flag."
(filesets-ingroup-get-data master 1))
-(defun filesets-ingroup-collect-finder (patt case-sencitivep)
+(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-sencitivep))
+ (setq case-fold-search (not case-sensitivep))
(re-search-forward patt nil t))))
(setq case-fold-search cfs)
rv))
(lax-plist-put filesets-ingroup-cache emaster this))))
(defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth)
- "Helper function for `filesets-ingroup-collect'. Collect file names."
+ "Helper function for `filesets-ingroup-collect'. Collect file names."
(let* ((master (or master
(filesets-entry-get-master fs)))
(remdupl-flag (or remdupl-flag
(when (and f
(not (member f flist))
(or (not remdupl-flag)
- (not (member*
+ (not (filesets-member
f filesets-ingroup-files
:test 'filesets-files-equalp))))
(let ((no-stub-flag
(filesets-message 2 "Filesets: no patterns defined for %S" master)))))
(defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
- "Helper function for `filesets-ingroup-collect'. Build the menu.
-FS is a fileset's name. FLIST is a list returned by
+ "Helper function for `filesets-ingroup-collect'. Build the menu.
+FS is a fileset's name. FLIST is a list returned by
`filesets-ingroup-collect-files'."
(if (null flist)
nil
(append rv
(if files
`((,nm
- [,(concat "Inclusion Group: "
+ [,(concat "Inclusion Group: "
(file-name-nondirectory master))
(filesets-open ':ingroup ',master ',fsn)]
"---"
(mapcar
(lambda (this)
(setq count (+ count 1))
- (let ((ff (filesets-ingroup-collect-build-menu
+ (let ((ff (filesets-ingroup-collect-build-menu
fs (list this) count)))
(if (= (length ff) 1)
(car ff)
,@(filesets-get-menu-epilog master ':ingroup fsn)))
`([,nm (filesets-file-open nil ',master ',fsn)])))))))))
-(defun filesets-ingroup-collect (fs remdupl-flag master &optional depth)
- "Collect names of included files & build submenu."
+(defun filesets-ingroup-collect (fs remdupl-flag master)
+ "Collect names of included files and build submenu."
(filesets-ingroup-cache-put master nil)
(filesets-message 2 "Filesets: parsing %S" master)
(filesets-ingroup-collect-build-menu
(let* ((x (file-name-as-directory x))
(xx (concat dir x))
(dd (filesets-build-dir-submenu-now
- (+ level 1) depth entry
+ (+ level 1) depth entry
lookup-name xx patt fd))
(nm (concat (filesets-get-shortcut count)
x)))
(append
dirsmenu
filesmenu))
- (filesets-get-menu-epilog `(,dir ,patt) ':tree
+ (filesets-get-menu-epilog `(,dir ,patt) ':tree
lookup-name rebuild-flag)))
nil))
lookup-name t)))))))))))
(defun filesets-remove-from-ubl (&optional buffer)
- "BUFFER or current-buffer require update of the filesets menu."
+ "BUFFER or current buffer require update of the filesets menu."
(let ((b (or buffer
(current-buffer))))
(if (member b filesets-updated-buffers)
(filesets-menu-cache-file-save-maybe)))
(let ((cb (current-buffer)))
(when (not (member cb filesets-updated-buffers))
- (filesets-add-submenu
+ (add-submenu
filesets-menu-path
`(,filesets-menu-name
("# Filesets"
filesets-menu-in-menu)
(setq filesets-updated-buffers
(cons cb filesets-updated-buffers))
- (message nil)
+ ;; This wipes out other messages in the echo area.
+ ;; (message nil)
;;(message "Filesets updated: %s" cb)
)))
(with-temp-buffer
(dolist (this filesets-menu-cache-contents)
(if (get this 'custom-type)
- (progn
+ (progn
(insert (format "(setq-default %s '%S)" this (eval this)))
(when filesets-menu-ensure-use-cached
(newline)
\(\"Test\" (:pattern \"~/dir/^pattern$\"))
--> \(\"Test\" (:pattern \"~/dir/\" \"^pattern$\"))
-2. `filesets-data': Change all occurances of \":document\" to \":ingroup\":
+2. `filesets-data': Change all occurrences of \":document\" to \":ingroup\":
\(\(\"Test\" \(:document \"~/dir/file\"))
--> \(\(\"Test\" \(:ingroup \"~/dir/file\"))
(find-file-other-window cf))
(filesets-error 'error msg))))
-(defun filesets-update (version cached-version)
+(defun filesets-update (cached-version)
"Do some cleanup after updating filesets.el."
(cond
((or (not cached-version)
(progn
(setq filesets-update-cache-file-flag nil)
t)
- (filesets-update filesets-version filesets-cache-version)))
+ (filesets-update filesets-cache-version)))
(t
(setq filesets-update-cache-file-flag t)
nil)))
(defun filesets-exit ()
(filesets-menu-cache-file-save-maybe))
+;;;###autoload
(defun filesets-init ()
"Filesets initialization.
Set up hooks, load the cache file -- if existing -- and build the menu."
- (add-hook (if filesets-running-xemacs 'activate-menubar-hook 'menu-bar-update-hook)
+ (add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook)
(function 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))
(filesets-build-menu)))
-;;; run
-(filesets-init)
-
(provide 'filesets)
-;;; Local Variables:
-;;; time-stamp-format:"%:y-%02m-%02d"
-;;; sentence-end-double-space:t
-;;; End:
+;; Local Variables:
+;; sentence-end-double-space:t
+;; End:
;;; filesets.el ends here
HCoop / bpt / emacs.git / blobdiff