From 26e7624b234f350a1f483d6fe0be8c30cca03008 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 13 Nov 2015 17:41:55 +0100 Subject: Adapt Tramp version, do not merge with master * doc/misc/trampver.texi (trampver): * lisp/net/trampver.el (tramp-version): Set to "2.2.13-25.1". --- lisp/net/trampver.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 5c42f3a828a..04046c5ee7d 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.13-pre" +(defconst tramp-version "2.2.13-25.1" "This version of Tramp.") ;;;###tramp-autoload -- cgit v1.2.1 From e0d2dc5fd7205dcfd9125a35a7dc4468d9f6b2af Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 13 Nov 2015 11:23:35 +0200 Subject: Fix last change in shr.el * lisp/net/shr.el (shr--have-one-fringe-p): Rename from have-fringes-p. All callers changed. Doc fix. (Bug#21895) Backport. --- lisp/net/shr.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 23e2dc1f874..a48d098fe26 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -203,9 +203,8 @@ cid: URL as the argument.") (goto-char begin) (shr-insert-document dom)))) -(defun have-fringes-p () - "Return t if fringe-columns is bound, and either (fringe-columns 'left) or -\(fringe-columns 'right) returns nonzero." +(defun shr--have-one-fringe-p () + "Return non-nil if we know at least one of the fringes has non-zero width." (and (fboundp 'fringe-columns) (or (not (zerop (fringe-columns 'right))) (not (zerop (fringe-columns 'left)))))) @@ -237,13 +236,13 @@ DOM should be a parse tree as generated by (if (not shr-use-fonts) (- (window-body-width) 1 (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) 0 1)) (- (window-body-width nil t) (* 2 (frame-char-width)) (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))))) (shr-descend dom) @@ -467,7 +466,7 @@ size, and full-buffer size." ;; to usurp one column for the ;; continuation glyph. (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))) (shr-insert text) -- cgit v1.2.1 From ac16149ba470ae8a625d42a61adbb6e84254c675 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 17 Nov 2015 15:28:50 -0800 Subject: =?UTF-8?q?Fix=20docstring=20quoting=20problems=20with=20=E2=80=98?= =?UTF-8?q?=20'=E2=80=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Artur Malabarba in: http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01513.html Most of these fixes are to documentation; many involve fixing longstanding quoting glitches that are independent of the recent substitute-command-keys changes. The changes to code are: * lisp/cedet/mode-local.el (mode-local-augment-function-help) (describe-mode-local-overload): Substitute docstrings before displaying them. * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Quote the generated docstring for later substitution. --- lisp/net/ange-ftp.el | 2 +- lisp/net/eww.el | 2 +- lisp/net/imap.el | 6 +++--- lisp/net/mairix.el | 2 +- lisp/net/newst-backend.el | 10 +++++----- lisp/net/newst-plainview.el | 12 ++++++------ lisp/net/rcirc.el | 2 +- lisp/net/soap-client.el | 4 ++-- lisp/net/tramp.el | 4 ++-- 9 files changed, 22 insertions(+), 22 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 4f7fa3b8f39..7fbf7f3650f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3863,7 +3863,7 @@ If VERBOSE-P is non-nil, print progress report in the echo area. FILES is a list of files to copy in the form (from-file to-file ok-if-already-exists keep-date) E.g., - (ange-ftp-copy-files-async t nil t '((\"a\" \"b\" t t) (\"c\" \"d\" t t)))" + (ange-ftp-copy-files-async t nil t \\='((\"a\" \"b\" t t) (\"c\" \"d\" t t)))" (unless okay-p (error "%s: %s" 'ange-ftp-copy-files-async line)) (if files (let* ((ff (car files)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5748e88bbca..cd659d0840e 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -93,7 +93,7 @@ desktop. Otherwise, such entries will be retained." (defcustom eww-restore-desktop nil "How to restore EWW buffers on `desktop-restore'. -If t or 'auto, the buffers will be reloaded automatically. +If t or `auto', the buffers will be reloaded automatically. If nil, buffers will require manual reload, and will contain the text specified in `eww-restore-reload-prompt' instead of the actual Web page contents." diff --git a/lisp/net/imap.el b/lisp/net/imap.el index b559ff65908..33eb3e43836 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -453,7 +453,7 @@ second the status (OK, NO, BAD etc) of the command.") When non-nil, use an alternative UIDS form. Enabling appears to be required for some servers (e.g., Microsoft Exchange 2007) -which otherwise would trigger a response 'BAD The specified +which otherwise would trigger a response `BAD The specified message set is invalid.'. We don't unconditionally use this form, since this is said to be significantly inefficient. @@ -1564,8 +1564,8 @@ returned, if ITEMS is a symbol only its value is returned." (defun imap-mailbox-status-asynch (mailbox items &optional buffer) "Send status item requests ITEMS on MAILBOX to server in BUFFER. ITEMS can be a symbol or a list of symbols, valid symbols are one of -the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity -or 'unseen. The IMAP command tag is returned." +the STATUS data items -- i.e., `messages', `recent', `uidnext', `uidvalidity' +or `unseen'. The IMAP command tag is returned." (with-current-buffer (or buffer (current-buffer)) (imap-send-command (list "STATUS \"" (imap-utf7-encode mailbox) diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index a73b4dfa921..997e47b1ec2 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -211,7 +211,7 @@ nil for disabling this).") (defvar mairix-widget-other '(threads flags) "Other editable mairix commands when using customization widgets. -Currently there are 'threads and 'flags.") +Currently there are `threads' and `flags'.") ;;;; Internal variables diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 072fd015b60..2bec11ee3a3 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -502,8 +502,8 @@ This is a list of the form where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are strings. TIME is a time value as returned by `current-time'. -AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote -ordinary news items, whereas 'feed denotes an item which is not a +AGE is a symbol: `new', `old', `immortal', and `obsolete' denote +ordinary news items, whereas `feed' denotes an item which is not a headline but describes the feed itself. INDEX denotes the original position of the item -- used for restoring the original order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the @@ -1987,7 +1987,7 @@ Renders the HTML code in the region POS1 to POS2 using htmlr." (defun newsticker--cache-replace-age (data feed old-age new-age) "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE. -If FEED is 'any it applies to all feeds. If OLD-AGE is 'any, +If FEED is `any' it applies to all feeds. If OLD-AGE is `any', all marks are replaced by NEW-AGE. Removes all pre-formatted contents." (mapc (lambda (a-feed) (when (or (eq feed 'any) @@ -2038,7 +2038,7 @@ The properties which are checked are TITLE, DESC, LINK, AGE, and GUID. In general all properties must match in order to return a certain item, except for the following cases. -If AGE equals 'feed the TITLE, DESCription and LINK do not +If AGE equals `feed' the TITLE, DESCription and LINK do not matter. If DESC is nil it is ignored as well. If `newsticker-desc-comp-max' is non-nil, only the first `newsticker-desc-comp-max' characters of DESC are taken into @@ -2143,7 +2143,7 @@ which the item got." (defun newsticker--cache-remove (data feed-symbol age) "Remove all entries from DATA in the feed FEED-SYMBOL with AGE. -FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in +FEED-SYMBOL may be `any'. Entries from old feeds, which are no longer in `newsticker-url-list' or `newsticker-url-list-defaults', are removed as well." (let* ((pos data) diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 0cb5d8c6a2f..b4e569078a9 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -228,7 +228,7 @@ Each function is called after one of `newsticker-next-item', `newsticker-next-new-item', `newsticker-previous-item', `newsticker-previous-new-item' has been called. -The default value 'newsticker--buffer-make-item-completely-visible +The default value `newsticker--buffer-make-item-completely-visible' assures that the current item is always completely visible." :type 'hook :options '(newsticker--buffer-make-item-completely-visible) @@ -240,7 +240,7 @@ assures that the current item is always completely visible." Each function is called after one of `newsticker-next-feed', and `newsticker-previous-feed' has been called. -The default value 'newsticker--buffer-make-item-completely-visible +The default value `newsticker--buffer-make-item-completely-visible' assures that the current feed is completely visible." :type 'hook :options '(newsticker--buffer-make-item-completely-visible) @@ -251,7 +251,7 @@ assures that the current feed is completely visible." "List of functions run after the newsticker buffer has been updated. Each function is called after `newsticker-buffer-update' has been called. -The default value `\\='newsticker-w3m-show-inline-images' loads inline +The default value `newsticker-w3m-show-inline-images' loads inline images." :type 'hook :group 'newsticker-plainview-hooks) @@ -263,7 +263,7 @@ Each function is called after `newsticker-toggle-auto-narrow-to-feed' or `newsticker-toggle-auto-narrow-to-item' has been called. -The default value `\\='newsticker-w3m-show-inline-images' loads inline +The default value `newsticker-w3m-show-inline-images' loads inline images." :type 'hook :group 'newsticker-plainview-hooks) @@ -1524,8 +1524,8 @@ Scans the buffer between START and END." (defun newsticker--buffer-set-invisibility (start end) "Add invisibility properties according to nt-type property. -Scans the buffer between START and END. Sets the 'invisible -property to '(- )." +Scans the buffer between START and END. Sets the `invisible' +property to (- )." (save-excursion ;; reset invisibility settings (put-text-property start end 'invisible nil) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index d58f3ebd4ea..3539dcf91f4 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -320,7 +320,7 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." (defcustom rcirc-decode-coding-system 'utf-8 "Coding system used to decode incoming irc messages. -Set to 'undecided if you want the encoding of the incoming +Set to `undecided' if you want the encoding of the incoming messages autodetected." :type 'coding-system :group 'rcirc) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 71d42459974..790084a4862 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -58,7 +58,7 @@ (require 'mm-decode) (defsubst soap-warning (message &rest args) - "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." + "Display a warning MESSAGE with ARGS, using the `soap-client' warning type." ;; Do not use #'format-message, to support older Emacs versions. (display-warning 'soap-client (apply #'format message args) :warning)) @@ -562,7 +562,7 @@ fractional seconds, and the DST (daylight savings time) field is replaced with DATATYPE, a symbol representing the XSD primitive datatype. This symbol can be used to determine which fields apply and which don't when it's not already clear from context. -For example a datatype of 'time means the year, month and day +For example a datatype of `time' means the year, month and day fields should be ignored. This function will throw an error if DATE-TIME-STRING represents diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 42a9e3d6710..40c3f368a9f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -694,8 +694,8 @@ Useful for \"rsync\" like methods.") It can have the following values: - 'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default) - 'sep -- Syntax as defined for XEmacs." + `ftp' -- Ange-FTP respective EFS like syntax (GNU Emacs default) + `sep' -- Syntax as defined for XEmacs." :group 'tramp :version "24.4" :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp) -- cgit v1.2.1 From bb4303c536a2ac5fe683a711ef8072074f77670e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 18 Nov 2015 09:17:20 -0800 Subject: Quote symbols in docstrings using `' Be more systematic about quoting symbols `like-this' rather than `like-this or 'like-this' in docstrings. This follows up Artur Malabarba's email in: http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01647.html --- lisp/net/eww.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index cd659d0840e..205be41a000 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1869,7 +1869,7 @@ Generally, the list should not include the (usually overly large) (defun eww-restore-desktop (file-name buffer-name misc-data) "Restore an eww buffer from its desktop file record. -If `eww-restore-desktop' is t or 'auto, this function will also +If `eww-restore-desktop' is t or `auto', this function will also initiate the retrieval of the respective URI in the background. Otherwise, the restored buffer will contain a prompt to do so by using \\[eww-reload]." -- cgit v1.2.1 From 43d2e55fc17336b33a1581adf60179ff07ad580c Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Sun, 22 Nov 2015 17:30:50 -0500 Subject: Add BBDB 3 support for EUDC export * eudc.el: Add bbdb-version defvar. (eudc--using-bbdb-3-or-newer-p): New function. * eudc-export.el (eudc-create-bbdb-record): Add support for bbdb-create-internal argument list changes introduced in BBDB 3. * eudcb-bbdb.el: Remove bbdb-version defvar. (eudc-bbdb-field): Call eudc--using-bbdb-3-or-newer-p. (Bug#21971) --- lisp/net/eudc-export.el | 19 +++++++++++++------ lisp/net/eudc.el | 12 ++++++++++++ lisp/net/eudcb-bbdb.el | 10 +--------- 3 files changed, 26 insertions(+), 15 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index c60911ff0c5..a65f555f89e 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -86,12 +86,19 @@ If SILENT is non-nil then the created BBDB record is not displayed." (cons (car mapping) value)))) conversion-alist))) (setq bbdb-notes (delq nil bbdb-notes)) - (setq bbdb-record (bbdb-create-internal bbdb-name - bbdb-company - bbdb-net - bbdb-address - bbdb-phones - bbdb-notes)) + (setq bbdb-record (bbdb-create-internal + bbdb-name + ,@(when (eudc--using-bbdb-3-or-newer-p) + '(nil + nil)) + bbdb-company + bbdb-net + ,@(if (eudc--using-bbdb-3-or-newer-p) + '(bbdb-phones + bbdb-address) + '(bbdb-address + bbdb-phones)) + bbdb-notes)) (or silent (bbdb-display-records (list bbdb-record)))))) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 7280d9d2625..25a26bdf029 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -107,6 +107,18 @@ ;; attribute name (defvar eudc-protocol-has-default-query-attributes nil) +(defvar bbdb-version) + +(defun eudc--using-bbdb-3-or-newer-p () + "Return non-nil if BBDB version is 3 or greater." + (or + ;; MELPA versions of BBDB may have a bad package version, but + ;; they're all version 3 or later. + (equal bbdb-version "@PACKAGE_VERSION@") + ;; Development versions of BBDB can have the format "X.YZ devo". + ;; Split the string just in case. + (version<= "3" (car (split-string bbdb-version))))) + (defun eudc-plist-member (plist prop) "Return t if PROP has a value specified in PLIST." (if (not (= 0 (% (length plist) 2))) diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 0545304b4a3..1972fc1939a 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -42,21 +42,13 @@ (defvar eudc-bbdb-current-query nil) (defvar eudc-bbdb-current-return-attributes nil) -(defvar bbdb-version) - (defun eudc-bbdb-field (field-symbol) "Convert FIELD-SYMBOL so that it is recognized by the current BBDB version. BBDB < 3 used `net'; BBDB >= 3 uses `mail'." ;; This just-in-time translation permits upgrading from BBDB 2 to ;; BBDB 3 without restarting Emacs. (if (and (eq field-symbol 'net) - (or - ;; MELPA versions of BBDB may have a bad package version, - ;; but they're all version 3 or later. - (equal bbdb-version "@PACKAGE_VERSION@") - ;; Development versions of BBDB can have the format "X.YZ - ;; devo". Split the string just in case. - (version<= "3" (car (split-string bbdb-version))))) + (eudc--using-bbdb-3-or-newer-p)) 'mail field-symbol)) -- cgit v1.2.1 From 124f1807c4b7beafedde654dcd298ae92caf5b09 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Sun, 22 Nov 2015 11:29:13 -0500 Subject: Improve EUDC to BBDB 3 export * eudc-vars.el (eudc-ldap-bbdb-conversion-alist): Change phone entry to single item. Add company conversion. * eudc-export.el (eudc-bbdbify-company): New function. (bbdb-parse-phone): Declare function. (eudc-bbdbify-phone): Add BBDB 3 support. (Bug#21971) --- lisp/net/eudc-export.el | 9 ++++++++- lisp/net/eudc-vars.el | 3 ++- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index a65f555f89e..a9fac516745 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -167,8 +167,13 @@ LOCATION is used as the address location for bbdb." ;; External. (declare-function bbdb-parse-phone-number "ext:bbdb-com" (string &optional number-type)) +(declare-function bbdb-parse-phone "ext:bbdb-com" (string &optional style)) (declare-function bbdb-string-trim "ext:bbdb" (string)) +(defun eudc-bbdbify-company (&rest organizations) + "Return ORGANIZATIONS as a list compatible with BBDB." + organizations) + (defun eudc-bbdbify-phone (phone location) "Parse PHONE into a vector compatible with BBDB. PHONE is either a string supposedly containing a phone number or @@ -179,7 +184,9 @@ LOCATION is used as the phone location for BBDB." ((stringp phone) (let (phone-list) (condition-case err - (setq phone-list (bbdb-parse-phone-number phone)) + (setq phone-list (if (eudc--using-bbdb-3-or-newer-p) + (bbdb-parse-phone phone) + (bbdb-parse-phone-number phone))) (error (if (string= "phone number unparsable." (cadr err)) (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone))) diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 8cffa8e466a..a08d175fd6e 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -369,7 +369,8 @@ BBDB fields. SPECs are sexps which are evaluated: '((name . cn) (net . mail) (address . (eudc-bbdbify-address postaladdress "Address")) - (phone . ((eudc-bbdbify-phone telephonenumber "Phone")))) + (phone . (eudc-bbdbify-phone telephonenumber "Phone")) + (company . (eudc-bbdbify-company o))) "A mapping from BBDB to LDAP attributes. This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where BBDB-FIELD is the name of a field that must be defined in your BBDB -- cgit v1.2.1 From de203a67d4c3762edd8ee7fdd346b4728331354d Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Mon, 30 Nov 2015 17:55:35 +0100 Subject: Fix scrambling of html-rendered item buffers * net/newst-treeview.el (newsticker--treeview-render-text): Fix scrambling of contents by wrapping call to html-renderer in save-selected-window. --- lisp/net/newst-treeview.el | 50 ++++++++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 22 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 0c2df8897d7..4f81b864970 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -267,28 +267,34 @@ their id stays constant." "Render text between markers START and END." (if newsticker-html-renderer (condition-case error-data - (save-excursion - (set-marker-insertion-type end t) - ;; check whether it is necessary to call html renderer - ;; (regexp inspired by htmlr.el) - (goto-char start) - (when (re-search-forward - " Date: Thu, 3 Dec 2015 15:27:21 +0000 Subject: Fix some file headers for the purpose of `package--builtins' * lisp/emacs-lisp/cl-preloaded.el * lisp/emacs-lisp/eieio-compat.el * lisp/net/sasl-scram-rfc.el: Add a "Package:" header * lisp/ielm.el: Fix summary line. --- lisp/net/sasl-scram-rfc.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/net') diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index 18d7a6bfa18..34d6ddbd679 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. ;; Author: Magnus Henoch +;; Package: sasl ;; This file is part of GNU Emacs. -- cgit v1.2.1 From a1c26b19fc779a9d796873fd7415c4f1bf1e7e4f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 3 Dec 2015 20:31:49 +0100 Subject: Some error message improvements in tramp-sh.el * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Suppress error messages for "mesg" and "biff" calls. (tramp-get-remote-path): Ignore errors when expanding `tramp-own-remote-path'. Raise a warning instead. --- lisp/net/tramp-sh.el | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f5ff6a7adec..a2153415f4d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4264,7 +4264,7 @@ process to set up. VEC specifies the connection." (tramp-find-shell vec) ;; Disable unexpected output. - (tramp-send-command vec "mesg n; biff n" t) + (tramp-send-command vec "mesg n 2>/dev/null; biff n 2>/dev/null" t) ;; IRIX64 bash expands "!" even when in single quotes. This ;; destroys our shell functions, we must disable it. See @@ -5295,21 +5295,26 @@ Return ATTR." ;; The login shell could return more than just the $PATH ;; string. So we use `tramp-end-of-heredoc' as marker. (when elt2 - (tramp-send-command-and-read - vec - (format - "%s %s %s 'echo %s \\\"$PATH\\\"'" - (tramp-get-method-parameter vec 'tramp-remote-shell) - (mapconcat - 'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-login) - " ") - (mapconcat - 'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-args) - " ") - (tramp-shell-quote-argument tramp-end-of-heredoc)) - nil (regexp-quote tramp-end-of-heredoc))))) + (or + (tramp-send-command-and-read + vec + (format + "%s %s %s 'echo %s \\\"$PATH\\\"'" + (tramp-get-method-parameter vec 'tramp-remote-shell) + (mapconcat + 'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-login) + " ") + (mapconcat + 'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-args) + " ") + (tramp-shell-quote-argument tramp-end-of-heredoc)) + 'noerror (regexp-quote tramp-end-of-heredoc)) + (progn + (tramp-message + vec 2 "Could not retrieve `tramp-own-remote-path'") + nil))))) ;; Replace place holder `tramp-default-remote-path'. (when elt1 -- cgit v1.2.1 From 156ad50b9146b4b517bcb7908cb75cc3863ba2c4 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 4 Dec 2015 19:49:07 -0500 Subject: * lisp/net/net-utils.el: Small improvements. (net-utils--executable-find-sbin): New function. (ifconfig-program): Check sbin directories. Fallback to "ip". (Bug#22091) (ifconfig-program-options): Check the actual program in use. (arp-program): Check sbin directories. --- lisp/net/net-utils.el | 35 ++++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 13 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index c6d40b62415..c43d48e514c 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -35,15 +35,19 @@ ;; * Support connections to HOST/PORT, generally for debugging and the like. ;; In other words, for doing much the same thing as "telnet HOST PORT", and ;; then typing commands. -;; -;; PATHS -;; -;; On some systems, some of these programs are not in normal user path, -;; but rather in /sbin, /usr/sbin, and so on. - ;;; Code: +;; On some systems, programs like ifconfig are not in normal user +;; path, but rather in /sbin, /usr/sbin, etc (but non-root users can +;; still use them for queries). Actually the trend these +;; day is for /sbin to be a symlink to /usr/sbin, but we still need to +;; search both for older systems. +(defun net-utils--executable-find-sbin (command) + "Return absolute name of COMMAND if found in an sbin directory." + (let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin"))) + (executable-find command))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customization Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -85,10 +89,13 @@ These options can be used to limit how many ICMP packets are emitted." (define-obsolete-variable-alias 'ipconfig-program 'ifconfig-program "22.2") (defcustom ifconfig-program - (if (eq system-type 'windows-nt) - "ipconfig" - "ifconfig") + (cond ((eq system-type 'windows-nt) "ipconfig") + ((executable-find "ifconfig") "ifconfig") + ((net-utils--executable-find-sbin "ifconfig")) + ((net-utils--executable-find-sbin "ip")) + (t "ip")) "Program to print network configuration information." + :version "25.1" ; add ip :group 'net-utils :type 'string) @@ -96,10 +103,12 @@ These options can be used to limit how many ICMP packets are emitted." 'ifconfig-program-options "22.2") (defcustom ifconfig-program-options - (list - (if (eq system-type 'windows-nt) - "/all" "-a")) + (cond ((string-match "ipconfig\\'" ifconfig-program) '("/all")) + ((string-match "ifconfig\\'" ifconfig-program) '("-a")) + ((string-match "ip\\'" ifconfig-program) '("addr"))) "Options for the ifconfig program." + :version "25.1" + :set-after '(ifconfig-program) :group 'net-utils :type '(repeat string)) @@ -126,7 +135,7 @@ These options can be used to limit how many ICMP packets are emitted." :group 'net-utils :type '(repeat string)) -(defcustom arp-program "arp" +(defcustom arp-program (or (net-utils--executable-find-sbin "arp") "arp") "Program to print IP to address translation tables." :group 'net-utils :type 'string) -- cgit v1.2.1 From f18e93442b283b4eabfc063a06892fa4cc8579e8 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 4 Dec 2015 19:56:32 -0500 Subject: ; * lisp/net/net-utils.el: Fix comment typo in previous. --- lisp/net/net-utils.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index c43d48e514c..643d312fc2b 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -41,7 +41,7 @@ ;; On some systems, programs like ifconfig are not in normal user ;; path, but rather in /sbin, /usr/sbin, etc (but non-root users can ;; still use them for queries). Actually the trend these -;; day is for /sbin to be a symlink to /usr/sbin, but we still need to +;; days is for /sbin to be a symlink to /usr/sbin, but we still need to ;; search both for older systems. (defun net-utils--executable-find-sbin (command) "Return absolute name of COMMAND if found in an sbin directory." -- cgit v1.2.1 From 0e574ea35ea75fa91a38718966ffe6c17b8e93d8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 6 Dec 2015 18:55:50 +0100 Subject: Fix minor Tramp problems found on BSD * lisp/net/tramp-sh.el (tramp-perl-file-truename): Do not append trailing slash. Quote apostrophes. (tramp-sh-handle-file-truename): Do not append trailing slash in the "ls" case. (tramp-get-ls-command-with-w-option): New defun. (tramp-do-file-attributes-with-ls) (tramp-do-directory-files-and-attributes-with-stat): Use it. * test/automated/tramp-tests.el (tramp-test31-special-characters-with-perl) (tramp-test31-special-characters-with-ls) (tramp-test32-utf8-with-perl, tramp-test32-utf8-with-ls): Suppress also readlink. --- lisp/net/tramp-sh.el | 64 +++++++++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 28 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a2153415f4d..2c2179e8285 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -621,10 +621,7 @@ if (!$result) { $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\"); } -if ($ARGV[0] =~ /\\/$/) { - $result = $result . \"/\"; -} - +$result =~ s/\"/\\\\\"/g; print \"\\\"$result\\\"\\n\"; ' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-truename' @@ -1143,20 +1140,17 @@ target of the symlink differ." ;; Do it yourself. We bind `directory-sep-char' here for ;; XEmacs on Windows, which would otherwise use backslash. - (t (let* ((directory-sep-char ?/) - (steps (tramp-compat-split-string localname "/")) - (localnamedir (tramp-run-real-handler - 'file-name-as-directory (list localname))) - (is-dir (string= localname localnamedir)) - (thisstep nil) - (numchase 0) - ;; Don't make the following value larger than - ;; necessary. People expect an error message in - ;; a timely fashion when something is wrong; - ;; otherwise they might think that Emacs is hung. - ;; Of course, correctness has to come first. - (numchase-limit 20) - symlink-target) + (t (let ((directory-sep-char ?/) + (steps (tramp-compat-split-string localname "/")) + (thisstep nil) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; + ;; otherwise they might think that Emacs is hung. + ;; Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) (while (and steps (< numchase numchase-limit)) (setq thisstep (pop steps)) (tramp-message @@ -1212,10 +1206,8 @@ target of the symlink differ." (if result (mapconcat 'identity (cons "" result) "/") "/")) - (when (and is-dir - (or (string= "" result) - (not (string= (substring result -1) "/")))) - (setq result (concat result "/")))))) + (when (string= "" result) + (setq result "/"))))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) @@ -1278,8 +1270,12 @@ target of the symlink differ." (tramp-get-ls-command vec) ;; On systems which have no quoting style, file names ;; with special characters could fail. - (if (tramp-get-ls-command-with-quoting-style vec) - "--quoting-style=c" "") + (cond + ((tramp-get-ls-command-with-quoting-style vec) + "--quoting-style=c") + ((tramp-get-ls-command-with-w-option vec) + "-w") + (t "")) (if (eq id-format 'integer) "-ildn" "-ild") (tramp-shell-quote-argument localname))) ;; Parse `ls -l' output ... @@ -1837,10 +1833,14 @@ be non-negative integers." "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) - ;; On systems which have no quoting style, file names with - ;; special characters could fail. - (if (tramp-get-ls-command-with-quoting-style vec) - "--quoting-style=shell" "") + ;; On systems which have no quoting style, file names with special + ;; characters could fail. + (cond + ((tramp-get-ls-command-with-quoting-style vec) + "--quoting-style=shell") + ((tramp-get-ls-command-with-w-option vec) + "-w") + (t "")) (tramp-get-remote-stat vec) tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker @@ -5417,6 +5417,14 @@ Return ATTR." vec (format "%s --quoting-style=shell -al /dev/null" (tramp-get-ls-command vec)))))) +(defun tramp-get-ls-command-with-w-option (vec) + (save-match-data + (with-tramp-connection-property vec "ls-w-option" + (tramp-message vec 5 "Checking, whether `ls -w' works") + ;; Option "-w" is available on BSD systems. + (tramp-send-command-and-check + vec (format "%s -alw /dev/null" (tramp-get-ls-command vec)))))) + (defun tramp-get-test-command (vec) (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command") -- cgit v1.2.1 From 0a45afa30fae6543fd21f3102ae259f02c1b9042 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Sun, 6 Dec 2015 19:33:24 -0500 Subject: Make eudcb-ph.el obsolete * doc/misc/eudc.texi: Bump version to 1.40.0. Remove PH/QI sections and mentions. * lisp/obsolete/eudcb-ph.el: Make obsolete. * lisp/net/eudc-vars.el (eudc-known-protocols): Remove ph. (eudc-ph-bbdb-conversion-alist): Make obsolete. * etc/NEWS: Mention this. (Bug#21191) --- lisp/net/eudc-vars.el | 6 +- lisp/net/eudcb-ph.el | 244 -------------------------------------------------- 2 files changed, 5 insertions(+), 245 deletions(-) delete mode 100644 lisp/net/eudcb-ph.el (limited to 'lisp/net') diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index a08d175fd6e..de7e25a66aa 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -50,7 +50,7 @@ instead." ;; Known protocols (used in completion) ;; Not to be mistaken with `eudc-supported-protocols' -(defvar eudc-known-protocols '(bbdb ph ldap)) +(defvar eudc-known-protocols '(bbdb ldap)) (defcustom eudc-server-hotlist nil "Directory servers to query. @@ -357,6 +357,10 @@ BBDB fields. SPECs are sexps which are evaluated: (symbol :tag "BBDB Field") (sexp :tag "Conversion Spec")))) +(make-obsolete-variable 'eudc-ph-bbdb-conversion-alist + "the EUDC PH/QI backend is obsolete." + "25.1") + ;;}}} ;;{{{ LDAP Custom Group diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el deleted file mode 100644 index f144bf695f5..00000000000 --- a/lisp/net/eudcb-ph.el +++ /dev/null @@ -1,244 +0,0 @@ -;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend - -;; Copyright (C) 1998-2015 Free Software Foundation, Inc. - -;; Author: Oscar Figueiredo -;; Pavel Janík -;; Maintainer: Thomas Fitzsimmons -;; Keywords: comm -;; Package: eudc - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This library provides specific CCSO PH/QI protocol support for the -;; Emacs Unified Directory Client package. - -;;; Code: - -(require 'eudc) - -;;{{{ Internal cooking - -(eudc-protocol-set 'eudc-bbdb-conversion-alist 'eudc-ph-bbdb-conversion-alist 'ph) -(eudc-protocol-set 'eudc-query-function 'eudc-ph-query-internal 'ph) -(eudc-protocol-set 'eudc-list-attributes-function 'eudc-ph-get-field-list 'ph) -(eudc-protocol-set 'eudc-protocol-has-default-query-attributes t 'ph) - -(defvar eudc-ph-process-buffer nil) -(defvar eudc-ph-read-point) - -(defconst eudc-ph-default-server-port 105 - "Default TCP port for CCSO PH/QI directory services.") - -(defun eudc-ph-query-internal (query &optional return-fields) - "Query the PH/QI server with QUERY. -QUERY can be a string NAME or a list made of strings NAME -and/or cons cells (KEY . VALUE) where KEYs should be valid -CCSO database keys. NAME is equivalent to (DEFAULT . NAME), -where DEFAULT is the default key of the database. -RETURN-FIELDS is a list of database fields to return, -defaulting to `eudc-default-return-attributes'." - (let (request) - (if (null return-fields) - (setq return-fields eudc-default-return-attributes)) - (if (eq 'all return-fields) - (setq return-fields '(all))) - (setq request - (concat "query " - (if (stringp query) - query - (mapconcat (function (lambda (elt) - (if (stringp elt) elt) - (format "%s=%s" (car elt) (cdr elt)))) - query - " ")) - (if return-fields - (concat " return " (mapconcat 'symbol-name return-fields " "))))) - (and (> (length request) 6) - (eudc-ph-do-request request) - (eudc-ph-parse-query-result return-fields)))) - -(defun eudc-ph-get-field-list (full-records) - "Return a list of valid field names for the current server. -If FULL-RECORDS is non-nil, full records including field description -are returned" - (interactive) - (eudc-ph-do-request "fields") - (if full-records - (eudc-ph-parse-query-result) - (mapcar #'caar (eudc-ph-parse-query-result)))) - -(defun eudc-ph-parse-query-result (&optional fields) - "Return a list of alists of key/values from in `eudc-ph-process-buffer'. -Fields not in FIELDS are discarded." - (let (record - records - line-regexp - current-key - key - value - ignore) - (save-excursion - (message "Parsing results...") - (set-buffer eudc-ph-process-buffer) - (goto-char (point-min)) - (while (re-search-forward "^\\(-[0-9]+\\):\\([0-9]+\\):" nil t) - (catch 'ignore - (setq line-regexp (concat "^\\(-[0-9]+\\):" (match-string 2) ":[ \t]*\\([-a-zA-Z_]*\\)?:[ \t]*\\(.*\\)$")) - (beginning-of-line) - (setq record nil - ignore nil - current-key nil) - (while (re-search-forward line-regexp nil t) - (catch 'skip-line - (if (string= "-508" (match-string 1)) - ;; A field is missing in this entry. Skip it or skip the - ;; whole record (see `eudc-strict-return-matches') - (if (not eudc-strict-return-matches) - (throw 'skip-line t) - (while (re-search-forward line-regexp nil t)) - (setq ignore t) - (throw 'ignore t))) - (setq key (and (not (string= (match-string 2) "")) - (intern (match-string 2))) - value (match-string 3)) - (if (and current-key - (eq key current-key)) - (setq key nil) - (setq current-key key)) - (if (or (null fields) - (eq 'all fields) - (memq current-key fields)) - (if key - (setq record (cons (cons key value) record)) ; New key - (setcdr (car record) (if (listp (cdar record)) - (append (cdar record) (list value)) - (list (cdar record) value)))))))) - (and (not ignore) - (or (null fields) - (eq 'all fields) - (setq record (nreverse record))) - (setq record (if (not (eq 'list eudc-duplicate-attribute-handling-method)) - (eudc-filter-duplicate-attributes record) - (list record))) - (setq records (append record records))))) - (message "Done") - records)) - -(defun eudc-ph-do-request (request) - "Send REQUEST to the server. -Wait for response and return the buffer containing it." - (let (process - buffer) - (unwind-protect - (progn - (message "Contacting server...") - (setq process (eudc-ph-open-session)) - (if process - (with-current-buffer (setq buffer (process-buffer process)) - (eudc-ph-send-command process request) - (message "Request sent, waiting for reply...") - (eudc-ph-read-response process)))) - (if process - (eudc-ph-close-session process))) - buffer)) - -(defun eudc-ph-open-session (&optional server) - "Open a connection to the given CCSO/QI SERVER. -SERVER is either a string naming the server or a list (NAME PORT)." - (let (process - host - port) - (catch 'done - (if (null server) - (setq server (or eudc-server - (call-interactively 'eudc-ph-set-server)))) - (string-match "\\(.*\\)\\(:\\(.*\\)\\)?" server) - (setq host (match-string 1 server)) - (setq port (or (match-string 3 server) - eudc-ph-default-server-port)) - (setq eudc-ph-process-buffer (get-buffer-create (format " *PH-%s*" host))) - (with-current-buffer eudc-ph-process-buffer - (erase-buffer) - (setq eudc-ph-read-point (point)) - (and (featurep 'xemacs) (featurep 'mule) - (set-buffer-file-coding-system 'binary t))) - (setq process (open-network-stream "ph" eudc-ph-process-buffer host port)) - (if (null process) - (throw 'done nil)) - (set-process-query-on-exit-flag process t) - process))) - -(defun eudc-ph-close-session (process) - (with-current-buffer (process-buffer process) - (eudc-ph-send-command process "quit") - (eudc-ph-read-response process) - (run-at-time 2 nil 'delete-process process))) - -(defun eudc-ph-send-command (process command) - (goto-char (point-max)) - (process-send-string process command) - (process-send-string process "\r\n") - ) - -(defun eudc-ph-read-response (process &optional return-response) - "Read a response from the PH/QI query process PROCESS. -Returns nil if response starts with an error code. If the -response is successful the return code or the response itself is returned -depending on RETURN-RESPONSE." - (let ((case-fold-search nil) - return-code - match-end) - (goto-char eudc-ph-read-point) - ;; CCSO protocol : response complete if status >= 200 - (while (not (re-search-forward "^\\(^[2-5].*\\):.*\n" nil t)) - (accept-process-output process) - (goto-char eudc-ph-read-point)) - (setq match-end (point)) - (goto-char eudc-ph-read-point) - (if (and (setq return-code (match-string 1)) - (setq return-code (string-to-number return-code)) - (>= (abs return-code) 300)) - (progn (setq eudc-ph-read-point match-end) nil) - (setq eudc-ph-read-point match-end) - (if return-response - (buffer-substring (point) match-end) - return-code)))) - -;;}}} - -;;{{{ High-level interfaces (interactive functions) - -(defun eudc-ph-customize () - "Customize the EUDC PH support." - (interactive) - (customize-group 'eudc-ph)) - -(defun eudc-ph-set-server (server) - "Set the PH server to SERVER." - (interactive "sNew PH/QI Server: ") - (message "Selected PH/QI server is now %s" server) - (eudc-set-server server 'ph)) - -;;}}} - -(eudc-register-protocol 'ph) - -(provide 'eudcb-ph) - -;;; eudcb-ph.el ends here -- cgit v1.2.1 From eb85d55cea4c5a715c4381ab6aeee630183fa23e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 7 Dec 2015 08:15:27 +0000 Subject: Fix an utf8 problem for Tramp on BSD * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Make lax check for utf8. (tramp-get-remote-locale): Add "en_US.UTF-8" as candidate. --- lisp/net/tramp-sh.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c2179e8285..c1df1c602d5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4149,7 +4149,8 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." "Set up an interactive shell. Mainly sets the prompt and the echo correctly. PROC is the shell process to set up. VEC specifies the connection." - (let ((tramp-end-of-output tramp-initial-end-of-output)) + (let ((tramp-end-of-output tramp-initial-end-of-output) + (case-fold-search t)) (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell)) ;; Disable tab and echo expansion. @@ -4182,7 +4183,7 @@ process to set up. VEC specifies the connection." ;; Use MULE to select the right EOL convention for communicating ;; with the process. (let ((cs (or (and (memq 'utf-8 (coding-system-list)) - (string-match "utf8" (tramp-get-remote-locale vec)) + (string-match "utf-?8" (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (tramp-compat-funcall 'process-coding-system proc) (cons 'undecided 'undecided))) @@ -5358,7 +5359,7 @@ Return ATTR." (defun tramp-get-remote-locale (vec) (with-tramp-connection-property vec "locale" (tramp-send-command vec "locale -a") - (let ((candidates '("en_US.utf8" "C.utf8")) + (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-current-buffer (tramp-get-connection-buffer vec) (while candidates -- cgit v1.2.1 From b227422c66f20806f406730f8ef7dea276956151 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 9 Dec 2015 12:17:15 +0100 Subject: Fix error in Tramp perl script for cygwin * lisp/net/tramp-sh.el (tramp-perl-file-truename): Do not raise an error if file doesn't exist. --- lisp/net/tramp-sh.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c1df1c602d5..03492de1149 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -597,9 +597,14 @@ we have this shell function.") use File::Spec; use Cwd \"realpath\"; +sub myrealpath { + my ($file) = @_; + return realpath($file) if -e $file; +} + sub recursive { my ($volume, @dirs) = @_; - my $real = realpath(File::Spec->catpath( + my $real = myrealpath(File::Spec->catpath( $volume, File::Spec->catdir(@dirs), \"\")); if ($real) { my ($vol, $dir) = File::Spec->splitpath($real, 1); @@ -613,7 +618,7 @@ sub recursive { } } -$result = realpath($ARGV[0]); +$result = myrealpath($ARGV[0]); if (!$result) { my ($vol, $dir) = File::Spec->splitpath($ARGV[0], 1); ($vol, @dirs) = recursive($vol, File::Spec->splitdir($dir)); -- cgit v1.2.1 From 3be06984666626341e14db0fa2eef089d2f5de13 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 Dec 2015 12:05:37 +0100 Subject: Handle Mac OS X eol encoding in Tramp * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Handle Mac OS X eol encoding. --- lisp/net/tramp-sh.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 03492de1149..8e0ef57fd8a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -486,6 +486,7 @@ The string is used in `tramp-methods'.") ;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin ;; GNU/Linux (Debian, Suse): /bin:/usr/bin ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! +;; Darwin: /usr/bin:/bin:/usr/sbin:/sbin ;; IRIX64: /usr/bin ;;;###tramp-autoload (defcustom tramp-remote-path @@ -4198,8 +4199,12 @@ process to set up. VEC specifies the connection." (setq cs-encode (cdr cs)) (unless cs-decode (setq cs-decode 'undecided)) (unless cs-encode (setq cs-encode 'undecided)) - (setq cs-encode (tramp-compat-coding-system-change-eol-conversion - cs-encode 'unix)) + (setq cs-encode + (tramp-compat-coding-system-change-eol-conversion + cs-encode + (if (string-match + "^Darwin" (tramp-get-connection-property vec "uname" "")) + 'mac 'unix))) (tramp-send-command vec "echo foo ; echo bar" t) (goto-char (point-min)) (when (search-forward "\r" nil t) -- cgit v1.2.1 From 0ad27a5aab529d507829c60fa79aad9866f492ab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 Dec 2015 12:18:16 +0100 Subject: Complete last commit * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Move uname check up. Handle Mac OS X eol encoding. --- lisp/net/tramp-sh.el | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8e0ef57fd8a..ebf646f26ff 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4181,6 +4181,25 @@ process to set up. VEC specifies the connection." vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" (tramp-shell-quote-argument tramp-end-of-output)) t) + ;; Check whether the output of "uname -sr" has been changed. If + ;; yes, this is a strong indication that we must expire all + ;; connection properties. We start again with + ;; `tramp-maybe-open-connection', it will be caught there. + (tramp-message vec 5 "Checking system information") + (let ((old-uname (tramp-get-connection-property vec "uname" nil)) + (new-uname + (tramp-set-connection-property + vec "uname" + (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) + (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) + (tramp-message + vec 3 + "Connection reset, because remote host changed from `%s' to `%s'" + old-uname new-uname) + ;; We want to keep the password. + (tramp-cleanup-connection vec t t) + (throw 'uname-changed (tramp-maybe-open-connection vec)))) + ;; Try to set up the coding system correctly. ;; CCC this can't be the right way to do it. Hm. (tramp-message vec 5 "Determining coding system") @@ -4223,25 +4242,6 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "set +o vi +o emacs" t) - ;; Check whether the output of "uname -sr" has been changed. If - ;; yes, this is a strong indication that we must expire all - ;; connection properties. We start again with - ;; `tramp-maybe-open-connection', it will be caught there. - (tramp-message vec 5 "Checking system information") - (let ((old-uname (tramp-get-connection-property vec "uname" nil)) - (new-uname - (tramp-set-connection-property - vec "uname" - (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))) - (when (and (stringp old-uname) (not (string-equal old-uname new-uname))) - (tramp-message - vec 3 - "Connection reset, because remote host changed from `%s' to `%s'" - old-uname new-uname) - ;; We want to keep the password. - (tramp-cleanup-connection vec t t) - (throw 'uname-changed (tramp-maybe-open-connection vec)))) - ;; Check whether the remote host suffers from buggy ;; `send-process-string'. This is known for FreeBSD (see comment in ;; `send_process', file process.c). I've tested sending 624 bytes -- cgit v1.2.1 From 80346f1ae4b3d56490e4a744df2bf1db00844ddc Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 15 Dec 2015 23:54:11 +0100 Subject: Set utf8 encoding with stty in Tramp * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell): Move up uname check. Handle Mac OS X eol encoding. Set utf8 encoding with stty. --- lisp/net/tramp-sh.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ebf646f26ff..6cd29c1ca6c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4288,6 +4288,10 @@ process to set up. VEC specifies the connection." (tramp-get-connection-property vec "uname" "")) (tramp-send-command vec "stty -oxtabs" t)) + ;; Set utf8 encoding. Needed for Mac OS X, for example. This is + ;; non-POSIX, so we must expect errors on some systems. + (tramp-send-command vec "stty iutf8 2>/dev/null" t) + ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) -- cgit v1.2.1 From dfc850ba4ce229136b2f183574c030120d320d19 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 18 Dec 2015 17:32:52 +0100 Subject: Make tramp a built-in package * lisp/finder.el (finder-compile-keywords): Update `package--builtins' also when Version: keyword is available. * lisp/net/trampver.el: Add Version: keyword. (tramp-version): Change it to "2.2.13.25.1", in order to be compatible with `version-to-list'. --- lisp/net/trampver.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 04046c5ee7d..77ee8aebd61 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -6,6 +6,7 @@ ;; Author: Kai Großjohann ;; Keywords: comm, processes ;; Package: tramp +;; Version: 2.2.13.25.1 ;; This file is part of GNU Emacs. @@ -31,7 +32,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.13-25.1" +(defconst tramp-version "2.2.13.25.1" "This version of Tramp.") ;;;###tramp-autoload -- cgit v1.2.1 From 81e523fc4d3dcb0cf59a69f45786d2691f982695 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 18 Dec 2015 17:45:24 +0100 Subject: Minor fixes in Tramp * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls): Reorder ls arguments. * lisp/net/tramp.el (tramp-dissect-file-name): Fix docstring. --- lisp/net/tramp-sh.el | 2 +- lisp/net/tramp.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6cd29c1ca6c..95fafb848d9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1274,6 +1274,7 @@ target of the symlink differ." (tramp-get-test-command vec) (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) + (if (eq id-format 'integer) "-ildn" "-ild") ;; On systems which have no quoting style, file names ;; with special characters could fail. (cond @@ -1282,7 +1283,6 @@ target of the symlink differ." ((tramp-get-ls-command-with-w-option vec) "-w") (t "")) - (if (eq id-format 'integer) "-ildn" "-ild") (tramp-shell-quote-argument localname))) ;; Parse `ls -l' output ... (with-current-buffer (tramp-get-buffer vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 40c3f368a9f..b7f53095a8e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1291,8 +1291,8 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." (defun tramp-dissect-file-name (name &optional nodefault) "Return a `tramp-file-name' structure. -The structure consists of remote method, remote user, remote host -and localname (file name on remote host). If NODEFAULT is +The structure consists of remote method, remote user, remote host, +localname (file name on remote host) and hop. If NODEFAULT is non-nil, the file name parts are not expanded to their default values." (save-match-data -- cgit v1.2.1 From 6a8a41c5104b29846ed6e69da7576e0960f2bf14 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 19 Dec 2015 20:36:07 +0100 Subject: * tramp-sh.el (tramp-get-ls-command-with-w-option): Improve check. --- lisp/net/tramp-sh.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 95fafb848d9..aebfe422168 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5438,7 +5438,7 @@ Return ATTR." (tramp-message vec 5 "Checking, whether `ls -w' works") ;; Option "-w" is available on BSD systems. (tramp-send-command-and-check - vec (format "%s -alw /dev/null" (tramp-get-ls-command vec)))))) + vec (format "%s -alw" (tramp-get-ls-command vec)))))) (defun tramp-get-test-command (vec) (with-tramp-connection-property vec "test" -- cgit v1.2.1 From 9b0f1824d766139d3469c6837fb0b9db411a15b6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 22 Dec 2015 18:57:51 +0200 Subject: Fix decoding of text in URLs retrieved by EWW * lisp/net/eww.el (eww-render): Pass 'charset' to 'eww-display-raw'. Use the value of 'last-coding-system-used', if non-nil, to set 'buffer-file-coding-system' of the buffer where we show the URL. (eww-display-html, eww-display-raw): Decode the text correctly, using the charset found in the headers, and defaulting to UTF-8. If the user told us to use a specific encoding, override the charset from the headers. (Bug#22222) --- lisp/net/eww.el | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 205be41a000..179010cf4cd 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -326,7 +326,8 @@ Currently this means either text/html or application/xhtml+xml." (or (cdr (assq 'charset (cdr content-type))) (eww-detect-charset (eww-html-p (car content-type))) "utf-8")))) - (data-buffer (current-buffer))) + (data-buffer (current-buffer)) + last-coding-system-used) ;; Save the https peer status. (with-current-buffer buffer (plist-put eww-data :peer (plist-get status :peer))) @@ -344,11 +345,13 @@ Currently this means either text/html or application/xhtml+xml." ((string-match-p "\\`image/" (car content-type)) (eww-display-image buffer)) (t - (eww-display-raw buffer encode))) + (eww-display-raw buffer (or encode charset 'utf-8)))) (with-current-buffer buffer (plist-put eww-data :url url) (eww-update-header-line-format) (setq eww-history-position 0) + (and last-coding-system-used + (set-buffer-file-coding-system last-coding-system-used)) (run-hooks 'eww-after-render-hook))) (kill-buffer data-buffer)))) @@ -394,13 +397,10 @@ Currently this means either text/html or application/xhtml+xml." (list 'base (list (cons 'href url)) (progn - (when (or (and encode - (not (eq charset encode))) - (not (eq charset 'utf-8))) - (condition-case nil - (decode-coding-region (point) (point-max) - (or encode charset)) - (coding-system-error nil))) + (setq encode (or encode charset 'utf-8)) + (condition-case nil + (decode-coding-region (point) (point-max) encode) + (coding-system-error nil)) (libxml-parse-html-region (point) (point-max)))))) (source (and (null document) (buffer-substring (point) (point-max))))) @@ -508,11 +508,9 @@ Currently this means either text/html or application/xhtml+xml." (let ((inhibit-read-only t)) (erase-buffer) (insert data) - (unless (eq encode 'utf-8) - (encode-coding-region (point-min) (1+ (length data)) 'utf-8) - (condition-case nil - (decode-coding-region (point-min) (1+ (length data)) encode) - (coding-system-error nil)))) + (condition-case nil + (decode-coding-region (point-min) (1+ (length data)) encode) + (coding-system-error nil))) (goto-char (point-min))))) (defun eww-display-image (buffer) -- cgit v1.2.1 From cc3de97ad37f634b859c1c1b3d1bce0961733a2a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Dec 2015 14:00:38 +0100 Subject: shr table rendering fix * shr.el (shr-tag-table): Allow rendering body-less tables that have headers. Backport: (cherry picked from commit b05471e42c17e02c56c87d7599ada0c124a5fe09) --- lisp/net/shr.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index a48d098fe26..dbf45b885da 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1582,7 +1582,7 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-stylesheet (nconc (list (cons 'background-color bgcolor)) shr-stylesheet)) (nheader (if header (shr-max-columns header))) - (nbody (if body (shr-max-columns body))) + (nbody (if body (shr-max-columns body) 0)) (nfooter (if footer (shr-max-columns footer)))) (if (and (not caption) (not header) -- cgit v1.2.1 From 6ef896cc78b7caf39541a94fd89197d7a0497f9a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Dec 2015 14:40:16 +0100 Subject: Ignore invalid SVG images * shr.el (shr-tag-svg): Ignore SVG images that have no width or height, because these can't be displayed by ImageMagick, anyway. Backport: (cherry picked from commit 821107d53c2e390240d25c036b99ebbf9b4a93b6) --- lisp/net/shr.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index dbf45b885da..d51b8c73d10 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1152,7 +1152,9 @@ ones, in case fg and bg are nil." (defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) - (not shr-inhibit-images)) + (not shr-inhibit-images) + (dom-attr dom 'width) + (dom-attr dom 'height)) (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml) "SVG Image"))) -- cgit v1.2.1 From 5bd3a0c9e00cde01cf325389458f86fd9f05db3f Mon Sep 17 00:00:00 2001 From: Ashish SHUKLA Date: Thu, 24 Dec 2015 18:54:41 +0100 Subject: Add FreeBSD cert bundle * doc/misc/emacs-gnutls.texi (Help For Users): Document FreeBSD bundle. * lisp/net/gnutls.el (gnutls-trustfiles): Add FreeBSD cert bundle. Backport: (cherry picked from commit 60c0f1a18ad88d6dc1a8f4ee5d9d18940eaeb6f7) --- lisp/net/gnutls.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 479c9a579f3..ccaef8aafac 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -67,10 +67,11 @@ set this variable to \"normal:-dhe-rsa\"." (defcustom gnutls-trustfiles '( - "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux - "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL - "/etc/ssl/ca-bundle.pem" ; Suse - "/usr/ssl/certs/ca-bundle.crt" ; Cygwin + "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux + "/etc/pki/tls/certs/ca-bundle.crt" ; Fedora and RHEL + "/etc/ssl/ca-bundle.pem" ; Suse + "/usr/ssl/certs/ca-bundle.crt" ; Cygwin + "/usr/local/share/certs/ca-root-nss.crt" ; FreeBSD ) "List of CA bundle location filenames or a function returning said list. The files may be in PEM or DER format, as per the GnuTLS documentation. -- cgit v1.2.1 From 90f82ffa5dee8314edd8c73d72ef2f82ee617a11 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Dec 2015 22:21:24 +0100 Subject: Decode hex-encoded URLs before using them as file names * eww.el (eww-decode-url-file-name): New function. (eww-download-callback): Use it to decode file names before saving them. Backport: (cherry picked from commit af22a010d87516c2a646572fb27512c03057784f) --- lisp/net/eww.el | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 179010cf4cd..90ddd05b845 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1400,13 +1400,38 @@ Differences in #targets are ignored." (unless (plist-get status :error) (let* ((obj (url-generic-parse-url url)) (path (car (url-path-and-query obj))) - (file (eww-make-unique-file-name (file-name-nondirectory path) - eww-download-directory))) + (file (eww-make-unique-file-name + (eww-decode-url-file-name (file-name-nondirectory path)) + eww-download-directory))) (goto-char (point-min)) (re-search-forward "\r?\n\r?\n") (write-region (point) (point-max) file) (message "Saved %s" file)))) +(defun eww-decode-url-file-name (string) + (let* ((binary (url-unhex-string string)) + (decoded + (decode-coding-string + binary + ;; Possibly set by `universal-coding-system-argument'. + (or coding-system-for-read + ;; RFC 3986 says that %AB stuff is utf-8. + (if (equal (decode-coding-string binary 'utf-8) + '(unicode)) + 'utf-8 + ;; But perhaps not. + (car (detect-coding-string binary)))))) + (encodes (find-coding-systems-string decoded))) + (if (or (equal encodes '(undecided)) + (memq (or file-name-coding-system + default-file-name-coding-system) + encodes)) + decoded + ;; If we can't encode the decoded file name (due to language + ;; environment settings), then we return the original, hexified + ;; string. + string))) + (defun eww-make-unique-file-name (file directory) (cond ((zerop (length file)) -- cgit v1.2.1 From a7143faf482d9b30c120ff969b1a75f1de7f8017 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 24 Dec 2015 22:47:58 +0100 Subject: Make prettier unique file names in eww (eww-make-unique-file-name): Make unique file names by making files like foo(2).jpg instead of foo(1)(2).jpg. Backport: (cherry picked from commit edfdd0a6cbdfa9e5e4bd0553e2b489401ca39266) --- lisp/net/eww.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 90ddd05b845..a22664bfbb5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1438,13 +1438,14 @@ Differences in #targets are ignored." (setq file "!")) ((string-match "\\`[.]" file) (setq file (concat "!" file)))) - (let ((count 1)) + (let ((count 1) + (stem file) + (suffix "")) + (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) + (setq stem (match-string 1) + suffix (match-string 2))) (while (file-exists-p (expand-file-name file directory)) - (setq file - (if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) - (format "%s(%d)%s" (match-string 1 file) - count (match-string 2 file)) - (format "%s(%d)" file count))) + (setq file (format "%s(%d)%s" stem count suffix)) (setq count (1+ count))) (expand-file-name file directory))) -- cgit v1.2.1 From 96ac31425d898d853a15763288d5e360a0f0430a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 06:01:19 +0100 Subject: Allow several tags in shr * shr.el (shr-table-body): New function to find the real body of a table. (shr-tag-table): Use it to render several tags in a table (bug#22170). Backport: (cherry picked from commit cdaf33029d6620073833876d76056045ecfbc7c4) --- lisp/net/shr.el | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d51b8c73d10..18eadcb0f91 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1572,12 +1572,23 @@ The preference is a float determined from `shr-prefer-media-type'." ;; Then render the table again with these new "hard" widths. (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths))) +(defun shr-table-body (dom) + (let ((tbodies (dom-by-tag dom 'tbody))) + (cond + ((null tbodies) + dom) + ((= (length tbodies) 1) + (car tbodies)) + (t + ;; Table with multiple tbodies. Convert into a single tbody. + `(tbody nil + ,@(reduce 'append (mapcar 'dom-non-text-children tbodies))))))) + (defun shr-tag-table (dom) (shr-ensure-paragraph) (let* ((caption (dom-children (dom-child-by-tag dom 'caption))) (header (dom-non-text-children (dom-child-by-tag dom 'thead))) - (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody) - dom))) + (body (dom-non-text-children (shr-table-body dom))) (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot))) (bgcolor (dom-attr dom 'bgcolor)) (start (point)) -- cgit v1.2.1 From ec2a509cfb9fe31a5929eac9c04d9dacca81ce82 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 06:04:01 +0100 Subject: Use cl-reduce, not reduce. Backport: (cherry picked from commit fe4606f93b91ff3d046aee0cf21ecc277af7a786) --- lisp/net/shr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 18eadcb0f91..8b51fc83f44 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1581,8 +1581,8 @@ The preference is a float determined from `shr-prefer-media-type'." (car tbodies)) (t ;; Table with multiple tbodies. Convert into a single tbody. - `(tbody nil - ,@(reduce 'append (mapcar 'dom-non-text-children tbodies))))))) + `(tbody nil ,@(cl-reduce 'append + (mapcar 'dom-non-text-children tbodies))))))) (defun shr-tag-table (dom) (shr-ensure-paragraph) -- cgit v1.2.1 From 5b2401d38f52ca03c8b43cdfdf5a32ca73f10178 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 06:19:34 +0100 Subject: Stop rendering HTML before specdlr exhaustion Fixes: 22117 * shr.el (shr-descend): Stop rendering before we run out of specpdl room (bug#22117). Backport: (cherry picked from commit 248da292fe46224b0b5a79b632c89cf4de2c2081) --- lisp/net/shr.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 8b51fc83f44..9e86ca9e0f9 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -425,8 +425,8 @@ size, and full-buffer size." (shr-stylesheet shr-stylesheet) (shr-depth (1+ shr-depth)) (start (point))) - ;; shr uses about 12 frames per nested node. - (if (> shr-depth (/ max-specpdl-size 12)) + ;; shr uses many frames per nested node. + (if (> shr-depth (/ max-specpdl-size 15)) (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'") (when style (if (string-match "color\\|display\\|border-collapse" style) -- cgit v1.2.1 From 2d33a9ca0b408806c4b929c001d9b917244f6d22 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 06:47:28 +0100 Subject: Make toggling checkboxes work again * eww.el (eww-update-field): Make toggling checkboxes work again (bug#21881). Backport: (cherry picked from commit 5e56f606952e5e81b4d3a93ea70e791b74b33041) --- lisp/net/eww.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index a22664bfbb5..5bcb6221cbb 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1177,16 +1177,19 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (eww-update-field display)))) (defun eww-update-field (string &optional offset) - (if (not offset) (setq offset 0)) + (unless offset + (setq offset 0)) (let ((properties (text-properties-at (point))) (start (+ (eww-beginning-of-field) offset)) (current-end (1+ (eww-end-of-field))) - (new-end (1+ (+ (eww-beginning-of-field) (length string))))) + (new-end (+ (eww-beginning-of-field) (length string))) + (inhibit-read-only t)) (delete-region start current-end) (forward-char offset) (insert string (make-string (- (- (+ new-end offset) start) (length string)) ? )) - (if (= 0 offset) (set-text-properties start new-end properties)) + (when (= 0 offset) + (set-text-properties start new-end properties)) start)) (defun eww-toggle-checkbox () -- cgit v1.2.1 From 1a99bd69ea6eb6772930275d52c414c48db7f977 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 07:45:27 +0100 Subject: Default web pages to right-to-left * eww.el (eww-mode): Most web pages are left-to-right, so make that the default (bug#19801). * shr.el (shr-tag-html): Respect "dir" attributes (left-to-right, right-to-left). Backport: (cherry picked from commit 9e089ec8a380ec3758fcf1564c5f86dc92c68c2a) --- lisp/net/eww.el | 3 ++- lisp/net/shr.el | 9 +++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5bcb6221cbb..7c73d936568 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -713,7 +713,8 @@ the like." (setq-local desktop-save-buffer #'eww-desktop-misc-data) ;; multi-page isearch support (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer) - (setq truncate-lines t) + (setq truncate-lines t + bidi-paragraph-direction 'left-to-right) (buffer-disable-undo) (setq buffer-read-only t)) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9e86ca9e0f9..c28e0b8899c 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1102,6 +1102,15 @@ ones, in case fg and bg are nil." ;;; Tag-specific rendering rules. +(defun shr-tag-html (dom) + (let ((dir (dom-attr dom 'dir))) + (cond + ((equal dir "ltr") + (setq bidi-paragraph-direction 'left-to-right)) + ((equal dir "rtl") + (setq bidi-paragraph-direction 'right-to-left)))) + (shr-generic dom)) + (defun shr-tag-body (dom) (let* ((start (point)) (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text))) -- cgit v1.2.1 From 6c12691a4becc7cecc208bd95f8e99afe81d9469 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 07:56:08 +0100 Subject: Always save eww history * eww.el (eww-setup-buffer): Always save history, even when called from outside the eww buffer (bug#19638). Backport: (cherry picked from commit 2a0f18d9b6ce0ccce3d9c4a4a3b5743bae71b41e) --- lisp/net/eww.el | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 7c73d936568..5da7c4929c0 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -274,17 +274,13 @@ word(s) will be searched for via `eww-search-prefix'." (setq url (concat url "/")))) (setq url (concat eww-search-prefix (replace-regexp-in-string " " "+" url)))))) - (if (eq major-mode 'eww-mode) - (when (or (plist-get eww-data :url) - (plist-get eww-data :dom)) - (eww-save-history)) - (eww-setup-buffer) - (plist-put eww-data :url url) - (plist-put eww-data :title "") - (eww-update-header-line-format) - (let ((inhibit-read-only t)) - (insert (format "Loading %s..." url)) - (goto-char (point-min)))) + (eww-setup-buffer) + (plist-put eww-data :url url) + (plist-put eww-data :title "") + (eww-update-header-line-format) + (let ((inhibit-read-only t)) + (insert (format "Loading %s..." url)) + (goto-char (point-min))) (url-retrieve url 'eww-render (list url nil (current-buffer)))) @@ -536,6 +532,9 @@ Currently this means either text/html or application/xhtml+xml." (defun eww-setup-buffer () (switch-to-buffer (get-buffer-create "*eww*")) + (when (or (plist-get eww-data :url) + (plist-get eww-data :dom)) + (eww-save-history)) (let ((inhibit-read-only t)) (remove-overlays) (erase-buffer)) -- cgit v1.2.1 From e59b2ee8cdfe75785f3e49acd9a03db784114763 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 08:31:10 +0100 Subject: More eww file name coding fixes * eww.el (eww-decode-url-file-name): Use the base coding system to check for encodability. Backport: (cherry picked from commit a8627008abe4ab339df19b417776da28b3ce0fc7) --- lisp/net/eww.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5da7c4929c0..29b4b876465 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1426,8 +1426,8 @@ Differences in #targets are ignored." (car (detect-coding-string binary)))))) (encodes (find-coding-systems-string decoded))) (if (or (equal encodes '(undecided)) - (memq (or file-name-coding-system - default-file-name-coding-system) + (memq (coding-system-base (or file-name-coding-system + default-file-name-coding-system)) encodes)) decoded ;; If we can't encode the decoded file name (due to language -- cgit v1.2.1 From ba82d68819f2bc2b666f548fb76825f13b093dfa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 25 Dec 2015 18:18:42 +0100 Subject: Follow redirects in eww Merge conflict, but I think I resolved it. Follow meta refresh tags in eww * eww.el (eww-tag-meta): Follow meta refresh tags (bug#22234). Backport: --- lisp/net/eww.el | 37 ++++++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 29b4b876465..033529d0616 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -407,13 +407,15 @@ Currently this means either text/html or application/xhtml+xml." (inhibit-modification-hooks t) (shr-target-id (url-target (url-generic-parse-url url))) (shr-external-rendering-functions - '((title . eww-tag-title) - (form . eww-tag-form) - (input . eww-tag-input) - (textarea . eww-tag-textarea) - (select . eww-tag-select) - (link . eww-tag-link) - (a . eww-tag-a)))) + (append + '((title . eww-tag-title) + (form . eww-tag-form) + (input . eww-tag-input) + (textarea . eww-tag-textarea) + (select . eww-tag-select) + (link . eww-tag-link) + (meta . eww-tag-meta) + (a . eww-tag-a))))) (erase-buffer) (shr-insert-document document) (cond @@ -458,6 +460,27 @@ Currently this means either text/html or application/xhtml+xml." where (plist-put eww-data (cdr where) href)))) +(defvar eww-redirect-level 1) + +(defun eww-tag-meta (dom) + (when (and (cl-equalp (dom-attr dom 'http-equiv) "refresh") + (< eww-redirect-level 5)) + (when-let (refresh (dom-attr dom 'content)) + (when (or (string-match "^\\([0-9]+\\) *;.*url=\"\\([^\"]+\\)\"" refresh) + (string-match "^\\([0-9]+\\) *;.*url=\\([^ ]+\\)" refresh)) + (let ((timeout (match-string 1 refresh)) + (url (match-string 2 refresh)) + (eww-redirect-level (1+ eww-redirect-level))) + (if (equal timeout "0") + (eww (shr-expand-url url)) + (eww-tag-a + (dom-node 'a `((href . ,(shr-expand-url url))) + (format "Auto refresh in %s second%s disabled" + timeout + (if (equal timeout "1") + "" + "s")))))))))) + (defun eww-tag-link (dom) (eww-handle-link dom) (shr-generic dom)) -- cgit v1.2.1 From 490dcf2ae3f05baf201a451e701bc08d227ddc29 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Fri, 25 Dec 2015 23:32:55 +0100 Subject: Don't treat /foo/bar:mumble as ange-ftp address * lisp/net/browse-url.el (browse-url-filename-alist): Match colons only in the first component. (bug#5362) --- lisp/net/browse-url.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 757e368317a..feb0788db92 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -419,11 +419,11 @@ commands reverses the effect of this variable." :group 'browse-url) (defcustom browse-url-filename-alist - `(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/") + `(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/") ;; The above loses the username to avoid the browser prompting for ;; it in anonymous cases. If it's not anonymous the next regexp ;; applies. - ("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/") + ("^/\\([^:@/]+@\\)?\\([^:/]+\\):/*" . "ftp://\\1\\2/") ,@(if (memq system-type '(windows-nt ms-dos)) '(("^\\([a-zA-Z]:\\)[\\/]" . "file:///\\1/") ("^[\\/][\\/]+" . "file://"))) @@ -441,13 +441,13 @@ address to an HTTP URL: (setq browse-url-filename-alist \\='((\"/webmaster@webserver:/home/www/html/\" . \"http://www.acme.co.uk/\") - (\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\") - (\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\") + (\"^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*\" . \"ftp://\\2/\") + (\"^/\\([^:@/]+@\\)?\\([^:/]+\\):/*\" . \"ftp://\\1\\2/\") (\"^/+\" . \"file:/\")))" :type '(repeat (cons :format "%v" (regexp :tag "Regexp") (string :tag "Replacement"))) - :version "23.1" + :version "25.1" :group 'browse-url) (defcustom browse-url-save-file nil -- cgit v1.2.1 From 0191077d6a96d9ef8e43989fd5dc8a95e61806d5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 26 Dec 2015 20:47:42 +0200 Subject: Fix documentation of browse-url browser-related functions * lisp/net/browse-url.el (browse-url) (browse-url-default-browser, browse-url-default-windows-browser) (browse-url-default-macosx-browser, browse-url-chromium) (browse-url-kde, browse-url-text-xterm): Clarify the usage of ARGS and NEW-WINDOW arguments in these functions. (Bug#19421) --- lisp/net/browse-url.el | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index feb0788db92..d232c8add13 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -762,12 +762,17 @@ narrowed." (defun browse-url (url &rest args) "Ask a WWW browser to load URL. Prompt for a URL, defaulting to the URL at or before point. -The variable `browse-url-browser-function' says which browser to use. -If the URL is a mailto: URL, consult `browse-url-mailto-function' +Invokes a suitable browser function which does the actual job. +The variable `browse-url-browser-function' says which browser function to +use. If the URL is a mailto: URL, consult `browse-url-mailto-function' first, if that exists. -Passes any ARGS to the browser function. -The default is to pass `browse-url-new-window-flag'." +The additional ARGS are passed to the browser function. See the doc +strings of the actual functions, starting with `browse-url-browser-function', +for information about the significance of ARGS (most of the functions +ignore it). +If ARGS are omitted, the default is to pass `browse-url-new-window-flag' +as ARGS." (interactive (browse-url-interactive-arg "URL: ")) (unless (called-interactively-p 'interactive) (setq args (or args (list browse-url-new-window-flag)))) @@ -836,6 +841,8 @@ says which browser to use." (declare-function w32-shell-execute "w32fns.c") ;; Defined in C. (defun browse-url-default-windows-browser (url &optional _new-window) + "Invoke the MS-Windows system's default Web browser. +The optional NEW-WINDOW argument is not used." (interactive (browse-url-interactive-arg "URL: ")) (cond ((eq system-type 'ms-dos) (if dos-windows-version @@ -846,6 +853,8 @@ says which browser to use." (t (w32-shell-execute "open" url)))) (defun browse-url-default-macosx-browser (url &optional _new-window) + "Invoke the MacOS X system's default Web browser. +The optional NEW-WINDOW argument is not used" (interactive (browse-url-interactive-arg "URL: ")) (start-process (concat "open " url) nil "open" url)) @@ -880,8 +889,8 @@ non-nil, load the document in a new window, if possible, otherwise use a random 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'." +When called non-interactively, optional second argument ARGS is used +instead of `browse-url-new-window-flag'." (apply (cond ((memq system-type '(windows-nt ms-dos cygwin)) @@ -1103,7 +1112,8 @@ instead of `browse-url-new-window-flag'." "Ask the Chromium WWW browser to load URL. Default to the URL around or before point. The strings in variable `browse-url-chromium-arguments' are also passed to -Chromium." +Chromium. +The optional argument NEW-WINDOW is not used." (interactive (browse-url-interactive-arg "URL: ")) (setq url (browse-url-encode-url url)) (let* ((process-environment (browse-url-process-environment))) @@ -1412,7 +1422,8 @@ The `browse-url-gnudoit-program' program is used with options given by 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'." +with possible additional arguments `browse-url-xterm-args'. +The optional argument NEW-WINDOW is not used." (interactive (browse-url-interactive-arg "Text browser URL: ")) (apply #'start-process `(,(concat browse-url-text-browser url) nil ,browse-url-xterm-program @@ -1560,7 +1571,8 @@ don't offer a form of remote control." ;;;###autoload (defun browse-url-kde (url &optional _new-window) "Ask the KDE WWW browser to load URL. -Default to the URL around or before point." +Default to the URL around or before point. +The optional argument NEW-WINDOW is not used." (interactive (browse-url-interactive-arg "KDE URL: ")) (message "Sending URL to KDE...") (apply #'start-process (concat "KDE " url) nil browse-url-kde-program -- cgit v1.2.1 From a2158f6c9af62f11533b2086596b755781d2e34f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 26 Dec 2015 21:45:51 +0100 Subject: Use built-in encryption in imap.el * lisp/net/imap.el (imap-ssl-program): Remove (bug#21134). (imap-starttls-open): Use open-network-stream instead of starttls.el. (imap-tls-open): Use open-network-stream instead of tls.el. --- lisp/net/imap.el | 63 ++++++++++++++++---------------------------------------- 1 file changed, 18 insertions(+), 45 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 33eb3e43836..b25f30b5306 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -74,8 +74,7 @@ ;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1). The implemented ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, -;; LOGINDISABLED) (with use of external library starttls.el and -;; program starttls), and the GSSAPI / Kerberos V4 sections of RFC1731 +;; LOGINDISABLED), and the GSSAPI / Kerberos V4 sections of RFC1731 ;; (with use of external program `imtest'), and RFC2971 (ID). It also ;; takes advantage of the UNSELECT extension in Cyrus IMAPD. ;; @@ -140,8 +139,6 @@ (eval-and-compile ;; For Emacs <22.2 and XEmacs. (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))) - (autoload 'starttls-open-stream "starttls") - (autoload 'starttls-negotiate "starttls") (autoload 'sasl-find-mechanism "sasl") (autoload 'digest-md5-parse-digest-challenge "digest-md5") (autoload 'digest-md5-digest-response "digest-md5") @@ -151,8 +148,7 @@ (autoload 'utf7-encode "utf7") (autoload 'utf7-decode "utf7") (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec") - (autoload 'open-tls-stream "tls")) + (autoload 'format-spec-make "format-spec")) ;; User variables. @@ -184,19 +180,6 @@ the list is tried until a successful connection is made." :group 'imap :type '(repeat string)) -(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p" - "openssl s_client -quiet -ssl2 -connect %s:%p" - "s_client -quiet -ssl3 -connect %s:%p" - "s_client -quiet -ssl2 -connect %s:%p") - "A string, or list of strings, containing commands for SSL connections. -Within a string, %s is replaced with the server address and %p with -port number on server. The program should accept IMAP commands on -stdin and return responses to stdout. Each entry in the list is tried -until a successful connection is made." - :group 'imap - :type '(choice string - (repeat string))) - (defcustom imap-shell-program '("ssh %s imapd" "rsh %s imapd" "ssh %g ssh %s imapd" @@ -718,7 +701,8 @@ sure of changing the value of `foo'." (let* ((port (or port imap-default-tls-port)) (coding-system-for-read imap-coding-system-for-read) (coding-system-for-write imap-coding-system-for-write) - (process (open-tls-stream name buffer server port))) + (process (open-network-stream name buffer server port + :type 'tls))) (when process (while (and (memq (process-status process) '(open run)) ;; FIXME: Per the "blue moon" comment, the process/buffer @@ -803,34 +787,23 @@ sure of changing the value of `foo'." (imap-capability 'STARTTLS buffer)) (defun imap-starttls-open (name buffer server port) + (message "imap: Connecting with STARTTLS...") (let* ((port (or port imap-default-port)) (coding-system-for-read imap-coding-system-for-read) (coding-system-for-write imap-coding-system-for-write) - (process (starttls-open-stream name buffer server port)) - done tls-info) - (message "imap: Connecting with STARTTLS...") - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (imap-send-command "STARTTLS") - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t))) - (accept-process-output process 1) - (sit-for 1)) - (imap-log buffer) - (when (and (setq tls-info (starttls-negotiate process)) - (memq (process-status process) '(open run))) - (setq done process))) - (if (stringp tls-info) - (message "imap: STARTTLS info: %s" tls-info)) + (process (open-network-stream + name buffer server port + :type 'starttls + :capability-command "1 CAPABILITY\r\n" + :always-query-capabilities t + :end-of-command "\r\n" + :success " OK " + :starttls-function + (lambda (capabilities) + (when (string-match-p "STARTTLS" capabilities) + "1 STARTTLS\r\n")))) + (done (and process + (memq (process-status process) '(open run))))) (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed")) done)) -- cgit v1.2.1 From b329958df604e84147e85e9b214fa52742c47183 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 26 Dec 2015 21:47:20 +0100 Subject: * imap.el (imap-ssl-open): Remove --- lisp/net/imap.el | 54 +----------------------------------------------------- 1 file changed, 1 insertion(+), 53 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/imap.el b/lisp/net/imap.el index b25f30b5306..cc89f475bba 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -276,7 +276,7 @@ Shorter values mean quicker response, but is more CPU intensive." '((gssapi imap-gssapi-stream-p imap-gssapi-open) (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open) (tls imap-tls-p imap-tls-open) - (ssl imap-ssl-p imap-ssl-open) + (ssl imap-tls-p imap-tls-open) (network imap-network-p imap-network-open) (shell imap-shell-p imap-shell-open) (starttls imap-starttls-p imap-starttls-open)) @@ -644,56 +644,6 @@ sure of changing the value of `foo'." nil))))) done)) -(defun imap-ssl-p (_buffer) - nil) - -(defun imap-ssl-open (name buffer server port) - "Open an SSL connection to SERVER." - (let ((cmds (if (listp imap-ssl-program) imap-ssl-program - (list imap-ssl-program))) - cmd done) - (while (and (not done) (setq cmd (pop cmds))) - (message "imap: Opening SSL connection with `%s'..." cmd) - (erase-buffer) - (let* ((port (or port imap-default-ssl-port)) - (coding-system-for-read imap-coding-system-for-read) - (coding-system-for-write imap-coding-system-for-write) - (process-connection-type imap-process-connection-type) - (set-process-query-on-exit-flag - (if (fboundp 'set-process-query-on-exit-flag) - 'set-process-query-on-exit-flag - 'process-kill-without-query)) - process) - (when (progn - (setq process (start-process - name buffer shell-file-name - shell-command-switch - (format-spec cmd - (format-spec-make - ?s server - ?p (number-to-string port))))) - (funcall set-process-query-on-exit-flag process nil) - process) - (with-current-buffer buffer - (goto-char (point-min)) - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-max)) - (forward-line -1) - (not (imap-parse-greeting))) - (accept-process-output process 1) - (sit-for 1)) - (imap-log buffer) - (erase-buffer) - (when (memq (process-status process) '(open run)) - (setq done process)))))) - (if done - (progn - (message "imap: Opening SSL connection with `%s'...done" cmd) - done) - (message "imap: Opening SSL connection with `%s'...failed" cmd) - nil))) - (defun imap-tls-p (_buffer) nil) @@ -2939,8 +2889,6 @@ Return nil if no complete line has arrived." imap-error-text imap-kerberos4s-p imap-kerberos4-open - imap-ssl-p - imap-ssl-open imap-network-p imap-network-open imap-interactive-login -- cgit v1.2.1 From 03dbfb948c13dd7c9f24fae63e6ef482393c1e8e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 27 Dec 2015 20:35:05 +0100 Subject: (eww-setup-buffer): Restore left-to-right defaults * eww.el (eww-setup-buffer): Restore left-to-right defaults. Backport: (cherry picked from commit 96c874b96b617c124d500a94de761a61f2a08685) --- lisp/net/eww.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 033529d0616..5755a942ebe 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -561,6 +561,7 @@ Currently this means either text/html or application/xhtml+xml." (let ((inhibit-read-only t)) (remove-overlays) (erase-buffer)) + (setq bidi-paragraph-direction 'left-to-right) (unless (eq major-mode 'eww-mode) (eww-mode))) -- cgit v1.2.1 From b406665df12664a3e7048f93f192a488a14058f2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 28 Dec 2015 18:11:56 +0100 Subject: Always reset the bidi direction * eww.el (eww-display-html): Always reset the bidi direction to `left-to-right' (bug#22257). --- lisp/net/eww.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 5755a942ebe..d4555772e9a 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -401,6 +401,7 @@ Currently this means either text/html or application/xhtml+xml." (source (and (null document) (buffer-substring (point) (point-max))))) (with-current-buffer buffer + (setq bidi-paragraph-direction 'left-to-right) (plist-put eww-data :source source) (plist-put eww-data :dom document) (let ((inhibit-read-only t) -- cgit v1.2.1 From 82b9bfc40949987f4a4d8d2f87aa6af4ec234253 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 28 Dec 2015 21:02:43 +0100 Subject: * eww.el (eww-mode): Remove superfluous bidi reset. --- lisp/net/eww.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d4555772e9a..e8fdc972fb3 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -737,8 +737,7 @@ the like." (setq-local desktop-save-buffer #'eww-desktop-misc-data) ;; multi-page isearch support (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer) - (setq truncate-lines t - bidi-paragraph-direction 'left-to-right) + (setq truncate-lines t) (buffer-disable-undo) (setq buffer-read-only t)) -- cgit v1.2.1 From 9982c01d1a190390254b8c5bd866aea62848664f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 28 Dec 2015 21:55:18 +0100 Subject: shr link traversal fixup * shr.el (shr-next-link): Don't bug out on adjacent links. Backport: (cherry picked from commit 1efc5f8b09273c359683ce13be95fb5df7a84311) --- lisp/net/shr.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index c28e0b8899c..d5c56362f60 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -303,13 +303,25 @@ redirects somewhere else." (defun shr-next-link () "Skip to the next link." (interactive) - (let ((skip (text-property-any (point) (point-max) 'help-echo nil))) - (if (or (eobp) - (not (setq skip (text-property-not-all skip (point-max) - 'help-echo nil)))) - (message "No next link") + (let ((current (get-text-property (point) 'shr-url)) + (start (point)) + skip) + (while (and (not (eobp)) + (equal (get-text-property (point) 'shr-url) current)) + (forward-char 1)) + (cond + ((and (not (eobp)) + (get-text-property (point) 'shr-url)) + ;; The next link is adjacent. + (message "%s" (get-text-property (point) 'help-echo))) + ((or (eobp) + (not (setq skip (text-property-not-all (point) (point-max) + 'shr-url nil)))) + (goto-char start) + (message "No next link")) + (t (goto-char skip) - (message "%s" (get-text-property (point) 'help-echo))))) + (message "%s" (get-text-property (point) 'help-echo)))))) (defun shr-previous-link () "Skip to the previous link." -- cgit v1.2.1 From ad9aaa460e2fa446b08124bd8df846e1471c030b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 29 Dec 2015 14:30:53 +0100 Subject: Remove --insecure from gnutls-cli invocation * tls.el (tls-program): Default to using secure TLS connections (bug#19284). --- lisp/net/tls.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 48e6a42186c..6745e5d8282 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -74,8 +74,8 @@ and `gnutls-cli' (version 2.0.1) output." :type 'regexp :group 'tls) -(defcustom tls-program '("gnutls-cli --insecure -p %p %h" - "gnutls-cli --insecure -p %p %h --protocols ssl3" +(defcustom tls-program '("gnutls-cli -p %p %h" + "gnutls-cli -p %p %h --protocols ssl3" "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") "List of strings containing commands to start TLS stream to a host. Each entry in the list is tried until a connection is successful. @@ -89,13 +89,13 @@ successful negotiation." :type '(choice (const :tag "Default list of commands" - ("gnutls-cli --insecure -p %p %h" - "gnutls-cli --insecure -p %p %h --protocols ssl3" + ("gnutls-cli -p %p %h" + "gnutls-cli -p %p %h --protocols ssl3" "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (list :tag "Choose commands" :value - ("gnutls-cli --insecure -p %p %h" - "gnutls-cli --insecure -p %p %h --protocols ssl3" + ("gnutls-cli -p %p %h" + "gnutls-cli -p %p %h --protocols ssl3" "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") (set :inline t ;; FIXME: add brief `:tag "..."' descriptions. @@ -105,8 +105,8 @@ successful negotiation." (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof") ;; No trust check: - (const "gnutls-cli --insecure -p %p %h") - (const "gnutls-cli --insecure -p %p %h --protocols ssl3") + (const "gnutls-cli -p %p %h") + (const "gnutls-cli -p %p %h --protocols ssl3") (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (repeat :inline t :tag "Other" (string))) (list :tag "List of commands" -- cgit v1.2.1 From 1ba1e35fbed820ec9d9e1dafbe150f88f29342d8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 29 Dec 2015 14:39:53 +0100 Subject: Refactor out gnutls-trustfiles * lisp/net/gnutls.el (gnutls-trustfiles): Refactor out for reuse by tls.el. --- lisp/net/gnutls.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index ccaef8aafac..a7321da854c 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -193,12 +193,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." ;; The gnutls library doesn't understand files delivered via ;; the special handlers, so ignore all files found via those. (file-name-handler-alist nil) - (trustfiles (or trustfiles - (delq nil - (mapcar (lambda (f) (and f (file-exists-p f) f)) - (if (functionp gnutls-trustfiles) - (funcall gnutls-trustfiles) - gnutls-trustfiles))))) + (trustfiles (or trustfiles (gnutls-trustfiles))) (priority-string (or priority-string (cond ((eq type 'gnutls-anon) @@ -251,6 +246,14 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." process)) +(defun gnutls-trustfiles () + "Return a list of usable trustfiles." + (delq nil + (mapcar (lambda (f) (and f (file-exists-p f) f)) + (if (functionp gnutls-trustfiles) + (funcall gnutls-trustfiles) + gnutls-trustfiles)))) + (declare-function gnutls-error-string "gnutls.c" (error)) (defun gnutls-message-maybe (doit format &rest params) -- cgit v1.2.1 From de5c44fe8811b07eaad6ab5fc53d498e465a43d4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 29 Dec 2015 14:46:20 +0100 Subject: Make tls.el use trustfiles by default * lisp/net/tls.el (tls-program): Add a certfile by default (bug#21227). (open-tls-stream): Insert the trustfile by looking at `gnutls-trustfiles'. --- lisp/net/tls.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 6745e5d8282..72fb50ed923 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -44,6 +44,8 @@ ;;; Code: +(require 'gnutls) + (autoload 'format-spec "format-spec") (autoload 'format-spec-make "format-spec") @@ -74,9 +76,10 @@ and `gnutls-cli' (version 2.0.1) output." :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 -ign_eof") +(defcustom tls-program + '("gnutls-cli --x509cafile %t -p %p %h" + "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") "List of strings containing commands to start TLS stream to a host. Each entry in the list is tried until a connection is successful. %h is replaced with server hostname, %p with port to connect to. @@ -89,24 +92,20 @@ successful negotiation." :type '(choice (const :tag "Default list of commands" - ("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3" - "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) + ("gnutls-cli --x509cafile %t -p %p %h" + "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3" + "openssl s_client -CAfile %t -connect %h:%p -no_ssl2 -ign_eof")) (list :tag "Choose commands" :value - ("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3" + ("gnutls-cli --x509cafile %t -p %p %h" + "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3" "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") (set :inline t ;; FIXME: add brief `:tag "..."' descriptions. ;; (repeat :inline t :tag "Other" (string)) - ;; See `tls-checktrust': - (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h") - (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") - (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof") ;; No trust check: - (const "gnutls-cli -p %p %h") - (const "gnutls-cli -p %p %h --protocols ssl3") + (const "gnutls-cli --insecure -p %p %h") + (const "gnutls-cli --insecure -p %p %h --protocols ssl3") (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (repeat :inline t :tag "Other" (string))) (list :tag "List of commands" @@ -232,6 +231,7 @@ Fourth arg PORT is an integer specifying a port to connect to." (format-spec cmd (format-spec-make + ?t (car (gnutls-trustfiles)) ?h host ?p (if (integerp port) (int-to-string port) -- cgit v1.2.1 From 8ca864ba8df6c2214dcaa9c8d1c9aa069a62db06 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 29 Dec 2015 15:35:44 +0100 Subject: Sync with Tramp 2.2.13 * doc/misc/trampver.texi: Change version to "2.2.13.25.1". * lisp/net/tramp-compat.el (tramp-compat-delete-dups): Use `tramp-compat-funcall'. * lisp/net/tramp-gvfs.el (tramp-gvfs-parse-device-names): Make `split-string' call compatible with older Emacsen. * lisp/net/trampver.el: Change version to "2.2.13.25.1". --- lisp/net/tramp-compat.el | 3 ++- lisp/net/tramp-gvfs.el | 13 +++++++++---- lisp/net/tramp-sh.el | 7 +++---- lisp/net/trampver.el | 2 +- 4 files changed, 15 insertions(+), 10 deletions(-) (limited to 'lisp/net') diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index c57102881bf..b6d6796255b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -600,7 +600,8 @@ and replace a sub-expression, e.g. Store the result in LIST and return it. LIST must be a proper list. Of several `equal' occurrences of an element in LIST, the first one is kept." - (cl-delete-duplicates list '(:test equal :from-end) nil))) + (tramp-compat-funcall + 'cl-delete-duplicates list '(:test equal :from-end) nil))) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index c5a60751d5b..549d3b15abe 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1740,20 +1740,25 @@ be used." (list user host))) (zeroconf-list-services service))) +;; We use the TRIM argument of `split-string', which exist since Emacs +;; 24.4. I mask this for older Emacs versions, there is no harm. (defun tramp-gvfs-parse-device-names (service) "Return a list of (user host) tuples allowed to access. This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (let ((result - (split-string - (shell-command-to-string (format "avahi-browse -trkp %s" service)) - "[\n\r]+" 'omit "^\\+;.*$"))) + (ignore-errors + (tramp-compat-funcall + 'split-string + (shell-command-to-string (format "avahi-browse -trkp %s" service)) + "[\n\r]+" 'omit "^\\+;.*$")))) (tramp-compat-delete-dups (mapcar (lambda (x) (let* ((list (split-string x ";")) (host (nth 6 list)) (port (nth 8 list)) - (text (split-string (nth 9 list) "\" \"" 'omit "\"")) + (text (tramp-compat-funcall + 'split-string (nth 9 list) "\" \"" 'omit "\"")) user) ; (when (and port (not (string-equal port "0"))) ; (setq host (format "%s%s%s" host tramp-prefix-port-regexp port))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index aebfe422168..0dd2440e5e0 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5425,9 +5425,6 @@ Return ATTR." (save-match-data (with-tramp-connection-property vec "ls-quoting-style" (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works") - ;; Some "ls" versions are sensible wrt the order of arguments, - ;; they fail when "-al" is after the "--dired" argument (for - ;; example on FreeBSD). (tramp-send-command-and-check vec (format "%s --quoting-style=shell -al /dev/null" (tramp-get-ls-command vec)))))) @@ -5436,7 +5433,9 @@ Return ATTR." (save-match-data (with-tramp-connection-property vec "ls-w-option" (tramp-message vec 5 "Checking, whether `ls -w' works") - ;; Option "-w" is available on BSD systems. + ;; Option "-w" is available on BSD systems. No argument is + ;; given, because this could return wrong results in case "ls" + ;; supports the "-w NUM" argument, as for busyboxes. (tramp-send-command-and-check vec (format "%s -alw" (tramp-get-ls-command vec)))))) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 77ee8aebd61..f93cfc4e8ae 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -63,7 +63,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.13-pre is not fit for %s" + (format "Tramp 2.2.13.25.1 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) -- cgit v1.2.1 From 88e2de2381a61445c20f8d35857ad57d581eafe1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 29 Dec 2015 18:49:57 +0200 Subject: Fix filling text with bidirectional characters in shr.el * lisp/net/shr.el (shr-insert-document): Bind bidi-display-reordering to nil while filling lines. This is required for when a line includes characters whose bidi directionality is opposite to the base paragraph direction, because columns are counted in the logical order. (Bug#22250) --- lisp/net/shr.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/net') diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d5c56362f60..330f7b5d84b 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -244,7 +244,8 @@ DOM should be a parse tree as generated by (if (and (null shr-width) (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) - 0)))))) + 0))))) + bidi-display-reordering) (shr-descend dom) (shr-fill-lines start (point)) (shr-remove-trailing-whitespace start (point)) -- cgit v1.2.1