GNU bug report logs - #20032
eww: access bookmarks right from the URI prompt

Previous Next

Full log

Message #8 received at 20032 <at> debbugs.gnu.org (full text, mbox):

From: Ivan Shmakov <ivan <at> siamics.net>
To: 20032 <at> debbugs.gnu.org
Subject: Re: bug#20032: eww: access bookmarks right from the URI prompt 
Date: Sun, 08 Mar 2015 10:25:49 +0000

[Message part 1 (text/plain, inline)]

>>>>> Ivan Shmakov <ivan <at> siamics.net> writes:

[…]

	That variant didn’t work quite well in practice.  The primary
	issue was that using 'display meant it wasn’t possible to search
	/annotations/ (using C-s, C-r, etc.) – only the URIs proper,
	which isn’t as nice as it could be.

	One another is that once we replace the use of 'display with
	appending the actual annotation to the value, with a non-nil
	'field property (for navigation purposes), move-end-of-line
	starts to misbehave in certain cases, apparently due to the fact
	that ‘line-move’ returns t after moving point to another /field/
	(as opposed to /line/.)  I haven’t identified the cause as of
	yet, but placing the title /before/ URI seems to make this
	problem harder to actually stumble upon.  Now given that there
	may be different preferences anyway, I’ve decided to introduce a
	new customizable variable for this one.

	(I’ve cleaned the new code up somewhat as well.)

	Please consider the revised patch MIMEd.

	* lisp/net/eww.el (eww-suggest-uris): Add eww-suggest-bookmarks
	to the default value and :options.  (Bug#20032)
	(eww-suggested-bookmarks-annotation): New customizable variable.
	(eww-suggest-bookmarks, eww-remove-annotation)
	(eww-substring-nil-property): New functions.
	(eww-suggested-uris, eww): Use eww-remove-annotation.

 > Somehow, I believe that eww-remove-annotation may be generalized
 > into something worthy of subr.el.

	(Or subr-x.el; or some other library.)  Generalized in the
	current revision of the patch as eww-substring-nil-property.

-- 
FSF associate member #7257  np. In the Garden — David Modica … B6A0 230E 334A

[Message part 2 (text/diff, inline)]

--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -64,7 +64,8 @@
 (defcustom eww-suggest-uris
   '(eww-links-at-point
     url-get-url-at-point
-    eww-current-url)
+    eww-current-url
+    eww-suggest-bookmarks)
   "List of functions called to form the list of default URIs for `eww'.
 Each of the elements is a function returning either a string or a list
 of strings.  The results will be joined into a single list with
@@ -74,7 +75,21 @@ defcustom eww-suggest-uris
   :type 'hook
   :options '(eww-links-at-point
 	     url-get-url-at-point
-	     eww-current-url))
+	     eww-current-url
+	     eww-suggest-bookmarks))
+
+(defcustom eww-suggested-bookmarks-annotation 'before
+  "Where to place annotation in the list of bookmarks at the URI prompt.
+This variable controls where the bookmark annotation (title) is placed.
+
+If 'before, annotation goes before URI.
+If 'after, annotation goes after URI.
+If nil, no annotation is provided."
+  :version "25.1"
+  :group 'eww
+  :type '(choice (const :tag "Annotation before URI" before)
+		 (const :tag "Annotation after URI" after)
+		 (const :tag "No annotation" nil)))
 
 (defcustom eww-bookmarks-directory user-emacs-directory
   "Directory where bookmark files will be stored."
@@ -234,9 +256,10 @@ defun eww-suggested-uris nil
     (dolist (fun eww-suggest-uris)
       (let ((ret (funcall fun)))
 	(dolist (uri (if (stringp ret) (list ret) ret))
-	  (when (and uri (not (intern-soft uri obseen)))
-	    (intern uri obseen)
-	    (push   uri uris)))))
+	  (let ((key (and uri (eww-remove-annotation uri))))
+	    (when (and key (not (intern-soft key obseen)))
+	      (intern key obseen)
+	      (push   uri uris))))))
     (nreverse uris)))
 
 ;;;###autoload
@@ -249,7 +272,9 @@ defun eww (url)
 	  (prompt (concat "Enter URL or keywords"
 			  (if uris (format " (default %s)" (car uris)) "")
 			  ": ")))
-     (list (read-string prompt nil nil uris))))
+     (let ((minibuffer-allow-text-properties t))
+       (list (eww-remove-annotation
+	      (read-string prompt nil nil uris))))))
   (setq url (string-trim url))
   (cond ((string-match-p "\\`file:/" url))
 	;; Don't mangle file: URLs at all.
@@ -549,6 +560,67 @@
 	(list (get-text-property (point) 'shr-url)
 	      (get-text-property (point) 'image-url))))
 
+(defun eww-suggested-bookmarks ()
+  "Return list of bookmarked URIs, if any.
+The URIs returned may contain arbitrary annotations.  Apply
+`eww-remove-annotation' on elements of the list returned to obtain the
+URIs proper."
+  (let* ((afterp (eq 'after eww-suggested-bookmarks-annotation))
+	 (prop (and eww-suggested-bookmarks-annotation
+		    (nconc (if afterp nil
+			     (list 'front-sticky t
+				   'rear-nonsticky t))
+			   '(field eww-title
+			     annotation t
+			     ; read-only t
+			     face minibuffer-prompt))))
+	 (fmt  (and prop
+		    (apply #'propertize
+			   (if afterp " (%s)" "(%s) ")
+			   prop))))
+    (mapcar (lambda (elt)
+	      (let ((uri (plist-get elt :url))
+		    (title (plist-get elt :title)))
+		(when uri
+		  (cond ((not fmt) uri)
+			(afterp (concat uri (format fmt title)))
+			(t      (concat (format fmt title) uri))))))
+	  eww-bookmarks)))
+
+(defun eww-remove-annotation (string &optional start limit)
+  (eww-substring-nil-property 'annotation string start limit))
+
+(defun eww-substring-nil-property (property &optional object start limit)
+  "Return the contents of OBJECT where PROPERTY is not set or nil.
+Return nil if all the contents of OBJECT has PROPERTY set and non-nil.
+
+OBJECT is either a string, buffer, or nil (which means the
+current buffer).
+
+If START is nil, use 0 for a string, or point for a buffer OBJECT.
+If LIMIT is nil, use string length for a string or (point-max) for a
+buffer."
+  (save-current-buffer
+    (cond ((stringp object))
+          (object
+           (set-buffer object)
+           (setq object nil)))
+    ;; From now on, object is either a string or nil.
+    (unless start
+      (setq start (if object 0 (point))))
+    (unless (or object limit)
+      (setq limit (point-max)))
+    (let ((acc  nil) 
+          (from start))
+      (while from
+        (let ((to (next-single-property-change from property object)))
+          (unless (get-text-property from property object)
+            (setq acc (concat acc
+                              (if object
+                                  (substring object from to)
+                                (buffer-substring from (or to limit))))))
+          (setq from to)))
+      acc)))
 (defun eww-view-source ()
   "View the HTML source code of the current page."
   (interactive)

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.