aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGerd Moellmann2000-06-16 15:47:45 +0000
committerGerd Moellmann2000-06-16 15:47:45 +0000
commit6344985d2b9b17ea8cb2a03b5a13ba89aa53fbd5 (patch)
treecfa892951eacaa9c44900d7d8afaa2829503e4e7
parent97d4edaaa32e42c7953a46716b1a349efd61dac2 (diff)
downloademacs-6344985d2b9b17ea8cb2a03b5a13ba89aa53fbd5.tar.gz
emacs-6344985d2b9b17ea8cb2a03b5a13ba89aa53fbd5.zip
*** empty log message ***
-rw-r--r--etc/NEWS3
-rw-r--r--etc/TODO6
-rw-r--r--lisp/ChangeLog4
-rw-r--r--lisp/find-lisp.el365
-rw-r--r--src/ChangeLog3
5 files changed, 378 insertions, 3 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 86989a02bba..d98866dbef9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -13,6 +13,7 @@ the --without-pop configure option, should that be necessary.
13 13
14** There are new configure options associated with the support for 14** There are new configure options associated with the support for
15images and toolkit scrollbars. Use the --help option to list them. 15images and toolkit scrollbars. Use the --help option to list them.
16
16 17
17* Changes in Emacs 21.1 18* Changes in Emacs 21.1
18 19
@@ -1081,6 +1082,8 @@ list-buffers or electric-buffer-list. Use M-x bs-show to display a
1081buffer menu with this package. You can use M-x bs-customize to 1082buffer menu with this package. You can use M-x bs-customize to
1082customize the package. 1083customize the package.
1083 1084
1085*** find-lisp.el is a package emulating the Unix find command in Lisp.
1086
1084*** calculator.el is a small calculator package that is intended to 1087*** calculator.el is a small calculator package that is intended to
1085replace desktop calculators such as xcalc and calc.exe. Actually, it 1088replace desktop calculators such as xcalc and calc.exe. Actually, it
1086is not too small - it has more features than most desktop calculators, 1089is not too small - it has more features than most desktop calculators,
diff --git a/etc/TODO b/etc/TODO
index def4652a449..4fd7f0352ac 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -24,9 +24,6 @@
24* Save undo information in files, and reload it when needed 24* Save undo information in files, and reload it when needed
25 for undoing. 25 for undoing.
26 26
27* modify comint.el so that input appears in a special font.
28 I can add a simple Emacs feature to help.
29
30* Implement other text formatting properties. 27* Implement other text formatting properties.
31** Footnotes that can appear either in place 28** Footnotes that can appear either in place
32 or at the end of the page. 29 or at the end of the page.
@@ -48,3 +45,6 @@
48 the whole menu bar. In the mean time, it should process other messages. 45 the whole menu bar. In the mean time, it should process other messages.
49 46
50* Make Emacs work as a Java Bean. 47* Make Emacs work as a Java Bean.
48
49* Make keymaps a first-class Lisp object (this means a rewrite of
50keymap.c).
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fa6c46b1778..3f2a66948d4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
12000-06-16 Gerd Moellmann <gerd@gnu.org>
2
3 * find-lisp.el: New file.
4
12000-06-16 Andrew Innes <andrewi@gnu.org> 52000-06-16 Andrew Innes <andrewi@gnu.org>
2 6
3 * time.el (display-time-mail-function): New variable, to allow 7 * time.el (display-time-mail-function): New variable, to allow
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
new file mode 100644
index 00000000000..0398bd6e0ec
--- /dev/null
+++ b/lisp/find-lisp.el
@@ -0,0 +1,365 @@
1;;; find-lisp.el --- Emulation of find in Emacs Lisp
2
3;; Author: Peter Breton
4;; Created: Fri Mar 26 1999
5;; Keywords: unix
6;; Time-stamp: <1999-04-19 16:37:01 pbreton>
7
8;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28;;
29;; This is a very generalized form of find; it basically implements a
30;; recursive directory descent. The conditions which bound the search
31;; are expressed as predicates, and I have not addressed the question
32;; of how to wrap up the common chores that find does in a simpler
33;; format than writing code for all the various predicates.
34;;
35;; Some random thoughts are to express simple queries directly with
36;; user-level functions, and perhaps use some kind of forms interface
37;; for medium-level queries. Really complicated queries can be
38;; expressed in Lisp.
39;;
40
41;;; Todo
42;;
43;; It would be nice if we could sort the results without running the find
44;; again. Maybe that could work by storing the original file attributes?
45
46;;; Code:
47
48;; Internal variables
49
50(defvar find-lisp-regexp nil
51 "Internal variable.")
52
53(defconst find-lisp-line-indent " "
54 "Indentation for dired file lines.")
55
56(defvar find-lisp-file-predicate nil
57 "Predicate for choosing to include files.")
58
59(defvar find-lisp-directory-predicate nil
60 "Predicate for choosing to descend into directories.")
61
62;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63;; Debugging Code
64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65
66(defvar find-lisp-debug-buffer "*Find Lisp Debug*"
67 "Buffer for debugging information.")
68
69(defvar find-lisp-debug nil
70 "Whether debugging is enabled.")
71
72(defun find-lisp-debug-message (message)
73 "Print a debug message MESSAGE in `find-lisp-debug-buffer'."
74 (set-buffer (get-buffer-create find-lisp-debug-buffer))
75 (goto-char (point-max))
76 (insert message "\n"))
77
78;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
79;; Directory and File predicates
80;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81
82(defun find-lisp-default-directory-predicate (dir parent)
83 "True if DIR is not a dot file, and not a symlink.
84PARENT is the parent directory of DIR."
85 (and find-lisp-debug
86 (find-lisp-debug-message
87 (format "Processing directory %s in %s" dir parent)))
88 ;; Skip current and parent directories
89 (not (or (string= dir ".")
90 (string= dir "..")
91 ;; Skip directories which are symlinks
92 ;; Easy way to circumvent recursive loops
93 (file-symlink-p dir))))
94
95(defun find-lisp-default-file-predicate (file dir)
96 "True if FILE matches `find-lisp-regexp'.
97DIR is the directory containing FILE."
98 (and find-lisp-debug
99 (find-lisp-debug-message
100 (format "Processing file %s in %s" file dir)))
101 (and (not (file-directory-p (expand-file-name file dir)))
102 (string-match find-lisp-regexp file)))
103
104(defun find-lisp-file-predicate-is-directory (file dir)
105 "True if FILE is a directory.
106Argument DIR is the directory containing FILE."
107 (and find-lisp-debug
108 (find-lisp-debug-message
109 (format "Processing file %s in %s" file dir)))
110 (and (file-directory-p (expand-file-name file dir))
111 (not (or (string= file ".")
112 (string= file "..")))))
113
114;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115;; Find functions
116;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
117
118(defun find-lisp-find-files (directory regexp)
119 "Find files in DIRECTORY which match REGEXP."
120 (let ((file-predicate 'find-lisp-default-file-predicate)
121 (directory-predicate 'find-lisp-default-directory-predicate)
122 (find-lisp-regexp regexp)
123 )
124 (find-lisp-find-files-internal
125 directory
126 file-predicate
127 directory-predicate)))
128
129;; Workhorse function
130(defun find-lisp-find-files-internal (directory file-predicate
131 directory-predicate)
132 "Find files under DIRECTORY which satisfy FILE-PREDICATE.
133FILE-PREDICATE is a function which takes two arguments: the file and its
134directory.
135
136DIRECTORY-PREDICATE is used to decide whether to descend into directories.
137It is a function which takes two arguments, the directory and its parent."
138 (let (results sub-results)
139 (mapcar
140 (function
141 (lambda(file)
142 (let ((fullname (expand-file-name file directory)))
143 (and (file-readable-p (expand-file-name file directory))
144 (progn
145 ;; If a directory, check it we should descend into it
146 (and (file-directory-p fullname)
147 (funcall directory-predicate file directory)
148 (progn
149 (setq sub-results
150 (find-lisp-find-files-internal
151 fullname
152 file-predicate
153 directory-predicate))
154 (if results
155 (nconc results sub-results)
156 (setq results sub-results))))
157 ;; For all files and directories, call the file predicate
158 (and (funcall file-predicate file directory)
159 (if results
160 (nconc results (list fullname))
161 (setq results (list fullname))))
162 )))))
163 (directory-files directory nil nil t))
164 results))
165
166;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
167;; Find-dired all in Lisp
168;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169
170(defun find-lisp-find-dired (dir regexp)
171 "Find files in DIR, matching REGEXP."
172 (interactive "DFind files in directory: \nsMatching regexp: ")
173 (let ((find-lisp-regexp regexp))
174 (find-lisp-find-dired-internal
175 dir
176 'find-lisp-default-file-predicate
177 'find-lisp-default-directory-predicate
178 "*Find Lisp Dired*")))
179
180;; Just the subdirectories
181(defun find-lisp-find-dired-subdirectories (dir)
182 "Find all subdirectories of DIR."
183 (interactive "DFind subdirectories of directory: ")
184 (find-lisp-find-dired-internal
185 dir
186 'find-lisp-file-predicate-is-directory
187 'find-lisp-default-directory-predicate
188 "*Find Lisp Dired Subdirectories*"))
189
190;; Most of this is lifted from find-dired.el
191;;
192(defun find-lisp-find-dired-internal (dir file-predicate
193 directory-predicate buffer-name)
194 "Run find (Lisp version) and go into Dired mode on a buffer of the output."
195 (let ((dired-buffers dired-buffers)
196 buf
197 (regexp find-lisp-regexp))
198 ;; Expand DIR ("" means default-directory), and make sure it has a
199 ;; trailing slash.
200 (setq dir (abbreviate-file-name
201 (file-name-as-directory (expand-file-name dir))))
202 ;; Check that it's really a directory.
203 (or (file-directory-p dir)
204 (error "find-dired needs a directory: %s" dir))
205 (or
206 (and (buffer-name)
207 (string= buffer-name (buffer-name)))
208 (switch-to-buffer (setq buf (get-buffer-create buffer-name))))
209 (widen)
210 (kill-all-local-variables)
211 (setq buffer-read-only nil)
212 (erase-buffer)
213 (setq default-directory dir)
214 (dired-mode dir)
215
216 (use-local-map (append (make-sparse-keymap) (current-local-map)))
217
218 (make-local-variable 'find-lisp-file-predicate)
219 (setq find-lisp-file-predicate file-predicate)
220 (make-local-variable 'find-lisp-directory-predicate)
221 (setq find-lisp-directory-predicate directory-predicate)
222 (make-local-variable 'find-lisp-regexp)
223 (setq find-lisp-regexp regexp)
224
225 (make-local-variable 'revert-buffer-function)
226 (setq revert-buffer-function
227 (function
228 (lambda(ignore1 ignore2)
229 (find-lisp-insert-directory
230 default-directory
231 find-lisp-file-predicate
232 find-lisp-directory-predicate
233 'ignore)
234 )
235 ))
236
237 ;; Set subdir-alist so that Tree Dired will work:
238 (if (fboundp 'dired-simple-subdir-alist)
239 ;; will work even with nested dired format (dired-nstd.el,v 1.15
240 ;; and later)
241 (dired-simple-subdir-alist)
242 ;; else we have an ancient tree dired (or classic dired, where
243 ;; this does no harm)
244 (set (make-local-variable 'dired-subdir-alist)
245 (list (cons default-directory (point-min-marker)))))
246 (find-lisp-insert-directory
247 dir file-predicate directory-predicate 'ignore)
248 (goto-char (point-min))
249 (dired-goto-next-file)))
250
251(defun find-lisp-insert-directory (dir
252 file-predicate
253 directory-predicate
254 sort-function)
255 "Insert the results of `find-lisp-find-files' in the current buffer."
256 (let ((buffer-read-only nil)
257 (files (find-lisp-find-files-internal
258 dir
259 file-predicate
260 directory-predicate))
261 (len (length dir)))
262 (erase-buffer)
263 ;; Subdir headlerline must come first because the first marker in
264 ;; subdir-alist points there.
265 (insert find-lisp-line-indent dir ":\n")
266 ;; Make second line a ``find'' line in analogy to the ``total'' or
267 ;; ``wildcard'' line.
268 ;;
269 ;; No analog for find-lisp?
270 (insert find-lisp-line-indent "\n")
271 ;; Run the find function
272 (mapcar
273 (function
274 (lambda(file)
275 (find-lisp-find-dired-insert-file
276 (substring file len)
277 (current-buffer))))
278 (sort files 'string-lessp))
279 ;; FIXME: Sort function is ignored for now
280 ;; (funcall sort-function files))
281 (goto-char (point-min))
282 (dired-goto-next-file)))
283
284(defun find-lisp-find-dired-filter (regexp)
285 "Change the filter on a find-lisp-find-dired buffer to REGEXP."
286 (interactive "sSet filter to regexp: ")
287 (setq find-lisp-regexp regexp)
288 (revert-buffer))
289
290(defun find-lisp-find-dired-insert-file (file buffer)
291 (set-buffer buffer)
292 (insert find-lisp-line-indent
293 (find-lisp-format file (file-attributes file) (list "")
294 (current-time))))
295
296;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
297;; Lifted from ls-lisp. We don't want to require it, because that
298;; would alter the insert-directory function.
299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
300
301(defun find-lisp-format (file-name file-attr switches now)
302 (let ((file-type (nth 0 file-attr)))
303 (concat (if (memq ?i switches) ; inode number
304 (format "%6d " (nth 10 file-attr)))
305 ;; nil is treated like "" in concat
306 (if (memq ?s switches) ; size in K
307 (format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
308 (nth 8 file-attr) ; permission bits
309 ;; numeric uid/gid are more confusing than helpful
310 ;; Emacs should be able to make strings of them.
311 ;; user-login-name and user-full-name could take an
312 ;; optional arg.
313 (format " %3d %-8s %-8s %8d "
314 (nth 1 file-attr) ; no. of links
315 (if (= (user-uid) (nth 2 file-attr))
316 (user-login-name)
317 (int-to-string (nth 2 file-attr))) ; uid
318 (if (eq system-type 'ms-dos)
319 "root" ; everything is root on MSDOS.
320 (int-to-string (nth 3 file-attr))) ; gid
321 (nth 7 file-attr) ; size in bytes
322 )
323 (find-lisp-format-time file-attr switches now)
324 " "
325 file-name
326 (if (stringp file-type) ; is a symbolic link
327 (concat " -> " file-type)
328 "")
329 "\n")))
330
331(defun find-lisp-time-index (switches)
332 ;; Return index into file-attributes according to ls SWITCHES.
333 (cond
334 ((memq ?c switches) 6) ; last mode change
335 ((memq ?u switches) 4) ; last access
336 ;; default is last modtime
337 (t 5)))
338
339(defun find-lisp-format-time (file-attr switches now)
340 ;; Format time string for file with attributes FILE-ATTR according
341 ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
342 ;; Use the same method as `ls' to decide whether to show time-of-day or year,
343 ;; depending on distance between file date and NOW.
344 (let* ((time (nth (find-lisp-time-index switches) file-attr))
345 (diff16 (- (car time) (car now)))
346 (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now)))))
347 (past-cutoff (- (* 6 30 24 60 60))) ; 6 30-day months
348 (future-cutoff (* 60 60))) ; 1 hour
349 (format-time-string
350 (if (and
351 (<= past-cutoff diff) (<= diff future-cutoff)
352 ;; Sanity check in case `diff' computation overflowed.
353 (<= (1- (ash past-cutoff -16)) diff16)
354 (<= diff16 (1+ (ash future-cutoff -16))))
355 "%b %e %H:%M"
356 "%b %e %Y")
357 time)))
358
359(provide 'find-lisp)
360
361;;; find-lisp.el ends here
362
363;; Local Variables:
364;; autocompile: t
365;; End:
diff --git a/src/ChangeLog b/src/ChangeLog
index e3a423e7eae..ed02be8761b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,8 @@
12000-06-16 Gerd Moellmann <gerd@gnu.org> 12000-06-16 Gerd Moellmann <gerd@gnu.org>
2 2
3 * keymap.c (describe_buffer_bindings): Add `\f\n' in front
4 of titles.
5
3 * dispnew.c (update_frame_1): Handle case that cursor vpos is 6 * dispnew.c (update_frame_1): Handle case that cursor vpos is
4 out of bounds. 7 out of bounds.
5 8