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