diff --git a/discoursel.el b/discoursel.el index 0baafdf..bd8d4f6 100644 --- a/discoursel.el +++ b/discoursel.el @@ -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)) - (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)))) + (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 (endpoint) (condition-case plzerror @@ -80,20 +90,119 @@ (defun discoursel-update () (interactive) (with-current-buffer (discoursel-get-create-buffer) - (let ((inhibit-read-only t)) - (discoursel--latest-topics)))) + (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 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) - (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))))))))) + (save-excursion + (let ((inhibit-read-only t)) + (erase-buffer) + (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 "
") + (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'.")