1;;; em-pred.el --- argument predicates and modifiers (ala zsh)
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: John Wiegley <johnw@gnu.org>
7
8;; This file is part of GNU Emacs.
9
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)
13;; any later version.
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
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.
24
25(provide 'em-pred)
26
27(eval-when-compile (require 'esh-maint))
28
29(defgroup eshell-pred nil
30  "This module allows for predicates to be applied to globbing
31patterns (similar to zsh), in addition to string modifiers which can
32be applied either to globbing results, variable references, or just
33ordinary strings."
34  :tag "Value modifiers and predicates"
35  :group 'eshell-module)
36
37;;; Commentary:
38
39;; Argument predication is used to affect which members of a list are
40;; selected for use as argument.  This is most useful with globbing,
41;; but can be used on any list argument, to select certain members.
42;;
43;; Argument modifiers are used to manipulate argument values.  For
44;; example, sorting lists, upcasing words, substituting characters,
45;; etc.
46;;
47;; Here are some examples of how to use argument predication.  Most of
48;; the predicates and modifiers are modeled after those provided by
49;; zsh.
50;;
51;;   ls -ld *(/)           ; list all directories
52;;   ls -l *(@u'johnw')    ; list all symlinks owned by 'johnw'
53;;   bzip2 -9v **/*(a+30)  ; compress everything which hasn't been
54;;                           accessed in 30 days
55;;   echo *.c(:o:R)     ; a reversed, sorted list of C files
56;;   *(^@:U^u0)         ; all non-symlinks not owned by 'root', upcased
57;;   chmod u-x *(U*)    : remove exec bit on all executables owned by user
58;;
59;; See the zsh docs for more on the syntax ([(zsh.info)Filename
60;; Generation]).
61
62;;; Code:
63
64;;; User Variables:
65
66(defcustom eshell-pred-load-hook '(eshell-pred-initialize)
67  "*A list of functions to run when `eshell-pred' is loaded."
68  :type 'hook
69  :group 'eshell-pred)
70
71(defcustom eshell-predicate-alist
72  '((?/ . (eshell-pred-file-type ?d))   ; directories
73    (?. . (eshell-pred-file-type ?-))   ; regular files
74    (?s . (eshell-pred-file-type ?s))   ; sockets
75    (?p . (eshell-pred-file-type ?p))   ; named pipes
76    (?@ . (eshell-pred-file-type ?l))   ; symbolic links
77    (?% . (eshell-pred-file-type ?%))   ; allow user to specify (c def.)
78    (?r . (eshell-pred-file-mode 0400)) ; owner-readable
79    (?w . (eshell-pred-file-mode 0200)) ; owner-writable
80    (?x . (eshell-pred-file-mode 0100)) ; owner-executable
81    (?A . (eshell-pred-file-mode 0040)) ; group-readable
82    (?I . (eshell-pred-file-mode 0020)) ; group-writable
83    (?E . (eshell-pred-file-mode 0010)) ; group-executable
84    (?R . (eshell-pred-file-mode 0004)) ; world-readable
85    (?W . (eshell-pred-file-mode 0002)) ; world-writable
86    (?X . (eshell-pred-file-mode 0001)) ; world-executable
87    (?s . (eshell-pred-file-mode 4000)) ; setuid
88    (?S . (eshell-pred-file-mode 2000)) ; setgid
89    (?t . (eshell-pred-file-mode 1000)) ; sticky bit
90    (?U . '(lambda (file)               ; owned by effective uid
91	     (if (file-exists-p file)
92		 (= (nth 2 (file-attributes file)) (user-uid)))))
93;;; (?G . '(lambda (file)               ; owned by effective gid
94;;;          (if (file-exists-p file)
95;;;              (= (nth 2 (file-attributes file)) (user-uid)))))
96    (?* . '(lambda (file)
97	     (and (file-regular-p file)
98		  (not (file-symlink-p file))
99		  (file-executable-p file))))
100    (?l . (eshell-pred-file-links))
101    (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
102    (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
103    (?a . (eshell-pred-file-time ?a "access" 4))
104    (?m . (eshell-pred-file-time ?m "modification" 5))
105    (?c . (eshell-pred-file-time ?c "change" 6))
106    (?L . (eshell-pred-file-size)))
107  "*A list of predicates than can be applied to a globbing pattern.
108The format of each entry is
109
110  (CHAR . PREDICATE-FUNC-SEXP)"
111  :type '(repeat (cons character sexp))
112  :group 'eshell-pred)
113
114(put 'eshell-predicate-alist 'risky-local-variable t)
115
116(defcustom eshell-modifier-alist
117  '((?E . '(lambda (lst)
118	     (mapcar
119	      (function
120	       (lambda (str)
121		 (eshell-stringify
122		  (car (eshell-parse-argument str))))) lst)))
123    (?L . '(lambda (lst)
124	     (mapcar 'downcase lst)))
125    (?U . '(lambda (lst)
126	     (mapcar 'upcase lst)))
127    (?C . '(lambda (lst)
128	     (mapcar 'capitalize lst)))
129    (?h . '(lambda (lst)
130	     (mapcar 'file-name-directory lst)))
131    (?i . (eshell-include-members))
132    (?x . (eshell-include-members t))
133    (?r . '(lambda (lst)
134	     (mapcar 'file-name-sans-extension lst)))
135    (?e . '(lambda (lst)
136	     (mapcar 'file-name-extension lst)))
137    (?t . '(lambda (lst)
138	     (mapcar 'file-name-nondirectory lst)))
139    (?q . '(lambda (lst)
140	     (mapcar 'eshell-escape-arg lst)))
141    (?u . '(lambda (lst)
142	     (eshell-uniqify-list lst)))
143    (?o . '(lambda (lst)
144	     (sort lst 'string-lessp)))
145    (?O . '(lambda (lst)
146	     (nreverse (sort lst 'string-lessp))))
147    (?j . (eshell-join-members))
148    (?S . (eshell-split-members))
149    (?R . 'reverse)
150    (?g . (progn
151	    (forward-char)
152	    (if (eq (char-before) ?s)
153		(eshell-pred-substitute t)
154	      (error "`g' modifier cannot be used alone"))))
155    (?s . (eshell-pred-substitute)))
156  "*A list of modifiers than can be applied to an argument expansion.
157The format of each entry is
158
159  (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
160  :type '(repeat (cons character sexp))
161  :group 'eshell-pred)
162
163(put 'eshell-modifier-alist 'risky-local-variable t)
164
165(defvar eshell-predicate-help-string
166  "Eshell predicate quick reference:
167
168  -  follow symbolic references for predicates after the `-'
169  ^  invert sense of predicates after the `^'
170
171FILE TYPE:
172  /  directories              s  sockets
173  .  regular files            p  named pipes
174  *  executable (files only)  @  symbolic links
175
176  %x  file type == `x' (as by ls -l; so `c' = char device, etc.)
177
178PERMISSION BITS (for owner/group/world):
179  r/A/R  readable    s  setuid
180  w/I/W  writable    S  setgid
181  x/E/X  executable  t  sticky bit
182
183OWNERSHIP:
184  U               owned by effective uid
185  u(UID|'user')   owned by UID/user
186  g(GID|'group')  owned by GID/group
187
188FILE ATTRIBUTES:
189  l[+-]N                 +/-/= N links
190  a[Mwhms][+-](N|'FILE') access time +/-/= N mnths/weeks/hours/mins/secs
191			 (days if unspecified) if FILE specified,
192			 use as comparison basis; so a+'file.c'
193			 shows files accessed before file.c was
194			 last accessed
195  m[Mwhms][+-](N|'FILE') modification time...
196  c[Mwhms][+-](N|'FILE') change time...
197  L[kmp][+-]N            file size +/-/= N Kb/Mb/blocks
198
199EXAMPLES:
200  *(^@)         all non-dot files which are not symlinks
201  .#*(^@)       all files which are not symbolic links
202  **/.#*(*)     all executable files, searched recursively
203  ***/*~f*(-/)  recursively (though not traversing symlinks),
204		find all directories (or symlinks referring to
205		directories) whose names do not begin with f.
206  e*(*Lk+50)    executables 50k or larger beginning with 'e'")
207
208(defvar eshell-modifier-help-string
209  "Eshell modifier quick reference:
210
211FOR SINGLE ARGUMENTS, or each argument of a list of strings:
212  E  evaluate again
213  L  lowercase
214  U  uppercase
215  C  capitalize
216  h  dirname
217  t  basename
218  e  file extension
219  r  strip file extension
220  q  escape special characters
221
222  S       split string at any whitespace character
223  S/PAT/  split string at each occurrence of PAT
224
225FOR LISTS OF ARGUMENTS:
226  o  sort alphabetically
227  O  reverse sort alphabetically
228  u  uniq list (typically used after :o or :O)
229  R  reverse list
230
231  j       join list members, separated by a space
232  j/PAT/  join list members, separated by PAT
233  i/PAT/  exclude all members not matching PAT
234  x/PAT/  exclude all members matching PAT
235
236  s/pat/match/  substitute PAT with MATCH
237  g/pat/match/  substitute PAT with MATCH for all occurrences
238
239EXAMPLES:
240  *.c(:o)  sorted list of .c files")
241
242;;; Functions:
243
244(defun eshell-display-predicate-help ()
245  (interactive)
246  (with-electric-help
247   (function
248    (lambda ()
249      (insert eshell-predicate-help-string)))))
250
251(defun eshell-display-modifier-help ()
252  (interactive)
253  (with-electric-help
254   (function
255    (lambda ()
256      (insert eshell-modifier-help-string)))))
257
258(defun eshell-pred-initialize ()
259  "Initialize the predicate/modifier code."
260  (add-hook 'eshell-parse-argument-hook
261	    'eshell-parse-arg-modifier t t)
262  (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
263  (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
264
265(defun eshell-apply-modifiers (lst predicates modifiers)
266  "Apply to LIST a series of PREDICATES and MODIFIERS."
267  (let (stringified)
268    (if (stringp lst)
269	(setq lst (list lst)
270	      stringified t))
271    (when (listp lst)
272      (setq lst (eshell-winnow-list lst nil predicates))
273      (while modifiers
274	(setq lst (funcall (car modifiers) lst)
275	      modifiers (cdr modifiers)))
276      (if (and stringified
277	       (= (length lst) 1))
278	  (car lst)
279	lst))))
280
281(defun eshell-parse-arg-modifier ()
282  "Parse a modifier that has been specified after an argument.
283This function is specially for adding onto `eshell-parse-argument-hook'."
284  (when (eq (char-after) ?\()
285    (forward-char)
286    (let ((end (eshell-find-delimiter ?\( ?\))))
287      (if (not end)
288	  (throw 'eshell-incomplete ?\()
289	(when (eshell-arg-delimiter (1+ end))
290	  (save-restriction
291	    (narrow-to-region (point) end)
292	    (let* ((modifiers (eshell-parse-modifiers))
293		   (preds (car modifiers))
294		   (mods (cdr modifiers)))
295	      (if (or preds mods)
296		  ;; has to go at the end, which is only natural since
297		  ;; syntactically it can only occur at the end
298		  (setq eshell-current-modifiers
299			(append
300			 eshell-current-modifiers
301			 (list
302			  `(lambda (lst)
303			     (eshell-apply-modifiers
304			      lst (quote ,preds) (quote ,mods)))))))))
305	  (goto-char (1+ end))
306	  (eshell-finish-arg))))))
307
308(defun eshell-parse-modifiers ()
309  "Parse value modifiers and predicates at point.
310If ALLOW-PREDS is non-nil, predicates will be parsed as well.
311Return a cons cell of the form
312
313  (PRED-FUNC-LIST . MOD-FUNC-LIST)
314
315NEW-STRING is STRING minus any modifiers.  PRED-FUNC-LIST is a list of
316predicate functions.  MOD-FUNC-LIST is a list of result modifier
317functions.  PRED-FUNCS take a filename and return t if the test
318succeeds; MOD-FUNCS take any string and preform a modification,
319returning the resultant string."
320  (let (result negate follow preds mods)
321    (condition-case err
322	(while (not (eobp))
323	  (let ((char (char-after)))
324	    (cond
325	     ((eq char ?')
326	      (forward-char)
327	      (if (looking-at "[^|':]")
328		  (let ((func (read (current-buffer))))
329		    (if (and func (functionp func))
330			(setq preds (eshell-add-pred-func func preds
331							  negate follow))
332		      (error "Invalid function predicate '%s'"
333			     (eshell-stringify func))))
334		(error "Invalid function predicate")))
335	     ((eq char ?^)
336	      (forward-char)
337	      (setq negate (not negate)))
338	     ((eq char ?-)
339	      (forward-char)
340	      (setq follow (not follow)))
341	     ((eq char ?|)
342	      (forward-char)
343	      (if (looking-at "[^|':]")
344		  (let ((func (read (current-buffer))))
345		    (if (and func (functionp func))
346			(setq mods
347			      (cons `(lambda (lst)
348				       (mapcar (function ,func) lst))
349				    mods))
350		      (error "Invalid function modifier '%s'"
351			     (eshell-stringify func))))
352		(error "Invalid function modifier")))
353	     ((eq char ?:)
354	      (forward-char)
355	      (let ((mod (assq (char-after) eshell-modifier-alist)))
356		(if (not mod)
357		    (error "Unknown modifier character '%c'" (char-after))
358		  (forward-char)
359		  (setq mods (cons (eval (cdr mod)) mods)))))
360	     (t
361	      (let ((pred (assq char eshell-predicate-alist)))
362		(if (not pred)
363		    (error "Unknown predicate character '%c'" char)
364		  (forward-char)
365		  (setq preds
366			(eshell-add-pred-func (eval (cdr pred)) preds
367					      negate follow))))))))
368      (end-of-buffer
369       (error "Predicate or modifier ended prematurely")))
370    (cons (nreverse preds) (nreverse mods))))
371
372(defun eshell-add-pred-func (pred funcs negate follow)
373  "Add the predicate function PRED to FUNCS."
374  (if negate
375      (setq pred `(lambda (file)
376		    (not (funcall ,pred file)))))
377  (if follow
378      (setq pred `(lambda (file)
379		    (funcall ,pred (file-truename file)))))
380  (cons pred funcs))
381
382(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
383  "Return a predicate to test whether a file match a given user/group id."
384  (let (ugid open close end)
385    (if (looking-at "[0-9]+")
386	(progn
387	  (setq ugid (string-to-number (match-string 0)))
388	  (goto-char (match-end 0)))
389      (setq open (char-after))
390      (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
391	  (setq close (car (last '(?\) ?\] ?\> ?\})
392				 (length close))))
393	(setq close open))
394      (forward-char)
395      (setq end (eshell-find-delimiter open close))
396      (unless end
397	(error "Malformed %s name string for modifier `%c'"
398	       mod-type mod-char))
399      (setq ugid
400	    (funcall get-id-func (buffer-substring (point) end)))
401      (goto-char (1+ end)))
402    (unless ugid
403      (error "Unknown %s name specified for modifier `%c'"
404	     mod-type mod-char))
405    `(lambda (file)
406       (let ((attrs (file-attributes file)))
407	 (if attrs
408	     (= (nth ,attr-index attrs) ,ugid))))))
409
410(defun eshell-pred-file-time (mod-char mod-type attr-index)
411  "Return a predicate to test whether a file matches a certain time."
412  (let* ((quantum 86400)
413	 qual amount when open close end)
414    (when (memq (char-after) '(?M ?w ?h ?m ?s))
415      (setq quantum (char-after))
416      (cond
417       ((eq quantum ?M)
418	(setq quantum (* 60 60 24 30)))
419       ((eq quantum ?w)
420	(setq quantum (* 60 60 24 7)))
421       ((eq quantum ?h)
422	(setq quantum (* 60 60)))
423       ((eq quantum ?m)
424	(setq quantum 60))
425       ((eq quantum ?s)
426	(setq quantum 1)))
427      (forward-char))
428    (when (memq (char-after) '(?+ ?-))
429      (setq qual (char-after))
430      (forward-char))
431    (if (looking-at "[0-9]+")
432	(progn
433	  (setq when (- (eshell-time-to-seconds (current-time))
434			(* (string-to-number (match-string 0))
435			   quantum)))
436	  (goto-char (match-end 0)))
437      (setq open (char-after))
438      (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
439	  (setq close (car (last '(?\) ?\] ?\> ?\})
440				 (length close))))
441	(setq close open))
442      (forward-char)
443      (setq end (eshell-find-delimiter open close))
444      (unless end
445	(error "Malformed %s time modifier `%c'" mod-type mod-char))
446      (let* ((file (buffer-substring (point) end))
447	     (attrs (file-attributes file)))
448	(unless attrs
449	  (error "Cannot stat file `%s'" file))
450	(setq when (eshell-time-to-seconds (nth attr-index attrs))))
451      (goto-char (1+ end)))
452    `(lambda (file)
453       (let ((attrs (file-attributes file)))
454	 (if attrs
455	     (,(if (eq qual ?-)
456		   '<
457		 (if (eq qual ?+)
458		     '>
459		   '=)) ,when (eshell-time-to-seconds
460			       (nth ,attr-index attrs))))))))
461
462(defun eshell-pred-file-type (type)
463  "Return a test which tests that the file is of a certain TYPE.
464TYPE must be a character, and should be one of the possible options
465that 'ls -l' will show in the first column of its display. "
466  (when (eq type ?%)
467    (setq type (char-after))
468    (if (memq type '(?b ?c))
469	(forward-char)
470      (setq type ?%)))
471  `(lambda (file)
472     (let ((attrs (eshell-file-attributes (directory-file-name file))))
473       (if attrs
474	   (memq (aref (nth 8 attrs) 0)
475		 ,(if (eq type ?%)
476		      '(?b ?c)
477		    (list 'quote (list type))))))))
478
479(defsubst eshell-pred-file-mode (mode)
480  "Return a test which tests that MODE pertains to the file."
481  `(lambda (file)
482     (let ((modes (file-modes file)))
483       (if modes
484	   (logand ,mode modes)))))
485
486(defun eshell-pred-file-links ()
487  "Return a predicate to test whether a file has a given number of links."
488  (let (qual amount)
489    (when (memq (char-after) '(?- ?+))
490      (setq qual (char-after))
491      (forward-char))
492    (unless (looking-at "[0-9]+")
493      (error "Invalid file link count modifier `l'"))
494    (setq amount (string-to-number (match-string 0)))
495    (goto-char (match-end 0))
496    `(lambda (file)
497       (let ((attrs (eshell-file-attributes file)))
498	 (if attrs
499	     (,(if (eq qual ?-)
500		   '<
501		 (if (eq qual ?+)
502		     '>
503		   '=)) (nth 1 attrs) ,amount))))))
504
505(defun eshell-pred-file-size ()
506  "Return a predicate to test whether a file is of a given size."
507  (let ((quantum 1) qual amount)
508    (when (memq (downcase (char-after)) '(?k ?m ?p))
509      (setq qual (downcase (char-after)))
510      (cond
511       ((eq qual ?k)
512	(setq quantum 1024))
513       ((eq qual ?m)
514	(setq quantum (* 1024 1024)))
515       ((eq qual ?p)
516	(setq quantum 512)))
517      (forward-char))
518    (when (memq (char-after) '(?- ?+))
519      (setq qual (char-after))
520      (forward-char))
521    (unless (looking-at "[0-9]+")
522      (error "Invalid file size modifier `L'"))
523    (setq amount (* (string-to-number (match-string 0)) quantum))
524    (goto-char (match-end 0))
525    `(lambda (file)
526       (let ((attrs (eshell-file-attributes file)))
527	 (if attrs
528	     (,(if (eq qual ?-)
529		   '<
530		 (if (eq qual ?+)
531		     '>
532		   '=)) (nth 7 attrs) ,amount))))))
533
534(defun eshell-pred-substitute (&optional repeat)
535  "Return a modifier function that will substitute matches."
536  (let ((delim (char-after))
537	match replace end)
538    (forward-char)
539    (setq end (eshell-find-delimiter delim delim nil nil t)
540	  match (buffer-substring-no-properties (point) end))
541    (goto-char (1+ end))
542    (setq end (eshell-find-delimiter delim delim nil nil t)
543	  replace (buffer-substring-no-properties (point) end))
544    (goto-char (1+ end))
545    (if repeat
546	`(lambda (lst)
547	   (mapcar
548	    (function
549	     (lambda (str)
550	       (let ((i 0))
551		 (while (setq i (string-match ,match str i))
552		   (setq str (replace-match ,replace t nil str))))
553	       str)) lst))
554      `(lambda (lst)
555	 (mapcar
556	  (function
557	   (lambda (str)
558	     (if (string-match ,match str)
559		 (setq str (replace-match ,replace t nil str)))
560	     str)) lst)))))
561
562(defun eshell-include-members (&optional invert-p)
563  "Include only lisp members matching a regexp."
564  (let ((delim (char-after))
565	regexp end)
566    (forward-char)
567    (setq end (eshell-find-delimiter delim delim nil nil t)
568	  regexp (buffer-substring-no-properties (point) end))
569    (goto-char (1+ end))
570    `(lambda (lst)
571       (eshell-winnow-list
572	lst nil '((lambda (elem)
573		    ,(if invert-p
574			 `(not (string-match ,regexp elem))
575		       `(string-match ,regexp elem))))))))
576
577(defun eshell-join-members ()
578  "Return a modifier function that join matches."
579  (let ((delim (char-after))
580	str end)
581    (if (not (memq delim '(?' ?/)))
582	(setq delim " ")
583      (forward-char)
584      (setq end (eshell-find-delimiter delim delim nil nil t)
585	    str (buffer-substring-no-properties (point) end))
586      (goto-char (1+ end)))
587    `(lambda (lst)
588       (mapconcat 'identity lst ,str))))
589
590(defun eshell-split-members ()
591  "Return a modifier function that splits members."
592  (let ((delim (char-after))
593	sep end)
594    (when (memq delim '(?' ?/))
595      (forward-char)
596      (setq end (eshell-find-delimiter delim delim nil nil t)
597	    sep (buffer-substring-no-properties (point) end))
598      (goto-char (1+ end)))
599    `(lambda (lst)
600       (mapcar
601	(function
602	 (lambda (str)
603	   (split-string str ,sep))) lst))))
604
605;;; arch-tag: 8b5ce022-17f3-4c40-93c7-5faafaa63f31
606;;; em-pred.el ends here
607