~brettgilio/org-webring

Dumb support for pinning. v1 APPLIED

Alexandru-Sergiu Marton: 1
 Dumb support for pinning.

 1 files changed, 50 insertions(+), 7 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~brettgilio/org-webring/patches/14329/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH] Dumb support for pinning. Export this patch

---

This is a quick and dirty way of pinning items. It works only for the
webring, as it's mostly a kind of proof of concept. I didn't have the
time to make something cleaner right now, but I will probably come
back to this soon.

To pin an article you have to add its URL to the
org-webring-pinned-urls list.

The final webring will contain all the pinned items first (of course,
limited by org-webring-items-per-source and org-webring-items-total),
sorted chronologically, followed by as many normal articles the
settings allow. The pinned items in HTML form also have the "pinned"
class to allow for visual customization.

 org-webring.el | 57 +++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 50 insertions(+), 7 deletions(-)

diff --git a/org-webring.el b/org-webring.el
index 32d363e..a5b162d 100644
--- a/org-webring.el
+++ b/org-webring.el
@@ -181,6 +181,11 @@ set for the planet description."
  :group 'org-webring
  :type 'string)

(defcustom org-webring-pinned-urls '()
  "URLs of feed items that should be pinned."
  :group 'org-webring
  :type '(repeat string))

(defun org-webring--xml-get-child (xml child-name)
  "Return the first child of the parsed XML root whose name
matches CHILD-NAME."
@@ -236,6 +241,16 @@ OBJECT may be either the full feed or an item thereof."
			(seq-map #'cadr
				 (xml-get-children object 'link)))))))

(defun org-webring--partition-list (predicate list)
  "Split LIST in two other lists based on PREDICATE.

The first value returned contains the elements that satisfy
PREDICATE, and the second, those that don't."
  (loop for x in list
    if (funcall predicate x) collect x into yes
    else collect x into no
    finally (return (values yes no))))

(defun org-webring--get-items-from-url (url)
  "Create a list of items contained in the feed at URL.

@@ -267,9 +282,22 @@ The URL will be skipped
                 (sourceType nil ,type)
                 (sourceLink nil ,source-link)
                 (sourceTitle nil ,source-title)
		 (pinned nil ,(if (member (org-webring--get-link item) org-webring-pinned-urls)
				  "true"
				"false"))
                 ,@(xml-node-children item)))
	     (seq-take (org-webring--feed-items feed type)
		       org-webring-items-per-source))))
	     (seq-take
	      (multiple-value-bind (pinned normal)
		  (org-webring--partition-list
		   (lambda (item)
		     (member (org-webring--get-link item) org-webring-pinned-urls))
		   (org-webring--feed-items feed type))
		(append pinned normal))
	      org-webring-items-per-source))))

(defun org-webring--item-pinned-p (item)
  (string-equal (org-webring--feed-text-prop item 'pinned)
		"true"))

(defun org-webring--string-truncate (len s elipsis)
  "If S is longer than LEN, cut it down and add ELIPSIS at the
@@ -329,7 +357,10 @@ was introduced in Emacs 27) isn't available."
						      (point-max))))
			 ((consp content)
			  content)))))))
    `(div :class "org-webring-article"
    `(div :class ,(concat "org-webring-article"
			  (if (org-webring--item-pinned-p item)
			      " pinned"
			    ""))
	  (h4 :class "org-webring-article-title"
	      (a :href
		 ,(org-webring--get-link item)
@@ -373,10 +404,22 @@ was introduced in Emacs 27) isn't available."
  "Generate the entire webring and return it as HTML."
  (let* ((unique-urls (seq-uniq org-webring-urls))
         (items (mapcan #'org-webring--get-items-from-url unique-urls))
         (sorted-items (cl-sort items #'time-less-p
                                :key #'org-webring--pub-time))
         (most-recent (reverse (last sorted-items org-webring-items-total)))
         (articles (mapcar #'org-webring--article-instance most-recent)))
	 (articles
	  (multiple-value-bind (pinned normal)
	      (org-webring--partition-list
	       #'org-webring--item-pinned-p
	       items)
	    (let* ((combined-items (list pinned normal))
		   (sorted-items (mapcar (lambda (items)
					   (cl-sort items #'time-less-p
						    :key #'org-webring--pub-time))
					 combined-items))
		   (most-recent (mapcar (lambda (x)
					  (reverse (last x org-webring-items-total)))
					sorted-items))
		   (articles (mapcar #'org-webring--article-instance
				     (seq-take (apply #'append most-recent) org-webring-items-total))))
	      articles))))
    (xmlgen
     `(section :class "org-webring"
	       ,(when org-webring-display-header
-- 
2.28.0