[bpt/emacs.git] / lisp / eshell / em-glob.el

;;; em-glob.el --- extended file name globbing

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;;   2008, 2009, 2010  Free Software Foundation, Inc.

;; Author: John Wiegley <johnw@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; The globbing code used by Eshell closely follows the syntax used by
;; zsh.  Basically, here is a summary of examples:
;;
;;   echo a*       ; anything starting with 'a'
;;   echo a#b      ; zero or more 'a's, then 'b'
;;   echo a##b     ; one or more 'a's, then 'b'
;;   echo a?       ; a followed by any character
;;   echo a*~ab    ; 'a', then anything, but not 'ab'
;;   echo c*~*~    ; all files beginning with 'c', except backups (*~)
;;
;; Recursive globbing is also supported:
;;
;;   echo **/*.c   ; all '.c' files at or under current directory
;;   echo ***/*.c  ; same as above, but traverse symbolic links
;;
;; Using argument predication, the recursive globbing syntax is
;; sufficient to replace the use of 'find <expr> | xargs <cmd>' in
;; most cases.  For example, to change the readership of all files
;; belonging to 'johnw' in the '/tmp' directory or lower, use:
;;
;;   chmod go-r /tmp/**/*(u'johnw')
;;
;; The glob above matches all of the files beneath '/tmp' that are
;; owned by the user 'johnw'.  See [Value modifiers and predicates],
;; for more information about argument predication.

;;; Code:

