1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
;;;; tilde.jl -- File handler for tilde expansion
;;; Copyright (C) 1998 John Harper <john@dcs.warwick.ac.uk>
;;; $Id: tilde.jl,v 1.9 1999/11/25 23:20:27 john Exp $
;;; This file is part of Jade.
;;; Jade 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.
;;; Jade 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 Jade; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(defun tilde-expand (file-name)
(if (string-looking-at "~([^/]*)/?" file-name)
(concat
(if (/= (match-start 1) (match-end 1))
;; ~USER/...
(user-home-directory (substring file-name
(match-start 1)
(match-end 1)))
;; ~/..
(user-home-directory))
(substring file-name (match-end)))
file-name))
(defun tilde-file-handler (op &rest args)
(cond
((eq op 'file-name-absolute-p)) ;~FOO always absolute
((eq op 'expand-file-name)
;; Slightly tricky. It's necessary to remove the tilde, call
;; expand-file-name, then reapply the tilde. This is to ensure
;; that things like "~/foo/../bar" expand to "~/bar"
(let
((file-name (car args)))
(if (string-looking-at "~[^/]*/?" file-name)
(concat (substring file-name (match-start) (match-end))
(expand-file-name (substring file-name (match-end)) "."))
file-name)))
((memq op '(file-name-nondirectory file-name-directory
file-name-as-directory directory-file-name))
;; Functions of a single file name that we leave alone. By re-calling
;; OP the standard action will occur since this handler is now
;; blocked for OP.
(apply (symbol-value op) args))
((memq op '(local-file-name canonical-file-name open-file
write-buffer-contents read-file-contents insert-file-contents
delete-file delete-directory make-directory file-exists-p
file-regular-p file-readable-p
file-writable-p file-directory-p file-symlink-p file-owner-p
file-nlinks file-size file-modes file-modes-as-string
set-file-modes file-modtime directory-files
read-symlink make-symlink))
;; All functions which only have a single file name (their first
;; argument). Expand the tilde expression then re-call OP.)
(apply (symbol-value op) (tilde-expand (car args)) (cdr args)))
(t
;; Anything else shouldn't have happened
(error "Can't expand ~ in %s" (cons op args)))))
;; Runtime initialisation
(progn
;; Install the handler
(setq file-handler-alist (cons '("^~" . tilde-file-handler)
file-handler-alist))
;; Fix the initial default-directory; replacing $HOME by ~ if possible
(when (string-looking-at (concat (quote-regexp
(canonical-file-name
(user-home-directory)))
"?(.*)$") default-directory)
(setq-default default-directory (expand-last-match "~/\\1"))))
|
