lisp/filesets.el

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