/[tramp]/tramp/lisp/tramp-smb.el
ViewVC logotype

Diff of /tramp/lisp/tramp-smb.el

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

revision 2.8 by albinus, Wed Nov 20 22:53:03 2002 UTC revision 2.9 by albinus, Thu Nov 21 22:04:25 2002 UTC
# Line 31  Line 31 
31    
32  (require 'tramp)  (require 'tramp)
33    
34    ;; Pacify byte-compiler
35  (eval-when-compile  (eval-when-compile
36    (require 'cl)    (require 'cl)
37    (require 'custom)    (require 'custom)
# Line 38  Line 39 
39    (or (>= emacs-major-version 20)    (or (>= emacs-major-version 20)
40        (load "cl-seq")))        (load "cl-seq")))
41    
 (defvar tramp-use-smb nil  
   "*Temporary variable to pretend SMB application as long as under development.  
 Change it only if you know what you do.")  
   
42  ;; Define SMB method ...  ;; Define SMB method ...
43  (defcustom tramp-smb-method "smb"  (defcustom tramp-smb-method "smb"
44    "*Method to connect SAMBA and M$ SMB servers."    "*Method to connect SAMBA and M$ SMB servers."
# Line 49  Change it only if you know what you do." Line 46  Change it only if you know what you do."
46    :type 'string)    :type 'string)
47    
48  ;; ... and add it to the method list.  ;; ... and add it to the method list.
49  (when tramp-use-smb  (add-to-list 'tramp-methods (cons tramp-smb-method nil))
   (add-to-list 'tramp-methods (cons tramp-smb-method nil)))  
50    
51  ;; Add completion function for SMB method.  ;; Add completion function for SMB method.
52  (when tramp-use-smb  (tramp-set-completion-function
53    (tramp-set-completion-function   tramp-smb-method
54     tramp-smb-method   '((tramp-parse-netrc "~/.netrc")))
    '((tramp-parse-netrc "~/.netrc"))))  
55    
56  (defcustom tramp-smb-program "smbclient"  (defcustom tramp-smb-program "smbclient"
57    "*Name of SMB client to run."    "*Name of SMB client to run."
# Line 175  pass to the OPERATION." Line 170  pass to the OPERATION."
170            (save-match-data (apply (cdr fn) args)))            (save-match-data (apply (cdr fn) args)))
171        (tramp-run-real-handler operation args))))        (tramp-run-real-handler operation args))))
172    
173  (when tramp-use-smb  (add-to-list 'tramp-foreign-file-name-handler-alist
174    (add-to-list 'tramp-foreign-file-name-handler-alist               (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
                (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))  
175    
176    
177  ;; File name primitives  ;; File name primitives
# Line 358  rather than as numbers." Line 352  rather than as numbers."
352    (cond    (cond
353     ((not (file-exists-p file1)) nil)     ((not (file-exists-p file1)) nil)
354     ((not (file-exists-p file2)) t)     ((not (file-exists-p file2)) t)
355     (t     (t (tramp-smb-time-less-p (file-attributes file2)
356      (save-excursion                               (file-attributes file1)))))
       (let ((fa1 (file-attributes file1))  
             (fa2 (file-attributes file2)))  
         (when (and (not (equal (nth 5 fa1) '(0 0)))  
                    (not (equal (nth 5 fa2) '(0 0))))  
           (> 0 (car (tramp-time-diff (nth 5 fa1) (nth 5 fa2))))))))))  
357    
358  (defun tramp-smb-handle-file-writable-p (filename)  (defun tramp-smb-handle-file-writable-p (filename)
359    "Like `file-writable-p' for tramp files."    "Like `file-writable-p' for tramp files."
# Line 385  rather than as numbers." Line 374  rather than as numbers."
374  (defun tramp-smb-handle-insert-directory  (defun tramp-smb-handle-insert-directory
375    (filename switches &optional wildcard full-directory-p)    (filename switches &optional wildcard full-directory-p)
376    "Like `insert-directory' for tramp files.    "Like `insert-directory' for tramp files.
377  SWITCHES, WILDCARD and FULL-DIRECTORY-P are not handled."  WILDCARD and FULL-DIRECTORY-P are not handled."
378    (setq filename (expand-file-name filename))    (setq filename (expand-file-name filename))
379    (when (file-directory-p filename)    (when (file-directory-p filename)
380      ;; This check is a little bit strange, but in `dired-add-entry'      ;; This check is a little bit strange, but in `dired-add-entry'
# Line 396  SWITCHES, WILDCARD and FULL-DIRECTORY-P Line 385  SWITCHES, WILDCARD and FULL-DIRECTORY-P
385      (with-parsed-tramp-file-name filename l      (with-parsed-tramp-file-name filename l
386        (setq user l-user host l-host path l-path))        (setq user l-user host l-host path l-path))
387      (save-match-data      (save-match-data
388        (save-excursion        (let* ((share (tramp-smb-get-share path))
389          (let* ((share (tramp-smb-get-share path))               (file (tramp-smb-get-path path nil))
390                 (file (tramp-smb-get-path path nil))               (entries (tramp-smb-get-file-entries user host share file)))
                (entries (tramp-smb-get-file-entries user host share file)))  
391    
392            ;; Delete dummy "" entry, sort them          ;; Delete dummy "" entry, sort them
393            (setq entries          (setq entries
394             (sort                (sort
395              (delq (assoc "" entries) entries)                 (delq (assoc "" entries) entries)
396              '(lambda (x y)                 '(lambda (x y)
397                 (if (string-match dired-sort-by-date-regexp dired-actual-switches)                    (if (string-match "t" switches)
398                     ; sort by date                        ; sort by date
399                     (tramp-smb-time-less-p (nth 3 y) (nth 3 x))                        (tramp-smb-time-less-p (nth 3 y) (nth 3 x))
400                   ; sort by name                      ; sort by name
401                   (string-lessp (nth 0 x) (nth 0 y))))))                      (string-lessp (nth 0 x) (nth 0 y))))))
402    
403            ;; Print entries          ;; Print entries
404            (mapcar          (mapcar
405             '(lambda (x)           '(lambda (x)
406                (insert              (insert
407                 (format               (format
408                  "%10s %3d %-8s %-8s %8s %s %s\n"                "%10s %3d %-8s %-8s %8s %s %s\n"
409                  (nth 1 x) ; mode                (nth 1 x) ; mode
410                  1 "nobody" "nogroup"                1 "nobody" "nogroup"
411                  (nth 2 x) ; size                (nth 2 x) ; size
412                  (format-time-string                (format-time-string
413                   (if (tramp-smb-time-less-p                 (if (tramp-smb-time-less-p
414                        (tramp-smb-time-subtract (current-time) (nth 3 x))                      (tramp-smb-time-subtract (current-time) (nth 3 x))
415                        tramp-smb-half-a-year)                      tramp-smb-half-a-year)
416                       "%b %e %R"                     "%b %e %R"
417                     "%b %e  %Y")                   "%b %e  %Y")
418                   (nth 3 x)) ; date                 (nth 3 x)) ; date
419                  (nth 0 x))) ; file name                (nth 0 x))) ; file name
420                (forward-line)              (forward-line)
421                (beginning-of-line))              (beginning-of-line))
422             entries))))))           entries)))))
423    
424  (defun tramp-smb-handle-rename-file  (defun tramp-smb-handle-rename-file
425    (filename newname &optional ok-if-already-exists)    (filename newname &optional ok-if-already-exists)
# Line 500  Preserves \"$\" in file names, before \" Line 488  Preserves \"$\" in file names, before \"
488        (let ((share (tramp-smb-get-share path))        (let ((share (tramp-smb-get-share path))
489              (file (tramp-smb-get-path path t))              (file (tramp-smb-get-path path t))
490              (curbuf (current-buffer))              (curbuf (current-buffer))
             (trampbuf (get-buffer-create "*tramp output*"))  
491              ;; We use this to save the value of `last-coding-system-used'              ;; We use this to save the value of `last-coding-system-used'
492              ;; after writing the tmp file.  At the end of the function,              ;; after writing the tmp file.  At the end of the function,
493              ;; we set `last-coding-system-used' to this saved value.              ;; we set `last-coding-system-used' to this saved value.
# Line 668  Result is the list (PATH MODE SIZE MTIME Line 655  Result is the list (PATH MODE SIZE MTIME
655          (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line)          (when (string-match "^\\s-+\\(\\S-+\\)\\s-+Disk" line)
656            (setq path (match-string 1 line)            (setq path (match-string 1 line)
657                  mode "dr-xr-xr-x"                  mode "dr-xr-xr-x"
658                  size 0                  size 0))
                 month "Jan"  
                 day 1  
                 hour 0  
                 min 0  
                 sec 0  
                 year 1970))  
659    
660        ; real listing        ; Real listing
661        (block nil        (block nil
662    
663          ;; year          ;; year
# Line 734  Result is the list (PATH MODE SIZE MTIME Line 715  Result is the list (PATH MODE SIZE MTIME
715              (setq path (match-string 1 line))              (setq path (match-string 1 line))
716            (return))))            (return))))
717    
718      (when (and path mode size sec min hour day month year)      (when (and path mode size)
719        (setq mtime        (setq mtime
720              (encode-time              (if (and sec min hour day month year)
721               sec min hour day                  (encode-time
722               (cdr (assoc (downcase month) tramp-smb-parse-time-months))                   sec min hour day
723               year))                   (cdr (assoc (downcase month) tramp-smb-parse-time-months))
724                     year)
725                  '(0 0)))
726        (list path mode size mtime))))        (list path mode size mtime))))
727    
728    
# Line 759  Erases temporary buffer before sending t Line 742  Erases temporary buffer before sending t
742  Does not do anything if a connection is already open, but re-opens the  Does not do anything if a connection is already open, but re-opens the
743  connection if a previous connection has died for some reason."  connection if a previous connection has died for some reason."
744    (let ((p (get-buffer-process    (let ((p (get-buffer-process
745              (tramp-get-buffer nil tramp-smb-method user host)))              (tramp-get-buffer nil tramp-smb-method user host))))
         last-cmd-time)  
746      (save-excursion      (save-excursion
747        (set-buffer (tramp-get-buffer nil tramp-smb-method user host))        (set-buffer (tramp-get-buffer nil tramp-smb-method user host))
748        ;; Check whether it is still the same share        ;; Check whether it is still the same share
# Line 927  Return the difference in the format of a Line 909  Return the difference in the format of a
909  ;; * Provide a local smb.conf. The default one might not be readable.  ;; * Provide a local smb.conf. The default one might not be readable.
910  ;; * Error handling in most of the functions. Brrrr.  ;; * Error handling in most of the functions. Brrrr.
911  ;; * Read password from "~/.netrc".  ;; * Read password from "~/.netrc".
912  ;; * Update documentation.  ;; * Use different buffers for different shares.  By this, the password
913    ;;   won't be requested again when changing shares on the same host.
914  ;; * Return more comprehensive file permission string.  ;; * Return more comprehensive file permission string.
 ;; * Use of `dired-sort-by-date-regexp' and `dired-actual-switches' seem  
 ;;   to work in GNU Emacs 21.x only.  
915  ;; * Handle '$' respectively '$$' correctly. Currently, it is done in  ;; * Handle '$' respectively '$$' correctly. Currently, it is done in
916  ;;   `tramp-smb-handle-substitute-in-file-name' and `tramp-smb-get-path'.  ;;   `tramp-smb-handle-substitute-in-file-name' and `tramp-smb-get-path'.
917  ;;   But that's not the full game; "C-x f" in dired converts "$" to "$$"  ;;   But that's not the full game; "C-x f" in dired converts "$" to "$$"
918  ;;   overzealous.  ;;   overzealous.
919    ;; * Handle WILDCARD and FULL-DIRECTORY-P in
920    ;;   `tramp-smb-handle-insert-directory'.
921  ;; * Maybe local tmp files should have the same extension like the original  ;; * Maybe local tmp files should have the same extension like the original
922  ;;   files.  Strange behaviour with jka-compr otherwise?  ;;   files.  Strange behaviour with jka-compr otherwise?
923    ;; * Copy files in dired from SMB to another method doesn't work.
924  ;; * Provide variables for debug.  ;; * Provide variables for debug.
925  ;; * (RMS) Use unwind-protect to clean up the state so as to make the state  ;; * (RMS) Use unwind-protect to clean up the state so as to make the state
926  ;;   regular again.  ;;   regular again.

Legend:
Removed from v.2.8  
changed lines
  Added in v.2.9

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