]> code.delx.au - gnu-emacs/blobdiff - lisp/net/eww.el
Merge from origin/emacs-24
[gnu-emacs] / lisp / net / eww.el
index c6d3bbceda29c0c453dc28440839f1c223fd6c32..b7ee0650d7080b120daf1fb0464b4a889336d46b 100644 (file)
@@ -1,6 +1,6 @@
-;;; eww.el --- Emacs Web Wowser
+;;; eww.el --- Emacs Web Wowser  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: html
@@ -60,6 +60,7 @@
   :group 'eww
   :type 'string)
 
+;;;###autoload
 (defcustom eww-suggest-uris
   '(eww-links-at-point
     url-get-url-at-point
@@ -255,14 +256,20 @@ word(s) will be searched for via `eww-search-prefix'."
         ((string-match-p "\\`ftp://" url)
          (user-error "FTP is not supported."))
         (t
-         (if (and (= (length (split-string url)) 1)
-                 (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
-                          (> (length (split-string url "[.:]")) 1))
-                     (string-match eww-local-regex url)))
+        ;; Anything that starts with something that vaguely looks
+        ;; like a protocol designator is interpreted as a full URL.
+         (if (or (string-match "\\`[A-Za-z]+:" url)
+                ;; Also try to match "naked" URLs like
+                ;; en.wikipedia.org/wiki/Free software
+                (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
+                (and (= (length (split-string url)) 1)
+                     (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url))
+                              (> (length (split-string url "[.:]")) 1))
+                         (string-match eww-local-regex url))))
              (progn
                (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
                  (setq url (concat "http://" url)))
-               ;; some site don't redirect final /
+               ;; Some sites do not redirect final /
                (when (string= (url-filename (url-generic-parse-url url)) "")
                  (setq url (concat url "/"))))
            (setq url (concat eww-search-prefix
@@ -273,6 +280,7 @@ word(s) will be searched for via `eww-search-prefix'."
        (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))
@@ -402,7 +410,6 @@ See the `eww-search-prefix' variable for the search engine used."
               (form . eww-tag-form)
               (input . eww-tag-input)
               (textarea . eww-tag-textarea)
-              (body . eww-tag-body)
               (select . eww-tag-select)
               (link . eww-tag-link)
               (a . eww-tag-a))))
@@ -445,7 +452,7 @@ See the `eww-search-prefix' variable for the search engine used."
                   ("start" . :start)
                   ("home" . :home)
                   ("contents" . :contents)
-                  ("up" . up)))))
+                  ("up" . :up)))))
     (and href
         where
         (plist-put eww-data (cdr where) href))))
@@ -488,15 +495,6 @@ See the `eww-search-prefix' variable for the search engine used."
              (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
   (eww-update-header-line-format))
 
