From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.bugs Subject: bug#7098: Emacs24 crash with segmentation fault Date: Sat, 25 Sep 2010 14:32:24 +0200 Organization: ThierryVolpiatto Message-ID: <87iq1uqa07.fsf@tux.homenetwork> References: <87aan7c9k7.fsf@tux.homenetwork> <831v8jt379.fsf@gnu.org> <8762xvc5eq.fsf@tux.homenetwork> <83wrqbrl0w.fsf@gnu.org> <87wrqac3rn.fsf@tux.homenetwork> <83sk0ysxu7.fsf@gnu.org> <87k4maqni0.fsf@tux.homenetwork> <83fwwys0p3.fsf@gnu.org> <878w2qcju7.fsf@tux.homenetwork> <874odecgj9.fsf@tux.homenetwork> <87mxr6qch2.fsf@tux.homenetwork> <837hiarq3y.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1285418496 30052 80.91.229.12 (25 Sep 2010 12:41:36 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sat, 25 Sep 2010 12:41:36 +0000 (UTC) Cc: lekktu@gmail.com, 7098@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Sep 25 14:41:35 2010 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OzU4E-0006Nh-PG for geb-bug-gnu-emacs@m.gmane.org; Sat, 25 Sep 2010 14:41:34 +0200 Original-Received: from localhost ([127.0.0.1]:34338 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OzU4D-00071E-Jk for geb-bug-gnu-emacs@m.gmane.org; Sat, 25 Sep 2010 08:41:25 -0400 Original-Received: from [140.186.70.92] (port=48279 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OzU42-000717-CN for bug-gnu-emacs@gnu.org; Sat, 25 Sep 2010 08:41:19 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OzU3x-0007p3-8o for bug-gnu-emacs@gnu.org; Sat, 25 Sep 2010 08:41:14 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:56854) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OzU3x-0007oz-5T for bug-gnu-emacs@gnu.org; Sat, 25 Sep 2010 08:41:09 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1OzTv7-00088M-VA; Sat, 25 Sep 2010 08:32:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Thierry Volpiatto Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: owner@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 25 Sep 2010 12:32:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 7098 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 7098-submit@debbugs.gnu.org id=B7098.128541788731260 (code B ref 7098); Sat, 25 Sep 2010 12:32:01 +0000 Original-Received: (at 7098) by debbugs.gnu.org; 25 Sep 2010 12:31:27 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OzTuZ-000889-Ia for submit@debbugs.gnu.org; Sat, 25 Sep 2010 08:31:27 -0400 Original-Received: from mail-ww0-f46.google.com ([74.125.82.46]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OzTuX-000884-ME for 7098@debbugs.gnu.org; Sat, 25 Sep 2010 08:31:26 -0400 Original-Received: by wwb13 with SMTP id 13so616328wwb.15 for <7098@debbugs.gnu.org>; Sat, 25 Sep 2010 05:34:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:received:received:from:to:cc:subject :organization:references:date:in-reply-to:message-id:user-agent :mime-version:content-type; bh=h/1vRaQcjhJ2nsKn42AwLFGvh1jZjrdCdCJmcqFoLAM=; b=ODGqYlznbV4PNcnRUc7uUnOE5PXxodWSk/KoUvv79QP7gOxYUHkK9uGYIn7LWbH2A1 OwDa8dl2DznRSHnWQrnPb8ZHR7C+y67n9R4TKwGRFBaIxtvDB1kHYRNQJ9gC9EKXQvCV qe9oVtzTtC7yaPp0spgTBBEkhMh0FHydzfslk= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=from:to:cc:subject:organization:references:date:in-reply-to :message-id:user-agent:mime-version:content-type; b=UycisXSLiHoeHnotrxe/G0ibdPyH8ExmRdiqQgfJSJn49zrSeNYGPdrYTm1Kghmf8U loNAA/ufclHwyDaMQUEm2hznUEFpfffwklOqD+dfE915FjkXWNl1rDYvjQX17fhzZpNX J4QWhnw/CBBCfIMR52C6OXOI4jPREIEBJoADc= Original-Received: by 10.216.72.209 with SMTP id t59mr10573131wed.83.1285418047840; Sat, 25 Sep 2010 05:34:07 -0700 (PDT) Original-Received: from tux.homenetwork (203.77.197-77.rev.gaoland.net [77.197.77.203]) by mx.google.com with ESMTPS id n40sm2063382weq.29.2010.09.25.05.34.05 (version=TLSv1/SSLv3 cipher=RC4-MD5); Sat, 25 Sep 2010 05:34:07 -0700 (PDT) In-Reply-To: <837hiarq3y.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 25 Sep 2010 13:59:13 +0200") User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list Resent-Date: Sat, 25 Sep 2010 08:32:01 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:40423 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> From: Thierry Volpiatto >> Cc: Eli Zaretskii , 7098@debbugs.gnu.org >> Date: Sat, 25 Sep 2010 13:39:05 +0200 >> >> I can crash at everytime now using the same command that recurse >> through a big tree and match regexp in file (like rgrep but all lisp). > > Is it possible to post that command and any data it uses here? Then > perhaps others could join the effort of hunting down this bug. > Yes sure, no dependencies needed, just load and use M-x traverse-deep-rfind on a big but reasonable directory (it is not rgrep, it's slow). The test i do take 172s here when it success. Use a regexp for "only" e.g .*\.el$ or nothing to stress more emacs. But i think using anything else to generate a lot of activity in Emacs should do the same. e.g using many tools at the same time. A good point is i couldn't crash Emacs23.2 at this game :-) -- A+ Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=traverselisp.el Content-Transfer-Encoding: quoted-printable ;;; traverselisp.el --- walk through directories and perform actions on fil= es. ;; Copyright (C) 2008, 2009, 2010 Thierry Volpiatto, all rights reserved. ;; Author: Thierry Volpiatto - thierry dot volpiatto at gmail dot com ;; Maintainer: Thierry Volpiatto ;; Keywords: data, regexp, occur. ;; X-URL: http://mercurial.intuxication.org/hg/traverselisp ;; This file is not 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 3, 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., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;;; Commentary: ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; Developped and tested on Emacs23+ (CVS) ;; Compatibility: Emacs23.* ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; Dependencies: ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;; iterator.el (part of traverselisp package). ;; Install: ;; =3D=3D=3D=3D=3D=3D=3D ;; ;; Put this file in your load-path And Byte-compile it. ;; (If you don't do that you will have error as traverse ;; use code that work only at compile time.) ;; ;; You will need also iterator.el to be in your load path and compiled. ;; ;; Add to your .emacs: ;; ;; (require 'traverselisp) ;; ;; Set up your prefered keys for dired and globals as usual. ;; Suggested config: ;; =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D ;; ;; (require 'traverselisp) ;; (setq traverse-use-avfs t) ;; (global-set-key (kbd " f") 'traverse-deep-rfind) ;; (global-set-key (kbd "C-c o") 'traverse-incremental-occur) ;; (define-key dired-mode-map (kbd "A") 'traverse-dired-search-regexp-in-an= ything-at-point) ;; (define-key dired-mode-map (kbd "C-c C-z") 'traverse-dired-browse-archiv= e) ;; (define-key dired-mode-map (kbd "C-c t") 'traverse-dired-find-in-all-fil= es) ;; (mapc #'(lambda (x) ;; (add-to-list 'traverse-ignore-files x)) ;; '(".ledger-cache" "ANYTHING-TAG-FILE")) ;; (add-to-list 'traverse-ignore-dirs "emacs_backup") ;; (global-set-key (kbd "C-c C-f") 'anything-traverse) ;; (global-set-key (kbd "C-M-|") 'traverse-toggle-split-window-h-v) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Traverse auto documentation ;; --------------------------- ;; ;; [UPDATE ALL EVAL] (autodoc-update-all) ;; ;; * Commands defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'command) ;; `traverselisp-version' ;; `traverse-quit' ;; `traverse-find-in-file' ;; `traverse-deep-rfind' ;; `traverse-search-in-dired-dir-at-point' ;; `traverse-search-in-dired-file-at-point' ;; `traverse-dired-browse-archive' ;; `traverse-dired-search-in-archive' ;; `traverse-dired-find-in-marked-files' ;; `traverse-dired-find-in-all-files' ;; `traverse-dired-search-regexp-in-anything-at-point' ;; `traverse-jump-other-window' ;; `traverse-go-forward' ;; `traverse-go-backward' ;; `traverse-scroll-down-other-window' ;; `traverse-scroll-up-other-window' ;; `traverse-toggle-split-window-h-v' ;; `traverse-count-files-in-dir' ;; * Non--interactive functions defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'function :prefix "traverse") ;; `traverse-list-directory' ;; `traverse-walk-directory' ;; `traverse-goto-line' ;; `traverse-comp-str-to-list' ;; `traverse-check-only-lists' ;; `traverse-find-readlines' ;; `traverse-file-process' ;; `traverse-file-process-ext' ;; `traverse-buffer-process-ext' ;; `traverse-occur-color-current-line' ;; `traverse-button-func' ;; `traverse-prepare-buffer' ;; `traverse-read-regexp' ;; `traverse-dired-get-marked-files' ;; `traverse-go-forward-or-backward' ;; `traverse-window-split-h-or-t' ;; `traverse-list-directories-in-tree' ;; `traverse-list-files-in-tree' ;; `traverse-mv-files-in-tree' ;; * Macros defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'macro :prefix "traverse") ;; `traverse-collect-files-in-tree-if' ;; `traverse-collect-files-in-tree-if-not' ;; * Internal variables defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'internal-variable :prefix "t= raverse") ;; `traverse-mode-map' ;; `traverse-match-overlay-face' ;; `traverse-show-regexp-delay' ;; `traverse-keep-indent' ;; `traverse-count-occurences' ;; `traverse-occur-overlay' ;; * Faces defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'faces :prefix "traverse") ;; `traverse-match-face' ;; `traverse-regex-face' ;; `traverse-path-face' ;; `traverse-overlay-face' ;; * User variables defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "^trav= erse") ;; `traverse-ignore-files' ;; `traverse-ignore-dirs' ;; `traverse-length-line' ;; `traverse-file-function' ;; `traverse-use-avfs' ;; `traverse-avfs-default-directory' ;; *** END auto-documentation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Usage: ;; =3D=3D=3D=3D=3D ;; ;; M-x `traverse-deep-rfind' ;; That is the interactive recursive function of traverse. ;; It will search for a regexp in all files of a directory ;; tree and his subdirectories. ;; ;; When searching is done and you are in traverse buffer ;; some interactive actions are provided for navigate ;; Use "C-h m" for more info while in traverse-buffer. ;; ;; You can also use traverse from DIRED: ;; M-x `traverse-dired-search-regexp-in-anything-at-point' ;; ;; This function work on directory, files, (1)compressed files (AVFS) ;; and marked files: ;; ;; If you have marked files search will be performed only on these files. ;; (No recursion will be performed on marked directories, so don't mark dir= ectories.) ;; ;; If no files are marked, traverse will search in element at point ;; with appropriate function. ;; ;; However, you can use specialized functions, check this file to see all ;; the interactives functions. ;; ;; M-x `traverse-dired-find-in-all-files' ;; Search in all regular files in the current dired buffer (no recursion). ;; ;; M-x `traverse-dired-browse-archive' ;; This function use (1)AVFS to browse archive tar.gz, bz2 etc.. ;; ;; (1)NOTE: You have to install AVFS and enable fuse in your kernel if ;; you want to browse and search in archives. ;; Please see the doc of your DISTRIB and the doc of AVFS here: ;; http://sourceforge.net/projects/avf ;; ;; If you want to use AVFS in traverse, set `traverse-use-avfs' to non--nil. ;; ;; Traverse provide also diverses functions to use in your programs. ;; (especially for recursion like `traverse-walk-directory'.) ;; ;; ;; Download: ;; =3D=3D=3D=3D=3D=3D=3D=3D ;; ;; You can get the development version of the file with hg: ;; ;; hg clone http://mercurial.intuxication.org/hg/traverselisp ;; For the current development branch: ;; hg update -C development ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Change log: ;; http://mercurial.intuxication.org/hg/traverselisp ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Version: (defconst traverse-version "2.10") ;;; Code: (require 'derived) (eval-when-compile (require 'cl)) (defvar traverse-mode-map (let ((map (make-sparse-keymap))) (define-key map [?q] 'traverse-quit) (define-key map [?N] 'traverse-go-forward) (define-key map [?P] 'traverse-go-backward) (define-key map [(shift down)] 'traverse-scroll-down-other-window) (define-key map [(shift up)] 'traverse-scroll-up-other-window) (define-key map [?|] 'traverse-toggle-split-window-h-v) (define-key map (kbd "C-z") 'traverse-jump-other-window) map) "Keymap used for traverse commands.") (define-derived-mode traverse-mode text-mode "traverse" "Major mode to recurse in a tree and perform diverses = actions on files. Special commands: \\{traverse-mode-map}") (defgroup traverse nil "Mode that allow walking through directories and perform diverses actions= on files." :prefix "traverse-" :group 'text) (defcustom traverse-ignore-files '(".elc$" ".pyc$" ".orig$" ".bz2$" ".gz$" ".zip$" ".vdi$" ".doc$" ".jpg$" ".avi$" ".jpeg$" ".png$" ".xpm$" ".jar$" ".pbm$" ".gif$" ".xls$" ".ppt$" ".mdb$" ".adp$" "\\<\\(TAGS\\)\\>" ".tiff$" ".img$" ".pdf$" ".dvi$" ".xbm$" ".gpg$" ".svg$" ".rej$") "Files we want to ignore. Are allowed:(examples) - extensions file =3D=3D> .ext - Plain name =3D=3D> TAGS ; note regexps take precedence on plain names. - Regexp =3D=3D> \".*\\(.py\\)$\"" :group 'traverse :type '(repeat string)) (defcustom traverse-ignore-dirs '(".hg" ".svn" "RCS" ".bzr" ".git" ".VirtualBox" ".arch-ids" "CVS" "{arch}" "knits") "Directories we don't want to search in." :group 'traverse :type '(repeat string)) (defcustom traverse-length-line 45 "Length of the line displayed in traverse buffers." :group 'traverse :type 'integer) (defcustom traverse-file-function 'traverse-file-process "Default function to use to process files." :group 'traverse :type 'symbol) (defcustom traverse-use-avfs nil "Enable support for avfs." :group 'traverse :type 'boolean) (defcustom traverse-avfs-default-directory "~/.avfs" "Default directory for avfs." :group 'traverse :type 'string) ;;; Faces for traverse (defgroup traverse-faces nil "Faces for TRAVERSE." :group 'traverse) (defface traverse-match-face '((t (:foreground "red"))) "TRAVERSE face." :group 'traverse-faces) (defface traverse-regex-face '((t (:foreground "yellow"))) "TRAVERSE face." :group 'traverse-faces) (defface traverse-path-face '((t (:foreground "green"))) "TRAVERSE face." :group 'traverse-faces) (defface traverse-overlay-face '((t (:background "Indianred4" :underline t)= )) "Face for highlight line in matched buffer." :group 'traverse-faces) ;;; User's variable (you can set these variables) (defvar traverse-match-overlay-face 'traverse-overlay-face "*Use the default traverse face for overlay.") (defvar traverse-show-regexp-delay 1 "*Delay in seconds where regexp found is highlighted.") (defvar traverse-keep-indent nil "*Keep indentation in traverse buffer if non nil.") ;;; Internal use only (DON'T modify) (defvar traverse-count-occurences 0 "Simple variable to store the number of occurence found.") (defvar traverse-occur-overlay nil) (make-variable-buffer-local 'traverse-occur-overlay) (defun traverselisp-version () "Give version number of traverselisp." (interactive) (message "traverse-lisp-version-%s" traverse-version)) ;;; Main backend functions (defun traverse-quit () "Quit and kill traverse buffer." (interactive) (quit-window t) (other-window 1) (delete-other-windows) (when traverse-occur-overlay (delete-overlay traverse-occur-overlay))) (defun traverse-list-directory (dirname &optional abs) "Use directory-files without these \".\" \"..\". If abs is non-nil use absolute path." ;; Use the same regexp as `directory-files-no-dot-files-regexp'. (let ((regexp "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) (directory-files dirname abs regexp))) (defsubst* traverse-walk-directory (dirname &key file-fn dir-fn exclude-fil= es exclude-dirs) "Walk through DIRNAME and use FILE-FN and/or DIR-FN function on each file= /dir found. DIRNAME =3D=3D> we start in this directory Use keys to set args: You must specify at list one of these 2 functions: :FILE-FN =3D=3D> function to apply to FILES :DIR-FN =3D=3D> function to apply on DIRECTORIES Files or/and directories in these lists will be skipped: :EXCLUDES-FILES =3D=3D> list of .ext or files to ignore. :EXCLUDE-DIRS =3D=3D> list of directory to ignore. Example of use: (traverse-walk-directory \"~/foo\" :file-fn #'(lambda (x) (princ x) (terpr= i))) See `traverse-ignore-files' and `traverse-ignore-dirs'." (labels ((walk (name) (cond (;; Is a directory and not a symlink. (eq t (car (file-attributes name))) (when dir-fn (funcall dir-fn name)) (if exclude-dirs (dolist (x (traverse-list-directory name t)) (when (stringp x) ; be sure x is a string and not nil (unless (member (file-name-nondirectory x) exclude-= dirs) (walk x)))) ; Return to TOP and take the good cond ;; Same but don't check excludes-dirs. (dolist (x (traverse-list-directory name t)) (when (stringp x) (walk x))))) ; Return to TOP and take the good cond ;; Is neither a directory nor a symbolic link. ((eq nil (car (file-attributes name))) (when file-fn (if exclude-files (unless (traverse-check-only-lists name exclude-files) (funcall file-fn name)) (funcall file-fn name))))))) (if (or file-fn dir-fn) (walk (expand-file-name dirname)) (error "Error:you must specify at least one function")))) (defun traverse-goto-line (numline) "Non--interactive version of `goto-line.'" (goto-char (point-min)) (forward-line (1- numline))) (defun traverse-comp-str-to-list (str lis) "Compare STR with all elements of list LIS. All the elements of list LIS are regexps issued from prompt. Each element of LIS is compared with the filename STR." (catch 'break (dolist (i lis) (when (string-match i str) (throw 'break t))))) (defun traverse-check-only-lists (str lis) "Check if STR match one element of LIS." (or (member (file-name-extension str t) lis) (traverse-comp-str-to-list str lis))) (defsubst* traverse-find-readlines (bfile regexp &key (insert-fn 'buffer)) "Return an alist of all the (numline line) matching REGEXP." (let ((fn (case insert-fn ('file 'insert-file-contents) ('buffer 'insert-buffer-substring)))) (with-temp-buffer (funcall fn bfile) ; call insert function (goto-char (point-min)) (loop with lines-list =3D (split-string (buffer-string) "\n") for i in lines-list for count from 0 when (string-match regexp i) collect (list count i) into lis finally return lis)))) (defun traverse-file-process (regex fname &optional full-path insert-fn) "Default function to process files and insert matched lines in *traverse-= lisp* buffer." (let ((matched-lines (traverse-find-readlines fname regex :insert-fn (or = insert-fn 'file)))) (when matched-lines (dolist (i matched-lines) ; each element is of the form '(key value) (let ((line-to-print (if traverse-keep-indent (second i) (replace-regexp-in-string "\\(^ *\\)" "" (= second i))))) (and (cond ((eq insert-fn 'file) (insert-button (format "[%s]" (if full-path fname (file-relative-name fname = default-directory))) 'action 'traverse-button-func 'face "hi-green")) ((eq insert-fn 'buffer) (insert-button (format "[%s]" (buffer-name fname)) 'action 'traverse-button-func 'face "hi-green"))) (insert (concat " " (int-to-string (+ (first i) 1)) ":" (if (> (length line-to-print) traverse-lengt= h-line) (substring line-to-print 0 traverse-leng= th-line) line-to-print) "\n")))))) (setq traverse-count-occurences (+ traverse-count-occurences (length ma= tched-lines))))) (defun* traverse-file-process-ext (regex fname &key (lline traverse-length-= line)) "Function to process files in external program like anything." (setq traverse-count-occurences 0) (let ((matched-lines (traverse-find-readlines fname regex :insert-fn 'fil= e))) (when matched-lines (dolist (i matched-lines) ;; each element is of the form '(key value) (let* ((ltp (second i)) (replace-reg (if (string-match "^\t" ltp) "\\(^\t*\\)" "\\= (^ *\\)")) (new-ltp (replace-regexp-in-string replace-reg "" ltp)) (line-to-print (if traverse-keep-indent ltp new-ltp))) (incf traverse-count-occurences) (insert (concat (propertize (file-name-nondirectory fname) 'face 'traverse-path-face 'help-echo line-to-print) " " (propertize (int-to-string (+ (first i) 1)) 'face 'traverse-match-face) ":" (if (> (length line-to-print) lline) (substring line-to-print 0 lline) line-to-print) "\n"))))))) (defun* traverse-buffer-process-ext (regex buffer &key (lline traverse-leng= th-line)) "Function to process buffer in external program like anything." (setq traverse-count-occurences 0) (let ((matched-lines (traverse-find-readlines buffer regex :insert-fn 'bu= ffer))) (when matched-lines (dolist (i matched-lines) ; Each element is of the form '(key value) (let* ((ltp (second i)) (replace-reg (if (string-match "^\t" ltp) "\\(^\t*\\)" "\\= (^ *\\)")) (new-ltp (replace-regexp-in-string replace-reg "" ltp)) (line-to-print (if traverse-keep-indent ltp new-ltp))) (incf traverse-count-occurences) (insert (concat " " (propertize (int-to-string (+ (first i) 1)) 'face 'traverse-match-face 'help-echo line-to-print) ":" (if (> (length line-to-print) lline) (substring line-to-print 0 lline) line-to-print) "\n"))))))) ;;;###autoload (defun traverse-find-in-file (fname regexp &optional full-path) "Traverse search regex in a single file." (interactive (list (read-file-name "FileName: ") (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")))) (traverse-prepare-buffer) (let ((prefarg (not (null current-prefix-arg)))) (if (and (not (bufferp fname)) (file-regular-p fname) (not (file-symlink-p fname))) (traverse-file-process regexp fname prefarg 'file) (traverse-file-process regexp fname prefarg 'buffer)) (goto-char (point-min)) (when (re-search-forward "^Wait") (beginning-of-line) (delete-region (point) (line-end-position)) (insert (format "Found %s occurences for %s:\n" traverse-count-occurences regexp)) (message "%s Occurences found for %s" (propertize (int-to-string traverse-count-occurences) 'face 'traverse-match-face) (propertize regexp 'face 'traverse-regex-face)) (highlight-regexp regexp) (setq traverse-count-occurences 0))) (switch-to-buffer-other-window "*traverse-lisp*")) (defun traverse-occur-color-current-line () "Highlight and underline current position." (if (not traverse-occur-overlay) (setq traverse-occur-overlay (make-overlay (line-beginning-position) (1+ (line-end-position)))) (move-overlay traverse-occur-overlay (line-beginning-position) (1+ (line-end-position)))) (overlay-put traverse-occur-overlay 'face traverse-match-overlay-face)) (defun traverse-button-func (button) "The function called by buttons in traverse buffers." (let* ((list-line (split-string (thing-at-point 'line))) (nline (nth 1 list-line)) (fname (button-label (button-at (point))))) (save-excursion (setq fname (replace-regexp-in-string "\\(\\[\\|\\]\\)" "" fname)) (if (bufferp (get-buffer fname)) (switch-to-buffer-other-window (get-buffer fname)) (find-file-other-window fname)) (traverse-goto-line (string-to-number nline)) (beginning-of-line) (traverse-occur-color-current-line)))) (defun traverse-prepare-buffer () "Prepare a traverse buffer." (set-buffer (get-buffer-create "*traverse-lisp*")) (erase-buffer) (hi-lock-mode 1) (goto-char (point-min)) (traverse-mode) (insert " *Traverse-lisp-output*\n\n\n") (highlight-regexp " \\*Traverse-lisp-output\\*$" "hi-pink") (display-buffer "*traverse-lisp*") (insert "Wait Lisp searching...\n\n") (sit-for 1)) (defun traverse-read-regexp (&rest args) "For compatibility with emacs-22. Use `read-string' in emacs-22 instead of using `read-regexp'. Use the same args as `read-string' or `read-regexp' depending of what emacs version you use. NOTE:When using `read-string' some regexp (complex) may not be displayed correctly to traverselisp" (apply #'funcall (if (fboundp 'read-regexp) 'read-regexp 'read-string) args)) ;;;###autoload (defun traverse-deep-rfind (tree regexp &optional only) "Search for regexp in all files of dirs and subdirs of current tree. Main function that call walk, if only is omitted it will be set as nil and search will be proceeded on all files except on files that are in `traverse-ignore-files' Called with prefix-argument (C-u) absolute path is displayed" (interactive (list (read-directory-name "Tree: ") (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp" "Regexp:= ")) (read-string "CheckOnly: "))) (traverse-prepare-buffer) (let ((init-time (cadr (current-time))) (only-list (split-string only))) (unwind-protect (traverse-walk-directory tree :file-fn #'(lambda (y) (let ((prefarg (not (null current-prefix-arg)))) (if only-list (when (traverse-check-only-lists y only-list) (funcall traverse-file-function regexp y pre= farg 'file)) (funcall traverse-file-function regexp y prefa= rg 'file))) (message "[%s] Matches for `%s'" (if (>=3D traverse-count-occurences 1) (int-to-string traverse-count-occurence= s) 0) regexp)) :exclude-files (unless only-list traverse-ignore-files) :exclude-dirs traverse-ignore-dirs) (setq traverse-count-occurences (if (< traverse-count-occurences 0) 0 traverse-count-occurences)) (goto-char (point-min)) (when (re-search-forward "^Wait") (beginning-of-line) (delete-region (point) (line-end-position)) (if (eq traverse-count-occurences 0) (insert "Oh!No! Nothing found!") (insert (format "Search performed in %s seconds\n\nFound %s occurences= for %s\n" (- (cadr (current-time)) init-time) traverse-count-occurences regexp)))) (message "%s Occurences found for %s in %s seconds" (int-to-string traverse-count-occurences) regexp (- (cadr (current-time)) init-time)) (highlight-regexp regexp) (setq traverse-count-occurences 0))) (switch-to-buffer-other-window "*traverse-lisp*")) ;;; Dired functions ;;;###autoload (defun traverse-search-in-dired-dir-at-point (regex &optional only) "Search for regexp in all files of directory at point in a dired buffer." (interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")) (read-string "CheckOnly: "))) (if (eq major-mode 'dired-mode) (let ((tree (dired-get-filename))) (if (file-directory-p tree) (traverse-deep-rfind tree regex only) (message "Sorry! %s is not a Directory" tree))) (message "Hoops! We are not in Dired!"))) ;;;###autoload (defun traverse-search-in-dired-file-at-point (regex) "Search for regexp in file at point in a dired buffer." (interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")))) (if (eq major-mode 'dired-mode) (let ((fname (dired-get-filename))) (if (file-regular-p fname) (traverse-find-in-file fname regex) (message "Sorry! %s is not a regular file" fname))) (message "Hoops! We are not in Dired!"))) ;;;###autoload (defun traverse-dired-browse-archive () "Open compressed archive at point in a dired buffer. This function use AVFS and FUSE, so be sure to have these programs and modules installed on your system." (interactive) (when traverse-use-avfs (let ((file-at-point (dired-get-filename))) (if (file-compressed-p file-at-point) (progn (when (not (cddr (directory-files traverse-avfs-default-directo= ry))) (shell-command "mountavfs")) (find-file (concat traverse-avfs-default-directory file-at-poin= t "#"))) (find-file file-at-point))))) ;;;###autoload (defun traverse-dired-search-in-archive (regexp &optional only) "Search for regexp in compressed archive at point in a dired buffer. This function use AVFS and FUSE, so be sure to have these programs installed on your system and FUSE module enabled in your kernel. This function is disabled by default, enable it setting traverse-use-avfs to non--nil" (interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")) (read-string "CheckOnly: "))) (when traverse-use-avfs (let ((file-at-point (dired-get-filename))) (if (file-compressed-p file-at-point) (progn (when (not (cddr (directory-files traverse-avfs-default-directo= ry))) (shell-command "mountavfs")) (traverse-deep-rfind (concat traverse-avfs-default-directory fi= le-at-point "#") regexp only)) (message "That's not a compressed file"))))) ;;;###autoload (defun traverse-dired-find-in-marked-files (regexp &optional full-path) "Search for regexp in all marked files of a dired buffer. if some of the marked files are directories ignore them if no marked files use file at point." (interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")))) (let ((prefarg (not (null current-prefix-arg))) (fname-list (traverse-dired-get-marked-files))) (traverse-prepare-buffer) (dolist (i fname-list) (traverse-file-process regexp i prefarg 'file)) (goto-char (point-min)) (when (re-search-forward "^Wait") (beginning-of-line) (delete-region (point) (line-end-position)) (insert (format "Found %s occurences for %s:\n" traverse-count-occurences regexp)) (message "%s Occurences found for %s" (propertize (int-to-string traverse-count-occurences) 'face 'traverse-match-face) (propertize regexp 'face 'traverse-regex-face)) (highlight-regexp regexp) (setq traverse-count-occurences 0))) (switch-to-buffer-other-window "*traverse-lisp*")) (defun traverse-dired-find-in-all-files (regexp only &optional full-path) "Search for regexp in all files of current dired buffer. except compressed files and symlinks" (interactive (list (traverse-read-regexp (if (fboundp 'read-regexp) "Rege= xp" "Regexp: ")) (read-string "CheckOnly: "))) (let ((prefarg (not (null current-prefix-arg))) (all-files (traverse-list-directory (dired-current-directory))) (only-list (split-string only))) (traverse-prepare-buffer) (dolist (i all-files) (when (and (file-regular-p i) (not (file-symlink-p i)) (not (file-compressed-p i)) (if only-list (traverse-check-only-lists i only-list) (not (traverse-check-only-lists i traverse-ignore-file= s)))) (traverse-file-process regexp i prefarg 'file))) (goto-char (point-min)) (when (re-search-forward "^Wait") (beginning-of-line) (delete-region (point) (line-end-position)) (insert (format "Found %s occurences for %s:\n" traverse-count-occurences regexp)) (message "%s Occurences found for %s" (propertize (int-to-string traverse-count-occurences) 'face 'traverse-match-face) (propertize regexp 'face 'traverse-regex-face)) (highlight-regexp regexp) (setq traverse-count-occurences 0))) (switch-to-buffer-other-window "*traverse-lisp*")) (defun traverse-dired-get-marked-files (&optional strict) "Get a list of all marked files in a dired buffer for traverse." (let* ((fname-list nil) (all-marked (dired-get-marked-files nil nil nil t)) (dir-marked-list (if strict (if (symbolp (car all-marked)) (cdr all-marked) (when (> (length all-marked) 1) all-marked)) (if (symbolp (car all-marked)) (cdr all-marked) all-marked)))) (dolist (i dir-marked-list) (when (and (not (file-directory-p i)) (not (file-compressed-p i))) (push i fname-list))) (nreverse fname-list))) ;;;###autoload (defun traverse-dired-search-regexp-in-anything-at-point (regexp &optional = only) "Use the right function in dired depending on context. Search in: file at point or marked files or directory at point (recursion) or in compressed archive at point if traverse-use-avfs is non--nil." (interactive (let ((f-or-d-name (dired-get-filename))) (cond ((traverse-dired-get-marked-files) (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp"= "Regexp: ")))) ((or (file-directory-p f-or-d-name) (and (file-regular-p f-or-d-name) (file-compressed-p f-or-d-name))) (list (traverse-read-regexp (if (fboundp 'read-regexp) "Regexp"= "Regexp: ")) (read-string "CheckOnly: ")))))) (let ((fname (dired-get-filename))) (cond ((traverse-dired-get-marked-files) (traverse-dired-find-in-marked-files regexp)) ((file-directory-p fname) (traverse-search-in-dired-dir-at-point regexp only)) ((and (file-regular-p fname) (file-compressed-p fname)) (traverse-dired-search-in-archive regexp only))))) ;;;; Navigate in traverse (defun traverse-go-forward-or-backward (num) "Go to next or precedent occurence in a traverse buffer." (other-window -1) (when (buffer-file-name (current-buffer)) (save-buffer) (kill-buffer (current-buffer))) (other-window -1) (forward-button num) (push-button) (other-window -1)) (defun traverse-jump-other-window () (interactive) (push-button) (other-window -1)) (defun traverse-go-forward (&optional num) "Go to next occurence and open file with point at the right place in othe= r window." (interactive "p") (traverse-go-forward-or-backward (or num 1))) (defun traverse-go-backward (&optional num) "Go to next occurence and open file with point at the right place in othe= r window." (interactive "p") (traverse-go-forward-or-backward (- (or num 1)))) (defun traverse-scroll-down-other-window () "Scroll other window down from a traverse buffer." (interactive) (when (equal (current-buffer) (get-buffer "*traverse-lisp*")) (scroll-other-window 1))) (defun traverse-scroll-up-other-window () "Scroll other window up from a traverse buffer." (interactive) (when (equal (current-buffer) (get-buffer "*traverse-lisp*")) (scroll-other-window -1))) ;;;; Utils (defun file-compressed-p (fname) "Return t if FNAME is a compressed file." (let ((ext (file-name-extension fname))) (member ext '("gz" "bz2" "zip")))) (defun traverse-window-split-h-or-t () "Give current split window state under symbol form. Possible value are 'hor or 'ver" (cdr (assoc 'dir (bw-get-tree)))) ;;;###autoload (defun traverse-toggle-split-window-h-v () "From traverse buffer toggle split window horizontally or vertically ala = ediff." (interactive) (when (eq (count-windows) 2) (balance-windows) (let ((buffA (current-buffer)) (buffB) (split-pos (traverse-window-split-h-or-t))) (save-excursion (other-window 1) (setq buffB (current-buffer)) (delete-window)) (if (eq split-pos 'hor) (split-window-vertically) (split-window-horizontally)) (set-buffer (get-buffer buffB)) (display-buffer (current-buffer))))) ;;;###autoload (defun traverse-count-files-in-dir (tree &optional quiet) "Count files in TREE. and return a message and the number of files. If `quiet' is non-nil don't send message." (interactive "DDirectory: ") (let ((count-files 0)) (traverse-walk-directory tree :file-fn #'(lambda (n) (when n (incf count-files)))) (unless quiet (message "[%s] contain <%s> files" (propertize tree 'face 'traverse-path-face) (propertize (number-to-string count-files) 'face 'traverse-match-face))) count-files)) (defun traverse-list-directories-in-tree (tree &optional ignore-dirs) "Return all directories and subdirectories of TREE. IGNORE-DIRS is a list of directories to ignore." (let (list-dirs) (traverse-walk-directory tree :dir-fn #'(lambda (x) (push x list-dirs)) :exclude-dirs (if ignore-dirs ignore-dirs)) (nreverse list-dirs))) (defun* traverse-list-files-in-tree (tree &optional (ignore-files traverse-ignore-files) (ignore-dirs traverse-ignore-dirs) only-ext) "Return all files in TREE without directories. IGNORE-FILES is a list of files(and/or).ext to ignore. ONLY-EXT will match only files with .ext or matching regexp that are in thi= s list. NOTE: if both IGNORE-FILES and ONLY-EXT' are set, ONLY-EXT will take preced= ence on IGNORE-FILES." (let (list-files) (traverse-walk-directory tree :file-fn #'(lambda (x) (if only-ext (if (traverse-check-only-lists x only-ext) (push x list-files)) (push x list-files))) :exclude-files (unless only-ext (if ignore-files ignore-files)) :exclude-dirs ignore-dirs) (nreverse list-files))) (defmacro traverse-collect-files-in-tree-if (tree pred) "Return a list of files matching PRED in TREE. PRED is a function that take one arg." `(let ((flist ())) (traverse-walk-directory ,tree :file-fn #'(lambda (x) (when (funcall ,pred x) (push x flist)))) flist)) (defmacro traverse-collect-files-in-tree-if-not (tree pred) "Return a list of files not matching PRED in TREE. PRED is a function that take one arg." `(let ((flist ())) (traverse-walk-directory ,tree :file-fn #'(lambda (x) (unless (funcall ,pred x) (push x flist)))) flist)) (defun* traverse-mv-files-in-tree (tree dest ext &key test-only (fn 'rename-file) (confirm 'noconfirm)) "Copy or Move all files in TREE with EXT to DEST. FN determine which of `copy-file' or `rename-file' is used. CONFIRM can be one of 'noconfirm, nil(signal error), \ or any number value to ask for confirmation. If TEST-ONLY is non--nil only print a buffer signaling what will be done." (let ((f-to-rename (traverse-collect-files-in-tree-if tree #'(lambda (x) (if (listp ext) (loop for i in ext when (string=3D (file-name-extension x) i)= return t) (string=3D (file-name-extension x) ext)))))) (if test-only (progn (with-current-buffer (get-buffer-create "*test buffer*") (erase-buffer) (loop for f in f-to-rename do (insert (format "%s %s\n" (file-nam= e-nondirectory f) dest)))) (switch-to-buffer "*test buffer*") (align-regexp (point-min) (point-max) "\\(\\s-*\\)" 1 1 nil) (unless (file-exists-p dest) (insert (format "WARNING:<%s> doesn't exist and will have to be= created." dest)))) (unless (file-exists-p dest) (if (y-or-n-p (format "%s doesn't exists, create it? " dest)) (make-directory dest) (error "Abort: %s doesn't exists." dest))) (loop for f in f-to-rename do (funcall fn f dest confirm)) (message "%d files %s to %s" (length f-to-rename) (if (eq 'fn 'rename-file) "renamed" "copied") dest)))) ;; Provide (provide 'traverselisp) ;;; traverselisp.el ends here --=-=-=--