Compare commits
No commits in common. "245d2b702e9650a83f8558c67f799c685754024c" and "3c59b27b028907f44159efa3413499671768b474" have entirely different histories.
245d2b702e
...
3c59b27b02
1 changed files with 51 additions and 174 deletions
225
discoursel.el
225
discoursel.el
|
@ -4,7 +4,6 @@
|
|||
(require 'json)
|
||||
(require 'plz)
|
||||
(require 'message)
|
||||
(require 'rx)
|
||||
|
||||
(defgroup discoursel nil
|
||||
"Discourse TODO")
|
||||
|
@ -14,17 +13,6 @@
|
|||
: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.")
|
||||
|
||||
|
@ -47,22 +35,19 @@ posts manually and incrementally."
|
|||
:group 'discoursel)
|
||||
|
||||
(defun discoursel--parse-pre (tag)
|
||||
(let ((p (point))
|
||||
(shr-folding-mode 'none))
|
||||
(shr-ensure-newline)
|
||||
(shr-generic tag)
|
||||
(shr-ensure-newline)
|
||||
(add-text-properties p (point)
|
||||
'(pre-tag t face discoursel-code-face))))
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(let ((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))))
|
||||
|
||||
(defun discoursel--get (endpoint &optional args)
|
||||
(defun discoursel--get (endpoint)
|
||||
(condition-case plzerror
|
||||
(plz 'get (concat discoursel-instance "/" endpoint ".json"
|
||||
(when args
|
||||
(concat "?"
|
||||
(mapconcat (lambda (elt)
|
||||
(concat (car elt) "=" (cdr elt)))
|
||||
args "&"))))
|
||||
(plz 'get (concat discoursel-instance "/" endpoint ".json")
|
||||
:as #'json-read)
|
||||
(plz-error
|
||||
(error "Could not query endpoint '%s': '%s'"
|
||||
|
@ -95,161 +80,55 @@ posts manually and incrementally."
|
|||
(defun discoursel-update ()
|
||||
(interactive)
|
||||
(with-current-buffer (discoursel-get-create-buffer)
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(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-render-posts-from-topic (topic &optional start-idx)
|
||||
(let* ((posts (alist-get 'posts (alist-get 'post_stream topic)))
|
||||
(topic-slug (alist-get 'slug topic))
|
||||
(buf (discoursel-get-create-buffer topic-slug))
|
||||
(startidx (or start-idx 0)))
|
||||
(with-current-buffer buf
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(cl-loop for idx from startidx to (1- (length posts)) do
|
||||
(goto-char (point-max))
|
||||
(insert
|
||||
"\n"
|
||||
(with-temp-buffer
|
||||
(insert "<hr>")
|
||||
(shr-render-region (point-min) (point-max))
|
||||
(buffer-string)))
|
||||
(discoursel--insert-post (aref posts idx))))))))
|
||||
|
||||
(defun discoursel--fetch-all-posts-from-topic (topic-id number-of-pages)
|
||||
(cl-loop for page from 2 to number-of-pages do
|
||||
(with-delayed-message (2 (format "Rendering page %d out of %d..." page number-of-pages))
|
||||
(let* ((topic (discoursel--get (concat "t/" topic-id)
|
||||
`(("page" . ,(number-to-string page)))))
|
||||
(posts (alist-get 'posts (alist-get 'post_stream topic))))
|
||||
(discoursel-render-posts-from-topic topic)))))
|
||||
(let ((inhibit-read-only t))
|
||||
(discoursel--latest-topics))))
|
||||
|
||||
(defun discoursel--open-topic (&optional id)
|
||||
(interactive)
|
||||
(when (and (not (eq major-mode 'discoursel-mode))
|
||||
(not id))
|
||||
(user-error "You must be in a discoursel buffer"))
|
||||
(error "You must be in a discoursel buffer"))
|
||||
(let* ((topic-id (number-to-string
|
||||
(or id (get-text-property (point) 'discoursel-topic-id))))
|
||||
(topic (discoursel--get (concat "t/" topic-id)))
|
||||
(posts (alist-get 'posts (alist-get 'post_stream topic)))
|
||||
(r (discoursel--get (concat "t/" topic-id)))
|
||||
(posts (alist-get 'posts (alist-get 'post_stream r)))
|
||||
(first-post (aref posts 0))
|
||||
(topic-slug (alist-get 'slug topic))
|
||||
(topic-title (alist-get 'title topic))
|
||||
(buf (discoursel-get-create-buffer topic-slug))
|
||||
(number-of-pages (ceiling (/ (float (alist-get 'posts_count topic))
|
||||
(float (alist-get 'chunk_size topic))))))
|
||||
(topic-slug (get-text-property (point) 'discoursel-topic-slug))
|
||||
(topic-title (alist-get 'title r))
|
||||
(topic-date (alist-get 'created_at r))
|
||||
(topic-date-string
|
||||
(format-time-string "%c"
|
||||
(encode-time
|
||||
(parse-time-string topic-date))))
|
||||
(userid (alist-get 'user_id r))
|
||||
(participants (alist-get 'participants (alist-get 'details r)))
|
||||
(topic-author-alist (seq-find (lambda (p)
|
||||
(= (alist-get 'id p) userid))
|
||||
participants))
|
||||
(topic-author (alist-get 'username topic-author-alist))
|
||||
(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)
|
||||
(discoursel--insert-post first-post topic-title)
|
||||
(discoursel-render-posts-from-topic topic 1)
|
||||
(when (> number-of-pages 1)
|
||||
(if discoursel-fetch-all-posts-from-topic
|
||||
(discoursel--fetch-all-posts-from-topic topic-id number-of-pages)
|
||||
(message "TODO"))))))))
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(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")
|
||||
(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)))))))))
|
||||
|
||||
(defun discoursel-open-topic (id)
|
||||
(interactive "nTopic ID: ")
|
||||
|
@ -298,10 +177,8 @@ characters."
|
|||
(let ((map (make-sparse-keymap)))
|
||||
(prog1 map
|
||||
(suppress-keymap map)
|
||||
(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 "n" #'discoursel-topic-next-post)
|
||||
(define-key map "p" #'discoursel-topic-previous-post)
|
||||
(define-key map "q" #'discoursel-kill-buffer)))
|
||||
"Keymap for `discoursel-topic-mode'.")
|
||||
|
||||
|
|
Loading…
Reference in a new issue