Add a mediawiki API fetcher.

Applicable to wikihow. Also clean up the code to reduce duplication
with fetching and finding files. And fix when the wiki entry is under
a directory naming itself which is common in mediawiki: both foo and
foo/bar could be a valid wiki title. So locally files need to have an
extension (by default .wiki). Also add the extension to
auto-mode-alist.

4 files changed, 185 insertions, 131 deletions

diff --git a/README.org b/README.org
index c2ae3b0..32e2b50 100644
--- a/README.org
+++ b/README.org
@@ -47,7 +47,7 @@ Currently supported features:
 
 * Install and use
   :PROPERTIES:
-  :UPDATED:  [2023-07-23 Sun 18:12]
+  :UPDATED:  [2023-07-23 Sun 22:25]
   :END:
 
 Clone, require, M-x:
@@ -69,7 +69,7 @@ Some entry points:
   sites in the alist ~wiki-sites~. For example
   - M-x ~wiki-wikipedia-en-fetch~ RET Emacs RET
   - M-x ~wiki-parabolawiki-fetch~ RET Installation Guide RET
-  - M-x ~wiki-libreplanet-fetch~ RET Group:Freedom Ladder RET
+  - M-x ~wiki-libreplanet-fetch~ RET Activism Guide RET
   - M-x ~wiki-emacswiki-fetch~ RET SandBox RET
 - ~wiki-open-url~: fetches a title from a url. Example:
   - M-x ~wiki-open-url~ RET https://libreplanet.org/wiki/Group_talk:Freedom_Ladder RET
diff --git a/wiki-engine.el b/wiki-engine.el
index c4de2e7..8f666ef 100644
--- a/wiki-engine.el
+++ b/wiki-engine.el
@@ -40,6 +40,39 @@
     (error "Nil wiki-site or wiki-title!"))
   (wiki-engine-html-url wiki-site wiki-title))
 
