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