unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#16086: 24.3.50; [PATCH] eww: New command and functions to list the browser histories.
@ 2013-12-08  5:44 Kenjiro NAKAYAMA
  2013-12-11  0:21 ` Ted Zlatanov
  0 siblings, 1 reply; 13+ messages in thread
From: Kenjiro NAKAYAMA @ 2013-12-08  5:44 UTC (permalink / raw)
  To: 16086

New command and functions to list the eww browser histories. Since eww quits only "q" command, I think it becomes useful.

Signed-off-by: Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>

	* net/eww.el
      (eww-list-histories,eww-list-histories,eww-history-browse,eww-history-quit,eww-history-kill,eww-history-mode-map,eww-history-mode):
      New command and functions to list browser histories.

---
 lisp/net/eww.el | 107 +++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 95 insertions(+), 12 deletions(-)

diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 9d1c3a2..7a9c8e2 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -410,7 +410,8 @@ word(s) will be searched for via `eww-search-prefix'."
     (define-key map "w" 'eww-copy-page-url)
     (define-key map "C" 'url-cookie-list)
     (define-key map "v" 'eww-view-source)
-
+    (define-key map "H" 'eww-list-histories)
+    
     (define-key map "b" 'eww-add-bookmark)
     (define-key map "B" 'eww-list-bookmarks)
     (define-key map [(meta n)] 'eww-next-bookmark)
@@ -430,6 +431,7 @@ word(s) will be searched for via `eww-search-prefix'."
 	["Copy page URL" eww-copy-page-url t]
 	["Add bookmark" eww-add-bookmark t]
 	["List bookmarks" eww-copy-page-url t]
+	["List histories" eww-list-histories t]	
 	["List cookies" url-cookie-list t]))
     map))
 
@@ -443,21 +445,12 @@ word(s) will be searched for via `eww-search-prefix'."
   (set (make-local-variable 'eww-current-source) nil)
   (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
   (set (make-local-variable 'after-change-functions) 'eww-process-text-input)
-  (set (make-local-variable 'eww-history) nil)
-  (set (make-local-variable 'eww-history-position) 0)
+;;  (set (make-local-variable 'eww-history) nil)
+;;  (set (make-local-variable 'eww-history-position) 0)
   (buffer-disable-undo)
   ;;(setq buffer-read-only t)
   )
 
-(defun eww-save-history ()
-  (push (list :url eww-current-url
-	      :title eww-current-title
-	      :point (point)
-              :dom eww-current-dom
-              :source eww-current-source
-	      :text (buffer-string))
-	eww-history))
-
 ;;;###autoload
 (defun eww-browse-url (url &optional _new-window)
   (when (and (equal major-mode 'eww-mode)
@@ -1229,6 +1222,96 @@ Differences in #targets are ignored."
   (setq buffer-read-only t
 	truncate-lines t))
 
+;;; History code
+
+(defun eww-save-history ()
+  (push (list :url eww-current-url
+	      :title eww-current-title
+	      :point (point)
+              :dom eww-current-dom
+              :source eww-current-source
+	      :text (buffer-string))
+	eww-history))
+
+(defun eww-list-histories ()
+  "List the eww-histories."
+  (interactive)
+  (when (null eww-history)
+    (error "No eww-histories are defined"))
+  (set-buffer (get-buffer-create "*eww history*"))    
+  (eww-history-mode)
+  (let ((inhibit-read-only t)
+	(domain-length 0)
+	(title-length 0)
+	url title format start)
+    (erase-buffer)
+    (dolist (history eww-history)
+      (setq start (point))            
+      (setq domain-length (max domain-length (length (plist-get history :url))))
+      (setq title-length (max title-length (length (plist-get history :title))))
+      )
+    (setq format (format "%%-%ds %%-%ds" title-length domain-length)
+	  header-line-format
+	  (concat " " (format format "Title" "URL")))
+
+    (dolist (history eww-history)
+      (setq url (plist-get history :url))
+      (setq title (plist-get history :title))
+      (insert (format format title url))
+      (insert "\n")
+      (put-text-property start (point) 'eww-history history)
+      )
+    (goto-char (point-min)))
+  (pop-to-buffer "*eww history*")  
+  )
+
+(defun eww-history-browse ()
+  "Browse the history under point in eww."
+  (interactive)
+  (let ((history (get-text-property (line-beginning-position) 'eww-history)))
+    (unless history
+      (error "No history on the current line"))
+    (eww-history-quit)
+    (pop-to-buffer "*eww*")
+    (eww-browse-url (plist-get history :url))))
+
+(defun eww-history-quit ()
+  "Kill the current buffer."
+  (interactive)
+  (kill-buffer (current-buffer)))
+
+(defvar eww-history-kill-ring nil)
+
+(defun eww-history-kill ()
+  "Kill the current history."
+  (interactive)
+  (let* ((start (line-beginning-position))
+	 (history (get-text-property start 'eww-history))
+	 (inhibit-read-only t))
+    (unless history
+      (error "No history on the current line"))
+    (forward-line 1)
+    (push (buffer-substring start (point)) eww-history-kill-ring)
+    (delete-region start (point))
+    (setq eww-history (delq history eww-history))
+    ))
+
+(defvar eww-history-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (define-key map "q" 'eww-history-quit)
+    (define-key map [(control k)] 'eww-history-kill)
+    (define-key map "\r" 'eww-history-browse)
+    map))
+
+(define-derived-mode eww-history-mode nil "eww history"
+  "Mode for listing eww-histories.
+
+\\{eww-history-mode-map}"
+  (buffer-disable-undo)
+  (setq buffer-read-only t
+	truncate-lines t))
+
 (provide 'eww)
 
 ;;; eww.el ends here
-- 
1.8.3.1






^ permalink raw reply related	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2013-12-21 20:34 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-12-08  5:44 bug#16086: 24.3.50; [PATCH] eww: New command and functions to list the browser histories Kenjiro NAKAYAMA
2013-12-11  0:21 ` Ted Zlatanov
2013-12-11 19:07   ` Ted Zlatanov
2013-12-12  3:20     ` nakayamakenjiro
2013-12-12 15:42       ` Ted Zlatanov
2013-12-12 23:54         ` Kenjiro NAKAYAMA
2013-12-13 14:39           ` Ted Zlatanov
2013-12-14  1:48             ` Kenjiro NAKAYAMA
2013-12-14 15:56               ` Stefan Monnier
2013-12-14 16:15         ` Lars Magne Ingebrigtsen
2013-12-20  0:53           ` Kenjiro NAKAYAMA
2013-12-21 20:34             ` Ted Zlatanov
2013-12-21 20:34             ` Ted Zlatanov

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).