+(defun wiki-fetch-url (url title &optional dir callback)
+  "Fetch URL asynchronously to a file in DIR.
+
+Then call CALLBACK which is a closure taking no argument.
+
+A non-nil TITLE overrides title inferred from the url."
+  (let ((cb (lambda (status)
+              (wiki-save-fetched-and-switch status title dir)
+              (when callback (funcall callback)))))
+    (url-retrieve url cb))
+  )
+
+(defun wiki-save-string-and-switch (to-insert title dir)
+  "Insert string TO-INSERT to TITLE under DIR and switch to buffer."
+  (let ((buffer (wiki-find-file title dir t))
+        (coding-system-for-write 'utf-8))
+    (with-current-buffer buffer
+      (insert to-insert)
+      (goto-char (point-min))
+      (save-buffer)
+      (revert-buffer t t))
+    (switch-to-buffer buffer)))
+
+(defun wiki-save-fetched-and-switch (status title dir)
+  "If STATUS is ok, insert response payload to TITLE under DIR.
+
+And switch to the corresponding buffer."
+  (when (plist-get status :error)
+    (error "Wiki fetch failed: %s" (plist-get status :error)))
+  (wiki-delete-http-header)
+  (let ((to-insert (buffer-string))
+        (_ (kill-buffer)))
+    (wiki-save-string-and-switch to-insert title dir)))
 
 (defun wiki-engine-wiki-url (site title)
   "Construct the url to fetch wiki of TITLE from SITE."
@@ -52,102 +85,86 @@
       ('oddmuse (format "%s?action=download;id=%s" base-url title))
       (_ (error "Unknown engine: %s" engine)))))
 
-(defun wiki-engine-mediawiki-fetch (site-id title)
-  "Fetch a mediawiki entry describing TITLE.
-
-The site handle is passed as a symbol SITE-ID."
-  (let ((wiki-site-info (alist-get site-id wiki-sites)))
-    (cl-assert (eq (plist-get wiki-site-info :engine) 'mediawiki))
-    (when (string-empty-p title) (setq title "Main Page"))
-    (unless (and wiki-fetch-prefer-local
-                 (wiki-find-file
-                  title
-                  (wiki-locate-dir site-id)))
-      (wiki-fetch-url
-       (format "%s%s?action=raw"
-               (plist-get wiki-site-info :base-url)
-               title)
-       (wiki-locate-dir site-id)
-       (lambda ()
-         (wiki-mode)
-         (setq-local wiki-site site-id
-                     wiki-title title)
-         )
-       ))))
-
-(defun wiki-engine-oddmuse-fetch (site-id title)
-  "Fetch an oddmuse entry describing TITLE.
-
-The site handle is passed as a symbol SITE-ID."
-  (let ((wiki-site-info (alist-get site-id wiki-sites)))
-    (cl-assert (eq (plist-get wiki-site-info :engine) 'oddmuse))
-    (unless (and wiki-fetch-prefer-local
-                 (wiki-find-file
-                  title
-                  (wiki-locate-dir site-id)))
+(defun wiki-engine-simple-fetch (site-id title)
+  "A simple method to fetch TITLE from site with SITE-ID.
+
+If the site has a `local' engine, \"fetch\" locally. Otherwise,
+if `wiki-fetch-prefer-local' is non-nil, try fetching locally,
+and if the title cannot be found locally, fetch remotely."
+  (when (string-empty-p title) (setq title "Main Page"))
+  (let* ((engine (plist-get (alist-get site-id wiki-sites) :engine))
+         (found-local
+          (when (or wiki-fetch-prefer-local (eq engine 'local))
+            (wiki-find-file title (wiki-locate-dir site-id)
+                            (eq engine 'local)))))
+    (if found-local
+        (switch-to-buffer found-local)
       (wiki-fetch-url
-       (format "%s?action=download;id=%s"
-               (plist-get wiki-site-info :base-url)
-               title)
+       (wiki-engine-wiki-url site-id title)
+       title
        (wiki-locate-dir site-id)
        (lambda ()
          (wiki-mode)
          (setq-local wiki-site site-id
-                     wiki-title title)
-         )
-       title))))
-
-(defun wiki-engine-moinmoin-fetch (site-id title)
-  "Fetch a moinmoin entry describing TITLE.
-
-The site handle is passed as a symbol SITE-ID."
-  (let ((wiki-site-info (alist-get site-id wiki-sites)))
-    (cl-assert (eq (plist-get wiki-site-info :engine) 'moinmoin))
-    (unless (and wiki-fetch-prefer-local
-                 (wiki-find-file
-                  title
-                  (wiki-locate-dir site-id)))
-      (wiki-fetch-url
-       (format "%s%s?action=raw"
-               (plist-get wiki-site-info :base-url)
-               title)
-       (wiki-locate-dir site-id)
-       (lambda ()
-         (wiki-mode)
-         (setq-local wiki-site site-id
-                     wiki-title title))
-       title))))
+                     wiki-title title))))))
+
+(defun wiki-engine-mediawiki-api-fetch (site-id title)
+  "Fetch TITLE from site with SITE-ID using mediawiki api."
+  (when (string-empty-p title) (setq title "Main Page"))
+  (let* ((engine (plist-get (alist-get site-id wiki-sites) :engine))
+         (base-url (plist-get (alist-get site-id wiki-sites) :base-url))
+         (found-local
+          (when (or wiki-fetch-prefer-local (eq engine 'local))
+            (wiki-find-file title (wiki-locate-dir site-id)
+                            (eq engine 'local)))))
+    (if found-local
+        (switch-to-buffer found-local)
+      (wiki-save-string-and-switch
+       (alist-get
+        '* (alist-get
+            'main (alist-get
+                   'slots (elt
+                           (alist-get
+                            'revisions
+                            (cdr
+                             (car
+                              (alist-get
+                               'pages (alist-get
+                                       'query
+                                       (wiki-url-fetch-json
+                                        (format
+                                         "%sapi.php?action=query&titles=%s&prop=revisions&rvprop=content&rvslots=main&format=json"
+                                         base-url
+                                         title)
+                                        ))))))
+                           0))))
+       title
+       (wiki-locate-dir site-id))
+      (wiki-mode)
+      (setq-local wiki-site site-id
+                  wiki-title title))))
 
 (defun wiki-locate-dir (site-id)
   "Locate the directory for a SITE-ID."
   (expand-file-name (format "%s" site-id) wiki-local-dir))
 
-(defun wiki-find-file (title &optional dir create-if-not-exists
-                             extension)
-  "Find local TITLE in DIR.
+(defun wiki-find-file (title &optional dir create-if-not-exists)
+  "Find local TITLE in DIR. Do not switch to buffer.
 
-Returns the file-name if success, and nil otherwise. If
+Return the buffer if success, and nil otherwise. If
 CREATE-IF-NOT-EXISTS is non-nil, creates the file is not found.
-DIR defaults to `default-directory'.
-EXTENSION is the file extension."
+DIR defaults to `default-directory'."
   (interactive (list (read-file-name "Find wiki file: ")))
   (unless dir (setq dir default-directory))
   (let ((file-name (expand-file-name
-                    (if extension
-                        (file-name-extension title extension)
-                      title)
+                    (concat title wiki-extension)
                     dir)))
     (when (or (file-exists-p file-name) create-if-not-exists)
-      (find-file file-name)
-      (wiki-mode)
-      file-name)))
-
-(defalias #'wiki-local-fetch #'wiki-find-file)
-
-(defun wiki-engine-fetcher (wiki-site-info)
-  "Return the fetcher for the engine of WIKI-SITE-INFO."
-  (intern (format "wiki-engine-%s-fetch"
-                  (plist-get wiki-site-info :engine))))
+      (setq dir (file-name-directory file-name))
+      (unless (file-exists-p dir) (make-directory dir t))
+      (with-current-buffer (find-file-noselect file-name)
+        (wiki-mode)
+        (buffer-name)))))
 
 (defmacro defun-wiki-fetchers ()
   "Defines all wiki fetcher functions."
@@ -155,12 +172,14 @@ EXTENSION is the file extension."
         (mapcar
          (lambda (pair)
            (pcase-let ((`(,id . ,info) pair))
-             `(defun ,(wiki-site-fetcher id) (title)
-                (interactive ,(format "sFetch title for %s: "
-                                      (plist-get info :display-name)))
-                (,(wiki-engine-fetcher info) ',id title))))
-         (seq-filter #'cdr
-                     wiki-sites)
+             (let ((engine-fetcher
+                    (or (plist-get info :fetcher)
+                        'wiki-engine-simple-fetch)))
+               `(defun ,(wiki-site-fetcher id) (title)
+                  (interactive ,(format "sFetch title for %s: "
+                                        (plist-get info :display-name)))
+                  (,engine-fetcher ',id title)))))
+         (seq-filter #'cdr wiki-sites)
          )))
 
 (defun-wiki-fetchers)
diff --git a/wiki-markup.el b/wiki-markup.el
index 4809695..61cdca8 100644
--- a/wiki-markup.el
+++ b/wiki-markup.el
@@ -90,8 +90,13 @@ This can be overriden with .dir-locals.el."
   (unless wiki-site
     (setq-local wiki-site
                 (let ((guessed
-                       (intern (file-name-base
-                                (directory-file-name default-directory)))))
+                       (intern (replace-regexp-in-string
+                                (format
+                                 "%s/\\(.+?\\)/.*"
+                                 (regexp-quote
+                                  (expand-file-name wiki-local-dir)))
+                                "\\1"
+                                default-directory))))
                   (if (alist-get guessed wiki-sites)
                       guessed
                     'local))))
diff --git a/wiki-utils.el b/wiki-utils.el
index 0e204b1..61357d2 100644
--- a/wiki-utils.el
+++ b/wiki-utils.el
@@ -25,6 +25,7 @@
 
 ;;; Code:
 (require 'url-parse)
+(require 'json)
 
 (defvar wiki-local-dir (locate-user-emacs-file "wiki")
   "Path to local directory of wiki files.")
@@ -32,40 +33,17 @@
 (defvar wiki-fetch-prefer-local t
   "If non-nil, visit the local file if exists when fetching.")
 
-(defun wiki-fetch-url (url dir &optional callback title)
-  "Fetch URL asynchronously to a file in DIR.
-
-Then call CALLBACK which is a closure taking no argument.
-
-A non-nil TITLE overrides title inferred from the url."
-  (interactive "sURL: ")
-  (let ((file-name (expand-file-name
-                    (or title (wiki-make-file-name-from-url url))
-                    dir))
-        (cb (lambda (status file-name)
-              (wiki-fetch-url-save-and-switch status file-name)
-              (when callback (funcall callback)))))
-    (url-retrieve url cb (list file-name)))
-  )
-
-(defun wiki-fetch-url-save-and-switch (status file-name)
-  "Fetch url to FILE-NAME if STATUS is ok.
-
-And switch to the corresponding buffer."
-  (when (plist-get status :error)
-    (error "Wiki fetch failed: %s" (plist-get status :error)))
-  (wiki-delete-http-header)
-  (let ((to-insert (buffer-string))
-        (buffer (find-file-noselect file-name))
-        (coding-system-for-write 'utf-8))
-    (kill-buffer)
-    (with-current-buffer buffer
-      (insert to-insert)
-      (goto-char (point-min))
-      (save-buffer)
-      (revert-buffer t t))
-    (switch-to-buffer buffer))
-  )
+(defvar wiki-extension ".wiki"
+  "The extension of local wiki files.")
+
+(add-to-list 'auto-mode-alist
+             `(,(format "\\%s\\'" wiki-extension) . wiki-mode))
+
+(defun wiki-kill-http-header ()
+  "Kill the http header in current buffer.
+
+Assuming the current buffer to be a `url-retrieve' response buffer."
+  (kill-region (point-min) (progn (wiki-skip-http-header) (point))))
 
 (defun wiki-delete-http-header ()
   "Delete the http header in current buffer.
@@ -80,14 +58,7 @@ Assuming the current buffer to be a `url-retrieve' response buffer."
   (goto-char (point-min))
   (re-search-forward "\r?\n\r?\n"))
 
-(defun wiki-make-file-name-from-url (url)
-  "Make a file name from URL."
-  (file-name-nondirectory
-   (directory-file-name
-    (car (url-path-and-query (url-generic-parse-url
-                              (url-unhex-string url)))))))
-
-;; TODO: add wikihow; generalise fandom
+;; TODO: generalise fandom
 ;; TODO: default engine to mediawiki
 (defvar wiki-sites
   '((local)
@@ -134,6 +105,10 @@ Assuming the current buffer to be a `url-retrieve' response buffer."
      :base-url "https://help.ubuntu.com/community/"
      :engine moinmoin
      :display-name "Ubuntu Community Help Wiki")
+    (wikihow :base-url "https://www.wikihow.com/"
+             :engine mediawiki
+             :display-name "wikiHow"
+             :fetcher wiki-engine-mediawiki-api-fetch)
     (wikiindex :base-url "https://wikiindex.org/"
                :engine mediawiki
                :display-name "WikiIndex")
@@ -162,5 +137,60 @@ One of the sites is (local), meaning a local filesystem.")
       (intern (format "wiki-%s-fetch" site-id))
     'wiki-find-file))
 
+(defvar wiki-client-buffer-name "*wiki api*"
+  "Name of the buffer recording wiki API calls.")
+
+(defun wiki-parse-http-header (text)
+  "Parse the http header TEXT."
+  (let ((status) (fields))
+    (with-temp-buffer
+      (insert text)
+      (goto-char (point-min))
+      (re-search-forward "^HTTP.*\\([0-9]\\{3\\}\\).*$")
+      (setq status (match-string 1))
+      (while (re-search-forward "^\\(.*?\\): \\(.*\\)$" nil t)
+        (push (cons (intern (match-string 1)) (match-string 2)) fields)))
+    (list (cons 'status status) (cons 'fields fields))))
+
+(defun wiki-url-fetch-internal (url processor &optional
+                                    decompression with-header)
+  "Fetch from URL and process the response payload using PROCESSOR.
+
+PROCESSOR is a function that takes no argument and processes the
+current buffer.
+With non-nil DECOMPRESSION, decompress the response.
+With non-nil WITH-HEADER, include the header in the result."
+  (with-current-buffer (get-buffer-create wiki-client-buffer-name)
+    (goto-char (point-max))
+    (insert "[" (current-time-string) "] Request: " url "\n"))
+  (with-current-buffer (url-retrieve-synchronously url t)
+    (let ((header) (status) (fields))
+      (wiki-kill-http-header)
+      (goto-char (point-min))
+      (setq header (wiki-parse-http-header (car kill-ring))
+            status (alist-get 'status header)
+            fields (alist-get 'fields header))
+      (with-current-buffer wiki-client-buffer-name
+        (insert "[" (current-time-string) "] Response: " status "\n"))
+      (when decompression
+        (call-process-region (point) (point-max) "gunzip" t t t)
+        (goto-char (point-min)))
+      (call-interactively 'delete-trailing-whitespace)
+      (if (string= status "200")
+          (unless (= (point) (point-max))
+            (if with-header
+                (list
+                 (cons 'header fields)
+                 (cons 'json (funcall processor)))
+              (funcall processor)))
+        (error "HTTP error: %s" (buffer-substring (point) (point-max)))))))
+
+(defun wiki-url-fetch-json (url &optional decompression with-header)
+  "Fetch and parse a json object from URL.
+
+With non-nil DECOMPRESSION, decompress the response.
+With non-nil WITH-HEADER, include the header in the result."
+  (wiki-url-fetch-internal url 'json-read decompression with-header))
+
 (provide 'wiki-utils)
 ;;; wiki-utils.el ends here