├── README.org ├── tests └── wallabag-test.el ├── wombag-db.el ├── wombag-heading.el ├── wombag-options.el ├── wombag-search.el ├── wombag-show.el └── wombag.el /README.org: -------------------------------------------------------------------------------- 1 | #+title: Wombag - A Wallabag client for Emacs 2 | #+options: h:5 num:nil toc:nil 3 | 4 | #+html:

5 | 6 | # #+html:

43 | 44 | - Press =s= to search for articles, =?= for help when searching. 45 | - Sync with the server with =wombag-sync= (=G=). 46 | - You can archive (=A=), star (=F=), tag (=+=) or delete (=D=) entries. 47 | - Removing tags is not supported yet. 48 | 49 | ** Anywhere in Emacs 50 | 51 | To add a URL to Wallabag, you can run =M-x wombag-add-entry=. 52 | 53 | * Quality of life features 54 | 55 | Wombag provides a few QoL features. 56 | 57 | *** Full-featured text search 58 | 59 | You can filter the search listing incrementally using any combination of criteria. 60 | 61 | In this demo I filter the listing to articles that mention /Julia/ in the title, added between /2021/ and /2023/, are not archived, and contain the text /automatic differentiation/: 62 | 63 | # #+begin_export html 64 | #

66 | # #+end_export 67 | 68 | #+html:

69 | https://github.com/karthink/gptel/assets/8607532/3fa5b41f-4b18-416c-b4d4-7c314603d037 70 | #+html:

71 | 72 | # https://github-production-user-asset-6210df.s3.amazonaws.com/8607532/280438599-3fa5b41f-4b18-416c-b4d4-7c314603d037.mp4 73 | 74 | You can search by text, tags, title, author, URL, date published, date added, starred/archived status and more. 75 | 76 | *** Saves your place 77 | 78 | Wombag saves your place in articles. You can also show only partly-read articles when searching (press =?=), or call =M-x wombag-resume= from anywhere. 79 | 80 | *** =imenu= support 81 | 82 | Jump between article sections with =imenu=: 83 | 84 | # #+attr_html: :width 800px 85 | # [[file:images/wombag-imenu.png]] 86 | 87 | #+html:

