1 ;;; em-glob.el --- extended file name globbing
3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
4 ;; 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: John Wiegley <johnw@gnu.org>
8 ;; This file is part of GNU Emacs.
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)
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.
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.
29 (eval-when-compile (require 'esh-maint
))
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
)
40 ;; The globbing code used by Eshell closely follows the syntax used by
41 ;; zsh. Basically, here is a summary of examples:
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 (*~)
50 ;; Recursive globbing is also supported:
52 ;; echo **/*.c ; all '.c' files at or under current directory
53 ;; echo ***/*.c ; same as above, but traverse symbolic links
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:
60 ;; chmod go-r /tmp/**/*(u'johnw')
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.
68 (defcustom eshell-glob-load-hook
'(eshell-glob-initialize)
69 "*A list of functions to run when `eshell-glob' is loaded."
73 (defcustom eshell-glob-include-dot-files nil
74 "*If non-nil, glob patterns will match files beginning with a dot."
78 (defcustom eshell-glob-include-dot-dot t
79 "*If non-nil, glob patterns that match dots will match . and .."
83 (defcustom eshell-glob-case-insensitive
(eshell-under-windows-p)
84 "*If non-nil, glob pattern matching will ignore case."
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."
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."
100 (defcustom eshell-glob-chars-list
'(?\
] ?\
[ ?
* ?? ?~ ?\
( ?\
) ?| ?
#)
101 "*List of additional characters used in extended globbing."
102 :type
'(repeat character
)
105 (defcustom eshell-glob-translate-alist
114 (?
# .
(lambda (str pos
)
115 (if (and (< (1+ pos
) (length str
))
116 (memq (aref str
(1+ pos
)) '(?
* ?
# ?
+ ??
)))
117 (cons (if (eq (aref str
(1+ pos
)) ??
)
119 (if (eq (aref str
(1+ pos
)) ?
*)
121 (cons "*" (1+ pos
))))))
122 "*An alist for translation of extended globbing characters."
123 :type
'(repeat (cons character
(choice regexp function
)))
128 (defun eshell-glob-initialize ()
129 "Initialize the extended globbing code."
130 ;; it's important that `eshell-glob-chars-list' come first
131 (when (boundp 'eshell-special-chars-outside-quoting
)
132 (set (make-local-variable 'eshell-special-chars-outside-quoting
)
133 (append eshell-glob-chars-list eshell-special-chars-outside-quoting
)))
134 (add-hook 'eshell-parse-argument-hook
'eshell-parse-glob-chars t t
)
135 (add-hook 'eshell-pre-rewrite-command-hook
136 'eshell-no-command-globbing nil t
))
138 (defun eshell-no-command-globbing (terms)
139 "Don't glob the command argument. Reflect this by modifying TERMS."
141 (when (and (listp (car terms
))
142 (eq (caar terms
) 'eshell-extended-glob
))
143 (setcar terms
(cadr (car terms
))))))
145 (defun eshell-add-glob-modifier ()
146 "Add `eshell-extended-glob' to the argument modifier list."
147 (when (memq 'expand-file-name eshell-current-modifiers
)
148 (setq eshell-current-modifiers
149 (delq 'expand-file-name eshell-current-modifiers
))
150 ;; if this is a glob pattern than needs to be expanded, then it
151 ;; will need to expand each member of the resulting glob list
152 (add-to-list 'eshell-current-modifiers
155 (mapcar 'expand-file-name list
)
156 (expand-file-name list
)))))
157 (add-to-list 'eshell-current-modifiers
'eshell-extended-glob
))
159 (defun eshell-parse-glob-chars ()
160 "Parse a globbing delimiter.
161 The character is not advanced for ordinary globbing characters, so
162 that other function may have a chance to override the globbing
164 (when (memq (char-after) eshell-glob-chars-list
)
165 (if (not (memq (char-after) '(?\
( ?\
[)))
166 (ignore (eshell-add-glob-modifier))
167 (let ((here (point)))
169 (let* ((delim (char-before))
170 (end (eshell-find-delimiter
171 delim
(if (eq delim ?\
[) ?\
] ?\
)))))
173 (throw 'eshell-incomplete delim
)
174 (if (and (eshell-using-module 'eshell-pred
)
175 (eshell-arg-delimiter (1+ end
)))
176 (ignore (goto-char here
))
177 (eshell-add-glob-modifier)
179 (buffer-substring-no-properties (1- (point)) (1+ end
))
180 (goto-char (1+ end
))))))))))
182 (defvar eshell-glob-chars-regexp nil
)
184 (defun eshell-glob-regexp (pattern)
185 "Convert glob-pattern PATTERN to a regular expression.
190 ? . matches any single character
191 * .* matches any group of characters (or none)
192 # * matches zero or more occurrences of preceding
193 ## + matches one or more occurrences of preceding
194 (x) \(x\) makes 'x' a regular expression group
195 | \| boolean OR within an expression group
196 [a-b] [a-b] matches a character or range
197 [^a] [^a] excludes a character or range
199 If any characters in PATTERN have the text property `eshell-escaped'
200 set to true, then these characters will match themselves in the
201 resulting regular expression."
202 (let ((matched-in-pattern 0) ; How much of PATTERN handled
205 (or eshell-glob-chars-regexp
206 (set (make-local-variable 'eshell-glob-chars-regexp
)
207 (format "[%s]+" (apply 'string eshell-glob-chars-list
))))
208 pattern matched-in-pattern
)
209 (let* ((op-begin (match-beginning 0))
210 (op-char (aref pattern op-begin
)))
214 (substring pattern matched-in-pattern op-begin
))))
215 (if (get-text-property op-begin
'escaped pattern
)
216 (setq regexp
(concat regexp
217 (regexp-quote (char-to-string op-char
)))
218 matched-in-pattern
(1+ op-begin
))
219 (let ((xlat (assq op-char eshell-glob-translate-alist
)))
221 (error "Unrecognized globbing character '%c'" op-char
)
222 (if (stringp (cdr xlat
))
223 (setq regexp
(concat regexp
(cdr xlat
))
224 matched-in-pattern
(1+ op-begin
))
225 (let ((result (funcall (cdr xlat
) pattern op-begin
)))
226 (setq regexp
(concat regexp
(car result
))
227 matched-in-pattern
(cdr result
)))))))))
230 (regexp-quote (substring pattern matched-in-pattern
))
233 (defun eshell-extended-glob (glob)
234 "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
235 This function almost fully supports zsh style filename generation
236 syntax. Things that are not supported are:
238 ^foo for matching everything but foo
239 (foo~bar) tilde within a parenthesis group
240 foo<1-10> numeric ranges
241 foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list
243 Mainly they are not supported because file matching is done with Emacs
244 regular expressions, and these cannot support the above constructs.
246 If this routine fails, it returns nil. Otherwise, it returns a list
249 (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
250 (let ((paths (eshell-split-path glob
))
251 matches message-shown ange-cache
)
254 (file-name-absolute-p (car paths
)))
255 (eshell-glob-entries (file-name-as-directory (car paths
))
257 (eshell-glob-entries (file-name-as-directory ".") paths
))
260 (or (and matches
(nreverse matches
))
261 (if eshell-error-if-no-glob
262 (error "No matches found: %s" glob
)
267 (defvar message-shown
))
269 (defun eshell-glob-entries (path globs
&optional recurse-p
)
270 "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
271 (let* ((entries (ignore-errors
272 (file-name-all-completions "" path
)))
273 (case-fold-search eshell-glob-case-insensitive
)
280 ((and (= len
3) (equal glob
"**/"))
285 ((and (= len
4) (equal glob
"***/"))
289 len
(length glob
)))))
290 (if (and recurse-p
(not glob
))
291 (error "'**' cannot end a globbing pattern"))
294 (while (and (eq incl glob
)
295 (setq index
(string-match "~" glob index
)))
296 (if (or (get-text-property index
'escaped glob
)
297 (or (= (1+ index
) len
)))
298 (setq index
(1+ index
))
299 (setq incl
(substring glob
0 index
)
300 excl
(substring glob
(1+ index
))))))
301 ;; can't use `directory-file-name' because it strips away text
302 ;; properties in the string
303 (let ((len (1- (length incl
))))
304 (if (eq (aref incl len
) ?
/)
305 (setq incl
(substring incl
0 len
)))
307 (setq len
(1- (length excl
)))
308 (if (eq (aref excl len
) ?
/)
309 (setq excl
(substring excl
0 len
)))))
310 (setq incl
(eshell-glob-regexp incl
)
311 excl
(and excl
(eshell-glob-regexp excl
)))
312 (if (or eshell-glob-include-dot-files
313 (eq (aref glob
0) ?.
))
314 (unless (or eshell-glob-include-dot-dot
317 (concat "\\(\\`\\.\\.?\\'\\|" excl
"\\)")
320 (concat "\\(\\`\\.\\|" excl
"\\)")
322 (when (and recurse-p eshell-glob-show-progress
)
323 (message "Building file list...%d so far: %s"
324 (length matches
) path
)
325 (setq message-shown t
))
326 (if (equal path
"./") (setq path
""))
328 (setq name
(car entries
)
330 isdir
(eq (aref name
(1- len
)) ?
/))
331 (if (let ((fname (directory-file-name name
)))
332 (and (not (and excl
(string-match excl fname
)))
333 (string-match incl fname
)))
336 (setq dirs
(cons (concat path name
) dirs
)))
337 (setq matches
(cons (concat path name
) matches
))))
338 (if (and recurse-p isdir
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)
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
))
351 (eshell-glob-entries (car dirs
) (cdr globs
))
352 (setq dirs
(cdr dirs
)))
354 (eshell-glob-entries (car rdirs
) globs recurse-p
)
355 (setq rdirs
(cdr rdirs
)))))
357 ;;; arch-tag: d0548f54-fb7c-4978-a88e-f7c26f7f68ca
358 ;;; em-glob.el ends here