;;; wiki-engine.el -- client to wiki engines -*- lexical-binding: t -*- ;; Copyright (C) 2023 Free Software Foundation, Inc. ;; Author: Yuchen Pei ;; This file is part of wiki.el. ;; wiki.el is free software: you can redistribute it and/or modify it under ;; the terms of the GNU Affero General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; wiki.el is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General ;; Public License for more details. ;; You should have received a copy of the GNU Affero General Public ;; License along with wiki.el. If not, see . ;;; Commentary: ;; client to wiki engines, wiki server software. Each engine defines ;; how Emacs interacts with the remote server, including how to ;; construct a url to fetch from. ;;; Code: (require 'wiki-utils) (require 'wiki-markup) (require 'generic-search) ;; TODO: make this a defcustom (defvar wiki-default-engine 'mediawiki "The default wiki engine, when one is not supplied.") (defun wiki-engine-html-url (site title) "Return the url of the html webpage of TITLE on SITE." (format "%s/%s" (wiki-engine-compute-base-url (alist-get site wiki-sites)) title)) (defun wiki-current-html-url () "Return the url of the html webpage of the current wiki buffer." (unless (and wiki-site wiki-title) (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))))) (with-current-buffer (get-buffer-create wiki-client-buffer-name) (goto-char (point-max)) (insert "[" (current-time-string) "] Request: " url "\n")) (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." (with-current-buffer wiki-client-buffer-name (insert "[" (current-time-string) "] Response: " (if (plist-get status :error) (format "%s" (car (last (plist-get status :error)))) "200") "\n")) (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-compute-engine (site-info) "Return :engine of SITE-INFO, or the default engine." (or (plist-get site-info :engine) wiki-default-engine)) (defun wiki-engine-compute-display-name (site-id site-info) "Return :display-name of SITE-INFO, or the default from SITE-ID." (or (plist-get site-info :display-name) (let ((name (replace-regexp-in-string "-" " " (capitalize (format "%s" site-id))))) (if (string-suffix-p " Wiki" name) name (format "%s Wiki" name))))) (defun wiki-engine-compute-base-url (site-info) "Return :base-url of SITE-INFO, or engine-specific default." (or (plist-get site-info :base-url) (let ((host (plist-get site-info :host))) (pcase (wiki-engine-compute-engine site-info) ('mediawiki (format "%s/wiki" host)) ('moinmoin host) ('oddmuse (format "%s/wiki" host)) (_ (error "Unknown engine: %s" engine)))))) (defun wiki-engine-compute-api-base-url (site-info) "Return :api-base-url of SITE-INFO, or engine-specific default." (or (plist-get site-info :api-base-url) (let ((host (plist-get site-info :host))) (pcase (wiki-engine-compute-engine site-info) ('mediawiki (format "%s/w" host)) ('moinmoin (error "API not supported for engine: %s" engine)) ('oddmuse (error "API not supported for engine: %s" engine)) (_ (error "Unknown engine: %s" engine)))))) (defun wiki-engine-compute-fetcher (site-info) "Return :fetcher of SITE-INFO, or default." (or (plist-get site-info :fetcher) 'wiki-engine-simple-fetch)) (defun wiki-engine-wiki-url (site title) "Construct the url to fetch wiki of TITLE from SITE." (let* ((site-info (alist-get site wiki-sites)) (engine (wiki-engine-compute-engine site-info)) (base-url (wiki-engine-compute-base-url site-info))) (pcase engine ('mediawiki (format "%s/%s?action=raw" base-url title)) ('moinmoin (format "%s/%s?action=raw" base-url title)) ('oddmuse (format "%s?action=download;id=%s" base-url title)) (_ (error "Unknown engine: %s" engine))))) (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 (wiki-engine-compute-engine (alist-get site-id wiki-sites))) (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 (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)))))) (defun wiki-engine-mediawiki-api-wiki (api-base-url title) "Fetch the wikitext of TITLE using json api. API-BASE-URL is the base url for the api request." (wiki-url-fetch-json (format "%s/api.php?action=query&format=json&titles=%s&prop=revisions&rvprop=content&rvslots=main" api-base-url 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 (wiki-engine-compute-engine (alist-get site-id wiki-sites))) (api-base-url (wiki-engine-compute-api-base-url (alist-get site-id wiki-sites))) (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-engine-mediawiki-api-wiki api-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) "Find local TITLE in DIR. Do not switch to buffer. 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'." (interactive (list (read-file-name "Find wiki file: "))) (unless dir (setq dir default-directory)) (let ((file-name (expand-file-name (concat title wiki-extension) dir))) (when (or (file-exists-p file-name) create-if-not-exists) (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 wiki-define-site-commands () "Defines all wiki fetcher functions." (cons 'progn (mapcar (lambda (pair) (pcase-let ((`(,id . ,info) pair)) (let ((engine-fetcher (wiki-engine-compute-fetcher info))) `(progn (defun ,(wiki-site-fetcher id) (title) (interactive ,(format "sFetch title for %s: " (wiki-engine-compute-display-name id info))) (,engine-fetcher ',id title)) (defun ,(wiki-site-searcher id) (title) (interactive ,(format "sSearch %s for: " (wiki-engine-compute-display-name id info))) (wiki-engine-simple-search ',id title)))))) (seq-filter #'cdr wiki-sites) ))) (wiki-define-site-commands) ;; FIXME: make this work with local wiki, by using say grep-based ;; search. (defun wiki-engine-simple-search (site-id query) "Simple search of QUERY using eww with its default search. SITE-ID is the id of the site." (let ((site-info (alist-get site-id wiki-sites))) (pcase (wiki-engine-compute-engine site-info) ('mediawiki (wiki-engine-mediawiki-search site-id query)) ('local (error "Search not implemented for local engine yet" )) (_ (eww (format "%s site:%s" query (plist-get (alist-get site-id wiki-sites) :host))))))) (defun wiki-engine-mediawiki-api-search (api-base-url query) "Make an API call searching for QUERY. API-BASE-URL is the base url for the api request." (wiki-url-fetch-json (format "%s/api.php?action=query&format=json&list=search&srsearch=%s" api-base-url query))) (defun wiki-engine-mediawiki-search-action (site-id) (lambda (info) (interactive) (funcall (wiki-site-fetcher site-id) (alist-get 'title info)))) (defun wiki-engine-mediawiki-search (site-id query) (let ((api-base-url (wiki-engine-compute-api-base-url (alist-get site-id wiki-sites)))) (generic-search-open (alist-get 'search (alist-get 'query (wiki-engine-mediawiki-api-search api-base-url query))) (format "%s-query:%s" site-id query) `((formatter . wiki-engine-mediawiki-format-query-result) (default-action . ,(wiki-engine-mediawiki-search-action site-id)) (keymap . ,my-wikipedia-button-keymap))))) (defun wiki-engine-mediawiki-format-query-result (result) (concat (format "%s (%d words)" (alist-get 'title result) (alist-get 'wordcount result)) (propertize (format "\n\n%s" (wiki-mediawiki-highlight-snippet-matches (alist-get 'snippet result))) 'face 'default))) (defun wiki-mediawiki-highlight-snippet-matches (snippet) (with-temp-buffer (insert snippet) (goto-char (point-min)) (while (re-search-forward "\\(.*?\\)" nil t) (replace-match (propertize (match-string 1) 'face 'match))) (buffer-string))) (defun wiki-open-url (url) "Open the raw wiki corresponding to the URL of a html wiki page. If URL points to html title, open the corresponding raw title." (interactive "sURL: ") (when-let ((found-site (seq-find (lambda (site-pair) (when-let ((base-url (wiki-engine-compute-base-url (cdr site-pair)))) (string-prefix-p (format "%s/" base-url) url))) wiki-sites))) (pcase-let ((`(,site-id . ,site-info) found-site)) (funcall (wiki-site-fetcher site-id) (string-remove-prefix (format "%s/" (wiki-engine-compute-base-url site-info)) url)))) ) (provide 'wiki-engine) ;;; wiki-engine.el ends here