lisp/filesets.el

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