From 6dfcbe31b5d7f4880b020fd8d2323e3e5401c61d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 Apr 2008 06:09:32 +0000 Subject: [PATCH] New file. --- etc/NEWS | 2 + lisp/ChangeLog | 4 + lisp/find-cmd.el | 241 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 247 insertions(+) create mode 100644 lisp/find-cmd.el diff --git a/etc/NEWS b/etc/NEWS index 38fd4c55746..bb1f27fb7a8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1127,6 +1127,8 @@ forms to subroutines. * New Packages for Lisp Programming in Emacs 23.1 +** find-cmd.el can build `find' commands using lisp synax. + ** The package isearch-multi.el has been added. It implements a new mode `isearch-buffers-minor-mode' that allows isearch to search through multiple buffers. In this mode a new variable diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e61149e42e9..0aa685c3e5a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2008-04-29 Phil Jackson + + * find-cmd.el: New file. + 2008-04-29 Stefan Monnier * minibuffer.el (completion-hilit-commonality): Remove leftover code. diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el new file mode 100644 index 00000000000..e9780f94b3e --- /dev/null +++ b/lisp/find-cmd.el @@ -0,0 +1,241 @@ +;;; find-cmd.el --- Build a valid find(1) command with sexps + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Philip Jackson +;; Version: 0.6 + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; With this module you can build up a (hopefully) valid find(1) +;; string ready for the command line. For example: + +;; (find-cmd '(prune (name ".svn" ".git" ".CVS")) +;; '(and (or (name "*.pl" "*.pm" "*.t") +;; (mtime "+1")) +;; (fstype "nfs" "ufs")))) + +;; will become (un-wrapped): + +;; "find '/home/phil/' \\( \\( -name '.svn' -or -name '.git' -or +;; -name '.CVS' \\) -prune -or -true \\) \\( \\( \\( -name '*.pl' +;; -or -name '*.pm' -or -name '*.t' \\) -or -mtime '+1' \\) -and \\( +;; -fstype 'nfs' -or -fstype 'ufs' \\) \\)" + +(eval-when-compile (require 'cl)) + +(defconst find-constituents + '((and . find-and) + (not . find-not) + (or . find-or) + + (a . find-and) + (n . find-not) + (o . find-or) + + (prune . find-prune) + + ;; switches + (L . (0)) + (P . (0)) + (H . (0)) + + ;; generic tests + (amin . (1)) + (anewer . (1)) + (atime . (1)) + (cmin . (1)) + (cnewer . (1)) + (ctime . (1)) + (empty . (0)) + (false . (0)) + (fstype . (1)) + (gid . (1)) + (group . (1)) + (ilname . (1)) + (iname . (1)) + (inum . (1)) + (iwholename . (1)) + (iregex . (1)) + (links . (1)) + (lname . (1)) + (mmin . (1)) + (mtime . (1)) + (name . (1)) + (newer . (1)) + (nouser . (0)) + (nogroup . (0)) + (path . (1)) + (perm . (0)) + (regex . (1)) + (wholename . (1)) + (size . (1)) + (true . (0)) + (type . (1)) + (uid . (1)) + (used . (1)) + (user . (1)) + (xtype . (nil)) + + ;; normal options (always true) + (depth . (0)) + (maxdepth . (1)) + (mindepth . (1)) + (mount . (0)) + (noleaf . (0)) + (xdev . (0)) + (ignore_readdir_race . (0)) + (noignore_readdir_race . (0)) + + ;; actions + (delete . (0)) + (print0 . (0)) + (printf . (1)) + (fprintf . (2)) + (print . (0)) + (fprint0 . (1)) + (fprint . (1)) + (ls . (0)) + (fls . (1)) + (prune . (0)) + (quit . (0)) + + ;; these need to be terminated with a ; + (exec . (1 find-command t)) + (ok . (1 find-command t)) + (execdir . (1 find-command t)) + (okdir . (1 find-command t))) + "Holds details of each of the find options. The car of each +alist is the name. The cdr is minimum args, the function used +to join many occurences of the argument together, and whether or +not to leave quotes off the string (non-nil means the string will +be quoted).") + +;;;###autoload +(defun find-cmd (&rest subfinds) + "Initiate the building of a find command. For exmple: + +\(find-cmd '\(prune \(name \".svn\" \".git\" \".CVS\"\)\) + '\(and \(or \(name \"*.pl\" \"*.pm\" \"*.t\"\) + \(mtime \"+1\"\)\) + \(fstype \"nfs\" \"ufs\"\)\)\)\) + +`default-directory' is used as the initial search path. The +result is a string that should be ready for the command line." + (concat + "find " (shell-quote-argument (expand-file-name default-directory)) " " + (cond + ((cdr subfinds) + (mapconcat 'find-to-string subfinds "")) + (t + (find-to-string (car subfinds)))))) + +(defun find-and (form) + "And FORMs together, so: + \(and \(mtime \"+1\"\) \(name \"something\"\)\) +will produce: + find . \\\( -mtime '+1' -and -name 'something' \\\)" + (if (< (length form) 2) + (find-to-string (car form)) + (concat "\\( " + (mapconcat 'find-to-string form "-and ") + "\\) "))) + +(defun find-or (form) + "Or FORMs together, so: + \(or \(mtime \"+1\"\) \(name \"something\"\)\) +will produce: + find . \\\( -mtime '+1' -or -name 'something' \\\)" + (if (< (length form) 2) + (find-to-string (car form)) + (concat "\\( " + (mapconcat 'find-to-string form "-or ") + "\\) "))) + +(defun find-not (form) + "Or FORMs together and prefix with a -not, so: + \(not \(mtime \"+1\"\) \(name \"something\"\)\) +will produce: + -not \\\( -mtime '+1' -or -name 'something' \\\) +If you wanted the FORMs -and(ed) together instead then this would +suffice: + \(not \(and \(mtime \"+1\"\) \(name \"something\"\)\)\)" + (concat "-not " (find-or (mapcar 'find-to-string form)))) + +(defun find-prune (form) + "-or together FORM(s) postfix '-prune' and then -or that with a +-true, so: + \(prune \(name \".svn\" \".git\"\)\) \(name \"*.pm\"\) +will produce (unwrapped): + \\\( \\\( \\\( -name '.svn' -or -name '.git' \\\) / + -prune -or -true \\\) -and -name '*.pm' \\\)" + (find-or + (list + (concat (find-or (mapcar 'find-to-string form)) (find-generic "prune")) + (find-generic "true")))) + +(defun find-generic (option &optional oper argcount args dont-quote) + "This function allows an arbitrary string to be used as a +form. OPTION is the name of the form, OPER is the function used +to either OR or AND multiple results together. ARGCOUNT is the +minimum of args that OPTION can receive and ARGS are the +arguments for OPTION." + (when (and (numberp argcount) (< (length args) argcount)) + (error "'%s' needs at least %d arguments" option argcount)) + (let ((oper (or oper 'find-or))) + (if (and args (length args)) + (funcall oper (mapcar (lambda (x) + (concat "-" option + (if dont-quote + (concat " " x " ") + (concat " " + (shell-quote-argument x) + " ")))) + args)) + (concat "-" option " ")))) + +(defun find-command (form) + "For each item in FORM add a terminating semi-colon and turn +them into valid switches. The result is -and(ed) together." + (find-and (mapcar (lambda (x) + (concat (find-to-string x) "\\; ")) + form))) + +(defun find-to-string (form) + "Parse FORM to produce a set of valid find arguments." + (cond + ((stringp form) + form) + ((consp form) + (let ((option (cdr (assoc (car form) find-constituents)))) + (cond + ((and (symbolp option) (fboundp option)) + (funcall option (cdr form))) + ((consp option) + (let ((option (symbol-name (car form))) + (argcnt (car option)) + (oper (cadr option)) + (dont-quote (car (cddr option)))) + (find-to-string + (find-generic option oper argcnt (cdr form) dont-quote)))) + (t + (error "Sorry I don't know how to handle '%s'" (car form)))))))) + +(provide 'find-cmd) -- 2.11.4.GIT