diff --git a/discoursel.el b/discoursel.el index b5d344d..6a96750 100644 --- a/discoursel.el +++ b/discoursel.el @@ -5,11 +5,18 @@ (require 'plz) (require 'message) (require 'rx) +(require 'markdown-mode) (defgroup discoursel nil "Discourse TODO") -(defcustom discoursel-instance "https://discourse.ubuntu.com" +(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) @@ -55,49 +62,102 @@ posts manually and incrementally." (add-text-properties p (point) '(pre-tag t face discoursel-code-face)))) -(defun discoursel--get (endpoint &optional args) +(defun discoursel--get (instance endpoint &optional args) (condition-case plzerror - (plz 'get (concat discoursel-instance "/" endpoint ".json" - (when args - (concat "?" - (mapconcat (lambda (elt) - (concat (car elt) "=" (cdr elt))) - args "&")))) - :as #'json-read) + (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--latest-topics () - (let* ((r (discoursel--get "latest")) - (topics (alist-get 'topics (alist-get 'topic_list r))) - (users (alist-get 'users r))) - (with-current-buffer (discoursel-get-create-buffer) - (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)))) +(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)))) -;;;###autoload (defun discoursel-update () (interactive) (with-current-buffer (discoursel-get-create-buffer) (save-excursion (let ((inhibit-read-only t)) - (discoursel--latest-topics))))) + (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))) @@ -125,11 +185,11 @@ characters." (interactive) (let ((pos (point))) (save-excursion - (setq pos (next-single-char-property-change pos 'post-id)) + (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 'post-id)) + (setq pos (next-single-char-property-change pos 'discoursel-post-id)) (goto-char pos)) (when (eobp) (setq pos nil))) @@ -139,65 +199,60 @@ characters." (defun discoursel-topic-previous-entry () (interactive) (let ((pos (point))) - (setq pos (or (previous-single-property-change pos 'post-id) + (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 'post-id) + (setq pos (or (previous-single-property-change pos 'discoursel-post-id) (point-min))) (goto-char pos)))) -(defun discoursel--insert-post (post &optional post-title) +(defun discoursel--insert-post (instance 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-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 (discoursel--get-name-or-username post)) - (post-html-content (alist-get 'cooked post))) + (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)))))) -;; (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) +(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)) @@ -213,24 +268,28 @@ characters." (insert "
") (shr-render-region (point-min) (point-max)) (buffer-string))) - (discoursel--insert-post (aref posts idx)))))))) + (discoursel--insert-post instance (aref posts idx)))))))) -(defun discoursel--fetch-all-posts-from-topic (topic-id number-of-pages) +(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 (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 ((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 id) +(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* ((topic-id (number-to-string + (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 (concat "t/" 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)) @@ -244,16 +303,60 @@ characters." (save-excursion (let ((inhibit-read-only t)) (erase-buffer) - (discoursel--insert-post first-post topic-title) - (discoursel-render-posts-from-topic topic 1) + (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 topic-id number-of-pages) - (message "TODO")))))))) + (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-open-topic (id) - (interactive "nTopic ID: ") - (discoursel--open-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" @@ -290,6 +393,7 @@ characters." (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'.") @@ -302,9 +406,16 @@ characters." (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}" @@ -315,12 +426,18 @@ characters." \\{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))