comparison lisp/eshell/em-glob.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents eeded772a8a2
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; em-glob.el --- extended file name globbing 1 ;;; em-glob.el --- extended file name globbing
2 2
3 ;; Copyright (C) 1999, 2000 Free Software Foundation 3 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: John Wiegley <johnw@gnu.org> 6 ;; Author: John Wiegley <johnw@gnu.org>
6 7
7 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
8 9
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details. 18 ;; GNU General Public License for more details.
18 19
19 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02111-1307, USA. 23 ;; Boston, MA 02110-1301, USA.
23 24
24 ;;; Code: 25 ;;; Code:
25 26
26 (provide 'em-glob) 27 (provide 'em-glob)
27 28
120 (cons "*" (1+ pos)))))) 121 (cons "*" (1+ pos))))))
121 "*An alist for translation of extended globbing characters." 122 "*An alist for translation of extended globbing characters."
122 :type '(repeat (cons character (choice regexp function))) 123 :type '(repeat (cons character (choice regexp function)))
123 :group 'eshell-glob) 124 :group 'eshell-glob)
124 125
125 ;;; Internal Variables:
126
127 (defvar eshell-glob-chars-regexp nil)
128
129 ;;; Functions: 126 ;;; Functions:
130 127
131 (defun eshell-glob-initialize () 128 (defun eshell-glob-initialize ()
132 "Initialize the extended globbing code." 129 "Initialize the extended globbing code."
133 ;; it's important that `eshell-glob-chars-list' come first 130 ;; it's important that `eshell-glob-chars-list' come first
134 (when (boundp 'eshell-special-chars-outside-quoting) 131 (when (boundp 'eshell-special-chars-outside-quoting)
135 (set (make-local-variable 'eshell-special-chars-outside-quoting) 132 (set (make-local-variable 'eshell-special-chars-outside-quoting)
136 (append eshell-glob-chars-list eshell-special-chars-outside-quoting))) 133 (append eshell-glob-chars-list eshell-special-chars-outside-quoting)))
137 (set (make-local-variable 'eshell-glob-chars-regexp)
138 (format "[%s]+" (apply 'string eshell-glob-chars-list)))
139 (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t) 134 (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
140 (add-hook 'eshell-pre-rewrite-command-hook 135 (add-hook 'eshell-pre-rewrite-command-hook
141 'eshell-no-command-globbing nil t)) 136 'eshell-no-command-globbing nil t))
142 137
143 (defun eshell-no-command-globbing (terms) 138 (defun eshell-no-command-globbing (terms)
182 (eshell-add-glob-modifier) 177 (eshell-add-glob-modifier)
183 (prog1 178 (prog1
184 (buffer-substring-no-properties (1- (point)) (1+ end)) 179 (buffer-substring-no-properties (1- (point)) (1+ end))
185 (goto-char (1+ end)))))))))) 180 (goto-char (1+ end))))))))))
186 181
182 (defvar eshell-glob-chars-regexp nil)
183
187 (defun eshell-glob-regexp (pattern) 184 (defun eshell-glob-regexp (pattern)
188 "Convert glob-pattern PATTERN to a regular expression. 185 "Convert glob-pattern PATTERN to a regular expression.
189 The basic syntax is: 186 The basic syntax is:
190 187
191 glob regexp meaning 188 glob regexp meaning
202 If any characters in PATTERN have the text property `eshell-escaped' 199 If any characters in PATTERN have the text property `eshell-escaped'
203 set to true, then these characters will match themselves in the 200 set to true, then these characters will match themselves in the
204 resulting regular expression." 201 resulting regular expression."
205 (let ((matched-in-pattern 0) ; How much of PATTERN handled 202 (let ((matched-in-pattern 0) ; How much of PATTERN handled
206 regexp) 203 regexp)
207 (while (string-match eshell-glob-chars-regexp 204 (while (string-match
208 pattern matched-in-pattern) 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)) 209 (let* ((op-begin (match-beginning 0))
210 (op-char (aref pattern op-begin))) 210 (op-char (aref pattern op-begin)))
211 (setq regexp 211 (setq regexp
212 (concat regexp 212 (concat regexp
213 (regexp-quote 213 (regexp-quote
263 glob)))) 263 glob))))
264 264
265 (eval-when-compile 265 (eval-when-compile
266 (defvar matches) 266 (defvar matches)
267 (defvar message-shown)) 267 (defvar message-shown))
268
269 ;; jww (1999-11-18): this function assumes that directory-sep-char is
270 ;; a forward slash (/)
271 268
272 (defun eshell-glob-entries (path globs &optional recurse-p) 269 (defun eshell-glob-entries (path globs &optional recurse-p)
273 "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil." 270 "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
274 (let* ((entries (ignore-errors 271 (let* ((entries (ignore-errors
275 (file-name-all-completions "" path))) 272 (file-name-all-completions "" path)))
302 (setq incl (substring glob 0 index) 299 (setq incl (substring glob 0 index)
303 excl (substring glob (1+ index)))))) 300 excl (substring glob (1+ index))))))
304 ;; can't use `directory-file-name' because it strips away text 301 ;; can't use `directory-file-name' because it strips away text
305 ;; properties in the string 302 ;; properties in the string
306 (let ((len (1- (length incl)))) 303 (let ((len (1- (length incl))))
307 (if (eq (aref incl len) directory-sep-char) 304 (if (eq (aref incl len) ?/)
308 (setq incl (substring incl 0 len))) 305 (setq incl (substring incl 0 len)))
309 (when excl 306 (when excl
310 (setq len (1- (length excl))) 307 (setq len (1- (length excl)))
311 (if (eq (aref excl len) directory-sep-char) 308 (if (eq (aref excl len) ?/)
312 (setq excl (substring excl 0 len))))) 309 (setq excl (substring excl 0 len)))))
313 (setq incl (eshell-glob-regexp incl) 310 (setq incl (eshell-glob-regexp incl)
314 excl (and excl (eshell-glob-regexp excl))) 311 excl (and excl (eshell-glob-regexp excl)))
315 (if (or eshell-glob-include-dot-files 312 (if (or eshell-glob-include-dot-files
316 (eq (aref glob 0) ?.)) 313 (eq (aref glob 0) ?.))
328 (setq message-shown t)) 325 (setq message-shown t))
329 (if (equal path "./") (setq path "")) 326 (if (equal path "./") (setq path ""))
330 (while entries 327 (while entries
331 (setq name (car entries) 328 (setq name (car entries)
332 len (length name) 329 len (length name)
333 isdir (eq (aref name (1- len)) directory-sep-char)) 330 isdir (eq (aref name (1- len)) ?/))
334 (if (let ((fname (directory-file-name name))) 331 (if (let ((fname (directory-file-name name)))
335 (and (not (and excl (string-match excl fname))) 332 (and (not (and excl (string-match excl fname)))
336 (string-match incl fname))) 333 (string-match incl fname)))
337 (if (cdr globs) 334 (if (cdr globs)
338 (if isdir 335 (if isdir
355 (setq dirs (cdr dirs))) 352 (setq dirs (cdr dirs)))
356 (while rdirs 353 (while rdirs
357 (eshell-glob-entries (car rdirs) globs recurse-p) 354 (eshell-glob-entries (car rdirs) globs recurse-p)
358 (setq rdirs (cdr rdirs))))) 355 (setq rdirs (cdr rdirs)))))
359 356
357 ;;; arch-tag: d0548f54-fb7c-4978-a88e-f7c26f7f68ca
360 ;;; em-glob.el ends here 358 ;;; em-glob.el ends here