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) |
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." |
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." |
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 |
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." |
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' |
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) |
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. |
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 |
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 |
|
|
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 |
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. |