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