Mercurial > emacs
view lisp/find-lisp.el @ 60092:04686828d0da
2004-11-08 Benjamin Riefenstahl <Benjamin.Riefenstahl@epost.de>
* w32select.c: Summary: Thorough rework to implement Unicode
clipboard operations and delayed rendering.
Drop last_clipboard_text and related code, keep track of
ownership via clipboard_owner instead. Drop old #if0
sections.
(DEFAULT_LCID, ANSICP, OEMCP, QUNICODE, QANSICP, QOEMCP)
(clipboard_owner, modifying_clipboard, cfg_coding_system)
(cfg_codepage, cfg_lcid, cfg_clipboard_type, current_text)
(current_coding_system, current_requires_encoding)
(current_num_nls, current_clipboard_type, current_lcid): New
static variables.
(convert_to_handle_as_ascii, convert_to_handle_as_coded)
(render, render_all, run_protected, lisp_error_handler)
(owner_callback, create_owner, setup_config)
(enum_locale_callback, cp_from_locale, coding_from_cp): New
local functions.
(term_w32select, globals_of_w32select): New global functions.
(Fw32_set_clipboard_data): Ignore parameter FRAME, use
clipboard_owner instead. Use delayed rendering and provide
all text formats. Provide CF_LOCALE if necessary.
(Fw32_get_clipboard_data): Handle CF_UNICODETEXT and
CF_LOCALE. Fall back to CF_TEXT, if CF_UNICODETEXT is not
available. Force DOS line-ends for decoding.
(Fx_selection_exists_p): Handle CF_UNICODETEXT.
(syms_of_w32select): Init and register new variables.
* w32.h: Add prototypes for globals_of_w32select and
term_w32select. Make the neighboring K&R declarations into
prototypes, too.
* emacs.c: Include w32.h to get function prototypes.
(main): Call globals_of_w32select.
* w32.c (term_ntproc): Call term_w32select.
* mule-cmds.el (set-locale-environment): Remove call to
set-selection-coding-system on Windows.
* s/ms-w32.h: Guard MSC-specific #pragmas with an #ifdef.
author | Jason Rumney <jasonr@gnu.org> |
---|---|
date | Tue, 15 Feb 2005 23:19:26 +0000 |
parents | 695cf19ef79e |
children | 6fb026ad601f 375f2633d815 |
line wrap: on
line source
;;; find-lisp.el --- emulation of find in Emacs Lisp ;; Author: Peter Breton ;; Created: Fri Mar 26 1999 ;; Keywords: unix ;; Time-stamp: <2001-07-16 12:42:35 pavel> ;; 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." (setq directory (file-name-as-directory directory)) (let (results sub-results) (dolist (file (directory-files directory nil nil t)) (let ((fullname (expand-file-name file directory))) (when (file-readable-p (expand-file-name file directory)) ;; 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))))))) results)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Find-dired all in Lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;###autoload (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 ;;;###autoload (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))) ;;;###autoload (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) ;; Local Variables: ;; autocompile: t ;; End: ;;; arch-tag: a711374c-f12a-46f6-aa18-ba7d77b9602a ;;; find-lisp.el ends here