From: Qiantan Hong <qhong@mit.edu>
To: "emacs-devel@gnu.org" <emacs-devel@gnu.org>
Subject: New package: resist!
Date: Wed, 8 Dec 2021 20:55:02 +0000 [thread overview]
Message-ID: <F3A26DB8-D75C-448F-8AF9-55612371513B@mit.edu> (raw)
[-- Attachment #1: Type: text/plain, Size: 814 bytes --]
This package implements persistence facility.
It provides two level of interfaces:
- A high-level persistent variable facility
- A low-level persistent key-value store facility
The persistent variable facility detects changes of values
persistent variables in an idle timer and persist the changes
into a persistent key-value store.
Multiple methods for detecting and computing the changes are
provided. See `make-persistent-variable' for details.
The persistent key-value store provides the following functions:
- Creating and compressing store: `make-kv-store', `compact-kv-store'
- Put, remove and look up key value pairs: `kv-put', `kv-rem', `kv-get',
- List operations: `kv-push', `kv-delete'
See their docstrings for details.
All changes are persisted immediately into external storage.
[-- Attachment #2: resist!.el --]
[-- Type: application/octet-stream, Size: 10405 bytes --]
;;; resist! --- Against SQLite3! -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Author: Qiantan Hong <qhong@alum.mit.edu>
;; Maintainer: Qiantan Hong <qhong@alum.mit.edu>
;; Keywords: persistence database
;; Version: 0.0.1
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package implements persistence facility.
;; It provides two level of interfaces:
;; - A high-level persistent variable facility
;; - A low-level persistent key-value store facility
;; The persistent variable facility detects changes of values
;; persistent variables in an idle timer and persist the changes
;; into a persistent key-value store.
;; Multiple methods for detecting and computing the changes are
;; provided. See `make-persistent-variable' for details.
;; The persistent key-value store provides the following functions:
;; - Creating and compressing store: `make-kv-store', `compact-kv-store'
;; - Put, remove and look up key value pairs: `kv-put', `kv-rem', `kv-get',
;; - List operations: `kv-push', `kv-delete'
;; See their docstrings for details.
;; All changes are persisted immediately into external storage.
;;; Code:
(require 'cl-lib)
(defcustom persistent-variable-idle-time 1
"Time in seconds to wait before writing out persistent variables.
The effect normally takes place after restarting Emacs, or
restarting `persistent-variable-idle-timer' manually."
:type 'number)
(defcustom persistent-variable-store-filename (concat user-emacs-directory ".persistent-variables")
"Filename of the key value store that backs up persistent variables."
:type 'file)
(cl-defstruct (kv-store (:constructor make-kv-store-1)) path table)
(defun make-kv-store (path)
"Create a key value store backed by file PATH.
If file PATH does not exist, create it and return an empty key value store.
If file PATH exists, load its content into a key value store and return it."
(let* ((kv-store (make-kv-store-1 :path path))
(kv-store-table (make-hash-table :test 'equal))
need-compactification)
(when (file-exists-p path)
(condition-case nil
(with-temp-buffer
(insert-file-contents path)
(while (< (point) (1- (point-max))) ; exclude trailing newline
(let ((entry (read (current-buffer))))
(pcase (car entry)
('++ (puthash (cadr entry) (caddr entry) kv-store-table))
('-- (remhash (cadr entry) kv-store-table))
('l+ (push (caddr entry) (gethash (cadr entry) kv-store-table)))
('l- (puthash (cadr entry)
(delete (caddr entry) (gethash (cadr entry) kv-store-table))
kv-store-table))))))
(end-of-file
;; We might encounter trailing unbalanced form if Emacs
;; crashed in the middle of `kv-put'. We compact the file
;; and fix unbalanced form as a side effect
(setq need-compactification t)))
(setf (kv-store-table kv-store) kv-store-table))
(when need-compactification
(compact-kv-store kv-store))
kv-store))
(defsubst kv--log (form)
(let ((print-length nil) (print-level nil))
(prin1 form (current-buffer)))
(insert "\n"))
(defun compact-kv-store (kv-store)
"Compress the log for KV-STORE.
Do this by dumping the full content of (kv-store-table KV-STORE) at once."
;; dump the full content of kv-store-table at once
;; to compress the log
(with-temp-buffer
(maphash (lambda (key value) (kv--log (list '++ key value)))
(kv-store-table kv-store))
(let ((file-precious-flag t))
(write-file (kv-store-path kv-store)))))
(defsubst kv-put-1 (key value kv-store)
(kv--log (list '++ key value))
(puthash key value (kv-store-table kv-store)))
(defsubst kv-rem-1 (key kv-store)
(kv--log (list '-- key))
(remhash key (kv-store-table kv-store)))
(defsubst kv-push-1 (key value kv-store)
(kv--log (list 'l+ key value))
(push value (gethash key (kv-store-table kv-store))))
(defsubst kv-delete-1 (key value kv-store)
(kv--log (list 'l- key value))
(puthash key (delete value (gethash key (kv-store-table kv-store))) (kv-store-table kv-store)))
(defmacro kv--persist-now (kv-store &rest body)
(declare (indent 1) (debug ([&rest form] body)))
`(with-temp-buffer
,@body
(let ((inhibit-message t))
(write-region nil nil (kv-store-path ,kv-store) t 'silence))))
(defun kv-put (key value kv-store)
"Associate KEY with VALUE in KV-STORE.
The operation is immediately persisted."
(kv--persist-now kv-store
(kv-put-1 key value kv-store)))
(defun kv-rem (key kv-store)
"Remove KEY from KV-STORE.
The operation is immediately persisted."
(kv--persist-now kv-store
(kv-rem-1 key kv-store)))
(defun kv-push (key value kv-store)
"Add VALUE to the list associated with KEY in KV-STORE.
The operation is immediately persisted."
(kv--persist-now kv-store
(kv-push-1 key value kv-store)))
(defun kv-delete (key value kv-store)
"Remove VALUE from the list associated with KEY in KV-STORE.
The operation is immediately persisted."
(kv--persist-now kv-store
(kv-delete-1 key value kv-store)))
(defun kv-get (key kv-store &optional dflt)
"Look up KEY in KV-STORE and return its associated value.
If KEY is not found, return DFLT which defaults to nil."
(gethash key (kv-store-table kv-store) dflt))
(defvar inhibit-ask-user-about-lock nil)
(defun inhibit-ask-user-about-lock-advice (orig-func file opponent)
(if inhibit-ask-user-about-lock
(signal 'file-locked (list file opponent))
(funcall orig-func file opponent)))
(advice-add 'ask-user-about-lock :around #'inhibit-ask-user-about-lock-advice)
(defvar persistent-variable-list nil "List of persistent variables.")
(defvar persistent-variable-kv-store (make-kv-store persistent-variable-store-filename))
(defvar persistent-variable-idle-timer (run-with-idle-timer persistent-variable-idle-time t 'persistent-variable-demon))
(defvar persistent-variable-unbound-marker (gensym))
(defun persistent-variable-demon ()
"Persist any changes of variables in `persistent-variable-list'.
The operation may fail if `persistent-variable-store-filename' is locked.
In such cases, return nil. If the operation succeeds, return t."
(dolist (variable persistent-variable-list)
(with-temp-buffer
(setq buffer-file-truename (kv-store-path persistent-variable-kv-store))
(condition-case nil
(progn
(setf (buffer-modified-p (current-buffer)) t) ; otherwise `lock-buffer' would do nothing
(let ((create-lockfiles t)
(inhibit-ask-user-about-lock t))
(lock-buffer))
(condition-case nil
(pcase (get variable 'persistence-method)
('eql
(unless (eql (kv-get variable persistent-variable-kv-store) (symbol-value variable))
(kv-put-1 variable (symbol-value variable) persistent-variable-kv-store)))
('equal
(unless (equal (kv-get variable persistent-variable-kv-store) (symbol-value variable))
(kv-put-1 variable (copy-tree (symbol-value variable) t) persistent-variable-kv-store)))
('set
(let ((old-list (kv-get variable persistent-variable-kv-store))
(new-list (symbol-value variable)))
(let ((deleted-items (cl-set-difference old-list new-list))
(added-items (cl-set-difference new-list old-list)))
(mapc (lambda (value) (kv-delete-1 variable value persistent-variable-kv-store)) deleted-items)
(mapc (lambda (value) (kv-push-1 variable value persistent-variable-kv-store)) added-items)))))
(void-variable
(unless (eq (kv-get variable persistent-variable-kv-store persistent-variable-unbound-marker)
persistent-variable-unbound-marker)
(kv-rem variable persistent-variable-kv-store))))
(write-region nil nil buffer-file-truename t 'silent)
t)
(file-locked
(message "Giving up storing persistent variables this time, because %s is locked."
(kv-store-path persistent-variable-kv-store))
nil)))))
(add-hook 'kill-emacs-hook #'persistent-variable-demon)
(cl-defun make-persistent-variable (variable &optional (method 'eql))
"Make VARIABLE persistent.
If there is an existing entry in `persistent-variable-kv-store',
set the value of VARIABLE to the value in the key value store.
METHOD specifies how VARIABLE is saved and restored,
and can be one of the following:
- `eql': saves the value of VARIABLE if it is not `eql' to last saved value.
- `equal': saves the value of VARIABLE if it is not `equal' to last saved value.
- `set': saves the set difference of the value of VARIABLE compared to last saved value.
Membership test is done using `eql'."
(cl-pushnew variable persistent-variable-list)
(let ((persistent-value (kv-get variable persistent-variable-kv-store persistent-variable-unbound-marker)))
(unless (eq persistent-value persistent-variable-unbound-marker)
(set variable persistent-value)))
(setf (get variable 'persistence-method) method))
(defun kill-persistent-variable (variable)
"Make VARIABLE no longer persistent."
(setq persistent-variable-list (delq variable persistent-variable-list))
variable)
(provide 'resist!)
;;; resist!.el ends here
next reply other threads:[~2021-12-08 20:55 UTC|newest]
Thread overview: 50+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-12-08 20:55 Qiantan Hong [this message]
2021-12-09 2:48 ` New package: resist! Karl Fogel
2021-12-09 6:59 ` Qiantan Hong
2021-12-09 7:57 ` Óscar Fuentes
2021-12-09 8:05 ` Qiantan Hong
2021-12-09 8:09 ` Qiantan Hong
2021-12-09 13:24 ` Stefan Monnier
2021-12-09 9:15 ` Tassilo Horn
2021-12-09 9:25 ` Qiantan Hong
2021-12-09 9:36 ` Tassilo Horn
2021-12-09 20:37 ` Qiantan Hong
2021-12-10 18:25 ` Qiantan Hong
2021-12-10 18:59 ` Stefan Monnier
2021-12-10 19:15 ` Qiantan Hong
2021-12-10 19:24 ` Philip Kaludercic
2021-12-10 19:27 ` [External] : " Drew Adams
2021-12-10 19:57 ` Eli Zaretskii
2021-12-10 20:19 ` Alexandre Garreau
2021-12-10 20:28 ` Qiantan Hong
2021-12-10 20:34 ` Philip Kaludercic
2021-12-10 20:44 ` Qiantan Hong
2021-12-10 20:54 ` Alexandre Garreau
2021-12-10 21:11 ` [External] : " Drew Adams
2021-12-11 4:08 ` Richard Stallman
2021-12-10 22:17 ` Joost Kremers
2021-12-11 9:33 ` Qiantan Hong
2021-12-11 11:16 ` Tassilo Horn
2021-12-11 14:06 ` Stefan Monnier
2021-12-11 14:27 ` Qiantan Hong
2021-12-11 21:01 ` Alexandre Garreau
2021-12-11 21:13 ` Qiantan Hong
2021-12-11 21:26 ` Alexandre Garreau
2021-12-11 21:53 ` Alexandre Garreau
2021-12-12 1:05 ` Michael Heerdegen
2021-12-12 1:18 ` Alexandre Garreau
2021-12-12 1:35 ` Michael Heerdegen
2021-12-12 1:38 ` Qiantan Hong
2021-12-12 1:52 ` Michael Heerdegen
2021-12-12 2:02 ` Alexandre Garreau
2021-12-12 2:11 ` Michael Heerdegen
2021-12-12 2:18 ` Alexandre Garreau
2021-12-12 1:59 ` Alexandre Garreau
2021-12-12 2:56 ` Qiantan Hong
2021-12-12 6:42 ` Michael Heerdegen
2021-12-12 1:30 ` Qiantan Hong
2021-12-12 1:33 ` Qiantan Hong
2021-12-10 21:04 ` Dmitry Gutov
2021-12-10 19:53 ` Stefan Monnier
2021-12-10 21:08 ` [External] : " Drew Adams
2021-12-09 13:56 ` Stefan Kangas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=F3A26DB8-D75C-448F-8AF9-55612371513B@mit.edu \
--to=qhong@mit.edu \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.