Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-fnh.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 8b8b7f3559a2
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-fnh.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.3 $
7 ;; RCS:
8 ;; Description: Look for the emacs version, and install into
9 ;; the file-name-handler-alist
10 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
11 ;;
12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
14 ;;; Although used by efs, these utilities could be of general use to other
15 ;;; packages too. Keeping them separate from the main efs program
16 ;;; makes it easier for other programs to require them.
17
18 (provide 'efs-fnh)
19
20 (defconst efs-fnh-version
21 (concat (substring "$efs release: 1.15 $" 14 -2)
22 "/"
23 (substring "$Revision: 1.3 $" 11 -2)))
24
25 ;;;; ----------------------------------------------------------------
26 ;;;; Loading emacs version files
27 ;;;; ----------------------------------------------------------------
28
29 (defun efs-handle-emacs-version ()
30 ;; Load appropriate files for the current emacs version
31 (let ((ehev-match-data (match-data)))
32 (unwind-protect
33 (let ((lucidp (string-match "Lucid" emacs-version))
34 ver subver)
35 (or (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
36 (error "efs does not work with emacs version %s" emacs-version))
37 (setq ver (string-to-int (substring emacs-version
38 (match-beginning 1)
39 (match-end 1)))
40 subver (string-to-int (substring emacs-version
41 (match-beginning 2)
42 (match-end 2))))
43 (cond
44
45 ;; Lucid XEmacs (emacs-version looks like \"19.xx XEmacs Lucid\")
46 (lucidp
47 (cond
48 ((and (= ver 19) (>= subver 11) (< subver 15))
49 (require 'efs-l19\.11))
50 ((and (= ver 19) (>= subver 15))
51 (require 'efs-x19\.15))
52 ((= ver 20)
53 (require 'efs-x19\.15))
54 (t
55 (error
56 "efs does not work with emacs version %s" emacs-version))))
57
58 ;; Original GNU Emacs from FSF
59 (t
60 (cond
61 ((and (= ver 19) (<= subver 22))
62 (require 'efs-19))
63 ((and (= ver 19) (>= subver 23))
64 (require 'efs-19\.23))
65
66 ;; GNU Emacs 18-
67 ((<= ver 18)
68 (require 'efs-18)) ; this file will (require 'emacs-19)
69
70 (t
71 (error
72 "efs does not work with emacs version %s" emacs-version))))))
73
74 (store-match-data ehev-match-data))))
75
76 ;;;; --------------------------------------------------------------
77 ;;;; Stuff for file name handlers.
78 ;;;; --------------------------------------------------------------
79
80 ;;; Need to do this now, to make sure that the file-name-handler-alist is
81 ;;; defined for Emacs 18.
82
83 (efs-handle-emacs-version)
84
85 ;; Also defined in efs-cu.el
86 (defvar efs-path-root-regexp "^/[^/:]+:"
87 "Regexp to match the `/user@host:' root of an efs full path.")
88
89 (defun efs-file-name-handler-alist-sans-fn (fn)
90 ;; Returns a version of file-name-handler-alist without efs.
91 (delq nil (mapcar
92 (function
93 (lambda (x)
94 (and (not (eq (cdr x) fn)) x)))
95 file-name-handler-alist)))
96
97 (defun efs-root-handler-function (operation &rest args)
98 "Function to handle completion in the root directory."
99 (let ((handler (get operation 'efs-root)))
100 (if handler
101 (apply handler args)
102 (let ((inhibit-file-name-handlers
103 (cons 'efs-root-handler-function
104 (and (eq inhibit-file-name-operation operation)
105 inhibit-file-name-handlers)))
106 (inhibit-file-name-operation operation))
107 (apply operation args)))))
108
109 (put 'file-name-completion 'efs-root 'efs-root-file-name-completion)
110 (put 'file-name-all-completions 'efs-root 'efs-root-file-name-all-completions)
111 (autoload 'efs-root-file-name-all-completions "efs-netrc")
112 (autoload 'efs-root-file-name-completion "efs-netrc")
113
114 (autoload 'efs-file-handler-function "efs"
115 "Function to use efs to handle remote files.")
116
117 ;; Install into the file-name-handler-alist.
118 ;; If we are already there, remove the old entry, and re-install.
119 ;; Remove the ange-ftp entry too.
120
121 (setq file-name-handler-alist
122 (let (dired-entry alist)
123 (setq alist
124 (nconc
125 (list
126 (cons efs-path-root-regexp 'efs-file-handler-function)
127 '("^/$" . efs-root-handler-function))
128 (delq nil
129 (mapcar
130 (function
131 (lambda (x)
132 (if (eq (cdr x) 'dired-handler-fn)
133 (progn
134 (setq dired-entry x)
135 nil)
136 (and (not
137 (memq (cdr x)
138 '(efs-file-handler-function
139 efs-root-handler-function
140 ange-ftp-hook-function
141 ange-ftp-completion-hook-function)))
142 x))))
143 file-name-handler-alist))))
144 ;; Make sure that dired is in first.
145 (if dired-entry (cons dired-entry alist) alist)))
146
147 ;;; end of efs-fnh.el