lisp/filesets.el

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