88 | 89 | The above image is with =consult-imenu=. Any =imenu=-based command will work (including just =imenu=). 90 | 91 | *** Bookmark support 92 | 93 | You can bookmark search results or individual articles. 94 | 95 | *** TODO Org-link support 96 | 97 | (Not yet implemented) 98 | 99 | * How it works 100 | 101 | Wombag uses a local sqlite database to store your Wallabag entries and Emacs as a front-end. Remote to local syncing is incremental and based on the last sync time. Local changes are propagated to the remote instantaneously and requires an Internet connection. 102 | 103 | * Comparison with [[https://github.com/chenyanming/wallabag.el][wallabag.el]] 104 | 105 | I needed something that could work smoothly with my decades-old reading list of 15K+ articles. I could not get =wallabag.el=, a pre-existing Wallabag client for Emacs, to sync correctly or to work without freezing Emacs. This is a smaller, stripped down rewrite of the package -- no code is shared except for a couple of face definitions. 106 | 107 | - =wallabag.el= has many features Wombag doesn't: annotation support, ivy integration, image caching, bulk action support via marking entries and more customization options. 108 | - Wombag has a 12-25x lower memory footprint, more consistent syncing and graceful error handling, better search and many quality of life features. 109 | 110 | For more information on the differences see [[https://github.com/chenyanming/wallabag.el/issues/21][this thread]]. 111 | 112 | * Known issues 113 | 114 | - Deleting articles from the web interface or a different client will not cause them to be deleted from the local database when syncing. This is a known limitation of the Wallabag API. This can be done by doing a full (as opposed to incremental) sync, which Wombag does not (officially) support. Note that all local changes (including deletions) are always reflected server-side. 115 | 116 | - Removing tags is not implemented due to Wallabag [[https://github.com/wallabag/wallabag/issues/6928][API issues]]. 117 | 118 | * Acknowledgments 119 | 120 | - [[https://github.com/chenyanming][Damon Chan]] for writing wallabag.el, the inspiration for this package. 121 | - [[https://github.com/skeeto][Chris Wellons]] for writing Elfeed, the other inspiration for this package. He also authored =emacsql=, which Wombag uses. 122 | -------------------------------------------------------------------------------- /tests/wallabag-test.el: -------------------------------------------------------------------------------- 1 | (require 'ert) 2 | 3 | (ert-deftest w-db--sanitize-entry-test () 4 | ";TODO:" 5 | (let ((entry '((reading_time . 12) 6 | (created_at . "2023-08-25T05:01:37+0000") 7 | (updated_at . "2023-08-25T05:03:02+0000") 8 | (published_at . "2023-08-23T14:27:54+0000") 9 | (published_by . ["SK Ventures"]) 10 | (starred_at) 11 | (tags . [((id . 2) 12 | (label . "tag1") 13 | (slug . "tag1")) 14 | ((id . 3) 15 | (label . "tag2") 16 | (slug . "tag2"))]) 17 | (annotations . []) 18 | (mimetype . "text/html; charset=utf-8") 19 | (language . "en") 20 | (is_public . :json-false))) 21 | (entry-sanitized '((tag . "tag1,tag2") 22 | (reading_time . 12) 23 | (created_at . "2023-08-25T05:01:37") 24 | (updated_at . "2023-08-25T05:03:02") 25 | (published_at . "2023-08-23T14:27:54") 26 | (published_by . ["SK Ventures"]) 27 | (starred_at) 28 | (tags . [((id . 2) 29 | (label . "tag1") 30 | (slug . "tag1")) 31 | ((id . 3) 32 | (label . "tag2") 33 | (slug . "tag2"))]) 34 | (annotations . []) 35 | (mimetype . "text/html; charset=utf-8") 36 | (language . "en") 37 | (is_public . 0)))) 38 | (should (equal entry-sanitized 39 | (w-db--sanitize-entry entry))))) 40 | 41 | 42 | 43 | 44 | ;; Local Variables: 45 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 46 | ;; End: 47 | -------------------------------------------------------------------------------- /wombag-db.el: -------------------------------------------------------------------------------- 1 | ;;; wombag-db.el --- Wombag database interaction -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; Wombag database interaction 23 | 24 | ;;; Code: 25 | (require 'emacsql) 26 | (require 'emacsql-sqlite) 27 | (require 'map) 28 | (require 'wombag-options) 29 | 30 | (defconst w-db-version 2) 31 | (defvar w-db-connection nil) 32 | (defvar w-search-columns) 33 | 34 | (defvar w-db-open-func 35 | (or (and (fboundp 'sqlite-available-p) 36 | (sqlite-available-p) 37 | (require 'emacsql-sqlite-builtin nil t) 38 | (functionp 'emacsql-sqlite-builtin) 39 | #'emacsql-sqlite-builtin) 40 | (progn (require 'emacsql-sqlite) 41 | #'emacsql-sqlite)) 42 | ;; :type 'function ;; :group 'w-db 43 | "Function for creating the database connection.") 44 | 45 | (defun w-db-ensure () 46 | ";TODO:" 47 | (unless (and w-db-connection (emacsql-live-p w-db-connection)) 48 | (let ((dir (file-name-directory w-db-file))) 49 | (or (file-directory-p dir) (make-directory dir))) 50 | (setq w-db-connection (funcall w-db-open-func w-db-file)) 51 | 52 | (emacsql w-db-connection 53 | [:create-table 54 | :if-not-exists 55 | items ([tag is_archived is_starred 56 | user_name user_email user_id tags 57 | is_public (id integer :primary-key) uid title 58 | url hashed_url origin_url given_url hashed_given_url 59 | (archived_at DATE) content (created_at DATE) 60 | (updated_at DATE) (published_at DATE) published_by 61 | (starred_at DATE) annotations mimetype language reading_time 62 | domain_name preview_picture http_status headers _links])]) 63 | 64 | (emacsql w-db-connection [:create-table :if-not-exists version ([user-version])]) 65 | ;; Note: fetch-new is not currently used for anything 66 | (emacsql w-db-connection [:create-table :if-not-exists last_update ([ (fetch-new INTEGER) (fetch-all INTEGER) ])]) 67 | (unless (emacsql w-db-connection [:select * :from last_update]) 68 | (let ((epoch 1)) 69 | (emacsql w-db-connection `[:insert :into last_update :values ([,epoch ,epoch])]))) 70 | (unless (emacsql w-db-connection [:select user-version :from version]) 71 | (emacsql w-db-connection `[:insert :into version :values ([,w-db-version])]))) 72 | 73 | w-db-connection) 74 | 75 | (defun w-db-update-date (date &optional only-new) 76 | "Update the database with DATE (seconds since epoch) as the last_update time. 77 | 78 | With optional arg ONLY-NEW, update the \\='fetch-new\\=' field: 79 | Currently unused." 80 | (cl-assert (or (floatp date) (integerp date))) 81 | (setq date (floor date)) 82 | (emacsql (w-db-ensure) `[:update last_update 83 | :set (= ,(if only-new 'fetch-new 'fetch-all) ,date)])) 84 | 85 | ;; (w-db-update-date (time-to-seconds (time-subtract (current-time) (days-to-time 1)))) 86 | 87 | (defun w-db--sanitize-entry (entry) 88 | "Transform ENTRY before adding it to the database." 89 | (let ((alltags 90 | (mapconcat (lambda (el) (map-elt el 'label)) 91 | (map-elt entry 'tags) ","))) 92 | ;; Use 0 and 1 instead of :json-false and t for is_public 93 | (when-let ((public (map-elt entry 'is_public))) 94 | (map-put! entry 'is_public (if (eq public t) 1 0))) 95 | (map-put! entry 'headers nil) 96 | ;; ;; Remove timezone info if not in the form "+03:30" or "Z" 97 | ;; (dolist (datetype '(created_at updated_at published_at starred_at archived_at)) 98 | ;; (when-let* ((date (map-elt entry datetype)) 99 | ;; (_ (string-match-p "\\+[[:digit:]]\\{4\\}$" date))) 100 | ;; (map-put! entry datetype (substring date 0 -5)))) 101 | ;; Add all tags concatenated with a comma 102 | (cons `(tag . ,alltags) entry))) 103 | 104 | (defun w-db-query (query &rest args) 105 | "Run QUERY with ARGS against the Wombag database." 106 | (if (stringp query) 107 | (emacsql (w-db-ensure) (apply #'format query args)) 108 | (apply #'emacsql (w-db-ensure) query args))) 109 | 110 | (defconst w-db-schema 111 | '(tag is_archived is_starred user_name user_email user_id tags is_public 112 | id uid title url hashed_url origin_url given_url hashed_given_url 113 | archived_at content created_at updated_at published_at published_by 114 | starred_at annotations mimetype language reading_time domain_name 115 | preview_picture http_status headers _links)) 116 | 117 | (defun w-db-get-entries (query &optional columns) 118 | "Select COLUMNS from the Wombag DB for QUERY. 119 | 120 | If COLUMNS is nil select the full record. 121 | 122 | Return a list of alists of the column names and data." 123 | (setq columns (or (ensure-list columns) 124 | w-db-schema)) 125 | (mapcar (lambda (sel) (cl-pairlis columns sel)) 126 | (w-db-query query))) 127 | 128 | (defun w-db-get-ids (ids) 129 | (cl-typecase ids 130 | (number 131 | (w-db-get-entries 132 | `[:select ,(vconcat w-search-columns) :from items :where (= id ,ids)] 133 | w-search-columns)) 134 | (vector 135 | (w-db-get-entries 136 | `[:select ,(vconcat w-search-columns) :from items :where (in id ,(vconcat ids))])) 137 | (list 138 | (w-db-get-entries 139 | `[:select ,(vconcat w-search-columns) :from items :where (in id ,(vconcat ids))])))) 140 | 141 | (defun w-db--close () 142 | (emacsql-close (w-db-ensure))) 143 | 144 | (defun w-db-insert (entries &optional replace) 145 | "Return a list of the ids of ENTRIES inserted into the database. 146 | 147 | If REPLACE is non-nil, replace the entry in place instead." 148 | (let* ((ids '()) ;byte-compiler complains otherwise 149 | (entries 150 | (cl-loop for entry across entries 151 | collect (map-elt entry 'id) into ids 152 | collect (apply #'vector 153 | (mapcar 'cdr (w-db--sanitize-entry entry)))))) 154 | (w-db-query 155 | (if replace 156 | `[:insert-or-replace :into items :values ,entries] 157 | `[:insert-or-ignore :into items :values ,entries])) 158 | ids)) 159 | 160 | (defun w-db-delete (ids) 161 | (cond ((vectorp ids) 162 | (w-db-query `[:delete :from items :where (in id ,ids)]) ) 163 | ((numberp ids) (w-db-query `[:delete :from items :where (= id ,ids)])) 164 | (t nil))) 165 | 166 | (defun w-db-update (field id new) 167 | ";TODO: Update FIELD with ID in database with NEW data. 168 | 169 | FIELD is a symbol, ID the primary key integer and NEW is any data." 170 | (w-db-query `[:update items :set (= ,field ,new) :where (= id ,id)])) 171 | 172 | (provide 'wombag-db) 173 | ;;; wombag-db.el ends here 174 | 175 | ;; Local Variables: 176 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 177 | ;; End: 178 | -------------------------------------------------------------------------------- /wombag-heading.el: -------------------------------------------------------------------------------- 1 | ;;; wombag-heading.el --- Wombag heaading navigation -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; Wombag heading navigation support 23 | 24 | ;;; Code: 25 | (require 'shr) 26 | (require 'imenu) 27 | 28 | (eval-and-compile 29 | (if (require 'shr-heading nil t) 30 | (progn 31 | (defalias 'w-heading-next 'shr-heading-next) 32 | (defalias 'w-heading--line-at-point 'shr-heading--line-at-point) 33 | (defalias 'w-heading-previous 'shr-heading-previous) 34 | (defalias 'w-heading-setup-imenu 'shr-heading-setup-imenu)) 35 | (defun w-heading-next (&optional arg) 36 | "Move forward by ARG headings (any h1-h5). 37 | If ARG is negative move backwards, ARG defaults to 1." 38 | (interactive "p") 39 | (unless arg (setq arg 1)) 40 | (catch 'return 41 | (dotimes (_ (abs arg)) 42 | (when (> arg 0) (end-of-line)) 43 | (if-let ((match 44 | (funcall (if (> arg 0) 45 | #'text-property-search-forward 46 | #'text-property-search-backward) 47 | 'face '(shr-h1 shr-h2 shr-h3 shr-h4) 48 | (lambda (tags face) 49 | (cl-loop for x in (if (consp face) face (list face)) 50 | thereis (memq x tags)))))) 51 | (goto-char 52 | (if (> arg 0) (prop-match-beginning match) (prop-match-end match))) 53 | (throw 'return nil)) 54 | (when (< arg 0) (beginning-of-line))) 55 | (beginning-of-line) 56 | (point))) 57 | 58 | (defun w-heading-previous (&optional arg) 59 | "Move backward by ARG headings (any h1-h5). 60 | If ARG is negative move forwards instead, ARG defaults to 1." 61 | (interactive "p") 62 | (w-heading-next (- (or arg 1)))) 63 | 64 | (defun w-heading--line-at-point () 65 | "Return the current line." 66 | (buffer-substring (line-beginning-position) (line-end-position))) 67 | 68 | (defun w-heading-setup-imenu () 69 | "Setup imenu for h1-h5 headings in eww buffer. 70 | Add this function to appropriate major mode hooks such as 71 | `eww-mode-hook' or `elfeed-show-mode-hook'." 72 | (setq-local 73 | imenu-prev-index-position-function #'w-heading-previous 74 | imenu-extract-index-name-function #'w-heading--line-at-point)))) 75 | 76 | (provide 'wombag-heading) 77 | ;;; wombag-heading.el ends here 78 | 79 | ;; Local Variables: 80 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 81 | ;; End: 82 | -------------------------------------------------------------------------------- /wombag-options.el: -------------------------------------------------------------------------------- 1 | ;;; wombag-options.el --- Customization options for Wombag -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; Customization options for Wombag. 23 | 24 | ;;; Code: 25 | (require 'shr) 26 | 27 | 28 | ;;; Groups 29 | (defgroup wombag nil 30 | "Wombag client group." 31 | :group 'comm) 32 | 33 | (defgroup w-db nil 34 | "Wombag database group." 35 | :group 'wombag) 36 | 37 | (defgroup w-search nil 38 | "Wombag search buffer group." 39 | :group 'wombag) 40 | 41 | (defgroup w-show nil 42 | "Wombag search buffer group." 43 | :group 'wombag) 44 | 45 | (defgroup w-faces nil 46 | "Wombag faces group." 47 | :group 'wombag) 48 | 49 | (define-obsolete-variable-alias 50 | 'w-clientid 'w-client-id "0.1.0") 51 | (define-obsolete-variable-alias 52 | 'w-secret 'w-client-secret "0.1.0") 53 | 54 | 55 | ;;; Remote and authentication 56 | (defcustom w-host "" 57 | "Wombag host." 58 | :type 'string 59 | :group 'wombag) 60 | 61 | (defcustom w-username nil 62 | "User name for Wombag." 63 | :type 'string 64 | :group 'wombag) 65 | 66 | (defcustom w-password "" 67 | "Password for Wombag" 68 | :type '(choice 69 | (string :tag "Password") 70 | (function :tag "Function that returns the password.")) 71 | :group 'wombag) 72 | 73 | (defcustom w-client-id "" 74 | "Client ID for Wombag." 75 | :type 'string 76 | :group 'wombag) 77 | 78 | (defcustom w-client-secret "" 79 | "Client secret for Wombag." 80 | :type 'string 81 | :group 'wombag) 82 | 83 | 84 | ;;; Local database 85 | (defcustom w-dir (file-name-concat 86 | (or (getenv "XDG_CACHE_HOME") user-emacs-directory) 87 | "wombag") 88 | "Wombag data directory." 89 | :type 'directory 90 | :set (lambda (sym val) 91 | (condition-case nil 92 | (progn 93 | (unless (file-directory-p val) 94 | (make-directory val :parents)) 95 | (set-default-toplevel-value sym val)) 96 | (error (user-error "Could not create directory: %s" val)))) 97 | :group 'w-db) 98 | 99 | (defcustom w-db-file 100 | (file-name-concat w-dir "wombag.sqlite") 101 | "Sqlite database used to store Wombag data." 102 | :type 'file 103 | :group 'w-db) 104 | 105 | 106 | ;;; Wombag search 107 | (defcustom w-search-buffer-name "*wombag-search*" 108 | "Buffer name for the Wombag search buffer." 109 | :type 'string 110 | :group 'w-search) 111 | 112 | (defcustom w-search-filter "#30 " 113 | "Default search filter for Wombag." 114 | :type 'string 115 | :group 'w-search) 116 | 117 | (defcustom w-search-filter-help nil 118 | "When non-nil, pop up a help window showing Wombag's search filter syntax. 119 | 120 | This window can be toggled manually using \\`?'." 121 | :type 'boolean 122 | :group 'w-search) 123 | 124 | 125 | ;;; Wombag show 126 | (defcustom w-show-entry-switch #'pop-to-buffer-same-window 127 | "Function used to display Wombag entry window." 128 | :type 'function 129 | :group 'w-show) 130 | 131 | (defcustom w-browse-url-function #'browse-url 132 | "Function called with URLs to open." 133 | :type 'function 134 | :group 'w-show) 135 | 136 | (defcustom w-pre-html-render-hook nil 137 | "Hook run before rendering Wombag articles." 138 | :type 'hook 139 | :group 'w-show) 140 | 141 | (defcustom w-post-html-render-hook nil 142 | "Hook run after rendering Wombag articles." 143 | :type 'hook 144 | :group 'w-show) 145 | 146 | (defcustom w-show-buffer-name "*wombag-entry*" 147 | "Buffer name for the Wombag search buffer." 148 | :type 'string 149 | :group 'w-show) 150 | 151 | 152 | ;;; Faces 153 | (defface w-title-face '((t :inherit bold)) 154 | "Face used for title on compact view." 155 | :group 'w-faces) 156 | 157 | (defface w-tag-face 158 | '((((class color) (background light)) 159 | :foreground "brown") 160 | (((class color) (background dark)) 161 | :foreground "#EBCB8B") 162 | (t :inherit default)) 163 | "Face used for tag." 164 | :group 'w-faces) 165 | 166 | (defface w-domain-face 167 | '((((class color) (background light)) 168 | :foreground "#3B6EA8") 169 | (((class color) (background dark)) 170 | :foreground "#d9c6d6") 171 | (t :inherit default)) 172 | "Face used for author." 173 | :group 'w-faces) 174 | 175 | (defface w-reading-time-face 176 | '((((class color) (background light)) 177 | :foreground "#8b94a5") 178 | (((class color) (background dark)) 179 | :foreground "#6f7787") 180 | (t :inherit default)) 181 | "Face used for size." 182 | :group 'w-faces) 183 | 184 | (defface w-date-face 185 | '((((class color) (background light)) 186 | :foreground "#29838D") 187 | (((class color) (background dark)) 188 | :foreground "#8FBCBB") 189 | (t :inherit default)) 190 | "Face for the date (last_modified)." 191 | :group 'w-faces) 192 | 193 | (defface w-show-title-face 194 | '((t (:inherit (shr-h1 variable-pitch)))) 195 | "Face used for title." 196 | :group 'w-faces) 197 | 198 | (defface w-archive-face 199 | '((((class color) (background light)) 200 | :foreground "grey" 201 | :weight light) 202 | (((class color) (background dark)) 203 | :foreground "dim grey" 204 | :weight light) 205 | (t :inherit default)) 206 | "Face used for archive." 207 | :group 'w-faces) 208 | 209 | (defface w-starred-face 210 | '((((class color) (background light)) 211 | :foreground "red3") 212 | (((class color) (background dark)) 213 | :foreground "yellow") 214 | (t :inherit default)) 215 | "Face used for title." 216 | :group 'w-faces) 217 | 218 | (provide 'wombag-options) 219 | ;;; wombag-options.el ends here 220 | 221 | ;; Local Variables: 222 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 223 | ;; End: 224 | -------------------------------------------------------------------------------- /wombag-search.el: -------------------------------------------------------------------------------- 1 | ;;; wombag-search.el --- Wombag search interface -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; Wombag search interface 23 | 24 | ;;; Code: 25 | (require 'wombag-db) 26 | (require 'wombag-options) 27 | (require 'wombag-show) 28 | (require 'bookmark) 29 | (require 'request) 30 | 31 | (bookmark-maybe-load-default-file) 32 | 33 | (declare-function w-show-entry "wombag-show") 34 | (declare-function wombag "wombag") 35 | (declare-function w-add-entry "wombag") 36 | (declare-function w-sync "wombag") 37 | (declare-function w--debug "wombag") 38 | (declare-function w--retry-with-token "wombag") 39 | (defvar w-token nil) 40 | 41 | (defun w-search-buffer (&optional livep) 42 | "Get or create buffer *wombag-search*. 43 | 44 | With optional arg LIVEP, only return the buffer if it is live." 45 | (if livep 46 | (get-buffer w-search-buffer-name) 47 | (get-buffer-create w-search-buffer-name))) 48 | 49 | (defvar w-retrieving nil 50 | "Header message for state of Wombag.") 51 | 52 | 53 | ;;; Bookmark support 54 | 55 | ;;;###autoload 56 | (defun w-search-bookmark-handler (record) 57 | "Jump to the wombag-search bookmarked location in RECORD." 58 | (wombag) 59 | (setq w-search-filter (bookmark-prop-get record 'filter)) 60 | (w-search-update--force)) 61 | 62 | (defun w-search-bookmark-make-record () 63 | "Return a bookmark record for the current w-search buffer." 64 | `(,(format "(Wombag search) %s" w-search-filter) 65 | (filter . ,w-search-filter) 66 | (handler . w-search-bookmark-handler))) 67 | 68 | 69 | ;;; Searching and live searching 70 | (defvar w-search-filter-active nil) 71 | 72 | (defvar w-search-filter-syntax-table 73 | (let ((table (make-syntax-table))) 74 | (prog1 table 75 | (dolist (char (list ?# ?+ ?- ?= ?@ ?! ?* ?~ ?/ ?> ?< ?: ?& ?^ ?.)) 76 | (modify-syntax-entry char "w" table)))) 77 | "Syntax table active when editing the filter in the minibuffer.") 78 | 79 | (defun w-search--minibuffer-setup () 80 | "Set up the minibuffer for live filtering Wombag." 81 | (when w-search-filter-active 82 | (set-syntax-table w-search-filter-syntax-table) 83 | (when w-search-filter-help (w-search--show-filter-help)) 84 | (when (eq :live w-search-filter-active) 85 | (add-hook 'post-command-hook (w-search--live-updater) nil :local)))) 86 | 87 | (defconst w-search--filter-help-string 88 | (cl-labels ((spc (to) (propertize " " 'display `(space :align-to ,to))) 89 | (hlp (text) (propertize text 'face 'help-key-binding)) 90 | (box (text) (propertize text 'face '(:underline t :weight semi-bold))) 91 | (desc (key s1 desc &optional s2) 92 | (concat (hlp key) (spc s1) desc (and s2 (spc s2))))) 93 | (concat 94 | (propertize 95 | "Filter Syntax [All filters are \"AND\" composed; Regexp support is not available]" 96 | 'face '(inherit shadow :height 1.1)) 97 | (propertize "\n\n" 'face '(inherit :height 0.8)) 98 | (hlp ".") (spc 5) (concat "Currently Reading") 99 | (spc 31) (box "Match") (spc 55) (box "Date added") 100 | "\n" 101 | (desc "#20" 5 "Limit to 20 articles" 30) 102 | (desc " text" 36 "in content/title" 55) 103 | (desc "@2020-06-27" 69 "on") 104 | "\n" 105 | (desc "<12" 5 "reading time < 12 mins" 30) 106 | (desc "*text" 36 "in title" 55) 107 | (desc "@2020-06-27--" 69 "after") 108 | "\n" 109 | (desc ">12" 5 "reading time > 12 mins" 30) 110 | (desc "/text" 36 "in full url" 55) 111 | (desc "@--2022-06-27" 69 "before") 112 | "\n" 113 | (desc "+tag" 5 "tagged as 'tag'" 30) 114 | (desc "^text" 36 "in domain name" 55) 115 | (desc "@2022-01-11--2022-06-27" 79 "between") 116 | "\n" 117 | (spc 30) 118 | (desc "=text" 36 "in author's name") 119 | "\n" 120 | (box "Flags") (spc 55) (box "Date published") 121 | "\n" 122 | (desc "**" 4 "Starred" 30) 123 | (spc 31) (box "Not match") (spc 55) 124 | (desc ":2020-06-27" 69 "on") 125 | "\n" 126 | (desc "!*" 4 "Not starred" 30) 127 | (desc "!text" 36 "in content/title" 55) 128 | (desc ":2020-06-27--" 69 "after") 129 | "\n" 130 | (desc "&&" 4 "Archived" 30) 131 | (desc "~text" 36 "in full url" 55) 132 | (desc ":--2022-06-27" 69 "before") 133 | "\n" 134 | (desc "!&" 4 "Not archived" 30) 135 | (desc "-tag" 36 "not tagged 'tag'" 55) 136 | (desc ":2022-01-11--2022-06-27" 79 "between")))) 137 | 138 | (defun w-search--show-filter-help () 139 | "Display search filter help for Wombag." 140 | (interactive) 141 | (let* ((buf (get-buffer-create "*wombag filter help*")) 142 | (win (get-buffer-window buf))) 143 | (if (window-live-p win) 144 | (quit-window nil win) 145 | (display-buffer 146 | buf `((display-buffer-in-side-window 147 | display-buffer-at-bottom) 148 | (side . bottom) 149 | (slot . -20) 150 | (window-height . 14))) 151 | (with-current-buffer buf 152 | (when (= (buffer-size buf) 0) 153 | (setq truncate-lines t) 154 | (insert w-search--filter-help-string) 155 | (special-mode) 156 | (setq-local mode-line-format nil)))))) 157 | 158 | (defvar w-search--filter-overflow nil 159 | "Flag when there are more entries than fit on the screen.") 160 | 161 | (defun w-search--live-updater (&optional delay) 162 | "Return a live-update function for filtering with Wombag. 163 | 164 | DELAY is the duration for which user input is debounced before 165 | querying the database." 166 | (let ((prev-filter) 167 | (debounce-timer) 168 | (delay (or delay 0.20))) 169 | (lambda () 170 | (if (timerp debounce-timer) 171 | (timer-set-idle-time debounce-timer delay) 172 | (unless (eq this-command 'w-search-live-filter) 173 | (setq debounce-timer 174 | (run-with-idle-timer 175 | delay nil 176 | (lambda (buffer) 177 | (cancel-timer debounce-timer) 178 | (setq debounce-timer nil) 179 | (let ((current-filter (string-trim-right (minibuffer-contents-no-properties)))) 180 | (unless (equal prev-filter current-filter) 181 | (with-current-buffer buffer 182 | (let* ((user-limit (or (and (string-match "#\$[[:digit:]]+\$" current-filter) 183 | (string-to-number (match-string 1 current-filter))) 184 | most-positive-fixnum)) 185 | (wombag-buf (w-search-buffer)) 186 | (window (get-buffer-window wombag-buf)) 187 | (height (window-total-height window)) 188 | (limiter (if window (format " #%d " height) " #1 ")) 189 | (w-search-filter (if (> user-limit height) 190 | (concat current-filter limiter) 191 | current-filter))) 192 | (w-search-update :force) 193 | (setq w-search--filter-overflow (>= (car (buffer-line-statistics wombag-buf)) 194 | (window-text-height window)) 195 | prev-filter current-filter)))))) 196 | (current-buffer)))))))) 197 | 198 | (defun w-search--live-update () 199 | ";TODO:" 200 | (when (eq :live w-search-filter-active) 201 | (let ((buffer (w-search-buffer)) 202 | (current-filter (minibuffer-contents-no-properties))) 203 | (when buffer 204 | (with-current-buffer buffer 205 | (let* ((user-limit (or (and (string-match "#\$[[:digit:]]+\$" current-filter) 206 | (string-to-number (match-string 1 current-filter))) 207 | most-positive-fixnum)) 208 | (window (get-buffer-window (w-search-buffer))) 209 | (height (window-total-height window)) 210 | (limiter (if window 211 | (format " #%d " height) 212 | " #1 ")) 213 | (w-search-filter (if (< height user-limit) 214 | (concat current-filter limiter) 215 | current-filter))) 216 | (w-search-update :force) 217 | (setq w-search--filter-overflow (< (window-end) (point-max))))))))) 218 | 219 | (defvar-keymap w-search--filter-map 220 | :doc "Keymap for Wombag filter editing." 221 | :parent minibuffer-local-map 222 | "?" #'w-search--show-filter-help) 223 | 224 | (defvar w-search--filter-history nil) 225 | 226 | (defun w-search-live-filter () 227 | "Live search the Wombag database." 228 | (interactive) 229 | (let ((line (with-current-buffer (w-search-buffer) 230 | (line-number-at-pos)))) 231 | (unwind-protect 232 | (let ((w-search-filter-active :live)) 233 | (setq w-search-filter 234 | (read-from-minibuffer 235 | "Filter (? for help): " w-search-filter w-search--filter-map 236 | nil w-search--filter-history))) 237 | (w-search-update :force) 238 | (setq w-search--filter-overflow nil 239 | w-retrieving nil) 240 | (goto-char (point-min)) 241 | (forward-line (1- line)) 242 | (when (eobp) (forward-line -1))))) 243 | 244 | (defvar w-search-columns 245 | '(id title created_at reading_time is_archived 246 | is_starred tag domain_name url published_by 247 | published_at)) 248 | 249 | (defun w-search-update (&optional _) 250 | ";TODO:" 251 | (let ((entries (w-db-get-entries 252 | (w-search-parse-filter w-search-filter w-search-columns) 253 | w-search-columns))) 254 | (w-search-print-entries entries) 255 | (length entries))) 256 | 257 | (defun w-search--token (token coll) 258 | (let ((re (substring token 1))) 259 | (if (string-empty-p re) 260 | coll (cons re coll)))) 261 | 262 | (defun w-search--date-token (element) 263 | (let ((re (substring element 1))) 264 | (unless (string-empty-p re) 265 | (pcase-let ((`(,from ,to) (split-string re "--"))) 266 | (when (equal from "") (setq from "1970-01-01")) 267 | (when (equal to "") (setq to (format-time-string "%Y-%m-%d" (current-time)))) 268 | (cons from to))))) 269 | 270 | (defun w-search-parse-filter (filter &optional columns) 271 | "Parse the elements of a search FILTER into an emacsql query. 272 | 273 | Query should ask for COLUMNS, or `wombag-search-columns'." 274 | (let ((matches) (limit) (urls) (not-urls) (not-matches) 275 | (have-tag) (not-have-tag) (titles) (under-time) (over-time) 276 | (domains) (authors) (add-dates) (pub-dates) 277 | (starred) (archived) (unstarred) (unarchived) (reading)) 278 | (cl-loop for element in (split-string filter) 279 | for type = (aref element 0) 280 | do (cl-case type 281 | (?+ (setq have-tag (w-search--token element have-tag))) 282 | (?- (setq not-have-tag (w-search--token element not-have-tag))) 283 | (?/ (setq urls (w-search--token element urls))) 284 | (?~ (setq not-urls (w-search--token element not-urls))) 285 | (?! (pcase (ignore-errors (aref element 1)) 286 | ('?* (setq unstarred t)) 287 | ('?& (setq unarchived t)) 288 | (_ (setq not-matches (w-search--token element not-matches))))) 289 | (?* (if (eq (ignore-errors (aref element 1)) ?*) 290 | (setq starred t) 291 | (setq titles (w-search--token element titles)))) 292 | (?& (if (eq (ignore-errors (aref element 1)) ?&) 293 | (setq archived t) 294 | (push element matches))) 295 | (?^ (setq domains (w-search--token element domains))) 296 | (?= (setq authors (w-search--token element authors))) 297 | (?@ (setq add-dates (w-search--date-token element))) 298 | (?: (setq pub-dates (w-search--date-token element))) 299 | (?> (setf over-time 300 | (list (string-to-number (substring element 1))))) 301 | (?< (setf under-time 302 | (list (string-to-number (substring element 1))))) 303 | (?# (setf limit (string-to-number (substring element 1)))) 304 | (otherwise (if (string= element ".") 305 | (setq reading t) 306 | (push element matches))))) 307 | (apply #'vector 308 | (append (if columns 309 | `(:select ,(vconcat columns) :from items) 310 | '(:select * :from items)) 311 | `(,@(when (or urls matches titles have-tag under-time over-time 312 | not-have-tag not-matches not-urls domains authors add-dates 313 | pub-dates starred unstarred archived unarchived reading) 314 | (list :where 315 | `(and 316 | ,@(when starred `((= is_starred 1))) 317 | ,@(when archived `((= is_archived 1))) 318 | ,@(when unstarred `((= is_starred 0))) 319 | ,@(when unarchived `((= is_archived 0))) 320 | ,@(when urls 321 | (cl-loop for link in urls 322 | collect `(like url ,(concat "%" link "%")))) 323 | ,@(when matches 324 | (cl-loop for text in matches 325 | collect `(or (like title ,(concat "%" text "%")) 326 | (like content ,(concat "%" text "%"))))) 327 | ,@(when titles 328 | (cl-loop for title in titles 329 | collect `(like title ,(concat "%" title "%")))) 330 | ,@(when authors 331 | (cl-loop for author in authors 332 | collect `(like published_by ',(concat "%" author "%")))) 333 | ,@(when have-tag 334 | (cl-loop for tag in have-tag 335 | collect `(like tags ',(concat "%\"" tag "\"%")))) 336 | ,@(when domains 337 | (cl-loop for domain in domains 338 | collect `(like domain_name ,(concat "%" domain "%")))) 339 | ,@(when not-have-tag 340 | (cl-loop for tag in not-have-tag 341 | collect `(not (like tags ',(concat "%\"" tag "\"%"))))) 342 | ,@(when add-dates 343 | (if (cdr add-dates) 344 | `((<= ,(car add-dates) created_at ,(cdr add-dates))) 345 | `((like created_at ,(concat (car add-dates) "%"))))) 346 | ,@(when pub-dates 347 | (if (cdr pub-dates) 348 | `((<= ,(car pub-dates) published_at ,(cdr pub-dates))) 349 | `((like published_at ,(concat (car pub-dates) "%"))))) 350 | ,@(when (or under-time over-time) 351 | `((< ,@over-time reading_time ,@under-time))) 352 | ,@(when not-urls 353 | (cl-loop for link in not-urls 354 | collect `(not (like url ,(concat "%" link "%"))))) 355 | ,@(when not-matches 356 | (cl-loop for text in not-matches 357 | collect `(not (or (like title ,(concat "%" text "%")) 358 | (like content ,(concat "%" text "%")))))) 359 | ,@(when reading 360 | (if-let ((ids (hash-table-keys w-show--positions-table))) 361 | `((in id ,(vconcat ids))) 362 | `((= id 0))))))) 363 | :order-by (desc id) 364 | ,@(when limit (list :limit limit))))))) 365 | 366 | 367 | ;;; Search buffer display 368 | 369 | (defvar w-search-trailing-width 38) 370 | 371 | (defvar w-search-min-title-width 30) 372 | (defvar w-search-max-title-width 70) 373 | (defvar w-search-title-width w-search-min-title-width) 374 | 375 | (defun w-search-print-entries (entries) 376 | "Print ENTRIES to the Wombag search buffer." 377 | (with-current-buffer (w-search-buffer) 378 | (let ((inhibit-read-only t)) 379 | (erase-buffer) 380 | (setq w-search-title-width 381 | (min (max (- (window-width (get-buffer-window "*wombag-search*")) 382 | 10 w-search-trailing-width) 383 | w-search-min-title-width) 384 | w-search-max-title-width)) 385 | (mapc #'w-search-print-entry--default entries)))) 386 | 387 | (defun w-search-format-entry (entry) 388 | "Wombag ENTRY as string." 389 | (let* ((title (or (alist-get 'title entry) "NO TITLE")) 390 | (created-at (alist-get 'created_at entry)) 391 | (published-at (alist-get 'published_at entry)) 392 | (reading-time (alist-get 'reading_time entry)) 393 | (is-archived (alist-get 'is_archived entry)) 394 | (is-starred (alist-get 'is_starred entry)) 395 | (tag (alist-get 'tag entry)) 396 | (domain-name (or (alist-get 'domain_name entry) "")) 397 | (authors (mapconcat #'identity (alist-get 'published_by entry) ","))) 398 | (format "%s %s %s %s (%s)" 399 | ;; (substring created-at 0 10) 400 | (propertize 401 | (or (substring created-at 0 10) 402 | (and published-at (substring published-at 0 10))) 403 | 'face 'w-date-face) 404 | (propertize 405 | (truncate-string-to-width title w-search-title-width nil ? nil) 406 | 'face (if (= is-archived 1) 'w-archive-face 'w-title-face)) 407 | (propertize (format "%3d min" reading-time) 'face 'w-reading-time-face) 408 | (propertize ;; (if (string= authors "") domain-name authors) 409 | domain-name 'face 'w-domain-face) 410 | (concat 411 | (and (eq is-starred 1) 412 | (concat (propertize "★" 'face 'w-starred-face) 413 | (unless (string-empty-p tag) ","))) 414 | (propertize tag 'face 'w-tag-face))))) 415 | 416 | (defun w-search-print-entry--default (entry) 417 | "Print ENTRY to the buffer." 418 | (unless (equal entry "") 419 | (let (beg end) 420 | (setq beg (point)) 421 | (insert (w-search-format-entry entry)) 422 | (setq end (point)) 423 | ;; format the tag and push into attr alist 424 | (put-text-property beg end 'w-entry entry) 425 | (put-text-property beg end 'w-id (alist-get 'id entry)) 426 | (insert "\n")))) 427 | 428 | (defun w-search-header () 429 | "Return the string to be used as the wombag header." 430 | (format "%s: %s %s" 431 | (propertize "Wombag" 'face font-lock-preprocessor-face) 432 | (if w-retrieving 433 | (propertize w-retrieving 'face font-lock-warning-face) 434 | (concat 435 | (propertize (format "Total %s, " (if w-search--filter-overflow 436 | "??" (car (buffer-line-statistics)))) 437 | 'face font-lock-warning-face) 438 | (propertize w-search-filter 'face 'font-lock-keyword-face) 439 | ;; (propertize (let ((len (length (w-find-marked-candidates)))) 440 | ;; (if (> len 0) 441 | ;; (concat "Marked: " (number-to-string len)) "")) 'face font-lock-negation-char-face) 442 | )) 443 | (concat 444 | (propertize " " 'display `(space :align-to (- right ,(length w-host)))) 445 | (propertize (format "%s" w-host) 'face font-lock-type-face)))) 446 | 447 | 448 | ;;; Search buffer movement and interaction 449 | 450 | (defun w-search-update--force (&optional keep-header) 451 | "Force refresh view of the article listing. 452 | 453 | When KEEP-HEADER is non-nil, don't reset the header message." 454 | (interactive) 455 | (let ((line (line-number-at-pos))) 456 | (w-search-update :force) 457 | (unless keep-header (setq w-retrieving nil)) 458 | (goto-char (point-min)) 459 | (forward-line (1- line)))) 460 | 461 | (defun w-search-quit-window (&optional arg) 462 | "Quit Wombag and close the database. 463 | 464 | With prefix ARG only quit Wombag." 465 | (interactive "P") 466 | (unless arg (w-db--close)) 467 | (when-let ((buf (get-buffer w-show-buffer-name))) 468 | (if-let ((win (get-buffer-window buf))) 469 | (quit-window 'kill win) 470 | (kill-buffer buf))) 471 | (quit-window 'kill)) 472 | 473 | (defun w-search-selected (&optional ignore-region-p) 474 | ";TODO:" 475 | (let ((use-region (and (not ignore-region-p) (use-region-p)))) 476 | (let ((beg (if use-region (region-beginning) (point))) 477 | (end (if use-region (region-end) (point))) 478 | (entries)) 479 | (save-excursion 480 | (goto-char beg) 481 | (while (and (not (eobp)) (<= (point) end)) 482 | (push (get-text-property (point) 'w-entry) entries) 483 | (forward-line 1)) 484 | (if ignore-region-p 485 | (car entries) 486 | (nreverse entries)))))) 487 | 488 | (defun w-search-show-entry (entry) 489 | "Show Wombag ENTRY at point." 490 | (interactive (list (w-search-selected :ignore-region))) 491 | (when entry (w-show-entry entry))) 492 | 493 | (defmacro w-search--with-entry (&rest body) 494 | `(if-let ((entry (get-text-property (point) 'w-entry))) 495 | ,(macroexp-progn body) 496 | (message "No Wombag entry at point."))) 497 | 498 | (defun w-search-browse-url () 499 | "Open Wombag entry at point using `browse-url'." 500 | (interactive) 501 | (w-search--with-entry 502 | (when-let ((url (map-elt entry 'url))) 503 | (funcall w-browse-url-function url)))) 504 | 505 | (defun w-search-eww-open () 506 | "Open Wombag entry at point in EWW." 507 | (interactive) 508 | (w-search--with-entry 509 | (when-let ((url (map-elt entry 'url))) 510 | (eww url)))) 511 | 512 | (defun w-search-copy () 513 | "Copy URL of Wombag entry at point." 514 | (interactive) 515 | (w-search--with-entry 516 | (when-let ((url (map-elt entry 'url))) 517 | (kill-new url) 518 | (message "Copied to kill-ring: \"%s\"" url)))) 519 | 520 | (defun w-search--eob () 521 | "Go to the last line of the Wombag search buffer." 522 | (interactive) 523 | (prog1 (goto-char (point-max)) 524 | (when (eq (point) (line-beginning-position)) 525 | (forward-line -1)))) 526 | 527 | 528 | ;;; Resume search session 529 | ;;;###autoload 530 | (defun w-resume () 531 | "Resume reading Wombag articles. 532 | 533 | This limits the Wombag listing to articles that you have begun 534 | reading but not finished." 535 | (interactive) 536 | (call-interactively #'wombag) 537 | (if-let* ((ids (hash-table-keys w-show--positions-table)) 538 | (entries (w-db-get-entries 539 | `[:select ,(vconcat w-search-columns) :from items 540 | :where (in id ,(vconcat ids)) 541 | :order-by (desc created_at)] 542 | w-search-columns))) 543 | (let ((line (with-current-buffer (w-search-buffer) 544 | (line-number-at-pos)))) 545 | (w-search-print-entries entries) 546 | (goto-char (point-min)) 547 | (when line 548 | (forward-line (1- line)) 549 | (when (eobp) (forward-line -1))) 550 | (length entries)) 551 | (message "No entries to resume."))) 552 | 553 | 554 | ;;; Update/delete entries in search buffer 555 | (defconst w-search--update-fields 556 | '(("archive" is_archived "Archiving...") 557 | ("starred" is_starred "Starring..."))) 558 | 559 | (defun w-search--updater (method) 560 | "Update Wombag entry at point using METHOD." 561 | (lambda () 562 | "Update Wombag entry at point." 563 | (interactive) 564 | (pcase-let* ((id (get-text-property (point) 'w-id)) 565 | (entry (get-text-property (point) 'w-entry)) 566 | (`(,field ,msg) (map-elt w-search--update-fields method)) 567 | (oldval (map-elt entry field)) 568 | (location (point))) 569 | (let ((newval (pcase oldval 570 | ('1 0) 571 | ('0 1)))) 572 | (setq w-retrieving msg) 573 | (request (format "%s/api/entries/%d" w-host id) 574 | :type "PATCH" 575 | :params `(("access_token" . ,w-token) 576 | ("detail" . "metadata")) 577 | :parser 'json-read 578 | :data (json-encode `(("access_token" . ,w-token) 579 | (,method . ,newval))) 580 | :headers '(("Content-Type" . "application/json") 581 | ("Prefer" . "return=minimal")) 582 | :status-code `((401 . ,(w--retry-with-token 583 | (intern-soft (format "wombag-search-%s-entry" method))))) 584 | :success 585 | (cl-function 586 | (lambda (&key data &allow-other-keys) 587 | (setq w-retrieving nil) 588 | (with-current-buffer (w-search-buffer) 589 | (let ((state (map-elt data field)) 590 | (updated-at (map-elt data 'updated_at)) 591 | (inhibit-read-only t)) 592 | ;; (message "%S" data) 593 | ;; (message "state: %S" state) 594 | (w-db-update field id state) 595 | (w-db-update 'updated_at id updated-at) 596 | (save-excursion 597 | (goto-char location) 598 | (delete-line) 599 | (w-search-print-entry--default 600 | (car (w-db-get-ids id)))))))) 601 | :error #'w--debug))))) 602 | 603 | (defalias 'w-search-archive-entry (w-search--updater "archive") "Archive entry at point") 604 | (defalias 'w-search-starred-entry (w-search--updater "starred") "Star entry at point") 605 | 606 | (defun w-search-add-tags (addtags remtags) 607 | "Add or remove tags to Wombag entry at point. 608 | 609 | NOTE: Removing tags is not yet implemented. 610 | 611 | ADDTAGS and REMTAGS are the tags to be added and removed 612 | respectively." 613 | (interactive (let ((alltags (split-string 614 | (read-string "Tag or untag (+tag1 -tag2 ...): " 615 | (if (equal this-command 'w-search-remove-tags) 616 | "-" "+"))))) 617 | (cl-loop for tag in alltags 618 | when (string-prefix-p "+" tag) collect (substring tag 1) into addtags 619 | when (string-prefix-p "-" tag) collect (substring tag 1) into remtags 620 | finally return (list addtags remtags)))) 621 | (let ((id (get-text-property (point) 'w-id)) 622 | (location (point))) 623 | (setq w-retrieving "Tagging...") 624 | (when addtags 625 | (request (format "%s/api/entries/%d/tags" w-host id) 626 | :type "POST" 627 | :params `(("access_token" . ,w-token) 628 | ("detail" . "metadata")) 629 | :parser 'json-read 630 | :data (json-encode `(("access_token" . ,w-token) 631 | (tags . ,(mapconcat #'identity addtags ",")))) 632 | :headers '(("Content-Type" . "application/json") 633 | ("Prefer" . "return=minimal")) 634 | :status-code `((401 . ,(w--retry-with-token #'w-search-add-tags addtags remtags))) 635 | :success 636 | (cl-function 637 | (lambda (&key data &allow-other-keys) 638 | (setq w-retrieving nil) 639 | (with-current-buffer (w-search-buffer) 640 | (let ((tags (map-elt data 'tags)) 641 | (updated-at (map-elt data 'updated_at)) 642 | (inhibit-read-only t)) 643 | ;; (message "%S" data) 644 | ;; (message "state: %S" state) 645 | (print (map-elt data 'tags) (get-buffer "*scratch*")) 646 | (w-db-update 647 | 'tag id (mapconcat (lambda (el) (map-elt el 'label)) (map-elt data 'tags) ",")) 648 | (when (vectorp tags) (setq tags `',tags)) 649 | (w-db-update 'tags id tags) 650 | (w-db-update 'updated_at id updated-at) 651 | (save-excursion 652 | (goto-char location) 653 | (delete-line) 654 | (w-search-print-entry--default 655 | (car (w-db-get-ids id)))))))) 656 | :error #'w--debug)) 657 | (when remtags 658 | (setq w-retrieving nil) 659 | (message "Removing tags is not implemented, sorry!")))) 660 | 661 | (defalias 'w-search-remove-tags 'w-search-add-tags) 662 | 663 | (defun w-search-delete-entry (&optional no-confirm) 664 | "Delete Wombag entry at point. 665 | 666 | When NO-CONFIRM is non-nil, do not ask for confirmation." 667 | (interactive (list (not (yes-or-no-p "Delete entry at point? ")))) 668 | (when-let (((not no-confirm)) 669 | (id (get-text-property (point) 'w-id)) 670 | (entry (get-text-property (point) 'w-entry)) 671 | (location (point))) 672 | (setq w-retrieving "Deleting...") 673 | (request (format "%s/api/entries/%d" w-host id) 674 | :parser 'json-read 675 | :type "DELETE" 676 | :params `(("access_token" . ,w-token)) 677 | :headers '(("Content-Type" . "application/json") ("Prefer" . "return=minimal")) 678 | :status-code `((401 . ,(w--retry-with-token #'w-search-delete-entry)) 679 | (404 . ,(cl-function 680 | (lambda (&key _data &allow-other-keys) 681 | (w-search--remove-from-listing id location))))) 682 | :success 683 | (cl-function 684 | (lambda (&key _data &allow-other-keys) 685 | (w-search--remove-from-listing id location))) 686 | :error #'w--debug))) 687 | 688 | (defun w-search--remove-from-listing (id location) 689 | (setq w-retrieving nil) 690 | (with-current-buffer (w-search-buffer) 691 | (let ((inhibit-read-only t)) 692 | (w-db-delete id) 693 | (save-excursion 694 | (goto-char location) 695 | (delete-line))))) 696 | 697 | 698 | ;;; Search buffer major mode 699 | 700 | (defvar-keymap w-search-mode-map 701 | :doc "Keymap for `wombag-search-mode'." 702 | :suppress t 703 | "" #'w-search-show-entry 704 | "<" #'beginning-of-buffer 705 | ">" #'w-search--eob 706 | "G" #'w-sync 707 | "B" #'w-search-eww-open 708 | "&" #'w-search-browse-url 709 | "x" #'w-search-browse-url 710 | "s" #'w-search-live-filter 711 | "q" #'w-search-quit-window 712 | "g" #'w-search-update--force 713 | "R" #'w-add-entry 714 | "D" #'w-search-delete-entry 715 | "n" #'next-line 716 | "p" #'previous-line 717 | "w" #'w-search-copy 718 | "+" #'w-search-add-tags 719 | "-" #'w-search-remove-tags 720 | "A" #'w-search-archive-entry 721 | "F" #'w-search-starred-entry) 722 | 723 | (define-derived-mode w-search-mode fundamental-mode "wombag-search" 724 | "Major mode for listing wombag entries. 725 | \\{wombag-search-mode-map}" 726 | (setq truncate-lines t 727 | buffer-read-only t 728 | header-line-format '(:eval (w-search-header))) 729 | (buffer-disable-undo) 730 | (w-search-update :force) 731 | (goto-char (point-min)) 732 | (hl-line-mode 1) 733 | (add-hook 'minibuffer-setup-hook 'w-search--minibuffer-setup) 734 | (setq-local bookmark-make-record-function 735 | #'w-search-bookmark-make-record)) 736 | 737 | (provide 'wombag-search) 738 | ;;; wombag-search.el ends here 739 | 740 | ;; Local Variables: 741 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 742 | ;; End: 743 | -------------------------------------------------------------------------------- /wombag-show.el: -------------------------------------------------------------------------------- 1 | ;;; wombag-show.el --- Wombag article interface -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; Wombag article interface 23 | 24 | ;;; Code: 25 | (require 'cl-lib) 26 | (require 'shr) 27 | (require 'browse-url) 28 | (require 'bookmark) 29 | (require 'wombag-options) 30 | (require 'wombag-heading) 31 | (require 'wombag-db) 32 | 33 | (declare-function w-search-buffer "wombag-search") 34 | 35 | (bookmark-maybe-load-default-file) 36 | 37 | (defun w-show-buffer () 38 | "Return the Wombag entry buffer." 39 | (get-buffer "*wombag-entry*")) 40 | 41 | (defvar-local w-show-entry nil 42 | "The Wombag entry displayed in this buffer.") 43 | 44 | 45 | ;;; Bookmarks 46 | ;;;###autoload 47 | (defun w-show-bookmark-handler (record) 48 | "Show the bookmarked entry saved in the `RECORD'." 49 | (let* ((id (bookmark-prop-get record 'id)) 50 | (entry (car (w-db-get-ids id))) 51 | (position (bookmark-get-position record))) 52 | (set-buffer (w-show-entry entry)) 53 | (goto-char position))) 54 | 55 | (defun w-show-bookmark-make-record () 56 | "Save the current position and the entry into a bookmark." 57 | (let ((id (alist-get 'id w-show-entry)) 58 | (position (point)) 59 | (title (alist-get 'title w-show-entry))) 60 | `(,(format "(Wombag) \"%s\"" title) 61 | (id . ,id) 62 | ;; (location . ,title) 63 | (position . ,position) 64 | (handler . w-show-bookmark-handler)))) 65 | 66 | 67 | ;;; Saving entry positions 68 | (defvar w-show--positions-file 69 | (file-name-concat w-dir "positions.eld")) 70 | 71 | (defvar w-show--positions-table 72 | (if (file-exists-p w-show--positions-file) 73 | (condition-case nil 74 | (let ((coding-system-for-read 'utf-8)) 75 | (with-temp-buffer 76 | (insert-file-contents w-show--positions-file) 77 | (goto-char (point-min)) 78 | (read (current-buffer)))) 79 | (error (message "Could not sync Wombag positions, starting over.") 80 | (make-hash-table :size 1024))) 81 | (make-hash-table :size 1024))) 82 | 83 | (defun w-show--positions-save () 84 | (when-let ((id (alist-get 'id w-show-entry))) 85 | (if (or (bobp) (eobp)) 86 | (remhash id w-show--positions-table) 87 | (puthash id (point) w-show--positions-table)))) 88 | 89 | (defun w-show--positions-write () 90 | (when (and (boundp 'w-show--positions-table) 91 | (hash-table-p w-show--positions-table) 92 | (not (hash-table-empty-p w-show--positions-table))) 93 | (let ((write-region-inhibit-fsync t) 94 | (coding-system-for-write 'utf-8) 95 | (print-level nil) 96 | (print-length nil)) 97 | (with-temp-file w-show--positions-file 98 | (insert ";;; -*- lisp-data -*-\n" 99 | (prin1-to-string w-show--positions-table)))))) 100 | 101 | (add-hook 'kill-emacs-hook #'w-show--positions-write) 102 | 103 | 104 | ;;; Rendering the entry buffer 105 | (defun w-show-render-html (begin end) 106 | "Render HTML in current buffer with shr. 107 | 108 | Render from positions BEGIN to END." 109 | (run-hooks 'w-pre-html-render-hook) 110 | (shr-render-region begin end) 111 | (run-hooks 'w-post-html-render-hook)) 112 | 113 | (defun w-show-entry (entry) 114 | "Read Wombag ENTRY at point." 115 | (let ((buf (get-buffer-create w-show-buffer-name)) 116 | (title (alist-get 'title entry "(UNTITLED)")) 117 | (reading-time (alist-get 'reading_time entry)) 118 | (created-at (alist-get 'created_at entry)) 119 | ;; (tag (alist-get 'tag entry)) 120 | (domain-name (or (alist-get 'domain_name entry) "")) 121 | (id (alist-get 'id entry)) 122 | (url (alist-get 'url entry)) 123 | (beg) (end)) 124 | (with-current-buffer buf 125 | (delay-mode-hooks 126 | (w-show-mode) 127 | (funcall w-show-entry-switch buf) 128 | (let ((inhibit-read-only t)) 129 | (erase-buffer) 130 | (insert (propertize title 'face 'w-show-title-face) 131 | "\n") 132 | (insert (format "%s %s %s\n\n\n" 133 | (propertize (format "%d min" reading-time) 134 | 'face 'w-reading-time-face) 135 | (propertize (substring created-at 0 10) 136 | 'face 'w-date-face) 137 | ;; No DATA or HELP-ECHO args, the latter is not supported on Emacs 28.2 138 | (propertize (button-buttonize 139 | domain-name (lambda (_) (browse-url url))) 140 | 'face 'w-domain-face))) 141 | (if-let ((content (car 142 | (car-safe 143 | (w-db-query `[:select content :from items :where (= id ,id)]))))) 144 | (progn (setq beg (point)) 145 | (insert content) 146 | (setq end (point)) 147 | (w-show-render-html beg end)) 148 | (insert (propertize "(empty)" 'face 'warning))) 149 | (if-let ((pos (gethash id w-show--positions-table))) 150 | (prog1 (goto-char pos) 151 | ;; (recenter next-screen-context-lines) 152 | (recenter) 153 | ) 154 | (goto-char (point-min))))) 155 | (setq w-show-entry entry) 156 | (run-mode-hooks) 157 | (current-buffer)))) 158 | 159 | ;;; Actions in the entry buffer 160 | (defun w-show-quit-window () 161 | "Close this Wombag article." 162 | (interactive) 163 | (quit-window 'kill) 164 | (when-let* ((buf (w-search-buffer)) 165 | (win (get-buffer-window buf))) 166 | (if (window-live-p win) 167 | (select-window win)))) 168 | 169 | (defun w-show-disable-images () 170 | "Disable images in this Wombag buffer." 171 | (interactive) 172 | (when-let ((entry w-show-entry) 173 | (shr-inhibit-images t)) 174 | (w-show-entry entry))) 175 | 176 | 177 | ;;; Major mode 178 | (defvar-keymap w-show-mode-map 179 | :doc "Keymap for `wombag-show-mode'." 180 | "TAB" #'shr-next-link 181 | "" #'shr-previous-link 182 | "SPC" #'scroll-up-command 183 | "S-SPC" #'scroll-down-command 184 | "DEL" #'scroll-down-command 185 | "<" #'beginning-of-buffer 186 | ">" #'end-of-buffer 187 | "q" #'w-show-quit-window 188 | "I" #'w-show-disable-images 189 | "C-c C-n" #'w-heading-next 190 | "C-c C-p" #'w-heading-previous) 191 | 192 | (define-derived-mode w-show-mode fundamental-mode 193 | "wombag-entry" 194 | "Mode for displaying wombag entry details. 195 | \\{wombag-show-mode-map}" 196 | (setq buffer-read-only t) 197 | (buffer-disable-undo) 198 | (setq-local bookmark-make-record-function 199 | #'w-show-bookmark-make-record) 200 | (w-heading-setup-imenu) 201 | (add-hook 'kill-buffer-hook 202 | #'w-show--positions-save nil 'local)) 203 | 204 | (provide 'wombag-show) 205 | ;;; wombag-show.el ends here 206 | 207 | ;; Local Variables: 208 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 209 | ;; End: 210 | -------------------------------------------------------------------------------- /wombag.el: -------------------------------------------------------------------------------- 1 | ;;; wombag.el --- A Wallabag Client -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2023 Karthik Chikmagalur 4 | 5 | ;; Author: Karthik Chikmagalur 6 | ;; Version: 0.1.0 7 | ;; Package-Requires: ((emacs "28.1") (emacsql "3.1.1") (request "0.3.3") (compat "29.1.0")) 8 | ;; Keywords: multimedia, extensions 9 | ;; URL: https://github.com/karthink/wombag 10 | 11 | ;; This file is NOT part of GNU Emacs. 12 | 13 | ;; This program is free software; you can redistribute it and/or modify 14 | ;; it under the terms of the GNU General Public License as published by 15 | ;; the Free Software Foundation, either version 3 of the License, or 16 | ;; (at your option) any later version. 17 | 18 | ;; This program is distributed in the hope that it will be useful, 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 | ;; GNU General Public License for more details. 22 | 23 | ;; You should have received a copy of the GNU General Public License 24 | ;; along with this program. If not, see . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Wombag is a Wallabag client for Emacs. 29 | ;; 30 | ;; Wallabag is an (optionally self-hosted) read-it-later or web page archival 31 | ;; service. To use this package you need a Wallabag account, or access to a 32 | ;; server running Wallabag. 33 | ;; 34 | ;; Usage: 35 | ;; 36 | ;; Set the following parameters: 37 | ;; (setq wombag-host "https://app.wallabag.it" ;where you access Wallabag 38 | ;; wombag-username "my-wallabag-username" 39 | ;; wombag-password "my-wallabag-password" 40 | ;; wombag-client-id "abcdefgh1234" 41 | ;; wombag-client-secret "abcdefgh1234")) 42 | ;; 43 | ;; - Start Wombag with M-x `wombag'. 44 | ;; 45 | ;; - Sync your reading list with the server using `wombag-sync' (`G' in the 46 | ;; Wombag buffer) 47 | ;; 48 | ;; - Filter entries with `s', press `?' for help with searching. 49 | ;; 50 | ;; - You can read, archive, star, tag or delete entries. 51 | ;; - You can bookmark Wombag searches/entries, and navigate entries with `imenu'. 52 | 53 | ;;; Code: 54 | (eval-when-compile 55 | (require 'cl-lib) 56 | (require 'subr-x)) 57 | (require 'compat) 58 | (require 'map) 59 | (require 'request) 60 | (require 'json) 61 | (require 'wombag-options) 62 | (require 'wombag-db) 63 | 64 | (declare-function w-search-buffer 'wombag-search) 65 | (declare-function w-search-mode 'wombag-search) 66 | (declare-function w-search-update--force 'wombag-search) 67 | (defvar w-retrieving) 68 | 69 | 70 | ;;; Utility vars and functions 71 | (defvar w-token-file (file-name-concat w-dir "token") 72 | "File used to store the token. 73 | 74 | NOTE: This is currently not implemented.") 75 | (defvar w-token nil) 76 | (defvar w-version nil) 77 | (defvar w-appname nil) 78 | (defvar w-data nil) 79 | 80 | (defvar w--debug t) 81 | 82 | (cl-defun w--debug (&key data error-thrown symbol-status response &allow-other-keys) 83 | "Handle `request' errors when interacting with Wombag. 84 | 85 | DATA, ERROR-THROWN, SYMBOL-STATUS and RESPONSE have their usual 86 | meanings in a `request' callback, see `request'." 87 | (let ((status-code (request-response-status-code response)) 88 | (error-desc (cdr-safe error-thrown)) 89 | (data-desc (map-elt data 'error_description))) 90 | (unless (eq status-code 401) ;Handled elsewhere 91 | (setq w-retrieving 92 | (concat (format "%S: %S " symbol-status error-desc) data-desc)) 93 | (when w--debug 94 | (with-current-buffer (get-buffer-create "*Wombag Error*") 95 | (with-silent-modifications (erase-buffer)) 96 | (insert ";; Request failed with error: \n" (pp-to-string symbol-status) 97 | "\n\n;; Error data is:\n" (pp-to-string error-thrown) 98 | "\n\n;; Data is:\n" (pp-to-string data)) 99 | (unless (eq major-mode 'emacs-lisp-mode) (emacs-lisp-mode)) 100 | (display-buffer-in-side-window (current-buffer) 101 | '((side . bottom) 102 | (slot . -40) 103 | (window-height . 10)))))))) 104 | 105 | 106 | ;;; Fetching data: Remote to local 107 | 108 | (cl-defun w-get-token (&key callback args) 109 | "Request a Wallabag token. 110 | 111 | If provided, call CALLBACK with ARGS afterwards." 112 | (interactive) 113 | (request (format "%s/oauth/v2/token" w-host) 114 | :parser 'json-read 115 | :params `(("username" . ,w-username) 116 | ("password" . ,w-password) 117 | ("client_id" . ,w-client-id) 118 | ("client_secret" . ,w-client-secret) 119 | ("grant_type" . "password")) 120 | :headers '(("Content-Type" . "application/json")) 121 | :sync t 122 | :success (cl-function 123 | (lambda (&key data &allow-other-keys) 124 | (setf w-token (alist-get 'access_token data)) 125 | (when w--debug (message "Wombag token acquired.")) 126 | (when callback (apply callback args)))) 127 | :error #'w--debug)) 128 | 129 | (defun w--retry-with-token (func &rest args) 130 | "Retrieve a Wombag token and call FUNC with ARGS." 131 | (cl-function 132 | (lambda (&key data error-thrown &allow-other-keys) 133 | (if (not (equal (map-elt data 'error) "invalid_grant")) 134 | (message (format "Request failed with: %S" error-thrown)) 135 | (setq w-retrieving "Authenticating...") 136 | (w-get-token :callback func :args args))))) 137 | 138 | (defsubst w--sync-message (num-total) 139 | "Adjust Wombag header message stating NUM-TOTAL." 140 | (setq w-retrieving 141 | (if (= num-total 0) 142 | "Retrieving... already up to date" 143 | (format "Retrieving... %d entries added" num-total)))) 144 | 145 | ;;----------------8<------------------- 146 | ;; (defvar w-all-entries nil) 147 | ;; (defvar w-local-ids nil) 148 | ;;----------------8<------------------- 149 | (cl-defun w-sync (&key since page num-total local-ids full) 150 | "Synchronize the local Wombag database. 151 | 152 | This will update the local state of Wombag to that the server: 153 | - Fetch new entries since the last update 154 | - Update all metadata (archived/starred/annotations etc) 155 | 156 | With `prefix-arg' \\[universal-argument], query for date to sync 157 | from. 158 | 159 | By default, it will not delete local entries that have been 160 | deleted on the server. 161 | 162 | With double prefix-arg \\[universal-argument] 163 | \\[universal-argument], do a full sweep of the database and 164 | delete all entries not on the Server. 165 | NOTE: This is not yet implemented. 166 | 167 | Keywords: 168 | 169 | SINCE: Unix timestamp or date formatted as \"YYYY-MM-DD\" to sync 170 | upwards from. (Determined automatically when not provided.) 171 | 172 | FULL: If non-nil, perform a full sweep of deleted entries on the 173 | server and delete them locally. 174 | 175 | The remaining keywords are for internal use only 176 | 177 | PAGE: Page number of entries. 178 | NUM-TOTAL: Running total of new entries 179 | LOCAL-IDS: Ids from SINCE available locally." 180 | (interactive 181 | (list :since 182 | (when (= (prefix-numeric-value current-prefix-arg) 4) 183 | (read-string "Sync from (2023-09-01): ")) 184 | :full (and (= (prefix-numeric-value current-prefix-arg) 16) 185 | (y-or-n-p 186 | "Do a full sweep of the database (This will transfer a lot of data)? ")))) 187 | (unless num-total 188 | (setq w-retrieving "Retrieving..." 189 | num-total (or num-total 0))) 190 | ;;----------------8<------------------- 191 | ;; (setq w-all-entries nil 192 | ;; w-local-ids nil) 193 | ;;----------------8<------------------- 194 | (if since 195 | (unless (numberp since) 196 | (if (string-match-p "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" since) 197 | (setq since (floor (float-time (date-to-time since)))) 198 | (user-error "Date %s does not match format YYYY-MM-DD" since))) 199 | (setq since (or (caar (w-db-query `[:select fetch-all :from last_update])) 1))) 200 | (request (format "%s/api/entries" w-host) 201 | :parser 'json-read 202 | :params `(("access_token" . ,w-token) 203 | ("sort" . "created") 204 | ("order" . "desc") 205 | ("page" . ,(or page 1)) 206 | ("perPage" . 30) 207 | ("detail" . "full") 208 | ("since" . ,since)) 209 | :headers '(("Content-Type" . "application/json")) 210 | :status-code `((401 . ,(w--retry-with-token #'w-sync 211 | :page page :since since :full full)) 212 | (404 . ,(lambda (&rest _) 213 | (w-db-update-date (float-time)) 214 | (w--sync-message num-total) 215 | (when full (w--sweep-deleted-entries))))) 216 | :success 217 | (cl-function 218 | (lambda (&key data &allow-other-keys) 219 | "Update Wombag db if necessary" 220 | (let ((num-new) 221 | (all-entries (map-nested-elt data '(_embedded items))) 222 | (local-ids (or local-ids 223 | (apply #'nconc 224 | (w-db-query 225 | `[:select id :from items 226 | :where (>= updated_at ;created_at 227 | ,(format-time-string "%Y-%m-%dT%H:%M:%S" since t)) 228 | :order-by (desc id)]))))) 229 | ;;----------------8<------------------- 230 | ;; (setq w-all-entries 231 | ;; (nconc w-all-entries all-entries)) 232 | ;; (setq w-local-ids 233 | ;; (nconc w-local-ids local-ids)) 234 | ;;----------------8<------------------- 235 | (if local-ids 236 | (let ((server-ids)) 237 | (cl-loop for entry across all-entries 238 | for id = (map-elt entry 'id) 239 | do (push id server-ids) 240 | if (memq id local-ids) 241 | collect entry into updated-entries 242 | else collect entry into new-entries 243 | finally do 244 | (when new-entries 245 | (w--insert-entries :data (vconcat new-entries) :replace t)) 246 | (when updated-entries 247 | (w--insert-entries :data (vconcat updated-entries) :replace t)) 248 | (setq num-new (length new-entries))) 249 | (when-let ((deleted-ids (cl-set-difference local-ids server-ids))) 250 | (w-db-delete (vconcat deleted-ids)))) 251 | (unless (= 0 (length all-entries)) (w--insert-entries :data all-entries)) 252 | (setq num-new (length all-entries))) 253 | (if (>= (length all-entries) 30) 254 | ;; There might be more entries 255 | (run-with-idle-timer 256 | 1 nil #'w-sync 257 | :page (1+ (or page 1)) 258 | :since since 259 | :num-total (+ num-new num-total) 260 | :local-ids local-ids 261 | :full full) 262 | (w-db-update-date (float-time)) 263 | (when full (w--sweep-deleted-entries))) 264 | (w--sync-message (+ num-new num-total))))) 265 | :error #'w--debug)) 266 | 267 | (defun w--sweep-deleted-entries () 268 | ";TODO: Sweeping all deleted entries not implemented yet." 269 | (message "Sweeping all deleted entries not implemented yet.")) 270 | 271 | ;;;; Updating the database: 272 | (cl-defun w--insert-entries (&key data replace &allow-other-keys) 273 | "Insert entries in DATA into the Wombag database. 274 | 275 | If keyword REPLACE is non-nil, replace entries if they already exist." 276 | (condition-case-unless-debug parse-error 277 | (if (not data) 278 | (message "Parse error! Could not extract entry data.") 279 | (or (vectorp data) (setq data (vector data))) 280 | (when w--debug (message "Running insert entry")) 281 | (prog1 (w-db-insert data replace) 282 | (let ((inhibit-message t) 283 | (num (length data))) 284 | (if (= num 1) 285 | (message "Entry added to Wombag.") 286 | (message "%d entries added to Wombag." num))) 287 | (when-let* (((featurep 'w-search)) 288 | (buf (w-search-buffer :if-live)) 289 | (win (get-buffer-window buf)) 290 | ((window-live-p win))) 291 | (with-selected-window win 292 | (w-search-update--force :keep-header))))) 293 | (error (message "Couldn't insert entries into database: %S" (car parse-error))))) 294 | 295 | 296 | ;;; Sending data: Local to remote 297 | 298 | ;;;###autoload 299 | (defun w-add-entry (url &optional tags) 300 | "Add an entry (from URL) to the Wombag database. 301 | 302 | Interactively, query for TAGS as well. TAGS must be a 303 | comma-separated string." 304 | (interactive 305 | (list (read-string "URL to add to Wombag: ") 306 | (split-string (read-string "Tags (comma separated): ") "," t "\\s-+"))) 307 | (request (format "%s/api/entries" w-host) 308 | :parser 'json-read 309 | :type "POST" 310 | :params `(("access_token" . ,w-token)) 311 | :data (json-encode 312 | `(("url" . ,url) 313 | ("archive" . 0) 314 | ("starred" . 0) 315 | ("tags" . ,(or tags "")))) 316 | :headers '(("Content-Type" . "application/json")) 317 | :error #'w--debug 318 | :status-code `((401 . ,(w--retry-with-token 319 | (lambda () (w-add-entry url tags))))) 320 | :success #'w--insert-entries)) 321 | 322 | 323 | ;;; Main command 324 | ;;;###autoload 325 | (defun wombag () 326 | "Open Wombag." 327 | (interactive) 328 | (w-db-ensure) 329 | (require 'w-search) 330 | (pop-to-buffer-same-window (w-search-buffer)) 331 | (unless (eq major-mode 'w-search-mode) 332 | (w-search-mode))) 333 | 334 | (provide 'wombag) 335 | ;;; wombag.el ends here 336 | 337 | ;; Local Variables: 338 | ;; read-symbol-shorthands: (("w-" . "wombag-")) 339 | ;; End: 340 | --------------------------------------------------------------------------------