From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Luc Teirlinck Newsgroups: gmane.emacs.devel Subject: locate.el Date: Mon, 31 May 2004 21:15:54 -0500 (CDT) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <200406010215.i512FsI01201@raven.dms.auburn.edu> NNTP-Posting-Host: deer.gmane.org X-Trace: sea.gmane.org 1086056252 7507 80.91.224.253 (1 Jun 2004 02:17:32 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 1 Jun 2004 02:17:32 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Tue Jun 01 04:17:25 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1BUyqD-00056T-00 for ; Tue, 01 Jun 2004 04:17:25 +0200 Original-Received: from lists.gnu.org ([199.232.76.165]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1BUyqC-0003c7-00 for ; Tue, 01 Jun 2004 04:17:24 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1BUyqO-0004oD-RA for emacs-devel@quimby.gnus.org; Mon, 31 May 2004 22:17:36 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.33) id 1BUyqG-0004mz-EF for emacs-devel@gnu.org; Mon, 31 May 2004 22:17:28 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.33) id 1BUyqE-0004lh-Jf for emacs-devel@gnu.org; Mon, 31 May 2004 22:17:28 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.33) id 1BUyqE-0004le-Fd for emacs-devel@gnu.org; Mon, 31 May 2004 22:17:26 -0400 Original-Received: from [131.204.53.104] (helo=manatee.dms.auburn.edu) by monty-python.gnu.org with esmtp (Exim 4.34) id 1BUypc-00087B-8k for emacs-devel@gnu.org; Mon, 31 May 2004 22:16:50 -0400 Original-Received: from raven.dms.auburn.edu (raven.dms.auburn.edu [131.204.53.29]) by manatee.dms.auburn.edu (8.12.10/8.12.10) with ESMTP id i512GluE011510 for ; Mon, 31 May 2004 21:16:47 -0500 (CDT) Original-Received: (from teirllm@localhost) by raven.dms.auburn.edu (8.11.6+Sun/8.11.6) id i512FsI01201; Mon, 31 May 2004 21:15:54 -0500 (CDT) X-Authentication-Warning: raven.dms.auburn.edu: teirllm set sender to teirllm@dms.auburn.edu using -f Original-To: emacs-devel@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:24329 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:24329 This is the first in a series of three patches to locate.el, find-dired.el and dired-aux.el. They correct a variety of malfunctionings, bugs and misfeatures regarding inserted subdirectories in *Locate* and *Find* buffers as well as in ordinary Dired buffers. The patches to locate.el and find-dired.el are just updated versions of patches I submitted earlier. But to function well, they need the changes in dired-aux, which I will post separately. The patches to locate.el and find.el do not fix every single problem in *Locate* and *Find* buffers. That is impossible, because both are in a form that Dired is not 100 percent prepared to cope with. I will install all three patches within a few days if there are no objections. ===File ~/locate-diff======================================= *** locate.el 20 May 2004 17:14:36 -0500 1.22 --- locate.el 28 May 2004 11:35:25 -0500 *************** *** 223,241 **** (save-window-excursion (set-buffer (get-buffer-create locate-buffer-name)) (locate-mode) ! (erase-buffer) ! (setq locate-current-filter filter) ! (if run-locate-command ! (shell-command search-string locate-buffer-name) ! (apply 'call-process locate-cmd nil t nil locate-cmd-args)) ! (and filter ! (locate-filter-output filter)) ! (locate-do-setup search-string) ! ) (and (not (string-equal (buffer-name) locate-buffer-name)) (switch-to-buffer-other-window locate-buffer-name)) --- 223,242 ---- (save-window-excursion (set-buffer (get-buffer-create locate-buffer-name)) (locate-mode) ! (let ((inhibit-read-only t)) ! (erase-buffer) ! (setq locate-current-filter filter) ! (if run-locate-command ! (shell-command search-string locate-buffer-name) ! (apply 'call-process locate-cmd nil t nil locate-cmd-args)) ! (and filter ! (locate-filter-output filter)) ! (locate-do-setup search-string) ! )) (and (not (string-equal (buffer-name) locate-buffer-name)) (switch-to-buffer-other-window locate-buffer-name)) *************** *** 281,287 **** (define-key locate-mode-map [menu-bar mark directories] 'undefined) (define-key locate-mode-map [menu-bar mark symlinks] 'undefined) ! (define-key locate-mode-map [mouse-2] 'locate-mouse-view-file) (define-key locate-mode-map "\C-c\C-t" 'locate-tags) (define-key locate-mode-map "U" 'dired-unmark-all-files) --- 282,289 ---- (define-key locate-mode-map [menu-bar mark directories] 'undefined) (define-key locate-mode-map [menu-bar mark symlinks] 'undefined) ! (define-key locate-mode-map [M-mouse-2] 'locate-mouse-view-file) ! (define-key locate-mode-map "i" 'locate-maybe-insert-subdir) (define-key locate-mode-map "\C-c\C-t" 'locate-tags) (define-key locate-mode-map "U" 'dired-unmark-all-files) *************** *** 318,329 **** (not (eq lineno 2)) (buffer-substring (elt pos 0) (elt pos 1))))) (defun locate-mouse-view-file (event) "In Locate mode, view a file, using the mouse." (interactive "@e") (save-excursion (goto-char (posn-point (event-start event))) ! (view-file (locate-get-filename)))) ;; Define a mode for locate ;; Default directory is set to "/" so that dired commands, which --- 320,365 ---- (not (eq lineno 2)) (buffer-substring (elt pos 0) (elt pos 1))))) + (defun locate-main-listing-line-p () + "Return t if current line contains a file name listed by locate. + This function returns nil if the current line either contains no + file name or is inside a subdirectory." + (save-excursion + (forward-line 0) + (looking-at (concat "." + (make-string (1- locate-filename-indentation) ?\ ) + "\\(/\\|[A-Za-z]:\\)")))) + (defun locate-mouse-view-file (event) "In Locate mode, view a file, using the mouse." (interactive "@e") (save-excursion (goto-char (posn-point (event-start event))) ! (if (locate-main-listing-line-p) ! (view-file (locate-get-filename)) ! (message "This command only works inside main listing.")))) ! ! (defun locate-maybe-insert-subdir (dirname &optional ! switches no-error-if-not-dir-p) ! "Like `dired-maybe-insert-subdir', but works in `locate-mode'. ! `locate-mode' needs a special command for this to replace its own ! binding of `dired-actual-switches' with \"-al\", when called ! interactively. As with `dired-maybe-insert-subdir', you can ! specify your own switches by providing a numeric prefix argument, ! but you can not specify the \"-F\" switch. For proper ! functioning, you should specify the \"-l\" switch." ! ;; Code adapted from dired-maybe-insert-subdir ! (interactive ! (list (dired-get-filename) ! (if current-prefix-arg ! (read-string "Switches for listing: " "-al")))) ! (let ((opoint (point))) ! (setq dirname (file-name-as-directory dirname)) ! (or (and (not switches) ! (dired-goto-subdir dirname)) ! (dired-insert-subdir dirname ! (or switches "-al") no-error-if-not-dir-p)) ! (push-mark opoint))) ;; Define a mode for locate ;; Default directory is set to "/" so that dired commands, which *************** *** 340,362 **** (use-local-map locate-mode-map) (setq major-mode 'locate-mode mode-name "Locate" ! default-directory "/") (dired-alist-add-1 default-directory (point-min-marker)) (make-local-variable 'dired-move-to-filename-regexp) ;; This should support both Unix and Windoze style names (setq dired-move-to-filename-regexp ! (concat "." (make-string (1- locate-filename-indentation) ?\ ) ! "\\(/\\|[A-Za-z]:\\)")) (make-local-variable 'dired-actual-switches) (setq dired-actual-switches "") (make-local-variable 'dired-permission-flags-regexp) (setq dired-permission-flags-regexp (concat "^.\\(" (make-string (1- locate-filename-indentation) ?\ ) ! "\\)")) (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'locate-update) (run-hooks 'locate-mode-hook)) (defun locate-do-setup (search-string) --- 376,404 ---- (use-local-map locate-mode-map) (setq major-mode 'locate-mode mode-name "Locate" ! default-directory "/" ! buffer-read-only t ! selective-display t) (dired-alist-add-1 default-directory (point-min-marker)) + (set (make-local-variable 'dired-directory) "/") (make-local-variable 'dired-move-to-filename-regexp) ;; This should support both Unix and Windoze style names (setq dired-move-to-filename-regexp ! (concat "^." (make-string (1- locate-filename-indentation) ?\ ) ! "\\(/\\|[A-Za-z]:\\)\\|" ! (default-value 'dired-move-to-filename-regexp))) (make-local-variable 'dired-actual-switches) (setq dired-actual-switches "") (make-local-variable 'dired-permission-flags-regexp) (setq dired-permission-flags-regexp (concat "^.\\(" (make-string (1- locate-filename-indentation) ?\ ) ! "\\)\\|" ! (default-value 'dired-permission-flags-regexp))) (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'locate-update) + (set (make-local-variable 'page-delimiter) "\n\n") (run-hooks 'locate-mode-hook)) (defun locate-do-setup (search-string) *************** *** 386,392 **** (dired-insert-set-properties (elt pos 0) (elt pos 1))))) (defun locate-insert-header (search-string) ! (let ((locate-format-string "Matches for %s") (locate-regexp-match (concat " *Matches for \\(" (regexp-quote search-string) "\\)")) (locate-format-args (list search-string)) --- 428,434 ---- (dired-insert-set-properties (elt pos 0) (elt pos 1))))) (defun locate-insert-header (search-string) ! (let ((locate-format-string " Matches for %s") (locate-regexp-match (concat " *Matches for \\(" (regexp-quote search-string) "\\)")) (locate-format-args (list search-string)) *************** *** 439,447 **** (defun locate-tags () "Visit a tags table in `*Locate*' mode." (interactive) ! (let ((tags-table (locate-get-filename))) ! (and (y-or-n-p (format "Visit tags table %s? " tags-table)) ! (visit-tags-table tags-table)))) ;; From Stephen Eglen (defun locate-update (ignore1 ignore2) --- 481,491 ---- (defun locate-tags () "Visit a tags table in `*Locate*' mode." (interactive) ! (if (locate-main-listing-line-p) ! (let ((tags-table (locate-get-filename))) ! (and (y-or-n-p (format "Visit tags table %s? " tags-table)) ! (visit-tags-table tags-table))) ! (message "This command only works inside main listing."))) ;; From Stephen Eglen (defun locate-update (ignore1 ignore2) *************** *** 460,471 **** (defun locate-find-directory () "Visit the directory of the file mentioned on this line." (interactive) ! (let ((directory-name (locate-get-dirname))) ! (if (file-directory-p directory-name) ! (find-file directory-name) ! (if (file-symlink-p directory-name) ! (error "Directory is a symlink to a nonexistent target") ! (error "Directory no longer exists; run `updatedb' to update database"))))) (defun locate-find-directory-other-window () "Visit the directory of the file named on this line in other window." --- 504,517 ---- (defun locate-find-directory () "Visit the directory of the file mentioned on this line." (interactive) ! (if (locate-main-listing-line-p) ! (let ((directory-name (locate-get-dirname))) ! (if (file-directory-p directory-name) ! (find-file directory-name) ! (if (file-symlink-p directory-name) ! (error "Directory is a symlink to a nonexistent target") ! (error "Directory no longer exists; run `updatedb' to update database")))) ! (message "This command only works inside main listing."))) (defun locate-find-directory-other-window () "Visit the directory of the file named on this line in other window." ============================================================