~brettgilio/org-webring

a7e717f749685c4f8b13a95be5d9a6a6866f0ab3 — Alexandru-Sergiu Marton 4 days ago cf96855
Add initial support for article pinning.

Co-authored-by: Brett Gilio <brettg@gnu.org>
1 files changed, 63 insertions(+), 17 deletions(-)

M org-webring.el
M org-webring.el => org-webring.el +63 -17
@@ 12,7 12,7 @@
;; Co-author: Amin Bandali <bandali@gnu.org>
;; Co-author: Ivan Sokolov <ivan-p-sokolov@ya.ru>

;; Version: 1.9
;; Version: 1.9.1

;; Homepage: https://sr.ht/~brettgilio/org-webring
;; Repository: https://git.sr.ht/~brettgilio/org-webring


@@ 85,7 85,7 @@
  "Address of the project-hub page.")

(defconst org-webring-version
  "1.9"
  "1.9.1"
  "The current version of `org-webring'.")

(defcustom org-webring-items-total 3


@@ 181,6 181,16 @@ set for the planet description."
  :group 'org-webring
  :type 'string)

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

(defcustom org-webring-pin-symbol "🖈"
  "The symbol used to denote a pinned item."
  :group 'org-webring
  :type '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 246,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 based on PREDICATE.

The first value returned contains the elements that satisfy
PREDICATE, and the second contains those that do not."
  (cl-loop for x in list
           if (funcall predicate x) collect x into satisfy
           else collect x into fail
           finally (return (cl-values satisfy fail))))

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



@@ 267,9 287,23 @@ 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
	      (cl-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)
  "Check if ITEM item is pinned, and return it if TRUE."
  (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,12 363,17 @@ 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"
                            nil))
          ,(when (org-webring--item-pinned-p item)
               `(div :class "org-webring-article-pinned-symbol"
                     ,(print org-webring-pin-symbol)))
	  (h4 :class "org-webring-article-title"
	      (a :href
		 ,(org-webring--get-link item)
              (a :href ,(org-webring--get-link item)
		 :target "_blank"
		 ,(org-webring--feed-text-prop item 'title)))
                 ,(org-webring--feed-text-prop item 'title)))
	  (p :class "org-webring-article-summary"
	     ,(org-webring--string-truncate
	       org-webring-summary-max-length


@@ 373,10 412,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
	  (cl-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


@@ 399,11 450,6 @@ was introduced in Emacs 27) isn't available."
			 (print (concat " -- v"
					org-webring-version))))))))))

;; TODO: Eventually `org-webring-generate-webring' and
;; `org-webring-generate-planet' may be replacable with MACROs.
;; TODO: Sort syndicates by alphanumeric.
;; FIXME: Some feeds trigger a bug around date-encoding, seemingly
;; on older early 2000s posts.
(defun org-webring-generate-planet ()
  "Generate the entire planet with syndicates list and return it as HTML."
  (let* ((org-webring-items-per-source most-positive-fixnum)