/[emacs]/emacs/lisp/net/ange-ftp.el
ViewVC logotype

Diff of /emacs/lisp/net/ange-ftp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37 by rms, Tue Jul 2 19:20:42 2002 UTC revision 1.38 by monnier, Thu Jul 4 20:37:14 2002 UTC
# Line 1434  only return the directory part of FILE." Line 1434  only return the directory part of FILE."
1434                  (setq buffer-file-name file)                  (setq buffer-file-name file)
1435                  (setq default-directory (file-name-directory file))                  (setq default-directory (file-name-directory file))
1436                  (normal-mode t)                  (normal-mode t)
1437                  (mapcar 'funcall find-file-hooks)                  (run-hooks 'find-file-hook)
1438                  (setq buffer-file-name nil)                  (setq buffer-file-name nil)
1439                  (goto-char (point-min))                  (goto-char (point-min))
1440                  (skip-chars-forward " \t\r\n")                  (skip-chars-forward " \t\r\n")
# Line 2760  The main reason for this alist is to dea Line 2760  The main reason for this alist is to dea
2760  ;; unquoting names obtained with the SysV b switch and the GNU Q  ;; unquoting names obtained with the SysV b switch and the GNU Q
2761  ;; switch. See Sebastian's dired-get-filename.  ;; switch. See Sebastian's dired-get-filename.
2762    
2763  (defmacro ange-ftp-ls-parser ()  (defun ange-ftp-ls-parser ()
2764    ;; Note that switches is dynamically bound.    ;; Note that switches is dynamically bound.
2765    ;; Meant to be called by ange-ftp-parse-dired-listing    ;; Meant to be called by ange-ftp-parse-dired-listing
2766    `(let ((tbl (ange-ftp-make-hashtable))    (let ((tbl (ange-ftp-make-hashtable))
2767           (used-F (and (stringp switches)          (used-F (and (stringp switches)
2768                        (string-match "F" switches)))                       (string-match "F" switches)))
2769           file-type symlink directory file)          file-type symlink directory file)
2770       (while (setq file (ange-ftp-parse-filename))      (while (setq file (ange-ftp-parse-filename))
2771         (beginning-of-line)        (beginning-of-line)
2772         (skip-chars-forward "\t 0-9")        (skip-chars-forward "\t 0-9")
2773         (setq file-type (following-char)        (setq file-type (following-char)
2774               directory (eq file-type ?d))              directory (eq file-type ?d))
2775         (if (eq file-type ?l)        (if (eq file-type ?l)
2776             (if (string-match " -> " file)            (let ((end (string-match " -> " file)))
2777                 (setq symlink (substring file (match-end 0))              (if end
2778                       file (substring file 0 (match-beginning 0)))                  ;; Sometimes `ls' appends a @ at the end of the target.
2779               ;; Shouldn't happen                  (setq symlink (substring file (match-end 0)
2780               (setq symlink ""))                                           (string-match "@\\'" file))
2781           (setq symlink nil))                        file (substring file 0 end))
2782         ;; Only do a costly regexp search if the F switch was used.                ;; Shouldn't happen
2783         (if (and used-F                (setq symlink "")))
2784                  (not (string-equal file ""))          (setq symlink nil))
2785                  (looking-at        ;; Only do a costly regexp search if the F switch was used.
2786                   ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))        (if (and used-F
2787             (let ((socket (eq file-type ?s))                 (not (string-equal file ""))
2788                   (executable                 (looking-at
2789                    (and (not symlink) ; x bits don't mean a thing for symlinks                  ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
2790                         (string-match            (let ((socket (eq file-type ?s))
2791                          "[xst]"                  (executable
2792                          (concat (buffer-substring                   (and (not symlink) ; x bits don't mean a thing for symlinks
2793                                   (match-beginning 1) (match-end 1))                        (string-match
2794                                  (buffer-substring                         "[xst]"
2795                                   (match-beginning 2) (match-end 2))                         (concat (buffer-substring
2796                                  (buffer-substring                                  (match-beginning 1) (match-end 1))
2797                                   (match-beginning 3) (match-end 3)))))))                                 (buffer-substring
2798               ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)                                  (match-beginning 2) (match-end 2))
2799               ;; and others don't. (sigh...) Beware, that some Unix's don't                                 (buffer-substring
2800               ;; seem to believe in the F-switch                                  (match-beginning 3) (match-end 3)))))))
2801               (if (or (and symlink (string-match "@$" file))              ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
2802                       (and directory (string-match "/$" file))              ;; and others don't. (sigh...) Beware, that some Unix's don't
2803                       (and executable (string-match "*$" file))              ;; seem to believe in the F-switch
2804                       (and socket (string-match "=$" file)))              (if (or (and symlink (string-match "@$" file))
2805                   (setq file (substring file 0 -1)))))                      (and directory (string-match "/$" file))
2806         (ange-ftp-put-hash-entry file (or symlink directory) tbl)                      (and executable (string-match "*$" file))
2807         (forward-line 1))                      (and socket (string-match "=$" file)))
2808                    (setq file (substring file 0 -1)))))
2809          (ange-ftp-put-hash-entry file (or symlink directory) tbl)
2810          (forward-line 1))
2811      (ange-ftp-put-hash-entry "." t tbl)      (ange-ftp-put-hash-entry "." t tbl)
2812      (ange-ftp-put-hash-entry ".." t tbl)      (ange-ftp-put-hash-entry ".." t tbl)
2813      tbl))      tbl))
# Line 2983  NO-ERROR, if a listing for DIRECTORY can Line 2986  NO-ERROR, if a listing for DIRECTORY can
2986                 ;; error message.                 ;; error message.
2987                 (ange-ftp-get-hash-entry "." ent))                 (ange-ftp-get-hash-entry "." ent))
2988            ;; Child lookup failed, so try the parent.            ;; Child lookup failed, so try the parent.
2989            (let ((table (ange-ftp-get-files dir)))            (let ((table (ange-ftp-get-files dir 'no-error)))
2990              ;; If the dir doesn't exist, don't use it as a hash table.              ;; If the dir doesn't exist, don't use it as a hash table.
2991              (and table              (and table
2992                   (ange-ftp-hash-entry-exists-p file                   (ange-ftp-hash-entry-exists-p file
# Line 4372  NEWNAME should be the name to give the n Line 4375  NEWNAME should be the name to give the n
4375  ;;; if the user ever uses a file name with a colon in it.  ;;; if the user ever uses a file name with a colon in it.
4376    
4377  ;;; This sets the mode  ;;; This sets the mode
4378  (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)))  
4379    
4380  ;;; Now say where to find the handlers for particular operations.  ;;; Now say where to find the handlers for particular operations.
4381    
# Line 4517  NEWNAME should be the name to give the n Line 4518  NEWNAME should be the name to give the n
4518          (if (and (not wildcard)          (if (and (not wildcard)
4519                   (setq tem (file-symlink-p (directory-file-name file))))                   (setq tem (file-symlink-p (directory-file-name file))))
4520              (ange-ftp-insert-directory              (ange-ftp-insert-directory
4521               (ange-ftp-replace-name-component file tem)               (ange-ftp-expand-symlink
4522                  tem (file-name-directory (directory-file-name file)))
4523               switches wildcard full)               switches wildcard full)
4524            (insert            (insert
4525             (if wildcard             (if wildcard

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26