cgit.sxemacs.org Git - packages/blob - xemacs-packages/efs/efs-fnh.el

   1 ;; -*-Emacs-Lisp-*-
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; File:         efs-fnh.el
   5 ;; Release:      $efs release: 1.24 $
   6 ;; Version:      #Revision: 1.5 $
   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.24 $" 14 -2)
  22           "/"
  23           (substring "#Revision: 1.4 $" 11 -2)))
  24
  25 ;;;###autoload
  26 (defvar allow-remote-paths t
  27    "*Set this to nil if you don't want remote paths to access
  28 remote files.")
  29
  30 ;;;; ----------------------------------------------------------------
  31 ;;;; Loading emacs version files
  32 ;;;; ----------------------------------------------------------------
  33
  34 (defun efs-handle-emacs-version ()
  35   ;; Load appropriate files for the current emacs version
  36   (let ((ehev-match-data (match-data)))
  37     (unwind-protect
  38         (let ((xemacsp (string-match "XEmacs" emacs-version))
  39               (ver emacs-major-version)
  40               (subver emacs-minor-version))
  41           (unless ver
  42             (or (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version)
  43                 (error "efs does not work with emacs version %s" emacs-version))
  44             (setq ver (string-to-int (substring emacs-version
  45                                                 (match-beginning 1)
  46                                                 (match-end 1)))
  47                   subver (string-to-int (substring emacs-version
  48                                                    (match-beginning 2)
  49                                                    (match-end 2)))))
  50           (cond
  51
  52            ;; XEmacs (emacs-version looks like \"19.xx XEmacs\")
  53            (xemacsp
  54             (cond
  55              ((and (= ver 19) (>= subver 11) (< subver 15))
  56               (require 'efs-l19\.11))
  57              ((and (= ver 19) (>= subver 15))
  58               (require 'efs-x19\.15))
  59              ((>= ver 20)
  60               (require 'efs-x19\.15))
  61              (t
  62               (error
  63                "efs does not work with emacs version %s" emacs-version))))
  64
  65            ;; Original GNU Emacs from FSF
  66            (t
  67             (cond
  68              ((and (= ver 19) (<= subver 22))
  69               (require 'efs-19))
  70              ((and (= ver 19) (< subver 34))
  71               (require 'efs-19\.23))
  72              ((and (= ver 19) (>= subver 34))
  73               (require 'efs-19\.34))
  74              ((>= ver 20)
  75               (require 'efs-19\.34))
  76              ;; GNU Emacs 18-
  77              ((<= ver 18)
  78               (require 'efs-18)) ; this file will (require 'emacs-19)
  79
  80              (t
  81               (error
  82                "efs does not work with emacs version %s" emacs-version))))))
  83
  84       (store-match-data ehev-match-data))))
  85
  86 ;;;; --------------------------------------------------------------
  87 ;;;; Stuff for file name handlers.
  88 ;;;; --------------------------------------------------------------
  89
  90 ;;; Need to do this now, to make sure that the file-name-handler-alist is
  91 ;;; defined for Emacs 18.
  92
  93 (efs-handle-emacs-version)
  94
  95 ;; Also defined in efs-cu.el
  96 (defvar efs-path-root-regexp "^/[^/:]+:"
  97   "Regexp to match the `/user@host:' root of an efs full path.")
  98
  99 (defun efs-file-name-handler-alist-sans-fn (fn)
 100   ;; Returns a version of file-name-handler-alist without efs.
 101   (delq nil (mapcar
 102              (function
 103               (lambda (x)
 104                 (and (not (eq (cdr x) fn)) x)))
 105              file-name-handler-alist)))
 106
 107 (defun efs-root-handler-function (operation &rest args)
 108   "Function to handle completion in the root directory."
 109   (let ((handler (and (if (boundp 'allow-remote-paths)
 110                           allow-remote-paths
 111                         t)
 112                       (get operation 'efs-root))))
 113     (if handler
 114         (apply handler args)
 115       (let ((inhibit-file-name-handlers
 116              (cons 'efs-root-handler-function
 117                    (and (eq inhibit-file-name-operation operation)
 118                         inhibit-file-name-handlers)))
 119             (inhibit-file-name-operation operation))
 120         (apply operation args)))))
 121
 122 (put 'file-name-completion 'efs-root 'efs-root-file-name-completion)
 123 (put 'file-name-all-completions 'efs-root 'efs-root-file-name-all-completions)
 124 (autoload 'efs-root-file-name-all-completions "efs-netrc")
 125 (autoload 'efs-root-file-name-completion "efs-netrc")
 126
 127 (autoload 'efs-file-handler-function "efs"
 128           "Function to use efs to handle remote files.")
 129
 130 ;; Install into the file-name-handler-alist.
 131 ;; If we are already there, remove the old entry, and re-install.
 132 ;; Remove the ange-ftp entry too.
 133
 134 (setq file-name-handler-alist
 135       (let (dired-entry alist)
 136         (setq alist
 137               (nconc
 138                (list
 139                 (cons efs-path-root-regexp 'efs-file-handler-function)
 140                 '("^/$" . efs-root-handler-function))
 141                (delq nil
 142                      (mapcar
 143                       (function
 144                        (lambda (x)
 145                          (if (eq (cdr x) 'dired-handler-fn)
 146                              (progn
 147                                (setq dired-entry x)
 148                                nil)
 149                            (and (not
 150                                  (memq (cdr x)
 151                                        '(remote-path-file-handler-function
 152                                          efs-file-handler-function
 153                                          efs-root-handler-function
 154                                          ange-ftp-hook-function
 155                                          ange-ftp-completion-hook-function)))
 156                                 x))))
 157                       file-name-handler-alist))))
 158         ;; Make sure that dired is in first.
 159         (if dired-entry (cons dired-entry alist) alist)))
 160
 161 ;;; end of efs-fnh.el