diff options
-rw-r--r-- | README.org | 4 | ||||
-rw-r--r-- | wiki-engine.el | 189 | ||||
-rw-r--r-- | wiki-markup.el | 9 | ||||
-rw-r--r-- | wiki-utils.el | 114 |
4 files changed, 185 insertions, 131 deletions
@@ -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 |