Mercurial > emacs
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 |