filesets.el 84.8 KB
Newer Older
1
;;; filesets.el --- handle group of files -*- coding: utf-8 -*-
2

3
;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
4

Chong Yidong's avatar
Chong Yidong committed
5
;; Author: Thomas Link <sanobast-emacs@yahoo.de>
6
;; Maintainer: FSF
7 8
;; Keywords: filesets convenience

Pavel Janík's avatar
Pavel Janík committed
9 10
;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15

16
;; GNU Emacs is distributed in the hope that it will be useful,
17 18 19 20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

21 22 23 24
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:
25

26
(defvar filesets-version "1.8.4")
27 28 29 30 31
(defvar filesets-homepage
  "http://members.a1.net/t.link/CompEmacsFilesets.html")

;;; Commentary:

Pavel Janík's avatar
Pavel Janík committed
32
;; Define filesets, which can be opened or saved with the power of one or
Pavel Janík's avatar
Pavel Janík committed
33 34 35
;; two mouse clicks only.  A fileset is either a list of files, a file
;; pattern, a base directory and a search pattern (for files), or an
;; inclusion group (i.e. a base file including other files).
36

37
;; Usage:
38
;; 1. Put (require 'filesets) and (filesets-init) in your init file.
39 40
;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
;; 3. Save your customizations.
41

Pavel Janík's avatar
Pavel Janík committed
42
;; Caveat: Fileset names have to be unique.
43

Pavel Janík's avatar
Pavel Janík committed
44 45 46
;; Filesets.el adds a nifty filesets menu to your menubar.  If you change
;; your filesets on the fly, don't forget to select "Save Filesets" from
;; the menu.
47

Pavel Janík's avatar
Pavel Janík committed
48 49 50 51
;; Pressing on the first item in the submenu will open all files at once.
;; Define your own function, e.g. browse-url, for opening a fileset's
;; files.  Or define external viewers for opening files with other
;; programs.  See `filesets-external-viewers'.
52

Pavel Janík's avatar
Pavel Janík committed
53
;; BTW, if you close a fileset, files, which have been changed, will
Glenn Morris's avatar
Glenn Morris committed
54
;; be silently saved.  Change this behavior by setting
Pavel Janík's avatar
Pavel Janík committed
55
;; `filesets-save-buffer-fn'.
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

;;; Supported modes for inclusion groups (`filesets-ingroup-patterns'):
;; - Elisp
;; - Emacs-Wiki (simple names only)
;; - LaTeX



;;; Known bugs:


;;; To do:

;;- better handling of different customization scenarios

71 72 73 74 75 76 77
;; Data gathering should be better separated from building the menu
;; so that one could (1) use filesets without installing the menu
;; and (2) create new "frontends" to speedbar and others.

;; The functionality to call external viewers should be isolated in
;; an extra package and possibly integrated with the MIME
;; handling.
78 79 80 81 82 83 84 85 86 87 88 89 90

;;; Credits:

;; Helpful suggestions (but no significant code) were contributed by

;;- Christoph Conrad (at gmx de)
;;- Christian Ohler (at Informatik Uni-Oldenburg DE)
;;- Richard Stallman aka RMS (at gnu org)
;;- Per Abrahamsen aka abraham (at dina kvl dk)


;;; Code:

Stefan Monnier's avatar
Stefan Monnier committed
91
(eval-when-compile (require 'cl-lib))
92 93 94 95 96 97 98 99 100 101 102 103

;;; Some variables

(defvar filesets-menu-cache nil
  "The whole filesets menu.")
(defvar filesets-cache-version nil
  "Filesets' cached version number.")
(defvar filesets-cache-hostname nil
  "Filesets' cached system name.")

(defvar filesets-ingroup-cache nil
  "A plist containing files and their ingroup data.")
104 105
(defvar filesets-ingroup-files nil
  "List of files already processed when searching for included files.")
106 107 108 109 110 111 112 113

(defvar filesets-has-changed-flag t
  "Non-nil means some fileset definition has changed.")
(defvar filesets-submenus nil
  "An association list with filesets menu data.")
(defvar filesets-updated-buffers nil
  "A list of buffers with updated menu bars.")
(defvar filesets-menu-use-cached-flag nil
114
  "Use cached data.  See `filesets-menu-ensure-use-cached' for details.")
115 116 117
(defvar filesets-update-cache-file-flag nil
  "Non-nil means the cache needs updating.")
(defvar filesets-ignore-next-set-default nil
118
  "List of custom variables for which the next `set-default' will be ignored.")
119 120 121 122 123 124

(defvar filesets-output-buffer-flag nil
  "Non-nil means the current buffer is an output buffer created by filesets.
Is buffer local variable.")

(defvar filesets-verbosity 1
125 126
  "An integer defining the level of verbosity.
0 means no messages at all.")
127 128

(defvar filesets-menu-ensure-use-cached
129
  (and (featurep 'xemacs)
130 131
       (if (fboundp 'emacs-version>=)
	   (not (emacs-version>= 21 5))))
132 133 134 135 136 137 138 139 140 141 142 143
  "Make sure (X)Emacs uses filesets' cache.

Well, if you use XEmacs (prior to 21.5?) custom.el is loaded after
init.el.  This means that settings saved in the cache file (see
`filesets-menu-cache-file') will be overwritten by custom.el.  In order
to ensure the use of the cache file, set this variable to t -- which is
the default for XEmacs prior to 21.5.  If you want to change this value
put \"(setq filesets-menu-ensure-use-cached VALUE)\" into your startup
file -- before loading filesets.el.

So, when should you think about setting this value to t? If filesets.el
is loaded before user customizations.  Thus, if (require 'filesets)
144 145
precedes the `custom-set-variables' command or, for XEmacs, if init.el
is loaded before custom.el, set this variable to t.")
146 147 148 149 150 151


;;; utils
(defun filesets-filter-list (lst cond-fn)
  "Remove all elements not conforming to COND-FN from list LST.
COND-FN takes one argument: the current element."
152
;  (cl-remove 'dummy lst :test (lambda (dummy elt)
153 154 155 156 157 158
;			      (not (funcall cond-fn elt)))))
  (let ((rv nil))
    (dolist (elt lst rv)
      (when (funcall cond-fn elt)
	(setq rv (append rv (list elt)))))))

159
(defun filesets-ormap (fsom-pred lst)
160
  "Return the tail of LST for the head of which FSOM-PRED is non-nil."
161 162 163 164 165 166 167 168 169 170
  (let ((fsom-lst lst)
	(fsom-rv nil))
    (while (and (not (null fsom-lst))
		(null fsom-rv))
      (if (funcall fsom-pred (car fsom-lst))
	  (setq fsom-rv fsom-lst)
	(setq fsom-lst (cdr fsom-lst))))
    fsom-rv))

(defun filesets-some (fss-pred fss-lst)
171
  "Return non-nil if FSS-PRED is non-nil for any element of FSS-LST.
172 173 174 175 176 177
Like `some', return the first value of FSS-PRED that is non-nil."
  (catch 'exit
    (dolist (fss-this fss-lst nil)
      (let ((fss-rv (funcall fss-pred fss-this)))
	(when fss-rv
	  (throw 'exit fss-rv))))))
178
;(fset 'filesets-some 'cl-some) ;; or use the cl function
179 180 181

(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
  "Find the first occurrence of FSM-ITEM in FSM-LST.
182
It is supposed to work like cl's `member*'.  At the moment only the :test
183 184 185 186
key is supported."
  (let ((fsm-test (or (plist-get fsm-keys ':test)
		      (function equal))))
    (filesets-ormap (lambda (fsm-this)
187
		      (funcall fsm-test fsm-item fsm-this))
188
		    fsm-lst)))
189
;(fset 'filesets-member 'cl-member) ;; or use the cl function
190

191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
(defun filesets-sublist (lst beg &optional end)
  "Get the sublist of LST from BEG to END - 1."
  (let ((rv  nil)
	(i   beg)
	(top (or end
		 (length lst))))
    (while (< i top)
      (setq rv (append rv (list (nth i lst))))
      (setq i (+ i 1)))
    rv))

(defun filesets-select-command (cmd-list)
  "Select one command from CMD-LIST -- a string with space separated names."
  (let ((this (shell-command-to-string
	       (format "which --skip-alias %s 2> /dev/null | head -n 1"
		       cmd-list))))
207
    (if (equal this "")
208 209 210 211
	nil
      (file-name-nondirectory (substring this 0 (- (length this) 1))))))

(defun filesets-which-command (cmd)
212
  "Call \"which CMD\"."
213 214 215
  (shell-command-to-string (format "which %s" cmd)))

(defun filesets-which-command-p (cmd)
216
  "Call \"which CMD\" and return non-nil if the command was found."
217 218
  (when (string-match-p (format "\\(/[^/]+\\)?/%s" cmd)
			(filesets-which-command cmd))
219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
    cmd))

(defun filesets-message (level &rest args)
  "Show a message only if LEVEL is greater or equal then `filesets-verbosity'."
  (when (<= level (abs filesets-verbosity))
    (apply 'message args)))


;;; config file
(defun filesets-save-config ()
  "Save filesets' customizations."
  (interactive)
  (customize-save-customized))

(defun filesets-reset-fileset (&optional fileset no-cache)
  "Reset the cached values for one or all filesets."
  (if fileset
      (setq filesets-submenus (lax-plist-put filesets-submenus fileset nil))
    (setq filesets-submenus nil))
  (setq filesets-has-changed-flag t)
  (setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
					    (not no-cache))))

(defun filesets-set-config (fileset var val)
  "Set-default wrapper function."
  (filesets-reset-fileset fileset)
  (set-default var val))
;  (customize-set-variable var val))
;  (filesets-build-menu))

249
;; It seems this is a workaround for the XEmacs issue described in the
250
;; doc-string of filesets-menu-ensure-use-cached.  Under Emacs this is
251
;; essentially just `set-default'.
252
(defun filesets-set-default (sym val &optional init-flag)
253 254 255 256 257
  "Set-default wrapper function used in conjunction with `defcustom'.
If SYM is in the list `filesets-ignore-next-set-default', delete
it from that list, and return nil.  Otherwise, set the value of
SYM to VAL and return t.  If INIT-FLAG is non-nil, set with
`custom-initialize-set', otherwise with `set-default'."
258 259 260 261 262 263 264 265 266 267
  (let ((ignore-flag (member sym filesets-ignore-next-set-default)))
    (if ignore-flag
	(setq filesets-ignore-next-set-default
	      (delete sym filesets-ignore-next-set-default))
      (if init-flag
	  (custom-initialize-set sym val)
	(set-default sym val)))
    (not ignore-flag)))

(defun filesets-set-default! (sym val)
Paul Eggert's avatar
Paul Eggert committed
268
  "Call `filesets-set-default' and reset cached data (i.e. rebuild menu)."
269 270 271 272
  (when (filesets-set-default sym val)
    (filesets-reset-fileset)))

(defun filesets-set-default+ (sym val)
Paul Eggert's avatar
Paul Eggert committed
273
  "Call `filesets-set-default' and reset filesets' standard menu."
274 275 276 277
  (when (filesets-set-default sym val)
    (setq filesets-has-changed-flag t)))
;    (filesets-reset-fileset nil t)))

278 279
(defvar filesets-data)

280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295
(defun filesets-data-set-default (sym val)
  "Set the default for `filesets-data'."
  (if filesets-menu-use-cached-flag
      (setq filesets-menu-use-cached-flag nil)
    (when (default-boundp 'filesets-data)
      (let ((modified-filesets
	     (filesets-filter-list val
				   (lambda (x)
				     (let ((name (car x))
					   (data (cdr x)))
				       (let ((elt (assoc name filesets-data)))
					 (or (not elt)
					     (not (equal data (cdr elt))))))))))
	(dolist (x modified-filesets)
	  (filesets-reset-fileset (car x))))))
  (filesets-set-default sym val))
296

297 298 299 300
;;; configuration
(defgroup filesets nil
  "The fileset swapper."
  :prefix "filesets-"
301
  :group 'convenience
302
  :version "22.1")
303 304

(defcustom filesets-menu-name "Filesets"
305
  "Filesets' menu name."
306
  :set (function filesets-set-default)
Glenn Morris's avatar
Glenn Morris committed
307
  :type 'string
308 309
  :group 'filesets)

Glenn Morris's avatar
Glenn Morris committed
310
(defcustom filesets-menu-path '("File")	; cf recentf-menu-path
311
  "The menu under which the filesets menu should be inserted.
Glenn Morris's avatar
Glenn Morris committed
312 313
See `add-submenu' for documentation."
  :set (function filesets-set-default)
Glenn Morris's avatar
Glenn Morris committed
314 315 316
  :type '(choice (const :tag "Top Level" nil)
		 (sexp :tag "Menu Path"))
  :version "23.1"			; was nil
Glenn Morris's avatar
Glenn Morris committed
317 318
  :group 'filesets)

Glenn Morris's avatar
Glenn Morris committed
319
(defcustom filesets-menu-before "Open File..." ; cf recentf-menu-before
320
  "The name of a menu before which this menu should be added.
Glenn Morris's avatar
Glenn Morris committed
321 322
See `add-submenu' for documentation."
  :set (function filesets-set-default)
Glenn Morris's avatar
Glenn Morris committed
323 324 325
  :type '(choice (string :tag "Name")
                 (const :tag "Last" nil))
  :version "23.1"			; was "File"
Glenn Morris's avatar
Glenn Morris committed
326 327 328
  :group 'filesets)

(defcustom filesets-menu-in-menu nil
329
  "Use that instead of `current-menubar' as the menu to change.
Glenn Morris's avatar
Glenn Morris committed
330 331 332 333
See `add-submenu' for documentation."
  :set (function filesets-set-default)
  :type 'sexp
  :group 'filesets)
334 335

(defcustom filesets-menu-shortcuts-flag t
336
  "Non-nil means to prepend menus with hopefully unique shortcuts."
337 338 339 340 341
  :set (function filesets-set-default!)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-menu-shortcuts-marker "%_"
342
  "String for marking menu shortcuts."
343 344 345 346
  :set (function filesets-set-default!)
  :type 'string
  :group 'filesets)

347
;;(defcustom filesets-menu-cnvfp-flag nil
Glenn Morris's avatar
Glenn Morris committed
348
;;  "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus."
349 350 351
;;  :set (function filesets-set-default!)
;;  :type 'boolean
;;  :group 'filesets)
352 353

(defcustom filesets-menu-cache-file
354
  (locate-user-emacs-file "filesets-cache.el")
355
  "File to be used for saving the filesets menu between sessions.
356
Set this to \"\", to disable caching of menus.
357 358 359 360
Don't forget to check out `filesets-menu-ensure-use-cached'."
  :set (function filesets-set-default)
  :type 'file
  :group 'filesets)
361
(put 'filesets-menu-cache-file 'risky-local-variable t)
362 363 364 365

(defcustom filesets-menu-cache-contents
  '(filesets-be-docile-flag
    filesets-submenus
366
    filesets-menu-cache
367
    filesets-ingroup-cache)
368
  "Stuff we want to save in `filesets-menu-cache-file'.
369 370 371 372 373

Possible uses: don't save configuration data in the main startup files
but in filesets's own cache.  In this case add `filesets-data' to this
list.

374
There is a second reason for putting `filesets-data' on this list.  If
375 376
you frequently add and remove buffers on the fly to :files filesets, you
don't need to save your customizations if `filesets-data' is being
377
mirrored in the cache file.  In this case the version in the cache file
378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405
is the current one, and the version in your startup file will be
silently updated later on.

If you want caching to work properly, at least `filesets-submenus',
`filesets-menu-cache', and `filesets-ingroup-cache' should be in this
list.

Don't forget to check out `filesets-menu-ensure-use-cached'."
  :set (function filesets-set-default)
  :type '(repeat
	  (choice :tag "Variable"
		  (const :tag "filesets-submenus"
			 :value filesets-submenus)
		  (const :tag "filesets-menu-cache"
			 :value filesets-menu-cache)
		  (const :tag "filesets-ingroup-cache"
			 :value filesets-ingroup-cache)
		  (const :tag "filesets-data"
			 :value filesets-data)
		  (const :tag "filesets-external-viewers"
			 :value filesets-external-viewers)
		  (const :tag "filesets-ingroup-patterns"
			 :value filesets-ingroup-patterns)
		  (const :tag "filesets-be-docile-flag"
			 :value filesets-be-docile-flag)
		  (sexp :tag "Other" :value nil)))
  :group 'filesets)

Stefan Monnier's avatar
Stefan Monnier committed
406 407 408 409
(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks
  'filesets-cache-fill-content-hook "24.3")
(defcustom filesets-cache-fill-content-hook nil
  "Hook run when writing the contents of filesets' cache file.
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430

The hook is called with the cache file as current buffer and the cursor
at the last position.  I.e. each hook has to make sure that the cursor is
at the last position.

Possible uses: If you don't want to save `filesets-data' in your normal
configuration file, you can add a something like this

	\(lambda ()
	      \(insert (format \"(setq-default filesets-data '%S)\"
			      filesets-data))
	      \(newline 2))

to this hook.

Don't forget to check out `filesets-menu-ensure-use-cached'."
  :set (function filesets-set-default)
  :type 'hook
  :group 'filesets)

(defcustom filesets-cache-hostname-flag nil
431
  "Non-nil means cache the hostname.
432 433
If the current name differs from the cached one,
rebuild the menu and create a new cache file."
434 435 436 437 438
  :set (function filesets-set-default)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-cache-save-often-flag nil
439
  "Non-nil means save buffer on every change of the filesets menu.
440
If this variable is set to nil and if Emacs crashes, the cache and
441
filesets-data could get out of sync.  Set this to t if this happens from
442 443 444 445 446 447
time to time or if the fileset cache causes troubles."
  :set (function filesets-set-default)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-max-submenu-length 25
448
  "Maximum length of submenus.
449 450 451 452 453 454 455
Set this value to 0 to turn menu splitting off.  BTW, parts of submenus
will not be rewrapped if their length exceeds this value."
  :set (function filesets-set-default)
  :type 'integer
  :group 'filesets)

(defcustom filesets-max-entry-length 50
Paul Eggert's avatar
Paul Eggert committed
456
  "Truncate names of split submenus to this length."
457 458 459 460
  :set (function filesets-set-default)
  :type 'integer
  :group 'filesets)

461
(defcustom filesets-browse-dir-function 'dired
462
  "A function or command used for browsing directories.
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478
When using an external command, \"%s\" will be replaced with the
directory's name.

Note: You have to manually rebuild the menu if you change this value."
  :set (function filesets-set-default)
  :type '(choice :tag "Function:"
		 (const :tag "dired"
			:value dired)
		 (list :tag "Command"
		       :value ("" "%s")
		       (string :tag "Name")
		       (string :tag "Arguments"))
		 (function :tag "Function"
			   :value nil))
  :group 'filesets)

479
(defcustom filesets-open-file-function 'filesets-find-or-display-file
480
  "The function used for opening files.
481 482 483 484 485 486 487

`filesets-find-or-display-file' ... Filesets' default function for
visiting files.  This function checks if an external viewer is defined
for a specific file type.  Either this viewer, if defined, or
`find-file' will be used to visit a file.

`filesets-find-file' ... An alternative function that always uses
488
`find-file'.  If `filesets-be-docile-flag' is true, a file, which isn't
489 490 491 492 493 494 495 496 497 498 499 500 501
readable, will not be opened.

Caveat: Changes will take effect only after rebuilding the menu."
  :set (function filesets-set-default)
  :type '(choice :tag "Function:"
		 (const :tag "filesets-find-or-display-file"
			:value filesets-find-or-display-file)
		 (const :tag "filesets-find-file"
			:value filesets-find-file)
		 (function :tag "Function"
			   :value nil))
  :group 'filesets)

502
(defcustom filesets-save-buffer-function 'save-buffer
503
  "The function used to save a buffer.
504 505 506 507 508 509 510 511 512 513
Caveat: Changes will take effect after rebuilding the menu."
  :set (function filesets-set-default)
  :type '(choice :tag "Function:"
		 (const :tag "save-buffer"
			:value save-buffer)
		 (function :tag "Function"
			   :value nil))
  :group 'filesets)

(defcustom filesets-find-file-delay
514
  (if (and (featurep 'xemacs) gutter-buffers-tab-visible-p)
515 516
      0.5
    0)
517
  "Delay before calling `find-file'.
518 519 520
This is for calls via `filesets-find-or-display-file'
or `filesets-find-file'.

521
Set this to 0, if you don't use XEmacs's buffer tabs."
522 523 524 525 526
  :set (function filesets-set-default)
  :type 'number
  :group 'filesets)

(defcustom filesets-be-docile-flag nil
527
  "Non-nil means don't complain if a file or a directory doesn't exist.
528 529 530 531 532 533 534
This is useful if you want to use the same startup files in different
computer environments."
  :set (function filesets-set-default)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-sort-menu-flag t
535
  "Non-nil means sort the filesets menu alphabetically."
536 537 538 539 540
  :set (function filesets-set-default)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-sort-case-sensitive-flag t
541
  "Non-nil means sorting of the filesets menu is case sensitive."
542 543 544 545 546
  :set (function filesets-set-default)
  :type 'boolean
  :group 'filesets)

(defcustom filesets-tree-max-level 3
547
  "Maximum scan depth for directory trees.
548
A :tree fileset is defined by a base directory the contents of which
549
will be recursively added to the menu.  `filesets-tree-max-level' tells up
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
to which level the directory structure should be scanned/listed,
i.e. how deep the menu should be.  Try something like

	\(\"HOME -- only one level\"
	 \(:tree \"~\" \"^[^.].*[^~]$\")
	 \(:tree-max-level 1)
	 \(:filter-dirs-flag t))
	\(\"HOME -- up to 3 levels\"
	 \(:tree \"~\" \"^[^.].*[^~]$\")
	 \(:tree-max-level 3)
	 \(:filter-dirs-flag t))

and it should become clear what this option is about.  In any case,
including directory trees to the menu can take a lot of memory."
  :set (function filesets-set-default)
  :type 'integer
  :group 'filesets)

(defcustom filesets-commands
569 570 571 572 573 574 575 576
  `(("Isearch"
     multi-isearch-files
     (filesets-cmd-isearch-getargs))
    ("Isearch (regexp)"
     multi-isearch-files-regexp
     (filesets-cmd-isearch-getargs))
    ("Query Replace"
     perform-replace
577 578
     (filesets-cmd-query-replace-getargs))
    ("Query Replace (regexp)"
579 580
     perform-replace
     (filesets-cmd-query-replace-regexp-getargs))
581 582 583 584 585 586
    ("Grep <<selection>>"
     "grep"
     ("-n " filesets-get-quoted-selection " " "<<file-name>>"))
    ("Run Shell Command"
     filesets-cmd-shell-command
     (filesets-cmd-shell-command-getargs)))
587
  "Commands to run on filesets.
588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610
An association list of names, functions, and an argument list (or a
function that returns one) to be run on a filesets' files.

The argument <file-name> or <<file-name>> (quoted) will be replaced with
the filename."
  :set (function filesets-set-default+)
  :type '(repeat :tag "Commands"
		 (list :tag "Definition" :value ("")
		       (string "Name")
		       (choice :tag "Command"
			       (string :tag "String")
			       (function :tag "Function"))
		       (repeat :tag "Argument List"
			       (choice :tag "Arguments"
				       (sexp :tag "Sexp"
					     :value nil)
				       (string :tag "File Name"
					       :value "<file-name>")
				       (string :tag "Quoted File Name"
					       :value "<<file-name>>")
				       (function :tag "Function"
						 :value nil)))))
  :group 'filesets)
611
(put 'filesets-commands 'risky-local-variable t)
612 613 614

(defcustom filesets-external-viewers
  (let
615 616 617 618 619 620 621 622 623 624
      ;; ((ps-cmd  (or (and (boundp 'my-ps-viewer) my-ps-viewer)
      ;;    	    (filesets-select-command "ggv gv")))
      ;;  (pdf-cmd (or (and (boundp 'my-ps-viewer) my-pdf-viewer)
      ;;    	    (filesets-select-command "xpdf acroread")))
      ;;  (dvi-cmd (or (and (boundp 'my-ps-viewer) my-dvi-viewer)
      ;;    	    (filesets-select-command "xdvi tkdvi")))
      ;;  (doc-cmd (or (and (boundp 'my-ps-viewer) my-doc-viewer)
      ;;    	    (filesets-select-command "antiword")))
      ;;  (pic-cmd (or (and (boundp 'my-ps-viewer) my-pic-viewer)
      ;;    	    (filesets-select-command "gqview ee display"))))
625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651
      ((ps-cmd  "ggv")
       (pdf-cmd "xpdf")
       (dvi-cmd "xdvi")
       (doc-cmd "antiword")
       (pic-cmd "gqview"))
    `(("^.+\\..?html?$" browse-url
       ((:ignore-on-open-all t)))
      ("^.+\\.pdf$" ,pdf-cmd
       ((:ignore-on-open-all t)
	(:ignore-on-read-text t)
	(:constraint-flag ,pdf-cmd)))
      ("^.+\\.e?ps\\(.gz\\)?$" ,ps-cmd
       ((:ignore-on-open-all t)
	(:ignore-on-read-text t)
	(:constraint-flag ,ps-cmd)))
      ("^.+\\.dvi$" ,dvi-cmd
       ((:ignore-on-open-all t)
	(:ignore-on-read-text t)
	(:constraint-flag ,dvi-cmd)))
      ("^.+\\.doc$" ,doc-cmd
       ((:capture-output t)
	(:ignore-on-read-text t)
	(:constraint-flag ,doc-cmd)))
      ("^.+\\.\\(tiff\\|xpm\\|gif\\|pgn\\)$" ,pic-cmd
       ((:ignore-on-open-all t)
	(:ignore-on-read-text t)
	(:constraint-flag ,pic-cmd)))))
652
  "Association list of file patterns and external viewers for use with
653 654 655 656 657
`filesets-find-or-display-file'.

Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a
function or a command name as string.

658 659
Properties is an association list determining filesets' behavior in
several conditions.  Choose one from this list:
660 661 662 663 664 665 666 667

:ignore-on-open-all ... Don't open files of this type automatically --
i.e. on open-all-files-events or when running commands

:capture-output ... capture an external viewer output

:constraintp FUNCTION ... use this viewer only if FUNCTION returns non-nil

668
:constraint-flag SEXP ... use this viewer only if SEXP evaluates to non-nil
669 670 671 672 673 674 675 676 677 678 679 680 681

:open-hook HOOK ... run hooks after spawning the viewer -- mainly useful
in conjunction with :capture-output

:args (FORMAT-STRING or SYMBOL or FUNCTION) ... a list of arguments
\(defaults to (list \"%S\")) when using shell commands

Avoid modifying this variable and achieve minor speed-ups by setting the
variables my-ps-viewer, my-pdf-viewer, my-dvi-viewer, my-pic-viewer.

In order to view pdf or rtf files in an Emacs buffer, you could use these:


682
      \(\"^.+\\\\.pdf\\\\'\" \"pdftotext\"
683 684 685 686 687 688
       \((:capture-output t)
	\(:args (\"%S - | fmt -w \" window-width))
	\(:ignore-on-read-text t)
	\(:constraintp (lambda ()
			\(and \(filesets-which-command-p \"pdftotext\")
			     \(filesets-which-command-p \"fmt\"))))))
689
      \(\"^.+\\\\.rtf\\\\'\" \"rtf2htm\"
690 691 692 693 694
       \((:capture-output t)
	\(:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
	\(:ignore-on-read-text t)
	\(:constraintp (lambda ()
			\(and (filesets-which-command-p \"rtf2htm\")
695
			     \(filesets-which-command-p \"w3m\"))))))"
696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714
  :set (function filesets-set-default)
  :type '(repeat :tag "Viewer"
		 (list :tag "Definition"
		       :value ("^.+\\.suffix$" "")
		       (regexp :tag "Pattern")
		       (choice :tag "Viewer"
			       (symbol :tag "Function" :value nil)
			       (string :tag "Program" :value ""))
		       (repeat :tag "Properties"
			       (choice
				(list :tag ":constraintp"
				      :value (:constraintp)
				      (const :format ""
					     :value :constraintp)
				      (function :tag "Function"))
				(list :tag ":constraint-flag"
				      :value (:constraint-flag)
				      (const :format ""
					     :value :constraint-flag)
715
				      (sexp :tag "Symbol"))
716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753
				(list :tag ":ignore-on-open-all"
				      :value (:ignore-on-open-all t)
				      (const  :format ""
					      :value :ignore-on-open-all)
				      (boolean :tag "Boolean"))
				(list :tag ":ignore-on-read-text"
				      :value (:ignore-on-read-text t)
				      (const  :format ""
					      :value :ignore-on-read-text)
				      (boolean :tag "Boolean"))
				(list :tag ":args"
				      :value (:args)
				      (const :format ""
					     :value :args)
				      (repeat :tag "List"
					      (choice :tag "Arguments"
						      (string :tag "String"
							      :value "")
						      (symbol :tag "Symbol"
							      :value nil)
						      (function :tag "Function"
								:value nil))))
				(list :tag ":open-hook"
				      :value (:open-hook)
				      (const :format ""
					     :value :open-hook)
				      (hook :tag "Hook"))
;				(list :tag ":close-hook"
;				      :value (:close-hook)
;				      (const :format ""
;					     :value :close-hook)
;				      (hook :tag "Hook"))
				(list :tag ":capture-output"
				      :value (:capture-output t)
				      (const  :format ""
					      :value :capture-output)
				      (boolean :tag "Boolean"))))))
  :group 'filesets)
754
(put 'filesets-external-viewers 'risky-local-variable t)
755 756 757 758 759 760 761 762 763 764

(defcustom filesets-ingroup-patterns
  '(("^.+\\.tex$" t
     (((:name "Package")
       (:pattern "\\\\usepackage\\W*\\(\\[[^\]]*\\]\\W*\\)?{\\W*\\(.+\\)\\W*}")
       (:match-number 2)
       (:stub-flag t)
       (:get-file-name (lambda (master file)
			 (filesets-which-file master
					      (concat file ".sty")
765
					      (filesets-convert-path-list
766 767 768 769 770 771 772
					       (or (getenv "MY_TEXINPUTS")
						   (getenv "TEXINPUTS")))))))
      ((:name "Include")
       (:pattern "\\\\include\\W*{\\W*\\(.+\\)\\W*}")
       (:get-file-name (lambda (master file)
			 (filesets-which-file master
					      (concat file ".tex")
773
					      (filesets-convert-path-list
774 775 776 777 778 779 780 781 782
					       (or (getenv "MY_TEXINPUTS")
						   (getenv "TEXINPUTS"))))))
       (:scan-depth 5))
      ((:name "Input")
       (:pattern "\\\\input\\W*{\\W*\\(.+\\)\\W*}")
       (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
       (:get-file-name (lambda (master file)
			 (filesets-which-file master
					      (concat file ".tex")
783
					      (filesets-convert-path-list
784 785 786 787 788 789 790 791
					       (or (getenv "MY_TEXINPUTS")
						   (getenv "TEXINPUTS"))))))
       (:scan-depth 5))
      ((:name "Bibliography")
       (:pattern "\\\\bibliography\\W*{\\W*\\(.+\\)\\W*}")
       (:get-file-name (lambda (master file)
			 (filesets-which-file master
					      (concat file ".bib")
792
					      (filesets-convert-path-list
793 794 795 796 797 798 799 800 801 802 803 804 805 806 807
					       (or (getenv "MY_BIBINPUTS")
						   (getenv "BIBINPUTS")))))))))
    ("^.+\\.el$" t
     (((:name "Require")
       (:pattern "(require\\W+'\\(.+\\))")
       (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
       (:get-file-name (lambda (master file)
			 (filesets-which-file master
					      (concat file ".el")
					      load-path))))
      ((:name "Load")
       (:pattern "(load\\(-library\\)?\\W+\"\\(.+\\)\")")
       (:match-number 2)
       (:get-file-name (lambda (master file)
			 (filesets-which-file master file load-path))))))
808 809
    ("^\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)$" t
     (((:pattern "\\<\\([A-ZÄÖÜ][a-zäöüß]+\\([A-ZÄÖÜ][a-zäöüß]+\\)+\\)\\>")
810 811 812 813 814 815 816 817 818 819 820
       (:scan-depth 5)
       (:stubp (lambda (a b) (not (filesets-files-in-same-directory-p a b))))
       (:case-sensitive t)
       (:get-file-name (lambda (master file)
			 (filesets-which-file
			  master
			  file
			  (if (boundp 'emacs-wiki-directories)
			      emacs-wiki-directories
			    nil))))))))

821
  "Inclusion group definitions.
822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850

Define how to find included file according to a file's mode (being
defined by a file pattern).

A valid entry has the form (FILE-PATTERN REMOVE-DUPLICATES-FLAG
CMD-DEF1 ...), CMD-DEF1 being a plist containing the fields :pattern
\(mandatory), :name, :get-file-name, :match-number, :scan-depth,
:preprocess, :case-sensitive.

File Pattern ... A regexp matching the file's name for which the
following rules should be applied.

Remove Duplicates ... If t, only the first occurrence of an included
file is retained.  (See below for a full explanation.)

:name STRING ... This pattern's name.

:pattern REGEXP ... A regexp matching the command.  This regexp has to
include a group that holds the name of the included file.

:get-file-name FUNCTION (default: `filesets-which-file') ... A function
that takes two arguments (the path of the master file and the name
of the included file) and returns a valid path or nil -- if the
subfile can't be found.

:match-number INTEGER (default: 1) ... The number of the match/group
in the pattern holding the subfile's name.  0 refers the whole
match, 1 to the first group.

851
:stubp FUNCTION ... If (FUNCTION MASTER INCLUDED-FILE) returns non-nil,
852 853
INCLUDED-FILE is a stub -- see below.

854
:stub-flag ... Files of this type are stubs -- see below.
855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871

:scan-depth INTEGER (default: 0) ... Whether included files should be
rescanned.  Set this to 0 to disable re-scanning of included file.

:preprocess FUNCTION ... A function modifying a buffer holding the
master file so that pattern matching becomes easier.  This is usually
used to narrow a buffer to the relevant region.  This function could also
be destructive and simply delete non-relevant text.

:case-sensitive BOOLEAN (default: nil) ... Whether a pattern is
case-sensitive or not.


Stubs:

First, a stub is a file that shows up in the menu but will not be
included in an ingroup's file listing -- i.e. filesets will never
872 873
operate on this file automatically.  Secondly, in opposition to normal
files stubs are not scanned for new inclusion groups.  This is useful if
874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941
you want to have quick access to library headers.

In the menu, an asterisk is appended to the stub's name.


Remove Duplicates:

E.g. File A and file B refer to file X; X refers to A.  If
you choose not to remove duplicates the tree would look like:

    M + A - X - A ...
        B - X - A ...

As you can see, there is some chance that you run in circles.
Nevertheless, up to some degree this could still be what you want.

With duplicates removed, it would be:

    M + A - X
        B"
  :set (function filesets-set-default)
  :type '(repeat
	  :tag "Include"
	  (list
	   :tag "Definition" :value ("^.+\\.suffix$" t)
	   (regexp :tag "File Pattern" :value "^.+\\.suffix$")
	   (boolean :tag "Remove Duplicates" :value t)
	   (repeat :tag "Commands"
		   (repeat :tag "Command"
			   (choice
			    :tag "Definition"
			    (list :tag ":name"
				  :value (:name "")
				  (const :format "" :value :name)
				  (string :tag "String"))
			    (list :tag ":pattern"
				  :value (:pattern "\\<CMD\\W*\\(.+\\)\\>")
				  (const :format "" :value :pattern)
				  (regexp :tag "RegExp"))
			    (list :tag ":get-file-name"
				  :value (:get-file-name)
				  (const :format "" :value :get-file-name)
				  (function :tag "Function"))
			    (list :tag ":match-number"
				  :value (:match-number 1)
				  (const :format "" :value :match-number)
				  (integer :tag "Integer"))
			    (list :tag ":stub-flag"
				  :value (:stub-flag t)
				  (const :format "" :value :stub-flag)
				  (boolean :tag "Boolean"))
			    (list :tag ":stubp"
				  :value (:stubp)
				  (const :format "" :value :stubp)
				  (function :tag "Function"))
			    (list :tag ":scan-depth"
				  :value (:scan-depth 0)
				  (const :format "" :value :scan-depth)
				  (integer :tag "Integer"))
			    (list :tag ":case-sensitive"
				  :value (:case-sensitive)
				  (const :format "" :value :case-sensitive)
				  (boolean :tag "Boolean"))
			    (list :tag ":preprocess"
				  :value (:preprocess)
				  (const :format "" :value :preprocess)
				  (function :tag "Function")))))))
  :group 'filesets)
942
(put 'filesets-ingroup-patterns 'risky-local-variable t)
943

944 945
(defcustom filesets-data nil
  "Fileset definitions.
946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975

A fileset is either a list of files, a file pattern, a base directory
and a search pattern (for files), or a base file.  Changes to this
variable will take effect after rebuilding the menu.

Caveat: Fileset names have to be unique.

Example definition:
      '\(\(\"My Wiki\"
	 \(:ingroup \"~/Etc/My-Wiki/WikiContents\"))
	\(\"My Homepage\"
	 \(:pattern \"~/public_html/\" \"^.+\\\\.html$\")
	 \(:open filesets-find-file))
	\(\"User Configuration\"
	 \(:files \"~/.xinitrc\"
		 \"~/.bashrc\"
		 \"~/.bash_profile\"))
	\(\"HOME\"
	 \(:tree \"~\" \"^[^.].*[^~]$\")
	 \(:filter-dirs-flag t)))

`filesets-data' is a list of (NAME-AS-STRING . DEFINITION), DEFINITION
being an association list with the fields:

:files FILE-1 .. FILE-N ... a list of files belonging to a fileset

:ingroup FILE-NAME ... an inclusion group's base file.

:tree ROOT-DIR PATTERN ... a base directory and a file pattern

Chong Yidong's avatar
Chong Yidong committed
976 977 978 979 980
:pattern DIR PATTERN ... a base directory and a regexp matching
                         files in that directory.  Usually,
                         PATTERN has the form '^REGEXP$'.  Unlike
                         :tree, this form does not descend
                         recursively into subdirectories.
981 982 983 984

:filter-dirs-flag BOOLEAN ... is only used in conjunction with :tree.

:tree-max-level INTEGER ... recurse into directories this many levels
Pavel Janík's avatar
Pavel Janík committed
985
\(see `filesets-tree-max-level' for a full explanation)
986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006

:dormant-flag BOOLEAN ... non-nil means don't show this item in the
menu; dormant filesets can still be manipulated via commands available
from the minibuffer -- e.g. `filesets-open', `filesets-close', or
`filesets-run-cmd'

:dormant-p FUNCTION ... a function returning :dormant-flag

:open FUNCTION ... the function used to open file belonging to this
fileset.  The function takes a file name as argument

:save FUNCTION ... the function used to save file belonging to this
fileset; it takes no arguments, but works on the current buffer.

Either :files, :pattern, :tree, or :ingroup must be supplied.  :files
overrules :tree, :tree overrules :pattern, :pattern overrules :ingroup,
i.e. these tags are mutually exclusive.  The fields :open and :save are
optional.

In conjunction with the :tree tag, :save is void.  :open refers to the
function used for opening files in a directory, not for opening the
1007
directory.  For browsing directories, `filesets-browse-dir-function' is used.
1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068

Before using :ingroup, make sure that the file type is already
defined in `filesets-ingroup-patterns'."
  :group 'filesets
  :set (function filesets-data-set-default)
  :type '(repeat
	  (cons :tag "Fileset"
		(string :tag "Name" :value "")
		(repeat :tag "Data"
			(choice
			 :tag "Type" :value nil
			 (list :tag "Pattern"
			       :value (:pattern "~/"  "^.+\\.suffix$")
			       (const :format "" :value :pattern)
			       (directory :tag "Dir")
			       (regexp :tag "Pattern"))
			 (cons :tag "Files"
			       :value (:files)
			       (const :format "" :value :files)
			       (repeat :tag "Files" file))
			 (list :tag "Single File"
			       :value (:file "~/")
			       (const :format "" :value :file)
			       (file :tag "File"))
			 (list :tag "Inclusion group"
			       :value (:ingroup "~/")
			       (const :format "" :value :ingroup)
			       (file :tag "File" :value "~/"))
			 (list :tag "Directory Tree"
			       :value (:tree "~/"  "^.+\\.suffix$")
			       (const :format "" :value :tree)
			       (directory :tag "Dir")
			       (regexp :tag "Pattern"))
			 (list :tag "Filter directories"
			       :value (:filter-dirs-flag)
			       (const :format "" :value :filter-dirs-flag)
			       (boolean :tag "Boolean" :value nil))
			 (list :tag "Scanning depth"
			       :value (:tree-max-level 3)
			       (const :format "" :value :tree-max-level)
			       (integer :tag "Integer"))
			 (list :tag "Verbosity"
			       :value (:verbosity 1)
			       (const :format "" :value :verbosity)
			       (integer :tag "Integer"))
			 (list :tag "Conceal fileset (Flag)"
			       :value (:dormant-flag)
			       (const :format "" :value :dormant-flag)
			       (boolean :tag "Boolean"))
			 (list :tag "Conceal fileset (Function)"
			       :value (:dormant-p)
			       (const :format "" :value :dormant-p)
			       (function :tag "Function"))
			 (list :tag "Save function"
			       :value (:save)
			       (const :format "" :value :save)
			       (function :tag "Function"))
			 (list :tag "Open function"
			       :value (:open)
			       (const :format "" :value :open)
			       (function :tag "Function")))))))
1069
(put 'filesets-data 'risky-local-variable t)
1070 1071 1072


(defcustom filesets-query-user-limit 15
1073
  "Query the user before opening a fileset with that many files."
1074 1075 1076
  :set (function filesets-set-default)
  :type 'integer
  :group 'filesets)
1077

1078 1079
;;; Emacs compatibility
(eval-and-compile
1080
  (if (featurep 'xemacs)
Glenn Morris's avatar
Glenn Morris committed
1081
      (fset 'filesets-error 'error)
1082

1083
    (require 'easymenu)
1084

1085
    (defun filesets-error (_class &rest args)
1086
      "`error' wrapper."
1087
      (error "%s" (mapconcat 'identity args " ")))
1088 1089

    ))
1090 1091

(defun filesets-filter-dir-names (lst &optional negative)
1092 1093
  "Remove non-directory names from a list of strings.
If NEGATIVE is non-nil, remove all directory names."
1094 1095
  (filesets-filter-list lst
			(lambda (x)
1096
			  (and (not (string-match-p "^\\.+/$" x))
1097
			       (if negative
1098 1099
				   (not (string-match-p "[:/\\]$" x))
				 (string-match-p "[:/\\]$" x))))))
1100

1101
(defun filesets-conditional-sort (lst &optional access-fn)
1102 1103 1104
  "Return a sorted copy of LST, LST being a list of strings.
If `filesets-sort-menu-flag' is nil, return LST itself.

1105
ACCESS-FN ... function to get the string value of LST's elements."
1106 1107 1108 1109 1110 1111 1112 1113 1114 1115
  (if filesets-sort-menu-flag
      (let* ((fni (or access-fn
		      (function identity)))
	     (fn (if filesets-sort-case-sensitive-flag
		     (lambda (a b)
		       (string< (funcall fni a)
				(funcall fni b)))
		   (lambda (a b)
		     (string< (upcase (funcall fni a))
			      (upcase (funcall fni b)))))))
1116
	(sort (copy-sequence lst) fn))
1117 1118 1119 1120
    lst))

(defun filesets-directory-files (dir &optional
				     pattern what full-flag match-dirs-flag)
1121 1122 1123 1124 1125
  "Get WHAT (:files or :dirs) in DIR.
If PATTERN is provided return only those entries matching this
regular expression.
If MATCH-DIRS-FLAG is non-nil, also match directory entries.
Return full path if FULL-FLAG is non-nil."
1126 1127 1128 1129 1130 1131
  (filesets-message 2 "Filesets: scanning %S" dir)
  (cond
   ((file-exists-p dir)
    (let ((files nil)
	  (dirs  nil))
      (dolist (this (file-name-all-completions "" dir))
1132
	(cond
1133
	 ((string-match-p "^\\.+/$" this)
1134
	  nil)
1135
	 ((string-match-p "[:/\\]$" this)
1136 1137
	  (when (or (not match-dirs-flag)
		    (not pattern)
1138
		    (string-match-p pattern this))
1139
	    (filesets-message 5 "Filesets: matched dir %S with pattern %S"
1140 1141 1142 1143
			      this pattern)
	    (setq dirs (cons this dirs))))
	 (t
	  (when (or (not pattern)
1144
		    (string-match-p pattern this))
1145
	    (filesets-message 5 "Filesets: matched file %S with pattern %S"
1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216
			      this pattern)
	    (setq files (cons (if full-flag
				  (concat (file-name-as-directory dir) this)
				this)
			      files))))))
      (cond
       ((equal what ':dirs)
	(filesets-conditional-sort dirs))
       ((equal what ':files)
	(filesets-conditional-sort files))
       (t
	(append (filesets-conditional-sort files)
		(filesets-conditional-sort dirs))))))
   (filesets-be-docile-flag
    (filesets-message 1 "Filesets: %S doesn't exist" dir)
    nil)
   (t
    (filesets-error 'error "Filesets: " dir " does not exist"))))

(defun filesets-quote (txt)
  "Return TXT in quotes."
  (concat "\"" txt "\""))

(defun filesets-get-selection ()
  "Get the text between mark and point -- i.e. the selection or region."
  (let ((m (mark))
	(p (point)))
    (if m
	(buffer-substring (min m p) (max m p))
      (filesets-error 'error "No selection."))))

(defun filesets-get-quoted-selection ()
  "Return the currently selected text in quotes."
  (filesets-quote (filesets-get-selection)))

(defun filesets-get-shortcut (n)
  "Create menu shortcuts based on number N."
  (let ((n (mod (- n 1) 51)))
    (cond
     ((not filesets-menu-shortcuts-flag)
      "")
     ((<= n 9)
      (concat (number-to-string n) " "))
     ((<= n 35)
      (format "%c " (+ 87 n)))
     ((<= n 51)
      (format "%c " (+ -3 n))))))

(defun filesets-files-equalp (a b)
  "Compare two filenames A and B after expansion."
  (equal (expand-file-name a) (expand-file-name b)))

(defun filesets-files-in-same-directory-p (a b)
  "Compare two filenames A and B after expansion."
  (let ((ad (file-name-directory (expand-file-name a)))
	(bd (file-name-directory (expand-file-name b))))
    (equal ad bd)))

(defun filesets-convert-path-list (string)
  "Return a path-list given as STRING as list."
  (if string
      (mapcar (lambda (x) (file-name-as-directory x))
	      (split-string string path-separator))
    nil))

(defun filesets-which-file (master filename &optional path-list)
  "Search for a FILENAME relative to a MASTER file in PATH-LIST."
  (let ((f (concat (file-name-directory master)
		   filename)))
    (if (file-exists-p f)
	f
1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228
      (filesets-some
       (lambda (dir)
	 (let ((dir (file-name-as-directory dir))
	       (files (if (file-exists-p dir)
			  (filesets-directory-files dir nil ':files)
			nil)))
	   (filesets-some (lambda (file)
			    (if (equal filename (file-name-nondirectory file))
				(concat dir file)
			      nil))
			  files)))
       path-list))))
1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249


(defun filesets-eviewer-get-props (entry)
  "Get ENTRY's (representing an external viewer) properties."
  (nth 2 entry))

(defun filesets-eviewer-constraint-p (entry)
  (let* ((props           (filesets-eviewer-get-props entry))
	 (constraint      (assoc ':constraintp props))
	 (constraint-flag (assoc ':constraint-flag props)))
    (cond
     (constraint
      (funcall (cadr constraint)))
     (constraint-flag
      (eval (cadr constraint-flag)))
     (t
      t))))

(defun filesets-get-external-viewer (file)
  "Find an external viewer for FILE."
  (let ((filename (file-name-nondirectory file)))
1250
    (filesets-some
1251
     (lambda (entry)
1252
       (when (and (string-match-p (nth 0 entry) filename)
1253 1254 1255 1256 1257 1258 1259
		  (filesets-eviewer-constraint-p entry))
	 entry))
     filesets-external-viewers)))

(defun filesets-get-external-viewer-by-name (name)
  "Get the external viewer definition called NAME."
  (when name
1260
    (filesets-some
1261 1262 1263 1264 1265 1266 1267
     (lambda (entry)
       (when (and (string-equal (nth 1 entry) name)
		  (filesets-eviewer-constraint-p entry))
	 entry))
     filesets-external-viewers)))

(defun filesets-filetype-property (filename event &optional entry)
1268
  "Return non-nil if a file of a specific type has special flags/tags.
1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279

Events (corresponding tag):

on-open-all (:ignore-on-open-all) ... Exclude files of this when opening
a fileset

on-grep (:ignore-on-read-text) ... Exclude files of this when running
the \"Grep <<selection>>\" command

on-capture-output (:capture-output) ... Capture output of an external viewer

1280
on-ls ... Not used
1281

1282
on-cmd ... Not used
1283

1284
on-close-all ... Not used"
1285 1286 1287 1288
  (let ((def (filesets-eviewer-get-props
	      (or entry
		  (filesets-get-external-viewer