/[emacs]/emacs/lisp/net/tramp.el
ViewVC logotype

Diff of /emacs/lisp/net/tramp.el

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

revision 1.71 by ttn, Mon Aug 1 15:17:06 2005 UTC revision 1.72 by albinus, Sun Aug 7 15:42:42 2005 UTC
# Line 4  Line 4 
4  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5  ;;   2005 Free Software Foundation, Inc.  ;;   2005 Free Software Foundation, Inc.
6    
7  ;; Author: kai.grossjohann@gmx.net  ;; Author: Kai Gro,A_(Bjohann <kai.grossjohann@gmx.net>
8    ;;         Michael Albinus <michael.albinus@gmx.de>
9  ;; Keywords: comm, processes  ;; Keywords: comm, processes
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 147  Nil means to use a separate filename syn Line 148  Nil means to use a separate filename syn
148    (when (boundp 'byte-compile-not-obsolete-var)    (when (boundp 'byte-compile-not-obsolete-var)
149      (setq byte-compile-not-obsolete-var 'directory-sep-char)))      (setq byte-compile-not-obsolete-var 'directory-sep-char)))
150    
 ;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'.  
 (eval-when-compile  
   (unless (boundp 'last-coding-system-used)  
     (defvar last-coding-system-used nil)))  
   
151  ;;; User Customizable Internal Variables:  ;;; User Customizable Internal Variables:
152    
153  (defgroup tramp nil  (defgroup tramp nil
# Line 1031  Derived from `tramp-postfix-multi-hop-fo Line 1027  Derived from `tramp-postfix-multi-hop-fo
1027    :type 'regexp)    :type 'regexp)
1028    
1029  (defcustom tramp-user-regexp  (defcustom tramp-user-regexp
1030    "[^:@/ \t]*"    "[^:/ \t]*"
1031    "*Regexp matching user names."    "*Regexp matching user names."
1032    :group 'tramp    :group 'tramp
1033    :type 'regexp)    :type 'regexp)
# Line 1914  This function expects to be called from Line 1910  This function expects to be called from
1910            tramp-current-multi-method tramp-current-method            tramp-current-multi-method tramp-current-method
1911            tramp-current-user tramp-current-host))            tramp-current-user tramp-current-host))
1912          (goto-char (point-max))          (goto-char (point-max))
1913          (tramp-insert-with-face          (unless (bolp)
1914              (insert "\n"))
1915            (tramp-insert-with-face
1916           'italic           'italic
1917           (concat "# " (apply #'format fmt-string args) "\n"))))))           (concat "# " (apply #'format fmt-string args) "\n"))))))
1918    
# Line 2370  target of the symlink differ." Line 2368  target of the symlink differ."
2368             (buffer-name)))             (buffer-name)))
2369    (if time-list    (if time-list
2370        (tramp-run-real-handler 'set-visited-file-modtime (list time-list))        (tramp-run-real-handler 'set-visited-file-modtime (list time-list))
2371      (let ((f (buffer-file-name))      (let ((f (buffer-file-name)))
           (coding-system-used nil))  
2372        (with-parsed-tramp-file-name f nil        (with-parsed-tramp-file-name f nil
2373          (let* ((attr (file-attributes f))          (let* ((attr (file-attributes f))
2374                 ;; '(-1 65535) means file doesn't exists yet.                 ;; '(-1 65535) means file doesn't exists yet.
2375                 (modtime (or (nth 5 attr) '(-1 65535))))                 (modtime (or (nth 5 attr) '(-1 65535))))
2376            ;; We use '(0 0) as a don't-know value.  See also            ;; We use '(0 0) as a don't-know value.  See also
2377            ;; `tramp-handle-file-attributes-with-ls'.            ;; `tramp-handle-file-attributes-with-ls'.
           (when (boundp 'last-coding-system-used)  
             (setq coding-system-used last-coding-system-used))  
2378            (if (not (equal modtime '(0 0)))            (if (not (equal modtime '(0 0)))
2379                (tramp-run-real-handler 'set-visited-file-modtime (list modtime))                (tramp-run-real-handler 'set-visited-file-modtime (list modtime))
2380              (save-excursion              (save-excursion
# Line 2392  target of the symlink differ." Line 2387  target of the symlink differ."
2387                (setq attr (buffer-substring (point)                (setq attr (buffer-substring (point)
2388                                             (progn (end-of-line) (point)))))                                             (progn (end-of-line) (point)))))
2389              (setq tramp-buffer-file-attributes attr))              (setq tramp-buffer-file-attributes attr))
2390            (when (boundp 'last-coding-system-used)            nil)))))
             (setq last-coding-system-used coding-system-used))  
         nil)))))  
2391    
2392  ;; CCC continue here  ;; CCC continue here
2393    
# Line 2412  of." Line 2405  of."
2405      ;; recorded last modification time.      ;; recorded last modification time.
2406      (if (or (not (buffer-file-name))      (if (or (not (buffer-file-name))
2407              (eq (visited-file-modtime) 0))              (eq (visited-file-modtime) 0))
2408        t          t
2409        (let ((f (buffer-file-name)))        (let ((f (buffer-file-name)))
2410          (with-parsed-tramp-file-name f nil          (with-parsed-tramp-file-name f nil
2411            (let* ((attr (file-attributes f))            (let* ((attr (file-attributes f))
# Line 2447  of." Line 2440  of."
2440               ;; if and only if that agrees with the buffer's record.               ;; if and only if that agrees with the buffer's record.
2441               (t (equal mt '(-1 65535))))))))))               (t (equal mt '(-1 65535))))))))))
2442    
 (defadvice clear-visited-file-modtime (after tramp activate)  
   "Set `tramp-buffer-file-attributes' back to nil.  
 Tramp uses this variable as an emulation for the actual modtime of the file,  
 if the remote host can't provide the modtime."  
   (setq tramp-buffer-file-attributes nil))  
   
2443  (defun tramp-handle-set-file-modes (filename mode)  (defun tramp-handle-set-file-modes (filename mode)
2444    "Like `set-file-modes' for tramp files."    "Like `set-file-modes' for tramp files."
2445    (with-parsed-tramp-file-name filename nil    (with-parsed-tramp-file-name filename nil
# Line 3137  be a local filename.  The method used mu Line 3124  be a local filename.  The method used mu
3124              tramp-current-method method              tramp-current-method method
3125              tramp-current-user user              tramp-current-user user
3126              tramp-current-host host)              tramp-current-host host)
3127        (tramp-message        (message "Transferring %s to %s..." filename newname)
        5 "Transferring %s to file %s..." filename newname)  
3128    
3129        ;; Use rcp-like program for file transfer.        ;; Use rcp-like program for file transfer.
3130        (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf        (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf
# Line 3147  be a local filename.  The method used mu Line 3133  be a local filename.  The method used mu
3133          (tramp-process-actions p multi-method method user host          (tramp-process-actions p multi-method method user host
3134                                 tramp-actions-copy-out-of-band))                                 tramp-actions-copy-out-of-band))
3135        (kill-buffer trampbuf)        (kill-buffer trampbuf)
3136        (tramp-message        (message "Transferring %s to %s...done" filename newname)
        5 "Transferring %s to file %s...done" filename newname)  
3137    
3138        ;; Set the mode.        ;; Set the mode.
3139        (unless keep-date        (unless keep-date
# Line 3319  This is like `dired-recursive-delete-dir Line 3304  This is like `dired-recursive-delete-dir
3304    (filename switches &optional wildcard full-directory-p)    (filename switches &optional wildcard full-directory-p)
3305    "Like `insert-directory' for tramp files."    "Like `insert-directory' for tramp files."
3306    (if (and (boundp 'ls-lisp-use-insert-directory-program)    (if (and (boundp 'ls-lisp-use-insert-directory-program)
3307             (not ls-lisp-use-insert-directory-program))             (not (symbol-value 'ls-lisp-use-insert-directory-program)))
3308        (tramp-run-real-handler 'insert-directory        (tramp-run-real-handler 'insert-directory
3309                                (list filename switches wildcard full-directory-p))                                (list filename switches wildcard full-directory-p))
3310      ;; For the moment, we assume that the remote "ls" program does not      ;; For the moment, we assume that the remote "ls" program does not
# Line 3505  the result will be a local, non-Tramp, f Line 3490  the result will be a local, non-Tramp, f
3490  ;; Remote commands.  ;; Remote commands.
3491    
3492  (defvar tramp-async-proc nil  (defvar tramp-async-proc nil
3493    "Global variable keeping asyncronous process object.    "Global variable keeping asynchronous process object.
3494  Used in `tramp-handle-shell-command'")  Used in `tramp-handle-shell-command'")
3495    
3496  (defun tramp-handle-shell-command (command &optional output-buffer error-buffer)  (defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
# Line 3762  This will break if COMMAND prints a newl Line 3747  This will break if COMMAND prints a newl
3747                                'insert-file-contents)                                'insert-file-contents)
3748                        'file-local-copy)))                        'file-local-copy)))
3749                 (file-local-copy filename)))                 (file-local-copy filename)))
             (coding-system-used nil)  
3750              (result nil))              (result nil))
3751          (when visit          (when visit
3752            (setq buffer-file-name filename)            (setq buffer-file-name filename)
# Line 3772  This will break if COMMAND prints a newl Line 3756  This will break if COMMAND prints a newl
3756           multi-method method user host           multi-method method user host
3757           9 "Inserting local temp file `%s'..." local-copy)           9 "Inserting local temp file `%s'..." local-copy)
3758          (setq result (insert-file-contents local-copy nil beg end replace))          (setq result (insert-file-contents local-copy nil beg end replace))
         ;; Now `last-coding-system-used' has right value.  Remember it.  
         (when (boundp 'last-coding-system-used)  
           (setq coding-system-used last-coding-system-used))  
3759          (tramp-message-for-buffer          (tramp-message-for-buffer
3760           multi-method method user host           multi-method method user host
3761           9 "Inserting local temp file `%s'...done" local-copy)           9 "Inserting local temp file `%s'...done" local-copy)
3762          (delete-file local-copy)          (delete-file local-copy)
         (when (boundp 'last-coding-system-used)  
           (setq last-coding-system-used coding-system-used))  
3763          (list (expand-file-name filename)          (list (expand-file-name filename)
3764                (second result))))))                (second result))))))
3765    
# Line 3845  This will break if COMMAND prints a newl Line 3824  This will break if COMMAND prints a newl
3824    ;;              (string= lockname filename))    ;;              (string= lockname filename))
3825    ;;    (error    ;;    (error
3826    ;;     "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))    ;;     "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
3827    ;; XEmacs takes a coding system as the sevent argument, not `confirm'    ;; XEmacs takes a coding system as the seventh argument, not `confirm'
3828    (when (and (not (featurep 'xemacs))    (when (and (not (featurep 'xemacs))
3829               confirm (file-exists-p filename))               confirm (file-exists-p filename))
3830      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
# Line 3859  This will break if COMMAND prints a newl Line 3838  This will break if COMMAND prints a newl
3838            (loc-dec (tramp-get-local-decoding multi-method method user host))            (loc-dec (tramp-get-local-decoding multi-method method user host))
3839            (trampbuf (get-buffer-create "*tramp output*"))            (trampbuf (get-buffer-create "*tramp output*"))
3840            (modes (file-modes filename))            (modes (file-modes filename))
           ;; We use this to save the value of `last-coding-system-used'  
           ;; after writing the tmp file.  At the end of the function,  
           ;; we set `last-coding-system-used' to this saved value.  
           ;; This way, any intermediary coding systems used while  
           ;; talking to the remote shell or suchlike won't hose this  
           ;; variable.  This approach was snarfed from ange-ftp.el.  
           coding-system-used  
3841            tmpfil)            tmpfil)
3842        ;; Write region into a tmp file.  This isn't really needed if we        ;; Write region into a tmp file.  This isn't really needed if we
3843        ;; use an encoding function, but currently we use it always        ;; use an encoding function, but currently we use it always
# Line 3887  This will break if COMMAND prints a newl Line 3859  This will break if COMMAND prints a newl
3859        ;; the backup file.  This case `save-buffer' handles        ;; the backup file.  This case `save-buffer' handles
3860        ;; permissions.        ;; permissions.
3861        (when modes (set-file-modes tmpfil modes))        (when modes (set-file-modes tmpfil modes))
       ;; Now, `last-coding-system-used' has the right value.  Remember it.  
       (when (boundp 'last-coding-system-used)  
         (setq coding-system-used last-coding-system-used))  
3862        ;; This is a bit lengthy due to the different methods possible for        ;; This is a bit lengthy due to the different methods possible for
3863        ;; file transfer.  First, we check whether the method uses an rcp        ;; file transfer.  First, we check whether the method uses an rcp
3864        ;; program.  If so, we call it.  Otherwise, both encoding and        ;; program.  If so, we call it.  Otherwise, both encoding and
# Line 3991  This will break if COMMAND prints a newl Line 3960  This will break if COMMAND prints a newl
3960           ;; We must pass modtime explicitely, because filename can be different           ;; We must pass modtime explicitely, because filename can be different
3961           ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.           ;; from (buffer-file-name), f.e. if `file-precious-flag' is set.
3962           (nth 5 (file-attributes filename))))           (nth 5 (file-attributes filename))))
       ;; Make `last-coding-system-used' have the right value.  
       (when (boundp 'last-coding-system-used)  
         (setq last-coding-system-used coding-system-used))  
3963        (when (or (eq visit t)        (when (or (eq visit t)
3964                  (eq visit nil)                  (eq visit nil)
3965                  (stringp visit))                  (stringp visit))
# Line 4301  necessary anymore." Line 4267  necessary anymore."
4267          (symbol-function 'PC-expand-many-files))          (symbol-function 'PC-expand-many-files))
4268    (defun PC-expand-many-files (name)    (defun PC-expand-many-files (name)
4269      (if (tramp-tramp-file-p name)      (if (tramp-tramp-file-p name)
4270          (expand-many-files name)          (funcall (symbol-function 'expand-many-files) name)
4271        (tramp-save-PC-expand-many-files name))))        (tramp-save-PC-expand-many-files name))))
4272    
4273  ;; Why isn't eval-after-load sufficient?  ;; Why isn't eval-after-load sufficient?
# Line 4825  User may be nil." Line 4791  User may be nil."
4791  (defun tramp-completion-handle-expand-file-name (name &optional dir)  (defun tramp-completion-handle-expand-file-name (name &optional dir)
4792    "Like `expand-file-name' for tramp files."    "Like `expand-file-name' for tramp files."
4793    (let ((fullname (concat (or dir default-directory) name)))    (let ((fullname (concat (or dir default-directory) name)))
4794      (tramp-drop-volume-letter      (if (tramp-completion-mode fullname)
4795       (if (tramp-completion-mode fullname)          (tramp-run-real-handler
4796           (tramp-run-real-handler           'expand-file-name (list name dir))
4797            'expand-file-name (list name dir))        (tramp-completion-run-real-handler
4798         (tramp-completion-run-real-handler         'expand-file-name (list name dir)))))
         'expand-file-name (list name dir))))))  
4799    
4800  ;;; Internal Functions:  ;;; Internal Functions:
4801    
# Line 5127  file exists and nonzero exit status othe Line 5092  file exists and nonzero exit status othe
5092        (tramp-send-command        (tramp-send-command
5093         multi-method method user host         multi-method method user host
5094         (concat "PS1='$ ' exec " shell)) ;         (concat "PS1='$ ' exec " shell)) ;
5095        (unless (tramp-wait-for-regexp        (tramp-barf-if-no-shell-prompt
5096                 (get-buffer-process (current-buffer))         (get-buffer-process (current-buffer))
5097                 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'"         60 "Couldn't find remote `%s' prompt" shell)
                           tramp-shell-prompt-pattern shell-prompt-pattern))  
         (pop-to-buffer (buffer-name))  
         (error "Couldn't find remote `%s' prompt" shell))  
5098        (tramp-message        (tramp-message
5099         9 "Setting remote shell prompt...")         9 "Setting remote shell prompt...")
5100        ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we        ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
# Line 5331  The terminal type can be configured with Line 5293  The terminal type can be configured with
5293      (tramp-message 9 "Waiting 60s for prompt from remote shell")      (tramp-message 9 "Waiting 60s for prompt from remote shell")
5294      (with-timeout (60 (throw 'tramp-action 'timeout))      (with-timeout (60 (throw 'tramp-action 'timeout))
5295        (while (not found)        (while (not found)
5296          (accept-process-output p 1)          (tramp-accept-process-output p 1)
5297          (goto-char (point-min))          (goto-char (point-min))
5298          (setq todo actions)          (setq todo actions)
5299          (while todo          (while todo
# Line 5368  The terminal type can be configured with Line 5330  The terminal type can be configured with
5330      (tramp-message 9 "Waiting 60s for prompt from remote shell")      (tramp-message 9 "Waiting 60s for prompt from remote shell")
5331      (with-timeout (60 (throw 'tramp-action 'timeout))      (with-timeout (60 (throw 'tramp-action 'timeout))
5332        (while (not found)        (while (not found)
5333          (accept-process-output p 1)          (tramp-accept-process-output p 1)
5334          (setq todo actions)          (setq todo actions)
5335          (goto-char (point-min))          (goto-char (point-min))
5336          (while todo          (while todo
# Line 5757  character." Line 5719  character."
5719    
5720  ;; Utility functions.  ;; Utility functions.
5721    
5722    (defun tramp-accept-process-output
5723      (&optional process timeout timeout-msecs)
5724      "Like `accept-process-output' for Tramp processes.
5725    This is needed in order to hide `last-coding-system-used', which is set
5726    for process communication also."
5727      (let (last-coding-system-used)
5728        (accept-process-output process timeout timeout-msecs)))
5729    
5730  (defun tramp-wait-for-regexp (proc timeout regexp)  (defun tramp-wait-for-regexp (proc timeout regexp)
5731    "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.    "Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
5732  Expects the output of PROC to be sent to the current buffer.  Returns  Expects the output of PROC to be sent to the current buffer.  Returns
# Line 5773  nil." Line 5743  nil."
5743                            timeout))                            timeout))
5744               (with-timeout (timeout)               (with-timeout (timeout)
5745                 (while (not found)                 (while (not found)
5746                   (accept-process-output proc 1)                   (tramp-accept-process-output proc 1)
5747                   (unless (memq (process-status proc) '(run open))                   (unless (memq (process-status proc) '(run open))
5748                     (error "Process has died"))                     (error "Process has died"))
5749                   (goto-char (point-min))                   (goto-char (point-min))
5750                   (setq found (when (re-search-forward regexp nil t)                   (setq found (re-search-forward regexp nil t))))))
                                (tramp-match-string-list)))))))  
5751            (t            (t
5752             (while (not found)             (while (not found)
5753               (accept-process-output proc 1)               (tramp-accept-process-output proc 1)
5754               (unless (memq (process-status proc) '(run open))               (unless (memq (process-status proc) '(run open))
5755                 (error "Process has died"))                 (error "Process has died"))
5756               (goto-char (point-min))               (goto-char (point-min))
5757               (setq found (when (re-search-forward regexp nil t)               (setq found (re-search-forward regexp nil t)))))
                            (tramp-match-string-list))))))  
5758      (when tramp-debug-buffer      (when tramp-debug-buffer
5759        (append-to-buffer        (append-to-buffer
5760         (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method         (tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
# Line 6399  Sends COMMAND, then waits 30 seconds for Line 6367  Sends COMMAND, then waits 30 seconds for
6367                              timeout))                              timeout))
6368                 (with-timeout (timeout)                 (with-timeout (timeout)
6369                   (while (not found)                   (while (not found)
6370                     (accept-process-output proc 1)                     (tramp-accept-process-output proc 1)
6371                     (unless (memq (process-status proc) '(run open))                     (unless (memq (process-status proc) '(run open))
6372                       (error "Process has died"))                       (error "Process has died"))
6373                     (goto-char (point-max))                     (goto-char (point-max))
# Line 6407  Sends COMMAND, then waits 30 seconds for Line 6375  Sends COMMAND, then waits 30 seconds for
6375                     (setq found (looking-at end-of-output))))))                     (setq found (looking-at end-of-output))))))
6376              (t              (t
6377               (while (not found)               (while (not found)
6378                 (accept-process-output proc 1)                 (tramp-accept-process-output proc 1)
6379                 (unless (memq (process-status proc) '(run open))                 (unless (memq (process-status proc) '(run open))
6380                   (error "Process has died"))                   (error "Process has died"))
6381                 (goto-char (point-max))                 (goto-char (point-max))
# Line 6444  Sends COMMAND, then waits 30 seconds for Line 6412  Sends COMMAND, then waits 30 seconds for
6412      ;; Return value is whether end-of-output sentinel was found.      ;; Return value is whether end-of-output sentinel was found.
6413      found))      found))
6414    
 (defun tramp-match-string-list (&optional string)  
   "Returns list of all match strings.  
 That is, (list (match-string 0) (match-string 1) ...), according to the  
 number of matches."  
   (let* ((nmatches (/ (length (match-data)) 2))  
          (i (- nmatches 1))  
          (res nil))  
     (while (>= i 0)  
       (setq res (cons (match-string i string) res))  
       (setq i (- i 1)))  
     res))  
   
6415  (defun tramp-send-command-and-check (multi-method method user host command  (defun tramp-send-command-and-check (multi-method method user host command
6416                                                    &optional subshell)                                                    &optional subshell)
6417    "Run COMMAND and check its exit status.    "Run COMMAND and check its exit status.
# Line 6556  MULTI-METHOD, METHOD, USER, and HOST spe Line 6512  MULTI-METHOD, METHOD, USER, and HOST spe
6512  If `tramp-discard-garbage' is nil, just erase buffer."  If `tramp-discard-garbage' is nil, just erase buffer."
6513    (if (not tramp-discard-garbage)    (if (not tramp-discard-garbage)
6514        (erase-buffer)        (erase-buffer)
6515      (while (prog1 (erase-buffer) (accept-process-output p 0.25))      (while (prog1 (erase-buffer) (tramp-accept-process-output p 0.25))
6516        (when tramp-debug-buffer        (when tramp-debug-buffer
6517          (save-excursion          (save-excursion
6518            (set-buffer (tramp-get-debug-buffer multi-method method user host))            (set-buffer (tramp-get-debug-buffer multi-method method user host))
# Line 6993  as default." Line 6949  as default."
6949        ;; auto-saved file belonging to another original file.  This could        ;; auto-saved file belonging to another original file.  This could
6950        ;; be a security threat.        ;; be a security threat.
6951        (set-file-modes buffer-auto-save-file-name        (set-file-modes buffer-auto-save-file-name
6952                        (or (file-modes bfn) ?\600)))))                        (or (file-modes bfn) #o600)))))
6953    
6954  (unless (or (> emacs-major-version 21)  (unless (or (> emacs-major-version 21)
6955              (and (featurep 'xemacs)              (and (featurep 'xemacs)
# Line 7130  it does the right thing." Line 7086  it does the right thing."
7086    "Specify if query is needed for process when Emacs is exited.    "Specify if query is needed for process when Emacs is exited.
7087  If the second argument flag is non-nil, Emacs will query the user before  If the second argument flag is non-nil, Emacs will query the user before
7088  exiting if process is running."  exiting if process is running."
7089     (funcall
7090    (if (fboundp 'set-process-query-on-exit-flag)    (if (fboundp 'set-process-query-on-exit-flag)
7091        (set-process-query-on-exit-flag process flag)        (symbol-function 'set-process-query-on-exit-flag)
7092      (funcall (symbol-function 'process-kill-without-query)      (symbol-function 'process-kill-without-query))
7093               process flag)))    process flag))
7094    
7095    
7096  ;; ------------------------------------------------------------  ;; ------------------------------------------------------------
# Line 7213  Only works for Bourne-like shells." Line 7170  Only works for Bourne-like shells."
7170  ;; CCC: This check is now also really awful; we should search all  ;; CCC: This check is now also really awful; we should search all
7171  ;; of the filename format, not just the prefix.  ;; of the filename format, not just the prefix.
7172  (when (string-match "\\[" tramp-prefix-format)  (when (string-match "\\[" tramp-prefix-format)
7173  (defadvice file-expand-wildcards (around tramp-fix activate)    (defadvice file-expand-wildcards (around tramp-fix activate)
7174    (let ((name (ad-get-arg 0)))      (let ((name (ad-get-arg 0)))
7175      (if (tramp-tramp-file-p name)        (if (tramp-tramp-file-p name)
7176          ;; If it's a Tramp file, dissect it and look if wildcards            ;; If it's a Tramp file, dissect it and look if wildcards
7177          ;; need to be expanded at all.            ;; need to be expanded at all.
7178          (let ((v (tramp-dissect-file-name name)))            (let ((v (tramp-dissect-file-name name)))
7179            (if (string-match "[[*?]" (tramp-file-name-localname v))              (if (string-match "[[*?]" (tramp-file-name-localname v))
7180                (let ((res ad-do-it))                  (let ((res ad-do-it))
7181                  (setq ad-return-value (or res (list name))))                    (setq ad-return-value (or res (list name))))
7182              (setq ad-return-value (list name))))                (setq ad-return-value (list name))))
7183        ;; If it is not a Tramp file, just run the original function.          ;; If it is not a Tramp file, just run the original function.
7184        (let ((res ad-do-it))          (let ((res ad-do-it))
7185          (setq ad-return-value (or res (list name)))))))            (setq ad-return-value (or res (list name))))))))
 )  
7186    
7187  ;; Tramp version is useful in a number of situations.  ;; Tramp version is useful in a number of situations.
7188    
# Line 7246  Only works for Bourne-like shells." Line 7202  Only works for Bourne-like shells."
7202    (interactive)    (interactive)
7203    (require 'reporter)    (require 'reporter)
7204    (catch 'dont-send    (catch 'dont-send
7205      (let ((reporter-prompt-for-summary-p        t))      (let ((reporter-prompt-for-summary-p t))
7206        (reporter-submit-bug-report        (reporter-submit-bug-report
7207         tramp-bug-report-address         ; to-address         tramp-bug-report-address         ; to-address
7208         (format "tramp (%s)" tramp-version) ; package name and version         (format "tramp (%s)" tramp-version) ; package name and version
7209         `(;; Current state         (delq nil
7210           tramp-ls-command               `(;; Current state
7211           tramp-test-groks-nt                 tramp-ls-command
7212           tramp-file-exists-command                 tramp-test-groks-nt
7213           tramp-current-multi-method                 tramp-file-exists-command
7214           tramp-current-method                 tramp-current-multi-method
7215           tramp-current-user                 tramp-current-method
7216           tramp-current-host                 tramp-current-user
7217                   tramp-current-host
7218           ;; System defaults  
7219           tramp-auto-save-directory        ; vars to dump                 ;; System defaults
7220           tramp-default-method                 tramp-auto-save-directory        ; vars to dump
7221           tramp-rsh-end-of-line                 tramp-default-method
7222           tramp-default-password-end-of-line                 tramp-rsh-end-of-line
7223           tramp-remote-path                 tramp-default-password-end-of-line
7224           tramp-login-prompt-regexp                 tramp-remote-path
7225           tramp-password-prompt-regexp                 tramp-login-prompt-regexp
7226           tramp-wrong-passwd-regexp                 ;; Mask non-7bit characters
7227           tramp-yesno-prompt-regexp                 (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
7228           tramp-yn-prompt-regexp                 tramp-wrong-passwd-regexp
7229           tramp-terminal-prompt-regexp                 tramp-yesno-prompt-regexp
7230           tramp-temp-name-prefix                 tramp-yn-prompt-regexp
7231           tramp-file-name-structure                 tramp-terminal-prompt-regexp
7232           tramp-file-name-regexp                 tramp-temp-name-prefix
7233           tramp-multi-file-name-structure                 tramp-file-name-structure
7234           tramp-multi-file-name-hop-structure                 tramp-file-name-regexp
7235           tramp-multi-methods                 tramp-multi-file-name-structure
7236           tramp-multi-connection-function-alist                 tramp-multi-file-name-hop-structure
7237           tramp-methods                 tramp-multi-methods
7238           tramp-end-of-output                 tramp-multi-connection-function-alist
7239           tramp-coding-commands                 tramp-methods
7240           tramp-actions-before-shell                 tramp-end-of-output
7241           tramp-actions-copy-out-of-band                 tramp-coding-commands
7242           tramp-multi-actions                 tramp-actions-before-shell
7243           tramp-terminal-type                 tramp-actions-copy-out-of-band
7244           tramp-shell-prompt-pattern                 tramp-multi-actions
7245           tramp-chunksize                 tramp-terminal-type
7246           ,(when (boundp 'tramp-backup-directory-alist)                 ;; Mask non-7bit characters
7247              'tramp-backup-directory-alist)                 (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
7248           ,(when (boundp 'tramp-bkup-backup-directory-info)                 tramp-chunksize
7249              'tramp-bkup-backup-directory-info)                 ,(when (boundp 'tramp-backup-directory-alist)
7250                      'tramp-backup-directory-alist)
7251           ;; Non-tramp variables of interest                 ,(when (boundp 'tramp-bkup-backup-directory-info)
7252           shell-prompt-pattern                    'tramp-bkup-backup-directory-info)
7253           backup-by-copying  
7254           backup-by-copying-when-linked                 ;; Non-tramp variables of interest
7255           backup-by-copying-when-mismatch                 ;; Mask non-7bit characters
7256           ,(when (boundp 'backup-by-copying-when-privileged-mismatch)                 (shell-prompt-pattern . tramp-reporter-dump-variable)
7257              'backup-by-copying-when-privileged-mismatch)                 backup-by-copying
7258           ,(when (boundp 'password-cache)                 backup-by-copying-when-linked
7259              'password-cache)                 backup-by-copying-when-mismatch
7260           ,(when (boundp 'password-cache-expiry)                 ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
7261              'password-cache-expiry)                    'backup-by-copying-when-privileged-mismatch)
7262           ,(when (boundp 'backup-directory-alist)                 ,(when (boundp 'password-cache)
7263              'backup-directory-alist)                    'password-cache)
7264           ,(when (boundp 'bkup-backup-directory-info)                 ,(when (boundp 'password-cache-expiry)
7265              'bkup-backup-directory-info)                    'password-cache-expiry)
7266           file-name-handler-alist)                 ,(when (boundp 'backup-directory-alist)
7267         nil                              ; pre-hook                    'backup-directory-alist)
7268                   ,(when (boundp 'bkup-backup-directory-info)
7269                      'bkup-backup-directory-info)
7270                   file-name-handler-alist))
7271    
7272           'tramp-load-report-modules       ; pre-hook
7273         'tramp-append-tramp-buffers      ; post-hook         'tramp-append-tramp-buffers      ; post-hook
7274         "\         "\
7275  Enter your bug report in this message, including as much detail as you  Enter your bug report in this message, including as much detail as you
# Line 7327  report. Line 7288  report.
7288  --bug report follows this line--  --bug report follows this line--
7289  "))))  "))))
7290    
7291  (defun tramp-append-tramp-buffers ()  (defun tramp-reporter-dump-variable (varsym mailbuf)
7292    "Append Tramp buffers into the bug report."    "Pretty-print the value of the variable in symbol VARSYM.
7293    Used for non-7bit chars in strings."
7294      (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
7295             (val (with-current-buffer reporter-eval-buffer
7296                    (symbol-value varsym))))
7297    
7298        ;; There are characters to be masked.
7299        (when (and (boundp 'mm-7bit-chars)
7300                   (string-match
7301                    (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
7302          (with-current-buffer reporter-eval-buffer
7303            (set varsym (concat "(base64-decode-string \""
7304                                (base64-encode-string val)
7305                                "\")"))))
7306    
7307        ;; Dump variable.
7308        (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
7309    
7310        ;; Remove string quotation.
7311        (forward-line -1)
7312        (when (looking-at
7313               (concat "\\(^.*\\)" "\""                       ;; \1 "
7314                       "\\((base64-decode-string \\)" "\\\\"  ;; \2 \
7315                       "\\(\".*\\)" "\\\\"                    ;; \3 \
7316                       "\\(\")\\)" "\"$"))                    ;; \4 "
7317          (replace-match "\\1\\2\\3\\4")
7318          (beginning-of-line)
7319          (insert " ;; variable encoded due to non-printable characters\n"))
7320        (forward-line 1)
7321    
7322        ;; Reset VARSYM to old value.
7323        (with-current-buffer reporter-eval-buffer
7324          (set varsym val))))
7325    
7326    (defun tramp-load-report-modules ()
7327      "Load needed modules for reporting."
7328    
7329    ;; We load message.el and mml.el from Gnus.    ;; We load message.el and mml.el from Gnus.
7330    (if (featurep 'xemacs)    (if (featurep 'xemacs)
# Line 7338  report. Line 7334  report.
7334      (require 'message nil 'noerror)      (require 'message nil 'noerror)
7335      (require 'mml nil 'noerror))      (require 'mml nil 'noerror))
7336    (when (functionp 'message-mode)    (when (functionp 'message-mode)
7337      (funcall 'message-mode))      (funcall (symbol-function 'message-mode)))
7338    (when (functionp 'mml-mode)    (when (functionp 'mml-mode)
7339      (funcall 'mml-mode t))      (funcall (symbol-function 'mml-mode) t)))
7340    
7341    (defun tramp-append-tramp-buffers ()
7342      "Append Tramp buffers into the bug report."
7343    
7344    (when (and    (when (and
7345           (eq major-mode 'message-mode)           (eq major-mode 'message-mode)
# Line 7394  Therefore, the contents of files might b Line 7393  Therefore, the contents of files might b
7393                (goto-char (point-max))                (goto-char (point-max))
7394                (insert "\n\n")                (insert "\n\n")
7395                (dolist (buffer buffer-list)                (dolist (buffer buffer-list)
7396                  (mml-insert-empty-tag                  (funcall (symbol-function 'mml-insert-empty-tag)
7397                   'part 'type "text/plain" 'encoding "base64"                           'part 'type "text/plain" 'encoding "base64"
7398                   'disposition "attachment" 'buffer (buffer-name buffer)                           'disposition "attachment" 'buffer (buffer-name buffer)
7399                   'description (buffer-name buffer)))                           'description (buffer-name buffer)))
7400                (set-buffer-modified-p nil))                (set-buffer-modified-p nil))
7401    
7402            ;; Don't send.  Delete the message buffer.            ;; Don't send.  Delete the message buffer.

Legend:
Removed from v.1.71  
changed lines
  Added in v.1.72

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