-(defun eww-tag-body (dom)
-  (let* ((start (point))
-        (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
-        (bgcolor (dom-attr dom 'bgcolor))
-        (shr-stylesheet (list (cons 'color fgcolor)
-                              (cons 'background-color bgcolor))))
-    (shr-generic dom)
-    (shr-colorize-region start (point) fgcolor bgcolor)))
-
 (defun eww-display-raw (buffer &optional encode)
   (let ((data (buffer-substring (point) (point-max))))
     (unless (buffer-live-p buffer)
@@ -545,7 +543,7 @@ See the `eww-search-prefix' variable for the search engine used."
   "Return URI of the Web page the current EWW buffer is visiting."
   (plist-get eww-data :url))
 
-(defun eww-links-at-point (&optional pt)
+(defun eww-links-at-point ()
   "Return list of URIs, if any, linked at point."
   (remq nil
        (list (get-text-property (point) 'shr-url)
@@ -624,17 +622,13 @@ the like."
 
 (defvar eww-mode-map
   (let ((map (make-sparse-keymap)))
-    (suppress-keymap map)
-    (define-key map "q" 'quit-window)
-    (define-key map "g" 'eww-reload)
+    (set-keymap-parent map special-mode-map)
+    (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead!
     (define-key map "G" 'eww)
     (define-key map [?\t] 'shr-next-link)
     (define-key map [?\M-\t] 'shr-previous-link)
     (define-key map [backtab] 'shr-previous-link)
     (define-key map [delete] 'scroll-down-command)
-    (define-key map [?\S-\ ] 'scroll-down-command)
-    (define-key map "\177" 'scroll-down-command)
-    (define-key map " " 'scroll-up-command)
     (define-key map "l" 'eww-back-url)
     (define-key map "r" 'eww-forward-url)
     (define-key map "n" 'eww-next-url)
@@ -650,6 +644,7 @@ the like."
     (define-key map "H" 'eww-list-histories)
     (define-key map "E" 'eww-set-character-encoding)
     (define-key map "S" 'eww-list-buffers)
+    (define-key map "F" 'eww-toggle-fonts)
 
     (define-key map "b" 'eww-add-bookmark)
     (define-key map "B" 'eww-list-bookmarks)
@@ -692,19 +687,22 @@ the like."
     map)
   "Tool bar for `eww-mode'.")
 
-(define-derived-mode eww-mode nil "eww"
-  "Mode for browsing the web.
-
-\\{eww-mode-map}"
+;; Autoload cookie needed by desktop.el.
+;;;###autoload
+(define-derived-mode eww-mode special-mode "eww"
+  "Mode for browsing the web."
   (setq-local eww-data (list :title ""))
-  (setq-local browse-url-browser-function 'eww-browse-url)
-  (setq-local after-change-functions 'eww-process-text-input)
+  (setq-local browse-url-browser-function #'eww-browse-url)
+  (add-hook 'after-change-functions #'eww-process-text-input nil t)
   (setq-local eww-history nil)
   (setq-local eww-history-position 0)
   (when (boundp 'tool-bar-map)
-   (setq-local tool-bar-map eww-tool-bar-map))
+    (setq-local tool-bar-map eww-tool-bar-map))
   ;; desktop support
-  (setq-local desktop-save-buffer 'eww-desktop-misc-data)
+  (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)
   (buffer-disable-undo)
   (setq buffer-read-only t))
 
@@ -1046,7 +1044,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
     (insert value)
     (shr-ensure-newline)
     (when (< (count-lines start (point)) lines)
-      (dotimes (i (- lines (count-lines start (point))))
+      (dotimes (_ (- lines (count-lines start (point))))
        (insert "\n")))
     (setq end (point-marker))
     (goto-char start)
@@ -1421,29 +1419,37 @@ Differences in #targets are ignored."
       (eww-reload nil 'utf-8)
     (eww-reload nil charset)))
 
+(defun eww-toggle-fonts ()
+  "Toggle whether to use monospaced or font-enabled layouts."
+  (interactive)
+  (message "Fonts are now %s"
+          (if (setq shr-use-fonts (not shr-use-fonts))
+              "on"
+            "off"))
+  (eww-reload))
+
 ;;; Bookmarks code
 
 (defvar eww-bookmarks nil)
 
 (defun eww-add-bookmark ()
-  "Add the current page to the bookmarks."
+  "Bookmark the current page."
   (interactive)
   (eww-read-bookmarks)
   (dolist (bookmark eww-bookmarks)
     (when (equal (plist-get eww-data :url) (plist-get bookmark :url))
       (user-error "Already bookmarked")))
-  (if (y-or-n-p "bookmark this page? ")
-      (progn
-       (let ((title (replace-regexp-in-string "[\n\t\r]" " "
-                                              (plist-get eww-data :title))))
-         (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
-         (push (list :url (plist-get eww-data :url)
-                     :title title
-                     :time (current-time-string))
-               eww-bookmarks))
-       (eww-write-bookmarks)
-       (message "Bookmarked %s (%s)" (plist-get eww-data :url)
-                (plist-get eww-data :title)))))
+  (when (y-or-n-p "Bookmark this page?")
+    (let ((title (replace-regexp-in-string "[\n\t\r]" " "
+                                          (plist-get eww-data :title))))
+      (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
+      (push (list :url (plist-get eww-data :url)
+                 :title title
+                 :time (current-time-string))
+           eww-bookmarks))
+    (eww-write-bookmarks)
+    (message "Bookmarked %s (%s)" (plist-get eww-data :url)
+            (plist-get eww-data :title))))
 
 (defun eww-write-bookmarks ()
   (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
@@ -1838,7 +1844,7 @@ Also used when saving `eww-history'.")
     ;; .
     r))
 
-(defun eww-desktop-misc-data (directory)
+(defun eww-desktop-misc-data (_directory)
   "Return a property list with data used to restore eww buffers.
 This list will contain, as :history, the list, whose first element is
 the value of `eww-data', and the tail is `eww-history'.
@@ -1874,8 +1880,9 @@ Otherwise, the restored buffer will contain a prompt to do so by using
        (case eww-restore-desktop
          ((t auto) (eww (plist-get eww-data :url)))
          ((zerop (buffer-size))
-          (insert (substitute-command-keys
-                   eww-restore-reload-prompt))))))
+          (let ((inhibit-read-only t))
+            (insert (substitute-command-keys
+                     eww-restore-reload-prompt)))))))
     ;; .
     (current-buffer)))
 
@@ -1884,6 +1891,19 @@ Otherwise, the restored buffer will contain a prompt to do so by using
 (add-to-list 'desktop-buffer-mode-handlers
              '(eww-mode . eww-restore-desktop))
 
+;;; Isearch support
+
+(defun eww-isearch-next-buffer (&optional _buffer wrap)
+  "Go to the next page to search using `rel' attribute for navigation."
+  (if wrap
+      (condition-case nil
+         (eww-top-url)
+       (error nil))
+    (if isearch-forward
+       (eww-next-url)
+      (eww-previous-url)))
+  (current-buffer))
+
 (provide 'eww)
 
 ;;; eww.el ends here