lisp/filesets.el

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