lisp/eshell/em-glob.el

   1 ;;; em-glob.el --- extended file name globbing
   2
   3 ;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; The globbing code used by Eshell closely follows the syntax used by
  25 ;; zsh.  Basically, here is a summary of examples:
  26 ;;
  27 ;;   echo a*       ; anything starting with 'a'
  28 ;;   echo a#b      ; zero or more 'a's, then 'b'
  29 ;;   echo a##b     ; one or more 'a's, then 'b'
  30 ;;   echo a?       ; a followed by any character
  31 ;;   echo a*~ab    ; 'a', then anything, but not 'ab'
  32 ;;   echo c*~*~    ; all files beginning with 'c', except backups (*~)
  33 ;;
  34 ;; Recursive globbing is also supported:
  35 ;;
  36 ;;   echo **/*.c   ; all '.c' files at or under current directory
  37 ;;   echo ***/*.c  ; same as above, but traverse symbolic links
  38 ;;
  39 ;; Using argument predication, the recursive globbing syntax is
  40 ;; sufficient to replace the use of 'find <expr> | xargs <cmd>' in
  41 ;; most cases.  For example, to change the readership of all files
  42 ;; belonging to 'johnw' in the '/tmp' directory or lower, use:
  43 ;;
  44 ;;   chmod go-r /tmp/**/*(u'johnw')
  45 ;;
  46 ;; The glob above matches all of the files beneath '/tmp' that are
  47 ;; owned by the user 'johnw'.  See [Value modifiers and predicates],
  48 ;; for more information about argument predication.
  49
  50 ;;; Code:
  51
  52 (eval-when-compile (require 'eshell))
  53 (require 'esh-util)
  54
  55 ;;;###autoload
  56 (progn
  57 (defgroup eshell-glob nil
  58   "This module provides extended globbing syntax, similar what is used
  59 by zsh for filename generation."
  60   :tag "Extended filename globbing"
  61   :group 'eshell-module))
  62
  63 ;;; User Variables:
  64
  65 (defcustom eshell-glob-load-hook nil
  66   "A list of functions to run when `eshell-glob' is loaded."
  67   :version "24.1"                       ; removed eshell-glob-initialize
  68   :type 'hook
  69   :group 'eshell-glob)
  70
  71 (defcustom eshell-glob-include-dot-files nil
  72   "If non-nil, glob patterns will match files beginning with a dot."
  73   :type 'boolean
  74   :group 'eshell-glob)
  75
  76 (defcustom eshell-glob-include-dot-dot t
  77   "If non-nil, glob patterns that match dots will match . and .."
  78   :type 'boolean
  79   :group 'eshell-glob)
  80
  81 (defcustom eshell-glob-case-insensitive (eshell-under-windows-p)
  82   "If non-nil, glob pattern matching will ignore case."
  83   :type 'boolean
  84   :group 'eshell-glob)
  85
  86 (defcustom eshell-glob-show-progress nil
  87   "If non-nil, display progress messages during a recursive glob.
  88 This option slows down recursive glob processing by quite a bit."
  89   :type 'boolean
  90   :group 'eshell-glob)
  91
  92 (defcustom eshell-error-if-no-glob nil
  93   "If non-nil, it is an error for a glob pattern not to match.
  94  This mimics the behavior of zsh if non-nil, but bash if nil."
  95   :type 'boolean
  96   :group 'eshell-glob)
  97
  98 (defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?# ?^)
  99   "List of additional characters used in extended globbing."
 100   :type '(repeat character)
 101   :group 'eshell-glob)
 102
 103 (defcustom eshell-glob-translate-alist
 104   '((?\] . "]")
 105     (?\[ . "[")
 106     (?^  . "^")
 107     (??  . ".")
 108     (?*  . ".*")
 109     (?~  . "~")
 110     (?\( . "\\(")
 111     (?\) . "\\)")
 112     (?\| . "\\|")
 113     (?#  . (lambda (str pos)
 114              (if (and (< (1+ pos) (length str))
 115                       (memq (aref str (1+ pos)) '(?* ?# ?+ ??)))
 116                  (cons (if (eq (aref str (1+ pos)) ??)
 117                            "?"
 118                          (if (eq (aref str (1+ pos)) ?*)
 119                              "*" "+")) (+ pos 2))
 120                (cons "*" (1+ pos))))))
 121   "An alist for translation of extended globbing characters."
 122   :type '(repeat (cons character (choice regexp function)))
 123   :group 'eshell-glob)
 124
 125 ;;; Functions:
 126
 127 (defun eshell-glob-initialize ()
 128   "Initialize the extended globbing code."
 129   ;; it's important that `eshell-glob-chars-list' come first
 130   (when (boundp 'eshell-special-chars-outside-quoting)
 131     (set (make-local-variable 'eshell-special-chars-outside-quoting)
 132          (append eshell-glob-chars-list eshell-special-chars-outside-quoting)))
 133   (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
 134   (add-hook 'eshell-pre-rewrite-command-hook
 135             'eshell-no-command-globbing nil t))
 136
 137 (defun eshell-no-command-globbing (terms)
 138   "Don't glob the command argument.  Reflect this by modifying TERMS."
 139   (ignore
 140    (when (and (listp (car terms))
 141               (eq (caar terms) 'eshell-extended-glob))
 142      (setcar terms (cadr (car terms))))))
 143
 144 (defun eshell-add-glob-modifier ()
 145   "Add `eshell-extended-glob' to the argument modifier list."
 146   (when (memq 'expand-file-name eshell-current-modifiers)
 147     (setq eshell-current-modifiers
 148           (delq 'expand-file-name eshell-current-modifiers))
 149     ;; if this is a glob pattern than needs to be expanded, then it
 150     ;; will need to expand each member of the resulting glob list
 151     (add-to-list 'eshell-current-modifiers
 152                  (lambda (list)
 153                    (if (listp list)
 154                        (mapcar 'expand-file-name list)
 155                      (expand-file-name list)))))
 156   (add-to-list 'eshell-current-modifiers 'eshell-extended-glob))
 157
 158 (defun eshell-parse-glob-chars ()
 159   "Parse a globbing delimiter.
 160 The character is not advanced for ordinary globbing characters, so
 161 that other function may have a chance to override the globbing
 162 interpretation."
 163   (when (memq (char-after) eshell-glob-chars-list)
 164     (if (not (memq (char-after) '(?\( ?\[)))
 165         (ignore (eshell-add-glob-modifier))
 166       (let ((here (point)))
 167         (forward-char)
 168         (let* ((delim (char-before))
 169                (end (eshell-find-delimiter
 170                      delim (if (eq delim ?\[) ?\] ?\)))))
 171           (if (not end)
 172               (throw 'eshell-incomplete delim)
 173             (if (and (eshell-using-module 'eshell-pred)
 174                      (eshell-arg-delimiter (1+ end)))
 175                 (ignore (goto-char here))
 176               (eshell-add-glob-modifier)
 177               (prog1
 178                   (buffer-substring-no-properties (1- (point)) (1+ end))
 179                 (goto-char (1+ end))))))))))
 180
 181 (defvar eshell-glob-chars-regexp nil)
 182
 183 (defun eshell-glob-regexp (pattern)
 184   "Convert glob-pattern PATTERN to a regular expression.
 185 The basic syntax is:
 186
 187   glob  regexp   meaning
 188   ----  ------   -------
 189   ?      .       matches any single character
 190   *      .*      matches any group of characters (or none)
 191   #      *       matches zero or more occurrences of preceding
 192   ##     +       matches one or more occurrences of preceding
 193   (x)    \(x\)   makes 'x' a regular expression group
 194   |      \|      boolean OR within an expression group
 195   [a-b]  [a-b]   matches a character or range
 196   [^a]   [^a]    excludes a character or range
 197
 198 If any characters in PATTERN have the text property `eshell-escaped'
 199 set to true, then these characters will match themselves in the
 200 resulting regular expression."
 201   (let ((matched-in-pattern 0)          ; How much of PATTERN handled
 202         regexp)
 203     (while (string-match
 204             (or eshell-glob-chars-regexp
 205                 (set (make-local-variable 'eshell-glob-chars-regexp)
 206                      (format "[%s]+" (apply 'string eshell-glob-chars-list))))
 207             pattern matched-in-pattern)
 208       (let* ((op-begin (match-beginning 0))
 209              (op-char (aref pattern op-begin)))
 210         (setq regexp
 211               (concat regexp
 212                       (regexp-quote
 213                        (substring pattern matched-in-pattern op-begin))))
 214         (if (get-text-property op-begin 'escaped pattern)
 215             (setq regexp (concat regexp
 216                                  (regexp-quote (char-to-string op-char)))
 217                   matched-in-pattern (1+ op-begin))
 218           (let ((xlat (assq op-char eshell-glob-translate-alist)))
 219             (if (not xlat)
 220                 (error "Unrecognized globbing character '%c'" op-char)
 221               (if (stringp (cdr xlat))
 222                   (setq regexp (concat regexp (cdr xlat))
 223                         matched-in-pattern (1+ op-begin))
 224                 (let ((result (funcall (cdr xlat) pattern op-begin)))
 225                   (setq regexp (concat regexp (car result))
 226                         matched-in-pattern (cdr result)))))))))
 227     (concat "\\`"
 228             regexp
 229             (regexp-quote (substring pattern matched-in-pattern))
 230             "\\'")))
 231
 232 (defun eshell-extended-glob (glob)
 233   "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
 234 This function almost fully supports zsh style filename generation
 235 syntax.  Things that are not supported are:
 236
 237    ^foo        for matching everything but foo
 238    (foo~bar)   tilde within a parenthesis group
 239    foo<1-10>   numeric ranges
 240    foo~x(a|b)  (a|b) will be interpreted as a predicate/modifier list
 241
 242 Mainly they are not supported because file matching is done with Emacs
 243 regular expressions, and these cannot support the above constructs.
 244
 245 If this routine fails, it returns nil.  Otherwise, it returns a list
 246 the form:
 247
 248    (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
 249   (let ((paths (eshell-split-path glob))
 250         eshell-glob-matches message-shown ange-cache)
 251     (unwind-protect
 252         (if (and (cdr paths)
 253                  (file-name-absolute-p (car paths)))
 254             (eshell-glob-entries (file-name-as-directory (car paths))
 255                                  (cdr paths))
 256           (eshell-glob-entries (file-name-as-directory ".") paths))
 257       (if message-shown
 258           (message nil)))
 259     (or (and eshell-glob-matches (sort eshell-glob-matches #'string<))
 260         (if eshell-error-if-no-glob
 261             (error "No matches found: %s" glob)
 262           glob))))
 263
 264 (defvar eshell-glob-matches)
 265 (defvar message-shown)
 266
 267 ;; FIXME does this really need to abuse eshell-glob-matches, message-shown?
 268 (defun eshell-glob-entries (path globs &optional recurse-p)
 269   "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
 270   (let* ((entries (ignore-errors
 271                     (file-name-all-completions "" path)))
 272          (case-fold-search eshell-glob-case-insensitive)
 273          (glob (car globs))
 274          (len (length glob))
 275          dirs rdirs
 276          incl excl
 277          name isdir pathname)
 278     (while (cond
 279             ((and (= len 3) (equal glob "**/"))
 280              (setq recurse-p 2
 281                    globs (cdr globs)
 282                    glob (car globs)
 283                    len (length glob)))
 284             ((and (= len 4) (equal glob "***/"))
 285              (setq recurse-p 3
 286                    globs (cdr globs)
 287                    glob (car globs)
 288                    len (length glob)))))
 289     (if (and recurse-p (not glob))
 290         (error "'**' cannot end a globbing pattern"))
 291     (let ((index 1))
 292       (setq incl glob)
 293       (while (and (eq incl glob)
 294                   (setq index (string-match "~" glob index)))
 295         (if (or (get-text-property index 'escaped glob)
 296                 (or (= (1+ index) len)))
 297             (setq index (1+ index))
 298           (setq incl (substring glob 0 index)
 299                 excl (substring glob (1+ index))))))
 300     ;; can't use `directory-file-name' because it strips away text
 301     ;; properties in the string
 302     (let ((len (1- (length incl))))
 303       (if (eq (aref incl len) ?/)
 304           (setq incl (substring incl 0 len)))
 305       (when excl
 306         (setq len (1- (length excl)))
 307         (if (eq (aref excl len) ?/)
 308             (setq excl (substring excl 0 len)))))
 309     (setq incl (eshell-glob-regexp incl)
 310           excl (and excl (eshell-glob-regexp excl)))
 311     (if (or eshell-glob-include-dot-files
 312             (eq (aref glob 0) ?.))
 313         (unless (or eshell-glob-include-dot-dot
 314                     (cdr globs))
 315           (setq excl (if excl
 316                          (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
 317                        "\\`\\.\\.?\\'")))
 318       (setq excl (if excl
 319                      (concat "\\(\\`\\.\\|" excl "\\)")
 320                    "\\`\\.")))
 321     (when (and recurse-p eshell-glob-show-progress)
 322       (message "Building file list...%d so far: %s"
 323                (length eshell-glob-matches) path)
 324       (setq message-shown t))
 325     (if (equal path "./") (setq path ""))
 326     (while entries
 327       (setq name (car entries)
 328             len (length name)
 329             isdir (eq (aref name (1- len)) ?/))
 330       (if (let ((fname (directory-file-name name)))
 331             (and (not (and excl (string-match excl fname)))
 332                  (string-match incl fname)))
 333           (if (cdr globs)
 334               (if isdir
 335                   (setq dirs (cons (concat path name) dirs)))
 336             (setq eshell-glob-matches
 337                   (cons (concat path name) eshell-glob-matches))))
 338       (if (and recurse-p isdir
 339                (or (> len 3)
 340                    (not (or (and (= len 2) (equal name "./"))
 341                             (and (= len 3) (equal name "../")))))
 342                (setq pathname (concat path name))
 343                (not (and (= recurse-p 2)
 344                          (file-symlink-p
 345                           (directory-file-name pathname)))))
 346           (setq rdirs (cons pathname rdirs)))
 347       (setq entries (cdr entries)))
 348     (setq dirs (nreverse dirs)
 349           rdirs (nreverse rdirs))
 350     (while dirs
 351       (eshell-glob-entries (car dirs) (cdr globs))
 352       (setq dirs (cdr dirs)))
 353     (while rdirs
 354       (eshell-glob-entries (car rdirs) globs recurse-p)
 355       (setq rdirs (cdr rdirs)))))
 356
 357 (provide 'em-glob)
 358
 359 ;; Local Variables:
 360 ;; generated-autoload-file: "esh-groups.el"
 361 ;; End:
 362
 363 ;;; em-glob.el ends here