Finding files by substrings in Emacs and Gnus

Finding files by substrings in Emacs and Gnus

[François Pinard]

Hi, people and friend.

Let me share some Emacs LISP code I'm using since a few days (adapted
from some older code), and which I find very convenient for my own needs.
You might have to adapt it for yourself, I did not try to generalise the
thing, yet I might try to do so if people show me interest and direction.

The problem is when you often have to locate a file among Emacs from some big
"locate"-able subset of all your files, and you do not necessarily remember
the path going to that file.  (In my case, these are Babyl files, I have
nearly 4000 of them, their names systematically have either `rmail' for
one directory component, or `RMAIL' as the basename, or a prefix thereof.)

The following code, admittedly ugly (if you find a better way, tell me! :-),
reads a substring of the file name from the mini-buffer.  Completion at
that point resolves in the file name system, and if there is any slash in
your reply, then it is taken as is.  If your entry does not have a slash,
but names an existing file in the current directory (currently geared to
be your home directory), then your reply means this file.

Otherwise, the code tries to find a file in your defined subset.  If there
is only one match, that's it.  If there is more than one match, a second
interaction resolves it with completion.  Otherwise, no file has been
selected, and the calling function (for example, `find-file') might interact
on its own to get the wanted file name.  Here is the code of the engine,
followed by more comments, introducing two simple applications for this.

The code takes a few seconds on the first call to build the subset cache,
but is quite fast afterwards, in my case at least.

---------------------------------------------------------------------->
(defvar fp-force-read-file-name nil)
(defadvice read-file-name (around fp-force-read-file-name activate)
  (if fp-force-read-file-name
      (setq ad-return-value fp-force-read-file-name
	    fp-force-read-file-name nil)
    ad-do-it))

(defun fp-prepare-read-babyl-name (&optional default)
  (let* ((string (read-file-name (concat "Gabarit Babyl? "
					 (and default
					      (concat "(" default ") ")))
				 ""))
	 (filename (if (string-match "^[~/]" string)
		       string
		     (concat "~/" string))))
    (cond
     ((string-equal string "") default)
     ((string-match "/" string) (setq fp-force-read-file-name filename))
     ((file-regular-p filename) (setq fp-force-read-file-name filename))
     (t (save-excursion
	  (set-buffer (get-buffer-create "*babyl-file-list*"))
	  (goto-char (point-min))
	  (when (eobp)
	    (shell-command (concat "locate /rmail/ /RMAIL | sed -n s,"
				   (getenv "HOME") "/,,p | grep -v '~$'")
			   t)
	    (goto-char (point-min)))
	  (let (table start file)
	    (while (re-search-forward string nil t)
	      (beginning-of-line)
	      (setq start (point))
	      (end-of-line)
	      (setq file (buffer-substring start  (point)))
	      (forward-char 1)
	      (when (file-exists-p file)
		(push (list file) table)))
	    (cond ((= (length table) 0) default)
		  ((= (length table) 1) (setq fp-force-read-file-name
					      (concat "~/"(caar table))))
		  (t (let ((string (completing-read
				    (concat "Choix? "
					    (and default
						 (concat "(" default ") ")))
				    table nil nil nil 'file-name-history)))
		       (if (string-equal string "")
			   default
			 (setq fp-force-read-file-name
			       (if (string-match "^[~/]" string)
				   string
				 (concat "~/" string)))))))))))))
----------------------------------------------------------------------<

I bound `C-c M' to find a file through this mechanism, when I want to open
some Babyl file from my set.  It's very simple.  (I have some other code,
not shown here, that immediately triggers a Gnus summary view of any Babyl
file on its initial visit -- also very convenient for me.)

---------------------------------------------------------------------->
(defun fp-find-babyl-file ()
  (interactive)
  (find-file (fp-prepare-read-babyl-name)))
(global-set-key "\C-cM" 'fp-find-babyl-file)
----------------------------------------------------------------------<

A Gnus application is when I want to save a Usenet article or received
message in some Babyl file.  The following greatly speeds up operations.
I maintain an association list which "hints" a default save place from
the name of the mailgroup or newsgroup, this other trick helps me even more.

---------------------------------------------------------------------->

(defconst fp-default-save-group-alist
  '(("alt.answers" "1/")
    ("bpi.laurent" "bpi/admin/rmail/")
    ; [...]
    ("syst.linux" "syst/linux/rmail/")
    ("syst.microsoft" "syst/usoft/rmail/MSDN")))

(defun fp-select-default-save-group (group)
  (when (string-match "^nn[a-z]+:\\(.*\\)" group)
    (setq group (substring group (match-beginning 1) (match-end 1))))
  (fp-prepare-read-babyl-name
   (or (let ((pair (assoc group fp-default-save-group-alist)))
	 (and pair (concat "~/" (cadr pair))))
       (gnus-article-archive-name group))))
(defconst gnus-split-methods '((fp-select-default-save-group)))
----------------------------------------------------------------------<

-- 
François Pinard   http://www.iro.umontreal.ca/~pinard