468 lines
16 KiB
EmacsLisp
468 lines
16 KiB
EmacsLisp
|
|
;;; Code:
|
|
|
|
(require 'json)
|
|
(require 'plz)
|
|
(require 'message)
|
|
(require 'rx)
|
|
(require 'markdown-mode)
|
|
|
|
(defgroup discoursel nil
|
|
"Discourse TODO")
|
|
|
|
(defcustom discoursel-instances
|
|
'((ubuntu
|
|
:url "https://discourse.ubuntu.com"
|
|
:name "Ubuntu")
|
|
(fedora
|
|
:url "https://discussion.fedoraproject.org"
|
|
:name "Fedora"))
|
|
"The Discourse instance."
|
|
: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.")
|
|
|
|
(defface discoursel-topic-face
|
|
'((((class color) (background light)) (:foreground "#000"))
|
|
(((class color) (background dark)) (:foreground "#fff")))
|
|
"Face used for topics."
|
|
:group 'discoursel)
|
|
|
|
(defface discoursel-username-face
|
|
'((((class color) (background light)) (:foreground "#aa0"))
|
|
(((class color) (background dark)) (:foreground "#ff0")))
|
|
"Face used for usernames."
|
|
:group 'discoursel)
|
|
|
|
(defface discoursel-code-face
|
|
'((((class color) (background light)) (:background "#cdcecc" :extend t))
|
|
(((class color) (background dark)) (:background "#17211c" :extend t)))
|
|
"Face used for code blocks."
|
|
: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))))
|
|
|
|
(defun discoursel--get (instance endpoint &optional args)
|
|
(condition-case plzerror
|
|
(let* ((instance-url (plist-get (cdr instance) ':url))
|
|
(full-url (concat instance-url "/" endpoint ".json")))
|
|
(plz 'get (concat full-url
|
|
(when args
|
|
(concat "?"
|
|
(mapconcat (lambda (elt)
|
|
(concat (car elt) "=" (cdr elt)))
|
|
args "&"))))
|
|
:as #'json-read))
|
|
(plz-error
|
|
(error "Could not query endpoint '%s': '%s'"
|
|
endpoint (plz-error-message plzerror)))))
|
|
|
|
(defun discoursel--get-invisibility-spec (instance &optional section)
|
|
(let* ((instance-name (symbol-name (car instance)))
|
|
(spec-str (concat "discoursel-visibility-" instance-name
|
|
(when section
|
|
(concat "-" section)))))
|
|
(intern spec-str)))
|
|
|
|
(defun discoursel--latest-topics (instance)
|
|
(let* ((r (discoursel--get instance "latest"))
|
|
(instance-symbol (car instance))
|
|
(topics (alist-get 'topics (alist-get 'topic_list r)))
|
|
(users (alist-get 'users r))
|
|
(initial-point (point)))
|
|
(insert (propertize ">> Latest topics" 'invisible (discoursel--get-invisibility-spec instance)))
|
|
(insert
|
|
(with-temp-buffer
|
|
(insert "\n")
|
|
(cl-map 'vector
|
|
(lambda (topic)
|
|
(let* ((userid (alist-get 'user_id (aref (alist-get 'posters topic) 0)))
|
|
(username (seq-find
|
|
(lambda (v)
|
|
(= (alist-get 'id v) userid))
|
|
users))
|
|
(inhibit-read-only t))
|
|
(insert
|
|
(propertize (format " %s (by %s)\n"
|
|
(propertize (alist-get 'title topic)
|
|
'face 'discoursel-topic-face)
|
|
(propertize (alist-get 'name username)
|
|
'face 'discoursel-username-face))
|
|
'discoursel-topic-slug (alist-get 'slug topic)
|
|
'discoursel-topic-id (alist-get 'id topic)))))
|
|
topics)
|
|
(put-text-property (point-min) (point-max)
|
|
'invisible `(,(discoursel--get-invisibility-spec instance "latest")
|
|
,(discoursel--get-invisibility-spec instance)))
|
|
(buffer-string)))
|
|
(add-text-properties (1- initial-point) (point-max)
|
|
`(discoursel-section "latest"
|
|
discoursel-instance ,instance-symbol))))
|
|
|
|
(defun discoursel-update ()
|
|
(interactive)
|
|
(with-current-buffer (discoursel-get-create-buffer)
|
|
(save-excursion
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(dolist (instance discoursel-instances)
|
|
(let* ((instance-symbol (car instance))
|
|
(instance-plist (cdr instance))
|
|
(instance-name (plist-get instance-plist ':name)))
|
|
(insert (propertize (format "💻 %s" instance-name)
|
|
'discoursel-instance instance-symbol))
|
|
(insert (propertize "\n" 'invisible (discoursel--get-invisibility-spec instance)))
|
|
;; (let ((latest-topic-initial-point (point))
|
|
;; (latest-topic-final-point))
|
|
;; (insert ">> Latest topics")
|
|
;; (setq latest-topic-final-point (point))
|
|
;; (insert "\n")
|
|
(discoursel--latest-topics instance)
|
|
(insert "\n")))
|
|
(kill-line -2)))))
|
|
; (put-text-property latest-topic-final-point (point) 'invisible 'latest-topics))))))
|
|
;; (put-text-property latest-topic-initial-point
|
|
;; latest-topic-final-point
|
|
;; 'overlay (make-overlay (1+ latest-topic-final-point) (point-max))))))))
|
|
|
|
(defun discoursel-toggle-heading ()
|
|
(interactive)
|
|
(when-let* ((instance-to-toggle (get-text-property (point) 'discoursel-instance))
|
|
(instance (assoc instance-to-toggle discoursel-instances)))
|
|
(let* ((section-to-toggle (get-text-property (point) 'discoursel-section))
|
|
(spec (cons (discoursel--get-invisibility-spec instance
|
|
section-to-toggle)
|
|
t))
|
|
(invisible-p (and (listp buffer-invisibility-spec)
|
|
(member spec buffer-invisibility-spec))))
|
|
(if invisible-p
|
|
(remove-from-invisibility-spec spec)
|
|
(add-to-invisibility-spec spec)))))
|
|
|
|
(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 'discoursel-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 'discoursel-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 'discoursel-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 'discoursel-post-id)
|
|
(point-min)))
|
|
(goto-char pos))))
|
|
|
|
(defun discoursel--insert-post (instance post &optional post-title)
|
|
(let* ((post-slug (alist-get 'topic_slug post))
|
|
(post-id (alist-get 'id post))
|
|
(post-number (alist-get 'post_number post))
|
|
(post-date (alist-get 'created_at post))
|
|
(post-date-string
|
|
(format-time-string "%c"
|
|
(encode-time
|
|
(parse-time-string post-date))))
|
|
(post-author-name (discoursel--get-name-or-username post))
|
|
(post-author-username (alist-get 'username post))
|
|
(post-html-content (alist-get 'cooked post))
|
|
(instance-symbol (car instance)))
|
|
(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-name '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)))
|
|
(add-text-properties (point-min) (point-max)
|
|
`(discoursel-post-id ,post-id
|
|
discoursel-post-number ,post-number
|
|
discoursel-post-author-username ,post-author-username
|
|
discoursel-post-author-name ,post-author-name
|
|
discoursel-instance ,instance-symbol))
|
|
(buffer-string))))))
|
|
|
|
(defun discoursel-render-posts-from-topic (instance 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 instance (aref posts idx))))))))
|
|
|
|
(defun discoursel--fetch-all-posts-from-topic (instance 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 instance
|
|
(concat "t/" topic-id)
|
|
`(("page" . ,(number-to-string page))))))
|
|
(discoursel-render-posts-from-topic instance topic)))))
|
|
|
|
(defun discoursel--open-topic (&optional instance id)
|
|
(interactive)
|
|
(when (and (not (eq major-mode 'discoursel-mode))
|
|
(not id))
|
|
(user-error "You must be in a discoursel buffer"))
|
|
(let* ((instance-name (or instance
|
|
(get-text-property (point) 'discoursel-instance)
|
|
(user-error "You must select a topic to open")))
|
|
(instance-data (assoc instance-name discoursel-instances))
|
|
(topic-id (number-to-string
|
|
(or id (get-text-property (point) 'discoursel-topic-id))))
|
|
(topic (discoursel--get instance-data (concat "t/" topic-id)))
|
|
(posts (alist-get 'posts (alist-get 'post_stream topic)))
|
|
(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))))))
|
|
(switch-to-buffer buf)
|
|
(with-current-buffer buf
|
|
(discoursel-topic-mode)
|
|
(save-excursion
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(discoursel--insert-post instance-data first-post topic-title)
|
|
(discoursel-render-posts-from-topic instance-data topic 1)
|
|
(when (> number-of-pages 1)
|
|
(if discoursel-fetch-all-posts-from-topic
|
|
(discoursel--fetch-all-posts-from-topic instance-data
|
|
topic-id
|
|
number-of-pages)
|
|
(message "TODO")))
|
|
(put-text-property (point-min) (point-max)
|
|
'discoursel-topic-id (string-to-number topic-id)))))))
|
|
|
|
(defun discoursel-reply-to-post (&optional arg)
|
|
(interactive "P")
|
|
(let* ((post-id (or (get-text-property (point) 'discoursel-post-id)
|
|
(user-error "You must choose a post to reply to")))
|
|
(instance (assoc (get-text-property (point) 'discoursel-instance)
|
|
discoursel-instances))
|
|
(buf (discoursel-get-create-buffer (number-to-string post-id)))
|
|
(original-topic-point (point))
|
|
(original-topic-buffer (current-buffer)))
|
|
(switch-to-buffer-other-window buf)
|
|
(with-current-buffer buf
|
|
(when arg
|
|
(let ((post-raw-contents
|
|
(alist-get 'raw
|
|
(discoursel--get instance (concat "posts/"
|
|
(number-to-string post-id)))))
|
|
(post-author-username (get-text-property original-topic-point
|
|
'discoursel-post-author-username
|
|
original-topic-buffer))
|
|
(post-number (get-text-property original-topic-point
|
|
'discoursel-post-number
|
|
original-topic-buffer))
|
|
(topic-id (get-text-property original-topic-point
|
|
'discoursel-topic-id
|
|
original-topic-buffer)))
|
|
(insert (format "[quote=\"%s, post:%d, topic:%d\"]\n"
|
|
post-author-username
|
|
post-number
|
|
topic-id))
|
|
(insert post-raw-contents)
|
|
(goto-char (point-min))
|
|
;; We can't quote the [quote...] tag.
|
|
(next-line)
|
|
(while (re-search-forward (rx line-start) nil t)
|
|
(replace-match "> " t t))
|
|
(goto-char (point-max))
|
|
(insert "\n\n")))
|
|
(discoursel-post-reply-mode))
|
|
(message "Type C-c C-c to post reply, C-c C-k to discard it")))
|
|
|
|
(defun discoursel-open-topic (instance id)
|
|
(interactive "nInstance: \nnTopic ID: ")
|
|
(discoursel--open-topic instance id))
|
|
|
|
(defun discoursel-get-create-buffer (&optional name)
|
|
(let* ((bufname (concat "*discoursel"
|
|
(when name (concat "-" name))
|
|
"*"))
|
|
(buf (get-buffer-create bufname)))
|
|
(prog1 buf
|
|
(unless (memq buf discoursel-buffer-list)
|
|
(add-to-list 'discoursel-buffer-list buf)))))
|
|
|
|
(defun discoursel-kill-buffer (&optional buf)
|
|
(interactive)
|
|
(let* ((tmpb (or buf (current-buffer)))
|
|
(b (get-buffer tmpb)))
|
|
(unless b
|
|
(error "Invalid buffer %s" b))
|
|
(with-current-buffer b
|
|
(unless (derived-mode-p 'discoursel-mode)
|
|
(error "Cannot kill buffer %s: not a discoursel buffer" (buffer-name))))
|
|
(kill-buffer b)
|
|
(setq discoursel-buffer-list (remove b discoursel-buffer-list))))
|
|
|
|
(defun discoursel-exit ()
|
|
(interactive)
|
|
(dolist (buf discoursel-buffer-list)
|
|
(kill-buffer buf))
|
|
(setq discoursel-buffer-list nil))
|
|
|
|
(defvar discoursel-mode-map
|
|
(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 "RET") #'discoursel--open-topic)
|
|
(define-key map "j" #'discoursel-open-topic)
|
|
(define-key map (kbd "TAB") #'discoursel-toggle-heading)
|
|
(define-key map "q" #'discoursel-exit)
|
|
(define-key map "g" #'discoursel-update)))
|
|
"Keymap for `discoursel-mode'.")
|
|
|
|
(defvar discoursel-topic-mode-map
|
|
(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 (kbd "C-c C-r") #'discoursel-reply-to-post)
|
|
(define-key map "q" #'discoursel-kill-buffer)))
|
|
"Keymap for `discoursel-topic-mode'.")
|
|
|
|
(defvar discoursel-post-reply-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(prog1 map
|
|
(define-key map (kbd "C-c C-k") #'kill-buffer-and-window)))
|
|
"Keymap for `discoursel-post-reply-mode.")
|
|
|
|
(define-derived-mode discoursel-mode special-mode "Discourse client"
|
|
"Major mode for interacting with Discourse instances.
|
|
\\{discoursel-mode-map}"
|
|
(use-local-map discoursel-mode-map))
|
|
|
|
(define-derived-mode discoursel-topic-mode discoursel-mode "Discoursel topic"
|
|
"Major mode for interacting with Discourse topics.
|
|
\\{discoursel-topic-mode-map}"
|
|
(use-local-map discoursel-topic-mode-map))
|
|
|
|
(define-derived-mode discoursel-post-reply-mode markdown-mode "Discoursel post reply"
|
|
"Major mode for replying to Discourse posts.
|
|
\\{discoursel-post-reply-mode-map}"
|
|
(use-local-map discoursel-post-reply-mode-map))
|
|
|
|
(defun discoursel ()
|
|
"Enter discoursel."
|
|
(interactive)
|
|
(switch-to-buffer (discoursel-get-create-buffer))
|
|
(unless (eq major-mode 'discoursel-mode)
|
|
(discoursel-mode))
|
|
(setq buffer-invisibility-spec nil)
|
|
(discoursel-update))
|
|
|
|
|
|
;; TODO
|
|
;; (with-current-buffer (get-buffer-create "test-discourse")
|
|
;; (insert (plz 'get "https://discourse.ubuntu.com/raw/39765"))
|
|
;; (markdown-mode)
|
|
;; (setq buffer-read-only t))
|
|
|
|
;; (with-current-buffer (get-buffer-create "test-discourse4")
|
|
;; (let* ((ttt (plz 'get "https://discourse.ubuntu.com/latest.json" :as #'json-read))
|
|
;; (topics (alist-get 'topics (alist-get 'topic_list ttt)))
|
|
;; (users (alist-get 'users ttt)))
|
|
;; (cl-map 'vector
|
|
;; (lambda (topic)
|
|
;; (let* ((uid (alist-get 'user_id (aref (alist-get 'posters topic) 0)))
|
|
;; (user (seq-find (lambda (v) (= (alist-get 'id v) uid))
|
|
;; users)))
|
|
;; (insert
|
|
;; (propertize (format "%s [%s]\n" (alist-get 'title topic) (alist-get 'name user))
|
|
;; 'discoursel-slug (alist-get 'slug topic)))))
|
|
;; topics)))
|
|
|
|
|
|
|
|
(provide 'discoursel)
|
|
|
|
;;; discoursel.el ends here
|