diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/servall-client.el | 50 | ||||
| -rw-r--r-- | lisp/servall-wikipedia.el | 102 |
2 files changed, 152 insertions, 0 deletions
diff --git a/lisp/servall-client.el b/lisp/servall-client.el new file mode 100644 index 0000000..2c6dd17 --- /dev/null +++ b/lisp/servall-client.el @@ -0,0 +1,50 @@ +;; -*- lexical-binding: t; -*- + +(defvar servall-endpoint "localhost:5555") +(defvar servall-client-buffer-name "*servall-client*") + +(defun servall-api-wikipedia-search (query) + (servall-url-fetch-json + (concat servall-endpoint "/wikipedia/search/" query))) + +(defun servall-api-wikipedia-org (name) + (servall-url-fetch-json + (concat servall-endpoint "/wikipedia/org/" name))) + +(defun servall-parse-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 servall-url-fetch-json (url &optional decompression with-header) + (with-current-buffer (get-buffer-create servall-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) (json)) + (delete-http-header) + (setq header (servall-parse-http-header (car kill-ring)) + status (alist-get 'status header) + fields (alist-get 'fields header)) + (with-current-buffer servall-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 (json-read))) + (json-read))) + (error "HTTP error: %s" (buffer-substring (point) (point-max))))))) + +(provide 'servall-client) diff --git a/lisp/servall-wikipedia.el b/lisp/servall-wikipedia.el new file mode 100644 index 0000000..978e902 --- /dev/null +++ b/lisp/servall-wikipedia.el @@ -0,0 +1,102 @@ +;; -*- lexical-binding: t; -*- + +(defvar servall-results-mode-map special-mode-map) +(defvar servall-results-buffer "*servall-results*") + +(define-derived-mode servall-results-mode org-mode "servall-results" + "Mode for showing and selecting results" + (setq-local buffer-read-only t + servall-results-update-function nil + servall-results-re-search-function nil + servall-results-open-function nil)) + +(defun servall-results-update () + (interactive) + (funcall servall-results-update-function)) + +(defun servall-results-re-search () + (interactive) + (call-interactively servall-results-re-search-function)) + +(defun servall-results-open () + (interactive) + (funcall servall-results-open-function)) + +(define-key servall-results-mode-map "n" 'org-next-visible-heading) +(define-key servall-results-mode-map "g" 'servall-results-update) +(define-key servall-results-mode-map "\r" 'servall-results-open) +(define-key servall-results-mode-map "p" 'org-previous-visible-heading) +(define-key servall-results-mode-map "s" 'servall-results-re-search) + +(define-derived-mode servall-wikipedia-results-mode servall-results-mode + "servall-wikipedia-results" + "Mode for showing and selecting wikipedia results" + (setq-local servall-wikipedia-results-query nil)) + +(defun servall-wikipedia-results-highlight () + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "<span class=\"searchmatch\">\\(.*?\\)</span>" nil t) + (replace-match + (propertize (match-string 1) 'font-lock-face 'match))))) + +(defun servall-wikipedia-results-update () + (let* ((resp (servall-api-wikipedia-search servall-wikipedia-results-query)) + (results (alist-get 'search + (alist-get 'query resp))) + (inhibit-read-only t)) + (erase-buffer) + (mapc + (lambda (result) + (let ((title (alist-get 'title result))) + (insert + (propertize + (concat "* " title "\n") + 'title title)) + (insert (alist-get 'snippet result) "\n\n"))) + results) + (servall-wikipedia-results-highlight) + (goto-char (point-min)))) + +(defun servall-wikipedia-search (query) + (interactive "sWikipedia Query: ") + (with-current-buffer (get-buffer-create servall-results-buffer) + (servall-wikipedia-results-mode) + (setq servall-wikipedia-results-query query + servall-results-update-function 'servall-wikipedia-results-update + servall-results-re-search-function 'servall-wikipedia-search + servall-results-open-function 'servall-wikipedia-results-open) + (servall-results-update)) + (switch-to-buffer servall-results-buffer)) + +(defun servall-wikipedia-results-open () + (when-let ((title (get-text-property (point) 'title))) + (switch-to-buffer-other-window (servall-wikipedia-load title)))) + +(defun servall-wikipedia-to-name (title) + (replace-regexp-in-string " " "_" title)) + +(defvar servall-wikipedia-view-mode-map special-mode-map) +(defun servall-wikipedia-view-buffer (title) + (format "*wikipedia %s*" title)) + +(defvar servall-wikipedia-view-mode-map special-mode-map) + +(define-derived-mode servall-wikipedia-view-mode org-mode + "servall-wikipedia-view" + "Mode for viewing wikipedia entries." + (setq-local buffer-read-only t + servall-wikipedia-title nil)) + +(defun servall-wikipedia-load (title) + (let ((buffer (get-buffer-create (servall-wikipedia-view-buffer title)))) + (with-current-buffer buffer + (servall-wikipedia-view-mode) + (setq servall-wikipedia-title title) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (servall-api-wikipedia-org title))) + (goto-char (point-min))) + buffer)) + +(provide 'servall-wikipedia) |