Mercurial > emacs
changeset 29696:a5051216d618
*** empty log message ***
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Fri, 16 Jun 2000 15:47:45 +0000 |
| parents | 5201e6953968 |
| children | f24d81dfa064 |
| files | etc/NEWS etc/TODO lisp/ChangeLog lisp/find-lisp.el src/ChangeLog |
| diffstat | 5 files changed, 375 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Fri Jun 16 15:17:41 2000 +0000 +++ b/etc/NEWS Fri Jun 16 15:47:45 2000 +0000 @@ -13,6 +13,7 @@ ** There are new configure options associated with the support for images and toolkit scrollbars. Use the --help option to list them. + * Changes in Emacs 21.1 @@ -1081,6 +1082,8 @@ buffer menu with this package. You can use M-x bs-customize to customize the package. +*** find-lisp.el is a package emulating the Unix find command in Lisp. + *** calculator.el is a small calculator package that is intended to replace desktop calculators such as xcalc and calc.exe. Actually, it is not too small - it has more features than most desktop calculators,
--- a/etc/TODO Fri Jun 16 15:17:41 2000 +0000 +++ b/etc/TODO Fri Jun 16 15:47:45 2000 +0000 @@ -24,9 +24,6 @@ * Save undo information in files, and reload it when needed for undoing. -* modify comint.el so that input appears in a special font. - I can add a simple Emacs feature to help. - * Implement other text formatting properties. ** Footnotes that can appear either in place or at the end of the page. @@ -48,3 +45,6 @@ the whole menu bar. In the mean time, it should process other messages. * Make Emacs work as a Java Bean. + +* Make keymaps a first-class Lisp object (this means a rewrite of +keymap.c).
--- a/lisp/ChangeLog Fri Jun 16 15:17:41 2000 +0000 +++ b/lisp/ChangeLog Fri Jun 16 15:47:45 2000 +0000 @@ -1,3 +1,7 @@ +2000-06-16 Gerd Moellmann <gerd@gnu.org> + + * find-lisp.el: New file. + 2000-06-16 Andrew Innes <andrewi@gnu.org> * time.el (display-time-mail-function): New variable, to allow
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/find-lisp.el Fri Jun 16 15:47:45 2000 +0000 @@ -0,0 +1,365 @@ +;;; find-lisp.el --- Emulation of find in Emacs Lisp + +;; Author: Peter Breton +;; Created: Fri Mar 26 1999 +;; Keywords: unix +;; Time-stamp: <1999-04-19 16:37:01 pbreton> + +;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. + +;; 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. + +;;; Commentary: +;; +;; This is a very generalized form of find; it basically implements a +;; recursive directory descent. The conditions which bound the search +;; are expressed as predicates, and I have not addressed the question +;; of how to wrap up the common chores that find does in a simpler +;; format than writing code for all the various predicates. +;; +;; Some random thoughts are to express simple queries directly with +;; user-level functions, and perhaps use some kind of forms interface +;; for medium-level queries. Really complicated queries can be +;; expressed in Lisp. +;; + +;;; Todo +;; +;; It would be nice if we could sort the results without running the find +;; again. Maybe that could work by storing the original file attributes? + +;;; Code: + +;; Internal variables + +(defvar find-lisp-regexp nil + "Internal variable.") + +(defconst find-lisp-line-indent " " + "Indentation for dired file lines.") + +(defvar find-lisp-file-predicate nil + "Predicate for choosing to include files.") + +(defvar find-lisp-directory-predicate nil + "Predicate for choosing to descend into directories.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Debugging Code +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar find-lisp-debug-buffer "*Find Lisp Debug*" + "Buffer for debugging information.") + +(defvar find-lisp-debug nil + "Whether debugging is enabled.") + +(defun find-lisp-debug-message (message) + "Print a debug message MESSAGE in `find-lisp-debug-buffer'." + (set-buffer (get-buffer-create find-lisp-debug-buffer)) + (goto-char (point-max)) + (insert message "\n")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Directory and File predicates +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun find-lisp-default-directory-predicate (dir parent) + "True if DIR is not a dot file, and not a symlink. +PARENT is the parent directory of DIR." + (and find-lisp-debug + (find-lisp-debug-message + (format "Processing directory %s in %s" dir parent))) + ;; Skip current and parent directories + (not (or (string= dir ".") + (string= dir "..") + ;; Skip directories which are symlinks + ;; Easy way to circumvent recursive loops + (file-symlink-p dir)))) + +(defun find-lisp-default-file-predicate (file dir) + "True if FILE matches `find-lisp-regexp'. +DIR is the directory containing FILE." + (and find-lisp-debug + (find-lisp-debug-message + (format "Processing file %s in %s" file dir))) + (and (not (file-directory-p (expand-file-name file dir))) + (string-match find-lisp-regexp file))) + +(defun find-lisp-file-predicate-is-directory (file dir) + "True if FILE is a directory. +Argument DIR is the directory containing FILE." + (and find-lisp-debug + (find-lisp-debug-message + (format "Processing file %s in %s" file dir))) + (and (file-directory-p (expand-file-name file dir)) + (not (or (string= file ".") + (string= file ".."))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Find functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun find-lisp-find-files (directory regexp) + "Find files in DIRECTORY which match REGEXP." + (let ((file-predicate 'find-lisp-default-file-predicate) + (directory-predicate 'find-lisp-default-directory-predicate) + (find-lisp-regexp regexp) + ) + (find-lisp-find-files-internal + directory + file-predicate + directory-predicate))) + +;; Workhorse function +(defun find-lisp-find-files-internal (directory file-predicate + directory-predicate) + "Find files under DIRECTORY which satisfy FILE-PREDICATE. +FILE-PREDICATE is a function which takes two arguments: the file and its +directory. + +DIRECTORY-PREDICATE is used to decide whether to descend into directories. +It is a function which takes two arguments, the directory and its parent." + (let (results sub-results) + (mapcar + (function + (lambda(file) + (let ((fullname (expand-file-name file directory))) + (and (file-readable-p (expand-file-name file directory)) + (progn + ;; If a directory, check it we should descend into it + (and (file-directory-p fullname) + (funcall directory-predicate file directory) + (progn + (setq sub-results + (find-lisp-find-files-internal + fullname + file-predicate + directory-predicate)) + (if results + (nconc results sub-results) + (setq results sub-results)))) + ;; For all files and directories, call the file predicate + (and (funcall file-predicate file directory) + (if results + (nconc results (list fullname)) + (setq results (list fullname)))) + ))))) + (directory-files directory nil nil t)) + results)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Find-dired all in Lisp +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun find-lisp-find-dired (dir regexp) + "Find files in DIR, matching REGEXP." + (interactive "DFind files in directory: \nsMatching regexp: ") + (let ((find-lisp-regexp regexp)) + (find-lisp-find-dired-internal + dir + 'find-lisp-default-file-predicate + 'find-lisp-default-directory-predicate + "*Find Lisp Dired*"))) + +;; Just the subdirectories +(defun find-lisp-find-dired-subdirectories (dir) + "Find all subdirectories of DIR." + (interactive "DFind subdirectories of directory: ") + (find-lisp-find-dired-internal + dir + 'find-lisp-file-predicate-is-directory + 'find-lisp-default-directory-predicate + "*Find Lisp Dired Subdirectories*")) + +;; Most of this is lifted from find-dired.el +;; +(defun find-lisp-find-dired-internal (dir file-predicate + directory-predicate buffer-name) + "Run find (Lisp version) and go into Dired mode on a buffer of the output." + (let ((dired-buffers dired-buffers) + buf + (regexp find-lisp-regexp)) + ;; Expand DIR ("" means default-directory), and make sure it has a + ;; trailing slash. + (setq dir (abbreviate-file-name + (file-name-as-directory (expand-file-name dir)))) + ;; Check that it's really a directory. + (or (file-directory-p dir) + (error "find-dired needs a directory: %s" dir)) + (or + (and (buffer-name) + (string= buffer-name (buffer-name))) + (switch-to-buffer (setq buf (get-buffer-create buffer-name)))) + (widen) + (kill-all-local-variables) + (setq buffer-read-only nil) + (erase-buffer) + (setq default-directory dir) + (dired-mode dir) + + (use-local-map (append (make-sparse-keymap) (current-local-map))) + + (make-local-variable 'find-lisp-file-predicate) + (setq find-lisp-file-predicate file-predicate) + (make-local-variable 'find-lisp-directory-predicate) + (setq find-lisp-directory-predicate directory-predicate) + (make-local-variable 'find-lisp-regexp) + (setq find-lisp-regexp regexp) + + (make-local-variable 'revert-buffer-function) + (setq revert-buffer-function + (function + (lambda(ignore1 ignore2) + (find-lisp-insert-directory + default-directory + find-lisp-file-predicate + find-lisp-directory-predicate + 'ignore) + ) + )) + + ;; Set subdir-alist so that Tree Dired will work: + (if (fboundp 'dired-simple-subdir-alist) + ;; will work even with nested dired format (dired-nstd.el,v 1.15 + ;; and later) + (dired-simple-subdir-alist) + ;; else we have an ancient tree dired (or classic dired, where + ;; this does no harm) + (set (make-local-variable 'dired-subdir-alist) + (list (cons default-directory (point-min-marker))))) + (find-lisp-insert-directory + dir file-predicate directory-predicate 'ignore) + (goto-char (point-min)) + (dired-goto-next-file))) + +(defun find-lisp-insert-directory (dir + file-predicate + directory-predicate + sort-function) + "Insert the results of `find-lisp-find-files' in the current buffer." + (let ((buffer-read-only nil) + (files (find-lisp-find-files-internal + dir + file-predicate + directory-predicate)) + (len (length dir))) + (erase-buffer) + ;; Subdir headlerline must come first because the first marker in + ;; subdir-alist points there. + (insert find-lisp-line-indent dir ":\n") + ;; Make second line a ``find'' line in analogy to the ``total'' or + ;; ``wildcard'' line. + ;; + ;; No analog for find-lisp? + (insert find-lisp-line-indent "\n") + ;; Run the find function + (mapcar + (function + (lambda(file) + (find-lisp-find-dired-insert-file + (substring file len) + (current-buffer)))) + (sort files 'string-lessp)) + ;; FIXME: Sort function is ignored for now + ;; (funcall sort-function files)) + (goto-char (point-min)) + (dired-goto-next-file))) + +(defun find-lisp-find-dired-filter (regexp) + "Change the filter on a find-lisp-find-dired buffer to REGEXP." + (interactive "sSet filter to regexp: ") + (setq find-lisp-regexp regexp) + (revert-buffer)) + +(defun find-lisp-find-dired-insert-file (file buffer) + (set-buffer buffer) + (insert find-lisp-line-indent + (find-lisp-format file (file-attributes file) (list "") + (current-time)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Lifted from ls-lisp. We don't want to require it, because that +;; would alter the insert-directory function. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun find-lisp-format (file-name file-attr switches now) + (let ((file-type (nth 0 file-attr))) + (concat (if (memq ?i switches) ; inode number + (format "%6d " (nth 10 file-attr))) + ;; nil is treated like "" in concat + (if (memq ?s switches) ; size in K + (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) + (nth 8 file-attr) ; permission bits + ;; numeric uid/gid are more confusing than helpful + ;; Emacs should be able to make strings of them. + ;; user-login-name and user-full-name could take an + ;; optional arg. + (format " %3d %-8s %-8s %8d " + (nth 1 file-attr) ; no. of links + (if (= (user-uid) (nth 2 file-attr)) + (user-login-name) + (int-to-string (nth 2 file-attr))) ; uid + (if (eq system-type 'ms-dos) + "root" ; everything is root on MSDOS. + (int-to-string (nth 3 file-attr))) ; gid + (nth 7 file-attr) ; size in bytes + ) + (find-lisp-format-time file-attr switches now) + " " + file-name + (if (stringp file-type) ; is a symbolic link + (concat " -> " file-type) + "") + "\n"))) + +(defun find-lisp-time-index (switches) + ;; Return index into file-attributes according to ls SWITCHES. + (cond + ((memq ?c switches) 6) ; last mode change + ((memq ?u switches) 4) ; last access + ;; default is last modtime + (t 5))) + +(defun find-lisp-format-time (file-attr switches now) + ;; Format time string for file with attributes FILE-ATTR according + ;; to SWITCHES (a list of ls option letters of which c and u are recognized). + ;; Use the same method as `ls' to decide whether to show time-of-day or year, + ;; depending on distance between file date and NOW. + (let* ((time (nth (find-lisp-time-index switches) file-attr)) + (diff16 (- (car time) (car now))) + (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now))))) + (past-cutoff (- (* 6 30 24 60 60))) ; 6 30-day months + (future-cutoff (* 60 60))) ; 1 hour + (format-time-string + (if (and + (<= past-cutoff diff) (<= diff future-cutoff) + ;; Sanity check in case `diff' computation overflowed. + (<= (1- (ash past-cutoff -16)) diff16) + (<= diff16 (1+ (ash future-cutoff -16)))) + "%b %e %H:%M" + "%b %e %Y") + time))) + +(provide 'find-lisp) + +;;; find-lisp.el ends here + +;; Local Variables: +;; autocompile: t +;; End: