More updates

Signed-off-by: Sergio Durigan Junior <sergiodj@sergiodj.net>
This commit is contained in:
Sergio Durigan Junior 2024-04-12 21:40:06 -04:00
parent 3c59b27b02
commit dac665ceb1
Signed by: sergiodj
GPG key ID: D0EB762865FC5E36

View file

@ -4,6 +4,7 @@
(require 'json)
(require 'plz)
(require 'message)
(require 'rx)
(defgroup discoursel nil
"Discourse TODO")
@ -13,6 +14,17 @@
:group 'discoursel
:type 'string)
(defcustom discoursel-fetch-all-posts-from-topic t
"Whether to fetch all posts from a certain topic.
If t, the default, all posts are fetched (which may take a while
depending on the topic's length).
If nil, pagination is enabled and the user needs to ask for more
posts manually and incrementally."
:group 'discoursel
:type 'boolean)
(defvar discoursel-buffer-list nil
"List of discoursel buffers.")
@ -35,15 +47,13 @@
:group 'discoursel)
(defun discoursel--parse-pre (tag)
(insert
(with-temp-buffer
(let ((shr-folding-mode 'none))
(let ((p (point))
(shr-folding-mode 'none))
(shr-ensure-newline)
(shr-generic tag)
(shr-ensure-newline))
(add-text-properties (point-min) (point-max)
'(pre-tag t face discoursel-code-face))
(buffer-string))))
(shr-ensure-newline)
(add-text-properties p (point)
'(pre-tag t face discoursel-code-face))))
(defun discoursel--get (endpoint)
(condition-case plzerror
@ -80,20 +90,119 @@
(defun discoursel-update ()
(interactive)
(with-current-buffer (discoursel-get-create-buffer)
(save-excursion
(let ((inhibit-read-only t))
(discoursel--latest-topics))))
(discoursel--latest-topics)))))
(defun discoursel--get-name-or-username (post)
(let ((name (alist-get 'display_username post)))
(if (and name (not (string-empty-p name)))
name
(alist-get 'username post))))
(defun discoursel--parse-heading (dom)
"Prepend <hN> tag (DOM) with the equivalent number of sharp (#)
characters."
(let* ((idx (1- (length dom)))
;; This is a bit hacky and assumes that the text will always
;; be available as the last item in the list.
(tagname (symbol-name (car dom)))
(level (string-to-number
(string-remove-prefix "h" tagname)))
(sharps (make-string level ?#))
(face (intern (concat "shr-" tagname)))
(possible-text (nth idx dom)))
(when (stringp possible-text)
(setf (nth idx dom) (concat sharps " " possible-text)))
(shr-heading dom face)))
(defun discoursel-topic-next-entry ()
(interactive)
(let ((pos (point)))
(save-excursion
(setq pos (next-single-char-property-change pos 'post-id))
(goto-char pos)
(while (and (not (eobp))
(not (looking-at-p (rx line-start "Author:"))))
(setq pos (next-single-char-property-change pos 'post-id))
(goto-char pos))
(when (eobp)
(setq pos nil)))
(when pos
(goto-char pos))))
(defun discoursel-topic-previous-entry ()
(interactive)
(let ((pos (point)))
(setq pos (or (previous-single-property-change pos 'post-id)
(point-min)))
(goto-char pos)
(while (and (not (bobp))
(not (looking-at-p (rx line-start (or "Author:" "Title:")))))
(setq pos (or (previous-single-property-change pos 'post-id)
(point-min)))
(goto-char pos))))
(defun discoursel--insert-post (post &optional post-title)
(let* ((post-slug (alist-get 'topic_slug post))
(post-id (alist-get 'id post))
; (topic-title (alist-get 'title r))
(post-date (alist-get 'created_at post))
(post-date-string
(format-time-string "%c"
(encode-time
(parse-time-string post-date))))
(post-author (discoursel--get-name-or-username post))
(post-html-content (alist-get 'cooked post)))
;; (userid (alist-get 'user_id r))
;; (participants (alist-get 'participants (alist-get 'details r)))
;; (topic-username (alist-get 'username first-post))
;; (topic-author-alist (seq-find (lambda (p)
;; (string= (alist-get 'username p) topic-username))
;; participants))
;; ; (topic-author (alist-get 'username topic-author-alist))
;; (topic-flairname (alist-get 'name topic-author-alist))
;; (topic-author (concat topic-flairname " ("(alist-get 'username first-post) ")"))
(save-excursion
(insert
(with-temp-buffer
(when post-title
(insert (format (propertize "Title: %s\n" 'face 'message-header-name)
(propertize post-title 'face 'message-header-subject))))
(insert (format (propertize "Author: %s\n" 'face 'message-header-name)
(propertize post-author 'face 'message-header-to)))
(insert (format (propertize "Date: %s\n" 'face 'message-header-name)
(propertize post-date-string 'face 'message-header-other)))
(insert "\n")
(save-excursion
(insert post-html-content))
(let ((shr-use-fonts nil)
(shr-external-rendering-functions
'((pre . discoursel--parse-pre)
(h1 . discoursel--parse-heading)
(h2 . discoursel--parse-heading)
(h3 . discoursel--parse-heading)
(h4 . discoursel--parse-heading)
(h5 . discoursel--parse-heading)
(h6 . discoursel--parse-heading))))
(shr-render-region (point) (point-max)))
(put-text-property (point-min) (point-max)
'post-id post-id)
(buffer-string))))))
(defun discoursel--open-topic (&optional id)
(interactive)
(when (and (not (eq major-mode 'discoursel-mode))
(not id))
(error "You must be in a discoursel buffer"))
(user-error "You must be in a discoursel buffer"))
(let* ((topic-id (number-to-string
(or id (get-text-property (point) 'discoursel-topic-id))))
(r (discoursel--get (concat "t/" topic-id)))
(posts (alist-get 'posts (alist-get 'post_stream r)))
(first-post (aref posts 0))
(topic-slug (get-text-property (point) 'discoursel-topic-slug))
(topic-slug (alist-get 'slug r))
(topic-title (alist-get 'title r))
(topic-date (alist-get 'created_at r))
(topic-date-string
@ -102,33 +211,47 @@
(parse-time-string topic-date))))
(userid (alist-get 'user_id r))
(participants (alist-get 'participants (alist-get 'details r)))
(topic-username (alist-get 'username first-post))
(topic-author-alist (seq-find (lambda (p)
(= (alist-get 'id p) userid))
(string= (alist-get 'username p) topic-username))
participants))
(topic-author (alist-get 'username topic-author-alist))
; (topic-author (alist-get 'username topic-author-alist))
(topic-flairname (alist-get 'name topic-author-alist))
(topic-author (concat (alist-get 'display_username first-post) " ("(alist-get 'username first-post) ")"))
(buf (discoursel-get-create-buffer topic-slug)))
(switch-to-buffer buf)
(with-current-buffer buf
(discoursel-topic-mode)
(save-excursion
(let ((inhibit-read-only t))
(erase-buffer)
(save-excursion
(discoursel--insert-post first-post topic-title)
(cl-loop for idx from 1 to (1- (length posts)) do
(goto-char (point-max))
(insert
"\n"
(with-temp-buffer
(insert (format (propertize "Title: %s\n" 'face 'message-header-name)
(propertize topic-title 'face 'message-header-subject)))
(insert (format (propertize "Author: %s\n" 'face 'message-header-name)
(propertize topic-author 'face 'message-header-to)))
(insert (format (propertize "Date: %s\n" 'face 'message-header-name)
(propertize topic-date-string 'face 'message-header-other)))
(insert "\n")
(let ((p (point)))
(insert (alist-get 'cooked first-post))
(let ((shr-use-fonts nil)
(shr-external-rendering-functions
'((pre . discoursel--parse-pre))))
(shr-render-region p (point-max))))
(buffer-substring (point-min) (point-max)))))))))
(insert "<hr>")
(shr-render-region (point-min) (point-max))
(buffer-string)))
(discoursel--insert-post (aref posts idx))))))))
;; (save-excursion
;; (insert
;; (with-temp-buffer
;; (insert (format (propertize "Title: %s\n" 'face 'message-header-name)
;; (propertize topic-title 'face 'message-header-subject)))
;; (insert (format (propertize "Author: %s\n" 'face 'message-header-name)
;; (propertize topic-author 'face 'message-header-to)))
;; (insert (format (propertize "Date: %s\n" 'face 'message-header-name)
;; (propertize topic-date-string 'face 'message-header-other)))
;; (insert "\n")
;; (save-excursion
;; (insert (alist-get 'cooked first-post)))
;; (let ((shr-use-fonts nil)
;; (shr-external-rendering-functions
;; '((pre . discoursel--parse-pre))))
;; (shr-render-region (point) (point-max)))
;; (buffer-string))))))))
(defun discoursel-open-topic (id)
(interactive "nTopic ID: ")
@ -177,8 +300,10 @@
(let ((map (make-sparse-keymap)))
(prog1 map
(suppress-keymap map)
(define-key map "n" #'discoursel-topic-next-post)
(define-key map "p" #'discoursel-topic-previous-post)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
(define-key map (kbd "M-n") #'discoursel-topic-next-entry)
(define-key map (kbd "M-p") #'discoursel-topic-previous-entry)
(define-key map "q" #'discoursel-kill-buffer)))
"Keymap for `discoursel-topic-mode'.")