fileset-whole.el

   1 ;;;_ fileset-whole.el --- Commands and data applying to filesets as a whole
   2
   3 ;;;_. Headers
   4 ;;;_ , License
   5 ;; Copyright (C) 2011  Tom Breton (Tehom)
   6
   7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
   8 ;; Keywords: convenience
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;;_ , Commentary:
  26
  27 ;;
  28
  29
  30 ;;;_ , Requires
  31
  32 (require 'filesets)
  33
  34 ;;;_. Body
  35 ;;;_ , Customizations
  36 ;;;_  . fileset-whole-alist
  37 (defcustom fileset-whole-alist
  38    '()
  39    "Alist associating fileset names to keyed data"
  40    :group 'filesets
  41    :type '(repeat
  42              (cons :tag "Fileset"
  43                 (string :tag "Name" :value "")
  44                 (repeat :tag "Data"
  45                    (list
  46                       symbol
  47                       sexp)))))
  48 (put 'fileset-whole-alist 'risky-local-variable t)
  49
  50 ;;;_  . fileset-whole-commands
  51 (defcustom fileset-whole-commands
  52    '(
  53        ("git"
  54           magit-status (default-directory))
  55        ("eshell"
  56           eshell nil)
  57        ("Build"
  58           fileset-whole-apply-compile
  59           ("make -C" default-directory))
  60        ("test"
  61           emt:fileset
  62           (fileset-name))
  63        ("retest"
  64           emt:fileset-all
  65           (fileset-name))
  66        ("find-file"
  67           (lambda (name)
  68              (find-file
  69                 (fileset-whole-pick-file name)))
  70           (fileset-name)))
  71
  72    "List of commands that apply to whole filesets.
  73
  74 Before the command is applied, each arg is evalled with the
  75 following bindings:
  76
  77   `fileset' - the fileset.
  78   `fileset-name' - the name of the fileset
  79   `fileset-whole' - other data associated with the fileset, if any.
  80   `default-directory' the root directory of the project, if any.
  81
  82 Then the command is applied to the list of args.
  83
  84 It is the user's resposibility to ensure that commands and
  85 functions called in arguments are available; consider using
  86 autoloads."
  87
  88    :group 'filesets
  89    ;;$$IMPROVE ME Add a hotkey and put it into some keymap
  90    ;;$$IMPROVE ME Add a field saying how to find the buffers it
  91    ;;creates, given its return value.
  92    :type '(repeat :tag "Commands"
  93              (list :tag "Definition" :value ("")
  94                 (string "Name")
  95                 (choice :tag "Command"
  96                    (function :tag "Function"))
  97                 (repeat :tag "Argument List"
  98                    (choice :tag "Arguments"
  99                       ;;$$IMPROVE ME List the bound symbols as options
 100                       (sexp :tag "Sexp"
 101                          :value nil))))))
 102
 103 (put 'fileset-whole-commands 'risky-local-variable t)
 104 ;;;_ , Variables
 105 ;;For now, we don't contemplate multiple filesets applying to one
 106 ;;buffer.  Could treat a list of them differently.
 107 (defvar fileset-whole-name-here nil
 108    "The fileset that contains this buffer, if any." )
 109 (make-variable-buffer-local 'fileset-whole-name-here)
 110 (put 'fileset-whole-name-here 'permanent-local t)
 111 (put 'fileset-whole-alist 'risky-local-variable nil)
 112 ;;;_ , Setting up menus
 113 ;;;_  . fileset-whole-setup-menu
 114 (defun fileset-whole-setup-menu ()
 115    "Add the commands in fileset-whole-commands to fileset menu."
 116    ;;When is this triggered?
 117    ;;And see `filesets-get-cmd-menu'.  Either add to it or add another
 118    ;;menu.
 119
 120    (easy-menu-add-item
 121       nil ;;Should this be `filesets-menu-in-menu'?
 122       (append filesets-menu-path (list filesets-menu-name "# Filesets"))
 123       ["Edit Filesets' Data" fileset-whole-edit]
 124       "Save Filesets"))
 125
 126 ;;;_  . fileset-whole-cmds-to-menu
 127 (defun fileset-whole-cmds-to-menu ()
 128   "Add fileset-whole commands to filesets command menu."
 129    (mapcar
 130       #'(lambda (this)
 131            (let
 132               ((name (car this)))
 133               (easy-menu-add-item
 134                  nil ;;Should this be `filesets-menu-in-menu'?
 135                  (append filesets-menu-path (list filesets-menu-name "+ Commands"))
 136                  `[,name (fileset-whole-run-cmd
 137                             ,name
 138                             (fileset-whole-read-fileset))])))
 139       fileset-whole-commands)
 140    t)
 141
 142 ;;;_  . fileset-whole-add-buffer
 143
 144 ;;Add a "created" buffer such as gdb, eshell, or magit make to the
 145 ;;menus, in a section paralleling the list of files.
 146
 147 ;;;_  . fileset-whole-setup-files
 148 ;;;###autoload
 149 (defun fileset-whole-setup-files ()
 150    "Run a hook in each currently open buffer that any fileset applies to."
 151    ;;$$WRITE ME
 152    ;;$$FACTOR ME Several parts: Running something in all relevant
 153    ;;buffers (parms: fileset-name).  The hook.  Running the hook this
 154    ;;way.
 155    ;;$$DESIGN ABOUT ME How and when to trigger this.  There are no
 156    ;;obvious hooks in fileset.
 157    (interactive)
 158    (let*
 159       ()
 160       ;;For each fileset
 161       ;;Get list of files
 162       ;;For each one that's already open, with that buffer current,
 163       ;;run hooks.  Default hook will just set `fileset-whole-name-here'.
 164       ))
 165 ;;;_  . fileset-whole-init
 166 ;;;###autoload
 167 (defun fileset-whole-init ()
 168    "Set up fileset-whole on top of filesets"
 169    (filesets-init)
 170    (fileset-whole-setup-menu)
 171    (fileset-whole-cmds-to-menu))
 172 ;;;_ , Structuring
 173 ;;;_  . fileset-whole-cmd->fn
 174 (defun fileset-whole-cmd->fn (cmd)
 175    "Return the function field of CMD"
 176    (nth 1 cmd))
 177 ;;;_  . fileset-whole-cmd->args
 178 (defun fileset-whole-cmd->args (cmd)
 179    "Return the args field of CMD"
 180    (nth 2 cmd))
 181 ;;;_  . fileset-whole-entry->alist
 182 (defun fileset-whole-entry->alist (entry)
 183    "Return the alist of ENTRY"
 184    (cdr entry))
 185 ;;;_  . fileset-whole-data-get
 186 (defun fileset-whole-data-get (entry key &optional default carp)
 187   "Extract the value for KEY in the data part of fileset ENTRY.
 188 Return DEFAULT if not found.  Return (car VALUE) if CARP is non-nil."
 189   (filesets-alist-get
 190      (fileset-whole-entry->alist entry) key default carp))
 191
 192 ;;;_ , Running commands
 193 ;;;_  . fileset-whole-read-cmd
 194 (defun fileset-whole-read-cmd ()
 195    "Interactively get the name of a fileset command.
 196 Either a whole command or a command on individual files."
 197
 198    (completing-read "Select command: "
 199       (append filesets-commands fileset-whole-commands)
 200       nil t))
 201 ;;;_  . fileset-whole-read-fileset
 202 (defun fileset-whole-read-fileset (&optional ask)
 203    "Interactively get the name of a fileset.
 204 Called interactively, it's useful for changing a buffer's default
 205    fileset"
 206    (interactive (list t))
 207    (or
 208       (unless ask fileset-whole-name-here)
 209       (let
 210          ((name
 211              (completing-read "Select fileset: "
 212                 filesets-data nil t
 213                 nil nil fileset-whole-name-here)))
 214          ;;Record it so we won't have to ask again wrt this buffer
 215          ;;(`fileset-whole-name-here' is buffer-local)
 216
 217          ;;$$IMPROVE ME Allow some way(s) to not set it:
 218          ;;User preference, and a buffer-local variable.
 219          (unless (eq name fileset-whole-name-here)
 220             (setq fileset-whole-name-here name))
 221          ;;$$IMPROVE ME If buffer is not associated with
 222          ;;any file, ask to add it (consult user preference)
 223          ;;`filesets-add-buffer'
 224          name)))
 225 ;;;_  . fileset-whole-set-fileset
 226 (defalias 'fileset-whole-set-fileset 'fileset-whole-read-fileset)
 227 ;;;_  . fileset-whole-get-dir
 228 (defun fileset-whole-get-dir (fileset-whole fileset)
 229    "Return the root dir of FILESET-WHOLE if it exists."
 230    ;;$$IMPROVE ME  Store a :root-dir property if we made one.
 231    (or
 232       (fileset-whole-data-get fileset-whole :root-dir nil t)
 233       (fileset-whole-root-dir fileset)))
 234
 235
 236 ;;;_  . fileset-whole-run-cmd
 237 ;;;###autoload
 238 (defun fileset-whole-run-cmd (cmd-name &optional fileset-name)
 239    "Run command CMD-NAME on whole fileset FILESET-NAME.
 240 If prefix arg is given, don't use FILESET-NAME default."
 241    (interactive
 242       (list
 243          (fileset-whole-read-cmd)
 244          (fileset-whole-read-fileset current-prefix-arg)))
 245    (let
 246       ((cmd-on-whole (assoc cmd-name fileset-whole-commands)))
 247       (cond
 248          (cmd-on-whole
 249             (let*
 250                (
 251                   (fileset
 252                      (filesets-get-fileset-from-name fileset-name))
 253                   (fileset-whole
 254                      (assoc fileset-name fileset-whole-alist))
 255                   (default-directory
 256                      (fileset-whole-get-dir fileset-whole fileset))
 257                   (fn
 258                      (fileset-whole-cmd->fn cmd-on-whole))
 259                   (args-spec
 260                      (fileset-whole-cmd->args cmd-on-whole))
 261                   (args
 262                      (mapcar #'eval args-spec)))
 263
 264                ;;$$IMPROVE ME Maybe open the fileset first, as
 265                ;;filesets-run-cmd does.  Do this according to some
 266                ;;property of the command. `filesets-open'.
 267
 268                ;;$$IMPROVE ME When command makes another buffer
 269                ;;(if we can tell it did), associate that buffer
 270                ;;with FILESET.  Set `fileset-whole-name-here' in
 271                ;;it.  Add it as an associated buffer (Possibly
 272                ;;in another menu area).
 273                (apply fn args)))
 274
 275          ;;If not, call the filesets command (which presumably
 276          ;;exists since we found it earlier)
 277          (t
 278             (filesets-run-cmd cmd-name fileset-name)))))
 279
 280 ;;;_ , Fileset extras
 281 ;;;_  . fileset-whole->fileset
 282 (defun fileset-whole->fileset (fileset)
 283    "Return a fileset object corresponding to FILESET.
 284 If FILESET is a string, return the fileset of that name."
 285
 286    (cond
 287       ((stringp fileset)
 288          (filesets-get-fileset-from-name fileset))
 289       ((listp fileset)
 290          fileset)
 291       (t
 292          (error "Can't convert to fileset: %s" fileset))))
 293 ;;;_  . fileset-whole-get-filelist
 294
 295 ;;This may be a bugfix towards filesets, because
 296 ;;`filesets-get-filelist' fails on :pattern or :tree.  It's also an
 297 ;;extension, to allow multiple :files-type clauses.
 298 (defun fileset-whole-get-filelist (fileset)
 299    "Return a list of all files in FILESET.
 300 Use instead of `filesets-get-filelist'."
 301
 302    (let*
 303       (
 304          (entries (cdr fileset))
 305          (files
 306             (apply #'nconc
 307                (mapcar
 308                   #'(lambda (entry)
 309                        (mapcar
 310                           #'expand-file-name
 311                           (case (car entry)
 312                              ((:pattern :tree :ingroup)
 313                                 (filesets-get-filelist
 314                                    (cdr entry) (car entry) nil))
 315                              (:files (cdr entry))
 316                              (:file
 317                                 (list (cdr entry)))
 318                              ;;Anything else: nil
 319                              (t ())
 320                              )))
 321                   entries))))
 322       files))
 323
 324
 325 ;;;_  . fileset-whole-pick-file
 326 ;;This is suitable as a destination-file function for
 327 ;;`org-remember-templates'
 328 (defun fileset-whole-pick-file (&optional fileset-name filter)
 329    "Interactively pick a single file name from a fileset.
 330 If FILESET-NAME if not given, prompt for it.
 331
 332 If FILTER is given, it must be a function of 1 arg.  Only present
 333 files that satisfy it."
 334
 335    (interactive)
 336    (let*
 337       ((fileset-name
 338           (or
 339              fileset-name
 340              (fileset-whole-read-fileset t)))
 341          (fileset
 342             (filesets-get-fileset-from-name fileset-name))
 343          (files
 344             (fileset-whole-get-filelist fileset))
 345          (files
 346             ;;$$IMPROVE ME  Support filtering by extension, by
 347             ;;mode-symbol, or by regexp.
 348             (if filter
 349                (filesets-filter-list files filter)
 350                files)))
 351
 352       (completing-read "File: " files nil t
 353          (fileset-whole-root-dir fileset))))
 354
 355
 356 ;;;_  . fileset-whole-root-dir
 357 (defun fileset-whole-root-dir (fileset)
 358    "Return a fileset's smallest enclosing directory."
 359
 360    (let*
 361       ((fileset (fileset-whole->fileset fileset))
 362          (files (fileset-whole-get-filelist fileset))
 363          (prefix
 364             (if files
 365                (reduce
 366                   #'fill-common-string-prefix
 367                   files)
 368                (error "No files found for %s" fileset))))
 369       (file-name-directory prefix)))
 370
 371
 372
 373 ;;;_ , Maintaining fileset-whole data
 374 ;;;_  . fileset-whole-edit
 375 (defun fileset-whole-edit ()
 376    "Customize `fileset-whole-alist'."
 377    (interactive)
 378    ;;$$IMPROVE ME Populate it first from fileset-data
 379    (customize-variable 'fileset-whole-alist))
 380
 381 ;;;_  . fileset-whole-populate-alist
 382 ;;YAGNI
 383 ;;Populate `fileset-whole-alist' with fileset names and whatever data
 384 ;;can be deduced about them, such as :root-dir
 385 ;;;_ , Support
 386 ;;;_  . fileset-whole-apply-compile
 387 (defun fileset-whole-apply-compile (&rest args)
 388    "Like `compile', but applied to the concatenation of ARGS"
 389    (compile
 390       (mapconcat #'identity args " ")))
 391 ;;;_ , To set up bindings
 392 ;;;###autoload (global-set-key "\C-cp" #'fileset-whole-run-cmd)
 393
 394 ;;;_ , To set up menus
 395 (fileset-whole-init)
 396
 397 ;;;_. Footers
 398 ;;;_ , Provides
 399
 400 (provide 'fileset-whole)
 401
 402 ;;;_ * Local emacs vars.
 403 ;;;_  + Local variables:
 404 ;;;_  + mode: allout
 405 ;;;_  + End:
 406
 407 ;;;_ , End
 408 ;;; fileset-whole.el ends here