Mercurial > emacs
diff lisp/eshell/em-pred.el @ 29876:edfec1c0d511
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Fri, 23 Jun 2000 05:24:10 +0000 |
parents | |
children | 34b1ab9d583d |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/eshell/em-pred.el Fri Jun 23 05:24:10 2000 +0000 @@ -0,0 +1,602 @@ +;;; em-pred --- argument predicates and modifiers (ala zsh) + +;; Copyright (C) 1999, 2000 Free Sofware Foundation + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +(provide 'em-pred) + +(eval-when-compile (require 'esh-maint)) + +(defgroup eshell-pred nil + "This module allows for predicates to be applied to globbing +patterns (similar to zsh), in addition to string modifiers which can +be applied either to globbing results, variable references, or just +ordinary strings." + :tag "Value modifiers and predicates" + :group 'eshell-module) + +;;; Commentary: + +;; Argument predication is used to affect which members of a list are +;; selected for use as argument. This is most useful with globbing, +;; but can be used on any list argument, to select certain members. +;; +;; Argument modifiers are used to manipulate argument values. For +;; example, sorting lists, upcasing words, substituting characters, +;; etc. +;; +;; Here are some examples of how to use argument predication. Most of +;; the predicates and modifiers are modeled after those provided by +;; zsh. +;; +;; ls -ld *(/) ; list all directories +;; ls -l *(@u'johnw') ; list all symlinks owned by 'johnw' +;; bzip2 -9v **/*(a+30) ; compress everything which hasn't been +;; accessed in 30 days +;; echo *.c(:o:R) ; a reversed, sorted list of C files +;; *(^@:U^u0) ; all non-symlinks not owned by 'root', upcased +;; chmod u-x *(U*) : remove exec bit on all executables owned by user +;; +;; See the zsh docs for more on the syntax ([(zsh.info)Filename +;; Generation]). + +;;; User Variables: + +(defcustom eshell-pred-load-hook '(eshell-pred-initialize) + "*A list of functions to run when `eshell-pred' is loaded." + :type 'hook + :group 'eshell-pred) + +(defcustom eshell-predicate-alist + '((?/ . (eshell-pred-file-type ?d)) ; directories + (?. . (eshell-pred-file-type ?-)) ; regular files + (?s . (eshell-pred-file-type ?s)) ; sockets + (?p . (eshell-pred-file-type ?p)) ; named pipes + (?@ . (eshell-pred-file-type ?l)) ; symbolic links + (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.) + (?r . (eshell-pred-file-mode 0400)) ; owner-readable + (?w . (eshell-pred-file-mode 0200)) ; owner-writable + (?x . (eshell-pred-file-mode 0100)) ; owner-executable + (?A . (eshell-pred-file-mode 0040)) ; group-readable + (?I . (eshell-pred-file-mode 0020)) ; group-writable + (?E . (eshell-pred-file-mode 0010)) ; group-executable + (?R . (eshell-pred-file-mode 0004)) ; world-readable + (?W . (eshell-pred-file-mode 0002)) ; world-writable + (?X . (eshell-pred-file-mode 0001)) ; world-executable + (?s . (eshell-pred-file-mode 4000)) ; setuid + (?S . (eshell-pred-file-mode 2000)) ; setgid + (?t . (eshell-pred-file-mode 1000)) ; sticky bit + (?U . '(lambda (file) ; owned by effective uid + (if (file-exists-p file) + (= (nth 2 (file-attributes file)) (user-uid))))) +;;; (?G . '(lambda (file) ; owned by effective gid +;;; (if (file-exists-p file) +;;; (= (nth 2 (file-attributes file)) (user-uid))))) + (?* . '(lambda (file) + (and (file-regular-p file) + (not (file-symlink-p file)) + (file-executable-p file)))) + (?l . (eshell-pred-file-links)) + (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id)) + (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id)) + (?a . (eshell-pred-file-time ?a "access" 4)) + (?m . (eshell-pred-file-time ?m "modification" 5)) + (?c . (eshell-pred-file-time ?c "change" 6)) + (?L . (eshell-pred-file-size))) + "*A list of predicates than can be applied to a globbing pattern. +The format of each entry is + + (CHAR . PREDICATE-FUNC-SEXP)" + :type '(repeat (cons character sexp)) + :group 'eshell-pred) + +(put 'eshell-predicate-alist 'risky-local-variable t) + +(defcustom eshell-modifier-alist + '((?e . '(lambda (lst) + (mapcar + (function + (lambda (str) + (eshell-stringify + (car (eshell-parse-argument str))))) lst))) + (?L . '(lambda (lst) + (mapcar 'downcase lst))) + (?U . '(lambda (lst) + (mapcar 'upcase lst))) + (?C . '(lambda (lst) + (mapcar 'capitalize lst))) + (?h . '(lambda (lst) + (mapcar 'file-name-directory lst))) + (?i . (eshell-include-members)) + (?x . (eshell-include-members t)) + (?r . '(lambda (lst) + (mapcar 'file-name-sans-extension lst))) + (?e . '(lambda (lst) + (mapcar 'file-name-extension lst))) + (?t . '(lambda (lst) + (mapcar 'file-name-nondirectory lst))) + (?q . '(lambda (lst) + (mapcar 'eshell-escape-arg lst))) + (?u . '(lambda (lst) + (eshell-uniqify-list lst))) + (?o . '(lambda (lst) + (sort lst 'string-lessp))) + (?O . '(lambda (lst) + (nreverse (sort lst 'string-lessp)))) + (?j . (eshell-join-members)) + (?S . (eshell-split-members)) + (?R . 'reverse) + (?g . (progn + (forward-char) + (if (eq (char-before) ?s) + (eshell-pred-substitute t) + (error "`g' modifier cannot be used alone")))) + (?s . (eshell-pred-substitute))) + "*A list of modifiers than can be applied to an argument expansion. +The format of each entry is + + (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)" + :type '(repeat (cons character sexp)) + :group 'eshell-pred) + +(put 'eshell-modifier-alist 'risky-local-variable t) + +(defvar eshell-predicate-help-string + "Eshell predicate quick reference: + + - follow symbolic references for predicates after the `-' + ^ invert sense of predicates after the `^' + +FILE TYPE: + / directories s sockets + . regular files p named pipes + * executable (files only) @ symbolic links + + %x file type == `x' (as by ls -l; so `c' = char device, etc.) + +PERMISSION BITS (for owner/group/world): + r/A/R readable s setuid + w/I/W writable S setgid + x/E/X executable t sticky bit + +OWNERSHIP: + U owned by effective uid + u(UID|'user') owned by UID/user + g(GID|'group') owned by GID/group + +FILE ATTRIBUTES: + l[+-]N +/-/= N links + a[Mwhm][+-](N|'FILE') access time +/-/= N mnths/weeks/days/mins + if FILE specified, use as comparison basis; + so a+'file.c' shows files accessed before + file.c was last accessed + m[Mwhm][+-](N|'FILE') modification time... + c[Mwhm][+-](N|'FILE') change time... + L[kmp][+-]N file size +/-/= N Kb/Mb/blocks + +EXAMPLES: + *(^@) all non-dot files which are not symlinks + .#*(^@) all files which are not symbolic links + **/.#*(*) all executable files, searched recursively + ***/*~f*(-/) recursively (though not traversing symlinks), + find all directories (or symlinks referring to + directories) whose names do not begin with f. + e*(*Lk+50) executables 50k or larger beginning with 'e'") + +(defvar eshell-modifier-help-string + "Eshell modifier quick reference: + +FOR SINGLE ARGUMENTS, or each argument of a list of strings: + e evaluate again + L lowercase + U uppercase + C capitalize + h dirname + t basename + e file extension + r strip file extension + q escape special characters + + S split string at any whitespace character + S/PAT/ split string at each occurance of PAT + +FOR LISTS OF ARGUMENTS: + o sort alphabetically + O reverse sort alphabetically + u uniq list (typically used after :o or :O) + R reverse list + + j join list members, separated by a space + j/PAT/ join list members, separated by PAT + i/PAT/ exclude all members not matching PAT + x/PAT/ exclude all members matching PAT + + s/pat/match/ substitute PAT with MATCH + g/pat/match/ substitute PAT with MATCH for all occurances + +EXAMPLES: + *.c(:o) sorted list of .c files") + +;;; Functions: + +(defun eshell-display-predicate-help () + (interactive) + (with-electric-help + (function + (lambda () + (insert eshell-predicate-help-string))))) + +(defun eshell-display-modifier-help () + (interactive) + (with-electric-help + (function + (lambda () + (insert eshell-modifier-help-string))))) + +(defun eshell-pred-initialize () + "Initialize the predicate/modifier code." + (make-local-hook 'eshell-parse-argument-hook) + (add-hook 'eshell-parse-argument-hook + 'eshell-parse-arg-modifier t t) + (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help) + (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help)) + +(defun eshell-apply-modifiers (lst predicates modifiers) + "Apply to LIST a series of PREDICATES and MODIFIERS." + (let (stringified) + (if (stringp lst) + (setq lst (list lst) + stringified t)) + (when (listp lst) + (setq lst (eshell-winnow-list lst nil predicates)) + (while modifiers + (setq lst (funcall (car modifiers) lst) + modifiers (cdr modifiers))) + (if (and stringified + (= (length lst) 1)) + (car lst) + lst)))) + +(defun eshell-parse-arg-modifier () + "Parse a modifier that has been specified after an argument. +This function is specially for adding onto `eshell-parse-argument-hook'." + (when (eq (char-after) ?\() + (forward-char) + (let ((end (eshell-find-delimiter ?\( ?\)))) + (if (not end) + (throw 'eshell-incomplete ?\() + (when (eshell-arg-delimiter (1+ end)) + (save-restriction + (narrow-to-region (point) end) + (let* ((modifiers (eshell-parse-modifiers)) + (preds (car modifiers)) + (mods (cdr modifiers))) + (if (or preds mods) + ;; has to go at the end, which is only natural since + ;; syntactically it can only occur at the end + (setq eshell-current-modifiers + (append + eshell-current-modifiers + (list + `(lambda (lst) + (eshell-apply-modifiers + lst (quote ,preds) (quote ,mods))))))))) + (goto-char (1+ end)) + (eshell-finish-arg)))))) + +(defun eshell-parse-modifiers () + "Parse value modifiers and predicates at point. +If ALLOW-PREDS is non-nil, predicates will be parsed as well. +Return a cons cell of the form + + (PRED-FUNC-LIST . MOD-FUNC-LIST) + +NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of +predicate functions. MOD-FUNC-LIST is a list of result modifier +functions. PRED-FUNCS take a filename and return t if the test +succeeds; MOD-FUNCS take any string and preform a modification, +returning the resultant string." + (let (result negate follow preds mods) + (condition-case err + (while (not (eobp)) + (let ((char (char-after))) + (cond + ((eq char ?') + (forward-char) + (if (looking-at "[^|':]") + (let ((func (read (current-buffer)))) + (if (and func (functionp func)) + (setq preds (eshell-add-pred-func func preds + negate follow)) + (error "Invalid function predicate '%s'" + (eshell-stringify func)))) + (error "Invalid function predicate"))) + ((eq char ?^) + (forward-char) + (setq negate (not negate))) + ((eq char ?-) + (forward-char) + (setq follow (not follow))) + ((eq char ?|) + (forward-char) + (if (looking-at "[^|':]") + (let ((func (read (current-buffer)))) + (if (and func (functionp func)) + (setq mods + (cons `(lambda (lst) + (mapcar (function ,func) lst)) + mods)) + (error "Invalid function modifier '%s'" + (eshell-stringify func)))) + (error "Invalid function modifier"))) + ((eq char ?:) + (forward-char) + (let ((mod (assq (char-after) eshell-modifier-alist))) + (if (not mod) + (error "Unknown modifier character '%c'" (char-after)) + (forward-char) + (setq mods (cons (eval (cdr mod)) mods))))) + (t + (let ((pred (assq char eshell-predicate-alist))) + (if (not pred) + (error "Unknown predicate character '%c'" char) + (forward-char) + (setq preds + (eshell-add-pred-func (eval (cdr pred)) preds + negate follow)))))))) + (end-of-buffer + (error "Predicate or modifier ended prematurely"))) + (cons (nreverse preds) (nreverse mods)))) + +(defun eshell-add-pred-func (pred funcs negate follow) + "Add the predicate function PRED to FUNCS." + (if negate + (setq pred `(lambda (file) + (not (funcall ,pred file))))) + (if follow + (setq pred `(lambda (file) + (funcall ,pred (file-truename file))))) + (cons pred funcs)) + +(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func) + "Return a predicate to test whether a file match a given user/group id." + (let (ugid open close end) + (if (looking-at "[0-9]+") + (progn + (setq ugid (string-to-number (match-string 0))) + (goto-char (match-end 0))) + (setq open (char-after)) + (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) + (setq close (car (last '(?\) ?\] ?\> ?\}) + (length close)))) + (setq close open)) + (forward-char) + (setq end (eshell-find-delimiter open close)) + (unless end + (error "Malformed %s name string for modifier `%c'" + mod-type mod-char)) + (setq ugid + (funcall get-id-func (buffer-substring (point) end))) + (goto-char (1+ end))) + (unless ugid + (error "Unknown %s name specified for modifier `%c'" + mod-type mod-char)) + `(lambda (file) + (let ((attrs (file-attributes file))) + (if attrs + (= (nth ,attr-index attrs) ,ugid)))))) + +(defun eshell-pred-file-time (mod-char mod-type attr-index) + "Return a predicate to test whether a file matches a certain time." + (let* ((quantum 86400) + qual amount when open close end) + (when (memq (char-after) '(?M ?w ?h ?m)) + (setq quantum (char-after)) + (cond + ((eq quantum ?M) + (setq quantum (* 60 60 24 30))) + ((eq quantum ?w) + (setq quantum (* 60 60 24 7))) + ((eq quantum ?h) + (setq quantum (* 60 60))) + ((eq quantum ?m) + (setq quantum 60)) + ((eq quantum ?s) + (setq quantum 1))) + (forward-char)) + (when (memq (char-after) '(?+ ?-)) + (setq qual (char-after)) + (forward-char)) + (if (looking-at "[0-9]+") + (progn + (setq when (- (eshell-time-to-seconds (current-time)) + (* (string-to-number (match-string 0)) + quantum))) + (goto-char (match-end 0))) + (setq open (char-after)) + (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) + (setq close (car (last '(?\) ?\] ?\> ?\}) + (length close)))) + (setq close open)) + (forward-char) + (setq end (eshell-find-delimiter open close)) + (unless end + (error "Malformed %s time modifier `%c'" mod-type mod-char)) + (let* ((file (buffer-substring (point) end)) + (attrs (file-attributes file))) + (unless attrs + (error "Cannot stat file `%s'" file)) + (setq when (eshell-time-to-seconds (nth attr-index attrs)))) + (goto-char (1+ end))) + `(lambda (file) + (let ((attrs (file-attributes file))) + (if attrs + (,(if (eq qual ?-) + '< + (if (eq qual ?+) + '> + '=)) ,when (eshell-time-to-seconds + (nth ,attr-index attrs)))))))) + +(defun eshell-pred-file-type (type) + "Return a test which tests that the file is of a certain TYPE. +TYPE must be a character, and should be one of the possible options +that 'ls -l' will show in the first column of its display. " + (when (eq type ?%) + (setq type (char-after)) + (if (memq type '(?b ?c)) + (forward-char) + (setq type ?%))) + `(lambda (file) + (let ((attrs (file-attributes (directory-file-name file)))) + (if attrs + (memq (aref (nth 8 attrs) 0) + ,(if (eq type ?%) + '(?b ?c) + (list 'quote (list type)))))))) + +(defsubst eshell-pred-file-mode (mode) + "Return a test which tests that MODE pertains to the file." + `(lambda (file) + (let ((modes (file-modes file))) + (if modes + (logand ,mode modes))))) + +(defun eshell-pred-file-links () + "Return a predicate to test whether a file has a given number of links." + (let (qual amount) + (when (memq (char-after) '(?- ?+)) + (setq qual (char-after)) + (forward-char)) + (unless (looking-at "[0-9]+") + (error "Invalid file link count modifier `l'")) + (setq amount (string-to-number (match-string 0))) + (goto-char (match-end 0)) + `(lambda (file) + (let ((attrs (file-attributes file))) + (if attrs + (,(if (eq qual ?-) + '< + (if (eq qual ?+) + '> + '=)) (nth 1 attrs) ,amount)))))) + +(defun eshell-pred-file-size () + "Return a predicate to test whether a file is of a given size." + (let ((quantum 1) qual amount) + (when (memq (downcase (char-after)) '(?k ?m ?p)) + (setq qual (downcase (char-after))) + (cond + ((eq qual ?k) + (setq quantum 1024)) + ((eq qual ?m) + (setq quantum (* 1024 1024))) + ((eq qual ?p) + (setq quantum 512))) + (forward-char)) + (when (memq (char-after) '(?- ?+)) + (setq qual (char-after)) + (forward-char)) + (unless (looking-at "[0-9]+") + (error "Invalid file size modifier `L'")) + (setq amount (* (string-to-number (match-string 0)) quantum)) + (goto-char (match-end 0)) + `(lambda (file) + (let ((attrs (file-attributes file))) + (if attrs + (,(if (eq qual ?-) + '< + (if (eq qual ?+) + '> + '=)) (nth 7 attrs) ,amount)))))) + +(defun eshell-pred-substitute (&optional repeat) + "Return a modifier function that will substitute matches." + (let ((delim (char-after)) + match replace end) + (forward-char) + (setq end (eshell-find-delimiter delim delim nil nil t) + match (buffer-substring-no-properties (point) end)) + (goto-char (1+ end)) + (setq end (eshell-find-delimiter delim delim nil nil t) + replace (buffer-substring-no-properties (point) end)) + (goto-char (1+ end)) + (if repeat + `(lambda (lst) + (mapcar + (function + (lambda (str) + (let ((i 0)) + (while (setq i (string-match ,match str i)) + (setq str (replace-match ,replace t nil str)))) + str)) lst)) + `(lambda (lst) + (mapcar + (function + (lambda (str) + (if (string-match ,match str) + (setq str (replace-match ,replace t nil str))) + str)) lst))))) + +(defun eshell-include-members (&optional invert-p) + "Include only lisp members matching a regexp." + (let ((delim (char-after)) + regexp end) + (forward-char) + (setq end (eshell-find-delimiter delim delim nil nil t) + regexp (buffer-substring-no-properties (point) end)) + (goto-char (1+ end)) + `(lambda (lst) + (eshell-winnow-list + lst nil '((lambda (elem) + ,(if invert-p + `(not (string-match ,regexp elem)) + `(string-match ,regexp elem)))))))) + +(defun eshell-join-members () + "Return a modifier function that join matches." + (let ((delim (char-after)) + str end) + (if (not (memq delim '(?' ?/))) + (setq delim " ") + (forward-char) + (setq end (eshell-find-delimiter delim delim nil nil t) + str (buffer-substring-no-properties (point) end)) + (goto-char (1+ end))) + `(lambda (lst) + (mapconcat 'identity lst ,str)))) + +(defun eshell-split-members () + "Return a modifier function that splits members." + (let ((delim (char-after)) + sep end) + (when (memq delim '(?' ?/)) + (forward-char) + (setq end (eshell-find-delimiter delim delim nil nil t) + sep (buffer-substring-no-properties (point) end)) + (goto-char (1+ end))) + `(lambda (lst) + (mapcar + (function + (lambda (str) + (split-string str ,sep))) lst)))) + +;;; Code: + +;;; em-pred.el ends here