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