lisp/filesets.el

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