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 ;;;_ , Setting up menus
 112 ;;;_  . fileset-whole-setup-menu
 113 (defun fileset-whole-setup-menu ()
 114    "Add the commands in fileset-whole-commands to fileset menu."
 115    ;;When is this triggered?
 116    ;;And see `filesets-get-cmd-menu'.  Either add to it or add another
 117    ;;menu.
 118
 119    (easy-menu-add-item
 120       nil ;;Should this be `filesets-menu-in-menu'?
 121       (append filesets-menu-path (list filesets-menu-name "# Filesets"))
 122       ["Edit Filesets' Data" fileset-whole-edit]
 123       "Save Filesets"))
 124
 125 ;;;_  . fileset-whole-cmds-to-menu
 126 (defun fileset-whole-cmds-to-menu ()
 127   "Add fileset-whole commands to filesets command menu."
 128    (mapcar
 129       #'(lambda (this)
 130            (let
 131               ((name (car this)))
 132               (easy-menu-add-item
 133                  nil ;;Should this be `filesets-menu-in-menu'?
 134                  (append filesets-menu-path (list filesets-menu-name "+ Commands"))
 135                  `[,name (fileset-whole-run-cmd
 136                             ,name
 137                             (fileset-whole-read-fileset))])))
 138       fileset-whole-commands)
 139    t)
 140
 141 ;;;_  . fileset-whole-add-buffer
 142
 143 ;;Add a "created" buffer such as gdb, eshell, or magit make to the
 144 ;;menus, in a section paralleling the list of files.
 145
 146 ;;;_  . fileset-whole-setup-files
 147 ;;;###autoload
 148 (defun fileset-whole-setup-files ()
 149    "Run a hook in each currently open buffer that any fileset applies to."
 150    ;;$$WRITE ME
 151    ;;$$FACTOR ME Several parts: Running something in all relevant
 152    ;;buffers (parms: fileset-name).  The hook.  Running the hook this
 153    ;;way.
 154    ;;$$DESIGN ABOUT ME How and when to trigger this.  There are no
 155    ;;obvious hooks in fileset.
 156    (interactive)
 157    (let*
 158       ()
 159       ;;For each fileset
 160       ;;Get list of files
 161       ;;For each one that's already open, with that buffer current,
 162       ;;run hooks.  Default hook will just set `fileset-whole-name-here'.
 163       ))
 164 ;;;_  . fileset-whole-init
 165 ;;;###autoload
 166 (defun fileset-whole-init ()
 167    "Set up fileset-whole on top of filesets"
 168    (filesets-init)
 169    (fileset-whole-setup-menu)
 170    (fileset-whole-cmds-to-menu))
 171 ;;;_ , Structuring
 172 ;;;_  . fileset-whole-cmd->fn
 173 (defun fileset-whole-cmd->fn (cmd)
 174    "Return the function field of CMD"
 175    (nth 1 cmd))
 176 ;;;_  . fileset-whole-cmd->args
 177 (defun fileset-whole-cmd->args (cmd)
 178    "Return the args field of CMD"
 179    (nth 2 cmd))
 180 ;;;_  . fileset-whole-entry->alist
 181 (defun fileset-whole-entry->alist (entry)
 182    "Return the alist of ENTRY"
 183    (cdr entry))
 184 ;;;_  . fileset-whole-data-get
 185 (defun fileset-whole-data-get (entry key &optional default carp)
 186   "Extract the value for KEY in the data part of fileset ENTRY.
 187 Return DEFAULT if not found.  Return (car VALUE) if CARP is non-nil."
 188   (filesets-alist-get
 189      (fileset-whole-entry->alist entry) key default carp))
 190
 191 ;;;_ , Running commands
 192 ;;;_  . fileset-whole-read-cmd
 193 (defun fileset-whole-read-cmd ()
 194    "Interactively get the name of a fileset command.
 195 Either a whole command or a command on individual files."
 196
 197    (completing-read "Select command: "
 198       (append filesets-commands fileset-whole-commands)
 199       nil t))
 200 ;;;_  . fileset-whole-read-fileset
 201 (defun fileset-whole-read-fileset (&optional ask)
 202    "Interactively get the name of a fileset.
 203 Called interactively, it's useful for changing a buffer's default
 204    fileset"
 205    (interactive (list t))
 206    (or
 207       (unless ask fileset-whole-name-here)
 208       (let
 209          ((name
 210              (completing-read "Select fileset: "
 211                 filesets-data nil t
 212                 nil nil fileset-whole-name-here)))
 213          ;;Record it so we won't have to ask again wrt this buffer
 214          ;;(`fileset-whole-name-here' is buffer-local)
 215
 216          ;;$$IMPROVE ME Allow some way(s) to not set it:
 217          ;;User preference, and a buffer-local variable.
 218          (unless (eq name fileset-whole-name-here)
 219             (setq fileset-whole-name-here name))
 220          ;;$$IMPROVE ME If buffer is not associated with
 221          ;;any file, ask to add it (consult user preference)
 222          ;;`filesets-add-buffer'
 223          name)))
 224 ;;;_  . fileset-whole-set-fileset
 225 (defalias 'fileset-whole-set-fileset 'fileset-whole-read-fileset)
 226 ;;;_  . fileset-whole-get-dir
 227 (defun fileset-whole-get-dir (fileset-whole fileset)
 228    "Return the root dir of FILESET-WHOLE if it exists."
 229    ;;$$IMPROVE ME  Store a :root-dir property if we made one.
 230    (or
 231       (fileset-whole-data-get fileset-whole :root-dir nil t)
 232       (fileset-whole-root-dir fileset)))
 233
 234
 235 ;;;_  . fileset-whole-run-cmd
 236 ;;;###autoload
 237 (defun fileset-whole-run-cmd (cmd-name &optional fileset-name)
 238    "Run command CMD-NAME on whole fileset FILESET-NAME.
 239 If prefix arg is given, don't use FILESET-NAME default."
 240    (interactive
 241       (list
 242          (fileset-whole-read-cmd)
 243          (fileset-whole-read-fileset current-prefix-arg)))
 244    (let
 245       ((cmd-on-whole (assoc cmd-name fileset-whole-commands)))
 246       (cond
 247          (cmd-on-whole
 248             (let*
 249                (
 250                   (fileset
 251                      (filesets-get-fileset-from-name fileset-name))
 252                   (fileset-whole
 253                      (assoc fileset-name fileset-whole-alist))
 254                   (default-directory
 255                      (fileset-whole-get-dir fileset-whole fileset))
 256                   (fn
 257                      (fileset-whole-cmd->fn cmd-on-whole))
 258                   (args-spec
 259                      (fileset-whole-cmd->args cmd-on-whole))
 260                   (args
 261                      (mapcar #'eval args-spec)))
 262
 263                ;;$$IMPROVE ME Maybe open the fileset first, as
 264                ;;filesets-run-cmd does.  Do this according to some
 265                ;;property of the command. `filesets-open'.
 266
 267                ;;$$IMPROVE ME When command makes another buffer
 268                ;;(if we can tell it did), associate that buffer
 269                ;;with FILESET.  Set `fileset-whole-name-here' in
 270                ;;it.  Add it as an associated buffer (Possibly
 271                ;;in another menu area).
 272                (apply fn args)))
 273
 274          ;;If not, call the filesets command (which presumably
 275          ;;exists since we found it earlier)
 276          (t
 277             (filesets-run-cmd cmd-name fileset-name)))))
 278
 279 ;;;_ , Fileset extras
 280 ;;;_  . fileset-whole->fileset
 281 (defun fileset-whole->fileset (fileset)
 282    "Return a fileset object corresponding to FILESET.
 283 If FILESET is a string, return the fileset of that name."
 284
 285    (cond
 286       ((stringp fileset)
 287          (filesets-get-fileset-from-name fileset))
 288       ((listp fileset)
 289          fileset)
 290       (t
 291          (error "Can't convert to fileset: %s" fileset))))
 292 ;;;_  . fileset-whole-get-filelist
 293
 294 ;;This may be a bugfix towards filesets, because
 295 ;;`filesets-get-filelist' fails on :pattern or :tree.  It's also an
 296 ;;extension, to allow multiple :files-type clauses.
 297 (defun fileset-whole-get-filelist (fileset)
 298    "Return a list of all files in FILESET.
 299 Use instead of `filesets-get-filelist'."
 300
 301    (let*
 302       (
 303          (entries (cdr fileset))
 304          (files
 305             (apply #'nconc
 306                (mapcar
 307                   #'(lambda (entry)
 308                        (mapcar
 309                           #'expand-file-name
 310                           (case (car entry)
 311                              ((:pattern :tree :ingroup)
 312                                 (filesets-get-filelist
 313                                    (cdr entry) (car entry) nil))
 314                              (:files (cdr entry))
 315                              (:file
 316                                 (list (cdr entry)))
 317                              ;;Anything else: nil
 318                              (t ())
 319                              )))
 320                   entries))))
 321       files))
 322
 323
 324 ;;;_  . fileset-whole-pick-file
 325 ;;This is suitable as a destination-file function for
 326 ;;`org-remember-templates'
 327 (defun fileset-whole-pick-file (&optional fileset-name filter)
 328    "Interactively pick a single file name from a fileset.
 329 If FILESET-NAME if not given, prompt for it.
 330
 331 If FILTER is given, it must be a function of 1 arg.  Only present
 332 files that satisfy it."
 333
 334    (interactive)
 335    (let*
 336       ((fileset-name
 337           (or
 338              fileset-name
 339              (fileset-whole-read-fileset t)))
 340          (fileset
 341             (filesets-get-fileset-from-name fileset-name))
 342          (files
 343             (fileset-whole-get-filelist fileset))
 344          (files
 345             ;;$$IMPROVE ME  Support filtering by extension, by
 346             ;;mode-symbol, or by regexp.
 347             (if filter
 348                (filesets-filter-list files filter)
 349                files)))
 350
 351       (completing-read "File: " files nil t)))
 352
 353 ;;;_  . fileset-whole-root-dir
 354 (defun fileset-whole-root-dir (fileset)
 355    "Return a fileset's smallest enclosing directory."
 356
 357    (let*
 358       ((fileset (fileset-whole->fileset fileset))
 359          (files (fileset-whole-get-filelist fileset))
 360          (prefix
 361             (if files
 362                (reduce
 363                   #'fill-common-string-prefix
 364                   files)
 365                (error "No files found for %s" fileset))))
 366       (file-name-directory prefix)))
 367
 368
 369
 370 ;;;_ , Maintaining fileset-whole data
 371 ;;;_  . fileset-whole-edit
 372 (defun fileset-whole-edit ()
 373    "Customize `fileset-whole-alist'."
 374    (interactive)
 375    ;;$$IMPROVE ME Populate it first from fileset-data
 376    (customize-variable 'fileset-whole-alist))
 377
 378 ;;;_  . fileset-whole-populate-alist
 379 ;;YAGNI
 380 ;;Populate `fileset-whole-alist' with fileset names and whatever data
 381 ;;can be deduced about them, such as :root-dir
 382 ;;;_ , Support
 383 ;;;_  . fileset-whole-apply-compile
 384 (defun fileset-whole-apply-compile (&rest args)
 385    "Like `compile', but applied to the concatenation of ARGS"
 386    (compile
 387       (mapconcat #'identity args " ")))
 388 ;;;_ , To set up bindings
 389 ;;;###autoload (global-set-key "\C-cp" #'fileset-whole-run-cmd)
 390 ;;;###autoload (fileset-whole-init)
 391 ;;;_. Footers
 392 ;;;_ , Provides
 393
 394 (provide 'fileset-whole)
 395
 396 ;;;_ * Local emacs vars.
 397 ;;;_  + Local variables:
 398 ;;;_  + mode: allout
 399 ;;;_  + End:
 400
 401 ;;;_ , End
 402 ;;; fileset-whole.el ends here