cgit.sxemacs.org Git - packages/blob - xemacs-packages/eshell/em-glob.el

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