bug#4902: 23.1; directory-abbrev-alist is not handled early enough

[Stefan Monnier <monnier@iro.umontreal.ca>]

> Obviously, there are too many different names for the same file,
> and I want Emacs to normalize all files to a canonical
> form; i.e. all the variations of my network home should
> be normalized to u:/ and so forth.

> directory-abbrev-alist:

> '(("^//dntsrc/u/sasdjb" . "u:")
>   ("^/u/sasdjb" . "u:")
>   ("^//sashq/root/u/sasdjb" . "u:")
>   ("^/nfs/sanyo/vol/vol2/u22/sasdjb" . "u:/")
>   ("^//sashq/root/u/sasdjb" . "u:")
>   ("^/sas/" . "//dntsrc/sas/")
>   ("^/sasgen" . "//dntsrc/sasgen/"))

The way I see it, the problem really is in the way you organize and use
your naming structure.  So "the right solution" would be a combination
of discipline, conventions, and symlinks to sort out this mess and make
sure that you see much fewer variations of filenames and that all the
ones you see work everywhere (via symlinks, for example).

Now, I understand this may not be practically feasible for you, but
I think that changing Emacs to accomodate this particular situation is
a bit hard to justify.

OTOH, Emacs does provide enough hooks already for you to be able to make
it work, I think.  The hook you want is file-name-handler-alist.
The only problem with it, is that it's very powerful and quite a bit
trickier to use than directory-abbrev-alist.

You could try the code below (guaranteed 100% untested).


        Stefan


(defvar djb-filemess-remappings
  '(("\\`/\\(/dntsrc/u\\|u\\|/sashq/root/u\\|nfs/sanyo/vol/vol2/u22\\)/sasdjb"
     . "u:")
    ("\\`/\\(sas\\(gen\\)?\\)/" . "//dntsrc/\\1/")))

(defun djb-filemess-run-real-handler (operation args)
  (let ((inhibit-file-name-handlers
         (cons 'djb-filemess-handler
               (and (eq inhibit-file-name-operation operation)
                    inhibit-file-name-handlers)))
        (inhibit-file-name-operation operation))
    (apply operation args))))

(defun djb-filemess-handler (operation &rest args)
  (let ((fn (get operation 'djb-filemess-handler)))
    (if fn (funcall fn operation args)
      (djb-filemess-run-real-handler operation args))))

(defun djb-filemess-remap-1 (operation args)
  (let ((file (car args))
        (remappings djb-filemess-remappings)
        newfile)
    (while (and (null newfile) remappings)
      (if (string-match (caar remappings) file)
          (setq newfile (replace-match (cdar remappings) t nil file))
        (setq remappings (cdr remappings))))
    (djb-filemess-run-real-handler operation
                                  (cons (or newfile file) (cdr args)))))

(put 'expand-file-name 'djb-filemess-handler 'djb-filemess-remap-1)
(put 'substitute-in-file-name 'djb-filemess-handler 'djb-filemess-remap-1)

(dolist (remapping djb-filemess-remappings)
  (push (cons (car remapping) 'djb-filemess-handler)
        file-name-handler-alist))