summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/browse-url.el113
-rw-r--r--lisp/net/netrc.el95
-rw-r--r--lisp/net/newsticker.el9
-rw-r--r--lisp/net/rcirc.el218
-rw-r--r--lisp/net/tls.el97
-rw-r--r--lisp/net/tramp-cache.el66
-rw-r--r--lisp/net/tramp-cmds.el272
-rw-r--r--lisp/net/tramp-fish.el15
-rw-r--r--lisp/net/tramp-ftp.el7
-rw-r--r--lisp/net/tramp-smb.el20
-rw-r--r--lisp/net/tramp.el468
11 files changed, 826 insertions, 554 deletions
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index c2a0442478c..523588ec7c2 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -46,7 +46,7 @@
;; browse-url-cci XMosaic 2.5
;; browse-url-w3 w3 0
;; browse-url-w3-gnudoit w3 remotely
-;; browse-url-lynx-* Lynx 0
+;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
@@ -246,10 +246,10 @@ regexp should probably be \".\" to specify a default browser."
(function-item :tag "Netscape" :value browse-url-netscape)
(function-item :tag "Mosaic" :value browse-url-mosaic)
(function-item :tag "Mosaic using CCI" :value browse-url-cci)
- (function-item :tag "Lynx in an xterm window"
- :value browse-url-lynx-xterm)
- (function-item :tag "Lynx in an Emacs window"
- :value browse-url-lynx-emacs)
+ (function-item :tag "Text browser in an xterm window"
+ :value browse-url-text-xterm)
+ (function-item :tag "Text browser in an Emacs window"
+ :value browse-url-text-emacs)
(function-item :tag "KDE" :value browse-url-kde)
(function-item :tag "Elinks" :value browse-url-elinks)
(function-item :tag "Specified by `Browse Url Generic Program'"
@@ -502,9 +502,9 @@ enabled. The port number should be set in `browse-url-CCI-port'."
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
-
+
(defcustom browse-url-xterm-program "xterm"
- "The name of the terminal emulator used by `browse-url-lynx-xterm'.
+ "The name of the terminal emulator used by `browse-url-text-xterm'.
This might, for instance, be a separate color version of xterm."
:type 'string
:group 'browse-url)
@@ -515,17 +515,6 @@ These might set its size, for instance."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
-(defcustom browse-url-lynx-emacs-args (and (not window-system)
- '("-show_cursor"))
- "A list of strings defining options for Lynx in an Emacs buffer.
-
-The default is none in a window system, otherwise `-show_cursor' to
-indicate the position of the current link in the absence of
-highlighting, assuming the normal default for showing the cursor."
- :type '(repeat (string :tag "Argument"))
- :version "20.3"
- :group 'browse-url)
-
(defcustom browse-url-gnudoit-program "gnudoit"
"The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
:type 'string
@@ -562,28 +551,47 @@ incompatibly at version 4."
:type 'number
:group 'browse-url)
-(defcustom browse-url-lynx-input-field 'avoid
- "Action on selecting an existing Lynx buffer at an input field.
-What to do when sending a new URL to an existing Lynx buffer in Emacs
-if the Lynx cursor is on an input field (in which case the `g' command
+(defcustom browse-url-text-browser "lynx"
+ "The name of the text browser to invoke."
+ :type 'string
+ :group 'browse-url
+ :version "23.1")
+
+(defcustom browse-url-text-emacs-args (and (not window-system)
+ '("-show_cursor"))
+ "A list of strings defining options for a text browser in an Emacs buffer.
+
+The default is none in a window system, otherwise `-show_cursor' to
+indicate the position of the current link in the absence of
+highlighting, assuming the normal default for showing the cursor."
+ :type '(repeat (string :tag "Argument"))
+ :version "23.1"
+ :group 'browse-url)
+
+(defcustom browse-url-text-input-field 'avoid
+ "Action on selecting an existing text browser buffer at an input field.
+What to do when sending a new URL to an existing text browser buffer in Emacs
+if the browser cursor is on an input field (in which case the `g' command
would be entered as data). Such fields are recognized by the
-underlines ____. Allowed values: nil: disregard it, 'warn: warn the
-user and don't emit the URL, 'avoid: try to avoid the field by moving
+underlines ____. Allowed values: nil: disregard it, `warn': warn the
+user and don't emit the URL, `avoid': try to avoid the field by moving
down (this *won't* always work)."
:type '(choice (const :tag "Move to try to avoid field" :value avoid)
(const :tag "Disregard" :value nil)
(const :tag "Warn, don't emit URL" :value warn))
- :version "20.3"
+ :version "23.1"
:group 'browse-url)
-(defcustom browse-url-lynx-input-attempts 10
- "How many times to try to move down from a series of lynx input fields."
+(defcustom browse-url-text-input-attempts 10
+ "How many times to try to move down from a series of text browser input fields."
:type 'integer
+ :version "23.1"
:group 'browse-url)
-(defcustom browse-url-lynx-input-delay 0.2
- "How many seconds to wait for lynx between moves down from an input field."
+(defcustom browse-url-text-input-delay 0.2
+ "Seconds to wait for a text browser between moves down from an input field."
:type 'number
+ :version "23.1"
:group 'browse-url)
(defcustom browse-url-kde-program "kfmclient"
@@ -876,7 +884,7 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
((executable-find browse-url-kde-program) 'browse-url-kde)
((executable-find browse-url-netscape-program) 'browse-url-netscape)
((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find browse-url-xterm-program) 'browse-url-lynx-xterm)
+ ((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
(t
(lambda (&ignore args) (error "No usable browser found"))))
@@ -1308,38 +1316,41 @@ The `browse-url-gnudoit-program' program is used with options given by
;; --- Lynx in an xterm ---
;;;###autoload
-(defun browse-url-lynx-xterm (url &optional new-window)
+(defun browse-url-text-xterm (url &optional new-window)
;; new-window ignored
- "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point. A new Lynx process is run
+ "Ask a text browser to load URL.
+URL defaults to the URL around or before point.
+This runs the text browser specified by `browse-url-text-browser'.
in an Xterm window using the Xterm program named by `browse-url-xterm-program'
with possible additional arguments `browse-url-xterm-args'."
- (interactive (browse-url-interactive-arg "Lynx URL: "))
- (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program
- ,@browse-url-xterm-args "-e" "lynx"
+ (interactive (browse-url-interactive-arg "Text browser URL: "))
+ (apply #'start-process `(,(concat browse-url-text-browser url)
+ nil ,browse-url-xterm-program
+ ,@browse-url-xterm-args "-e" browse-url-text-browser
,url)))
;; --- Lynx in an Emacs "term" window ---
;;;###autoload
-(defun browse-url-lynx-emacs (url &optional new-buffer)
- "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point. With a prefix argument, run
-a new Lynx process in a new buffer.
+(defun browse-url-text-emacs (url &optional new-buffer)
+ "Ask a text browser to load URL.
+URL defaults to the URL around or before point.
+This runs the text browser specified by `browse-url-text-browser'.
+With a prefix argument, it runs a new browser process in a new buffer.
When called interactively, if variable `browse-url-new-window-flag' is
-non-nil, load the document in a new lynx in a new term window,
+non-nil, load the document in a new browser process in a new term window,
otherwise use any existing one. A non-nil interactive prefix argument
reverses the effect of `browse-url-new-window-flag'.
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
- (interactive (browse-url-interactive-arg "Lynx URL: "))
+ (interactive (browse-url-interactive-arg "Text browser URL: "))
(let* ((system-uses-terminfo t) ; Lynx uses terminfo
;; (term-term-name "vt100") ; ??
- (buf (get-buffer "*lynx*"))
+ (buf (get-buffer "*text browser*"))
(proc (and buf (get-buffer-process buf)))
- (n browse-url-lynx-input-attempts))
+ (n browse-url-text-input-attempts))
(if (and (browse-url-maybe-new-window new-buffer) buf)
;; Rename away the OLD buffer. This isn't very polite, but
;; term insists on working in a buffer named *lynx* and would
@@ -1350,11 +1361,13 @@ used instead of `browse-url-new-window-flag'."
(not buf)
(not proc)
(not (memq (process-status proc) '(run stop))))
- ;; start a new lynx
+ ;; start a new text browser
(progn
(setq buf
(apply #'make-term
- `("lynx" "lynx" nil ,@browse-url-lynx-emacs-args
+ `(,browse-url-text-browser
+ ,browse-url-text-browser
+ nil ,@browse-url-text-emacs-args
,url)))
(switch-to-buffer buf)
(term-char-mode)
@@ -1366,18 +1379,18 @@ used instead of `browse-url-new-window-flag'."
(if (not (memq (process-status process) '(run stop)))
(let ((buf (process-buffer process)))
(if buf (kill-buffer buf)))))))
- ;; send the url to lynx in the old buffer
+ ;; Send the url to the text browser in the old buffer
(let ((win (get-buffer-window buf t)))
(if win
(select-window win)
(switch-to-buffer buf)))
(if (eq (following-char) ?_)
- (cond ((eq browse-url-lynx-input-field 'warn)
+ (cond ((eq browse-url-text-input-field 'warn)
(error "Please move out of the input field first"))
- ((eq browse-url-lynx-input-field 'avoid)
+ ((eq browse-url-text-input-field 'avoid)
(while (and (eq (following-char) ?_) (> n 0))
(term-send-down) ; down arrow
- (sit-for browse-url-lynx-input-delay))
+ (sit-for browse-url-text-input-delay))
(if (eq (following-char) ?_)
(error "Cannot move out of the input field, sorry")))))
(term-send-string proc (concat "g" ; goto
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 1b52090abf6..8c4b0a08f51 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -32,27 +32,45 @@
;;; Code:
;;;
-;;; .netrc and .authinforc parsing
+;;; .netrc and .authinfo rc parsing
;;;
(defalias 'netrc-point-at-eol
(if (fboundp 'point-at-eol)
'point-at-eol
'line-end-position))
+;; autoload encrypt
+
+(eval-and-compile
+ (autoload 'encrypt-find-model "encrypt")
+ (autoload 'encrypt-insert-file-contents "encrypt"))
+
+(defgroup netrc nil
+ "Netrc configuration."
+ :group 'comm)
+
+(defvar netrc-services-file "/etc/services"
+ "The name of the services file.")
(defun netrc-parse (file)
- "Parse FILE and return a list of all entries in the file."
+ (interactive "fFile to Parse: ")
+ "Parse FILE and return an list of all entries in the file."
(when (file-exists-p file)
(with-temp-buffer
(let ((tokens '("machine" "default" "login"
"password" "account" "macdef" "force"
"port"))
+ (encryption-model (encrypt-find-model file))
alist elem result pair)
- (insert-file-contents file)
+
+ (if encryption-model
+ (encrypt-insert-file-contents file encryption-model)
+ (insert-file-contents file))
+
(goto-char (point-min))
;; Go through the file, line by line.
(while (not (eobp))
- (narrow-to-region (point) (netrc-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
;; For each line, get the tokens and values.
(while (not (eobp))
(skip-chars-forward "\t ")
@@ -113,16 +131,79 @@ Entries without port tokens default to DEFAULTPORT."
(when result
(setq result (nreverse result))
(while (and result
- (not (equal (or port defaultport "nntp")
- (or (netrc-get (car result) "port")
- defaultport "nntp"))))
+ (not (netrc-port-equal
+ (or port defaultport "nntp")
+ (or (netrc-get (car result) "port")
+ defaultport "nntp"))))
(pop result))
(car result))))
+(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults)
+ "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST.
+Matches a machine from MACHINES and a port from PORTS, giving
+default ports DEFAULTS to `netrc-machine'.
+
+MODE can be \"login\" or \"password\", suitable for passing to
+`netrc-get'."
+ (let ((authinfo-list (if (stringp authinfo-file-or-list)
+ (netrc-parse authinfo-file-or-list)
+ authinfo-file-or-list))
+ (ports (or ports '(nil)))
+ (defaults (or defaults '(nil)))
+ info)
+ (dolist (machine machines)
+ (dolist (default defaults)
+ (dolist (port ports)
+ (let ((alist (netrc-machine authinfo-list machine port default)))
+ (setq info (or (netrc-get alist mode) info))))))
+ info))
+
(defun netrc-get (alist type)
"Return the value of token TYPE from ALIST."
(cdr (assoc type alist)))
+(defun netrc-port-equal (port1 port2)
+ (when (numberp port1)
+ (setq port1 (or (netrc-find-service-name port1) port1)))
+ (when (numberp port2)
+ (setq port2 (or (netrc-find-service-name port2) port2)))
+ (equal port1 port2))
+
+(defun netrc-parse-services ()
+ (when (file-exists-p netrc-services-file)
+ (let ((services nil))
+ (with-temp-buffer
+ (insert-file-contents netrc-services-file)
+ (while (search-forward "#" nil t)
+ (delete-region (1- (point)) (point-at-eol)))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t)
+ (push (list (match-string 1) (string-to-number (match-string 2))
+ (intern (downcase (match-string 3))))
+ services))
+ (nreverse services)))))
+
+(defun netrc-find-service-name (number &optional type)
+ (let ((services (netrc-parse-services))
+ service)
+ (setq type (or type 'tcp))
+ (while (and (setq service (pop services))
+ (not (and (= number (cadr service))
+ (eq type (caddr service)))))
+ )
+ (car service)))
+
+(defun netrc-find-service-number (name &optional type)
+ (let ((services (netrc-parse-services))
+ service)
+ (setq type (or type 'tcp))
+ (while (and (setq service (pop services))
+ (not (and (string= name (car service))
+ (eq type (caddr service)))))
+ )
+ (cadr service)))
+
(provide 'netrc)
;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index eb70a2e2d31..735d946346d 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -1199,10 +1199,11 @@ buffers *newsticker-wget-<feed>* will not be closed."
(unless (fboundp 'match-string-no-properties)
(defalias 'match-string-no-properties 'match-string))
-(unless (fboundp 'replace-regexp-in-string)
- (defun replace-regexp-in-string (re rp st)
- (save-match-data ;; apparently XEmacs needs save-match-data
- (replace-in-string st re rp))))
+(when (featurep 'xemacs)
+ (unless (fboundp 'replace-regexp-in-string)
+ (defun replace-regexp-in-string (re rp st)
+ (save-match-data ;; apparently XEmacs needs save-match-data
+ (replace-in-string st re rp)))))
;; copied from subr.el
(unless (fboundp 'add-to-invisibility-spec)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index b2ad08d7ccd..ef24de44e50 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -93,11 +93,11 @@ VALUE must be a list of strings describing which channels to join
when connecting to this server. If absent, no channels will be
connected to automatically."
:type '(alist :key-type string
- :value-type (plist :options ((nick string)
- (port integer)
- (user-name string)
- (full-name string)
- (channels (repeat string)))))
+ :value-type (plist :options ((:nick string)
+ (:port integer)
+ (:user-name string)
+ (:full-name string)
+ (:channels (repeat string)))))
:group 'rcirc)
(defcustom rcirc-default-port 6667
@@ -323,6 +323,9 @@ and the cdr part is used for encoding."
(defvar rcirc-nick-table nil)
+(defvar rcirc-recent-quit-alist nil
+ "Alist of nicks that have recently quit or parted the channel.")
+
(defvar rcirc-nick-syntax-table
(let ((table (make-syntax-table text-mode-syntax-table)))
(mapc (lambda (c) (modify-syntax-entry c "w" table))
@@ -417,8 +420,11 @@ If ARG is non-nil, instead prompt for connection parameters."
connected-servers))))))))
(when connected-servers
(message "Already connected to %s"
- (concat (mapconcat 'identity (butlast connected-servers) ", ")
- ", and " (car (last connected-servers))))))))
+ (if (cdr connected-servers)
+ (concat (mapconcat 'identity (butlast connected-servers) ", ")
+ ", and "
+ (car (last connected-servers)))
+ (car connected-servers)))))))
;;;###autoload
(defalias 'irc 'rcirc)
@@ -763,7 +769,6 @@ If SILENT is non-nil, do not print the message in any irc buffer."
rcirc-target))))))
(let ((completion (car rcirc-nick-completions)))
(when completion
- (rcirc-put-nick-channel (rcirc-buffer-process) completion rcirc-target)
(delete-region (+ rcirc-prompt-end-marker
rcirc-nick-completion-start-offset)
(point))
@@ -799,6 +804,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg)
(define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-omit-mode)
+(define-key rcirc-mode-map (kbd "M-o") 'rcirc-omit-mode)
(define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part)
(define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query)
(define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic)
@@ -828,6 +834,10 @@ If SILENT is non-nil, do not print the message in any irc buffer."
"Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
Each element looks like (FILENAME . TEXT).")
+(defvar rcirc-current-line 0
+ "The current number of responses printed in this channel.
+This number is independent of the number of lines in the buffer.")
+
(defun rcirc-mode (process target)
"Major mode for IRC channel buffers.
@@ -850,12 +860,24 @@ Each element looks like (FILENAME . TEXT).")
(setq rcirc-last-post-time (current-time))
(make-local-variable 'fill-paragraph-function)
(setq fill-paragraph-function 'rcirc-fill-paragraph)
+ (make-local-variable 'rcirc-recent-quit-alist)
+ (setq rcirc-recent-quit-alist nil)
+ (make-local-variable 'rcirc-current-line)
+ (setq rcirc-current-line 0)
(make-local-variable 'rcirc-short-buffer-name)
(setq rcirc-short-buffer-name nil)
(make-local-variable 'rcirc-urls)
(setq use-hard-newlines t)
+ ;; setup for omitting responses
+ (setq buffer-invisibility-spec '())
+ (setq buffer-display-table (make-display-table))
+ (set-display-table-slot buffer-display-table 4
+ (let ((glyph (make-glyph-code
+ ?. 'font-lock-keyword-face)))
+ (make-vector 3 glyph)))
+
(make-local-variable 'rcirc-decode-coding-system)
(make-local-variable 'rcirc-encode-coding-system)
(dolist (i rcirc-coding-system-alist)
@@ -879,8 +901,6 @@ Each element looks like (FILENAME . TEXT).")
(setq overlay-arrow-position (make-marker))
(set-marker overlay-arrow-position nil)
- (setq buffer-invisibility-spec '(rcirc-ignored-user))
-
;; if the user changes the major mode or kills the buffer, there is
;; cleanup work to do
(add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t)
@@ -1005,8 +1025,9 @@ Create the buffer if it doesn't exist."
(let ((new-buffer (get-buffer-create
(rcirc-generate-new-buffer-name process target))))
(with-current-buffer new-buffer
- (rcirc-mode process target))
- (rcirc-put-nick-channel process (rcirc-nick process) target)
+ (rcirc-mode process target)
+ (rcirc-put-nick-channel process (rcirc-nick process) target
+ rcirc-current-line))
new-buffer)))))
(defun rcirc-send-input ()
@@ -1090,7 +1111,8 @@ Create the buffer if it doesn't exist."
(interactive)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
- (let ((text (buffer-substring rcirc-prompt-end-marker (point)))
+ (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
+ (point)))
(parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
(setq rcirc-window-configuration (current-window-configuration))
@@ -1187,7 +1209,7 @@ the of the following escape sequences replaced by the described values:
:group 'rcirc)
(defcustom rcirc-omit-responses
- '("JOIN" "PART" "QUIT")
+ '("JOIN" "PART" "QUIT" "NICK")
"Responses which will be hidden when `rcirc-omit-mode' is enabled."
:type '(repeat string)
:group 'rcirc)
@@ -1281,19 +1303,50 @@ Logfiles are kept in `rcirc-log-directory'."
:type 'boolean
:group 'rcirc)
+(defcustom rcirc-omit-threshold 100
+ "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted."
+ :type 'integer
+ :group 'rcirc)
+
+(defun rcirc-last-quit-line (process nick target)
+ "Return the line number where NICK left TARGET.
+Returns nil if the information is not recorded."
+ (let ((chanbuf (rcirc-get-buffer process target)))
+ (when chanbuf
+ (cdr (assoc-string nick (with-current-buffer chanbuf
+ rcirc-recent-quit-alist))))))
+
+(defun rcirc-last-line (process nick target)
+ "Return the line from the last activity from NICK in TARGET."
+ (let* ((chanbuf (rcirc-get-buffer process target))
+ (line (or (cdr (assoc-string target
+ (gethash nick (with-rcirc-server-buffer
+ rcirc-nick-table)) t))
+ (rcirc-last-quit-line process nick target))))
+ (if line
+ line
+ ;;(message "line is nil for %s in %s" nick target)
+ nil)))
+
+(defun rcirc-elapsed-lines (process nick target)
+ "Return the number of lines since activity from NICK in TARGET."
+ (let ((last-activity-line (rcirc-last-line process nick target)))
+ (when (and last-activity-line
+ (> last-activity-line 0))
+ (- rcirc-current-line last-activity-line))))
+
(defvar rcirc-markup-text-functions
'(rcirc-markup-attributes
rcirc-markup-my-nick
rcirc-markup-urls
rcirc-markup-keywords
- rcirc-markup-bright-nicks
- rcirc-markup-fill)
+ rcirc-markup-bright-nicks)
"List of functions used to manipulate text before it is printed.
-Each function takes two arguments, SENDER, RESPONSE. The buffer
-is narrowed with the text to be printed and the point is at the
-beginning of the `rcirc-text' propertized text.")
+Each function takes two arguments, SENDER, and RESPONSE. The
+buffer is narrowed with the text to be printed and the point is
+at the beginning of the `rcirc-text' propertized text.")
(defun rcirc-print (process sender response target text &optional activity)
"Print TEXT in the buffer associated with TARGET.
@@ -1305,7 +1358,8 @@ record activity."
(when (string-match "^\\([^/]\\w*\\)[:,]" text)
(match-string 1 text)))
rcirc-ignore-list))
- (not (string= sender (rcirc-nick process))))
+ ;; do not ignore if we sent the message
+ (not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
(inhibit-read-only t))
(with-current-buffer buffer
@@ -1350,16 +1404,22 @@ record activity."
(save-excursion (rcirc-markup-timestamp sender response))
(dolist (fn rcirc-markup-text-functions)
(save-excursion (funcall fn sender response)))
- (save-excursion (rcirc-markup-fill sender response)))
+ (when rcirc-fill-flag
+ (save-excursion (rcirc-markup-fill sender response))))
(when rcirc-read-only-flag
(add-text-properties (point-min) (point-max)
'(read-only t front-sticky t))))
;; make text omittable
- (when (and (member response rcirc-omit-responses)
- (> start (point-min)))
- (put-text-property (1- start) (1- rcirc-prompt-start-marker)
- 'invisible 'rcirc-omit))))
+ (let ((last-activity-lines (rcirc-elapsed-lines process sender target)))
+ (if (and (not (string= (rcirc-nick process) sender))
+ (member response rcirc-omit-responses)
+ (or (not last-activity-lines)
+ (< rcirc-omit-threshold last-activity-lines)))
+ (put-text-property (1- start) (1- rcirc-prompt-start-marker)
+ 'invisible 'rcirc-omit)
+ ;; otherwise increment the line count
+ (setq rcirc-current-line (1+ rcirc-current-line))))))
(set-marker-insertion-type rcirc-prompt-start-marker nil)
(set-marker-insertion-type rcirc-prompt-end-marker nil)
@@ -1442,9 +1502,10 @@ Log data is written to `rcirc-log-directory'."
(dolist (cell rcirc-log-alist)
(with-temp-buffer
(insert (cdr cell))
- (write-region (point-min) (point-max)
- (concat rcirc-log-directory "/" (car cell))
- t 'quiet)))
+ (let ((coding-system-for-write 'utf-8))
+ (write-region (point-min) (point-max)
+ (concat rcirc-log-directory "/" (car cell))
+ t 'quiet))))
(setq rcirc-log-alist nil))
(defun rcirc-join-channels (process channels)
@@ -1470,15 +1531,19 @@ Log data is written to `rcirc-log-directory'."
(mapcar (lambda (x) (car x))
(gethash nick rcirc-nick-table))))
-(defun rcirc-put-nick-channel (process nick channel)
- "Add CHANNEL to list associated with NICK."
+(defun rcirc-put-nick-channel (process nick channel &optional line)
+ "Add CHANNEL to list associated with NICK.
+Update the associated linestamp if LINE is non-nil.
+
+If the record doesn't exist, and LINE is nil, set the linestamp
+to zero."
(let ((nick (rcirc-user-nick nick)))
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
(record (assoc-string channel chans t)))
(if record
- (setcdr record (current-time))
- (puthash nick (cons (cons channel (current-time))
+ (when line (setcdr record line))
+ (puthash nick (cons (cons channel (or line 0))
chans)
rcirc-nick-table))))))
@@ -1514,7 +1579,10 @@ Log data is written to `rcirc-log-directory'."
(setq nicks (cons (cons k (cdr record)) nicks)))))
rcirc-nick-table)
(mapcar (lambda (x) (car x))
- (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))
+ (sort nicks (lambda (x y)
+ (let ((lx (or (cdr x) 0))
+ (ly (or (cdr y) 0)))
+ (< ly lx)))))))
(list target))))
(defun rcirc-ignore-update-automatic (nick)
@@ -1593,15 +1661,13 @@ Uninteresting lines are those whose responses are listed in
`rcirc-omit-responses'."
(interactive)
(setq rcirc-omit-mode (not rcirc-omit-mode))
- (let ((line (1- (count-screen-lines (point) (window-start)))))
- (if rcirc-omit-mode
- (progn
- (add-to-invisibility-spec 'rcirc-omit)
- (message "Rcirc-Omit mode enabled"))
- (remove-from-invisibility-spec 'rcirc-omit)
- (message "Rcirc-Omit mode disabled"))
- (recenter line))
- (force-mode-line-update))
+ (if rcirc-omit-mode
+ (progn
+ (add-to-invisibility-spec '(rcirc-omit . t))
+ (message "Rcirc-Omit mode enabled"))
+ (remove-from-invisibility-spec '(rcirc-omit . t))
+ (message "Rcirc-Omit mode disabled"))
+ (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
@@ -1636,7 +1702,10 @@ With prefix ARG, go to the next low priority buffer with activity."
(hipri (cdr pair)))
(if (or (and (not arg) hipri)
(and arg lopri))
- (switch-to-buffer (car (if arg lopri hipri)) t)
+ (progn
+ (switch-to-buffer (car (if arg lopri hipri)))
+ (when (> (point) rcirc-prompt-start-marker)
+ (recenter -1)))
(if (eq major-mode 'rcirc-mode)
(switch-to-buffer (rcirc-non-irc-buffer))
(message (concat
@@ -2169,11 +2238,13 @@ keywords when no KEYWORD is given."
(let ((fill-prefix
(or rcirc-fill-prefix
(make-string (- (point) (line-beginning-position)) ?\s)))
- (fill-column (cond ((eq rcirc-fill-column 'frame-width)
- (1- (frame-width)))
- (rcirc-fill-column
- rcirc-fill-column)
- (t fill-column))))
+ (fill-column (- (cond ((eq rcirc-fill-column 'frame-width)
+ (1- (frame-width)))
+ (rcirc-fill-column
+ rcirc-fill-column)
+ (t fill-column))
+ ;; make sure ... doesn't cause line wrapping
+ 3)))
(fill-region (point) (point-max) nil t))))
;;; handlers
@@ -2183,7 +2254,6 @@ keywords when no KEYWORD is given."
;; verbatim
(defun rcirc-handler-001 (process sender args text)
(rcirc-handler-generic process "001" sender args text)
- ;; set the real server name
(with-rcirc-process-buffer process
(setq rcirc-connecting nil)
(rcirc-reschedule-timeout process)
@@ -2201,9 +2271,9 @@ keywords when no KEYWORD is given."
(if (string-match "^\C-a\\(.*\\)\C-a$" message)
(rcirc-handler-CTCP process target sender (match-string 1 message))
(rcirc-print process sender "PRIVMSG" target message t))
- ;; update nick timestamp
- (if (member target (rcirc-nick-channels process sender))
- (rcirc-put-nick-channel process sender target))))
+ ;; update nick linestamp
+ (with-current-buffer (rcirc-get-buffer process target t)
+ (rcirc-put-nick-channel process sender target rcirc-current-line))))
(defun rcirc-handler-NOTICE (process sender args text)
(let ((target (car args))
@@ -2228,21 +2298,29 @@ keywords when no KEYWORD is given."
(defun rcirc-handler-JOIN (process sender args text)
(let ((channel (car args)))
- (rcirc-get-buffer-create process channel)
+ (with-current-buffer (rcirc-get-buffer-create process channel)
+ ;; when recently rejoining, restore the linestamp
+ (rcirc-put-nick-channel process sender channel
+ (let ((last-activity-lines
+ (rcirc-elapsed-lines process sender channel)))
+ (when (and last-activity-lines
+ (< last-activity-lines rcirc-omit-threshold))
+ (rcirc-last-line process sender channel)))))
+
(rcirc-print process sender "JOIN" channel "")
;; print in private chat buffer if it exists
(when (rcirc-get-buffer (rcirc-buffer-process) sender)
- (rcirc-print process sender "JOIN" sender channel))
-
- (rcirc-put-nick-channel process sender channel)))
+ (rcirc-print process sender "JOIN" sender channel))))
;; PART and KICK are handled the same way
(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
(rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
- (rcirc-remove-nick-channel process nick channel)
+ (progn
+ (rcirc-maybe-remember-nick-quit process nick channel)
+ (rcirc-remove-nick-channel process nick channel))
;; this is us leaving
(mapc (lambda (n)
(rcirc-remove-nick-channel process n channel))
@@ -2276,16 +2354,30 @@ keywords when no KEYWORD is given."
(rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
+(defun rcirc-maybe-remember-nick-quit (process nick channel)
+ "Remember NICK as leaving CHANNEL if they recently spoke."
+ (let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
+ (when (and elapsed-lines
+ (< elapsed-lines rcirc-omit-threshold))
+ (let ((buffer (rcirc-get-buffer process channel)))
+ (when buffer
+ (with-current-buffer buffer
+ (let ((record (assoc-string nick rcirc-recent-quit-alist t))
+ (line (rcirc-last-line process nick channel)))
+ (if record
+ (setcdr record line)
+ (setq rcirc-recent-quit-alist
+ (cons (cons nick line)
+ rcirc-recent-quit-alist))))))))))
+
(defun rcirc-handler-QUIT (process sender args text)
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
- (rcirc-print process sender "QUIT" channel (apply 'concat args)))
+ ;; broadcast quit message each channel
+ (rcirc-print process sender "QUIT" channel (apply 'concat args))
+ ;; record nick in quit table if they recently spoke
+ (rcirc-maybe-remember-nick-quit process sender channel))
(rcirc-nick-channels process sender))
-
- ;; print in private chat buffer if it exists
- (when (rcirc-get-buffer (rcirc-buffer-process) sender)
- (rcirc-print process sender "QUIT" sender (apply 'concat args)))
-
(rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args text)
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 2e890a4a476..104cb991254 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -55,6 +55,29 @@
"Transport Layer Security (TLS) parameters."
:group 'comm)
+(defcustom tls-end-of-info
+ (concat
+ "\\("
+ ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220.
+ ;; According to apps/s_client.c line 1515 `---' is always the last
+ ;; line that is printed by s_client before the real data.
+ "^ Verify return code: .+\n---\n\\|"
+ ;; `gnutls' regexp. See src/cli.c lines 721-.
+ "^- Simple Client Mode:\n"
+ "\\(\n\\|" ; ignore blank lines
+ ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715
+ ;; in `main' the handshake will start after this message. If the
+ ;; handshake fails, the programs will abort.
+ "^\\*\\*\\* Starting TLS handshake\n\\)*"
+ "\\)")
+ "Regexp matching end of TLS client informational messages.
+Client data stream begins after the last character matched by
+this. The default matches `openssl s_client' (version 0.9.8c)
+and `gnutls-cli' (version 2.0.1) output."
+ :version "22.2"
+ :type 'regexp
+ :group 'tls)
+
(defcustom tls-program '("gnutls-cli -p %p %h"
"gnutls-cli -p %p %h --protocols ssl3"
"openssl s_client -connect %h:%p -no_ssl2")
@@ -130,35 +153,51 @@ Fourth arg PORT is an integer specifying a port to connect to."
process cmd done)
(if use-temp-buffer
(setq buffer (generate-new-buffer " TLS")))
- (message "Opening TLS connection to `%s'..." host)
- (while (and (not done) (setq cmd (pop cmds)))
- (message "Opening TLS connection with `%s'..." cmd)
- (let ((process-connection-type tls-process-connection-type)
- response)
- (setq process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?h host
- ?p (if (integerp port)
- (int-to-string port)
- port)))))
- (while (and process
- (memq (process-status process) '(open run))
- (save-excursion
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- (not (setq done (re-search-forward tls-success nil t)))))
- (unless (accept-process-output process 1)
- (sit-for 1)))
- (message "Opening TLS connection with `%s'...%s" cmd
- (if done "done" "failed"))
- (if done
- (setq done process)
- (delete-process process))))
- (message "Opening TLS connection to `%s'...%s"
- host (if done "done" "failed"))
+ (with-current-buffer buffer
+ (message "Opening TLS connection to `%s'..." host)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "Opening TLS connection with `%s'..." cmd)
+ (let ((process-connection-type tls-process-connection-type)
+ response)
+ (setq process (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?h host
+ ?p (if (integerp port)
+ (int-to-string port)
+ port)))))
+ (while (and process
+ (memq (process-status process) '(open run))
+ (progn
+ (goto-char (point-min))
+ (not (setq done (re-search-forward tls-success nil t)))))
+ (unless (accept-process-output process 1)
+ (sit-for 1)))
+ (message "Opening TLS connection with `%s'...%s" cmd
+ (if done "done" "failed"))
+ (if (not done)
+ (delete-process process)
+ ;; advance point to after all informational messages that
+ ;; `openssl s_client' and `gnutls' print
+ (let ((start-of-data nil))
+ (while
+ (not (setq start-of-data
+ ;; the string matching `tls-end-of-info'
+ ;; might come in separate chunks from
+ ;; `accept-process-output', so start the
+ ;; search where `tls-success' ended
+ (save-excursion
+ (if (re-search-forward tls-end-of-info nil t)
+ (match-end 0)))))
+ (accept-process-output process 1))
+ (if start-of-data
+ ;; move point to start of client data
+ (goto-char start-of-data)))
+ (setq done process))))
+ (message "Opening TLS connection to `%s'...%s"
+ host (if done "done" "failed")))
(when use-temp-buffer
(if done (set-process-buffer process nil))
(kill-buffer buffer))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 35147e7907c..b28c20263f4 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -138,42 +138,29 @@ Remove also properties of all files in subdirectories."
(remhash key tramp-cache-data)))
tramp-cache-data)))
-(defun tramp-cache-print (table)
- "Prints hash table TABLE."
- (when (hash-table-p table)
- (let (result)
- (maphash
- '(lambda (key value)
- (let ((tmp (format
- "(%s %s)"
- (if (processp key)
- (prin1-to-string (prin1-to-string key))
- (prin1-to-string key))
- (if (hash-table-p value)
- (tramp-cache-print value)
- (if (bufferp value)
- (prin1-to-string (prin1-to-string value))
- (prin1-to-string value))))))
- (setq result (if result (concat result " " tmp) tmp))))
- table)
- result)))
-
;; Reverting or killing a buffer should also flush file properties.
-;; They could have been changed outside Tramp.
+;; They could have been changed outside Tramp. In eshell, "ls" would
+;; not show proper directory contents when a file has been copied or
+;; deleted before.
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from buffer-file-name."
- (let ((bfn (buffer-file-name)))
- (when (and (stringp bfn) (tramp-tramp-file-p bfn))
+ (let ((bfn (if (stringp (buffer-file-name))
+ (buffer-file-name)
+ default-directory)))
+ (when (tramp-tramp-file-p bfn)
(let* ((v (tramp-dissect-file-name bfn))
(localname (tramp-file-name-localname v)))
(tramp-flush-file-property v localname)))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
+(add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
(add-hook 'kill-buffer-hook 'tramp-flush-file-function)
(add-hook 'tramp-cache-unload-hook
'(lambda ()
(remove-hook 'before-revert-hook
'tramp-flush-file-function)
+ (remove-hook 'eshell-pre-command-hook
+ 'tramp-flush-file-function)
(remove-hook 'kill-buffer-hook
'tramp-flush-file-function)))
@@ -229,9 +216,38 @@ function is intended to run also as process sentinel."
; (tramp-message key 7 "%s" event)
(remhash key tramp-cache-data))
+(defun tramp-cache-print (table)
+ "Print hash table TABLE."
+ (when (hash-table-p table)
+ (let (result)
+ (maphash
+ '(lambda (key value)
+ (let ((tmp (format
+ "(%s %s)"
+ (if (processp key)
+ (prin1-to-string (prin1-to-string key))
+ (prin1-to-string key))
+ (if (hash-table-p value)
+ (tramp-cache-print value)
+ (if (bufferp value)
+ (prin1-to-string (prin1-to-string value))
+ (prin1-to-string value))))))
+ (setq result (if result (concat result " " tmp) tmp))))
+ table)
+ result)))
+
+(defun tramp-list-connections ()
+ "Return a list of all known connection vectors according to `tramp-cache'."
+ (let (result)
+ (maphash
+ '(lambda (key value)
+ (when (and (vectorp key) (null (aref key 3)))
+ (add-to-list 'result key)))
+ tramp-cache-data)
+ result))
+
(defun tramp-dump-connection-properties ()
-"Writes persistent connection properties into file
-`tramp-persistency-file-name'."
+ "Write persistent connection properties into file `tramp-persistency-file-name'."
;; We shouldn't fail, otherwise (X)Emacs might not be able to be closed.
(condition-case nil
(when (and (hash-table-p tramp-cache-data)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 72e57799dc4..7cf2bf3d923 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -61,12 +61,12 @@ When called interactively, a Tramp connection has to be selected."
(let ((connections
(mapcar
(lambda (x)
- (with-current-buffer x (list (file-remote-p default-directory))))
- ;; We shall not count debug buffers, because their
- ;; default-directory is random. It could be even a remote
- ;; one from another connection.
- (all-completions
- "*tramp" (mapcar 'list (tramp-list-tramp-buffers)))))
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method x)
+ (tramp-file-name-user x)
+ (tramp-file-name-host x)
+ (tramp-file-name-localname x)))
+ (tramp-list-connections)))
name)
(when connections
@@ -125,12 +125,270 @@ This includes password cache, file cache, connection cache, buffers."
(dolist (name (tramp-list-remote-buffers))
(when (bufferp (get-buffer name)) (kill-buffer name))))
+;; Tramp version is useful in a number of situations.
+
+(defun tramp-version (arg)
+ "Print version number of tramp.el in minibuffer or current buffer."
+ (interactive "P")
+ (if arg (insert tramp-version) (message tramp-version)))
+
+;; Make the `reporter` functionality available for making bug reports about
+;; the package. A most useful piece of code.
+
+(autoload 'reporter-submit-bug-report "reporter")
+
+(defun tramp-bug ()
+ "Submit a bug report to the Tramp developers."
+ (interactive)
+ (require 'reporter)
+ (catch 'dont-send
+ (let ((reporter-prompt-for-summary-p t))
+ (reporter-submit-bug-report
+ tramp-bug-report-address ; to-address
+ (format "tramp (%s)" tramp-version) ; package name and version
+ (delq nil
+ `(;; Current state
+ tramp-current-method
+ tramp-current-user
+ tramp-current-host
+
+ ;; System defaults
+ tramp-auto-save-directory ; vars to dump
+ tramp-default-method
+ tramp-default-method-alist
+ tramp-default-host
+ tramp-default-proxies-alist
+ tramp-default-user
+ tramp-default-user-alist
+ tramp-rsh-end-of-line
+ tramp-default-password-end-of-line
+ tramp-login-prompt-regexp
+ ;; Mask non-7bit characters
+ (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
+ tramp-wrong-passwd-regexp
+ tramp-yesno-prompt-regexp
+ tramp-yn-prompt-regexp
+ tramp-terminal-prompt-regexp
+ tramp-temp-name-prefix
+ tramp-file-name-structure
+ tramp-file-name-regexp
+ tramp-methods
+ tramp-end-of-output
+ tramp-local-coding-commands
+ tramp-remote-coding-commands
+ tramp-actions-before-shell
+ tramp-actions-copy-out-of-band
+ tramp-terminal-type
+ ;; Mask non-7bit characters
+ (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
+ ,(when (boundp 'tramp-backup-directory-alist)
+ 'tramp-backup-directory-alist)
+ ,(when (boundp 'tramp-bkup-backup-directory-info)
+ 'tramp-bkup-backup-directory-info)
+ ;; Dump cache.
+ (tramp-cache-data . tramp-reporter-dump-variable)
+
+ ;; Non-tramp variables of interest
+ ;; Mask non-7bit characters
+ (shell-prompt-pattern . tramp-reporter-dump-variable)
+ backup-by-copying
+ backup-by-copying-when-linked
+ backup-by-copying-when-mismatch
+ ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
+ 'backup-by-copying-when-privileged-mismatch)
+ ,(when (boundp 'password-cache)
+ 'password-cache)
+ ,(when (boundp 'password-cache-expiry)
+ 'password-cache-expiry)
+ ,(when (boundp 'backup-directory-alist)
+ 'backup-directory-alist)
+ ,(when (boundp 'bkup-backup-directory-info)
+ 'bkup-backup-directory-info)
+ file-name-handler-alist))
+
+ 'tramp-load-report-modules ; pre-hook
+ 'tramp-append-tramp-buffers ; post-hook
+ "\
+Enter your bug report in this message, including as much detail
+as you possibly can about the problem, what you did to cause it
+and what the local and remote machines are.
+
+If you can give a simple set of instructions to make this bug
+happen reliably, please include those. Thank you for helping
+kill bugs in Tramp.
+
+Another useful thing to do is to put
+
+ (setq tramp-verbose 8)
+
+in the ~/.emacs file and to repeat the bug. Then, include the
+contents of the *tramp/foo* buffer and the *debug tramp/foo*
+buffer in your bug report.
+
+--bug report follows this line--
+"))))
+
+(defun tramp-reporter-dump-variable (varsym mailbuf)
+ "Pretty-print the value of the variable in symbol VARSYM.
+Used for non-7bit chars in strings."
+ (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
+ (val (with-current-buffer reporter-eval-buffer
+ (symbol-value varsym))))
+
+ (if (hash-table-p val)
+ ;; Pretty print the cache.
+ (set varsym (read (format "(%s)" (tramp-cache-print val))))
+ ;; There are characters to be masked.
+ (when (and (boundp 'mm-7bit-chars)
+ (string-match
+ (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
+ (with-current-buffer reporter-eval-buffer
+ (set varsym (format "(base64-decode-string \"%s\""
+ (base64-encode-string val))))))
+
+ ;; Dump variable.
+ (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
+
+ (unless (hash-table-p val)
+ ;; Remove string quotation.
+ (forward-line -1)
+ (when (looking-at
+ (concat "\\(^.*\\)" "\"" ;; \1 "
+ "\\((base64-decode-string \\)" "\\\\" ;; \2 \
+ "\\(\".*\\)" "\\\\" ;; \3 \
+ "\\(\")\\)" "\"$")) ;; \4 "
+ (replace-match "\\1\\2\\3\\4")
+ (beginning-of-line)
+ (insert " ;; variable encoded due to non-printable characters\n"))
+ (forward-line 1))
+
+ ;; Reset VARSYM to old value.
+ (with-current-buffer reporter-eval-buffer
+ (set varsym val))))
+
+(defun tramp-load-report-modules ()
+ "Load needed modules for reporting."
+
+ ;; We load message.el and mml.el from Gnus.
+ (if (featurep 'xemacs)
+ (progn
+ (load "message" 'noerror)
+ (load "mml" 'noerror))
+ (require 'message nil 'noerror)
+ (require 'mml nil 'noerror))
+ (when (functionp 'message-mode)
+ (funcall (symbol-function 'message-mode)))
+ (when (functionp 'mml-mode)
+ (funcall (symbol-function 'mml-mode) t)))
+
+(defun tramp-append-tramp-buffers ()
+ "Append Tramp buffers and buffer local variables into the bug report."
+
+ (goto-char (point-max))
+
+ ;; Dump buffer local variables.
+ (dolist (buffer
+ (delq nil
+ (mapcar
+ '(lambda (b)
+ (when (string-match "\\*tramp/" (buffer-name b)) b))
+ (buffer-list))))
+ (let ((reporter-eval-buffer buffer)
+ (buffer-name (buffer-name buffer))
+ (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
+ (with-current-buffer elbuf
+ (emacs-lisp-mode)
+ (erase-buffer)
+ (insert "\n(setq\n")
+ (lisp-indent-line)
+ (funcall (symbol-function 'reporter-dump-variable)
+ 'buffer-name (current-buffer))
+ (dolist (varsym-or-cons-cell (buffer-local-variables buffer))
+ (let ((varsym (or (car-safe varsym-or-cons-cell)
+ varsym-or-cons-cell)))
+ (when (string-match "tramp" (symbol-name varsym))
+ (funcall
+ (symbol-function 'reporter-dump-variable)
+ varsym (current-buffer)))))
+ (lisp-indent-line)
+ (insert ")\n"))
+ (insert-buffer-substring elbuf)))
+
+ ;; Append buffers only when we are in message mode.
+ (when (and
+ (eq major-mode 'message-mode)
+ (boundp 'mml-mode)
+ (symbol-value 'mml-mode))
+
+ (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
+ (buffer-list (funcall (symbol-function 'tramp-list-tramp-buffers)))
+ (curbuf (current-buffer)))
+
+ ;; There is at least one Tramp buffer.
+ (when buffer-list
+ (switch-to-buffer (list-buffers-noselect nil))
+ (delete-other-windows)
+ (setq buffer-read-only nil)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ tramp-buf-regexp (tramp-compat-line-end-position) t)
+ (forward-line 1)
+ (forward-line 0)
+ (let ((start (point)))
+ (forward-line 1)
+ (kill-region start (point)))))
+ (insert "
+The buffer(s) above will be appended to this message. If you
+don't want to append a buffer because it contains sensitive data,
+or because the buffer is too large, you should delete the
+respective buffer. The buffer(s) will contain user and host
+names. Passwords will never be included there.")
+
+ (when (>= tramp-verbose 6)
+ (insert "\n\n")
+ (let ((start (point)))
+ (insert "\
+Please note that you have set `tramp-verbose' to a value of at
+least 6. Therefore, the contents of files might be included in
+the debug buffer(s).")
+ (add-text-properties start (point) (list 'face 'italic))))
+
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (goto-char (point-min))
+
+ (if (y-or-n-p "Do you want to append the buffer(s)? ")
+ ;; OK, let's send. First we delete the buffer list.
+ (progn
+ (kill-buffer nil)
+ (switch-to-buffer curbuf)
+ (goto-char (point-max))
+ (insert "\n\
+This is a special notion of the `gnus/message' package. If you
+use another mail agent (by copying the contents of this buffer)
+please ensure that the buffers are attached to your email.\n\n")
+ (dolist (buffer buffer-list)
+ (funcall (symbol-function 'mml-insert-empty-tag)
+ 'part 'type "text/plain" 'encoding "base64"
+ 'disposition "attachment" 'buffer buffer
+ 'description buffer))
+ (set-buffer-modified-p nil))
+
+ ;; Don't send. Delete the message buffer.
+ (set-buffer curbuf)
+ (set-buffer-modified-p nil)
+ (kill-buffer nil)
+ (throw 'dont-send nil))))))
+
+(defalias 'tramp-submit-bug 'tramp-bug)
+
(provide 'tramp-cmds)
;;; TODO:
;; * Clean up unused *tramp/foo* buffers after a while. (Pete Forman)
-;; * WIBNI there was an interactive command prompting for tramp
+;; * WIBNI there was an interactive command prompting for Tramp
;; method, hostname, username and filename and translates the user
;; input into the correct filename syntax (depending on the Emacs
;; flavor) (Reiner Steib)
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el
index 7116d144061..95091c276bc 100644
--- a/lisp/net/tramp-fish.el
+++ b/lisp/net/tramp-fish.el
@@ -308,10 +308,10 @@ pass to the OPERATION."
v1 'file-error "Error with add-name-to-file %s" newname)))))
(defun tramp-fish-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date)
+ (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Like `copy-file' for Tramp files."
(tramp-fish-do-copy-or-rename-file
- 'copy filename newname ok-if-already-exists keep-date))
+ 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
(defun tramp-fish-handle-delete-directory (directory)
"Like `delete-directory' for Tramp files."
@@ -346,7 +346,7 @@ pass to the OPERATION."
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (concat (file-name-as-directory dir) name)))
- ;; If NAME is not a tramp file, run the real handler
+ ;; If NAME is not a Tramp file, run the real handler,
(if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
(tramp-drop-volume-letter
(tramp-run-real-handler 'expand-file-name (list name nil)))
@@ -835,7 +835,7 @@ target of the symlink differ."
;; Internal file name functions
(defun tramp-fish-do-copy-or-rename-file
- (op filename newname &optional ok-if-already-exists keep-date)
+ (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Copy or rename a remote file.
OP must be `copy' or `rename' and indicates the operation to
perform. FILENAME specifies the file to copy or rename, NEWNAME
@@ -869,7 +869,7 @@ file names."
;; directly.
((tramp-equal-remote filename newname)
(tramp-fish-do-copy-or-rename-file-directly
- op filename newname keep-date))
+ op filename newname keep-date preserve-uid-gid))
;; No shortcut was possible. So we copy the
;; file first. If the operation was `rename', we go
;; back and delete the original file (if the copy was
@@ -899,12 +899,13 @@ file names."
(tramp-flush-file-property v (file-name-directory localname)))))))
(defun tramp-fish-do-copy-or-rename-file-directly
- (op filename newname keep-date)
+ (op filename newname keep-date preserve-uid-gid)
"Invokes `COPY' or `RENAME' on the remote system.
OP must be one of `copy' or `rename', indicating `cp' or `mv',
respectively. VEC specifies the connection. LOCALNAME1 and
LOCALNAME2 specify the two arguments of `cp' or `mv'. If
-KEEP-DATE is non-nil, preserve the time stamp when copying."
+KEEP-DATE is non-nil, preserve the time stamp when copying.
+PRESERVE-UID-GID is completely ignored."
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(tramp-fish-send-command
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 85416d308d3..a8b6bca44f2 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -143,10 +143,13 @@ pass to the OPERATION."
;; cannot disable the file-name-handler this case. We set the
;; connection property "started" in order to put the remote
;; location into the cache, which is helpful for further
- ;; completion.
+ ;; completion. We don't use `with-parsed-tramp-file-name',
+ ;; because this returns another user but the one declared in
+ ;; "~/.netrc".
((memq operation '(file-directory-p file-exists-p))
(if (apply 'ange-ftp-hook-function operation args)
- (with-parsed-tramp-file-name (car args) nil
+ (let ((v (tramp-dissect-file-name (car args) t)))
+ (aset v 0 tramp-ftp-method)
(tramp-set-connection-property v "started" t))
nil))
;; If the second argument of `copy-file' or `rename-file' is a
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index b4e68c77624..706042060f6 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -205,9 +205,10 @@ pass to the OPERATION."
;; File name primitives
(defun tramp-smb-handle-copy-file
- (filename newname &optional ok-if-already-exists keep-date)
+ (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
+KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
+PRESERVE-UID-GID is completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
@@ -562,7 +563,14 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server."
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `handle-substitute-in-file-name' for Tramp files.
-Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
+\"//\" substitutes only in the local filename part. Catches
+errors for shares like \"C$/\", which are common in Microsoft Windows."
+ (with-parsed-tramp-file-name filename nil
+ ;; Ignore in LOCALNAME everything before "//".
+ (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))))
(condition-case nil
(tramp-run-real-handler 'substitute-in-file-name (list filename))
(error filename)))
@@ -574,7 +582,7 @@ Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
(with-parsed-tramp-file-name filename nil
(unless (eq append nil)
(tramp-error
- v 'file-error "Cannot append to file using tramp (`%s')" filename))
+ v 'file-error "Cannot append to file using Tramp (`%s')" filename))
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
@@ -582,7 +590,7 @@ Catches errors for shares like \"C$/\", which are common in Microsoft Windows."
filename))
(tramp-error v 'file-error "File not overwritten")))
;; We must also flush the cache of the directory, because
- ;; file-attributes reads the values from there.
+ ;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(let ((file (tramp-smb-get-localname localname t))
@@ -1004,8 +1012,6 @@ Returns nil if an error message has appeared."
;; * Return more comprehensive file permission string. Think whether it is
;; possible to implement `set-file-modes'.
;; * Handle links (FILENAME.LNK).
-;; * Maybe local tmp files should have the same extension like the original
-;; files. Strange behaviour with jka-compr otherwise?
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
;; * (RMS) Use unwind-protect to clean up the state so as to make the state
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index b54641b311e..93fdea9ab27 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -93,7 +93,6 @@
(autoload 'tramp-set-file-property "tramp-cache")
(autoload 'tramp-flush-file-property "tramp-cache")
(autoload 'tramp-flush-directory-property "tramp-cache")
-(autoload 'tramp-cache-print "tramp-cache")
(autoload 'tramp-get-connection-property "tramp-cache")
(autoload 'tramp-set-connection-property "tramp-cache")
(autoload 'tramp-flush-connection-property "tramp-cache")
@@ -560,7 +559,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
* `tramp-remote-sh'
This specifies the Bourne shell to use on the remote host. This
MUST be a Bourne-like shell. It is normally not necessary to set
- this to any value other than \"/bin/sh\": tramp wants to use a shell
+ this to any value other than \"/bin/sh\": Tramp wants to use a shell
which groks tilde expansion, but it can search for it. Also note
that \"/bin/sh\" exists on all Unixen, this might not be true for
the value that you decide to use. You Have Been Warned.
@@ -972,7 +971,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
(defcustom tramp-wrong-passwd-regexp
(concat "^.*"
;; These strings should be on the last line
- (regexp-opt '("Permission denied."
+ (regexp-opt '("Permission denied"
"Login incorrect"
"Login Incorrect"
"Connection refused"
@@ -1117,12 +1116,12 @@ It can have the following values:
((equal tramp-syntax 'sep) "/[")
((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
- "*String matching the very beginning of tramp file names.
+ "*String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-prefix-regexp
(concat "^" (regexp-quote tramp-prefix-format))
- "*Regexp matching the very beginning of tramp file names.
+ "*Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp
@@ -1214,9 +1213,9 @@ Derived from `tramp-postfix-host-format'.")
2 4 5 7)
"*List of five elements (REGEXP METHOD USER HOST FILE), detailing \
-the tramp file name structure.
+the Tramp file name structure.
-The first element REGEXP is a regular expression matching a tramp file
+The first element REGEXP is a regular expression matching a Tramp file
name. The regex should contain parentheses around the method name,
the user name, the host name, and the file name parts.
@@ -1256,11 +1255,11 @@ See `tramp-file-name-structure' for more explanations.")
((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"*Regular expression matching file names handled by Tramp.
-This regexp should match tramp file names but no other file names.
+This regexp should match Tramp file names but no other file names.
\(When tramp.el is loaded, this regular expression is prepended to
`file-name-handler-alist', and that is searched sequentially. Thus,
-if the tramp entry appears rather early in the `file-name-handler-alist'
-and is a bit too general, then some files might be considered tramp
+if the Tramp entry appears rather early in the `file-name-handler-alist'
+and is a bit too general, then some files might be considered Tramp
files which are not really Tramp files.
Please note that the entry in `file-name-handler-alist' is made when
@@ -1302,8 +1301,8 @@ See `tramp-file-name-structure' for more explanations.")
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
- "*Regular expression matching file names handled by tramp completion.
-This regexp should match partial tramp file names only.
+ "*Regular expression matching file names handled by Tramp completion.
+This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
this file (tramp.el) is loaded. This means that this variable must be set
@@ -1752,7 +1751,7 @@ This is used to map a mode number to a permission string.")
"Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
-;; Handlers for partial tramp file names. For Emacs just
+;; Handlers for partial Tramp file names. For Emacs just
;; `file-name-all-completions' is needed.
;;;###autoload
(defconst tramp-completion-file-name-handler-alist
@@ -1815,7 +1814,7 @@ ARGS to actually emit the message (if applicable)."
(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
"Emit a message depending on verbosity level.
-VEC-OR-PROC identifies the tramp buffer to use. It can be either a
+VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
vector or a process. LEVEL says to be quiet if `tramp-verbose' is
less than LEVEL. The message is emitted only if `tramp-verbose' is
greater than or equal to LEVEL.
@@ -1966,7 +1965,8 @@ Return the local name of the temporary file."
(tramp-file-name-method vec)
(tramp-file-name-user vec)
(tramp-file-name-host vec)
- (expand-file-name tramp-temp-name-prefix "/tmp")))
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))
result)
(while (not result)
;; `make-temp-file' would be the natural choice for
@@ -2017,7 +2017,9 @@ Example:
(if (string-match "^HKEY_CURRENT_USER" (nth 1 (car v)))
;; Windows registry.
(and (memq system-type '(cygwin windows-nt))
- (zerop (call-process "reg" nil nil nil "query" (nth 1 (car v)))))
+ (zerop
+ (tramp-local-call-process
+ "reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
(setq r (delete (car v) r)))
@@ -2163,7 +2165,7 @@ target of the symlink differ."
(unless nomessage (tramp-message v 0 "Loading %s...done" file))
t)))
-;; Localname manipulation functions that grok TRAMP localnames...
+;; Localname manipulation functions that grok Tramp localnames...
(defun tramp-handle-file-name-directory (file)
"Like `file-name-directory' but aware of Tramp files."
;; Everything except the last filename thing is the directory. We
@@ -2548,7 +2550,7 @@ of."
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
- (call-process
+ (tramp-local-call-process
"touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
@@ -2573,16 +2575,12 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(tramp-shell-quote-argument localname)))))
;; We handle also the local part, because there doesn't exist
- ;; `set-file-uid-gid'.
+ ;; `set-file-uid-gid'. On Win32 "chown" might not work.
(let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
- (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))
- (default-directory (tramp-compat-temporary-file-directory)))
- ;; "chown" might not exist, for example on Win32.
- (condition-case nil
- (call-process
- "chown" nil nil nil
- (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))
- (error nil)))))
+ (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
+ (tramp-local-call-process
+ "chown" nil nil nil
+ (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))
;; Simple functions using the `test' command.
@@ -2897,7 +2895,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
(cond
- ;; At least one file a tramp file?
+ ;; At least one file a Tramp file?
((or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
(tramp-do-copy-or-rename-file
@@ -2915,10 +2913,10 @@ and gid of the corresponding user is taken. Both parameters must be integers."
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
;; Check if both files are local -- invoke normal rename-file.
- ;; Otherwise, use tramp from local system.
+ ;; Otherwise, use Tramp from local system.
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
- ;; At least one file a tramp file?
+ ;; At least one file a Tramp file?
(if (or (tramp-tramp-file-p filename)
(tramp-tramp-file-p newname))
(tramp-do-copy-or-rename-file
@@ -3309,7 +3307,7 @@ be a local filename. The method used must be an out-of-band method."
;; Dired.
;; CCC: This does not seem to be enough. Something dies when
-;; we try and delete two directories under TRAMP :/
+;; we try and delete two directories under Tramp :/
(defun tramp-handle-dired-recursive-delete-directory (filename)
"Recursively delete the directory given.
This is like `dired-recursive-delete-directory' for Tramp files."
@@ -3455,7 +3453,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
""
(tramp-shell-quote-argument
(file-name-nondirectory localname))))))
- ;; We cannot use `insert-buffer-substring' because the tramp buffer
+ ;; We cannot use `insert-buffer-substring' because the Tramp buffer
;; changes its contents before insertion due to calling
;; `expand-file' and alike.
(insert
@@ -3563,8 +3561,8 @@ beginning of local filename are not substituted."
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
- (tramp-make-tramp-file-name
- method user host (replace-match "\\1" nil nil localname)))
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))
;; "/m:h:~" does not work for completion. We use "/m:h:~/".
(when (string-match "~$" filename)
(setq filename (concat filename "/"))))
@@ -3729,6 +3727,20 @@ beginning of local filename are not substituted."
;; Return exit status.
ret)))
+(defun tramp-local-call-process
+ (program &optional infile destination display &rest args)
+ "Calls `call-process' on the local host.
+This is needed because for some Emacs flavors Tramp has
+defadviced `call-process' to behave like `process-file'. The
+Lisp error raised when PROGRAM is nil is trapped also, returning 1."
+ (let ((default-directory
+ (if (file-remote-p default-directory)
+ (tramp-compat-temporary-file-directory)
+ default-directory)))
+ (if (executable-find program)
+ (apply 'call-process program infile destination display args)
+ 1)))
+
(defun tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args)
"Like `call-process-region' for Tramp files."
@@ -3764,19 +3776,14 @@ beginning of local filename are not substituted."
output-buffer)))
(prog1
- ;; Run the process. We cannot use `process-file' and
- ;; `start-file-process', because these functions might not
- ;; exist in older Emacsen.
+ ;; Run the process.
(if (integerp asynchronous)
- (apply 'tramp-handle-start-file-process
- "*Async Shell*" buffer args)
- (apply 'process-file
- (car args) nil buffer nil (cdr args)))
+ (apply 'start-file-process "*Async Shell*" buffer args)
+ (apply 'process-file (car args) nil buffer nil (cdr args)))
;; Insert error messages if they were separated.
(when (listp buffer)
- (with-current-buffer error-buffer
- (insert-file-contents (cadr buffer)))
- (delete-file (buffer-file-name (cadr buffer))))
+ (with-current-buffer error-buffer (insert-file-contents (cadr buffer)))
+ (delete-file (cadr buffer)))
;; There's some output, display it.
(when (with-current-buffer output-buffer (> (point-max) (point-min)))
(if (functionp 'display-message-or-buffer)
@@ -4052,9 +4059,9 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
(tramp-error v 'file-error "File not overwritten")))
- (let ((uid (or (nth 2 (file-attributes filename 'integer))
+ (let ((uid (or (nth 2 (tramp-compat-file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
- (gid (or (nth 3 (file-attributes filename 'integer))
+ (gid (or (nth 3 (tramp-compat-file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
(if (and (tramp-local-host-p v)
@@ -4173,17 +4180,15 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(when file-precious-flag
(erase-buffer)
(and
- ;; cksum runs locally
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (zerop (call-process "cksum" tmpfile t)))
- ;; cksum runs remotely
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-local-call-process "cksum" tmpfile t))
+ ;; cksum runs remotely.
(zerop
(tramp-send-command-and-check
v
(format
"cksum <%s" (tramp-shell-quote-argument localname))))
- ;; ... they are different
+ ;; ... they are different.
(not
(string-equal
(buffer-string)
@@ -4367,7 +4372,7 @@ ARGS are the arguments OPERATION has been called with."
;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
-Falls back to normal file name handler if no tramp file name handler exists."
+Falls back to normal file name handler if no Tramp file name handler exists."
(save-match-data
(let* ((filename (apply 'tramp-file-name-for-operation operation args))
(completion (tramp-completion-mode-p))
@@ -4433,8 +4438,8 @@ Fall back to normal file name handler if no Tramp handler exists."
;;;###autoload
(progn (defun tramp-completion-file-name-handler (operation &rest args)
- "Invoke tramp file name completion handler.
-Falls back to normal file name handler if no tramp file name handler exists."
+ "Invoke Tramp file name completion handler.
+Falls back to normal file name handler if no Tramp file name handler exists."
;; (setq edebug-trace t)
;; (edebug-trace "%s" (with-output-to-string (backtrace)))
@@ -4449,7 +4454,7 @@ Falls back to normal file name handler if no tramp file name handler exists."
;;;###autoload
(defsubst tramp-register-file-name-handler ()
- "Add tramp file name handler to `file-name-handler-alist'."
+ "Add Tramp file name handler to `file-name-handler-alist'."
;; Remove autoloaded handler from file name handler alist. Useful,
;; if `tramp-syntax' has been changed.
(let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
@@ -4472,7 +4477,7 @@ Falls back to normal file name handler if no tramp file name handler exists."
;;;###autoload
(defsubst tramp-register-completion-file-name-handler ()
- "Add tramp completion file name handler to `file-name-handler-alist'."
+ "Add Tramp completion file name handler to `file-name-handler-alist'."
;; Remove autoloaded handler from file name handler alist. Useful,
;; if `tramp-syntax' has been changed.
(let ((a1 (rassq
@@ -4535,8 +4540,8 @@ should never be set globally, the intention is to let-bind it.")
;; risky, because completing a file might require loading other files,
;; like "~/.netrc", and for them it shouldn't be decided based on that
;; variable. On the other hand, those files shouldn't have partial
-;; tramp file name syntax. Maybe another variable should be introduced
-;; overwriting this check in such cases. Or we change tramp file name
+;; Tramp file name syntax. Maybe another variable should be introduced
+;; overwriting this check in such cases. Or we change Tramp file name
;; syntax in order to avoid ambiguities, like in XEmacs ...
(defun tramp-completion-mode-p ()
"Checks whether method / user name / host name completion is active."
@@ -5037,7 +5042,7 @@ User is always nil."
(let ((default-directory (tramp-compat-temporary-file-directory))
res)
(with-temp-buffer
- (when (zerop (call-process "reg" nil t nil "query" registry))
+ (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
(goto-char (point-min))
(while (not (eobp))
(push (tramp-parse-putty-group registry) res))))
@@ -5331,11 +5336,11 @@ file exists and nonzero exit status otherwise."
(when extra-args (setq shell (concat shell " " extra-args))))
(tramp-message
vec 5 "Starting remote shell `%s' for tilde expansion..." shell)
- (tramp-message
- vec 6 (format "PROMPT_COMMAND='' PS1='$ ' exec %s" shell))
- ;; We just send a string only without checking resulting prompt.
- (tramp-send-string
- vec (format "PROMPT_COMMAND='' PS1='$ ' exec %s" shell))
+ (let ((tramp-end-of-output "$ "))
+ (tramp-send-command
+ vec
+ (format "PROMPT_COMMAND='' PS1='$ ' PS2='' PS3='' exec %s" shell)
+ t))
(tramp-message vec 5 "Setting remote shell prompt...")
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
;; must use "\n" here, not tramp-rsh-end-of-line. Kai left the
@@ -5611,16 +5616,14 @@ process to set up. VEC specifies the connection."
;; called as sh) on startup; this way, we avoid the startup file
;; clobbering $PS1. $PROMP_COMMAND is another way to set the prompt
;; in /bin/bash, it must be discarded as well.
- (tramp-message
- vec 6 (format "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' %s"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-sh)))
- ;; We just send a string only without checking resulting prompt.
- (tramp-send-string
- vec
- (format "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' %s"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-sh)))
+ (let ((tramp-end-of-output "$ "))
+ (tramp-send-command
+ vec
+ (format
+ "exec env 'ENV=' 'PROMPT_COMMAND=' 'PS1=$ ' PS2='' PS3='' %s"
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-sh))
+ t))
(tramp-message vec 5 "Setting shell prompt")
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we must
;; use "\n" here, not tramp-rsh-end-of-line.
@@ -5631,6 +5634,12 @@ process to set up. VEC specifies the connection."
tramp-end-of-output
tramp-rsh-end-of-line)
t)
+ ;; If the connection buffer is not empty, the remote shell is
+ ;; echoing, and the prompt has been detected through the echoed
+ ;; command. We must reread for the real prompt.
+ (with-current-buffer (process-buffer proc)
+ (when (> (point-max) (point-min)) (tramp-wait-for-output proc)))
+ ;; Disable echo.
(tramp-message vec 5 "Setting up remote shell environment")
(tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
;; Check whether the echo has really been disabled. Some
@@ -5906,18 +5915,15 @@ INPUT can also be nil which means `/dev/null'.
OUTPUT can be a string (which specifies a filename), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (call-process
- tramp-encoding-shell ;program
- (when (and input (not (string-match "%s" cmd)))
- input) ;input
- (if (eq output t) t nil) ;output
- nil ;redisplay
- tramp-encoding-command-switch
- ;; actual shell command
- (concat
- (if (string-match "%s" cmd) (format cmd input) cmd)
- (if (stringp output) (concat "> " output) "")))))
+ (tramp-local-call-process
+ tramp-encoding-shell
+ (when (and input (not (string-match "%s" cmd))) input)
+ (if (eq output t) t nil)
+ nil
+ tramp-encoding-command-switch
+ (concat
+ (if (string-match "%s" cmd) (format cmd input) cmd)
+ (if (stringp output) (concat "> " output) ""))))
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'.
@@ -6014,7 +6020,8 @@ Gateway hops are already opened."
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
- (let ((p (tramp-get-connection-process vec)))
+ (let ((p (tramp-get-connection-process vec))
+ (process-environment (copy-sequence process-environment)))
;; If too much time has passed since last command was sent, look
;; whether process is still alive. If it isn't, kill it. When
@@ -6062,10 +6069,10 @@ connection if a previous connection has died for some reason."
(when (and p (processp p))
(delete-process p))
(setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" "C")
(setenv "PROMPT_COMMAND")
(setenv "PS1" "$ ")
(let* ((target-alist (tramp-compute-multi-hops vec))
- (process-environment (copy-sequence process-environment))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
(coding-system-for-read nil)
@@ -6197,7 +6204,9 @@ function waits for output unless NOOUTPUT is set."
(let ((found
(tramp-wait-for-regexp
proc timeout
- (format "^%s\r?$" (regexp-quote tramp-end-of-output)))))
+ ;; Initially, `tramp-end-of-output' is "$ ". There might
+ ;; be leading escape sequences, which must be ignored.
+ (format "^[^$\n]*%s\r?$" (regexp-quote tramp-end-of-output)))))
(if found
(let (buffer-read-only)
(goto-char (point-max))
@@ -6514,7 +6523,7 @@ Not actually used. Use `(format \"%o\" i)' instead?"
;; ------------------------------------------------------------
-;; -- TRAMP file names --
+;; -- Tramp file names --
;; ------------------------------------------------------------
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
@@ -6558,7 +6567,7 @@ Not actually used. Use `(format \"%o\" i)' instead?"
(string-to-number (match-string 2 host)))))
(defun tramp-tramp-file-p (name)
- "Return t if NAME is a tramp file."
+ "Return t if NAME is a Tramp file."
(save-match-data
(string-match tramp-file-name-regexp name)))
@@ -6608,7 +6617,7 @@ non-nil, the file name parts are not expanded to their default
values."
(save-match-data
(let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (error "Not a tramp file name: %s" name))
+ (unless match (error "Not a Tramp file name: %s" name))
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
@@ -6726,6 +6735,18 @@ necessary only. This function will be used in file name completion."
x))
remote-path)))))
+(defun tramp-get-remote-tmpdir (vec)
+ (with-connection-property vec "tmp-directory"
+ (let ((dir (tramp-shell-quote-argument "/tmp")))
+ (if (and (zerop
+ (tramp-send-command-and-check
+ vec (format "%s -d %s" (tramp-get-test-command vec) dir)))
+ (zerop
+ (tramp-send-command-and-check
+ vec (format "%s -w %s" (tramp-get-test-command vec) dir))))
+ dir
+ (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+
(defun tramp-get-ls-command (vec)
(with-connection-property vec "ls"
(with-current-buffer (tramp-get-buffer vec)
@@ -7161,265 +7182,6 @@ Only works for Bourne-like shells."
(add-hook 'tramp-unload-hook
'(lambda () (ad-unadvise 'file-expand-wildcards))))
-;; Tramp version is useful in a number of situations.
-
-(defun tramp-version (arg)
- "Print version number of tramp.el in minibuffer or current buffer."
- (interactive "P")
- (if arg (insert tramp-version) (message tramp-version)))
-
-;; Make the `reporter` functionality available for making bug reports about
-;; the package. A most useful piece of code.
-
-(unless (fboundp 'reporter-submit-bug-report)
- (autoload 'reporter-submit-bug-report "reporter"))
-
-(defun tramp-bug ()
- "Submit a bug report to the TRAMP developers."
- (interactive)
- (require 'reporter)
- (catch 'dont-send
- (let ((reporter-prompt-for-summary-p t))
- (reporter-submit-bug-report
- tramp-bug-report-address ; to-address
- (format "tramp (%s)" tramp-version) ; package name and version
- (delq nil
- `(;; Current state
- tramp-current-method
- tramp-current-user
- tramp-current-host
-
- ;; System defaults
- tramp-auto-save-directory ; vars to dump
- tramp-default-method
- tramp-default-method-alist
- tramp-default-host
- tramp-default-proxies-alist
- tramp-default-user
- tramp-default-user-alist
- tramp-rsh-end-of-line
- tramp-default-password-end-of-line
- tramp-login-prompt-regexp
- ;; Mask non-7bit characters
- (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
- tramp-wrong-passwd-regexp
- tramp-yesno-prompt-regexp
- tramp-yn-prompt-regexp
- tramp-terminal-prompt-regexp
- tramp-temp-name-prefix
- tramp-file-name-structure
- tramp-file-name-regexp
- tramp-methods
- tramp-end-of-output
- tramp-local-coding-commands
- tramp-remote-coding-commands
- tramp-actions-before-shell
- tramp-actions-copy-out-of-band
- tramp-terminal-type
- ;; Mask non-7bit characters
- (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
- ,(when (boundp 'tramp-backup-directory-alist)
- 'tramp-backup-directory-alist)
- ,(when (boundp 'tramp-bkup-backup-directory-info)
- 'tramp-bkup-backup-directory-info)
- ;; Dump cache.
- (tramp-cache-data . tramp-reporter-dump-variable)
-
- ;; Non-tramp variables of interest
- ;; Mask non-7bit characters
- (shell-prompt-pattern . tramp-reporter-dump-variable)
- backup-by-copying
- backup-by-copying-when-linked
- backup-by-copying-when-mismatch
- ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
- 'backup-by-copying-when-privileged-mismatch)
- ,(when (boundp 'password-cache)
- 'password-cache)
- ,(when (boundp 'password-cache-expiry)
- 'password-cache-expiry)
- ,(when (boundp 'backup-directory-alist)
- 'backup-directory-alist)
- ,(when (boundp 'bkup-backup-directory-info)
- 'bkup-backup-directory-info)
- file-name-handler-alist))
-
- 'tramp-load-report-modules ; pre-hook
- 'tramp-append-tramp-buffers ; post-hook
- "\
-Enter your bug report in this message, including as much detail
-as you possibly can about the problem, what you did to cause it
-and what the local and remote machines are.
-
-If you can give a simple set of instructions to make this bug
-happen reliably, please include those. Thank you for helping
-kill bugs in Tramp.
-
-Another useful thing to do is to put
-
- (setq tramp-verbose 8)
-
-in the ~/.emacs file and to repeat the bug. Then, include the
-contents of the *tramp/foo* buffer and the *debug tramp/foo*
-buffer in your bug report.
-
---bug report follows this line--
-"))))
-
-(defun tramp-reporter-dump-variable (varsym mailbuf)
- "Pretty-print the value of the variable in symbol VARSYM.
-Used for non-7bit chars in strings."
- (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
- (val (with-current-buffer reporter-eval-buffer
- (symbol-value varsym))))
-
- (if (hash-table-p val)
- ;; Pretty print the cache.
- (set varsym (read (format "(%s)" (tramp-cache-print val))))
- ;; There are characters to be masked.
- (when (and (boundp 'mm-7bit-chars)
- (string-match
- (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
- (with-current-buffer reporter-eval-buffer
- (set varsym (format "(base64-decode-string \"%s\""
- (base64-encode-string val))))))
-
- ;; Dump variable.
- (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
-
- (unless (hash-table-p val)
- ;; Remove string quotation.
- (forward-line -1)
- (when (looking-at
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$")) ;; \4 "
- (replace-match "\\1\\2\\3\\4")
- (beginning-of-line)
- (insert " ;; variable encoded due to non-printable characters\n"))
- (forward-line 1))
-
- ;; Reset VARSYM to old value.
- (with-current-buffer reporter-eval-buffer
- (set varsym val))))
-
-(defun tramp-load-report-modules ()
- "Load needed modules for reporting."
-
- ;; We load message.el and mml.el from Gnus.
- (if (featurep 'xemacs)
- (progn
- (load "message" 'noerror)
- (load "mml" 'noerror))
- (require 'message nil 'noerror)
- (require 'mml nil 'noerror))
- (when (functionp 'message-mode)
- (funcall (symbol-function 'message-mode)))
- (when (functionp 'mml-mode)
- (funcall (symbol-function 'mml-mode) t)))
-
-(defun tramp-append-tramp-buffers ()
- "Append Tramp buffers and buffer local variables into the bug report."
-
- (goto-char (point-max))
-
- ;; Dump buffer local variables.
- (dolist (buffer
- (delq nil
- (mapcar
- '(lambda (b)
- (when (string-match "\\*tramp/" (buffer-name b)) b))
- (buffer-list))))
- (let ((reporter-eval-buffer buffer)
- (buffer-name (buffer-name buffer))
- (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
- (with-current-buffer elbuf
- (emacs-lisp-mode)
- (erase-buffer)
- (insert "\n(setq\n")
- (lisp-indent-line)
- (funcall (symbol-function 'reporter-dump-variable)
- 'buffer-name (current-buffer))
- (dolist (varsym-or-cons-cell (buffer-local-variables buffer))
- (let ((varsym (or (car-safe varsym-or-cons-cell)
- varsym-or-cons-cell)))
- (when (string-match "tramp" (symbol-name varsym))
- (funcall
- (symbol-function 'reporter-dump-variable)
- varsym (current-buffer)))))
- (lisp-indent-line)
- (insert ")\n"))
- (insert-buffer-substring elbuf)))
-
- ;; Append buffers only when we are in message mode.
- (when (and
- (eq major-mode 'message-mode)
- (boundp 'mml-mode)
- (symbol-value 'mml-mode))
-
- (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
- (buffer-list (funcall (symbol-function 'tramp-list-tramp-buffers)))
- (curbuf (current-buffer)))
-
- ;; There is at least one Tramp buffer.
- (when buffer-list
- (switch-to-buffer (list-buffers-noselect nil))
- (delete-other-windows)
- (setq buffer-read-only nil)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- tramp-buf-regexp (tramp-compat-line-end-position) t)
- (forward-line 1)
- (forward-line 0)
- (let ((start (point)))
- (forward-line 1)
- (kill-region start (point)))))
- (insert "
-The buffer(s) above will be appended to this message. If you
-don't want to append a buffer because it contains sensitive data,
-or because the buffer is too large, you should delete the
-respective buffer. The buffer(s) will contain user and host
-names. Passwords will never be included there.")
-
- (when (>= tramp-verbose 6)
- (insert "\n\n")
- (let ((start (point)))
- (insert "\
-Please note that you have set `tramp-verbose' to a value of at
-least 6. Therefore, the contents of files might be included in
-the debug buffer(s).")
- (add-text-properties start (point) (list 'face 'italic))))
-
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (goto-char (point-min))
-
- (if (y-or-n-p "Do you want to append the buffer(s)? ")
- ;; OK, let's send. First we delete the buffer list.
- (progn
- (kill-buffer nil)
- (switch-to-buffer curbuf)
- (goto-char (point-max))
- (insert "\n\
-This is a special notion of the `gnus/message' package. If you
-use another mail agent (by copying the contents of this buffer)
-please ensure that the buffers are attached to your email.\n\n")
- (dolist (buffer buffer-list)
- (funcall (symbol-function 'mml-insert-empty-tag)
- 'part 'type "text/plain" 'encoding "base64"
- 'disposition "attachment" 'buffer buffer
- 'description buffer))
- (set-buffer-modified-p nil))
-
- ;; Don't send. Delete the message buffer.
- (set-buffer curbuf)
- (set-buffer-modified-p nil)
- (kill-buffer nil)
- (throw 'dont-send nil))))))
-
-(defalias 'tramp-submit-bug 'tramp-bug)
-
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
@@ -7521,7 +7283,7 @@ please ensure that the buffers are attached to your email.\n\n")
;; having the possibility of passing a local file there to a local
;; Emacs session (in case I can arrange for a connection back) would
;; be nice.
-;; Likely the corresponding tramp server should not allow the
+;; Likely the corresponding Tramp server should not allow the
;; equivalent of the emacsclient -eval option in order to make this
;; reasonably unproblematic. And maybe trampclient should have some
;; way of passing credentials, like by using an SSL socket or
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-21 09:28:52 +0000