|
44934
|
1 ;;; filesets.el --- handle group of files
|
|
|
2
|
|
100908
|
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
|
|
94678
|
4 ;; Free Software Foundation, Inc.
|
|
44934
|
5
|
|
99093
|
6 ;; Author: Thomas Link <sanobast-emacs@yahoo.de>
|
|
50782
|
7 ;; Maintainer: FSF
|
|
44934
|
8 ;; Keywords: filesets convenience
|
|
|
9
|
|
44959
|
10 ;; This file is part of GNU Emacs.
|
|
|
11
|
|
94678
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
44934
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
94678
|
14 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
15 ;; (at your option) any later version.
|
|
44934
|
16
|
|
94678
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
44934
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;; GNU General Public License for more details.
|
|
|
21
|
|
94678
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
24
|
|
|
25 ;;; Code:
|
|
44934
|
26
|
|
45164
|
27 (defvar filesets-version "1.8.4")
|
|
44934
|
28 (defvar filesets-homepage
|
|
|
29 "http://members.a1.net/t.link/CompEmacsFilesets.html")
|
|
|
30
|
|
|
31 ;;; Commentary:
|
|
|
32
|
|
44973
|
33 ;; Define filesets, which can be opened or saved with the power of one or
|
|
44959
|
34 ;; two mouse clicks only. A fileset is either a list of files, a file
|
|
|
35 ;; pattern, a base directory and a search pattern (for files), or an
|
|
|
36 ;; inclusion group (i.e. a base file including other files).
|
|
44934
|
37
|
|
50683
|
38 ;; Usage:
|
|
|
39 ;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file.
|
|
|
40 ;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
|
|
|
41 ;; 3. Save your customizations.
|
|
44934
|
42
|
|
44959
|
43 ;; Caveat: Fileset names have to be unique.
|
|
44934
|
44
|
|
44959
|
45 ;; Filesets.el adds a nifty filesets menu to your menubar. If you change
|
|
|
46 ;; your filesets on the fly, don't forget to select "Save Filesets" from
|
|
|
47 ;; the menu.
|
|
44934
|
48
|
|
44959
|
49 ;; Pressing on the first item in the submenu will open all files at once.
|
|
|
50 ;; Define your own function, e.g. browse-url, for opening a fileset's
|
|
|
51 ;; files. Or define external viewers for opening files with other
|
|
|
52 ;; programs. See `filesets-external-viewers'.
|
|
44934
|
53
|
|
44959
|
54 ;; BTW, if you close a fileset, files, which have been changed, will
|
|
96376
|
55 ;; be silently saved. Change this behavior by setting
|
|
44959
|
56 ;; `filesets-save-buffer-fn'.
|
|
44934
|
57
|
|
|
58 ;;; Supported modes for inclusion groups (`filesets-ingroup-patterns'):
|
|
|
59 ;; - Elisp
|
|
|
60 ;; - Emacs-Wiki (simple names only)
|
|
|
61 ;; - LaTeX
|
|
|
62
|
|
|
63
|
|
|
64
|
|
|
65 ;;; Known bugs:
|
|
|
66
|
|
|
67
|
|
|
68 ;;; To do:
|
|
|
69
|
|
|
70 ;;- better handling of different customization scenarios
|
|
|
71
|
|
50782
|
72 ;; Data gathering should be better separated from building the menu
|
|
|
73 ;; so that one could (1) use filesets without installing the menu
|
|
|
74 ;; and (2) create new "frontends" to speedbar and others.
|
|
|
75
|
|
|
76 ;; The functionality to call external viewers should be isolated in
|
|
|
77 ;; an extra package and possibly integrated with the MIME
|
|
|
78 ;; handling.
|
|
44934
|
79
|
|
|
80 ;;; Credits:
|
|
|
81
|
|
|
82 ;; Helpful suggestions (but no significant code) were contributed by
|
|
|
83
|
|
|
84 ;;- Christoph Conrad (at gmx de)
|
|
|
85 ;;- Christian Ohler (at Informatik Uni-Oldenburg DE)
|
|
|
86 ;;- Richard Stallman aka RMS (at gnu org)
|
|
|
87 ;;- Per Abrahamsen aka abraham (at dina kvl dk)
|
|
|
88
|
|
|
89
|
|
|
90 ;;; Code:
|
|
|
91
|
|
|
92 (eval-when-compile
|
|
|
93 (require 'cl))
|
|
|
94
|
|
|
95
|
|
|
96 ;;; Some variables
|
|
|
97
|
|
|
98 (defvar filesets-menu-cache nil
|
|
|
99 "The whole filesets menu.")
|
|
|
100 (defvar filesets-cache-version nil
|
|
|
101 "Filesets' cached version number.")
|
|
|
102 (defvar filesets-cache-hostname nil
|
|
|
103 "Filesets' cached system name.")
|
|
|
104
|
|
|
105 (defvar filesets-ingroup-cache nil
|
|
|
106 "A plist containing files and their ingroup data.")
|
|
45012
|
107 (defvar filesets-ingroup-files nil
|
|
|
108 "List of files already processed when searching for included files.")
|
|
44934
|
109
|
|
|
110 (defvar filesets-has-changed-flag t
|
|
|
111 "Non-nil means some fileset definition has changed.")
|
|
|
112 (defvar filesets-submenus nil
|
|
|
113 "An association list with filesets menu data.")
|
|
|
114 (defvar filesets-updated-buffers nil
|
|
|
115 "A list of buffers with updated menu bars.")
|
|
|
116 (defvar filesets-menu-use-cached-flag nil
|
|
84660
|
117 "Use cached data. See `filesets-menu-ensure-use-cached' for details.")
|
|
44934
|
118 (defvar filesets-update-cache-file-flag nil
|
|
|
119 "Non-nil means the cache needs updating.")
|
|
|
120 (defvar filesets-ignore-next-set-default nil
|
|
84660
|
121 "List of custom variables for which the next `set-default' will be ignored.")
|
|
44934
|
122
|
|
|
123 (defvar filesets-output-buffer-flag nil
|
|
|
124 "Non-nil means the current buffer is an output buffer created by filesets.
|
|
|
125 Is buffer local variable.")
|
|
|
126
|
|
|
127 (defvar filesets-verbosity 1
|
|
50782
|
128 "An integer defining the level of verbosity.
|
|
|
129 0 means no messages at all.")
|
|
44934
|
130
|
|
|
131 (defvar filesets-menu-ensure-use-cached
|
|
84660
|
132 (and (featurep 'xemacs)
|
|
62888
|
133 (if (fboundp 'emacs-version>=)
|
|
|
134 (not (emacs-version>= 21 5))))
|
|
44934
|
135 "Make sure (X)Emacs uses filesets' cache.
|
|
|
136
|
|
|
137 Well, if you use XEmacs (prior to 21.5?) custom.el is loaded after
|
|
|
138 init.el. This means that settings saved in the cache file (see
|
|
|
139 `filesets-menu-cache-file') will be overwritten by custom.el. In order
|
|
|
140 to ensure the use of the cache file, set this variable to t -- which is
|
|
|
141 the default for XEmacs prior to 21.5. If you want to change this value
|
|
|
142 put \"(setq filesets-menu-ensure-use-cached VALUE)\" into your startup
|
|
|
143 file -- before loading filesets.el.
|
|
|
144
|
|
|
145 So, when should you think about setting this value to t? If filesets.el
|
|
|
146 is loaded before user customizations. Thus, if (require 'filesets)
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
147 precedes the `custom-set-variables' command or, for XEmacs, if init.el
|
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
148 is loaded before custom.el, set this variable to t.")
|
|
44934
|
149
|
|
|
150
|
|
|
151 ;;; utils
|
|
|
152 (defun filesets-filter-list (lst cond-fn)
|
|
|
153 "Remove all elements not conforming to COND-FN from list LST.
|
|
|
154 COND-FN takes one argument: the current element."
|
|
|
155 ; (remove* 'dummy lst :test (lambda (dummy elt)
|
|
|
156 ; (not (funcall cond-fn elt)))))
|
|
|
157 (let ((rv nil))
|
|
|
158 (dolist (elt lst rv)
|
|
|
159 (when (funcall cond-fn elt)
|
|
|
160 (setq rv (append rv (list elt)))))))
|
|
|
161
|
|
45164
|
162 (defun filesets-ormap (fsom-pred lst)
|
|
79092
|
163 "Return the tail of LST for the head of which FSOM-PRED is non-nil."
|
|
45164
|
164 (let ((fsom-lst lst)
|
|
|
165 (fsom-rv nil))
|
|
|
166 (while (and (not (null fsom-lst))
|
|
|
167 (null fsom-rv))
|
|
|
168 (if (funcall fsom-pred (car fsom-lst))
|
|
|
169 (setq fsom-rv fsom-lst)
|
|
|
170 (setq fsom-lst (cdr fsom-lst))))
|
|
|
171 fsom-rv))
|
|
|
172
|
|
|
173 (defun filesets-some (fss-pred fss-lst)
|
|
49475
|
174 "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
|
|
45164
|
175 Like `some', return the first value of FSS-PRED that is non-nil."
|
|
|
176 (catch 'exit
|
|
|
177 (dolist (fss-this fss-lst nil)
|
|
|
178 (let ((fss-rv (funcall fss-pred fss-this)))
|
|
|
179 (when fss-rv
|
|
|
180 (throw 'exit fss-rv))))))
|
|
|
181 ;(fset 'filesets-some 'some) ;; or use the cl function
|
|
|
182
|
|
|
183 (defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
|
|
|
184 "Find the first occurrence of FSM-ITEM in FSM-LST.
|
|
84660
|
185 It is supposed to work like cl's `member*'. At the moment only the :test
|
|
45164
|
186 key is supported."
|
|
|
187 (let ((fsm-test (or (plist-get fsm-keys ':test)
|
|
|
188 (function equal))))
|
|
|
189 (filesets-ormap (lambda (fsm-this)
|
|
49475
|
190 (funcall fsm-test fsm-item fsm-this))
|
|
45164
|
191 fsm-lst)))
|
|
|
192 ;(fset 'filesets-member 'member*) ;; or use the cl function
|
|
|
193
|
|
44934
|
194 (defun filesets-sublist (lst beg &optional end)
|
|
|
195 "Get the sublist of LST from BEG to END - 1."
|
|
|
196 (let ((rv nil)
|
|
|
197 (i beg)
|
|
|
198 (top (or end
|
|
|
199 (length lst))))
|
|
|
200 (while (< i top)
|
|
|
201 (setq rv (append rv (list (nth i lst))))
|
|
|
202 (setq i (+ i 1)))
|
|
|
203 rv))
|
|
|
204
|
|
|
205 (defun filesets-select-command (cmd-list)
|
|
|
206 "Select one command from CMD-LIST -- a string with space separated names."
|
|
|
207 (let ((this (shell-command-to-string
|
|
|
208 (format "which --skip-alias %s 2> /dev/null | head -n 1"
|
|
|
209 cmd-list))))
|
|
49475
|
210 (if (equal this "")
|
|
44934
|
211 nil
|
|
|
212 (file-name-nondirectory (substring this 0 (- (length this) 1))))))
|
|
|
213
|
|
|
214 (defun filesets-which-command (cmd)
|
|
84660
|
215 "Call \"which CMD\"."
|
|
44934
|
216 (shell-command-to-string (format "which %s" cmd)))
|
|
|
217
|
|
|
218 (defun filesets-which-command-p (cmd)
|
|
84660
|
219 "Call \"which CMD\" and return non-nil if the command was found."
|
|
44934
|
220 (when (string-match (format "\\(/[^/]+\\)?/%s" cmd)
|
|
|
221 (filesets-which-command cmd))
|
|
|
222 cmd))
|
|
|
223
|
|
|
224 (defun filesets-message (level &rest args)
|
|
|
225 "Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
|
|
|
226 (when (<= level (abs filesets-verbosity))
|
|
|
227 (apply 'message args)))
|
|
|
228
|
|
|
229
|
|
|
230 ;;; config file
|
|
|
231 (defun filesets-save-config ()
|
|
|
232 "Save filesets' customizations."
|
|
|
233 (interactive)
|
|
|
234 (customize-save-customized))
|
|
|
235
|
|
|
236 (defun filesets-reset-fileset (&optional fileset no-cache)
|
|
|
237 "Reset the cached values for one or all filesets."
|
|
|
238 (if fileset
|
|
|
239 (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
|
|
|
240 (setq filesets-submenus nil))
|
|
|
241 (setq filesets-has-changed-flag t)
|
|
|
242 (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
|
|
|
243 (not no-cache))))
|
|
|
244
|
|
|
245 (defun filesets-set-config (fileset var val)
|
|
|
246 "Set-default wrapper function."
|
|
|
247 (filesets-reset-fileset fileset)
|
|
|
248 (set-default var val))
|
|
|
249 ; (customize-set-variable var val))
|
|
|
250 ; (filesets-build-menu))
|
|
|
251
|
|
61238
|
252 ;; It seems this is a workaround for the XEmacs issue described in the
|
|
84660
|
253 ;; doc-string of filesets-menu-ensure-use-cached. Under Emacs this is
|
|
61238
|
254 ;; essentially just `set-default'.
|
|
44934
|
255 (defun filesets-set-default (sym val &optional init-flag)
|
|
61238
|
256 "Set-default wrapper function used in conjunction with `defcustom'.
|
|
|
257 If SYM is in the list `filesets-ignore-next-set-default', delete
|
|
|
258 it from that list, and return nil. Otherwise, set the value of
|
|
|
259 SYM to VAL and return t. If INIT-FLAG is non-nil, set with
|
|
|
260 `custom-initialize-set', otherwise with `set-default'."
|
|
44934
|
261 (let ((ignore-flag (member sym filesets-ignore-next-set-default)))
|
|
|
262 (if ignore-flag
|
|
|
263 (setq filesets-ignore-next-set-default
|
|
|
264 (delete sym filesets-ignore-next-set-default))
|
|
|
265 (if init-flag
|
|
|
266 (custom-initialize-set sym val)
|
|
|
267 (set-default sym val)))
|
|
|
268 (not ignore-flag)))
|
|
|
269
|
|
|
270 (defun filesets-set-default! (sym val)
|
|
|
271 "Call `filestes-set-default' and reset cached data (i.e. rebuild menu)."
|
|
|
272 (when (filesets-set-default sym val)
|
|
|
273 (filesets-reset-fileset)))
|
|
|
274
|
|
|
275 (defun filesets-set-default+ (sym val)
|
|
|
276 "Call `filestes-set-default' and reset filesets' standard menu."
|
|
|
277 (when (filesets-set-default sym val)
|
|
|
278 (setq filesets-has-changed-flag t)))
|
|
|
279 ; (filesets-reset-fileset nil t)))
|
|
|
280
|
|
50782
|
281 (defvar filesets-data)
|
|
|
282
|
|
44934
|
283 (defun filesets-data-set-default (sym val)
|
|
|
284 "Set the default for `filesets-data'."
|
|
|
285 (if filesets-menu-use-cached-flag
|
|
|
286 (setq filesets-menu-use-cached-flag nil)
|
|
|
287 (when (default-boundp 'filesets-data)
|
|
|
288 (let ((modified-filesets
|
|
|
289 (filesets-filter-list val
|
|
|
290 (lambda (x)
|
|
|
291 (let ((name (car x))
|
|
|
292 (data (cdr x)))
|
|
|
293 (let ((elt (assoc name filesets-data)))
|
|
|
294 (or (not elt)
|
|
|
295 (not (equal data (cdr elt))))))))))
|
|
|
296 (dolist (x modified-filesets)
|
|
|
297 (filesets-reset-fileset (car x))))))
|
|
|
298 (filesets-set-default sym val))
|
|
50782
|
299
|
|
44934
|
300 ;;; configuration
|
|
|
301 (defgroup filesets nil
|
|
|
302 "The fileset swapper."
|
|
|
303 :prefix "filesets-"
|
|
57925
|
304 :group 'convenience
|
|
59996
|
305 :version "22.1")
|
|
44934
|
306
|
|
|
307 (defcustom filesets-menu-name "Filesets"
|
|
84660
|
308 "Filesets' menu name."
|
|
44934
|
309 :set (function filesets-set-default)
|
|
98441
|
310 :type 'string
|
|
44934
|
311 :group 'filesets)
|
|
|
312
|
|
98441
|
313 (defcustom filesets-menu-path '("File") ; cf recentf-menu-path
|
|
84660
|
314 "The menu under which the filesets menu should be inserted.
|
|
61138
|
315 See `add-submenu' for documentation."
|
|
|
316 :set (function filesets-set-default)
|
|
98441
|
317 :type '(choice (const :tag "Top Level" nil)
|
|
|
318 (sexp :tag "Menu Path"))
|
|
|
319 :version "23.1" ; was nil
|
|
61138
|
320 :group 'filesets)
|
|
44934
|
321
|
|
98441
|
322 (defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
|
|
84660
|
323 "The name of a menu before which this menu should be added.
|
|
61138
|
324 See `add-submenu' for documentation."
|
|
|
325 :set (function filesets-set-default)
|
|
98441
|
326 :type '(choice (string :tag "Name")
|
|
|
327 (const :tag "Last" nil))
|
|
|
328 :version "23.1" ; was "File"
|
|
61138
|
329 :group 'filesets)
|
|
44934
|
330
|
|
61138
|
331 (defcustom filesets-menu-in-menu nil
|
|
84660
|
332 "Use that instead of `current-menubar' as the menu to change.
|
|
61138
|
333 See `add-submenu' for documentation."
|
|
|
334 :set (function filesets-set-default)
|
|
|
335 :type 'sexp
|
|
|
336 :group 'filesets)
|
|
44934
|
337
|
|
|
338 (defcustom filesets-menu-shortcuts-flag t
|
|
84660
|
339 "Non-nil means to prepend menus with hopefully unique shortcuts."
|
|
44934
|
340 :set (function filesets-set-default!)
|
|
|
341 :type 'boolean
|
|
|
342 :group 'filesets)
|
|
|
343
|
|
|
344 (defcustom filesets-menu-shortcuts-marker "%_"
|
|
84660
|
345 "String for marking menu shortcuts."
|
|
44934
|
346 :set (function filesets-set-default!)
|
|
|
347 :type 'string
|
|
|
348 :group 'filesets)
|
|
|
349
|
|
84660
|
350 ;;(defcustom filesets-menu-cnvfp-flag nil
|
|
|
351 ;; "*Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
|
|
|
352 ;; :set (function filesets-set-default!)
|
|
|
353 ;; :type 'boolean
|
|
|
354 ;; :group 'filesets)
|
|
44934
|
355
|
|
|
356 (defcustom filesets-menu-cache-file
|
|
99106
|
357 (locate-user-emacs-file "filesets-cache.el")
|
|
84660
|
358 "File to be used for saving the filesets menu between sessions.
|
|
45132
|
359 Set this to \"\", to disable caching of menus.
|
|
44934
|
360 Don't forget to check out `filesets-menu-ensure-use-cached'."
|
|
|
361 :set (function filesets-set-default)
|
|
|
362 :type 'file
|
|
|
363 :group 'filesets)
|
|
45132
|
364 (put 'filesets-menu-cache-file 'risky-local-variable t)
|
|
44934
|
365
|
|
|
366 (defcustom filesets-menu-cache-contents
|
|
|
367 '(filesets-be-docile-flag
|
|
|
368 filesets-submenus
|
|
49475
|
369 filesets-menu-cache
|
|
44934
|
370 filesets-ingroup-cache)
|
|
84660
|
371 "Stuff we want to save in `filesets-menu-cache-file'.
|
|
44934
|
372
|
|
|
373 Possible uses: don't save configuration data in the main startup files
|
|
|
374 but in filesets's own cache. In this case add `filesets-data' to this
|
|
|
375 list.
|
|
|
376
|
|
84660
|
377 There is a second reason for putting `filesets-data' on this list. If
|
|
44934
|
378 you frequently add and remove buffers on the fly to :files filesets, you
|
|
|
379 don't need to save your customizations if `filesets-data' is being
|
|
84660
|
380 mirrored in the cache file. In this case the version in the cache file
|
|
44934
|
381 is the current one, and the version in your startup file will be
|
|
|
382 silently updated later on.
|
|
|
383
|
|
|
384 If you want caching to work properly, at least `filesets-submenus',
|
|
|
385 `filesets-menu-cache', and `filesets-ingroup-cache' should be in this
|
|
|
386 list.
|
|
|
387
|
|
|
388 Don't forget to check out `filesets-menu-ensure-use-cached'."
|
|
|
389 :set (function filesets-set-default)
|
|
|
390 :type '(repeat
|
|
|
391 (choice :tag "Variable"
|
|
|
392 (const :tag "filesets-submenus"
|
|
|
393 :value filesets-submenus)
|
|
|
394 (const :tag "filesets-menu-cache"
|
|
|
395 :value filesets-menu-cache)
|
|
|
396 (const :tag "filesets-ingroup-cache"
|
|
|
397 :value filesets-ingroup-cache)
|
|
|
398 (const :tag "filesets-data"
|
|
|
399 :value filesets-data)
|
|
|
400 (const :tag "filesets-external-viewers"
|
|
|
401 :value filesets-external-viewers)
|
|
|
402 (const :tag "filesets-ingroup-patterns"
|
|
|
403 :value filesets-ingroup-patterns)
|
|
|
404 (const :tag "filesets-be-docile-flag"
|
|
|
405 :value filesets-be-docile-flag)
|
|
|
406 (sexp :tag "Other" :value nil)))
|
|
|
407 :group 'filesets)
|
|
|
408
|
|
|
409 (defcustom filesets-cache-fill-content-hooks nil
|
|
84660
|
410 "Hooks to run when writing the contents of filesets' cache file.
|
|
44934
|
411
|
|
|
412 The hook is called with the cache file as current buffer and the cursor
|
|
|
413 at the last position. I.e. each hook has to make sure that the cursor is
|
|
|
414 at the last position.
|
|
|
415
|
|
|
416 Possible uses: If you don't want to save `filesets-data' in your normal
|
|
|
417 configuration file, you can add a something like this
|
|
|
418
|
|
|
419 \(lambda ()
|
|
|
420 \(insert (format \"(setq-default filesets-data '%S)\"
|
|
|
421 filesets-data))
|
|
|
422 \(newline 2))
|
|
|
423
|
|
|
424 to this hook.
|
|
|
425
|
|
|
426 Don't forget to check out `filesets-menu-ensure-use-cached'."
|
|
|
427 :set (function filesets-set-default)
|
|
|
428 :type 'hook
|
|
|
429 :group 'filesets)
|
|
|
430
|
|
|
431 (defcustom filesets-cache-hostname-flag nil
|
|
84660
|
432 "Non-nil means cache the hostname.
|
|
45132
|
433 If the current name differs from the cached one,
|
|
|
434 rebuild the menu and create a new cache file."
|
|
44934
|
435 :set (function filesets-set-default)
|
|
|
436 :type 'boolean
|
|
|
437 :group 'filesets)
|
|
|
438
|
|
|
439 (defcustom filesets-cache-save-often-flag nil
|
|
84660
|
440 "Non-nil means save buffer on every change of the filesets menu.
|
|
44934
|
441 If this variable is set to nil and if Emacs crashes, the cache and
|
|
84660
|
442 filesets-data could get out of sync. Set this to t if this happens from
|
|
44934
|
443 time to time or if the fileset cache causes troubles."
|
|
|
444 :set (function filesets-set-default)
|
|
|
445 :type 'boolean
|
|
|
446 :group 'filesets)
|
|
|
447
|
|
|
448 (defcustom filesets-max-submenu-length 25
|
|
84660
|
449 "Maximum length of submenus.
|
|
44934
|
450 Set this value to 0 to turn menu splitting off. BTW, parts of submenus
|
|
|
451 will not be rewrapped if their length exceeds this value."
|
|
|
452 :set (function filesets-set-default)
|
|
|
453 :type 'integer
|
|
|
454 :group 'filesets)
|
|
|
455
|
|
|
456 (defcustom filesets-max-entry-length 50
|
|
84660
|
457 "Truncate names of splitted submenus to this length."
|
|
44934
|
458 :set (function filesets-set-default)
|
|
|
459 :type 'integer
|
|
|
460 :group 'filesets)
|
|
|
461
|
|
45132
|
462 (defcustom filesets-browse-dir-function 'dired
|
|
84660
|
463 "A function or command used for browsing directories.
|
|
44934
|
464 When using an external command, \"%s\" will be replaced with the
|
|
|
465 directory's name.
|
|
|
466
|
|
|
467 Note: You have to manually rebuild the menu if you change this value."
|
|
|
468 :set (function filesets-set-default)
|
|
|
469 :type '(choice :tag "Function:"
|
|
|
470 (const :tag "dired"
|
|
|
471 :value dired)
|
|
|
472 (list :tag "Command"
|
|
|
473 :value ("" "%s")
|
|
|
474 (string :tag "Name")
|
|
|
475 (string :tag "Arguments"))
|
|
|
476 (function :tag "Function"
|
|
|
477 :value nil))
|
|
|
478 :group 'filesets)
|
|
|
479
|
|
45132
|
480 (defcustom filesets-open-file-function 'filesets-find-or-display-file
|
|
84660
|
481 "The function used for opening files.
|
|
44934
|
482
|
|
|
483 `filesets-find-or-display-file' ... Filesets' default function for
|
|
|
484 visiting files. This function checks if an external viewer is defined
|
|
|
485 for a specific file type. Either this viewer, if defined, or
|
|
|
486 `find-file' will be used to visit a file.
|
|
|
487
|
|
|
488 `filesets-find-file' ... An alternative function that always uses
|
|
84660
|
489 `find-file'. If `filesets-be-docile-flag' is true, a file, which isn't
|
|
44934
|
490 readable, will not be opened.
|
|
|
491
|
|
|
492 Caveat: Changes will take effect only after rebuilding the menu."
|
|
|
493 :set (function filesets-set-default)
|
|
|
494 :type '(choice :tag "Function:"
|
|
|
495 (const :tag "filesets-find-or-display-file"
|
|
|
496 :value filesets-find-or-display-file)
|
|
|
497 (const :tag "filesets-find-file"
|
|
|
498 :value filesets-find-file)
|
|
|
499 (function :tag "Function"
|
|
|
500 :value nil))
|
|
|
501 :group 'filesets)
|
|
|
502
|
|
45132
|
503 (defcustom filesets-save-buffer-function 'save-buffer
|
|
84660
|
504 "The function used to save a buffer.
|
|
44934
|
505 Caveat: Changes will take effect after rebuilding the menu."
|
|
|
506 :set (function filesets-set-default)
|
|
|
507 :type '(choice :tag "Function:"
|
|
|
508 (const :tag "save-buffer"
|
|
|
509 :value save-buffer)
|
|
|
510 (function :tag "Function"
|
|
|
511 :value nil))
|
|
|
512 :group 'filesets)
|
|
|
513
|
|
|
514 (defcustom filesets-find-file-delay
|
|
84660
|
515 (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
|
|
44934
|
516 0.5
|
|
|
517 0)
|
|
84660
|
518 "Delay before calling `find-file'.
|
|
44934
|
519 This is for calls via `filesets-find-or-display-file'
|
|
|
520 or `filesets-find-file'.
|
|
|
521
|
|
|
522 Set this to 0, if you don't use XEmacs' buffer tabs."
|
|
|
523 :set (function filesets-set-default)
|
|
|
524 :type 'number
|
|
|
525 :group 'filesets)
|
|
|
526
|
|
|
527 (defcustom filesets-be-docile-flag nil
|
|
84660
|
528 "Non-nil means don't complain if a file or a directory doesn't exist.
|
|
44934
|
529 This is useful if you want to use the same startup files in different
|
|
|
530 computer environments."
|
|
|
531 :set (function filesets-set-default)
|
|
|
532 :type 'boolean
|
|
|
533 :group 'filesets)
|
|
|
534
|
|
|
535 (defcustom filesets-sort-menu-flag t
|
|
84660
|
536 "Non-nil means sort the filesets menu alphabetically."
|
|
44934
|
537 :set (function filesets-set-default)
|
|
|
538 :type 'boolean
|
|
|
539 :group 'filesets)
|
|
|
540
|
|
|
541 (defcustom filesets-sort-case-sensitive-flag t
|
|
85317
|
542 "Non-nil means sorting of the filesets menu is case sensitive."
|
|
44934
|
543 :set (function filesets-set-default)
|
|
|
544 :type 'boolean
|
|
|
545 :group 'filesets)
|
|
|
546
|
|
|
547 (defcustom filesets-tree-max-level 3
|
|
84660
|
548 "Maximum scan depth for directory trees.
|
|
44934
|
549 A :tree fileset is defined by a base directory the contents of which
|
|
45132
|
550 will be recursively added to the menu. `filesets-tree-max-level' tells up
|
|
44934
|
551 to which level the directory structure should be scanned/listed,
|
|
|
552 i.e. how deep the menu should be. Try something like
|
|
|
553
|
|
|
554 \(\"HOME -- only one level\"
|
|
|
555 \(:tree \"~\" \"^[^.].*[^~]$\")
|
|
|
556 \(:tree-max-level 1)
|
|
|
557 \(:filter-dirs-flag t))
|
|
|
558 \(\"HOME -- up to 3 levels\"
|
|
|
559 \(:tree \"~\" \"^[^.].*[^~]$\")
|
|
|
560 \(:tree-max-level 3)
|
|
|
561 \(:filter-dirs-flag t))
|
|
|
562
|
|
|
563 and it should become clear what this option is about. In any case,
|
|
|
564 including directory trees to the menu can take a lot of memory."
|
|
|
565 :set (function filesets-set-default)
|
|
|
566 :type 'integer
|
|
|
567 :group 'filesets)
|
|
|
568
|
|
|
569 (defcustom filesets-commands
|
|
96958
|
570 `(("Isearch"
|
|
|
571 multi-isearch-files
|
|
|
572 (filesets-cmd-isearch-getargs))
|
|
|
573 ("Isearch (regexp)"
|
|
|
574 multi-isearch-files-regexp
|
|
|
575 (filesets-cmd-isearch-getargs))
|
|
|
576 ("Query Replace"
|
|
|
577 perform-replace
|
|
44934
|
578 (filesets-cmd-query-replace-getargs))
|
|
|
579 ("Query Replace (regexp)"
|
|
96958
|
580 perform-replace
|
|
|
581 (filesets-cmd-query-replace-regexp-getargs))
|
|
44934
|
582 ("Grep <<selection>>"
|
|
|
583 "grep"
|
|
|
584 ("-n " filesets-get-quoted-selection " " "<<file-name>>"))
|
|
|
585 ("Run Shell Command"
|
|
|
586 filesets-cmd-shell-command
|
|
|
587 (filesets-cmd-shell-command-getargs)))
|
|
84660
|
588 "Commands to run on filesets.
|
|
44934
|
589 An association list of names, functions, and an argument list (or a
|
|
|
590 function that returns one) to be run on a filesets' files.
|
|
|
591
|
|
|
592 The argument <file-name> or <<file-name>> (quoted) will be replaced with
|
|
|
593 the filename."
|
|
|
594 :set (function filesets-set-default+)
|
|
|
595 :type '(repeat :tag "Commands"
|
|
|
596 (list :tag "Definition" :value ("")
|
|
|
597 (string "Name")
|
|
|
598 (choice :tag "Command"
|
|
|
599 (string :tag "String")
|
|
|
600 (function :tag "Function"))
|
|
|
601 (repeat :tag "Argument List"
|
|
|
602 (choice :tag "Arguments"
|
|
|
603 (sexp :tag "Sexp"
|
|
|
604 :value nil)
|
|
|
605 (string :tag "File Name"
|
|
|
606 :value "<file-name>")
|
|
|
607 (string :tag "Quoted File Name"
|
|
|
608 :value "<<file-name>>")
|
|
|
609 (function :tag "Function"
|
|
|
610 :value nil)))))
|
|
|
611 :group 'filesets)
|
|
45132
|
612 (put 'filesets-commands 'risky-local-variable t)
|
|
44934
|
613
|
|
|
614 (defcustom filesets-external-viewers
|
|
|
615 (let
|
|
84660
|
616 ;; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
|
|
|
617 ;; (filesets-select-command "ggv gv")))
|
|
|
618 ;; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
|
|
|
619 ;; (filesets-select-command "xpdf acroread")))
|
|
|
620 ;; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
|
|
|
621 ;; (filesets-select-command "xdvi tkdvi")))
|
|
|
622 ;; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
|
|
|
623 ;; (filesets-select-command "antiword")))
|
|
|
624 ;; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
|
|
|
625 ;; (filesets-select-command "gqview ee display"))))
|
|
44934
|
626 ((ps-cmd "ggv")
|
|
|
627 (pdf-cmd "xpdf")
|
|
|
628 (dvi-cmd "xdvi")
|
|
|
629 (doc-cmd "antiword")
|
|
|
630 (pic-cmd "gqview"))
|
|
|
631 `(("^.+\\..?html?$" browse-url
|
|
|
632 ((:ignore-on-open-all t)))
|
|
|
633 ("^.+\\.pdf$" ,pdf-cmd
|
|
|
634 ((:ignore-on-open-all t)
|
|
|
635 (:ignore-on-read-text t)
|
|
|
636 (:constraint-flag ,pdf-cmd)))
|
|
|
637 ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
|
|
|
638 ((:ignore-on-open-all t)
|
|
|
639 (:ignore-on-read-text t)
|
|
|
640 (:constraint-flag ,ps-cmd)))
|
|
|
641 ("^.+\\.dvi$" ,dvi-cmd
|
|
|
642 ((:ignore-on-open-all t)
|
|
|
643 (:ignore-on-read-text t)
|
|
|
644 (:constraint-flag ,dvi-cmd)))
|
|
|
645 ("^.+\\.doc$" ,doc-cmd
|
|
|
646 ((:capture-output t)
|
|
|
647 (:ignore-on-read-text t)
|
|
|
648 (:constraint-flag ,doc-cmd)))
|
|
|
649 ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
|
|
|
650 ((:ignore-on-open-all t)
|
|
|
651 (:ignore-on-read-text t)
|
|
|
652 (:constraint-flag ,pic-cmd)))))
|
|
84660
|
653 "Association list of file patterns and external viewers for use with
|
|
44934
|
654 `filesets-find-or-display-file'.
|
|
|
655
|
|
|
656 Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a
|
|
|
657 function or a command name as string.
|
|
|
658
|
|
63251
|
659 Properties is an association list determining filesets' behavior in
|
|
|
660 several conditions. Choose one from this list:
|
|
44934
|
661
|
|
|
662 :ignore-on-open-all ... Don't open files of this type automatically --
|
|
|
663 i.e. on open-all-files-events or when running commands
|
|
|
664
|
|
|
665 :capture-output ... capture an external viewer output
|
|
|
666
|
|
|
667 :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
|
|
|
668
|
|
45164
|
669 :constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
|
|
44934
|
670
|
|
|
671 :open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
|
|
|
672 in conjunction with :capture-output
|
|
|
673
|
|
|
674 :args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
|
|
|
675 \(defaults to (list \"%S\")) when using shell commands
|
|
|
676
|
|
|
677 Avoid modifying this variable and achieve minor speed-ups by setting the
|
|
|
678 variables my-ps-viewer, my-pdf-viewer, my-dvi-viewer, my-pic-viewer.
|
|
|
679
|
|
|
680 In order to view pdf or rtf files in an Emacs buffer, you could use these:
|
|
|
681
|
|
|
682
|
|
84660
|
683 \(\"^.+\\\\.pdf\\\\'\" \"pdftotext\"
|
|
44934
|
684 \((:capture-output t)
|
|
|
685 \(:args (\"%S - | fmt -w \" window-width))
|
|
|
686 \(:ignore-on-read-text t)
|
|
|
687 \(:constraintp (lambda ()
|
|
|
688 \(and \(filesets-which-command-p \"pdftotext\")
|
|
|
689 \(filesets-which-command-p \"fmt\"))))))
|
|
84660
|
690 \(\"^.+\\\\.rtf\\\\'\" \"rtf2htm\"
|
|
44934
|
691 \((:capture-output t)
|
|
|
692 \(:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
|
|
|
693 \(:ignore-on-read-text t)
|
|
|
694 \(:constraintp (lambda ()
|
|
|
695 \(and (filesets-which-command-p \"rtf2htm\")
|
|
84660
|
696 \(filesets-which-command-p \"w3m\"))))))"
|
|
44934
|
697 :set (function filesets-set-default)
|
|
|
698 :type '(repeat :tag "Viewer"
|
|
|
699 (list :tag "Definition"
|
|
|
700 :value ("^.+\\.suffix$" "")
|
|
|
701 (regexp :tag "Pattern")
|
|
|
702 (choice :tag "Viewer"
|
|
|
703 (symbol :tag "Function" :value nil)
|
|
|
704 (string :tag "Program" :value ""))
|
|
|
705 (repeat :tag "Properties"
|
|
|
706 (choice
|
|
|
707 (list :tag ":constraintp"
|
|
|
708 :value (:constraintp)
|
|
|
709 (const :format ""
|
|
|
710 :value :constraintp)
|
|
|
711 (function :tag "Function"))
|
|
|
712 (list :tag ":constraint-flag"
|
|
|
713 :value (:constraint-flag)
|
|
|
714 (const :format ""
|
|
|
715 :value :constraint-flag)
|
|
45164
|
716 (sexp :tag "Symbol"))
|
|
44934
|
717 (list :tag ":ignore-on-open-all"
|
|
|
718 :value (:ignore-on-open-all t)
|
|
|
719 (const :format ""
|
|
|
720 :value :ignore-on-open-all)
|
|
|
721 (boolean :tag "Boolean"))
|
|
|
722 (list :tag ":ignore-on-read-text"
|
|
|
723 :value (:ignore-on-read-text t)
|
|
|
724 (const :format ""
|
|
|
725 :value :ignore-on-read-text)
|
|
|
726 (boolean :tag "Boolean"))
|
|
|
727 (list :tag ":args"
|
|
|
728 :value (:args)
|
|
|
729 (const :format ""
|
|
|
730 :value :args)
|
|
|
731 (repeat :tag "List"
|
|
|
732 (choice :tag "Arguments"
|
|
|
733 (string :tag "String"
|
|
|
734 :value "")
|
|
|
735 (symbol :tag "Symbol"
|
|
|
736 :value nil)
|
|
|
737 (function :tag "Function"
|
|
|
738 :value nil))))
|
|
|
739 (list :tag ":open-hook"
|
|
|
740 :value (:open-hook)
|
|
|
741 (const :format ""
|
|
|
742 :value :open-hook)
|
|
|
743 (hook :tag "Hook"))
|
|
|
744 ; (list :tag ":close-hook"
|
|
|
745 ; :value (:close-hook)
|
|
|
746 ; (const :format ""
|
|
|
747 ; :value :close-hook)
|
|
|
748 ; (hook :tag "Hook"))
|
|
|
749 (list :tag ":capture-output"
|
|
|
750 :value (:capture-output t)
|
|
|
751 (const :format ""
|
|
|
752 :value :capture-output)
|
|
|
753 (boolean :tag "Boolean"))))))
|
|
|
754 :group 'filesets)
|
|
45132
|
755 (put 'filesets-external-viewers 'risky-local-variable t)
|
|
44934
|
756
|
|
|
757 (defcustom filesets-ingroup-patterns
|
|
|
758 '(("^.+\\.tex$" t
|
|
|
759 (((:name "Package")
|
|
|
760 (:pattern "\\\\usepackage\\W*\\(\\[[^\]]*\\]\\W*\\)?{\\W*\\(.+\\)\\W*}")
|
|
|
761 (:match-number 2)
|
|
|
762 (:stub-flag t)
|
|
|
763 (:get-file-name (lambda (master file)
|
|
|
764 (filesets-which-file master
|
|
|
765 (concat file ".sty")
|
|
49475
|
766 (filesets-convert-path-list
|
|
44934
|
767 (or (getenv "MY_TEXINPUTS")
|
|
|
768 (getenv "TEXINPUTS")))))))
|
|
|
769 ((:name "Include")
|
|
|
770 (:pattern "\\\\include\\W*{\\W*\\(.+\\)\\W*}")
|
|
|
771 (:get-file-name (lambda (master file)
|
|
|
772 (filesets-which-file master
|
|
|
773 (concat file ".tex")
|
|
49475
|
774 (filesets-convert-path-list
|
|
44934
|
775 (or (getenv "MY_TEXINPUTS")
|
|
|
776 (getenv "TEXINPUTS"))))))
|
|
|
777 (:scan-depth 5))
|
|
|
778 ((:name "Input")
|
|
|
779 (:pattern "\\\\input\\W*{\\W*\\(.+\\)\\W*}")
|
|
|
780 (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
|
|
|
781 (:get-file-name (lambda (master file)
|
|
|
782 (filesets-which-file master
|
|
|
783 (concat file ".tex")
|
|
49475
|
784 (filesets-convert-path-list
|
|
44934
|
785 (or (getenv "MY_TEXINPUTS")
|
|
|
786 (getenv "TEXINPUTS"))))))
|
|
|
787 (:scan-depth 5))
|
|
|
788 ((:name "Bibliography")
|
|
|
789 (:pattern "\\\\bibliography\\W*{\\W*\\(.+\\)\\W*}")
|
|
|
790 (:get-file-name (lambda (master file)
|
|
|
791 (filesets-which-file master
|
|
|
792 (concat file ".bib")
|
|
49475
|
793 (filesets-convert-path-list
|
|
44934
|
794 (or (getenv "MY_BIBINPUTS")
|
|
|
795 (getenv "BIBINPUTS")))))))))
|
|
|
796 ("^.+\\.el$" t
|
|
|
797 (((:name "Require")
|
|
|
798 (:pattern "(require\\W+'\\(.+\\))")
|
|
|
799 (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
|
|
|
800 (:get-file-name (lambda (master file)
|
|
|
801 (filesets-which-file master
|
|
|
802 (concat file ".el")
|
|
|
803 load-path))))
|
|
|
804 ((:name "Load")
|
|
|
805 (:pattern "(load\\(-library\\)?\\W+\"\\(.+\\)\")")
|
|
|
806 (:match-number 2)
|
|
|
807 (:get-file-name (lambda (master file)
|
|
|
808 (filesets-which-file master file load-path))))))
|
|
|
809 ("^\\([A-Z綴�][a-z糜館]+\\([A-Z綴�][a-z糜館]+\\)+\\)$" t
|
|
|
810 (((:pattern "\\<\\([A-Z綴�][a-z糜館]+\\([A-Z綴�][a-z糜館]+\\)+\\)\\>")
|
|
|
811 (:scan-depth 5)
|
|
|
812 (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
|
|
|
813 (:case-sensitive t)
|
|
|
814 (:get-file-name (lambda (master file)
|
|
|
815 (filesets-which-file
|
|
|
816 master
|
|
|
817 file
|
|
|
818 (if (boundp 'emacs-wiki-directories)
|
|
|
819 emacs-wiki-directories
|
|
|
820 nil))))))))
|
|
|
821
|
|
84660
|
822 "Inclusion group definitions.
|
|
44934
|
823
|
|
|
824 Define how to find included file according to a file's mode (being
|
|
|
825 defined by a file pattern).
|
|
|
826
|
|
|
827 A valid entry has the form (FILE-PATTERN REMOVE-DUPLICATES-FLAG
|
|
|
828 CMD-DEF1 ...), CMD-DEF1 being a plist containing the fields :pattern
|
|
|
829 \(mandatory), :name, :get-file-name, :match-number, :scan-depth,
|
|
|
830 :preprocess, :case-sensitive.
|
|
|
831
|
|
|
832 File Pattern ... A regexp matching the file's name for which the
|
|
|
833 following rules should be applied.
|
|
|
834
|
|
|
835 Remove Duplicates ... If t, only the first occurrence of an included
|
|
|
836 file is retained. (See below for a full explanation.)
|
|
|
837
|
|
|
838 :name STRING ... This pattern's name.
|
|
|
839
|
|
|
840 :pattern REGEXP ... A regexp matching the command. This regexp has to
|
|
|
841 include a group that holds the name of the included file.
|
|
|
842
|
|
|
843 :get-file-name FUNCTION (default: `filesets-which-file') ... A function
|
|
|
844 that takes two arguments (the path of the master file and the name
|
|
|
845 of the included file) and returns a valid path or nil -- if the
|
|
|
846 subfile can't be found.
|
|
|
847
|
|
|
848 :match-number INTEGER (default: 1) ... The number of the match/group
|
|
|
849 in the pattern holding the subfile's name. 0 refers the whole
|
|
|
850 match, 1 to the first group.
|
|
|
851
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
852 :stubp FUNCTION ... If (FUNCTION MASTER INCLUDED-FILE) returns non-nil,
|
|
44934
|
853 INCLUDED-FILE is a stub -- see below.
|
|
|
854
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
855 :stub-flag ... Files of this type are stubs -- see below.
|
|
44934
|
856
|
|
|
857 :scan-depth INTEGER (default: 0) ... Whether included files should be
|
|
|
858 rescanned. Set this to 0 to disable re-scanning of included file.
|
|
|
859
|
|
|
860 :preprocess FUNCTION ... A function modifying a buffer holding the
|
|
|
861 master file so that pattern matching becomes easier. This is usually
|
|
|
862 used to narrow a buffer to the relevant region. This function could also
|
|
|
863 be destructive and simply delete non-relevant text.
|
|
|
864
|
|
|
865 :case-sensitive BOOLEAN (default: nil) ... Whether a pattern is
|
|
|
866 case-sensitive or not.
|
|
|
867
|
|
|
868
|
|
|
869 Stubs:
|
|
|
870
|
|
|
871 First, a stub is a file that shows up in the menu but will not be
|
|
|
872 included in an ingroup's file listing -- i.e. filesets will never
|
|
84660
|
873 operate on this file automatically. Secondly, in opposition to normal
|
|
|
874 files stubs are not scanned for new inclusion groups. This is useful if
|
|
44934
|
875 you want to have quick access to library headers.
|
|
|
876
|
|
|
877 In the menu, an asterisk is appended to the stub's name.
|
|
|
878
|
|
|
879
|
|
|
880 Remove Duplicates:
|
|
|
881
|
|
|
882 E.g. File A and file B refer to file X; X refers to A. If
|
|
|
883 you choose not to remove duplicates the tree would look like:
|
|
|
884
|
|
|
885 M + A - X - A ...
|
|
|
886 B - X - A ...
|
|
|
887
|
|
|
888 As you can see, there is some chance that you run in circles.
|
|
|
889 Nevertheless, up to some degree this could still be what you want.
|
|
|
890
|
|
|
891 With duplicates removed, it would be:
|
|
|
892
|
|
|
893 M + A - X
|
|
|
894 B"
|
|
|
895 :set (function filesets-set-default)
|
|
|
896 :type '(repeat
|
|
|
897 :tag "Include"
|
|
|
898 (list
|
|
|
899 :tag "Definition" :value ("^.+\\.suffix$" t)
|
|
|
900 (regexp :tag "File Pattern" :value "^.+\\.suffix$")
|
|
|
901 (boolean :tag "Remove Duplicates" :value t)
|
|
|
902 (repeat :tag "Commands"
|
|
|
903 (repeat :tag "Command"
|
|
|
904 (choice
|
|
|
905 :tag "Definition"
|
|
|
906 (list :tag ":name"
|
|
|
907 :value (:name "")
|
|
|
908 (const :format "" :value :name)
|
|
|
909 (string :tag "String"))
|
|
|
910 (list :tag ":pattern"
|
|
|
911 :value (:pattern "\\<CMD\\W*\\(.+\\)\\>")
|
|
|
912 (const :format "" :value :pattern)
|
|
|
913 (regexp :tag "RegExp"))
|
|
|
914 (list :tag ":get-file-name"
|
|
|
915 :value (:get-file-name)
|
|
|
916 (const :format "" :value :get-file-name)
|
|
|
917 (function :tag "Function"))
|
|
|
918 (list :tag ":match-number"
|
|
|
919 :value (:match-number 1)
|
|
|
920 (const :format "" :value :match-number)
|
|
|
921 (integer :tag "Integer"))
|
|
|
922 (list :tag ":stub-flag"
|
|
|
923 :value (:stub-flag t)
|
|
|
924 (const :format "" :value :stub-flag)
|
|
|
925 (boolean :tag "Boolean"))
|
|
|
926 (list :tag ":stubp"
|
|
|
927 :value (:stubp)
|
|
|
928 (const :format "" :value :stubp)
|
|
|
929 (function :tag "Function"))
|
|
|
930 (list :tag ":scan-depth"
|
|
|
931 :value (:scan-depth 0)
|
|
|
932 (const :format "" :value :scan-depth)
|
|
|
933 (integer :tag "Integer"))
|
|
|
934 (list :tag ":case-sensitive"
|
|
|
935 :value (:case-sensitive)
|
|
|
936 (const :format "" :value :case-sensitive)
|
|
|
937 (boolean :tag "Boolean"))
|
|
|
938 (list :tag ":preprocess"
|
|
|
939 :value (:preprocess)
|
|
|
940 (const :format "" :value :preprocess)
|
|
|
941 (function :tag "Function")))))))
|
|
|
942 :group 'filesets)
|
|
45132
|
943 (put 'filesets-ingroup-patterns 'risky-local-variable t)
|
|
44934
|
944
|
|
84660
|
945 (defcustom filesets-data nil
|
|
|
946 "Fileset definitions.
|
|
44934
|
947
|
|
|
948 A fileset is either a list of files, a file pattern, a base directory
|
|
|
949 and a search pattern (for files), or a base file. Changes to this
|
|
|
950 variable will take effect after rebuilding the menu.
|
|
|
951
|
|
|
952 Caveat: Fileset names have to be unique.
|
|
|
953
|
|
|
954 Example definition:
|
|
|
955 '\(\(\"My Wiki\"
|
|
|
956 \(:ingroup \"~/Etc/My-Wiki/WikiContents\"))
|
|
|
957 \(\"My Homepage\"
|
|
|
958 \(:pattern \"~/public_html/\" \"^.+\\\\.html$\")
|
|
|
959 \(:open filesets-find-file))
|
|
|
960 \(\"User Configuration\"
|
|
|
961 \(:files \"~/.xinitrc\"
|
|
|
962 \"~/.bashrc\"
|
|
|
963 \"~/.bash_profile\"))
|
|
|
964 \(\"HOME\"
|
|
|
965 \(:tree \"~\" \"^[^.].*[^~]$\")
|
|
|
966 \(:filter-dirs-flag t)))
|
|
|
967
|
|
|
968 `filesets-data' is a list of (NAME-AS-STRING . DEFINITION), DEFINITION
|
|
|
969 being an association list with the fields:
|
|
|
970
|
|
|
971 :files FILE-1 .. FILE-N ... a list of files belonging to a fileset
|
|
|
972
|
|
|
973 :ingroup FILE-NAME ... an inclusion group's base file.
|
|
|
974
|
|
|
975 :tree ROOT-DIR PATTERN ... a base directory and a file pattern
|
|
|
976
|
|
99095
|
977 :pattern DIR PATTERN ... a base directory and a regexp matching
|
|
|
978 files in that directory. Usually,
|
|
|
979 PATTERN has the form '^REGEXP$'. Unlike
|
|
|
980 :tree, this form does not descend
|
|
|
981 recursively into subdirectories.
|
|
44934
|
982
|
|
|
983 :filter-dirs-flag BOOLEAN ... is only used in conjunction with :tree.
|
|
|
984
|
|
|
985 :tree-max-level INTEGER ... recurse into directories this many levels
|
|
44959
|
986 \(see `filesets-tree-max-level' for a full explanation)
|
|
44934
|
987
|
|
|
988 :dormant-flag BOOLEAN ... non-nil means don't show this item in the
|
|
|
989 menu; dormant filesets can still be manipulated via commands available
|
|
|
990 from the minibuffer -- e.g. `filesets-open', `filesets-close', or
|
|
|
991 `filesets-run-cmd'
|
|
|
992
|
|
|
993 :dormant-p FUNCTION ... a function returning :dormant-flag
|
|
|
994
|
|
|
995 :open FUNCTION ... the function used to open file belonging to this
|
|
|
996 fileset. The function takes a file name as argument
|
|
|
997
|
|
|
998 :save FUNCTION ... the function used to save file belonging to this
|
|
|
999 fileset; it takes no arguments, but works on the current buffer.
|
|
|
1000
|
|
|
1001 Either :files, :pattern, :tree, or :ingroup must be supplied. :files
|
|
|
1002 overrules :tree, :tree overrules :pattern, :pattern overrules :ingroup,
|
|
|
1003 i.e. these tags are mutually exclusive. The fields :open and :save are
|
|
|
1004 optional.
|
|
|
1005
|
|
|
1006 In conjunction with the :tree tag, :save is void. :open refers to the
|
|
|
1007 function used for opening files in a directory, not for opening the
|
|
45132
|
1008 directory. For browsing directories, `filesets-browse-dir-function' is used.
|
|
44934
|
1009
|
|
|
1010 Before using :ingroup, make sure that the file type is already
|
|
|
1011 defined in `filesets-ingroup-patterns'."
|
|
|
1012 :group 'filesets
|
|
|
1013 :set (function filesets-data-set-default)
|
|
|
1014 :type '(repeat
|
|
|
1015 (cons :tag "Fileset"
|
|
|
1016 (string :tag "Name" :value "")
|
|
|
1017 (repeat :tag "Data"
|
|
|
1018 (choice
|
|
|
1019 :tag "Type" :value nil
|
|
|
1020 (list :tag "Pattern"
|
|
|
1021 :value (:pattern "~/" "^.+\\.suffix$")
|
|
|
1022 (const :format "" :value :pattern)
|
|
|
1023 (directory :tag "Dir")
|
|
|
1024 (regexp :tag "Pattern"))
|
|
|
1025 (cons :tag "Files"
|
|
|
1026 :value (:files)
|
|
|
1027 (const :format "" :value :files)
|
|
|
1028 (repeat :tag "Files" file))
|
|
|
1029 (list :tag "Single File"
|
|
|
1030 :value (:file "~/")
|
|
|
1031 (const :format "" :value :file)
|
|
|
1032 (file :tag "File"))
|
|
|
1033 (list :tag "Inclusion group"
|
|
|
1034 :value (:ingroup "~/")
|
|
|
1035 (const :format "" :value :ingroup)
|
|
|
1036 (file :tag "File" :value "~/"))
|
|
|
1037 (list :tag "Directory Tree"
|
|
|
1038 :value (:tree "~/" "^.+\\.suffix$")
|
|
|
1039 (const :format "" :value :tree)
|
|
|
1040 (directory :tag "Dir")
|
|
|
1041 (regexp :tag "Pattern"))
|
|
|
1042 (list :tag "Filter directories"
|
|
|
1043 :value (:filter-dirs-flag)
|
|
|
1044 (const :format "" :value :filter-dirs-flag)
|
|
|
1045 (boolean :tag "Boolean" :value nil))
|
|
|
1046 (list :tag "Scanning depth"
|
|
|
1047 :value (:tree-max-level 3)
|
|
|
1048 (const :format "" :value :tree-max-level)
|
|
|
1049 (integer :tag "Integer"))
|
|
|
1050 (list :tag "Verbosity"
|
|
|
1051 :value (:verbosity 1)
|
|
|
1052 (const :format "" :value :verbosity)
|
|
|
1053 (integer :tag "Integer"))
|
|
|
1054 (list :tag "Conceal fileset (Flag)"
|
|
|
1055 :value (:dormant-flag)
|
|
|
1056 (const :format "" :value :dormant-flag)
|
|
|
1057 (boolean :tag "Boolean"))
|
|
|
1058 (list :tag "Conceal fileset (Function)"
|
|
|
1059 :value (:dormant-p)
|
|
|
1060 (const :format "" :value :dormant-p)
|
|
|
1061 (function :tag "Function"))
|
|
|
1062 (list :tag "Save function"
|
|
|
1063 :value (:save)
|
|
|
1064 (const :format "" :value :save)
|
|
|
1065 (function :tag "Function"))
|
|
|
1066 (list :tag "Open function"
|
|
|
1067 :value (:open)
|
|
|
1068 (const :format "" :value :open)
|
|
|
1069 (function :tag "Function")))))))
|
|
45132
|
1070 (put 'filesets-data 'risky-local-variable t)
|
|
44934
|
1071
|
|
|
1072
|
|
|
1073 (defcustom filesets-query-user-limit 15
|
|
84660
|
1074 "Query the user before opening a fileset with that many files."
|
|
44934
|
1075 :set (function filesets-set-default)
|
|
|
1076 :type 'integer
|
|
|
1077 :group 'filesets)
|
|
50782
|
1078
|
|
44934
|
1079 ;;; Emacs compatibility
|
|
|
1080 (eval-and-compile
|
|
84660
|
1081 (if (featurep 'xemacs)
|
|
61138
|
1082 (fset 'filesets-error 'error)
|
|
44934
|
1083
|
|
45012
|
1084 (require 'easymenu)
|
|
49475
|
1085
|
|
45012
|
1086 (defun filesets-error (class &rest args)
|
|
|
1087 "`error' wrapper."
|
|
84660
|
1088 (error "%s" (mapconcat 'identity args " ")))
|
|
44934
|
1089
|
|
45012
|
1090 ))
|
|
44934
|
1091
|
|
|
1092 (defun filesets-filter-dir-names (lst &optional negative)
|
|
84660
|
1093 "Remove non-directory names from a list of strings.
|
|
|
1094 If NEGATIVE is non-nil, remove all directory names."
|
|
44934
|
1095 (filesets-filter-list lst
|
|
|
1096 (lambda (x)
|
|
|
1097 (and (not (string-match "^\\.+/$" x))
|
|
|
1098 (if negative
|
|
|
1099 (not (string-match "[:/\\]$" x))
|
|
|
1100 (string-match "[:/\\]$" x))))))
|
|
|
1101
|
|
84660
|
1102 (defun filesets-conditional-sort (lst &optional access-fn)
|
|
44934
|
1103 "Return a sorted copy of LST, LST being a list of strings.
|
|
|
1104 If `filesets-sort-menu-flag' is nil, return LST itself.
|
|
|
1105
|
|
85317
|
1106 ACCESS-FN ... function to get the string value of LST's elements."
|
|
44934
|
1107 (if filesets-sort-menu-flag
|
|
|
1108 (let* ((fni (or access-fn
|
|
|
1109 (function identity)))
|
|
|
1110 (fn (if filesets-sort-case-sensitive-flag
|
|
|
1111 (lambda (a b)
|
|
|
1112 (string< (funcall fni a)
|
|
|
1113 (funcall fni b)))
|
|
|
1114 (lambda (a b)
|
|
|
1115 (string< (upcase (funcall fni a))
|
|
|
1116 (upcase (funcall fni b)))))))
|
45186
aa4f6ae8b6a9
(filesets-conditional-sort): Use copy-sequence, not copy-list.
Markus Rost <rost@math.uni-bielefeld.de>
diff
changeset
|
1117 (sort (copy-sequence lst) fn))
|
|
44934
|
1118 lst))
|
|
|
1119
|
|
|
1120 (defun filesets-directory-files (dir &optional
|
|
|
1121 pattern what full-flag match-dirs-flag)
|
|
84660
|
1122 "Get WHAT (:files or :dirs) in DIR.
|
|
|
1123 If PATTERN is provided return only those entries matching this
|
|
|
1124 regular expression.
|
|
|
1125 If MATCH-DIRS-FLAG is non-nil, also match directory entries.
|
|
|
1126 Return full path if FULL-FLAG is non-nil."
|
|
44934
|
1127 (filesets-message 2 "Filesets: scanning %S" dir)
|
|
|
1128 (cond
|
|
|
1129 ((file-exists-p dir)
|
|
|
1130 (let ((files nil)
|
|
|
1131 (dirs nil))
|
|
|
1132 (dolist (this (file-name-all-completions "" dir))
|
|
49475
|
1133 (cond
|
|
44934
|
1134 ((string-match "^\\.+/$" this)
|
|
|
1135 nil)
|
|
|
1136 ((string-match "[:/\\]$" this)
|
|
|
1137 (when (or (not match-dirs-flag)
|
|
|
1138 (not pattern)
|
|
|
1139 (string-match pattern this))
|
|
49475
|
1140 (filesets-message 5 "Filesets: matched dir %S with pattern %S"
|
|
44934
|
1141 this pattern)
|
|
|
1142 (setq dirs (cons this dirs))))
|
|
|
1143 (t
|
|
|
1144 (when (or (not pattern)
|
|
|
1145 (string-match pattern this))
|
|
49475
|
1146 (filesets-message 5 "Filesets: matched file %S with pattern %S"
|
|
44934
|
1147 this pattern)
|
|
|
1148 (setq files (cons (if full-flag
|
|
|
1149 (concat (file-name-as-directory dir) this)
|
|
|
1150 this)
|
|
|
1151 files))))))
|
|
|
1152 (cond
|
|
|
1153 ((equal what ':dirs)
|
|
|
1154 (filesets-conditional-sort dirs))
|
|
|
1155 ((equal what ':files)
|
|
|
1156 (filesets-conditional-sort files))
|
|
|
1157 (t
|
|
|
1158 (append (filesets-conditional-sort files)
|
|
|
1159 (filesets-conditional-sort dirs))))))
|
|
|
1160 (filesets-be-docile-flag
|
|
|
1161 (filesets-message 1 "Filesets: %S doesn't exist" dir)
|
|
|
1162 nil)
|
|
|
1163 (t
|
|
|
1164 (filesets-error 'error "Filesets: " dir " does not exist"))))
|
|
|
1165
|
|
|
1166 (defun filesets-quote (txt)
|
|
|
1167 "Return TXT in quotes."
|
|
|
1168 (concat "\"" txt "\""))
|
|
|
1169
|
|
|
1170 (defun filesets-get-selection ()
|
|
|
1171 "Get the text between mark and point -- i.e. the selection or region."
|
|
|
1172 (let ((m (mark))
|
|
|
1173 (p (point)))
|
|
|
1174 (if m
|
|
|
1175 (buffer-substring (min m p) (max m p))
|
|
|
1176 (filesets-error 'error "No selection."))))
|
|
|
1177
|
|
|
1178 (defun filesets-get-quoted-selection ()
|
|
|
1179 "Return the currently selected text in quotes."
|
|
|
1180 (filesets-quote (filesets-get-selection)))
|
|
|
1181
|
|
|
1182 (defun filesets-get-shortcut (n)
|
|
|
1183 "Create menu shortcuts based on number N."
|
|
|
1184 (let ((n (mod (- n 1) 51)))
|
|
|
1185 (cond
|
|
|
1186 ((not filesets-menu-shortcuts-flag)
|
|
|
1187 "")
|
|
|
1188 ((<= n 9)
|
|
|
1189 (concat (number-to-string n) " "))
|
|
|
1190 ((<= n 35)
|
|
|
1191 (format "%c " (+ 87 n)))
|
|
|
1192 ((<= n 51)
|
|
|
1193 (format "%c " (+ -3 n))))))
|
|
|
1194
|
|
|
1195 (defun filesets-files-equalp (a b)
|
|
|
1196 "Compare two filenames A and B after expansion."
|
|
|
1197 (equal (expand-file-name a) (expand-file-name b)))
|
|
|
1198
|
|
|
1199 (defun filesets-files-in-same-directory-p (a b)
|
|
|
1200 "Compare two filenames A and B after expansion."
|
|
|
1201 (let ((ad (file-name-directory (expand-file-name a)))
|
|
|
1202 (bd (file-name-directory (expand-file-name b))))
|
|
|
1203 (equal ad bd)))
|
|
|
1204
|
|
|
1205 (defun filesets-convert-path-list (string)
|
|
|
1206 "Return a path-list given as STRING as list."
|
|
|
1207 (if string
|
|
|
1208 (mapcar (lambda (x) (file-name-as-directory x))
|
|
|
1209 (split-string string path-separator))
|
|
|
1210 nil))
|
|
|
1211
|
|
|
1212 (defun filesets-which-file (master filename &optional path-list)
|
|
|
1213 "Search for a FILENAME relative to a MASTER file in PATH-LIST."
|
|
|
1214 (let ((f (concat (file-name-directory master)
|
|
|
1215 filename)))
|
|
|
1216 (if (file-exists-p f)
|
|
|
1217 f
|
|
45164
|
1218 (filesets-some
|
|
|
1219 (lambda (dir)
|
|
|
1220 (let ((dir (file-name-as-directory dir))
|
|
|
1221 (files (if (file-exists-p dir)
|
|
|
1222 (filesets-directory-files dir nil ':files)
|
|
|
1223 nil)))
|
|
|
1224 (filesets-some (lambda (file)
|
|
|
1225 (if (equal filename (file-name-nondirectory file))
|
|
|
1226 (concat dir file)
|
|
|
1227 nil))
|
|
|
1228 files)))
|
|
|
1229 path-list))))
|
|
44934
|
1230
|
|
|
1231
|
|
|
1232 (defun filesets-eviewer-get-props (entry)
|
|
|
1233 "Get ENTRY's (representing an external viewer) properties."
|
|
|
1234 (nth 2 entry))
|
|
|
1235
|
|
|
1236 (defun filesets-eviewer-constraint-p (entry)
|
|
|
1237 (let* ((props (filesets-eviewer-get-props entry))
|
|
|
1238 (constraint (assoc ':constraintp props))
|
|
|
1239 (constraint-flag (assoc ':constraint-flag props)))
|
|
|
1240 (cond
|
|
|
1241 (constraint
|
|
|
1242 (funcall (cadr constraint)))
|
|
|
1243 (constraint-flag
|
|
|
1244 (eval (cadr constraint-flag)))
|
|
|
1245 (t
|
|
|
1246 t))))
|
|
|
1247
|
|
|
1248 (defun filesets-get-external-viewer (file)
|
|
|
1249 "Find an external viewer for FILE."
|
|
|
1250 (let ((filename (file-name-nondirectory file)))
|
|
45164
|
1251 (filesets-some
|
|
44934
|
1252 (lambda (entry)
|
|
|
1253 (when (and (string-match (nth 0 entry) filename)
|
|
|
1254 (filesets-eviewer-constraint-p entry))
|
|
|
1255 entry))
|
|
|
1256 filesets-external-viewers)))
|
|
|
1257
|
|
|
1258 (defun filesets-get-external-viewer-by-name (name)
|
|
|
1259 "Get the external viewer definition called NAME."
|
|
|
1260 (when name
|
|
45164
|
1261 (filesets-some
|
|
44934
|
1262 (lambda (entry)
|
|
|
1263 (when (and (string-equal (nth 1 entry) name)
|
|
|
1264 (filesets-eviewer-constraint-p entry))
|
|
|
1265 entry))
|
|
|
1266 filesets-external-viewers)))
|
|
|
1267
|
|
|
1268 (defun filesets-filetype-property (filename event &optional entry)
|
|
84660
|
1269 "Return non-nil if a file of a specific type has special flags/tags.
|
|
44934
|
1270
|
|
|
1271 Events (corresponding tag):
|
|
|
1272
|
|
|
1273 on-open-all (:ignore-on-open-all) ... Exclude files of this when opening
|
|
|
1274 a fileset
|
|
|
1275
|
|
|
1276 on-grep (:ignore-on-read-text) ... Exclude files of this when running
|
|
|
1277 the \"Grep <<selection>>\" command
|
|
|
1278
|
|
|
1279 on-capture-output (:capture-output) ... Capture output of an external viewer
|
|
|
1280
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1281 on-ls ... Not used
|
|
44934
|
1282
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1283 on-cmd ... Not used
|
|
44934
|
1284
|
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1285 on-close-all ... Not used"
|
|
44934
|
1286 (let ((def (filesets-eviewer-get-props
|
|
|
1287 (or entry
|
|
|
1288 (filesets-get-external-viewer filename)))))
|
|
|
1289 (filesets-alist-get def
|
|
|
1290 (case event
|
|
|
1291 ((on-open-all) ':ignore-on-open-all)
|
|
|
1292 ((on-grep) ':ignore-on-read-text)
|
|
|
1293 ((on-cmd) nil)
|
|
|
1294 ((on-close-all) nil))
|
|
|
1295 nil t)))
|
|
|
1296
|
|
|
1297 (defun filesets-filetype-get-prop (property filename &optional entry)
|
|
84660
|
1298 "Return PROPERTY for filename -- use ENTRY if provided."
|
|
44934
|
1299 (let ((def (filesets-eviewer-get-props
|
|
|
1300 (or entry
|
|
|
1301 (filesets-get-external-viewer filename)))))
|
|
|
1302 (when def
|
|
|
1303 (filesets-alist-get def property nil t))))
|
|
49475
|
1304
|
|
44934
|
1305 (defun filesets-reset-filename-on-change ()
|
|
|
1306 "Reset a buffer's filename if the buffer is being modified."
|
|
|
1307 (when filesets-output-buffer-flag
|
|
|
1308 (set-visited-file-name nil t)))
|
|
|
1309
|
|
|
1310 (defun filesets-spawn-external-viewer (file &optional ev-entry)
|
|
|
1311 "Start an external viewer for FILE.
|
|
|
1312 Use the viewer defined in EV-ENTRY (a valid element of
|
|
|
1313 `filesets-external-viewers') if provided."
|
|
|
1314 (let* ((file (expand-file-name file))
|
|
|
1315 (entry (or ev-entry
|
|
|
1316 (filesets-get-external-viewer file))))
|
|
|
1317 (if entry
|
|
|
1318 (let* ((vwr (cadr entry))
|
|
|
1319 (co-flag (filesets-filetype-get-prop ':capture-output file entry))
|
|
|
1320 (oh (filesets-filetype-get-prop ':open-hook file entry))
|
|
|
1321 (args (let ((fmt (filesets-filetype-get-prop ':args file entry)))
|
|
|
1322 (if fmt
|
|
|
1323 (let ((rv ""))
|
|
|
1324 (dolist (this fmt rv)
|
|
|
1325 (setq rv (concat rv
|
|
|
1326 (cond
|
|
|
1327 ((stringp this)
|
|
|
1328 (format this file))
|
|
|
1329 ((and (symbolp this)
|
|
|
1330 (fboundp this))
|
|
|
1331 (format "%S" (funcall this)))
|
|
|
1332 (t
|
|
|
1333 (format "%S" this)))))))
|
|
|
1334 (format "%S" file))))
|
|
|
1335 (output
|
|
|
1336 (cond
|
|
|
1337 ((and (functionp vwr) co-flag)
|
|
|
1338 (funcall vwr file))
|
|
|
1339 ((functionp vwr)
|
|
|
1340 (funcall vwr file)
|
|
|
1341 nil)
|
|
|
1342 (co-flag
|
|
|
1343 (shell-command-to-string (format "%s %s" vwr args)))
|
|
|
1344 (t
|
|
|
1345 (shell-command (format "%s %s&" vwr args))
|
|
|
1346 nil))))
|
|
|
1347 (if co-flag
|
|
|
1348 (progn
|
|
|
1349 (switch-to-buffer (format "Filesets: %s %s" vwr file))
|
|
|
1350 (insert output)
|
|
|
1351 (make-local-variable 'filesets-output-buffer-flag)
|
|
|
1352 (setq filesets-output-buffer-flag t)
|
|
|
1353 (set-visited-file-name file t)
|
|
|
1354 (when oh
|
|
|
1355 (run-hooks 'oh))
|
|
|
1356 (set-buffer-modified-p nil)
|
|
|
1357 (setq buffer-read-only t)
|
|
58039
|
1358 (goto-char (point-min)))
|
|
44934
|
1359 (when oh
|
|
|
1360 (run-hooks 'oh))))
|
|
|
1361 (filesets-error 'error
|
|
|
1362 "Filesets: general error when spawning external viewer"))))
|
|
|
1363
|
|
|
1364 (defun filesets-find-file (file)
|
|
|
1365 "Call `find-file' after a possible delay (see `filesets-find-file-delay').
|
|
|
1366 If `filesets-be-docile-flag' is true, a file, which isn't readable, will
|
|
|
1367 not be opened."
|
|
|
1368 ; (sleep-for filesets-find-file-delay)
|
|
|
1369 (when (or (file-readable-p file)
|
|
|
1370 (not filesets-be-docile-flag))
|
|
|
1371 (sit-for filesets-find-file-delay)
|
|
|
1372 (find-file file)))
|
|
|
1373
|
|
|
1374 (defun filesets-find-or-display-file (&optional file viewer)
|
|
79092
|
1375 "Visit FILE using an external VIEWER or open it in an Emacs buffer."
|
|
44934
|
1376 (interactive)
|
|
|
1377 (let* ((file (or file
|
|
|
1378 (read-file-name "Find file: " nil nil viewer)))
|
|
|
1379 (external-viewer-def (or
|
|
|
1380 (filesets-get-external-viewer-by-name viewer)
|
|
|
1381 (filesets-get-external-viewer file))))
|
|
|
1382 (filesets-message 3 "Filesets: view %S using %s" file external-viewer-def)
|
|
|
1383 (if external-viewer-def
|
|
|
1384 (filesets-spawn-external-viewer file external-viewer-def)
|
|
|
1385 (filesets-find-file file))))
|
|
|
1386
|
|
45012
|
1387 (defun filesets-find-file-using ()
|
|
44934
|
1388 "Select a viewer and call `filesets-find-or-display-file'."
|
|
|
1389 (interactive)
|
|
|
1390 (let* ((lst (mapcar (lambda (this)
|
|
|
1391 (let ((a (cadr this)))
|
|
|
1392 (list (format "%s" a) a)))
|
|
|
1393 filesets-external-viewers))
|
|
|
1394 (viewer (completing-read "Using viewer: " lst nil t)))
|
|
|
1395 (when viewer
|
|
|
1396 (filesets-find-or-display-file nil (cadr (assoc viewer lst))))))
|
|
|
1397
|
|
|
1398 (defun filesets-browser-name ()
|
|
45132
|
1399 "Get the directory browser's name as defined in `filesets-browse-dir-function'."
|
|
44934
|
1400 (cond
|
|
45132
|
1401 ((listp filesets-browse-dir-function)
|
|
|
1402 (car filesets-browse-dir-function))
|
|
44934
|
1403 (t
|
|
45132
|
1404 filesets-browse-dir-function)))
|
|
44934
|
1405
|
|
|
1406 (defun filesets-browse-dir (dir)
|
|
45132
|
1407 "Browse DIR using `filesets-browse-dir-function'."
|
|
|
1408 (if (functionp filesets-browse-dir-function)
|
|
|
1409 (funcall filesets-browse-dir-function dir)
|
|
|
1410 (let ((name (car filesets-browse-dir-function))
|
|
|
1411 (args (format (cadr filesets-browse-dir-function) (expand-file-name dir))))
|
|
44934
|
1412 (with-temp-buffer
|
|
|
1413 (start-process (concat "Filesets:" name)
|
|
|
1414 "*Filesets external directory browser*"
|
|
|
1415 name args)))))
|
|
|
1416
|
|
|
1417 (defun filesets-get-fileset-name (something)
|
|
84660
|
1418 "Get SOMETHING's name (Don't ask)."
|
|
44934
|
1419 (cond
|
|
|
1420 ((listp something)
|
|
|
1421 (car something))
|
|
|
1422 (t
|
|
|
1423 something)))
|
|
|
1424
|
|
|
1425 (defun filesets-data-get-name (entry)
|
|
79092
|
1426 "Access to `filesets-data'. Get the ENTRY's name."
|
|
44934
|
1427 (car entry))
|
|
|
1428
|
|
|
1429 (defun filesets-data-get-data (entry)
|
|
79092
|
1430 "Access to `filesets-data'. Get the ENTRY's data section."
|
|
44934
|
1431 (cdr entry))
|
|
|
1432
|
|
|
1433 (defun filesets-alist-get (alist key &optional default carp)
|
|
|
1434 "Get KEY's value in the association list ALIST.
|
|
|
1435 Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
|
|
79092
|
1436 (let ((elt (assoc key alist)))
|
|
44934
|
1437 (cond
|
|
79092
|
1438 (elt
|
|
|
1439 (if carp
|
|
|
1440 (cadr elt)
|
|
|
1441 (cdr elt)))
|
|
|
1442 (default default)
|
|
|
1443 (t nil))))
|
|
44934
|
1444
|
|
|
1445 (defun filesets-data-get (entry key &optional default carp)
|
|
|
1446 "Extract the value for KEY in the data part of fileset ENTRY.
|
|
|
1447 Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
|
|
|
1448 (filesets-alist-get (filesets-data-get-data entry) key default carp))
|
|
|
1449
|
|
|
1450 (defun filesets-data-set (entry key value)
|
|
79092
|
1451 "Set the VALUE for KEY in the data part of fileset ENTRY."
|
|
44934
|
1452 (let* ((alist (filesets-data-get-data entry))
|
|
|
1453 (elt (assoc key alist)))
|
|
|
1454 (if elt
|
|
|
1455 (setcdr elt value)
|
|
|
1456 (setcdr entry (cons (cons key value) alist)))))
|
|
|
1457
|
|
|
1458 (defun filesets-entry-mode (entry)
|
|
|
1459 "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
|
|
|
1460 See `filesets-data'."
|
|
|
1461 (let ((data (filesets-data-get-data entry)))
|
|
45164
|
1462 (filesets-some
|
|
|
1463 (lambda (x)
|
|
|
1464 (if (assoc x data)
|
|
|
1465 x))
|
|
|
1466 '(:files :tree :pattern :ingroup :file))))
|
|
44934
|
1467
|
|
|
1468 (defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry)
|
|
|
1469 "Get the open-function for FILESET-NAME.
|
|
|
1470 Use FILESET-ENTRY for finding the open function, if provided."
|
|
|
1471 (filesets-data-get (or fileset-entry
|
|
|
1472 (filesets-get-fileset-from-name fileset-name))
|
|
45132
|
1473 ':open filesets-open-file-function t))
|
|
44934
|
1474
|
|
|
1475 (defun filesets-entry-get-save-fn (fileset-name &optional fileset-entry)
|
|
|
1476 "Get the save-function for FILESET-NAME.
|
|
|
1477 Use FILESET-ENTRY for finding the save function, if provided."
|
|
|
1478 (filesets-data-get (or fileset-entry
|
|
|
1479 (filesets-get-fileset-from-name fileset-name))
|
|
45132
|
1480 ':save filesets-save-buffer-function t))
|
|
44934
|
1481
|
|
|
1482 (defun filesets-entry-get-files (entry)
|
|
|
1483 "Get the file list for fileset ENTRY."
|
|
|
1484 (filesets-data-get entry ':files))
|
|
|
1485
|
|
|
1486 (defun filesets-entry-set-files (entry data &optional anyways)
|
|
|
1487 "Set the file list for fileset ENTRY."
|
|
|
1488 (let ((files (filesets-entry-get-files entry)))
|
|
|
1489 (if (or anyways files)
|
|
|
1490 (filesets-data-set entry ':files data))))
|
|
|
1491
|
|
|
1492 (defun filesets-entry-get-verbosity (entry)
|
|
|
1493 "Get verbosity level for fileset ENTRY."
|
|
|
1494 (filesets-data-get entry ':verbosity 1 t))
|
|
|
1495
|
|
|
1496 (defun filesets-entry-get-file (entry)
|
|
|
1497 "Get the single file for fileset ENTRY."
|
|
|
1498 (filesets-data-get entry ':file nil t))
|
|
|
1499
|
|
|
1500 (defun filesets-entry-get-pattern (entry)
|
|
|
1501 "Get the base directory + file pattern for fileset ENTRY."
|
|
|
1502 ; (filesets-data-get entry ':pattern nil t))
|
|
|
1503 (filesets-data-get entry ':pattern))
|
|
|
1504
|
|
|
1505 (defun filesets-entry-get-pattern--pattern (list)
|
|
|
1506 "Get the file pattern for LIST."
|
|
|
1507 (if (= (length list) 1) ;; for compatibility with filesets < v1.5.5
|
|
|
1508 (file-name-nondirectory (car list))
|
|
|
1509 (cadr list)))
|
|
|
1510
|
|
|
1511 (defun filesets-entry-get-pattern--dir (list)
|
|
|
1512 "Get a file pattern's base directory for LIST."
|
|
|
1513 (if (= (length list) 1) ;; for compatibility with filesets < v1.5.5
|
|
|
1514 (file-name-directory (car list))
|
|
|
1515 (car list)))
|
|
|
1516
|
|
|
1517 (defun filesets-entry-get-tree (entry)
|
|
|
1518 "Get the tree pattern for fileset ENTRY."
|
|
|
1519 (filesets-data-get entry ':tree))
|
|
|
1520
|
|
|
1521 (defun filesets-entry-get-dormant-flag (entry)
|
|
|
1522 "Get dormant flag for fileset ENTRY."
|
|
|
1523 (let ((fn (filesets-data-get entry ':dormant-p nil t)))
|
|
|
1524 (if fn
|
|
|
1525 (funcall fn)
|
|
|
1526 (filesets-data-get entry ':dormant-flag nil t))))
|
|
|
1527
|
|
|
1528 (defun filesets-entry-get-filter-dirs-flag (entry)
|
|
|
1529 "Get filter-dirs-flag for fileset ENTRY."
|
|
|
1530 (filesets-data-get entry ':filter-dirs-flag nil t))
|
|
|
1531
|
|
|
1532 (defun filesets-entry-get-tree-max-level (entry)
|
|
|
1533 "Get maximal tree scanning depth for fileset ENTRY."
|
|
|
1534 (filesets-data-get entry ':tree-max-level nil t))
|
|
|
1535
|
|
|
1536 (defun filesets-entry-get-master (entry)
|
|
|
1537 "Get the base file for fileset ENTRY."
|
|
|
1538 (filesets-data-get entry ':ingroup nil t))
|
|
|
1539
|
|
|
1540 (defun filesets-file-open (open-function file-name &optional fileset-name)
|
|
84660
|
1541 "Open FILE-NAME using OPEN-FUNCTION.
|
|
|
1542 If OPEN-FUNCTION is nil, its value will be deduced from FILESET-NAME."
|
|
44934
|
1543 (let ((open-function (or open-function
|
|
|
1544 (filesets-entry-get-open-fn fileset-name))))
|
|
|
1545 (if (file-readable-p file-name)
|
|
|
1546 (funcall open-function file-name)
|
|
|
1547 (message "Filesets: Couldn't open `%s'" file-name))))
|
|
|
1548
|
|
|
1549 (defun filesets-file-close (save-function buffer)
|
|
|
1550 "Close BUFFER.
|
|
|
1551 First, save the buffer's contents using SAVE-FUNCTION. Then, kill buffer
|
|
|
1552 if `buffer-modified-p' returns nil.
|
|
|
1553
|
|
|
1554 SAVE-FUNCTION takes no argument, but works on the current buffer."
|
|
105994
|
1555 (with-current-buffer buffer
|
|
44934
|
1556 (if (buffer-modified-p)
|
|
|
1557 (funcall save-function))
|
|
|
1558 (if (not (buffer-modified-p))
|
|
|
1559 (kill-buffer buffer))))
|
|
|
1560
|
|
|
1561 (defun filesets-get-fileset-from-name (name &optional mode)
|
|
|
1562 "Get fileset definition for NAME."
|
|
|
1563 (case mode
|
|
|
1564 ((:ingroup :tree)
|
|
|
1565 name)
|
|
|
1566 (t
|
|
|
1567 (assoc name filesets-data))))
|
|
|
1568
|
|
|
1569
|
|
|
1570 ;;; commands
|
|
|
1571 (defun filesets-cmd-get-def (cmd-name)
|
|
|
1572 "Get `filesets-commands' entry for CMD-NAME."
|
|
|
1573 (assoc cmd-name filesets-commands))
|
|
|
1574
|
|
|
1575 (defun filesets-cmd-get-args (cmd-name)
|
|
|
1576 (let ((args (let ((def (filesets-cmd-get-def cmd-name)))
|
|
|
1577 (nth 2 def)))
|
|
|
1578 (rv nil))
|
|
|
1579 (dolist (this args rv)
|
|
|
1580 (cond
|
|
|
1581 ((and (symbolp this) (fboundp this))
|
|
|
1582 (let ((x (funcall this)))
|
|
49475
|
1583 (setq rv (append rv (if (listp x) x (list x))))))
|
|
44934
|
1584 (t
|
|
|
1585 (setq rv (append rv (list this))))))))
|
|
|
1586
|
|
|
1587 (defun filesets-cmd-get-fn (cmd-name)
|
|
|
1588 (let ((def (filesets-cmd-get-def cmd-name)))
|
|
|
1589 (nth 1 def)))
|
|
|
1590
|
|
|
1591 (defun filesets-cmd-show-result (cmd output)
|
|
|
1592 "Show OUTPUT of CMD (a shell command)."
|
|
|
1593 (pop-to-buffer "*Filesets: Shell Command Output*")
|
|
58039
|
1594 (with-no-warnings
|
|
|
1595 (end-of-buffer))
|
|
44934
|
1596 (insert "*** ")
|
|
|
1597 (insert cmd)
|
|
|
1598 (newline)
|
|
|
1599 (insert output)
|
|
|
1600 (newline))
|
|
|
1601
|
|
|
1602 (defun filesets-run-cmd--repl-fn (arg &optional format-fn)
|
|
84660
|
1603 "Helper function for `filesets-run-cmd'. Apply FORMAT-FN to arg.
|
|
44934
|
1604 Replace <file-name> or <<file-name>> with filename."
|
|
|
1605 (funcall format-fn (cond
|
|
|
1606 ((equal arg "<file-name>")
|
|
|
1607 (buffer-file-name))
|
|
|
1608 ((equal arg "<<file-name>>")
|
|
73369
|
1609 (shell-quote-argument (buffer-file-name)))
|
|
44934
|
1610 (t
|
|
|
1611 arg))))
|
|
|
1612
|
|
|
1613 (defun filesets-run-cmd (&optional cmd-name fileset mode)
|
|
|
1614 "Run CMD-NAME (see `filesets-commands') on FILESET."
|
|
|
1615 (interactive)
|
|
|
1616 (let* ((cmd-name (or cmd-name
|
|
|
1617 (completing-read "Select command: " filesets-commands
|
|
|
1618 nil t)))
|
|
|
1619 (name (or fileset
|
|
|
1620 (completing-read "Select fileset: " filesets-data nil t))))
|
|
|
1621 (when (and cmd-name name)
|
|
|
1622 (let* ((event (if (equal cmd-name "Grep <<selection>>")
|
|
|
1623 'on-grep
|
|
|
1624 'on-cmd))
|
|
|
1625 (files (if (and fileset
|
|
|
1626 (or (equal mode ':ingroup)
|
|
|
1627 (equal mode ':tree)))
|
|
|
1628 (filesets-get-filelist fileset mode event)
|
|
49475
|
1629 (filesets-get-filelist
|
|
44934
|
1630 (filesets-get-fileset-from-name name)
|
|
|
1631 mode event))))
|
|
|
1632 (when files
|
|
|
1633 (let ((fn (filesets-cmd-get-fn cmd-name))
|
|
|
1634 (args (filesets-cmd-get-args cmd-name)))
|
|
96958
|
1635 (if (memq fn '(multi-isearch-files multi-isearch-files-regexp))
|
|
|
1636 (apply fn args)
|
|
|
1637 (dolist (this files nil)
|
|
|
1638 (save-excursion
|
|
|
1639 (save-restriction
|
|
|
1640 (let ((buffer (filesets-find-file this)))
|
|
|
1641 (when buffer
|
|
|
1642 (goto-char (point-min))
|
|
104993
|
1643 (progn
|
|
96958
|
1644 (cond
|
|
|
1645 ((stringp fn)
|
|
|
1646 (let* ((args
|
|
|
1647 (let ((txt ""))
|
|
|
1648 (dolist (this args txt)
|
|
|
1649 (setq txt
|
|
|
1650 (concat txt
|
|
|
1651 (filesets-run-cmd--repl-fn
|
|
|
1652 this
|
|
|
1653 (lambda (this)
|
|
|
1654 (if (equal txt "") "" " ")
|
|
|
1655 (format "%s" this))))))))
|
|
|
1656 (cmd (concat fn " " args)))
|
|
|
1657 (filesets-cmd-show-result
|
|
|
1658 cmd (shell-command-to-string cmd))))
|
|
|
1659 ((symbolp fn)
|
|
|
1660 (let ((args
|
|
|
1661 (let ((argl nil))
|
|
|
1662 (dolist (this args argl)
|
|
|
1663 (setq argl
|
|
|
1664 (append argl
|
|
|
1665 (filesets-run-cmd--repl-fn
|
|
|
1666 this
|
|
|
1667 'list)))))))
|
|
|
1668 (apply fn args)))))))))))))))))
|
|
44934
|
1669
|
|
|
1670 (defun filesets-get-cmd-menu ()
|
|
|
1671 "Create filesets command menu."
|
|
|
1672 `("+ Commands"
|
|
|
1673 . ,(mapcar (lambda (this)
|
|
|
1674 (let ((name (car this)))
|
|
|
1675 `[,name (filesets-run-cmd ,name)]))
|
|
|
1676 filesets-commands)))
|
|
|
1677
|
|
|
1678
|
|
79092
|
1679 ;;; sample commands
|
|
44934
|
1680 (defun filesets-cmd-query-replace-getargs ()
|
|
79092
|
1681 "Get arguments for `query-replace' and `query-replace-regexp'."
|
|
96958
|
1682 (let ((common (query-replace-read-args "Filesets query replace" nil t)))
|
|
|
1683 (list (nth 0 common) (nth 1 common) t nil (nth 2 common) nil
|
|
|
1684 multi-query-replace-map)))
|
|
|
1685
|
|
|
1686 (defun filesets-cmd-query-replace-regexp-getargs ()
|
|
|
1687 "Get arguments for `query-replace' and `query-replace-regexp'."
|
|
|
1688 (let ((common (query-replace-read-args "Filesets query replace" t t)))
|
|
|
1689 (list (nth 0 common) (nth 1 common) t t (nth 2 common) nil
|
|
|
1690 multi-query-replace-map)))
|
|
|
1691
|
|
|
1692 (defun filesets-cmd-isearch-getargs ()
|
|
|
1693 "Get arguments for `multi-isearch-files' and `multi-isearch-files-regexp'."
|
|
97155
|
1694 (and (boundp 'files) (list files)))
|
|
44934
|
1695
|
|
|
1696 (defun filesets-cmd-shell-command-getargs ()
|
|
|
1697 "Get arguments for `filesets-cmd-shell-command'."
|
|
|
1698 (let* ((arg (read-string "Shell command (%s = file): "
|
|
|
1699 "%s"
|
|
|
1700 'shell-command-history)))
|
|
|
1701 arg))
|
|
|
1702
|
|
|
1703 (defun filesets-cmd-shell-command (txt)
|
|
|
1704 "Wrapper function for `shell-command'."
|
|
|
1705 (let ((ok (if (buffer-modified-p)
|
|
|
1706 (let ((ok (y-or-n-p "Save buffer? ")))
|
|
|
1707 (when ok
|
|
|
1708 (save-buffer))
|
|
|
1709 ok)
|
|
|
1710 t)))
|
|
|
1711 (when ok
|
73366
d0dd803ef151
(filesets-cmd-shell-command): Quote buffer-file-name to protect whitespace and
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1712 (let ((cmd (format txt (shell-quote-argument (buffer-file-name)))))
|
|
44934
|
1713 (message "Filesets: %s" cmd)
|
|
|
1714 (filesets-cmd-show-result cmd
|
|
|
1715 (shell-command-to-string cmd))))))
|
|
|
1716
|
|
|
1717
|
|
|
1718 ;;; body
|
|
|
1719 (defun filesets-get-filelist (entry &optional mode event)
|
|
|
1720 "Get all files for fileset ENTRY.
|
|
|
1721 Assume MODE (see `filesets-entry-mode'), if provided."
|
|
|
1722 (let* ((mode (or mode
|
|
|
1723 (filesets-entry-mode entry)))
|
|
|
1724 (fl (case mode
|
|
|
1725 ((:files)
|
|
|
1726 (filesets-entry-get-files entry))
|
|
|
1727 ((:file)
|
|
|
1728 (list (filesets-entry-get-file entry)))
|
|
|
1729 ((:ingroup)
|
|
|
1730 (let ((entry (expand-file-name
|
|
|
1731 (if (stringp entry)
|
|
|
1732 entry
|
|
|
1733 (filesets-entry-get-master entry)))))
|
|
|
1734 (cons entry (filesets-ingroup-cache-get entry))))
|
|
|
1735 ((:tree)
|
|
|
1736 (let ((dir (nth 0 entry))
|
|
|
1737 (patt (nth 1 entry)))
|
|
|
1738 (filesets-directory-files dir patt ':files t)))
|
|
|
1739 ((:pattern)
|
|
|
1740 (let ((dirpatt (filesets-entry-get-pattern entry)))
|
|
|
1741 (if dirpatt
|
|
|
1742 (let ((dir (filesets-entry-get-pattern--dir dirpatt))
|
|
|
1743 (patt (filesets-entry-get-pattern--pattern dirpatt)))
|
|
|
1744 ;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
|
|
|
1745 (filesets-directory-files dir patt ':files t))
|
|
|
1746 ;; (message "Filesets: malformed entry: %s" entry)))))))
|
|
|
1747 (filesets-error 'error "Filesets: malformed entry: "
|
|
|
1748 entry)))))))
|
|
|
1749 (filesets-filter-list fl
|
|
|
1750 (lambda (file)
|
|
|
1751 (not (filesets-filetype-property file event))))))
|
|
|
1752
|
|
|
1753 (defun filesets-open (&optional mode name lookup-name)
|
|
|
1754 "Open the fileset called NAME.
|
|
|
1755 Use LOOKUP-NAME for searching additional data if provided."
|
|
|
1756 (interactive)
|
|
|
1757 (let* ((name (or name
|
|
|
1758 (completing-read "Open fileset: " filesets-data nil t)))
|
|
|
1759 (fileset (filesets-get-fileset-from-name name mode))
|
|
|
1760 (lookup-fs (if lookup-name
|
|
|
1761 (filesets-get-fileset-from-name lookup-name)
|
|
|
1762 fileset))
|
|
|
1763 (mode (or mode (filesets-entry-mode lookup-fs))))
|
|
|
1764 (if fileset
|
|
|
1765 (let* ((files (filesets-get-filelist fileset mode 'on-open-all))
|
|
|
1766 (n (length files))
|
|
|
1767 (open-function (filesets-entry-get-open-fn nil lookup-fs)))
|
|
|
1768 (if (or (<= n filesets-query-user-limit)
|
|
|
1769 (y-or-n-p (format "Filesets: Open all %d files in %s? "
|
|
|
1770 n name)))
|
|
|
1771 (dolist (this files nil)
|
|
|
1772 (filesets-file-open open-function this))
|
|
|
1773 (message "Filesets: cancelled")))
|
|
|
1774 (filesets-error 'error "Filesets: Unknown fileset: " name))))
|
|
|
1775
|
|
|
1776 (defun filesets-close (&optional mode name lookup-name)
|
|
|
1777 "Close all buffers belonging to the fileset called NAME.
|
|
|
1778 Use LOOKUP-NAME for deducing the save-function, if provided."
|
|
|
1779 (interactive)
|
|
|
1780 (let* ((name (or name
|
|
|
1781 (completing-read "Close fileset: " filesets-data nil t)))
|
|
|
1782 (fileset (filesets-get-fileset-from-name name mode))
|
|
|
1783 (lookup-fs (if lookup-name
|
|
|
1784 (filesets-get-fileset-from-name lookup-name)
|
|
|
1785 fileset))
|
|
|
1786 (mode (or mode (filesets-entry-mode lookup-fs))))
|
|
|
1787 (if fileset
|
|
|
1788 (let ((files (filesets-get-filelist fileset mode 'on-close-all))
|
|
|
1789 (save-function (filesets-entry-get-save-fn nil lookup-fs)))
|
|
|
1790 (dolist (file-name files nil)
|
|
|
1791 (let* ((buffer (get-file-buffer file-name)))
|
|
|
1792 (if buffer
|
|
|
1793 (filesets-file-close save-function buffer)))))
|
|
|
1794 ; (message "Filesets: Unknown fileset: `%s'" name))))
|
|
|
1795 (filesets-error 'error "Filesets: Unknown fileset: " name))))
|
|
|
1796
|
|
|
1797 (defun filesets-add-buffer (&optional name buffer)
|
|
84660
|
1798 "Add BUFFER (or current buffer) to the fileset called NAME.
|
|
44934
|
1799 User will be queried, if no fileset name is provided."
|
|
|
1800 (interactive)
|
|
|
1801 (let* ((buffer (or buffer
|
|
|
1802 (current-buffer)))
|
|
|
1803 (name (or name
|
|
|
1804 (completing-read
|
|
|
1805 (format "Add '%s' to fileset: " buffer)
|
|
61583
|
1806 filesets-data nil)))
|
|
|
1807 (entry (or (assoc name filesets-data)
|
|
|
1808 (when (y-or-n-p
|
|
72386
|
1809 (format "Fileset %s does not exist. Create it? "
|
|
61583
|
1810 name))
|
|
|
1811 (progn
|
|
|
1812 (add-to-list 'filesets-data (list name '(:files)))
|
|
|
1813 (message
|
|
|
1814 "Fileset %s created. Call `M-x filesets-save-config' to save."
|
|
|
1815 name)
|
|
|
1816 (car filesets-data))))))
|
|
44934
|
1817 (if entry
|
|
|
1818 (let* ((files (filesets-entry-get-files entry))
|
|
|
1819 (this (buffer-file-name buffer))
|
|
45164
|
1820 (inlist (filesets-member this files
|
|
|
1821 :test 'filesets-files-equalp)))
|
|
44934
|
1822 (cond
|
|
|
1823 (inlist
|
|
|
1824 (message "Filesets: '%s' is already in '%s'" this name))
|
|
49475
|
1825 ((and (equal (filesets-entry-mode entry) ':files)
|
|
44934
|
1826 this)
|
|
|
1827 (filesets-entry-set-files entry (cons this files) t)
|
|
|
1828 (filesets-set-config name 'filesets-data filesets-data))
|
|
|
1829 (t
|
|
|
1830 (message "Filesets: Can't add '%s' to fileset '%s'" this name)))))))
|
|
|
1831
|
|
|
1832 (defun filesets-remove-buffer (&optional name buffer)
|
|
84660
|
1833 "Remove BUFFER (or current buffer) to fileset NAME.
|
|
44934
|
1834 User will be queried, if no fileset name is provided."
|
|
|
1835 (interactive)
|
|
|
1836 (let* ((buffer (or buffer
|
|
|
1837 (current-buffer)))
|
|
|
1838 (name (or name
|
|
|
1839 (completing-read
|
|
|
1840 (format "Remove '%s' from fileset: " buffer)
|
|
|
1841 filesets-data nil t)))
|
|
|
1842 (entry (assoc name filesets-data)))
|
|
|
1843 (if entry
|
|
|
1844 (let* ((files (filesets-entry-get-files entry))
|
|
|
1845 (this (buffer-file-name buffer))
|
|
45164
|
1846 (inlist (filesets-member this files
|
|
|
1847 :test 'filesets-files-equalp)))
|
|
44934
|
1848 ;;(message "%s %s %s" files this inlist)
|
|
|
1849 (if (and files this inlist)
|
|
|
1850 (let ((new (list (cons ':files (delete (car inlist) files)))))
|
|
|
1851 (setcdr entry new)
|
|
|
1852 (filesets-set-config name 'filesets-data filesets-data))
|
|
|
1853 (message "Filesets: Can't remove '%s' from fileset '%s'"
|
|
|
1854 this
|
|
|
1855 name))))))
|
|
|
1856
|
|
|
1857 (defun filesets-convert-patterns (name)
|
|
|
1858 "Change fileset NAME's mode from :pattern to :files."
|
|
|
1859 (interactive)
|
|
|
1860 (let ((entry (assoc name filesets-data)))
|
|
|
1861 (if entry
|
|
|
1862 (let ((pattern (filesets-entry-get-pattern entry))
|
|
|
1863 (patfiles (filesets-get-filelist entry ':pattern)))
|
|
|
1864 (if pattern
|
|
|
1865 (progn
|
|
|
1866 (filesets-entry-set-files entry patfiles t)
|
|
|
1867 (filesets-set-config name 'filesets-data filesets-data)))))))
|
|
|
1868
|
|
|
1869 (defun filesets-edit ()
|
|
|
1870 "Customize `filesets-data'."
|
|
|
1871 (interactive)
|
|
|
1872 (customize-variable 'filesets-data))
|
|
|
1873
|
|
|
1874 (defun filesets-customize ()
|
|
|
1875 "Customize the filesets group."
|
|
|
1876 (interactive)
|
|
|
1877 (customize-group 'filesets))
|
|
|
1878
|
|
|
1879 (defun filesets-info ()
|
|
|
1880 "Display filesets's version information."
|
|
|
1881 (interactive)
|
|
|
1882 (if (y-or-n-p (format "Filesets v%s: visit homepage? " filesets-version))
|
|
|
1883 (filesets-goto-homepage)))
|
|
|
1884
|
|
|
1885 (defun filesets-goto-homepage ()
|
|
|
1886 "Show filesets's homepage."
|
|
|
1887 (interactive)
|
|
|
1888 (browse-url filesets-homepage))
|
|
|
1889
|
|
|
1890 (defun filesets-remake-shortcut (count submenu)
|
|
79092
|
1891 "Remake a submenu's shortcut when wrapping long menus."
|
|
44934
|
1892 (let* ((name (concat (filesets-get-shortcut count)
|
|
|
1893 (substring (elt submenu 0) 2))))
|
|
|
1894 (if (listp submenu)
|
|
|
1895 (cons name (cdr submenu))
|
|
|
1896 (apply 'vector (list name (cdr (append submenu nil)))))))
|
|
|
1897 ; (vconcat `[,name] (subseq submenu 1)))))
|
|
|
1898
|
|
|
1899 (defun filesets-wrap-submenu (submenu-body)
|
|
|
1900 "Split long submenus."
|
|
|
1901 (let ((bl (length submenu-body)))
|
|
|
1902 (if (or (= filesets-max-submenu-length 0)
|
|
|
1903 (<= bl filesets-max-submenu-length))
|
|
|
1904 submenu-body
|
|
|
1905 (let* ((result nil)
|
|
|
1906 (factor (ceiling (/ (float bl)
|
|
|
1907 filesets-max-submenu-length))))
|
|
|
1908 (do ((data submenu-body (cdr data))
|
|
|
1909 (n 1 (+ n 1))
|
|
|
1910 (count 0 (+ count factor)))
|
|
|
1911 ((or (> count bl)
|
|
|
1912 (null data)))
|
|
|
1913 ; (let ((sl (subseq submenu-body count
|
|
|
1914 (let ((sl (filesets-sublist submenu-body count
|
|
|
1915 (let ((x (+ count factor)))
|
|
|
1916 (if (>= bl x)
|
|
|
1917 x
|
|
|
1918 nil)))))
|
|
|
1919 (when sl
|
|
|
1920 (setq result
|
|
|
1921 (append
|
|
|
1922 result
|
|
|
1923 (if (= (length sl) 1)
|
|
|
1924 (if filesets-menu-shortcuts-flag
|
|
|
1925 (list (filesets-remake-shortcut n (car sl)))
|
|
|
1926 sl)
|
|
|
1927 `((,(concat
|
|
|
1928 (filesets-get-shortcut n)
|
|
|
1929 (let ((rv ""))
|
|
|
1930 (do ((x sl (cdr x)))
|
|
|
1931 ((null x))
|
|
|
1932 (let ((y (concat (elt (car x) 0)
|
|
|
1933 (if (null (cdr x))
|
|
|
1934 ""
|
|
|
1935 ", "))))
|
|
49475
|
1936 (setq rv
|
|
44934
|
1937 (concat
|
|
|
1938 rv
|
|
|
1939 (if filesets-menu-shortcuts-flag
|
|
|
1940 (substring y 2)
|
|
|
1941 y)))))
|
|
|
1942 (if (> (length rv)
|
|
|
1943 filesets-max-entry-length)
|
|
|
1944 (concat
|
|
|
1945 (substring rv 0 filesets-max-entry-length)
|
|
|
1946 " ...")
|
|
|
1947 rv)))
|
|
|
1948 ,@sl))))))))
|
|
|
1949 result))))
|
|
|
1950
|
|
|
1951 (defun filesets-get-menu-epilog (something &optional
|
|
|
1952 mode lookup-name rebuild-flag)
|
|
|
1953 "Get submenu epilog for SOMETHING (usually a fileset).
|
|
|
1954 If mode is :tree or :ingroup, SOMETHING is some weird construct and
|
|
|
1955 LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
|
|
|
1956 (case mode
|
|
|
1957 ((:tree)
|
|
|
1958 `("---"
|
|
|
1959 ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
|
|
|
1960 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
|
|
|
1961 [,(format "Browse with `%s'" (filesets-browser-name))
|
|
|
1962 (filesets-browse-dir ',(car something))]
|
|
|
1963 ,@(when rebuild-flag
|
|
|
1964 `(["Rebuild this submenu"
|
|
|
1965 (filesets-rebuild-this-submenu ',lookup-name)]))))
|
|
|
1966 ((:ingroup)
|
|
|
1967 `("---"
|
|
|
1968 ["Close all files" (filesets-close ',mode ',something ',lookup-name)]
|
|
|
1969 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
|
|
|
1970 ,@(when rebuild-flag
|
|
|
1971 `(["Rebuild this submenu"
|
|
|
1972 (filesets-rebuild-this-submenu ',lookup-name)]))))
|
|
|
1973 ((:pattern)
|
|
|
1974 `("---"
|
|
|
1975 ["Close all files" (filesets-close ',mode ',something)]
|
|
|
1976 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
|
|
|
1977 [,(format "Browse with `%s'" (filesets-browser-name))
|
|
|
1978 ,(list 'filesets-browse-dir
|
|
|
1979 (filesets-entry-get-pattern--dir
|
|
|
1980 (filesets-entry-get-pattern
|
|
|
1981 (filesets-get-fileset-from-name something ':pattern))))]
|
|
|
1982 ; [,(concat (if filesets-menu-shortcuts-flag
|
|
|
1983 ; (concat "Con" filesets-menu-shortcuts-marker "vert")
|
|
|
1984 ; "Convert")
|
|
|
1985 ; " :pattern to :files")
|
|
|
1986 ; ,(list (function filesets-convert-patterns) something)]
|
|
|
1987 ,@(when rebuild-flag
|
|
|
1988 `(["Rebuild this submenu"
|
|
|
1989 (filesets-rebuild-this-submenu ',lookup-name)]))))
|
|
|
1990 ((:files)
|
|
|
1991 `("---"
|
|
|
1992 [,(concat "Close all files") (filesets-close ',mode ',something)]
|
|
|
1993 ["Run Command" (filesets-run-cmd nil ',something ',mode)]
|
|
|
1994 ["Add current buffer"
|
|
|
1995 (filesets-add-buffer ',something (current-buffer))]
|
|
|
1996 ["Remove current buffer"
|
|
|
1997 (filesets-remove-buffer ',something (current-buffer))]
|
|
|
1998 ,@(when rebuild-flag
|
|
|
1999 `(["Rebuild this submenu"
|
|
|
2000 (filesets-rebuild-this-submenu ',lookup-name)]))))
|
|
|
2001 (t
|
|
|
2002 (filesets-error 'error "Filesets: malformed definition of " something))))
|
|
|
2003
|
|
|
2004 (defun filesets-ingroup-get-data (master pos &optional fun)
|
|
|
2005 "Access to `filesets-ingroup-patterns'. Extract data section."
|
|
|
2006 (let ((masterfile (file-name-nondirectory master))
|
|
|
2007 (fn (or fun (lambda (a b)
|
|
|
2008 (and (stringp a)
|
|
|
2009 (stringp b)
|
|
|
2010 (string-match a b))))))
|
|
45164
|
2011 (filesets-some (lambda (x)
|
|
|
2012 (if (funcall fn (car x) masterfile)
|
|
|
2013 (nth pos x)
|
|
|
2014 nil))
|
|
|
2015 filesets-ingroup-patterns)))
|
|
44934
|
2016
|
|
|
2017 (defun filesets-ingroup-get-pattern (master)
|
|
|
2018 "Access to `filesets-ingroup-patterns'. Extract patterns."
|
|
|
2019 (filesets-ingroup-get-data master 2))
|
|
|
2020
|
|
|
2021 (defun filesets-ingroup-get-remdupl-p (master)
|
|
|
2022 "Access to `filesets-ingroup-patterns'. Extract remove-duplicates-flag."
|
|
|
2023 (filesets-ingroup-get-data master 1))
|
|
|
2024
|
|
84660
|
2025 (defun filesets-ingroup-collect-finder (patt case-sensitivep)
|
|
44934
|
2026 "Helper function for `filesets-ingroup-collect'. Find pattern PATT."
|
|
|
2027 (let ((cfs case-fold-search)
|
|
|
2028 (rv (progn
|
|
84660
|
2029 (setq case-fold-search (not case-sensitivep))
|
|
44934
|
2030 (re-search-forward patt nil t))))
|
|
|
2031 (setq case-fold-search cfs)
|
|
|
2032 rv))
|
|
|
2033
|
|
|
2034 (defun filesets-ingroup-cache-get (master)
|
|
|
2035 "Access to `filesets-ingroup-cache'."
|
|
|
2036 (lax-plist-get filesets-ingroup-cache master))
|
|
|
2037
|
|
|
2038 (defun filesets-ingroup-cache-put (master file)
|
|
|
2039 "Access to `filesets-ingroup-cache'."
|
|
|
2040 (let* ((emaster (expand-file-name master))
|
|
|
2041 (this (if file
|
|
|
2042 (cons file (filesets-ingroup-cache-get emaster))
|
|
|
2043 nil)))
|
|
|
2044 (setq filesets-ingroup-cache
|
|
|
2045 (lax-plist-put filesets-ingroup-cache emaster this))))
|
|
|
2046
|
|
|
2047 (defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth)
|
|
79092
|
2048 "Helper function for `filesets-ingroup-collect'. Collect file names."
|
|
44934
|
2049 (let* ((master (or master
|
|
|
2050 (filesets-entry-get-master fs)))
|
|
|
2051 (remdupl-flag (or remdupl-flag
|
|
|
2052 (filesets-ingroup-get-remdupl-p master))))
|
|
|
2053 (filesets-ingroup-cache-put master nil)
|
|
|
2054 (filesets-message 2 "Filesets: parsing %S" master)
|
|
|
2055 (let ((cmdpatts (filesets-ingroup-get-pattern master))
|
|
|
2056 (count 0)
|
|
|
2057 (rv nil))
|
|
|
2058 (if cmdpatts
|
|
|
2059 (dolist (this-def cmdpatts rv)
|
|
|
2060 (let* ((this-patt (filesets-alist-get this-def ':pattern nil t))
|
|
|
2061 (this-name (filesets-alist-get this-def ':name "" t))
|
|
|
2062 (this-pp (filesets-alist-get this-def ':preprocess nil t))
|
|
|
2063 (this-mn (filesets-alist-get this-def ':match-number 1 t))
|
|
|
2064 (this-sd (or depth
|
|
|
2065 (filesets-alist-get this-def ':scan-depth 0 t)))
|
|
|
2066 (this-csp (filesets-alist-get this-def ':case-sensitive nil t))
|
|
|
2067 (this-fn (filesets-alist-get
|
|
|
2068 this-def ':get-file-name 'filesets-which-file t))
|
|
|
2069 (this-stubp (filesets-alist-get this-def ':stubp nil t))
|
|
|
2070 (this-stub-flag (filesets-alist-get this-def ':stub-flag nil t))
|
|
|
2071 (flist nil)
|
|
|
2072 (lst nil))
|
|
|
2073 (cond
|
|
|
2074 ((not this-patt)
|
|
|
2075 (filesets-error 'error "Filesets: malformed :ingroup definition "
|
|
|
2076 this-def))
|
|
45130
|
2077 ((< this-sd 0)
|
|
|
2078 nil)
|
|
44934
|
2079 (t
|
|
|
2080 (with-temp-buffer
|
|
|
2081 (insert-file-contents master)
|
|
|
2082 (goto-char (point-min))
|
|
|
2083 (when this-pp
|
|
|
2084 (funcall this-pp))
|
|
|
2085 (while (filesets-ingroup-collect-finder this-patt this-csp)
|
|
|
2086 (let* ((txt (match-string this-mn))
|
|
|
2087 (f (funcall this-fn master txt)))
|
|
|
2088 (when (and f
|
|
|
2089 (not (member f flist))
|
|
|
2090 (or (not remdupl-flag)
|
|
45164
|
2091 (not (filesets-member
|
|
45012
|
2092 f filesets-ingroup-files
|
|
44934
|
2093 :test 'filesets-files-equalp))))
|
|
|
2094 (let ((no-stub-flag
|
|
|
2095 (and (not this-stub-flag)
|
|
|
2096 (if this-stubp
|
|
|
2097 (not (funcall this-stubp master f))
|
|
|
2098 t))))
|
|
|
2099 (setq count (+ count 1))
|
|
|
2100 (setq flist (cons f flist))
|
|
45012
|
2101 (setq filesets-ingroup-files
|
|
|
2102 (cons f filesets-ingroup-files))
|
|
44934
|
2103 (when no-stub-flag
|
|
|
2104 (filesets-ingroup-cache-put master f))
|
|
|
2105 (setq lst (append lst (list f))))))))
|
|
|
2106 (when lst
|
|
|
2107 (setq rv
|
|
|
2108 (nconc rv
|
|
|
2109 (mapcar (lambda (this)
|
|
|
2110 `((,this ,this-name)
|
|
|
2111 ,@(filesets-ingroup-collect-files
|
|
|
2112 fs remdupl-flag this
|
|
|
2113 (- this-sd 1))))
|
|
|
2114 lst))))))))
|
|
|
2115 (filesets-message 2 "Filesets: no patterns defined for %S" master)))))
|
|
|
2116
|
|
|
2117 (defun filesets-ingroup-collect-build-menu (fs flist &optional other-count)
|
|
84660
|
2118 "Helper function for `filesets-ingroup-collect'. Build the menu.
|
|
|
2119 FS is a fileset's name. FLIST is a list returned by
|
|
44934
|
2120 `filesets-ingroup-collect-files'."
|
|
|
2121 (if (null flist)
|
|
|
2122 nil
|
|
|
2123 (let ((count 0)
|
|
|
2124 (fsn fs)
|
|
|
2125 (rv nil))
|
|
|
2126 (dolist (this flist rv)
|
|
|
2127 (setq count (+ count 1))
|
|
|
2128 (let* ((def (if (listp this) (car this) (list this "")))
|
|
|
2129 (files (if (listp this) (cdr this) nil))
|
|
|
2130 (master (nth 0 def))
|
|
|
2131 (name (nth 1 def))
|
|
|
2132 (nm (concat (filesets-get-shortcut (if (or (not other-count) files)
|
|
|
2133 count other-count))
|
|
|
2134 (if (or (null name) (equal name ""))
|
|
|
2135 ""
|
|
|
2136 (format "%s: " name))
|
|
|
2137 (file-name-nondirectory master))))
|
|
|
2138 (setq rv
|
|
|
2139 (append rv
|
|
|
2140 (if files
|
|
|
2141 `((,nm
|
|
49475
|
2142 [,(concat "Inclusion Group: "
|
|
44934
|
2143 (file-name-nondirectory master))
|
|
|
2144 (filesets-open ':ingroup ',master ',fsn)]
|
|
|
2145 "---"
|
|
|
2146 [,master (filesets-file-open nil ',master ',fsn)]
|
|
|
2147 "---"
|
|
|
2148 ,@(let ((count 0))
|
|
|
2149 (mapcar
|
|
|
2150 (lambda (this)
|
|
|
2151 (setq count (+ count 1))
|
|
49475
|
2152 (let ((ff (filesets-ingroup-collect-build-menu
|
|
44934
|
2153 fs (list this) count)))
|
|
|
2154 (if (= (length ff) 1)
|
|
|
2155 (car ff)
|
|
|
2156 ff)))
|
|
|
2157 files))
|
|
|
2158 ,@(filesets-get-menu-epilog master ':ingroup fsn)))
|
|
|
2159 `([,nm (filesets-file-open nil ',master ',fsn)])))))))))
|
|
|
2160
|
|
84660
|
2161 (defun filesets-ingroup-collect (fs remdupl-flag master)
|
|
79092
|
2162 "Collect names of included files and build submenu."
|
|
44934
|
2163 (filesets-ingroup-cache-put master nil)
|
|
|
2164 (filesets-message 2 "Filesets: parsing %S" master)
|
|
|
2165 (filesets-ingroup-collect-build-menu
|
|
|
2166 fs
|
|
|
2167 (filesets-ingroup-collect-files fs remdupl-flag master)))
|
|
|
2168
|
|
|
2169 (defun filesets-build-ingroup-submenu (lookup-name master)
|
|
|
2170 "Build a :ingroup submenu for file MASTER."
|
|
|
2171 (if (file-readable-p master)
|
|
|
2172 (let ((remdupl-flag (filesets-ingroup-get-remdupl-p master)))
|
|
45012
|
2173 (setq filesets-ingroup-files (list master))
|
|
44934
|
2174 (filesets-ingroup-collect lookup-name remdupl-flag master))
|
|
|
2175 (if filesets-be-docile-flag
|
|
|
2176 (progn
|
|
|
2177 (message "Filesets: can't parse %s" master)
|
|
|
2178 nil)
|
|
|
2179 (filesets-error 'error "Filesets: can't parse " master))))
|
|
|
2180
|
|
|
2181 (defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd
|
|
|
2182 &optional rebuild-flag)
|
|
|
2183 "Helper function for `filesets-build-dir-submenu'."
|
|
|
2184 ;;(filesets-message 3 "Filesets: scanning %s" dir)
|
|
|
2185 (if (or (= depth 0)
|
|
|
2186 (< level depth))
|
|
|
2187 (let* ((dir (file-name-as-directory dir))
|
|
|
2188 (header `([,(concat "Tree: "
|
|
|
2189 (if (= level 0)
|
|
|
2190 dir
|
|
|
2191 (concat ".../"
|
|
|
2192 (file-name-as-directory
|
|
|
2193 (file-name-nondirectory
|
|
|
2194 (directory-file-name dir))))))
|
|
|
2195 ,(list (function filesets-open)
|
|
|
2196 ':tree
|
|
|
2197 `(quote (,dir ,patt))
|
|
|
2198 lookup-name)]
|
|
|
2199 "---"))
|
|
|
2200 (dirlist (filesets-directory-files dir patt nil nil fd))
|
|
|
2201 (subdirs (filesets-filter-dir-names dirlist))
|
|
|
2202 (count 0)
|
|
|
2203 (dirsmenu (mapcar
|
|
|
2204 (lambda (x)
|
|
|
2205 (setq count (+ count 1))
|
|
|
2206 (let* ((x (file-name-as-directory x))
|
|
|
2207 (xx (concat dir x))
|
|
|
2208 (dd (filesets-build-dir-submenu-now
|
|
49475
|
2209 (+ level 1) depth entry
|
|
44934
|
2210 lookup-name xx patt fd))
|
|
|
2211 (nm (concat (filesets-get-shortcut count)
|
|
|
2212 x)))
|
|
|
2213 (if dd
|
|
|
2214 `(,nm ,@dd)
|
|
|
2215 `[,nm ,(list 'filesets-browse-dir xx)])))
|
|
|
2216 subdirs))
|
|
|
2217 (files (filesets-filter-dir-names dirlist t))
|
|
|
2218 (filesmenu (mapcar (lambda (x)
|
|
|
2219 (setq count (+ count 1))
|
|
|
2220 `[,(concat (filesets-get-shortcut count)
|
|
|
2221 x)
|
|
|
2222 (filesets-file-open nil
|
|
|
2223 (quote ,(concat dir x))
|
|
|
2224 (quote ,lookup-name))])
|
|
|
2225 files)))
|
|
|
2226 (append header
|
|
|
2227 (filesets-wrap-submenu
|
|
|
2228 (append
|
|
|
2229 dirsmenu
|
|
|
2230 filesmenu))
|
|
49475
|
2231 (filesets-get-menu-epilog `(,dir ,patt) ':tree
|
|
44934
|
2232 lookup-name rebuild-flag)))
|
|
|
2233 nil))
|
|
|
2234
|
|
|
2235 (defun filesets-build-dir-submenu (entry lookup-name dir patt)
|
|
|
2236 "Build a :tree submenu named LOOKUP-NAME with base directory DIR including
|
|
|
2237 all files matching PATT for filesets ENTRY."
|
|
|
2238 (let ((fd (filesets-entry-get-filter-dirs-flag entry))
|
|
|
2239 (depth (or (filesets-entry-get-tree-max-level entry)
|
|
|
2240 filesets-tree-max-level)))
|
|
|
2241 (filesets-build-dir-submenu-now 0 depth entry lookup-name dir patt fd t)))
|
|
|
2242
|
|
|
2243 (defun filesets-build-submenu (count lookup-name entry)
|
|
|
2244 "Build submenu for the fileset ENTRY named LOOKUP-NAME.
|
|
|
2245 Construct a shortcut from COUNT."
|
|
|
2246 (let ((lookup-name (or lookup-name
|
|
|
2247 (filesets-data-get-name entry))))
|
|
|
2248 (message "Filesets: %s" lookup-name)
|
|
|
2249 (let ((mode (filesets-entry-mode entry))
|
|
|
2250 (filesets-verbosity (filesets-entry-get-verbosity entry))
|
|
|
2251 (this-lookup-name (concat (filesets-get-shortcut count)
|
|
|
2252 lookup-name)))
|
|
|
2253 (case mode
|
|
|
2254 ((:file)
|
|
|
2255 (let* ((file (filesets-entry-get-file entry)))
|
|
|
2256 `[,this-lookup-name
|
|
|
2257 (filesets-file-open nil ',file ',lookup-name)]))
|
|
|
2258 (t
|
|
|
2259 `(,this-lookup-name
|
|
|
2260 ,@(case mode
|
|
|
2261 ((:pattern)
|
|
|
2262 (let* ((files (filesets-get-filelist entry mode 'on-ls))
|
|
|
2263 (dirpatt (filesets-entry-get-pattern entry))
|
|
|
2264 (pattname (apply 'concat (cons "Pattern: " dirpatt)))
|
|
|
2265 (count 0))
|
|
|
2266 ;;(filesets-message 3 "Filesets: scanning %S" pattname)
|
|
|
2267 `([,pattname
|
|
|
2268 ,(list (function filesets-open) mode lookup-name)]
|
|
|
2269 "---"
|
|
|
2270 ,@(filesets-wrap-submenu
|
|
|
2271 (mapcar
|
|
|
2272 (lambda (x)
|
|
|
2273 (setq count (+ count 1))
|
|
|
2274 `[,(concat (filesets-get-shortcut count)
|
|
|
2275 (file-name-nondirectory x))
|
|
|
2276 (filesets-file-open nil ',x ',lookup-name)])
|
|
|
2277 files))
|
|
|
2278 ,@(filesets-get-menu-epilog lookup-name mode
|
|
|
2279 lookup-name t))))
|
|
|
2280 ((:ingroup)
|
|
|
2281 (let* ((master (filesets-entry-get-master entry)))
|
|
|
2282 ;;(filesets-message 3 "Filesets: parsing %S" master)
|
|
|
2283 `([,(concat "Inclusion Group: "
|
|
|
2284 (file-name-nondirectory master))
|
|
|
2285 (filesets-open ',mode ',master ',lookup-name)]
|
|
|
2286 "---"
|
|
|
2287 [,master (filesets-file-open nil ',master ',lookup-name)]
|
|
|
2288 "---"
|
|
|
2289 ,@(filesets-wrap-submenu
|
|
|
2290 (filesets-build-ingroup-submenu lookup-name master))
|
|
|
2291 ,@(filesets-get-menu-epilog master mode lookup-name t))))
|
|
|
2292 ((:tree)
|
|
|
2293 (let* ((dirpatt (filesets-entry-get-tree entry))
|
|
|
2294 (dir (car dirpatt))
|
|
|
2295 (patt (cadr dirpatt)))
|
|
|
2296 (filesets-build-dir-submenu entry lookup-name dir patt)))
|
|
|
2297 ((:files)
|
|
|
2298 (let ((files (filesets-get-filelist entry mode 'on-open-all))
|
|
|
2299 (count 0))
|
|
|
2300 `([,(concat "Files: " lookup-name)
|
|
|
2301 (filesets-open ',mode ',lookup-name)]
|
|
|
2302 "---"
|
|
|
2303 ,@(filesets-wrap-submenu
|
|
|
2304 (mapcar
|
|
|
2305 (lambda (x)
|
|
|
2306 (setq count (+ count 1))
|
|
|
2307 `[,(concat (filesets-get-shortcut count)
|
|
|
2308 (file-name-nondirectory x))
|
|
|
2309 (filesets-file-open nil ',x ',lookup-name)])
|
|
|
2310 (filesets-conditional-sort
|
|
|
2311 files
|
|
|
2312 (function file-name-nondirectory))))
|
|
|
2313 ,@(filesets-get-menu-epilog lookup-name mode
|
|
|
2314 lookup-name t)))))))))))
|
|
|
2315
|
|
|
2316 (defun filesets-remove-from-ubl (&optional buffer)
|
|
84660
|
2317 "BUFFER or current buffer require update of the filesets menu."
|
|
44934
|
2318 (let ((b (or buffer
|
|
|
2319 (current-buffer))))
|
|
|
2320 (if (member b filesets-updated-buffers)
|
|
|
2321 (setq filesets-updated-buffers
|
|
|
2322 (delete b filesets-updated-buffers)))))
|
|
|
2323
|
|
|
2324 (defun filesets-build-menu-now (from-scratch-flag)
|
|
|
2325 "Update the filesets menu.
|
|
|
2326 Build all new if FROM-SCRATCH-FLAG is non-nil. (To really build from the
|
|
|
2327 bottom up, set `filesets-submenus' to nil, first.)"
|
|
|
2328 (when (or from-scratch-flag
|
|
|
2329 filesets-has-changed-flag
|
|
|
2330 (not filesets-menu-cache))
|
|
|
2331 (setq filesets-menu-cache nil)
|
|
|
2332 (setq filesets-has-changed-flag nil)
|
|
|
2333 (setq filesets-updated-buffers nil)
|
|
|
2334 (setq filesets-update-cache-file-flag t)
|
|
|
2335 (do ((data (filesets-conditional-sort filesets-data (function car))
|
|
|
2336 (cdr data))
|
|
|
2337 (count 1 (+ count 1)))
|
|
|
2338 ((null data))
|
|
|
2339 (let* ((this (car data))
|
|
|
2340 (name (filesets-data-get-name this))
|
|
|
2341 (cached (lax-plist-get filesets-submenus name))
|
|
|
2342 (submenu (or cached
|
|
|
2343 (filesets-build-submenu count name this))))
|
|
|
2344 (unless cached
|
|
|
2345 (setq filesets-submenus
|
|
|
2346 (lax-plist-put filesets-submenus name submenu)))
|
|
|
2347 (unless (filesets-entry-get-dormant-flag this)
|
|
|
2348 (setq filesets-menu-cache
|
|
|
2349 (append filesets-menu-cache (list submenu))))))
|
|
|
2350 (when filesets-cache-save-often-flag
|
|
|
2351 (filesets-menu-cache-file-save-maybe)))
|
|
|
2352 (let ((cb (current-buffer)))
|
|
|
2353 (when (not (member cb filesets-updated-buffers))
|
|
61138
|
2354 (add-submenu
|
|
44934
|
2355 filesets-menu-path
|
|
|
2356 `(,filesets-menu-name
|
|
|
2357 ("# Filesets"
|
|
|
2358 ["Edit Filesets" filesets-edit]
|
|
|
2359 ["Save Filesets" filesets-save-config]
|
|
|
2360 ["Save Menu Cache" filesets-menu-cache-file-save]
|
|
|
2361 ["Rebuild Menu" filesets-build-menu]
|
|
|
2362 ["Customize" filesets-customize]
|
|
|
2363 ["About" filesets-info])
|
|
|
2364 ,(filesets-get-cmd-menu)
|
|
|
2365 "---"
|
|
|
2366 ,@filesets-menu-cache)
|
|
|
2367 filesets-menu-before
|
|
|
2368 filesets-menu-in-menu)
|
|
|
2369 (setq filesets-updated-buffers
|
|
|
2370 (cons cb filesets-updated-buffers))
|
|
48862
|
2371 ;; This wipes out other messages in the echo area.
|
|
|
2372 ;; (message nil)
|
|
44934
|
2373 ;;(message "Filesets updated: %s" cb)
|
|
|
2374 )))
|
|
|
2375
|
|
|
2376 (defun filesets-build-menu-maybe ()
|
|
|
2377 "Update the filesets menu."
|
|
|
2378 (interactive)
|
|
|
2379 (filesets-build-menu-now nil))
|
|
|
2380
|
|
|
2381 (defun filesets-build-menu ()
|
|
|
2382 "Force rebuild of the filesets menu."
|
|
|
2383 (interactive)
|
|
|
2384 ;(setq filesets-submenus nil)
|
|
|
2385 (filesets-reset-fileset)
|
|
|
2386 (filesets-build-menu-now t)
|
|
|
2387 (filesets-menu-cache-file-save-maybe))
|
|
|
2388
|
|
|
2389 (defun filesets-rebuild-this-submenu (fileset)
|
|
|
2390 "Force rebuild of FILESET submenu."
|
|
|
2391 (filesets-reset-fileset fileset)
|
|
|
2392 (filesets-build-menu-now t))
|
|
|
2393
|
|
|
2394 (defun filesets-menu-cache-file-save-maybe (&optional simply-do-it)
|
|
|
2395 "Write filesets' cache file.
|
|
|
2396 If SIMPLY-DO-IT is non-nil, the cache file will be written no matter if
|
|
|
2397 fileset thinks this is necessary or not."
|
|
|
2398 (when (and (not (equal filesets-menu-cache-file ""))
|
|
|
2399 (or simply-do-it
|
|
|
2400 filesets-update-cache-file-flag))
|
|
|
2401 (when (file-exists-p filesets-menu-cache-file)
|
|
|
2402 (delete-file filesets-menu-cache-file))
|
|
|
2403 ;;(message "Filesets: saving menu cache")
|
|
|
2404 (with-temp-buffer
|
|
|
2405 (dolist (this filesets-menu-cache-contents)
|
|
|
2406 (if (get this 'custom-type)
|
|
49475
|
2407 (progn
|
|
44934
|
2408 (insert (format "(setq-default %s '%S)" this (eval this)))
|
|
|
2409 (when filesets-menu-ensure-use-cached
|
|
|
2410 (newline)
|
|
|
2411 (insert (format "(setq %s (cons '%s %s))"
|
|
|
2412 'filesets-ignore-next-set-default
|
|
|
2413 this
|
|
|
2414 'filesets-ignore-next-set-default))))
|
|
|
2415 (insert (format "(setq %s '%S)" this (eval this))))
|
|
|
2416 (newline 2))
|
|
|
2417 (insert (format "(setq filesets-cache-version %S)" filesets-version))
|
|
|
2418 (newline 2)
|
|
|
2419 (when filesets-cache-hostname-flag
|
|
|
2420 (insert (format "(setq filesets-cache-hostname %S)" (system-name)))
|
|
|
2421 (newline 2))
|
|
|
2422 (run-hooks 'filesets-cache-fill-content-hooks)
|
|
|
2423 (write-file filesets-menu-cache-file))
|
|
|
2424 (setq filesets-has-changed-flag nil)
|
|
|
2425 (setq filesets-update-cache-file-flag nil)))
|
|
|
2426
|
|
|
2427 (defun filesets-menu-cache-file-save ()
|
|
|
2428 "Save filesets' menu cache file."
|
|
|
2429 (interactive)
|
|
|
2430 (filesets-menu-cache-file-save-maybe t))
|
|
|
2431
|
|
|
2432 (defun filesets-update-cleanup ()
|
|
|
2433 "Rebuild the menu and save the cache file after updating user data."
|
|
|
2434 (interactive)
|
|
|
2435 (message "Filesets v%s: updating menu & cache from version %s"
|
|
|
2436 filesets-version (or filesets-cache-version "???"))
|
|
|
2437 (filesets-build-menu)
|
|
|
2438 (filesets-menu-cache-file-save-maybe)
|
|
|
2439 (filesets-menu-cache-file-load))
|
|
|
2440
|
|
|
2441 (defun filesets-update-pre010505 ()
|
|
|
2442 (let ((msg
|
|
|
2443 "Filesets: manual editing of user data required!
|
|
|
2444
|
|
|
2445 Filesets has detected that you were using an older version before,
|
|
|
2446 which requires some manual updating. Type 'y' for editing the startup
|
|
|
2447 file now.
|
|
|
2448
|
|
|
2449 The layout of `filesets-data' has changed. Please delete your cache file
|
|
|
2450 and edit your startup file as shown below:
|
|
|
2451
|
|
|
2452 1. `filesets-data': Edit all :pattern filesets in your startup file and
|
|
|
2453 transform all entries as shown in this example:
|
|
|
2454
|
|
|
2455 \(\"Test\" (:pattern \"~/dir/^pattern$\"))
|
|
|
2456 --> \(\"Test\" (:pattern \"~/dir/\" \"^pattern$\"))
|
|
|
2457
|
|
45894
|
2458 2. `filesets-data': Change all occurrences of \":document\" to \":ingroup\":
|
|
44934
|
2459
|
|
|
2460 \(\(\"Test\" \(:document \"~/dir/file\"))
|
|
|
2461 --> \(\(\"Test\" \(:ingroup \"~/dir/file\"))
|
|
|
2462
|
|
|
2463 3. `filesets-subdocument-patterns': If you already modified the variable
|
|
|
2464 previously called `filesets-subdocument-patterns', change its name to
|
|
|
2465 `filesets-ingroup-patterns'.
|
|
|
2466
|
|
|
2467 4. `filesets-menu-cache-contents': If you already modified this
|
|
|
2468 variable, change the entry `filesets-subdocument--cache' to
|
|
|
2469 `filesets-ingroup-cache'.
|
|
|
2470
|
|
|
2471 5. Type M-x filesets-update-cleanup and restart Emacs.
|
|
|
2472
|
|
|
2473 We apologize for the inconvenience."))
|
|
|
2474 (let* ((cf (or custom-file user-init-file)))
|
|
|
2475 (switch-to-buffer-other-frame "*Filesets update*")
|
|
|
2476 (insert msg)
|
|
|
2477 (when (y-or-n-p (format "Edit startup (%s) file now? " cf))
|
|
|
2478 (find-file-other-window cf))
|
|
|
2479 (filesets-error 'error msg))))
|
|
|
2480
|
|
84660
|
2481 (defun filesets-update (cached-version)
|
|
44934
|
2482 "Do some cleanup after updating filesets.el."
|
|
|
2483 (cond
|
|
|
2484 ((or (not cached-version)
|
|
|
2485 (string< cached-version "1.5.5")
|
|
|
2486 (boundp 'filesets-subdocument-patterns))
|
|
|
2487 (filesets-update-pre010505)))
|
|
|
2488 (filesets-update-cleanup))
|
|
|
2489
|
|
|
2490 (defun filesets-menu-cache-file-load ()
|
|
|
2491 "Load filesets' menu cache file."
|
|
|
2492 (cond
|
|
|
2493 ((and (not (equal filesets-menu-cache-file ""))
|
|
|
2494 (file-readable-p filesets-menu-cache-file))
|
|
|
2495 (load-file filesets-menu-cache-file)
|
|
|
2496 (if (and (equal filesets-cache-version filesets-version)
|
|
|
2497 (if filesets-cache-hostname-flag
|
|
|
2498 (equal filesets-cache-hostname (system-name))
|
|
|
2499 t))
|
|
|
2500 (progn
|
|
|
2501 (setq filesets-update-cache-file-flag nil)
|
|
|
2502 t)
|
|
84660
|
2503 (filesets-update filesets-cache-version)))
|
|
44934
|
2504 (t
|
|
|
2505 (setq filesets-update-cache-file-flag t)
|
|
|
2506 nil)))
|
|
|
2507
|
|
|
2508 (defun filesets-exit ()
|
|
|
2509 (filesets-menu-cache-file-save-maybe))
|
|
|
2510
|
|
60965
|
2511 ;;;###autoload
|
|
44934
|
2512 (defun filesets-init ()
|
|
|
2513 "Filesets initialization.
|
|
|
2514 Set up hooks, load the cache file -- if existing -- and build the menu."
|
|
84660
|
2515 (add-hook (if (featurep 'xemacs) 'activate-menubar-hook 'menu-bar-update-hook)
|
|
44934
|
2516 (function filesets-build-menu-maybe))
|
|
|
2517 (add-hook 'kill-buffer-hook (function filesets-remove-from-ubl))
|
|
|
2518 (add-hook 'first-change-hook (function filesets-reset-filename-on-change))
|
|
|
2519 (add-hook 'kill-emacs-hook (function filesets-exit))
|
|
|
2520 (if (filesets-menu-cache-file-load)
|
|
|
2521 (progn
|
|
|
2522 (filesets-build-menu-maybe)
|
|
|
2523 ;;Well, normally when we use XEmacs <= 21.4, custom.el is loaded
|
|
|
2524 ;;after init.el. This more or less ignores the next
|
|
|
2525 ;;`filesets-data-set-default'
|
|
|
2526 (if filesets-menu-ensure-use-cached
|
|
|
2527 (setq filesets-menu-use-cached-flag t)))
|
|
|
2528 (filesets-build-menu)))
|
|
|
2529
|
|
|
2530
|
|
|
2531 (provide 'filesets)
|
|
|
2532
|
|
84660
|
2533 ;; Local Variables:
|
|
|
2534 ;; sentence-end-double-space:t
|
|
|
2535 ;; End:
|
|
44934
|
2536
|
|
84660
|
2537 ;; arch-tag: 2c03f85f-c3df-4cec-b0a3-b46fd5592d70
|
|
44934
|
2538 ;;; filesets.el ends here
|
