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 "