(eval-when-compile (require 'eshell))
(require 'esh-util)

;;;###autoload
(eshell-defgroup eshell-glob nil
  "This module provides extended globbing syntax, similar what is used
by zsh for filename generation."
  :tag "Extended filename globbing"
  :group 'eshell-module)

;;; User Variables:

(defcustom eshell-glob-load-hook '(eshell-glob-initialize)
  "A list of functions to run when `eshell-glob' is loaded."
  :type 'hook
  :group 'eshell-glob)

(defcustom eshell-glob-include-dot-files nil
  "If non-nil, glob patterns will match files beginning with a dot."
  :type 'boolean
  :group 'eshell-glob)

(defcustom eshell-glob-include-dot-dot t
  "If non-nil, glob patterns that match dots will match . and .."
  :type 'boolean
  :group 'eshell-glob)

(defcustom eshell-glob-case-insensitive (eshell-under-windows-p)
  "If non-nil, glob pattern matching will ignore case."
  :type 'boolean
  :group 'eshell-glob)

(defcustom eshell-glob-show-progress nil
  "If non-nil, display progress messages during a recursive glob.
This option slows down recursive glob processing by quite a bit."
  :type 'boolean
  :group 'eshell-glob)

(defcustom eshell-error-if-no-glob nil
  "If non-nil, it is an error for a glob pattern not to match.
 This mimcs the behavior of zsh if non-nil, but bash if nil."
  :type 'boolean
  :group 'eshell-glob)

(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?# ?^)
  "List of additional characters used in extended globbing."
  :type '(repeat character)
  :group 'eshell-glob)

(defcustom eshell-glob-translate-alist
  '((?\] . "]")
    (?\[ . "[")
    (?^  . "^")
    (??  . ".")
    (?*  . ".*")
    (?~  . "~")
    (?\( . "\\(")
    (?\) . "\\)")
    (?\| . "\\|")
    (?#  . (lambda (str pos)
	     (if (and (< (1+ pos) (length str))
		      (memq (aref str (1+ pos)) '(?* ?# ?+ ??)))
		 (cons (if (eq (aref str (1+ pos)) ??)
			   "?"
			 (if (eq (aref str (1+ pos)) ?*)
			     "*" "+")) (+ pos 2))
	       (cons "*" (1+ pos))))))
  "An alist for translation of extended globbing characters."
  :type '(repeat (cons character (choice regexp function)))
  :group 'eshell-glob)

;;; Functions:

(defun eshell-glob-initialize ()
  "Initialize the extended globbing code."
  ;; it's important that `eshell-glob-chars-list' come first
  (when (boundp 'eshell-special-chars-outside-quoting)
    (set (make-local-variable 'eshell-special-chars-outside-quoting)
	 (append eshell-glob-chars-list eshell-special-chars-outside-quoting)))
  (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
  (add-hook 'eshell-pre-rewrite-command-hook
	    'eshell-no-command-globbing nil t))

(defun eshell-no-command-globbing (terms)
  "Don't glob the command argument.  Reflect this by modifying TERMS."
  (ignore
   (when (and (listp (car terms))
	      (eq (caar terms) 'eshell-extended-glob))
     (setcar terms (cadr (car terms))))))

(defun eshell-add-glob-modifier ()
  "Add `eshell-extended-glob' to the argument modifier list."
  (when (memq 'expand-file-name eshell-current-modifiers)
    (setq eshell-current-modifiers
	  (delq 'expand-file-name eshell-current-modifiers))
    ;; if this is a glob pattern than needs to be expanded, then it
    ;; will need to expand each member of the resulting glob list
    (add-to-list 'eshell-current-modifiers
		 '(lambda (list)
		    (if (listp list)
			(mapcar 'expand-file-name list)
		      (expand-file-name list)))))
  (add-to-list 'eshell-current-modifiers 'eshell-extended-glob))

(defun eshell-parse-glob-chars ()
  "Parse a globbing delimiter.
The character is not advanced for ordinary globbing characters, so
that other function may have a chance to override the globbing
interpretation."
  (when (memq (char-after) eshell-glob-chars-list)
    (if (not (memq (char-after) '(?\( ?\[)))
	(ignore (eshell-add-glob-modifier))
      (let ((here (point)))
	(forward-char)
	(let* ((delim (char-before))
	       (end (eshell-find-delimiter
		     delim (if (eq delim ?\[) ?\] ?\)))))
	  (if (not end)
	      (throw 'eshell-incomplete delim)
	    (if (and (eshell-using-module 'eshell-pred)
		     (eshell-arg-delimiter (1+ end)))
		(ignore (goto-char here))
	      (eshell-add-glob-modifier)
	      (prog1
		  (buffer-substring-no-properties (1- (point)) (1+ end))
		(goto-char (1+ end))))))))))

(defvar eshell-glob-chars-regexp nil)

(defun eshell-glob-regexp (pattern)
  "Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:

  glob  regexp   meaning
  ----  ------   -------
  ?      .       matches any single character
  *      .*      matches any group of characters (or none)
  #      *       matches zero or more occurrences of preceding
  ##     +       matches one or more occurrences of preceding
  (x)    \(x\)   makes 'x' a regular expression group
  |      \|      boolean OR within an expression group
  [a-b]  [a-b]   matches a character or range
  [^a]   [^a]    excludes a character or range

If any characters in PATTERN have the text property `eshell-escaped'
set to true, then these characters will match themselves in the
resulting regular expression."
  (let ((matched-in-pattern 0)          ; How much of PATTERN handled
	regexp)
    (while (string-match
	    (or eshell-glob-chars-regexp
		(set (make-local-variable 'eshell-glob-chars-regexp)
		     (format "[%s]+" (apply 'string eshell-glob-chars-list))))
	    pattern matched-in-pattern)
      (let* ((op-begin (match-beginning 0))
	     (op-char (aref pattern op-begin)))
	(setq regexp
	      (concat regexp
		      (regexp-quote
		       (substring pattern matched-in-pattern op-begin))))
	(if (get-text-property op-begin 'escaped pattern)
	    (setq regexp (concat regexp
				 (regexp-quote (char-to-string op-char)))
		  matched-in-pattern (1+ op-begin))
	  (let ((xlat (assq op-char eshell-glob-translate-alist)))
	    (if (not xlat)
		(error "Unrecognized globbing character '%c'" op-char)
	      (if (stringp (cdr xlat))
		  (setq regexp (concat regexp (cdr xlat))
			matched-in-pattern (1+ op-begin))
		(let ((result (funcall (cdr xlat) pattern op-begin)))
		  (setq regexp (concat regexp (car result))
			matched-in-pattern (cdr result)))))))))
    (concat "\\`"
	    regexp
	    (regexp-quote (substring pattern matched-in-pattern))
	    "\\'")))

(defun eshell-extended-glob (glob)
  "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
This function almost fully supports zsh style filename generation
syntax.  Things that are not supported are:

   ^foo        for matching everything but foo
   (foo~bar)   tilde within a parenthesis group
   foo<1-10>   numeric ranges
   foo~x(a|b)  (a|b) will be interpreted as a predicate/modifier list

Mainly they are not supported because file matching is done with Emacs
regular expressions, and these cannot support the above constructs.

If this routine fails, it returns nil.  Otherwise, it returns a list
the form:

   (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
  (let ((paths (eshell-split-path glob))
	matches message-shown ange-cache)
    (unwind-protect
	(if (and (cdr paths)
		 (file-name-absolute-p (car paths)))
	    (eshell-glob-entries (file-name-as-directory (car paths))
				 (cdr paths))
	  (eshell-glob-entries (file-name-as-directory ".") paths))
      (if message-shown
	  (message nil)))
    (or (and matches (sort matches #'string<))
	(if eshell-error-if-no-glob
	    (error "No matches found: %s" glob)
	  glob))))

(defvar matches)
(defvar message-shown)

;; FIXME does this really need to abuse matches, message-shown?
(defun eshell-glob-entries (path globs &optional recurse-p)
  "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
  (let* ((entries (ignore-errors
		    (file-name-all-completions "" path)))
	 (case-fold-search eshell-glob-case-insensitive)
	 (glob (car globs))
	 (len (length glob))
	 dirs rdirs
	 incl excl
	 name isdir pathname)
    (while (cond
	    ((and (= len 3) (equal glob "**/"))
	     (setq recurse-p 2
		   globs (cdr globs)
		   glob (car globs)
		   len (length glob)))
	    ((and (= len 4) (equal glob "***/"))
	     (setq recurse-p 3
		   globs (cdr globs)
		   glob (car globs)
		   len (length glob)))))
    (if (and recurse-p (not glob))
	(error "'**' cannot end a globbing pattern"))
    (let ((index 1))
      (setq incl glob)
      (while (and (eq incl glob)
		  (setq index (string-match "~" glob index)))
	(if (or (get-text-property index 'escaped glob)
		(or (= (1+ index) len)))
	    (setq index (1+ index))
	  (setq incl (substring glob 0 index)
		excl (substring glob (1+ index))))))
    ;; can't use `directory-file-name' because it strips away text
    ;; properties in the string
    (let ((len (1- (length incl))))
      (if (eq (aref incl len) ?/)
	  (setq incl (substring incl 0 len)))
      (when excl
	(setq len (1- (length excl)))
	(if (eq (aref excl len) ?/)
	    (setq excl (substring excl 0 len)))))
    (setq incl (eshell-glob-regexp incl)
	  excl (and excl (eshell-glob-regexp excl)))
    (if (or eshell-glob-include-dot-files
	    (eq (aref glob 0) ?.))
	(unless (or eshell-glob-include-dot-dot
		    (cdr globs))
	  (setq excl (if excl
			 (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
		       "\\`\\.\\.?\\'")))
      (setq excl (if excl
		     (concat "\\(\\`\\.\\|" excl "\\)")
		   "\\`\\.")))
    (when (and recurse-p eshell-glob-show-progress)
      (message "Building file list...%d so far: %s"
	       (length matches) path)
      (setq message-shown t))
    (if (equal path "./") (setq path ""))
    (while entries
      (setq name (car entries)
	    len (length name)
	    isdir (eq (aref name (1- len)) ?/))
      (if (let ((fname (directory-file-name name)))
	    (and (not (and excl (string-match excl fname)))
		 (string-match incl fname)))
	  (if (cdr globs)
	      (if isdir
		  (setq dirs (cons (concat path name) dirs)))
	    (setq matches (cons (concat path name) matches))))
      (if (and recurse-p isdir
	       (or (> len 3)
		   (not (or (and (= len 2) (equal name "./"))
			    (and (= len 3) (equal name "../")))))
	       (setq pathname (concat path name))
	       (not (and (= recurse-p 2)
			 (file-symlink-p
			  (directory-file-name pathname)))))
	  (setq rdirs (cons pathname rdirs)))
      (setq entries (cdr entries)))
    (setq dirs (nreverse dirs)
	  rdirs (nreverse rdirs))
    (while dirs
      (eshell-glob-entries (car dirs) (cdr globs))
      (setq dirs (cdr dirs)))
    (while rdirs
      (eshell-glob-entries (car rdirs) globs recurse-p)
      (setq rdirs (cdr rdirs)))))

(provide 'em-glob)

;; Local Variables:
;; generated-autoload-file: "esh-groups.el"
;; End:

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