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