emacs: lisp/net/ange-ftp.el comparison

comparison lisp/net/ange-ftp.el @ 46178:cd546ee24e14

Use add-hook and find-file-hook. (ange-ftp-parse-netrc): Use run-hooks and find-file-hook. (ange-ftp-ls-parser): Make it into a function. Ignore trailing @ in symlink targets. (ange-ftp-file-entry-p): Ignore FTP errors. (ange-ftp-insert-directory): Use ange-ftp-expand-symlink to correctly expand "/flint:/bla -> ./etc" to /flint:/etc.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Thu, 04 Jul 2002 20:37:14 +0000
parents	5023425b4a55
children	af464c20ffb2

comparison

equal deleted inserted replaced

-:76bedba7ffd6
+:cd546ee24e14
 		(set-buffer (generate-new-buffer "*ftp-.netrc*"))
 		(ange-ftp-real-insert-file-contents file)
 		(setq buffer-file-name file)
 		(setq default-directory (file-name-directory file))
 		(normal-mode t)
-		(mapcar 'funcall find-file-hooks)
+		(run-hooks 'find-file-hook)
 		(setq buffer-file-name nil)
 		(goto-char (point-min))
 		(skip-chars-forward " \t\r\n")
 		(while (not (eobp))
 		  (ange-ftp-parse-netrc-group))
 ;; This deals with the F switch. Should also do something about
 ;; unquoting names obtained with the SysV b switch and the GNU Q
 ;; switch. See Sebastian's dired-get-filename.
-(defmacro ange-ftp-ls-parser ()
+(defun ange-ftp-ls-parser ()
 ;; Note that switches is dynamically bound.
 ;; Meant to be called by ange-ftp-parse-dired-listing
-`(let ((tbl (ange-ftp-make-hashtable))
+(let ((tbl (ange-ftp-make-hashtable))
-(used-F (and (stringp switches)
+	(used-F (and (stringp switches)
-(string-match "F" switches)))
+		     (string-match "F" switches)))
-file-type symlink directory file)
+	file-type symlink directory file)
 (while (setq file (ange-ftp-parse-filename))
 (beginning-of-line)
 (skip-chars-forward "\t 0-9")
 (setq file-type (following-char)
-directory (eq file-type ?d))
+	    directory (eq file-type ?d))
 (if (eq file-type ?l)
-(if (string-match " -> " file)
+	  (let ((end (string-match " -> " file)))
-(setq symlink (substring file (match-end 0))
+	    (if end
-file (substring file 0 (match-beginning 0)))
+		;; Sometimes `ls' appends a @ at the end of the target.
-;; Shouldn't happen
+		(setq symlink (substring file (match-end 0)
-	     (setq symlink ""))
+					 (string-match "@\\'" file))
-(setq symlink nil))
+		      file (substring file 0 end))
-;; Only do a costly regexp search if the F switch was used.
+	      ;; Shouldn't happen
-(if (and used-F
+	      (setq symlink "")))
-(not (string-equal file ""))
+	(setq symlink nil))
-(looking-at
+;; Only do a costly regexp search if the F switch was used.
-".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
+(if (and used-F
-(let ((socket (eq file-type ?s))
+	       (not (string-equal file ""))
-(executable
+	       (looking-at
-(and (not symlink) ; x bits don't mean a thing for symlinks
+		".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
-(string-match
+	  (let ((socket (eq file-type ?s))
-"[xst]"
+		(executable
-(concat (buffer-substring
+		 (and (not symlink) ; x bits don't mean a thing for symlinks
-(match-beginning 1) (match-end 1))
+		      (string-match
-(buffer-substring
+		       "[xst]"
-(match-beginning 2) (match-end 2))
+		       (concat (buffer-substring
-(buffer-substring
+				(match-beginning 1) (match-end 1))
-(match-beginning 3) (match-end 3)))))))
+			       (buffer-substring
-;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
+				(match-beginning 2) (match-end 2))
-;; and others don't. (sigh...) Beware, that some Unix's don't
+			       (buffer-substring
-;; seem to believe in the F-switch
+				(match-beginning 3) (match-end 3)))))))
-(if (or (and symlink (string-match "@$" file))
+	    ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
-(and directory (string-match "/$" file))
+	    ;; and others don't. (sigh...) Beware, that some Unix's don't
-(and executable (string-match "*$" file))
+	    ;; seem to believe in the F-switch
-(and socket (string-match "=$" file)))
+	    (if (or (and symlink (string-match "@$" file))
-(setq file (substring file 0 -1)))))
+		    (and directory (string-match "/$" file))
-(ange-ftp-put-hash-entry file (or symlink directory) tbl)
+		    (and executable (string-match "*$" file))
-(forward-line 1))
+		    (and socket (string-match "=$" file)))
+		(setq file (substring file 0 -1)))))
+(ange-ftp-put-hash-entry file (or symlink directory) tbl)
+(forward-line 1))
 (ange-ftp-put-hash-entry "." t tbl)
 (ange-ftp-put-hash-entry ".." t tbl)
 tbl))
 ;;; The dl stuff for descriptive listings
 	       ;; then dumb hosts will give an ftp error. Smart unix hosts
 	       ;; will simply send back the ls
 	       ;; error message.
 	       (ange-ftp-get-hash-entry "." ent))
 	  ;; Child lookup failed, so try the parent.
-	  (let ((table (ange-ftp-get-files dir)))
+	  (let ((table (ange-ftp-get-files dir 'no-error)))
 	    ;; If the dir doesn't exist, don't use it as a hash table.
 	    (and table
 		 (ange-ftp-hash-entry-exists-p file
 					       table)))))))
 ;;; The above two forms are sufficient to cause this file to be loaded
 ;;; if the user ever uses a file name with a colon in it.
 ;;; This sets the mode
-(or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
+(add-hook 'find-file-hook 'ange-ftp-set-buffer-mode)
-(setq find-file-hooks
-	  (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
 ;;; Now say where to find the handlers for particular operations.
 (put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory)
 (put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory)
 	tem)
 (if parsed
 	(if (and (not wildcard)
 		 (setq tem (file-symlink-p (directory-file-name file))))
 	    (ange-ftp-insert-directory
-	     (ange-ftp-replace-name-component file tem)
+	     (ange-ftp-expand-symlink
+	      tem (file-name-directory (directory-file-name file)))
 	     switches wildcard full)
 	  (insert
 	   (if wildcard
 	       (let ((default-directory (file-name-directory file)))
 		 (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))

Mercurial > emacs

comparison lisp/net/ange-ftp.el @ 46178:cd546ee24e14