unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* New package: resist!
@ 2021-12-08 20:55 Qiantan Hong
  2021-12-09  2:48 ` Karl Fogel
  2021-12-09 13:56 ` Stefan Kangas
  0 siblings, 2 replies; 50+ messages in thread
From: Qiantan Hong @ 2021-12-08 20:55 UTC (permalink / raw)
  To: emacs-devel@gnu.org

[-- 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

^ permalink raw reply	[flat|nested] 50+ messages in thread

end of thread, other threads:[~2021-12-12  6:42 UTC | newest]

Thread overview: 50+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-12-08 20:55 New package: resist! Qiantan Hong
2021-12-09  2:48 ` 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

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).