lisp/filesets.el

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