Implement support for fetching all pages

Still have to implement support for incrementally fetching pages by
hand, though.

Signed-off-by: Sergio Durigan Junior <sergiodj@sergiodj.net>

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,19 +47,22 @@
   :group 'discoursel)
 
 (defun discoursel--parse-pre (tag)
-  (insert
+  (let ((p (point))
-   (with-temp-buffer
+	(shr-folding-mode 'none))
-     (let ((shr-folding-mode 'none))
     (shr-ensure-newline)
     (shr-generic tag)
-       (shr-ensure-newline))
+    (shr-ensure-newline)
-     (add-text-properties (point-min) (point-max)
+    (add-text-properties p (point)
-			  '(pre-tag t face discoursel-code-face))
+			 '(pre-tag t face discoursel-code-face))))
-     (buffer-string))))
 
-(defun discoursel--get (endpoint)
+(defun discoursel--get (endpoint &optional args)
   (condition-case plzerror
-      (plz 'get (concat discoursel-instance "/" endpoint ".json")
+      (plz 'get (concat discoursel-instance "/" endpoint ".json"
+			(when args
+			  (concat "?"
+				  (mapconcat (lambda (elt)
+					       (concat (car elt) "=" (cdr elt)))
+					     args "&"))))
 	:as #'json-read)
     (plz-error
      (error "Could not query endpoint '%s': '%s'"
@@ -80,55 +95,161 @@
 (defun discoursel-update ()
   (interactive)
   (with-current-buffer (discoursel-get-create-buffer)
+    (save-excursion
       (let ((inhibit-read-only t))
-      (discoursel--latest-topics))))
+	(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)))))
 
 (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)))
+	 (topic (discoursel--get (concat "t/" topic-id)))
-	 (posts (alist-get 'posts (alist-get 'post_stream r)))
+	 (posts (alist-get 'posts (alist-get 'post_stream topic)))
 	 (first-post (aref posts 0))
-	 (topic-slug (get-text-property (point) 'discoursel-topic-slug))
+	 (topic-slug (alist-get 'slug topic))
-	 (topic-title (alist-get 'title r))
+	 (topic-title (alist-get 'title topic))
-	 (topic-date (alist-get 'created_at r))
+	 (buf (discoursel-get-create-buffer topic-slug))
-	 (topic-date-string
+	 (number-of-pages (ceiling (/ (float (alist-get 'posts_count topic))
-	  (format-time-string "%c"
+				      (float (alist-get 'chunk_size topic))))))
-			      (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)
-	(save-excursion
+	  (discoursel--insert-post first-post topic-title)
-	  (insert
+	  (discoursel-render-posts-from-topic topic 1)
-	   (with-temp-buffer
+	  (when (> number-of-pages 1)
-	     (insert (format (propertize "Title: %s\n" 'face 'message-header-name)
+	    (if discoursel-fetch-all-posts-from-topic
-			     (propertize topic-title 'face 'message-header-subject)))
+		(discoursel--fetch-all-posts-from-topic topic-id number-of-pages)
-	     (insert (format (propertize "Author: %s\n" 'face 'message-header-name)
+	      (message "TODO"))))))))
-			     (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: ")
@@ -177,8 +298,10 @@
   (let ((map (make-sparse-keymap)))
     (prog1 map
       (suppress-keymap map)
-      (define-key map "n" #'discoursel-topic-next-post)
+      (define-key map "n" #'next-line)
-      (define-key map "p" #'discoursel-topic-previous-post)
+      (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'.")