1 ;;; filesets.el --- handle group of files
3 ;; Copyright (C) 2002 Free Software Foundation, Inc.
5 ;; Author: Thomas Link <t.link@gmx.at>
6 ;; Keywords: filesets convenience
8 ;; This file is part of GNU Emacs.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; A copy of the GNU General Public License can be obtained from this
21 ;; program's author or from the Free Software Foundation, Inc., 675 Mass
22 ;; Ave, Cambridge, MA 02139, USA.
24 (defvar filesets-version
"1.8.4")
25 (defvar filesets-homepage
26 "http://members.a1.net/t.link/CompEmacsFilesets.html")
30 ;; Define filesets, which can be opened or saved with the power of one or
31 ;; two mouse clicks only. A fileset is either a list of files, a file
32 ;; pattern, a base directory and a search pattern (for files), or an
33 ;; inclusion group (i.e. a base file including other files).
35 ;; Usage: 1. Put (require 'filesets) into your start-up file. 2. Type
36 ;; M-x filesets-edit or choose "Edit Filesets" from the menu. 3. Save
37 ;; your customizations.
39 ;; Caveat: Fileset names have to be unique.
41 ;; Filesets.el adds a nifty filesets menu to your menubar. If you change
42 ;; your filesets on the fly, don't forget to select "Save Filesets" from
45 ;; Pressing on the first item in the submenu will open all files at once.
46 ;; Define your own function, e.g. browse-url, for opening a fileset's
47 ;; files. Or define external viewers for opening files with other
48 ;; programs. See `filesets-external-viewers'.
50 ;; BTW, if you close a fileset, files, which have been changed, will
51 ;; be silently saved. Change this behaviour by setting
52 ;; `filesets-save-buffer-fn'.
54 ;;; Supported modes for inclusion groups (`filesets-ingroup-patterns'):
56 ;; - Emacs-Wiki (simple names only)
66 ;;- better handling of different customization scenarios
71 ;; Helpful suggestions (but no significant code) were contributed by
73 ;;- Christoph Conrad (at gmx de)
74 ;;- Christian Ohler (at Informatik Uni-Oldenburg DE)
75 ;;- Richard Stallman aka RMS (at gnu org)
76 ;;- Per Abrahamsen aka abraham (at dina kvl dk)
87 (defvar filesets-running-xemacs
(string-match "XEmacs\\|Lucid" emacs-version
)
88 "Non-nil means we are running XEmacs."))
90 (defvar filesets-menu-cache nil
91 "The whole filesets menu.")
92 (defvar filesets-cache-version nil
93 "Filesets' cached version number.")
94 (defvar filesets-cache-hostname nil
95 "Filesets' cached system name.")
97 (defvar filesets-ingroup-cache nil
98 "A plist containing files and their ingroup data.")
99 (defvar filesets-ingroup-files nil
100 "List of files already processed when searching for included files.")
102 (defvar filesets-has-changed-flag t
103 "Non-nil means some fileset definition has changed.")
104 (defvar filesets-submenus nil
105 "An association list with filesets menu data.")
106 (defvar filesets-updated-buffers nil
107 "A list of buffers with updated menu bars.")
108 (defvar filesets-menu-use-cached-flag nil
109 "Use cached data. See `filesets-menu-ensure-use-cached' for details.")
110 (defvar filesets-update-cache-file-flag nil
111 "Non-nil means the cache needs updating.")
112 (defvar filesets-ignore-next-set-default nil
113 "A list of custom variables for which the next `set-default' will be
116 (defvar filesets-output-buffer-flag nil
117 "Non-nil means the current buffer is an output buffer created by filesets.
118 Is buffer local variable.")
120 (defvar filesets-verbosity
1
121 "An integer defining the level of verbosity. 0 means no messages
124 (defvar filesets-menu-ensure-use-cached
125 (and filesets-running-xemacs
126 (not (emacs-version>= 21 5)))
127 "Make sure (X)Emacs uses filesets' cache.
129 Well, if you use XEmacs (prior to 21.5?) custom.el is loaded after
130 init.el. This means that settings saved in the cache file (see
131 `filesets-menu-cache-file') will be overwritten by custom.el. In order
132 to ensure the use of the cache file, set this variable to t -- which is
133 the default for XEmacs prior to 21.5. If you want to change this value
134 put \"(setq filesets-menu-ensure-use-cached VALUE)\" into your startup
135 file -- before loading filesets.el.
137 So, when should you think about setting this value to t? If filesets.el
138 is loaded before user customizations. Thus, if (require 'filesets)
139 precedes the custom-set-variables command or, for XEmacs, if init.el is
140 loaded before custom.el, set this variable to t.")
144 (defun filesets-filter-list (lst cond-fn
)
145 "Remove all elements not conforming to COND-FN from list LST.
146 COND-FN takes one argument: the current element."
147 ; (remove* 'dummy lst :test (lambda (dummy elt)
148 ; (not (funcall cond-fn elt)))))
151 (when (funcall cond-fn elt
)
152 (setq rv
(append rv
(list elt
)))))))
154 (defun filesets-ormap (fsom-pred lst
)
155 "Return the tail of FSOM-LST for the head of which FSOM-PRED is non-nil."
158 (while (and (not (null fsom-lst
))
160 (if (funcall fsom-pred
(car fsom-lst
))
161 (setq fsom-rv fsom-lst
)
162 (setq fsom-lst
(cdr fsom-lst
))))
165 (defun filesets-some (fss-pred fss-lst
)
166 "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
167 Like `some', return the first value of FSS-PRED that is non-nil."
169 (dolist (fss-this fss-lst nil
)
170 (let ((fss-rv (funcall fss-pred fss-this
)))
172 (throw 'exit fss-rv
))))))
173 ;(fset 'filesets-some 'some) ;; or use the cl function
175 (defun filesets-member (fsm-item fsm-lst
&rest fsm-keys
)
176 "Find the first occurrence of FSM-ITEM in FSM-LST.
177 It is supposed to work like cl's `member*'. At the moment only the :test
179 (let ((fsm-test (or (plist-get fsm-keys
':test
)
181 (filesets-ormap (lambda (fsm-this)
182 (funcall fsm-test fsm-item fsm-this
))
184 ;(fset 'filesets-member 'member*) ;; or use the cl function
186 (defun filesets-sublist (lst beg
&optional end
)
187 "Get the sublist of LST from BEG to END - 1."
193 (setq rv
(append rv
(list (nth i lst
))))
197 (defun filesets-select-command (cmd-list)
198 "Select one command from CMD-LIST -- a string with space separated names."
199 (let ((this (shell-command-to-string
200 (format "which --skip-alias %s 2> /dev/null | head -n 1"
204 (file-name-nondirectory (substring this
0 (- (length this
) 1))))))
206 (defun filesets-which-command (cmd)
207 "Calls \"which CMD\"."
208 (shell-command-to-string (format "which %s" cmd
)))
210 (defun filesets-which-command-p (cmd)
211 "Calls \"which CMD\" and returns non-nil if the command was found."
212 (when (string-match (format "\\(/[^/]+\\)?/%s" cmd
)
213 (filesets-which-command cmd
))
216 (defun filesets-message (level &rest args
)
217 "Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
218 (when (<= level
(abs filesets-verbosity
))
219 (apply 'message args
)))
223 (defun filesets-save-config ()
224 "Save filesets' customizations."
226 (customize-save-customized))
228 (defun filesets-reset-fileset (&optional fileset no-cache
)
229 "Reset the cached values for one or all filesets."
231 (setq filesets-submenus
(lax-plist-put filesets-submenus fileset nil
))
232 (setq filesets-submenus nil
))
233 (setq filesets-has-changed-flag t
)
234 (setq filesets-update-cache-file-flag
(or filesets-update-cache-file-flag
237 (defun filesets-set-config (fileset var val
)
238 "Set-default wrapper function."
239 (filesets-reset-fileset fileset
)
240 (set-default var val
))
241 ; (customize-set-variable var val))
242 ; (filesets-build-menu))
244 (defun filesets-set-default (sym val
&optional init-flag
)
245 "Set-default wrapper function used in conjunction with `defcustom'."
246 (let ((ignore-flag (member sym filesets-ignore-next-set-default
)))
248 (setq filesets-ignore-next-set-default
249 (delete sym filesets-ignore-next-set-default
))
251 (custom-initialize-set sym val
)
252 (set-default sym val
)))
255 (defun filesets-set-default! (sym val
)
256 "Call `filestes-set-default' and reset cached data (i.e. rebuild menu)."
257 (when (filesets-set-default sym val
)
258 (filesets-reset-fileset)))
260 (defun filesets-set-default+ (sym val
)
261 "Call `filestes-set-default' and reset filesets' standard menu."
262 (when (filesets-set-default sym val
)
263 (setq filesets-has-changed-flag t
)))
264 ; (filesets-reset-fileset nil t)))
266 (defun filesets-data-set-default (sym val
)
267 "Set the default for `filesets-data'."
268 (if filesets-menu-use-cached-flag
269 (setq filesets-menu-use-cached-flag nil
)
270 (when (default-boundp 'filesets-data
)
271 (let ((modified-filesets
272 (filesets-filter-list val
276 (let ((elt (assoc name filesets-data
)))
278 (not (equal data
(cdr elt
))))))))))
279 (dolist (x modified-filesets
)
280 (filesets-reset-fileset (car x
))))))
281 (filesets-set-default sym val
))
286 (defgroup filesets nil
287 "The fileset swapper."
291 (defcustom filesets-menu-name
"Filesets"
292 "*Filesets' menu name."
293 :set
(function filesets-set-default
)
297 (if filesets-running-xemacs
299 (defcustom filesets-menu-path nil
300 "*The menu under which the filesets menu should be inserted.
301 XEmacs specific; see `add-submenu' for documentation."
302 :set
(function filesets-set-default
)
306 (defcustom filesets-menu-before
"File"
307 "*The name of a menu before which this menu should be added.
308 XEmacs specific; see `add-submenu' for documentation."
309 :set
(function filesets-set-default
)
313 (defcustom filesets-menu-in-menu nil
314 "*Use that instead of `current-menubar' as the menu to change.
315 XEmacs specific; see `add-submenu' for documentation."
316 :set
(function filesets-set-default
)
319 (defvar filesets-menu-path nil
)
320 (defvar filesets-menu-before nil
)
321 (defvar filesets-menu-in-menu nil
))
323 (defcustom filesets-menu-shortcuts-flag t
324 "*Non-nil means to prepend menus with hopefully unique shortcuts."
325 :set
(function filesets-set-default
!)
329 (defcustom filesets-menu-shortcuts-marker
"%_"
330 "*String for marking menu shortcuts."
331 :set
(function filesets-set-default
!)
335 ;(defcustom filesets-menu-cnvfp-flag nil
336 ; "*Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
337 ; :set (function filesets-set-default!)
341 (defcustom filesets-menu-cache-file
342 (if filesets-running-xemacs
343 "~/.xemacs/filesets-cache.el"
344 "~/.filesets-cache.el")
345 "*File to be used for saving the filesets menu between sessions.
346 Set this to \"\", to disable caching of menus.
347 Don't forget to check out `filesets-menu-ensure-use-cached'."
348 :set
(function filesets-set-default
)
351 (put 'filesets-menu-cache-file
'risky-local-variable t
)
353 (defcustom filesets-menu-cache-contents
354 '(filesets-be-docile-flag
357 filesets-ingroup-cache
)
358 "*Stuff we want to save in `filesets-menu-cache-file'.
360 Possible uses: don't save configuration data in the main startup files
361 but in filesets's own cache. In this case add `filesets-data' to this
364 There is a second reason for putting `filesets-data' on this list. If
365 you frequently add and remove buffers on the fly to :files filesets, you
366 don't need to save your customizations if `filesets-data' is being
367 mirrored in the cache file. In this case the version in the cache file
368 is the current one, and the version in your startup file will be
369 silently updated later on.
371 If you want caching to work properly, at least `filesets-submenus',
372 `filesets-menu-cache', and `filesets-ingroup-cache' should be in this
375 Don't forget to check out `filesets-menu-ensure-use-cached'."
376 :set
(function filesets-set-default
)
378 (choice :tag
"Variable"
379 (const :tag
"filesets-submenus"
380 :value filesets-submenus
)
381 (const :tag
"filesets-menu-cache"
382 :value filesets-menu-cache
)
383 (const :tag
"filesets-ingroup-cache"
384 :value filesets-ingroup-cache
)
385 (const :tag
"filesets-data"
386 :value filesets-data
)
387 (const :tag
"filesets-external-viewers"
388 :value filesets-external-viewers
)
389 (const :tag
"filesets-ingroup-patterns"
390 :value filesets-ingroup-patterns
)
391 (const :tag
"filesets-be-docile-flag"
392 :value filesets-be-docile-flag
)
393 (sexp :tag
"Other" :value nil
)))
396 (defcustom filesets-cache-fill-content-hooks nil
397 "*Hooks to run when writing the contents of filesets' cache file.
399 The hook is called with the cache file as current buffer and the cursor
400 at the last position. I.e. each hook has to make sure that the cursor is
401 at the last position.
403 Possible uses: If you don't want to save `filesets-data' in your normal
404 configuration file, you can add a something like this
407 \(insert (format \"(setq-default filesets-data '%S)\"
413 Don't forget to check out `filesets-menu-ensure-use-cached'."
414 :set
(function filesets-set-default
)
418 (defcustom filesets-cache-hostname-flag nil
419 "*Non-nil means cache the hostname.
420 If the current name differs from the cached one,
421 rebuild the menu and create a new cache file."
422 :set
(function filesets-set-default
)
426 (defcustom filesets-cache-save-often-flag nil
427 "*Non-nil means save buffer on every change of the filesets menu.
428 If this variable is set to nil and if Emacs crashes, the cache and
429 filesets-data could get out of sync. Set this to t if this happens from
430 time to time or if the fileset cache causes troubles."
431 :set
(function filesets-set-default
)
435 (defcustom filesets-max-submenu-length
25
436 "*Maximum length of submenus.
437 Set this value to 0 to turn menu splitting off. BTW, parts of submenus
438 will not be rewrapped if their length exceeds this value."
439 :set
(function filesets-set-default
)
443 (defcustom filesets-max-entry-length
50
444 "*Truncate names of splitted submenus to this length."
445 :set
(function filesets-set-default
)
449 (defcustom filesets-browse-dir-function
'dired
450 "*A function or command used for browsing directories.
451 When using an external command, \"%s\" will be replaced with the
454 Note: You have to manually rebuild the menu if you change this value."
455 :set
(function filesets-set-default
)
456 :type
'(choice :tag
"Function:"
462 (string :tag
"Arguments"))
463 (function :tag
"Function"
467 (defcustom filesets-open-file-function
'filesets-find-or-display-file
468 "*The function used for opening files.
470 `filesets-find-or-display-file' ... Filesets' default function for
471 visiting files. This function checks if an external viewer is defined
472 for a specific file type. Either this viewer, if defined, or
473 `find-file' will be used to visit a file.
475 `filesets-find-file' ... An alternative function that always uses
476 `find-file'. If `filesets-be-docile-flag' is true, a file, which isn't
477 readable, will not be opened.
479 Caveat: Changes will take effect only after rebuilding the menu."
480 :set
(function filesets-set-default
)
481 :type
'(choice :tag
"Function:"
482 (const :tag
"filesets-find-or-display-file"
483 :value filesets-find-or-display-file
)
484 (const :tag
"filesets-find-file"
485 :value filesets-find-file
)
486 (function :tag
"Function"
490 (defcustom filesets-save-buffer-function
'save-buffer
491 "*The function used to save a buffer.
492 Caveat: Changes will take effect after rebuilding the menu."
493 :set
(function filesets-set-default
)
494 :type
'(choice :tag
"Function:"
495 (const :tag
"save-buffer"
497 (function :tag
"Function"
501 (defcustom filesets-find-file-delay
502 (if (and filesets-running-xemacs gutter-buffers-tab-visible-p
)
505 "*Delay before calling find-file.
506 This is for calls via `filesets-find-or-display-file'
507 or `filesets-find-file'.
509 Set this to 0, if you don't use XEmacs' buffer tabs."
510 :set
(function filesets-set-default
)
514 (defcustom filesets-be-docile-flag nil
515 "*Non-nil means don't complain if a file or a directory doesn't exist.
516 This is useful if you want to use the same startup files in different
517 computer environments."
518 :set
(function filesets-set-default
)
522 (defcustom filesets-sort-menu-flag t
523 "*Non-nil means sort the filesets menu alphabetically."
524 :set
(function filesets-set-default
)
528 (defcustom filesets-sort-case-sensitive-flag t
529 "*Non-nil means sorting of the filesete menu is case sensitive."
530 :set
(function filesets-set-default
)
534 (defcustom filesets-tree-max-level
3
535 "*Maximum scan depth for directory trees.
536 A :tree fileset is defined by a base directory the contents of which
537 will be recursively added to the menu. `filesets-tree-max-level' tells up
538 to which level the directory structure should be scanned/listed,
539 i.e. how deep the menu should be. Try something like
541 \(\"HOME -- only one level\"
542 \(:tree \"~\" \"^[^.].*[^~]$\")
544 \(:filter-dirs-flag t))
545 \(\"HOME -- up to 3 levels\"
546 \(:tree \"~\" \"^[^.].*[^~]$\")
548 \(:filter-dirs-flag t))
550 and it should become clear what this option is about. In any case,
551 including directory trees to the menu can take a lot of memory."
552 :set
(function filesets-set-default
)
556 (defcustom filesets-commands
559 (filesets-cmd-query-replace-getargs))
560 ("Query Replace (regexp)"
562 (filesets-cmd-query-replace-getargs))
563 ("Grep <<selection>>"
565 ("-n " filesets-get-quoted-selection
" " "<<file-name>>"))
567 filesets-cmd-shell-command
568 (filesets-cmd-shell-command-getargs)))
569 "*Commands to run on filesets.
570 An association list of names, functions, and an argument list (or a
571 function that returns one) to be run on a filesets' files.
573 The argument <file-name> or <<file-name>> (quoted) will be replaced with
575 :set
(function filesets-set-default
+)
576 :type
'(repeat :tag
"Commands"
577 (list :tag
"Definition" :value
("")
579 (choice :tag
"Command"
580 (string :tag
"String")
581 (function :tag
"Function"))
582 (repeat :tag
"Argument List"
583 (choice :tag
"Arguments"
586 (string :tag
"File Name"
587 :value
"<file-name>")
588 (string :tag
"Quoted File Name"
589 :value
"<<file-name>>")
590 (function :tag
"Function"
593 (put 'filesets-commands
'risky-local-variable t
)
595 (defcustom filesets-external-viewers
597 ; ((ps-cmd (or (and (boundp 'my-ps-viewer) my-ps-viewer)
598 ; (filesets-select-command "ggv gv")))
599 ; (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
600 ; (filesets-select-command "xpdf acroread")))
601 ; (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
602 ; (filesets-select-command "xdvi tkdvi")))
603 ; (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
604 ; (filesets-select-command "antiword")))
605 ; (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
606 ; (filesets-select-command "gqview ee display"))))
612 `(("^.+\\..?html?$" browse-url
613 ((:ignore-on-open-all t
)))
614 ("^.+\\.pdf$" ,pdf-cmd
615 ((:ignore-on-open-all t
)
616 (:ignore-on-read-text t
)
617 (:constraint-flag
,pdf-cmd
)))
618 ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
619 ((:ignore-on-open-all t
)
620 (:ignore-on-read-text t
)
621 (:constraint-flag
,ps-cmd
)))
622 ("^.+\\.dvi$" ,dvi-cmd
623 ((:ignore-on-open-all t
)
624 (:ignore-on-read-text t
)
625 (:constraint-flag
,dvi-cmd
)))
626 ("^.+\\.doc$" ,doc-cmd
628 (:ignore-on-read-text t
)
629 (:constraint-flag
,doc-cmd
)))
630 ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
631 ((:ignore-on-open-all t
)
632 (:ignore-on-read-text t
)
633 (:constraint-flag
,pic-cmd
)))))
634 "*Association list of file patterns and external viewers for use with
635 `filesets-find-or-display-file'.
637 Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a
638 function or a command name as string.
640 Properties is an association list determining filesets' behaviour in
641 several conditions. Choose one from this list:
643 :ignore-on-open-all ... Don't open files of this type automatically --
644 i.e. on open-all-files-events or when running commands
646 :capture-output ... capture an external viewer output
648 :constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil
650 :constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
652 :open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
653 in conjunction with :capture-output
655 :args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
656 \(defaults to (list \"%S\")) when using shell commands
658 Avoid modifying this variable and achieve minor speed-ups by setting the
659 variables my-ps-viewer, my-pdf-viewer, my-dvi-viewer, my-pic-viewer.
661 In order to view pdf or rtf files in an Emacs buffer, you could use these:
664 \(\"^.+\\.pdf$\" \"pdftotext\"
665 \((:capture-output t)
666 \(:args (\"%S - | fmt -w \" window-width))
667 \(:ignore-on-read-text t)
668 \(:constraintp (lambda ()
669 \(and \(filesets-which-command-p \"pdftotext\")
670 \(filesets-which-command-p \"fmt\"))))))
671 \(\"^.+\\.rtf$\" \"rtf2htm\"
672 \((:capture-output t)
673 \(:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
674 \(:ignore-on-read-text t)
675 \(:constraintp (lambda ()
676 \(and (filesets-which-command-p \"rtf2htm\")
677 \(filesets-which-command-p \"w3m\"))))))
679 :set
(function filesets-set-default
)
680 :type
'(repeat :tag
"Viewer"
681 (list :tag
"Definition"
682 :value
("^.+\\.suffix$" "")
683 (regexp :tag
"Pattern")
684 (choice :tag
"Viewer"
685 (symbol :tag
"Function" :value nil
)
686 (string :tag
"Program" :value
""))
687 (repeat :tag
"Properties"
689 (list :tag
":constraintp"
690 :value
(:constraintp
)
693 (function :tag
"Function"))
694 (list :tag
":constraint-flag"
695 :value
(:constraint-flag
)
697 :value
:constraint-flag
)
698 (sexp :tag
"Symbol"))
699 (list :tag
":ignore-on-open-all"
700 :value
(:ignore-on-open-all t
)
702 :value
:ignore-on-open-all
)
703 (boolean :tag
"Boolean"))
704 (list :tag
":ignore-on-read-text"
705 :value
(:ignore-on-read-text t
)
707 :value
:ignore-on-read-text
)
708 (boolean :tag
"Boolean"))
714 (choice :tag
"Arguments"
715 (string :tag
"String"
717 (symbol :tag
"Symbol"
719 (function :tag
"Function"
721 (list :tag
":open-hook"
726 ; (list :tag ":close-hook"
727 ; :value (:close-hook)
729 ; :value :close-hook)
730 ; (hook :tag "Hook"))
731 (list :tag
":capture-output"
732 :value
(:capture-output t
)
734 :value
:capture-output
)
735 (boolean :tag
"Boolean"))))))
737 (put 'filesets-external-viewers
'risky-local-variable t
)
739 (defcustom filesets-ingroup-patterns
742 (:pattern
"\\\\usepackage\\W*\\(\\[[^\]]*\\]\\W*\\)?{\\W*\\(.+\\)\\W*}")
745 (:get-file-name
(lambda (master file
)
746 (filesets-which-file master
748 (filesets-convert-path-list
749 (or (getenv "MY_TEXINPUTS")
750 (getenv "TEXINPUTS")))))))
752 (:pattern
"\\\\include\\W*{\\W*\\(.+\\)\\W*}")
753 (:get-file-name
(lambda (master file
)
754 (filesets-which-file master
756 (filesets-convert-path-list
757 (or (getenv "MY_TEXINPUTS")
758 (getenv "TEXINPUTS"))))))
761 (:pattern
"\\\\input\\W*{\\W*\\(.+\\)\\W*}")
762 (:stubp
(lambda (a b
) (not (filesets-files-in-same-directory-p a b
))))
763 (:get-file-name
(lambda (master file
)
764 (filesets-which-file master
766 (filesets-convert-path-list
767 (or (getenv "MY_TEXINPUTS")
768 (getenv "TEXINPUTS"))))))
770 ((:name
"Bibliography")
771 (:pattern
"\\\\bibliography\\W*{\\W*\\(.+\\)\\W*}")
772 (:get-file-name
(lambda (master file
)
773 (filesets-which-file master
775 (filesets-convert-path-list
776 (or (getenv "MY_BIBINPUTS")
777 (getenv "BIBINPUTS")))))))))
780 (:pattern
"(require\\W+'\\(.+\\))")
781 (:stubp
(lambda (a b
) (not (filesets-files-in-same-directory-p a b
))))
782 (:get-file-name
(lambda (master file
)
783 (filesets-which-file master
787 (:pattern
"(load\\(-library\\)?\\W+\"\\(.+\\)\")")
789 (:get-file-name
(lambda (master file
)
790 (filesets-which-file master file load-path
))))))
791 ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
792 (((:pattern
"\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
794 (:stubp
(lambda (a b
) (not (filesets-files-in-same-directory-p a b
))))
796 (:get-file-name
(lambda (master file
)
800 (if (boundp 'emacs-wiki-directories
)
801 emacs-wiki-directories
804 "*Inclusion group definitions.
806 Define how to find included file according to a file's mode (being
807 defined by a file pattern).
809 A valid entry has the form (FILE-PATTERN REMOVE-DUPLICATES-FLAG
810 CMD-DEF1 ...), CMD-DEF1 being a plist containing the fields :pattern
811 \(mandatory), :name, :get-file-name, :match-number, :scan-depth,
812 :preprocess, :case-sensitive.
814 File Pattern ... A regexp matching the file's name for which the
815 following rules should be applied.
817 Remove Duplicates ... If t, only the first occurrence of an included
818 file is retained. (See below for a full explanation.)
820 :name STRING ... This pattern's name.
822 :pattern REGEXP ... A regexp matching the command. This regexp has to
823 include a group that holds the name of the included file.
825 :get-file-name FUNCTION (default: `filesets-which-file') ... A function
826 that takes two arguments (the path of the master file and the name
827 of the included file) and returns a valid path or nil -- if the
828 subfile can't be found.
830 :match-number INTEGER (default: 1) ... The number of the match/group
831 in the pattern holding the subfile's name. 0 refers the whole
832 match, 1 to the first group.
834 :stubp FUNCTION ... if (FUNCTION MASTER INCLUDED-FILE) returns non-nil,
835 INCLUDED-FILE is a stub -- see below.
837 :stub-flag ... files of this type are stubs -- see below.
839 :scan-depth INTEGER (default: 0) ... Whether included files should be
840 rescanned. Set this to 0 to disable re-scanning of included file.
842 :preprocess FUNCTION ... A function modifying a buffer holding the
843 master file so that pattern matching becomes easier. This is usually
844 used to narrow a buffer to the relevant region. This function could also
845 be destructive and simply delete non-relevant text.
847 :case-sensitive BOOLEAN (default: nil) ... Whether a pattern is
848 case-sensitive or not.
853 First, a stub is a file that shows up in the menu but will not be
854 included in an ingroup's file listing -- i.e. filesets will never
855 operate on this file automatically. Secondly, in opposition to normal
856 files stubs are not scanned for new inclusion groups. This is useful if
857 you want to have quick access to library headers.
859 In the menu, an asterisk is appended to the stub's name.
864 E.g. File A and file B refer to file X; X refers to A. If
865 you choose not to remove duplicates the tree would look like:
870 As you can see, there is some chance that you run in circles.
871 Nevertheless, up to some degree this could still be what you want.
873 With duplicates removed, it would be:
877 :set
(function filesets-set-default
)
881 :tag
"Definition" :value
("^.+\\.suffix$" t
)
882 (regexp :tag
"File Pattern" :value
"^.+\\.suffix$")
883 (boolean :tag
"Remove Duplicates" :value t
)
884 (repeat :tag
"Commands"
885 (repeat :tag
"Command"
890 (const :format
"" :value
:name
)
891 (string :tag
"String"))
892 (list :tag
":pattern"
893 :value
(:pattern
"\\<CMD\\W*\\(.+\\)\\>")
894 (const :format
"" :value
:pattern
)
895 (regexp :tag
"RegExp"))
896 (list :tag
":get-file-name"
897 :value
(:get-file-name
)
898 (const :format
"" :value
:get-file-name
)
899 (function :tag
"Function"))
900 (list :tag
":match-number"
901 :value
(:match-number
1)
902 (const :format
"" :value
:match-number
)
903 (integer :tag
"Integer"))
904 (list :tag
":stub-flag"
905 :value
(:stub-flag t
)
906 (const :format
"" :value
:stub-flag
)
907 (boolean :tag
"Boolean"))
910 (const :format
"" :value
:stubp
)
911 (function :tag
"Function"))
912 (list :tag
":scan-depth"
913 :value
(:scan-depth
0)
914 (const :format
"" :value
:scan-depth
)
915 (integer :tag
"Integer"))
916 (list :tag
":case-sensitive"
917 :value
(:case-sensitive
)
918 (const :format
"" :value
:case-sensitive
)
919 (boolean :tag
"Boolean"))
920 (list :tag
":preprocess"
922 (const :format
"" :value
:preprocess
)
923 (function :tag
"Function")))))))
925 (put 'filesets-ingroup-patterns
'risky-local-variable t
)
927 (defcustom filesets-data
929 "*Fileset definitions.
931 A fileset is either a list of files, a file pattern, a base directory
932 and a search pattern (for files), or a base file. Changes to this
933 variable will take effect after rebuilding the menu.
935 Caveat: Fileset names have to be unique.
939 \(:ingroup \"~/Etc/My-Wiki/WikiContents\"))
941 \(:pattern \"~/public_html/\" \"^.+\\\\.html$\")
942 \(:open filesets-find-file))
943 \(\"User Configuration\"
944 \(:files \"~/.xinitrc\"
946 \"~/.bash_profile\"))
948 \(:tree \"~\" \"^[^.].*[^~]$\")
949 \(:filter-dirs-flag t)))
951 `filesets-data' is a list of (NAME-AS-STRING . DEFINITION), DEFINITION
952 being an association list with the fields:
954 :files FILE-1 .. FILE-N ... a list of files belonging to a fileset
956 :ingroup FILE-NAME ... an inclusion group's base file.
958 :tree ROOT-DIR PATTERN ... a base directory and a file pattern
960 :pattern DIR PATTERN ... PATTERN is a regular expression comprising path
961 and file pattern -- e.g. 'PATH/^REGEXP$'. Note the `^' at the beginning
962 of the file name pattern.
964 :filter-dirs-flag BOOLEAN ... is only used in conjunction with :tree.
966 :tree-max-level INTEGER ... recurse into directories this many levels
967 \(see `filesets-tree-max-level' for a full explanation)
969 :dormant-flag BOOLEAN ... non-nil means don't show this item in the
970 menu; dormant filesets can still be manipulated via commands available
971 from the minibuffer -- e.g. `filesets-open', `filesets-close', or
974 :dormant-p FUNCTION ... a function returning :dormant-flag
976 :open FUNCTION ... the function used to open file belonging to this
977 fileset. The function takes a file name as argument
979 :save FUNCTION ... the function used to save file belonging to this
980 fileset; it takes no arguments, but works on the current buffer.
982 Either :files, :pattern, :tree, or :ingroup must be supplied. :files
983 overrules :tree, :tree overrules :pattern, :pattern overrules :ingroup,
984 i.e. these tags are mutually exclusive. The fields :open and :save are
987 In conjunction with the :tree tag, :save is void. :open refers to the
988 function used for opening files in a directory, not for opening the
989 directory. For browsing directories, `filesets-browse-dir-function' is used.
991 Before using :ingroup, make sure that the file type is already
992 defined in `filesets-ingroup-patterns'."
994 :set
(function filesets-data-set-default
)
997 (string :tag
"Name" :value
"")
1000 :tag
"Type" :value nil
1001 (list :tag
"Pattern"
1002 :value
(:pattern
"~/" "^.+\\.suffix$")
1003 (const :format
"" :value
:pattern
)
1004 (directory :tag
"Dir")
1005 (regexp :tag
"Pattern"))
1008 (const :format
"" :value
:files
)
1009 (repeat :tag
"Files" file
))
1010 (list :tag
"Single File"
1012 (const :format
"" :value
:file
)
1014 (list :tag
"Inclusion group"
1015 :value
(:ingroup
"~/")
1016 (const :format
"" :value
:ingroup
)
1017 (file :tag
"File" :value
"~/"))
1018 (list :tag
"Directory Tree"
1019 :value
(:tree
"~/" "^.+\\.suffix$")
1020 (const :format
"" :value
:tree
)
1021 (directory :tag
"Dir")
1022 (regexp :tag
"Pattern"))
1023 (list :tag
"Filter directories"
1024 :value
(:filter-dirs-flag
)
1025 (const :format
"" :value
:filter-dirs-flag
)
1026 (boolean :tag
"Boolean" :value nil
))
1027 (list :tag
"Scanning depth"
1028 :value
(:tree-max-level
3)
1029 (const :format
"" :value
:tree-max-level
)
1030 (integer :tag
"Integer"))
1031 (list :tag
"Verbosity"
1032 :value
(:verbosity
1)
1033 (const :format
"" :value
:verbosity
)
1034 (integer :tag
"Integer"))
1035 (list :tag
"Conceal fileset (Flag)"
1036 :value
(:dormant-flag
)
1037 (const :format
"" :value
:dormant-flag
)
1038 (boolean :tag
"Boolean"))
1039 (list :tag
"Conceal fileset (Function)"
1041 (const :format
"" :value
:dormant-p
)
1042 (function :tag
"Function"))
1043 (list :tag
"Save function"
1045 (const :format
"" :value
:save
)
1046 (function :tag
"Function"))
1047 (list :tag
"Open function"
1049 (const :format
"" :value
:open
)
1050 (function :tag
"Function")))))))
1051 (put 'filesets-data
'risky-local-variable t
)
1054 (defcustom filesets-query-user-limit
15
1055 "*Query the user before opening a fileset with that many files."
1056 :set
(function filesets-set-default
)
1061 ;;; Emacs compatibility
1063 (if filesets-running-xemacs
1065 (fset 'filesets-error
'error
)
1066 (fset 'filesets-add-submenu
'add-submenu
))
1070 (defun filesets-error (class &rest args
)
1072 (error (mapconcat 'identity args
" ")))
1074 ;; This should work for 21.1 Emacs
1075 (defun filesets-add-submenu (menu-path submenu
&optional
1077 "`easy-menu-define' wrapper."
1079 filesets-submenu global-map
"Filesets menu" submenu
))
1082 (defun filesets-filter-dir-names (lst &optional negative
)
1083 "Remove non-directory names from a list of strings. If NEGATIVE is
1084 non-nil, remove all directory names."
1085 (filesets-filter-list lst
1087 (and (not (string-match "^\\.+/$" x
))
1089 (not (string-match "[:/\\]$" x
))
1090 (string-match "[:/\\]$" x
))))))
1092 (defun filesets-conditional-sort (lst &optional access-fn simply-do-it
)
1093 "Return a sorted copy of LST, LST being a list of strings.
1094 If `filesets-sort-menu-flag' is nil, return LST itself.
1096 ACCESS-FN ... function to get the string value of LST's elements.
1098 If SIMPLY-DO-IT is non-nil, the list is sorted regardless of
1099 `filesets-sort-menu-flag'."
1100 (if filesets-sort-menu-flag
1101 (let* ((fni (or access-fn
1102 (function identity
)))
1103 (fn (if filesets-sort-case-sensitive-flag
1105 (string< (funcall fni a
)
1108 (string< (upcase (funcall fni a
))
1109 (upcase (funcall fni b
)))))))
1110 (sort (copy-sequence lst
) fn
))
1113 (defun filesets-directory-files (dir &optional
1114 pattern what full-flag match-dirs-flag
)
1115 "Get WHAT (:files or :dirs) in DIR. If PATTERN is provided return only
1116 those entries matching this regular expression. If MATCH-DIRS-FLAG is
1117 non-nil, also match directory entries. Return full path if FULL-FLAG is
1119 (filesets-message 2 "Filesets: scanning %S" dir
)
1121 ((file-exists-p dir
)
1124 (dolist (this (file-name-all-completions "" dir
))
1126 ((string-match "^\\.+/$" this
)
1128 ((string-match "[:/\\]$" this
)
1129 (when (or (not match-dirs-flag
)
1131 (string-match pattern this
))
1132 (filesets-message 5 "Filesets: matched dir %S with pattern %S"
1134 (setq dirs
(cons this dirs
))))
1136 (when (or (not pattern
)
1137 (string-match pattern this
))
1138 (filesets-message 5 "Filesets: matched file %S with pattern %S"
1140 (setq files
(cons (if full-flag
1141 (concat (file-name-as-directory dir
) this
)
1145 ((equal what
':dirs
)
1146 (filesets-conditional-sort dirs
))
1147 ((equal what
':files
)
1148 (filesets-conditional-sort files
))
1150 (append (filesets-conditional-sort files
)
1151 (filesets-conditional-sort dirs
))))))
1152 (filesets-be-docile-flag
1153 (filesets-message 1 "Filesets: %S doesn't exist" dir
)
1156 (filesets-error 'error
"Filesets: " dir
" does not exist"))))
1158 (defun filesets-quote (txt)
1159 "Return TXT in quotes."
1160 (concat "\"" txt
"\""))
1162 (defun filesets-get-selection ()
1163 "Get the text between mark and point -- i.e. the selection or region."
1167 (buffer-substring (min m p
) (max m p
))
1168 (filesets-error 'error
"No selection."))))
1170 (defun filesets-get-quoted-selection ()
1171 "Return the currently selected text in quotes."
1172 (filesets-quote (filesets-get-selection)))
1174 (defun filesets-get-shortcut (n)
1175 "Create menu shortcuts based on number N."
1176 (let ((n (mod (- n
1) 51)))
1178 ((not filesets-menu-shortcuts-flag
)
1181 (concat (number-to-string n
) " "))
1183 (format "%c " (+ 87 n
)))
1185 (format "%c " (+ -
3 n
))))))
1187 (defun filesets-files-equalp (a b
)
1188 "Compare two filenames A and B after expansion."
1189 (equal (expand-file-name a
) (expand-file-name b
)))
1191 (defun filesets-files-in-same-directory-p (a b
)
1192 "Compare two filenames A and B after expansion."
1193 (let ((ad (file-name-directory (expand-file-name a
)))
1194 (bd (file-name-directory (expand-file-name b
))))
1197 (defun filesets-convert-path-list (string)
1198 "Return a path-list given as STRING as list."
1200 (mapcar (lambda (x) (file-name-as-directory x
))
1201 (split-string string path-separator
))
1204 (defun filesets-which-file (master filename
&optional path-list
)
1205 "Search for a FILENAME relative to a MASTER file in PATH-LIST."
1206 (let ((f (concat (file-name-directory master
)
1208 (if (file-exists-p f
)
1212 (let ((dir (file-name-as-directory dir
))
1213 (files (if (file-exists-p dir
)
1214 (filesets-directory-files dir nil
':files
)
1216 (filesets-some (lambda (file)
1217 (if (equal filename
(file-name-nondirectory file
))
1224 (defun filesets-eviewer-get-props (entry)
1225 "Get ENTRY's (representing an external viewer) properties."
1228 (defun filesets-eviewer-constraint-p (entry)
1229 (let* ((props (filesets-eviewer-get-props entry
))
1230 (constraint (assoc ':constraintp props
))
1231 (constraint-flag (assoc ':constraint-flag props
)))
1234 (funcall (cadr constraint
)))
1236 (eval (cadr constraint-flag
)))
1240 (defun filesets-get-external-viewer (file)
1241 "Find an external viewer for FILE."
1242 (let ((filename (file-name-nondirectory file
)))
1245 (when (and (string-match (nth 0 entry
) filename
)
1246 (filesets-eviewer-constraint-p entry
))
1248 filesets-external-viewers
)))
1250 (defun filesets-get-external-viewer-by-name (name)
1251 "Get the external viewer definition called NAME."
1255 (when (and (string-equal (nth 1 entry
) name
)
1256 (filesets-eviewer-constraint-p entry
))
1258 filesets-external-viewers
)))
1260 (defun filesets-filetype-property (filename event
&optional entry
)
1261 "Returns non-nil if a file of a specific type has special flags/tags.
1263 Events (corresponding tag):
1265 on-open-all (:ignore-on-open-all) ... Exclude files of this when opening
1268 on-grep (:ignore-on-read-text) ... Exclude files of this when running
1269 the \"Grep <<selection>>\" command
1271 on-capture-output (:capture-output) ... Capture output of an external viewer
1277 on-close-all ... not used"
1278 (let ((def (filesets-eviewer-get-props
1280 (filesets-get-external-viewer filename
)))))
1281 (filesets-alist-get def
1283 ((on-open-all) ':ignore-on-open-all
)
1284 ((on-grep) ':ignore-on-read-text
)
1286 ((on-close-all) nil
))
1289 (defun filesets-filetype-get-prop (property filename
&optional entry
)
1290 "Returns PROPERTY for filename -- use ENTRY if provided."
1291 (let ((def (filesets-eviewer-get-props
1293 (filesets-get-external-viewer filename
)))))
1295 (filesets-alist-get def property nil t
))))
1297 (defun filesets-reset-filename-on-change ()
1298 "Reset a buffer's filename if the buffer is being modified."
1299 (when filesets-output-buffer-flag
1300 (set-visited-file-name nil t
)))
1302 (defun filesets-spawn-external-viewer (file &optional ev-entry
)
1303 "Start an external viewer for FILE.
1304 Use the viewer defined in EV-ENTRY (a valid element of
1305 `filesets-external-viewers') if provided."
1306 (let* ((file (expand-file-name file
))
1308 (filesets-get-external-viewer file
))))
1310 (let* ((vwr (cadr entry
))
1311 (co-flag (filesets-filetype-get-prop ':capture-output file entry
))
1312 (oh (filesets-filetype-get-prop ':open-hook file entry
))
1313 (args (let ((fmt (filesets-filetype-get-prop ':args file entry
)))
1316 (dolist (this fmt rv
)
1321 ((and (symbolp this
)
1323 (format "%S" (funcall this
)))
1325 (format "%S" this
)))))))
1326 (format "%S" file
))))
1329 ((and (functionp vwr
) co-flag
)
1335 (shell-command-to-string (format "%s %s" vwr args
)))
1337 (shell-command (format "%s %s&" vwr args
))
1341 (switch-to-buffer (format "Filesets: %s %s" vwr file
))
1343 (make-local-variable 'filesets-output-buffer-flag
)
1344 (setq filesets-output-buffer-flag t
)
1345 (set-visited-file-name file t
)
1348 (set-buffer-modified-p nil
)
1349 (setq buffer-read-only t
)
1350 (beginning-of-buffer))
1353 (filesets-error 'error
1354 "Filesets: general error when spawning external viewer"))))
1356 (defun filesets-find-file (file)
1357 "Call `find-file' after a possible delay (see `filesets-find-file-delay').
1358 If `filesets-be-docile-flag' is true, a file, which isn't readable, will
1360 ; (sleep-for filesets-find-file-delay)
1361 (when (or (file-readable-p file
)
1362 (not filesets-be-docile-flag
))
1363 (sit-for filesets-find-file-delay
)
1366 (defun filesets-find-or-display-file (&optional file viewer
)
1367 "Visit FILE using an external viewer or open it in an Emacs buffer."
1369 (let* ((file (or file
1370 (read-file-name "Find file: " nil nil viewer
)))
1371 (external-viewer-def (or
1372 (filesets-get-external-viewer-by-name viewer
)
1373 (filesets-get-external-viewer file
))))
1374 (filesets-message 3 "Filesets: view %S using %s" file external-viewer-def
)
1375 (if external-viewer-def
1376 (filesets-spawn-external-viewer file external-viewer-def
)
1377 (filesets-find-file file
))))
1379 (defun filesets-find-file-using ()
1380 "Select a viewer and call `filesets-find-or-display-file'."
1382 (let* ((lst (mapcar (lambda (this)
1383 (let ((a (cadr this
)))
1384 (list (format "%s" a
) a
)))
1385 filesets-external-viewers
))
1386 (viewer (completing-read "Using viewer: " lst nil t
)))
1388 (filesets-find-or-display-file nil
(cadr (assoc viewer lst
))))))
1390 (defun filesets-browser-name ()
1391 "Get the directory browser's name as defined in `filesets-browse-dir-function'."
1393 ((listp filesets-browse-dir-function
)
1394 (car filesets-browse-dir-function
))
1396 filesets-browse-dir-function
)))
1398 (defun filesets-browse-dir (dir)
1399 "Browse DIR using `filesets-browse-dir-function'."
1400 (if (functionp filesets-browse-dir-function
)
1401 (funcall filesets-browse-dir-function dir
)
1402 (let ((name (car filesets-browse-dir-function
))
1403 (args (format (cadr filesets-browse-dir-function
) (expand-file-name dir
))))
1405 (start-process (concat "Filesets:" name
)
1406 "*Filesets external directory browser*"
1409 (defun filesets-get-fileset-name (something)
1410 "Get SOMETHING's name. (Don't ask.)"
1417 (defun filesets-data-get-name (entry)
1418 "Access to `filesets-data'. Get the entry's name"
1421 (defun filesets-data-get-data (entry)
1422 "Access to `filesets-data'. Get the entry's data section"
1425 (defun filesets-alist-get (alist key
&optional default carp
)
1426 "Get KEY's value in the association list ALIST.
1427 Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
1428 (let* ((elt (assoc key alist
)))
1437 (defun filesets-data-get (entry key
&optional default carp
)
1438 "Extract the value for KEY in the data part of fileset ENTRY.
1439 Return DEFAULT if not found. Return (car VALUE) if CARP is non-nil."
1440 (filesets-alist-get (filesets-data-get-data entry
) key default carp
))
1442 (defun filesets-data-set (entry key value
)
1443 "Set the value for KEY in the data part of fileset ENTRY."
1444 (let* ((alist (filesets-data-get-data entry
))
1445 (elt (assoc key alist
)))
1448 (setcdr entry
(cons (cons key value
) alist
)))))
1450 (defun filesets-entry-mode (entry)
1451 "Return fileset ENTRY's mode: :files, :file, :tree, :pattern, or :ingroup.
1452 See `filesets-data'."
1453 (let ((data (filesets-data-get-data entry
)))
1458 '(:files
:tree
:pattern
:ingroup
:file
))))
1460 (defun filesets-entry-get-open-fn (fileset-name &optional fileset-entry
)
1461 "Get the open-function for FILESET-NAME.
1462 Use FILESET-ENTRY for finding the open function, if provided."
1463 (filesets-data-get (or fileset-entry
1464 (filesets-get-fileset-from-name fileset-name
))
1465 ':open filesets-open-file-function t
))
1467 (defun filesets-entry-get-save-fn (fileset-name &optional fileset-entry
)
1468 "Get the save-function for FILESET-NAME.
1469 Use FILESET-ENTRY for finding the save function, if provided."
1470 (filesets-data-get (or fileset-entry
1471 (filesets-get-fileset-from-name fileset-name
))
1472 ':save filesets-save-buffer-function t
))
1474 (defun filesets-entry-get-files (entry)
1475 "Get the file list for fileset ENTRY."
1476 (filesets-data-get entry
':files
))
1478 (defun filesets-entry-set-files (entry data
&optional anyways
)
1479 "Set the file list for fileset ENTRY."
1480 (let ((files (filesets-entry-get-files entry
)))
1481 (if (or anyways files
)
1482 (filesets-data-set entry
':files data
))))
1484 (defun filesets-entry-get-verbosity (entry)
1485 "Get verbosity level for fileset ENTRY."
1486 (filesets-data-get entry
':verbosity
1 t
))
1488 (defun filesets-entry-get-file (entry)
1489 "Get the single file for fileset ENTRY."
1490 (filesets-data-get entry
':file nil t
))
1492 (defun filesets-entry-get-pattern (entry)
1493 "Get the base directory + file pattern for fileset ENTRY."
1494 ; (filesets-data-get entry ':pattern nil t))
1495 (filesets-data-get entry
':pattern
))
1497 (defun filesets-entry-get-pattern--pattern (list)
1498 "Get the file pattern for LIST."
1499 (if (= (length list
) 1) ;; for compatibility with filesets < v1.5.5
1500 (file-name-nondirectory (car list
))
1503 (defun filesets-entry-get-pattern--dir (list)
1504 "Get a file pattern's base directory for LIST."
1505 (if (= (length list
) 1) ;; for compatibility with filesets < v1.5.5
1506 (file-name-directory (car list
))
1509 (defun filesets-entry-get-tree (entry)
1510 "Get the tree pattern for fileset ENTRY."
1511 (filesets-data-get entry
':tree
))
1513 (defun filesets-entry-get-dormant-flag (entry)
1514 "Get dormant flag for fileset ENTRY."
1515 (let ((fn (filesets-data-get entry
':dormant-p nil t
)))
1518 (filesets-data-get entry
':dormant-flag nil t
))))
1520 (defun filesets-entry-get-filter-dirs-flag (entry)
1521 "Get filter-dirs-flag for fileset ENTRY."
1522 (filesets-data-get entry
':filter-dirs-flag nil t
))
1524 (defun filesets-entry-get-tree-max-level (entry)
1525 "Get maximal tree scanning depth for fileset ENTRY."
1526 (filesets-data-get entry
':tree-max-level nil t
))
1528 (defun filesets-entry-get-master (entry)
1529 "Get the base file for fileset ENTRY."
1530 (filesets-data-get entry
':ingroup nil t
))
1532 (defun filesets-file-open (open-function file-name
&optional fileset-name
)
1533 "Open FILE-NAME using OPEN-FUNCTION. If OPEN-FUNCTION is nil, it's
1534 value will be deduced from FILESET-NAME"
1535 (let ((open-function (or open-function
1536 (filesets-entry-get-open-fn fileset-name
))))
1537 (if (file-readable-p file-name
)
1538 (funcall open-function file-name
)
1539 (message "Filesets: Couldn't open `%s'" file-name
))))
1541 (defun filesets-file-close (save-function buffer
)
1543 First, save the buffer's contents using SAVE-FUNCTION. Then, kill buffer
1544 if `buffer-modified-p' returns nil.
1546 SAVE-FUNCTION takes no argument, but works on the current buffer."
1549 (if (buffer-modified-p)
1550 (funcall save-function
))
1551 (if (not (buffer-modified-p))
1552 (kill-buffer buffer
))))
1554 (defun filesets-get-fileset-from-name (name &optional mode
)
1555 "Get fileset definition for NAME."
1560 (assoc name filesets-data
))))
1564 (defun filesets-cmd-get-def (cmd-name)
1565 "Get `filesets-commands' entry for CMD-NAME."
1566 (assoc cmd-name filesets-commands
))
1568 (defun filesets-cmd-get-args (cmd-name)
1569 (let ((args (let ((def (filesets-cmd-get-def cmd-name
)))
1572 (dolist (this args rv
)
1574 ((and (symbolp this
) (fboundp this
))
1575 (let ((x (funcall this
)))
1576 (setq rv
(append rv
(if (listp x
) x
(list x
))))))
1578 (setq rv
(append rv
(list this
))))))))
1580 (defun filesets-cmd-get-fn (cmd-name)
1581 (let ((def (filesets-cmd-get-def cmd-name
)))
1584 (defun filesets-cmd-show-result (cmd output
)
1585 "Show OUTPUT of CMD (a shell command)."
1586 (pop-to-buffer "*Filesets: Shell Command Output*")
1594 (defun filesets-run-cmd--repl-fn (arg &optional format-fn
)
1595 "Helper function for `filesets-run-cmd'. Apply FORMAT-FN to arg.
1596 Replace <file-name> or <<file-name>> with filename."
1597 (funcall format-fn
(cond
1598 ((equal arg
"<file-name>")
1600 ((equal arg
"<<file-name>>")
1601 (filesets-quote (buffer-file-name)))
1605 (defun filesets-run-cmd (&optional cmd-name fileset mode
)
1606 "Run CMD-NAME (see `filesets-commands') on FILESET."
1608 (let* ((cmd-name (or cmd-name
1609 (completing-read "Select command: " filesets-commands
1612 (completing-read "Select fileset: " filesets-data nil t
))))
1613 (when (and cmd-name name
)
1614 (let* ((event (if (equal cmd-name
"Grep <<selection>>")
1617 (files (if (and fileset
1618 (or (equal mode
':ingroup
)
1619 (equal mode
':tree
)))
1620 (filesets-get-filelist fileset mode event
)
1621 (filesets-get-filelist
1622 (filesets-get-fileset-from-name name
)
1625 (let ((fn (filesets-cmd-get-fn cmd-name
))
1626 (args (filesets-cmd-get-args cmd-name
)))
1627 (dolist (this files nil
)
1630 (let ((buffer (filesets-find-file this
)))
1632 (beginning-of-buffer)
1638 (dolist (this args txt
)
1641 (filesets-run-cmd--repl-fn
1644 (if (equal txt
"") "" " ")
1645 (format "%s" this
))))))))
1646 (cmd (concat fn
" " args
)))
1647 (filesets-cmd-show-result
1648 cmd
(shell-command-to-string cmd
))))
1652 (dolist (this args argl
)
1655 (filesets-run-cmd--repl-fn
1658 (apply fn args
))))))))))))))))
1660 (defun filesets-get-cmd-menu ()
1661 "Create filesets command menu."
1663 .
,(mapcar (lambda (this)
1664 (let ((name (car this
)))
1665 `[,name
(filesets-run-cmd ,name
)]))
1666 filesets-commands
)))
1670 (defun filesets-cmd-query-replace-getargs ()
1671 "Get arguments for `filesets-cmd-query-replace'."
1672 (let* ((from-string (read-string "Filesets query replace: "
1674 'query-replace-history
))
1675 (to-string (read-string
1676 (format "Filesets query replace %s with: " from-string
)
1678 'query-replace-history
))
1679 (delimited (y-or-n-p
1680 "Filesets query replace: respect word boundaries? ")))
1681 (list from-string to-string delimited
)))
1683 (defun filesets-cmd-shell-command-getargs ()
1684 "Get arguments for `filesets-cmd-shell-command'."
1685 (let* ((arg (read-string "Shell command (%s = file): "
1687 'shell-command-history
)))
1690 (defun filesets-cmd-shell-command (txt)
1691 "Wrapper function for `shell-command'."
1692 (let ((ok (if (buffer-modified-p)
1693 (let ((ok (y-or-n-p "Save buffer? ")))
1699 (let ((cmd (format txt
(buffer-file-name))))
1700 (message "Filesets: %s" cmd
)
1701 (filesets-cmd-show-result cmd
1702 (shell-command-to-string cmd
))))))
1706 (defun filesets-get-filelist (entry &optional mode event
)
1707 "Get all files for fileset ENTRY.
1708 Assume MODE (see `filesets-entry-mode'), if provided."
1709 (let* ((mode (or mode
1710 (filesets-entry-mode entry
)))
1713 (filesets-entry-get-files entry
))
1715 (list (filesets-entry-get-file entry
)))
1717 (let ((entry (expand-file-name
1720 (filesets-entry-get-master entry
)))))
1721 (cons entry
(filesets-ingroup-cache-get entry
))))
1723 (let ((dir (nth 0 entry
))
1724 (patt (nth 1 entry
)))
1725 (filesets-directory-files dir patt
':files t
)))
1727 (let ((dirpatt (filesets-entry-get-pattern entry
)))
1729 (let ((dir (filesets-entry-get-pattern--dir dirpatt
))
1730 (patt (filesets-entry-get-pattern--pattern dirpatt
)))
1731 ;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
1732 (filesets-directory-files dir patt
':files t
))
1733 ;; (message "Filesets: malformed entry: %s" entry)))))))
1734 (filesets-error 'error
"Filesets: malformed entry: "
1736 (filesets-filter-list fl
1738 (not (filesets-filetype-property file event
))))))
1740 (defun filesets-open (&optional mode name lookup-name
)
1741 "Open the fileset called NAME.
1742 Use LOOKUP-NAME for searching additional data if provided."
1744 (let* ((name (or name
1745 (completing-read "Open fileset: " filesets-data nil t
)))
1746 (fileset (filesets-get-fileset-from-name name mode
))
1747 (lookup-fs (if lookup-name
1748 (filesets-get-fileset-from-name lookup-name
)
1750 (mode (or mode
(filesets-entry-mode lookup-fs
))))
1752 (let* ((files (filesets-get-filelist fileset mode
'on-open-all
))
1754 (open-function (filesets-entry-get-open-fn nil lookup-fs
)))
1755 (if (or (<= n filesets-query-user-limit
)
1756 (y-or-n-p (format "Filesets: Open all %d files in %s? "
1758 (dolist (this files nil
)
1759 (filesets-file-open open-function this
))
1760 (message "Filesets: cancelled")))
1761 (filesets-error 'error
"Filesets: Unknown fileset: " name
))))
1763 (defun filesets-close (&optional mode name lookup-name
)
1764 "Close all buffers belonging to the fileset called NAME.
1765 Use LOOKUP-NAME for deducing the save-function, if provided."
1767 (let* ((name (or name
1768 (completing-read "Close fileset: " filesets-data nil t
)))
1769 (fileset (filesets-get-fileset-from-name name mode
))
1770 (lookup-fs (if lookup-name
1771 (filesets-get-fileset-from-name lookup-name
)
1773 (mode (or mode
(filesets-entry-mode lookup-fs
))))
1775 (let ((files (filesets-get-filelist fileset mode
'on-close-all
))
1776 (save-function (filesets-entry-get-save-fn nil lookup-fs
)))
1777 (dolist (file-name files nil
)
1778 (let* ((buffer (get-file-buffer file-name
)))
1780 (filesets-file-close save-function buffer
)))))
1781 ; (message "Filesets: Unknown fileset: `%s'" name))))
1782 (filesets-error 'error
"Filesets: Unknown fileset: " name
))))
1784 (defun filesets-add-buffer (&optional name buffer
)
1785 "Add BUFFER (or current-buffer) to the fileset called NAME.
1786 User will be queried, if no fileset name is provided."
1788 (let* ((buffer (or buffer
1792 (format "Add '%s' to fileset: " buffer
)
1793 filesets-data nil t
)))
1794 (entry (assoc name filesets-data
)))
1796 (let* ((files (filesets-entry-get-files entry
))
1797 (this (buffer-file-name buffer
))
1798 (inlist (filesets-member this files
1799 :test
'filesets-files-equalp
)))
1802 (message "Filesets: '%s' is already in '%s'" this name
))
1803 ((and (equal (filesets-entry-mode entry
) ':files
)
1805 (filesets-entry-set-files entry
(cons this files
) t
)
1806 (filesets-set-config name
'filesets-data filesets-data
))
1808 (message "Filesets: Can't add '%s' to fileset '%s'" this name
)))))))
1810 (defun filesets-remove-buffer (&optional name buffer
)
1811 "Remove BUFFER (or current-buffer) to fileset NAME.
1812 User will be queried, if no fileset name is provided."
1814 (let* ((buffer (or buffer
1818 (format "Remove '%s' from fileset: " buffer
)
1819 filesets-data nil t
)))
1820 (entry (assoc name filesets-data
)))
1822 (let* ((files (filesets-entry-get-files entry
))
1823 (this (buffer-file-name buffer
))
1824 (inlist (filesets-member this files
1825 :test
'filesets-files-equalp
)))
1826 ;;(message "%s %s %s" files this inlist)
1827 (if (and files this inlist
)
1828 (let ((new (list (cons ':files
(delete (car inlist
) files
)))))
1830 (filesets-set-config name
'filesets-data filesets-data
))
1831 (message "Filesets: Can't remove '%s' from fileset '%s'"
1835 (defun filesets-convert-patterns (name)
1836 "Change fileset NAME's mode from :pattern to :files."
1838 (let ((entry (assoc name filesets-data
)))
1840 (let ((pattern (filesets-entry-get-pattern entry
))
1841 (patfiles (filesets-get-filelist entry
':pattern
)))
1844 (filesets-entry-set-files entry patfiles t
)
1845 (filesets-set-config name
'filesets-data filesets-data
)))))))
1847 (defun filesets-edit ()
1848 "Customize `filesets-data'."
1850 (customize-variable 'filesets-data
))
1852 (defun filesets-customize ()
1853 "Customize the filesets group."
1855 (customize-group 'filesets
))
1857 (defun filesets-info ()
1858 "Display filesets's version information."
1860 (if (y-or-n-p (format "Filesets v%s: visit homepage? " filesets-version
))
1861 (filesets-goto-homepage)))
1863 (defun filesets-goto-homepage ()
1864 "Show filesets's homepage."
1866 (browse-url filesets-homepage
))
1868 (defun filesets-remake-shortcut (count submenu
)
1869 "Remake a submenus shortcut when wrapping long menus."
1870 (let* ((name (concat (filesets-get-shortcut count
)
1871 (substring (elt submenu
0) 2))))
1873 (cons name
(cdr submenu
))
1874 (apply 'vector
(list name
(cdr (append submenu nil
)))))))
1875 ; (vconcat `[,name] (subseq submenu 1)))))
1877 (defun filesets-wrap-submenu (submenu-body)
1878 "Split long submenus."
1879 (let ((bl (length submenu-body
)))
1880 (if (or (= filesets-max-submenu-length
0)
1881 (<= bl filesets-max-submenu-length
))
1884 (factor (ceiling (/ (float bl
)
1885 filesets-max-submenu-length
))))
1886 (do ((data submenu-body
(cdr data
))
1888 (count 0 (+ count factor
)))
1891 ; (let ((sl (subseq submenu-body count
1892 (let ((sl (filesets-sublist submenu-body count
1893 (let ((x (+ count factor
)))
1901 (if (= (length sl
) 1)
1902 (if filesets-menu-shortcuts-flag
1903 (list (filesets-remake-shortcut n
(car sl
)))
1906 (filesets-get-shortcut n
)
1908 (do ((x sl
(cdr x
)))
1910 (let ((y (concat (elt (car x
) 0)
1917 (if filesets-menu-shortcuts-flag
1921 filesets-max-entry-length
)
1923 (substring rv
0 filesets-max-entry-length
)
1929 (defun filesets-get-menu-epilog (something &optional
1930 mode lookup-name rebuild-flag
)
1931 "Get submenu epilog for SOMETHING (usually a fileset).
1932 If mode is :tree or :ingroup, SOMETHING is some weird construct and
1933 LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
1937 ["Close all files" (filesets-close ',mode
',something
',lookup-name
)]
1938 ["Run Command" (filesets-run-cmd nil
',something
',mode
)]
1939 [,(format "Browse with `%s'" (filesets-browser-name))
1940 (filesets-browse-dir ',(car something
))]
1941 ,@(when rebuild-flag
1942 `(["Rebuild this submenu"
1943 (filesets-rebuild-this-submenu ',lookup-name
)]))))
1946 ["Close all files" (filesets-close ',mode
',something
',lookup-name
)]
1947 ["Run Command" (filesets-run-cmd nil
',something
',mode
)]
1948 ,@(when rebuild-flag
1949 `(["Rebuild this submenu"
1950 (filesets-rebuild-this-submenu ',lookup-name
)]))))
1953 ["Close all files" (filesets-close ',mode
',something
)]
1954 ["Run Command" (filesets-run-cmd nil
',something
',mode
)]
1955 [,(format "Browse with `%s'" (filesets-browser-name))
1956 ,(list 'filesets-browse-dir
1957 (filesets-entry-get-pattern--dir
1958 (filesets-entry-get-pattern
1959 (filesets-get-fileset-from-name something
':pattern
))))]
1960 ; [,(concat (if filesets-menu-shortcuts-flag
1961 ; (concat "Con" filesets-menu-shortcuts-marker "vert")
1963 ; " :pattern to :files")
1964 ; ,(list (function filesets-convert-patterns) something)]
1965 ,@(when rebuild-flag
1966 `(["Rebuild this submenu"
1967 (filesets-rebuild-this-submenu ',lookup-name
)]))))
1970 [,(concat "Close all files") (filesets-close ',mode
',something
)]
1971 ["Run Command" (filesets-run-cmd nil
',something
',mode
)]
1972 ["Add current buffer"
1973 (filesets-add-buffer ',something
(current-buffer))]
1974 ["Remove current buffer"
1975 (filesets-remove-buffer ',something
(current-buffer))]
1976 ,@(when rebuild-flag
1977 `(["Rebuild this submenu"
1978 (filesets-rebuild-this-submenu ',lookup-name
)]))))
1980 (filesets-error 'error
"Filesets: malformed definition of " something
))))
1982 (defun filesets-ingroup-get-data (master pos
&optional fun
)
1983 "Access to `filesets-ingroup-patterns'. Extract data section."
1984 (let ((masterfile (file-name-nondirectory master
))
1985 (fn (or fun
(lambda (a b
)
1988 (string-match a b
))))))
1989 (filesets-some (lambda (x)
1990 (if (funcall fn
(car x
) masterfile
)
1993 filesets-ingroup-patterns
)))
1995 (defun filesets-ingroup-get-pattern (master)
1996 "Access to `filesets-ingroup-patterns'. Extract patterns."
1997 (filesets-ingroup-get-data master
2))
1999 (defun filesets-ingroup-get-remdupl-p (master)
2000 "Access to `filesets-ingroup-patterns'. Extract remove-duplicates-flag."
2001 (filesets-ingroup-get-data master
1))
2003 (defun filesets-ingroup-collect-finder (patt case-sencitivep
)
2004 "Helper function for `filesets-ingroup-collect'. Find pattern PATT."
2005 (let ((cfs case-fold-search
)
2007 (setq case-fold-search
(not case-sencitivep
))
2008 (re-search-forward patt nil t
))))
2009 (setq case-fold-search cfs
)
2012 (defun filesets-ingroup-cache-get (master)
2013 "Access to `filesets-ingroup-cache'."
2014 (lax-plist-get filesets-ingroup-cache master
))
2016 (defun filesets-ingroup-cache-put (master file
)
2017 "Access to `filesets-ingroup-cache'."
2018 (let* ((emaster (expand-file-name master
))
2020 (cons file
(filesets-ingroup-cache-get emaster
))
2022 (setq filesets-ingroup-cache
2023 (lax-plist-put filesets-ingroup-cache emaster this
))))
2025 (defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth
)
2026 "Helper function for `filesets-ingroup-collect'. Collect file names."
2027 (let* ((master (or master
2028 (filesets-entry-get-master fs
)))
2029 (remdupl-flag (or remdupl-flag
2030 (filesets-ingroup-get-remdupl-p master
))))
2031 (filesets-ingroup-cache-put master nil
)
2032 (filesets-message 2 "Filesets: parsing %S" master
)
2033 (let ((cmdpatts (filesets-ingroup-get-pattern master
))
2037 (dolist (this-def cmdpatts rv
)
2038 (let* ((this-patt (filesets-alist-get this-def
':pattern nil t
))
2039 (this-name (filesets-alist-get this-def
':name
"" t
))
2040 (this-pp (filesets-alist-get this-def
':preprocess nil t
))
2041 (this-mn (filesets-alist-get this-def
':match-number
1 t
))
2043 (filesets-alist-get this-def
':scan-depth
0 t
)))
2044 (this-csp (filesets-alist-get this-def
':case-sensitive nil t
))
2045 (this-fn (filesets-alist-get
2046 this-def
':get-file-name
'filesets-which-file t
))
2047 (this-stubp (filesets-alist-get this-def
':stubp nil t
))
2048 (this-stub-flag (filesets-alist-get this-def
':stub-flag nil t
))
2053 (filesets-error 'error
"Filesets: malformed :ingroup definition "
2059 (insert-file-contents master
)
2060 (goto-char (point-min))
2063 (while (filesets-ingroup-collect-finder this-patt this-csp
)
2064 (let* ((txt (match-string this-mn
))
2065 (f (funcall this-fn master txt
)))
2067 (not (member f flist
))
2068 (or (not remdupl-flag
)
2069 (not (filesets-member
2070 f filesets-ingroup-files
2071 :test
'filesets-files-equalp
))))
2073 (and (not this-stub-flag
)
2075 (not (funcall this-stubp master f
))
2077 (setq count
(+ count
1))
2078 (setq flist
(cons f flist
))
2079 (setq filesets-ingroup-files
2080 (cons f filesets-ingroup-files
))
2082 (filesets-ingroup-cache-put master f
))
2083 (setq lst
(append lst
(list f
))))))))
2087 (mapcar (lambda (this)
2088 `((,this
,this-name
)
2089 ,@(filesets-ingroup-collect-files
2090 fs remdupl-flag this
2093 (filesets-message 2 "Filesets: no patterns defined for %S" master
)))))
2095 (defun filesets-ingroup-collect-build-menu (fs flist
&optional other-count
)
2096 "Helper function for `filesets-ingroup-collect'. Build the menu.
2097 FS is a fileset's name. FLIST is a list returned by
2098 `filesets-ingroup-collect-files'."
2104 (dolist (this flist rv
)
2105 (setq count
(+ count
1))
2106 (let* ((def (if (listp this
) (car this
) (list this
"")))
2107 (files (if (listp this
) (cdr this
) nil
))
2108 (master (nth 0 def
))
2110 (nm (concat (filesets-get-shortcut (if (or (not other-count
) files
)
2112 (if (or (null name
) (equal name
""))
2114 (format "%s: " name
))
2115 (file-name-nondirectory master
))))
2120 [,(concat "Inclusion Group: "
2121 (file-name-nondirectory master
))
2122 (filesets-open ':ingroup
',master
',fsn
)]
2124 [,master
(filesets-file-open nil
',master
',fsn
)]
2129 (setq count
(+ count
1))
2130 (let ((ff (filesets-ingroup-collect-build-menu
2131 fs
(list this
) count
)))
2132 (if (= (length ff
) 1)
2136 ,@(filesets-get-menu-epilog master
':ingroup fsn
)))
2137 `([,nm
(filesets-file-open nil
',master
',fsn
)])))))))))
2139 (defun filesets-ingroup-collect (fs remdupl-flag master
&optional depth
)
2140 "Collect names of included files & build submenu."
2141 (filesets-ingroup-cache-put master nil
)
2142 (filesets-message 2 "Filesets: parsing %S" master
)
2143 (filesets-ingroup-collect-build-menu
2145 (filesets-ingroup-collect-files fs remdupl-flag master
)))
2147 (defun filesets-build-ingroup-submenu (lookup-name master
)
2148 "Build a :ingroup submenu for file MASTER."
2149 (if (file-readable-p master
)
2150 (let ((remdupl-flag (filesets-ingroup-get-remdupl-p master
)))
2151 (setq filesets-ingroup-files
(list master
))
2152 (filesets-ingroup-collect lookup-name remdupl-flag master
))
2153 (if filesets-be-docile-flag
2155 (message "Filesets: can't parse %s" master
)
2157 (filesets-error 'error
"Filesets: can't parse " master
))))
2159 (defun filesets-build-dir-submenu-now (level depth entry lookup-name dir patt fd
2160 &optional rebuild-flag
)
2161 "Helper function for `filesets-build-dir-submenu'."
2162 ;;(filesets-message 3 "Filesets: scanning %s" dir)
2165 (let* ((dir (file-name-as-directory dir
))
2166 (header `([,(concat "Tree: "
2170 (file-name-as-directory
2171 (file-name-nondirectory
2172 (directory-file-name dir
))))))
2173 ,(list (function filesets-open
)
2175 `(quote (,dir
,patt
))
2178 (dirlist (filesets-directory-files dir patt nil nil fd
))
2179 (subdirs (filesets-filter-dir-names dirlist
))
2183 (setq count
(+ count
1))
2184 (let* ((x (file-name-as-directory x
))
2186 (dd (filesets-build-dir-submenu-now
2187 (+ level
1) depth entry
2188 lookup-name xx patt fd
))
2189 (nm (concat (filesets-get-shortcut count
)
2193 `[,nm
,(list 'filesets-browse-dir xx
)])))
2195 (files (filesets-filter-dir-names dirlist t
))
2196 (filesmenu (mapcar (lambda (x)
2197 (setq count
(+ count
1))
2198 `[,(concat (filesets-get-shortcut count
)
2200 (filesets-file-open nil
2201 (quote ,(concat dir x
))
2202 (quote ,lookup-name
))])
2205 (filesets-wrap-submenu
2209 (filesets-get-menu-epilog `(,dir
,patt
) ':tree
2210 lookup-name rebuild-flag
)))
2213 (defun filesets-build-dir-submenu (entry lookup-name dir patt
)
2214 "Build a :tree submenu named LOOKUP-NAME with base directory DIR including
2215 all files matching PATT for filesets ENTRY."
2216 (let ((fd (filesets-entry-get-filter-dirs-flag entry
))
2217 (depth (or (filesets-entry-get-tree-max-level entry
)
2218 filesets-tree-max-level
)))
2219 (filesets-build-dir-submenu-now 0 depth entry lookup-name dir patt fd t
)))
2221 (defun filesets-build-submenu (count lookup-name entry
)
2222 "Build submenu for the fileset ENTRY named LOOKUP-NAME.
2223 Construct a shortcut from COUNT."
2224 (let ((lookup-name (or lookup-name
2225 (filesets-data-get-name entry
))))
2226 (message "Filesets: %s" lookup-name
)
2227 (let ((mode (filesets-entry-mode entry
))
2228 (filesets-verbosity (filesets-entry-get-verbosity entry
))
2229 (this-lookup-name (concat (filesets-get-shortcut count
)
2233 (let* ((file (filesets-entry-get-file entry
)))
2235 (filesets-file-open nil
',file
',lookup-name
)]))
2240 (let* ((files (filesets-get-filelist entry mode
'on-ls
))
2241 (dirpatt (filesets-entry-get-pattern entry
))
2242 (pattname (apply 'concat
(cons "Pattern: " dirpatt
)))
2244 ;;(filesets-message 3 "Filesets: scanning %S" pattname)
2246 ,(list (function filesets-open
) mode lookup-name
)]
2248 ,@(filesets-wrap-submenu
2251 (setq count
(+ count
1))
2252 `[,(concat (filesets-get-shortcut count
)
2253 (file-name-nondirectory x
))
2254 (filesets-file-open nil
',x
',lookup-name
)])
2256 ,@(filesets-get-menu-epilog lookup-name mode
2259 (let* ((master (filesets-entry-get-master entry
)))
2260 ;;(filesets-message 3 "Filesets: parsing %S" master)
2261 `([,(concat "Inclusion Group: "
2262 (file-name-nondirectory master
))
2263 (filesets-open ',mode
',master
',lookup-name
)]
2265 [,master
(filesets-file-open nil
',master
',lookup-name
)]
2267 ,@(filesets-wrap-submenu
2268 (filesets-build-ingroup-submenu lookup-name master
))
2269 ,@(filesets-get-menu-epilog master mode lookup-name t
))))
2271 (let* ((dirpatt (filesets-entry-get-tree entry
))
2273 (patt (cadr dirpatt
)))
2274 (filesets-build-dir-submenu entry lookup-name dir patt
)))
2276 (let ((files (filesets-get-filelist entry mode
'on-open-all
))
2278 `([,(concat "Files: " lookup-name
)
2279 (filesets-open ',mode
',lookup-name
)]
2281 ,@(filesets-wrap-submenu
2284 (setq count
(+ count
1))
2285 `[,(concat (filesets-get-shortcut count
)
2286 (file-name-nondirectory x
))
2287 (filesets-file-open nil
',x
',lookup-name
)])
2288 (filesets-conditional-sort
2290 (function file-name-nondirectory
))))
2291 ,@(filesets-get-menu-epilog lookup-name mode
2292 lookup-name t
)))))))))))
2294 (defun filesets-remove-from-ubl (&optional buffer
)
2295 "BUFFER or current-buffer require update of the filesets menu."
2298 (if (member b filesets-updated-buffers
)
2299 (setq filesets-updated-buffers
2300 (delete b filesets-updated-buffers
)))))
2302 (defun filesets-build-menu-now (from-scratch-flag)
2303 "Update the filesets menu.
2304 Build all new if FROM-SCRATCH-FLAG is non-nil. (To really build from the
2305 bottom up, set `filesets-submenus' to nil, first.)"
2306 (when (or from-scratch-flag
2307 filesets-has-changed-flag
2308 (not filesets-menu-cache
))
2309 (setq filesets-menu-cache nil
)
2310 (setq filesets-has-changed-flag nil
)
2311 (setq filesets-updated-buffers nil
)
2312 (setq filesets-update-cache-file-flag t
)
2313 (do ((data (filesets-conditional-sort filesets-data
(function car
))
2315 (count 1 (+ count
1)))
2317 (let* ((this (car data
))
2318 (name (filesets-data-get-name this
))
2319 (cached (lax-plist-get filesets-submenus name
))
2321 (filesets-build-submenu count name this
))))
2323 (setq filesets-submenus
2324 (lax-plist-put filesets-submenus name submenu
)))
2325 (unless (filesets-entry-get-dormant-flag this
)
2326 (setq filesets-menu-cache
2327 (append filesets-menu-cache
(list submenu
))))))
2328 (when filesets-cache-save-often-flag
2329 (filesets-menu-cache-file-save-maybe)))
2330 (let ((cb (current-buffer)))
2331 (when (not (member cb filesets-updated-buffers
))
2332 (filesets-add-submenu
2334 `(,filesets-menu-name
2336 ["Edit Filesets" filesets-edit
]
2337 ["Save Filesets" filesets-save-config
]
2338 ["Save Menu Cache" filesets-menu-cache-file-save
]
2339 ["Rebuild Menu" filesets-build-menu
]
2340 ["Customize" filesets-customize
]
2341 ["About" filesets-info
])
2342 ,(filesets-get-cmd-menu)
2344 ,@filesets-menu-cache
)
2345 filesets-menu-before
2346 filesets-menu-in-menu
)
2347 (setq filesets-updated-buffers
2348 (cons cb filesets-updated-buffers
))
2349 ;; This wipes out other messages in the echo area.
2351 ;;(message "Filesets updated: %s" cb)
2354 (defun filesets-build-menu-maybe ()
2355 "Update the filesets menu."
2357 (filesets-build-menu-now nil
))
2359 (defun filesets-build-menu ()
2360 "Force rebuild of the filesets menu."
2362 ;(setq filesets-submenus nil)
2363 (filesets-reset-fileset)
2364 (filesets-build-menu-now t
)
2365 (filesets-menu-cache-file-save-maybe))
2367 (defun filesets-rebuild-this-submenu (fileset)
2368 "Force rebuild of FILESET submenu."
2369 (filesets-reset-fileset fileset
)
2370 (filesets-build-menu-now t
))
2372 (defun filesets-menu-cache-file-save-maybe (&optional simply-do-it
)
2373 "Write filesets' cache file.
2374 If SIMPLY-DO-IT is non-nil, the cache file will be written no matter if
2375 fileset thinks this is necessary or not."
2376 (when (and (not (equal filesets-menu-cache-file
""))
2378 filesets-update-cache-file-flag
))
2379 (when (file-exists-p filesets-menu-cache-file
)
2380 (delete-file filesets-menu-cache-file
))
2381 ;;(message "Filesets: saving menu cache")
2383 (dolist (this filesets-menu-cache-contents
)
2384 (if (get this
'custom-type
)
2386 (insert (format "(setq-default %s '%S)" this
(eval this
)))
2387 (when filesets-menu-ensure-use-cached
2389 (insert (format "(setq %s (cons '%s %s))"
2390 'filesets-ignore-next-set-default
2392 'filesets-ignore-next-set-default
))))
2393 (insert (format "(setq %s '%S)" this
(eval this
))))
2395 (insert (format "(setq filesets-cache-version %S)" filesets-version
))
2397 (when filesets-cache-hostname-flag
2398 (insert (format "(setq filesets-cache-hostname %S)" (system-name)))
2400 (run-hooks 'filesets-cache-fill-content-hooks
)
2401 (write-file filesets-menu-cache-file
))
2402 (setq filesets-has-changed-flag nil
)
2403 (setq filesets-update-cache-file-flag nil
)))
2405 (defun filesets-menu-cache-file-save ()
2406 "Save filesets' menu cache file."
2408 (filesets-menu-cache-file-save-maybe t
))
2410 (defun filesets-update-cleanup ()
2411 "Rebuild the menu and save the cache file after updating user data."
2413 (message "Filesets v%s: updating menu & cache from version %s"
2414 filesets-version
(or filesets-cache-version
"???"))
2415 (filesets-build-menu)
2416 (filesets-menu-cache-file-save-maybe)
2417 (filesets-menu-cache-file-load))
2419 (defun filesets-update-pre010505 ()
2421 "Filesets: manual editing of user data required!
2423 Filesets has detected that you were using an older version before,
2424 which requires some manual updating. Type 'y' for editing the startup
2427 The layout of `filesets-data' has changed. Please delete your cache file
2428 and edit your startup file as shown below:
2430 1. `filesets-data': Edit all :pattern filesets in your startup file and
2431 transform all entries as shown in this example:
2433 \(\"Test\" (:pattern \"~/dir/^pattern$\"))
2434 --> \(\"Test\" (:pattern \"~/dir/\" \"^pattern$\"))
2436 2. `filesets-data': Change all occurrences of \":document\" to \":ingroup\":
2438 \(\(\"Test\" \(:document \"~/dir/file\"))
2439 --> \(\(\"Test\" \(:ingroup \"~/dir/file\"))
2441 3. `filesets-subdocument-patterns': If you already modified the variable
2442 previously called `filesets-subdocument-patterns', change its name to
2443 `filesets-ingroup-patterns'.
2445 4. `filesets-menu-cache-contents': If you already modified this
2446 variable, change the entry `filesets-subdocument--cache' to
2447 `filesets-ingroup-cache'.
2449 5. Type M-x filesets-update-cleanup and restart Emacs.
2451 We apologize for the inconvenience."))
2452 (let* ((cf (or custom-file user-init-file
)))
2453 (switch-to-buffer-other-frame "*Filesets update*")
2455 (when (y-or-n-p (format "Edit startup (%s) file now? " cf
))
2456 (find-file-other-window cf
))
2457 (filesets-error 'error msg
))))
2459 (defun filesets-update (version cached-version
)
2460 "Do some cleanup after updating filesets.el."
2462 ((or (not cached-version
)
2463 (string< cached-version
"1.5.5")
2464 (boundp 'filesets-subdocument-patterns
))
2465 (filesets-update-pre010505)))
2466 (filesets-update-cleanup))
2468 (defun filesets-menu-cache-file-load ()
2469 "Load filesets' menu cache file."
2471 ((and (not (equal filesets-menu-cache-file
""))
2472 (file-readable-p filesets-menu-cache-file
))
2473 (load-file filesets-menu-cache-file
)
2474 (if (and (equal filesets-cache-version filesets-version
)
2475 (if filesets-cache-hostname-flag
2476 (equal filesets-cache-hostname
(system-name))
2479 (setq filesets-update-cache-file-flag nil
)
2481 (filesets-update filesets-version filesets-cache-version
)))
2483 (setq filesets-update-cache-file-flag t
)
2486 (defun filesets-exit ()
2487 (filesets-menu-cache-file-save-maybe))
2489 (defun filesets-init ()
2490 "Filesets initialization.
2491 Set up hooks, load the cache file -- if existing -- and build the menu."
2492 (add-hook (if filesets-running-xemacs
'activate-menubar-hook
'menu-bar-update-hook
)
2493 (function filesets-build-menu-maybe
))
2494 (add-hook 'kill-buffer-hook
(function filesets-remove-from-ubl
))
2495 (add-hook 'first-change-hook
(function filesets-reset-filename-on-change
))
2496 (add-hook 'kill-emacs-hook
(function filesets-exit
))
2497 (if (filesets-menu-cache-file-load)
2499 (filesets-build-menu-maybe)
2500 ;;Well, normally when we use XEmacs <= 21.4, custom.el is loaded
2501 ;;after init.el. This more or less ignores the next
2502 ;;`filesets-data-set-default'
2503 (if filesets-menu-ensure-use-cached
2504 (setq filesets-menu-use-cached-flag t
)))
2505 (filesets-build-menu)))
2513 ;;; Local Variables:
2514 ;;; sentence-end-double-space:t
2517 ;;; filesets.el ends here