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

;;; em-glob.el --- extended file name globbing  -*- lexical-binding:t -*-

;; Copyright (C) 1999-2014 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:

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

;;;###autoload
(progn
(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 nil
  "A list of functions to run when `eshell-glob' is loaded."
  :version "24.1"			; removed eshell-glob-initialize
  :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 mimics 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 '(alist :key-type character
		:value-type (choice string 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)
(defvar eshell-glob-matches)
(defvar message-shown)

(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))
	    "\\'")))

(defvar ange-cache)			; XEmacs?  See esh-util

(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))
	eshell-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 eshell-glob-matches (sort eshell-glob-matches #'string<))
	(if eshell-error-if-no-glob
	    (error "No matches found: %s" glob)
	  glob))))

;; FIXME does this really need to abuse eshell-glob-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 eshell-glob-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 eshell-glob-matches
		  (cons (concat path name) eshell-glob-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:

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