diff options
Diffstat (limited to 'lisp/net')
| -rw-r--r-- | lisp/net/eww.el | 46 | ||||
| -rw-r--r-- | lisp/net/network-stream.el | 64 | ||||
| -rw-r--r-- | lisp/net/shr.el | 97 | ||||
| -rw-r--r-- | lisp/net/tramp-adb.el | 2 |
4 files changed, 149 insertions, 60 deletions
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2f6528de948..f4e3aa36c55 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -263,13 +263,17 @@ This list can be customized via `eww-suggest-uris'." (nreverse uris))) ;;;###autoload -(defun eww (url &optional arg) +(defun eww (url &optional arg buffer) "Fetch URL and render the page. If the input doesn't look like an URL or a domain name, the word(s) will be searched for via `eww-search-prefix'. If called with a prefix ARG, use a new buffer instead of reusing -the default EWW buffer." +the default EWW buffer. + +If BUFFER, the data to be rendered is in that buffer. In that +case, this function doesn't actually fetch URL. BUFFER will be +killed after rendering." (interactive (let* ((uris (eww-suggested-uris)) (prompt (concat "Enter URL or keywords" @@ -307,8 +311,12 @@ the default EWW buffer." (insert (format "Loading %s..." url)) (goto-char (point-min))) (let ((url-mime-accept-string eww-accept-content-types)) - (url-retrieve url #'eww-render - (list url nil (current-buffer))))) + (if buffer + (let ((eww-buffer (current-buffer))) + (with-current-buffer buffer + (eww-render nil url nil eww-buffer))) + (url-retrieve url #'eww-render + (list url nil (current-buffer)))))) (function-put 'eww 'browse-url-browser-kind 'internal) @@ -361,7 +369,19 @@ the default EWW buffer." (eww (concat "file://" (and (memq system-type '(windows-nt ms-dos)) "/") - (expand-file-name file)))) + (expand-file-name file)) + nil + ;; The file name may be a non-local Tramp file. The URL + ;; library doesn't understand these file names, so use the + ;; normal Emacs machinery to load the file. + (with-current-buffer (generate-new-buffer " *eww file*") + (set-buffer-multibyte nil) + (insert "Content-type: " (or (mailcap-extension-to-mime + (url-file-extension file)) + "application/octet-stream") + "\n\n") + (insert-file-contents file) + (current-buffer)))) ;;;###autoload (defun eww-search-words () @@ -1260,7 +1280,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-tag-textarea (dom) (let ((start (point)) - (value (or (dom-attr dom 'value) "")) + (value (or (dom-text dom) "")) (lines (string-to-number (or (dom-attr dom 'rows) "10"))) (width (string-to-number (or (dom-attr dom 'cols) "10"))) end) @@ -1744,25 +1764,27 @@ If CHARSET is nil then use UTF-8." (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n") (pp eww-bookmarks (current-buffer)))) -(defun eww-read-bookmarks () +(defun eww-read-bookmarks (&optional error-out) + "Read bookmarks from `eww-bookmarks'. +If ERROR-OUT, signal user-error if there are no bookmarks." (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory))) (setq eww-bookmarks (unless (zerop (or (file-attribute-size (file-attributes file)) 0)) (with-temp-buffer (insert-file-contents file) - (read (current-buffer))))))) + (read (current-buffer))))) + (when (and error-out (not eww-bookmarks)) + (user-error "No bookmarks are defined")))) ;;;###autoload (defun eww-list-bookmarks () "Display the bookmarks." (interactive) + (eww-read-bookmarks t) (pop-to-buffer "*eww bookmarks*") (eww-bookmark-prepare)) (defun eww-bookmark-prepare () - (eww-read-bookmarks) - (unless eww-bookmarks - (user-error "No bookmarks are defined")) (set-buffer (get-buffer-create "*eww bookmarks*")) (eww-bookmark-mode) (let* ((width (/ (window-width) 2)) @@ -1830,6 +1852,7 @@ If CHARSET is nil then use UTF-8." bookmark) (unless (get-buffer "*eww bookmarks*") (setq first t) + (eww-read-bookmarks t) (eww-bookmark-prepare)) (with-current-buffer (get-buffer "*eww bookmarks*") (when (and (not first) @@ -1848,6 +1871,7 @@ If CHARSET is nil then use UTF-8." bookmark) (unless (get-buffer "*eww bookmarks*") (setq first t) + (eww-read-bookmarks t) (eww-bookmark-prepare)) (with-current-buffer (get-buffer "*eww bookmarks*") (if first diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1c371f59870..e86426d4664 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -139,7 +139,10 @@ writes. See `make-network-process' for details. :capability-command specifies a command used to query the HOST for its capabilities. For instance, for IMAP this should be - \"1 CAPABILITY\\r\\n\". + \"1 CAPABILITY\\r\\n\". This can either be a string (which will + then be sent verbatim to the server), or a function (called with + a single parameter; the \"greeting\" from the server when connecting), + and should return a string to send to the server. :starttls-function specifies a function for handling STARTTLS. This function should take one parameter, the response to the @@ -280,8 +283,11 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." :coding (plist-get parameters :coding))) (greeting (and (not (plist-get parameters :nogreeting)) (network-stream-get-response stream start eoc))) - (capabilities (network-stream-command stream capability-command - eo-capa)) + (capabilities + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa)) (resulting-type 'plain) starttls-available starttls-command error) @@ -329,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; Requery capabilities for protocols that require it; i.e., ;; EHLO for SMTP. (when (plist-get parameters :always-query-capabilities) - (network-stream-command stream capability-command eo-capa))) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa))) (when (let ((response (network-stream-command stream starttls-command eoc))) (and response (string-match success-string response))) @@ -365,7 +374,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." host service)) ;; Re-get the capabilities, which may have now changed. (setq capabilities - (network-stream-command stream capability-command eo-capa)))) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + eo-capa)))) ;; If TLS is mandatory, close the connection if it's unencrypted. (when (and require-tls @@ -428,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." parameters) (require 'tls) (open-tls-stream name buffer host service))) - (eoc (plist-get parameters :end-of-command))) + (eoc (plist-get parameters :end-of-command)) + greeting) (if (plist-get parameters :nowait) (list stream nil nil 'tls) ;; Check certificate validity etc. @@ -440,17 +453,22 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." ;; openssl/gnutls-cli. (when (and (not (gnutls-available-p)) eoc) - (network-stream-get-response stream start eoc) + (setq greeting (network-stream-get-response stream start eoc)) (goto-char (point-min)) (when (re-search-forward eoc nil t) (goto-char (match-beginning 0)) (delete-region (point-min) (line-beginning-position)))) - (let ((capability-command (plist-get parameters :capability-command)) + (let ((capability-command + (plist-get parameters :capability-command)) (eo-capa (or (plist-get parameters :end-of-capability) eoc))) (list stream (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command eo-capa) + (network-stream-command + stream + (network-stream--capability-command + capability-command greeting) + eo-capa) 'tls))))))) (defun network-stream-open-shell (name buffer host service parameters) @@ -464,21 +482,29 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (format-spec (plist-get parameters :shell-command) `((?s . ,host) - (?p . ,service))))))) + (?p . ,service)))))) + greeting) (when coding (if (consp coding) - (set-process-coding-system stream - (car coding) - (cdr coding)) (set-process-coding-system stream - coding - coding))) + (car coding) + (cdr coding)) + (set-process-coding-system stream + coding + coding))) (list stream - (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command - (or (plist-get parameters :end-of-capability) - eoc)) + (setq greeting (network-stream-get-response stream start eoc)) + (network-stream-command + stream + (network-stream--capability-command capability-command greeting) + (or (plist-get parameters :end-of-capability) + eoc)) 'plain))) +(defun network-stream--capability-command (command greeting) + (if (functionp command) + (funcall command greeting) + command)) + (provide 'network-stream) ;;; network-stream.el ends here diff --git a/lisp/net/shr.el b/lisp/net/shr.el index a3f04968a27..ddd81127213 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -95,15 +95,31 @@ If nil, don't draw horizontal table lines." :type 'character) (defcustom shr-width nil - "Frame width to use for rendering. + "Window width to use for HTML rendering. May either be an integer specifying a fixed width in characters, -or nil, meaning that the full width of the window should be used. -If `shr-use-fonts' is set, the mean character width is used to -compute the pixel width, which is used instead." +or nil, meaning use the full width of the window. +If `shr-use-fonts' is set, the value is interpreted as a multiple +of the mean character width of the default face's font. + +Also see `shr-max-width'." :version "25.1" :type '(choice (integer :tag "Fixed width in characters") (const :tag "Use the width of the window" nil))) +(defcustom shr-max-width 120 + "Maximum text width to use for HTML rendering. +May either be an integer specifying a fixed width in characters, +or nil, meaning that there is no width limit. + +If `shr-use-fonts' is set, the value of this variable is +interpreted as a multiple of the mean character width of the +default face's font. + +If `shr-width' is non-nil, it overrides this variable." + :version "28.1" + :type '(choice (integer :tag "Fixed width in characters") + (const :tag "No width limit" nil))) + (defcustom shr-bullet "* " "Bullet used for unordered lists. Alternative suggestions are: @@ -267,30 +283,37 @@ DOM should be a parse tree as generated by (shr-table-separator-pixel-width (shr-string-pixel-width "-")) (shr-internal-bullet (cons shr-bullet (shr-string-pixel-width shr-bullet))) - (shr-internal-width (or (and shr-width - (if (not shr-use-fonts) - shr-width - (* shr-width (frame-char-width)))) - ;; We need to adjust the available - ;; width for when the user disables - ;; the fringes, which will cause the - ;; display engine usurp one column for - ;; the continuation glyph. - (if (not shr-use-fonts) - (- (window-body-width) 1 - (if (and (null shr-width) - (not (shr--have-one-fringe-p))) - 0 - 1)) - (- (window-body-width nil t) - (* 2 (frame-char-width)) - (if (and (null shr-width) - (not (shr--have-one-fringe-p))) - (* (frame-char-width) 2) - 0) - 1)))) + (shr-internal-width + (if shr-width + ;; Specified width; use it. + (if (not shr-use-fonts) + shr-width + (* shr-width (frame-char-width))) + ;; Compute the width based on the window width. We need to + ;; adjust the available width for when the user disables + ;; the fringes, which will cause the display engine usurp + ;; one column for the continuation glyph. + (if (not shr-use-fonts) + (- (window-body-width) 1 + (if (shr--have-one-fringe-p) + 1 + 0)) + (- (window-body-width nil t) + (* 2 (frame-char-width)) + (if (shr--have-one-fringe-p) + 0 + (* (frame-char-width) 2)) + 1)))) (max-specpdl-size max-specpdl-size) bidi-display-reordering) + ;; Adjust for max width specification. + (when (and shr-max-width + (not shr-width)) + (setq shr-internal-width + (min shr-internal-width + (if shr-use-fonts + (* shr-max-width (frame-char-width)) + shr-max-width)))) ;; If the window was hscrolled for some reason, shr-fill-lines ;; below will misbehave, because it silently assumes that it ;; starts with a non-hscrolled window (vertical-motion will move @@ -2576,12 +2599,28 @@ flags that control whether to collect or render objects." i)) (defun shr-max-columns (dom) - (let ((max 0)) + (let ((max 0) + (this 0) + (rowspans nil)) (dolist (row (dom-children dom)) (when (and (not (stringp row)) (eq (dom-tag row) 'tr)) - (setq max (max max (+ (shr-count row 'td) - (shr-count row 'th)))))) + (setq this 0) + (dolist (column (dom-children row)) + (when (and (not (stringp column)) + (memq (dom-tag column) '(td th))) + (setq this (+ 1 this (length rowspans))) + ;; We have a rowspan, which we emulate later in rendering + ;; by adding an extra column to the following rows. + (when-let* ((span (dom-attr column 'rowspan))) + (push (string-to-number span) rowspans)))) + (setq max (max max this))) + ;; Count down the rowspans in effect. + (let ((new nil)) + (dolist (span rowspans) + (when (> span 1) + (push (1- span) new))) + (setq rowspans new))) max)) (provide 'shr) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 25e4097a806..c1eb36e3405 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." "When this method name is used, forward all calls to Android Debug Bridge.") ;;;###tramp-autoload -(defcustom tramp-adb-prompt "^[^#\\$]*[#\\$][[:space:]]" +(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]" "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" |