[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/sqlite 14ad9f5 2/3: Start implementation of a persistence librar
From: |
Lars Ingebrigtsen |
Subject: |
scratch/sqlite 14ad9f5 2/3: Start implementation of a persistence library |
Date: |
Tue, 7 Dec 2021 00:00:46 -0500 (EST) |
branch: scratch/sqlite
commit 14ad9f59499e37e62779238013d278aad9a2f78b
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Start implementation of a persistence library
---
lisp/emacs-lisp/sticky.el | 178 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 178 insertions(+)
diff --git a/lisp/emacs-lisp/sticky.el b/lisp/emacs-lisp/sticky.el
new file mode 100644
index 0000000..fcfc7d2
--- /dev/null
+++ b/lisp/emacs-lisp/sticky.el
@@ -0,0 +1,178 @@
+;;; sticky.el --- Sticky storage for variables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; 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:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+
+(defmacro define-sticky-variable (name initial-value &optional doc
+ &rest args)
+ "Make NAME into a sticky variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-sticky'."
+ (declare (indent defun))
+ `(defvar ,name
+ (make-sticky :key ',name
+ :initial-value ,initial-value
+ ,@args)
+ ,@(list doc)))
+
+(cl-defstruct (sticky
+ (:constructor nil)
+ (:constructor sticky--create)
+ (:conc-name sticky--))
+ "A persistent variable that will live across Emacs invocations."
+ key
+ (initial-value nil)
+ package
+ (synchronized t)
+ (cached-value :)
+ (cached-sequence 0))
+
+(cl-defun make-sticky (&key key initial-value package)
+ "Create a sticky object."
+ (unless key
+ (error "No key for the sticky object"))
+ (unless package
+ (setq package (intern (replace-regexp-in-string "-.*" ""
+ (symbol-name key)))))
+ (sticky--create
+ :key key
+ :initial-value initial-value
+ :package package))
+
+(defvar sticky--db nil)
+
+(defun sticky--ensure-db ()
+ (unless sticky--db
+ (setq sticky--db
+ (sqlite-open (expand-file-name "sticky.sqlite" "~/.emacs.d/"))))
+ (unwind-protect
+ (progn
+ (sqlite-transaction sticky--db)
+ (unless (sqlite-select
+ sticky--db
+ "select name from sqlite_master where type='table' and
name='sticky'")
+ ;; Create the table.
+ (sqlite-execute
+ sticky--db
+ "create table sticky (package text not null, key text not null,
sequence number not null, value text not null)")
+ (sqlite-execute
+ sticky--db
+ "create unique index sticky_idx on sticky (package, key)")))
+ (sqlite-commit sticky--db)))
+
+(defun sticky-value (object)
+ "Return the value of the sticky OBJECT."
+ (if (or (null user-init-file)
+ (not (sqlite-available-p)))
+ ;; If we don't have storage, then just return the value from the
+ ;; object.
+ (if (eq (sticky--cached-value object) :)
+ (sticky--initial-value object)
+ (sticky--cached-value object))
+ ;; We have storage, so we update from storage.
+ (sticky--ensure-db)
+ (let ((id (list (symbol-name (sticky--package object))
+ (symbol-name (sticky--key object)))))
+ (cond
+ ;; We have no value yet; check the database.
+ ((eq (sticky--cached-value object) :)
+ (let ((stored
+ (car
+ (sqlite-select
+ sticky--db
+ "select value, sequence from sticky where package = ? and key
= ?"
+ id))))
+ (if stored
+ (let ((value (read-from-string (caar stored))))
+ (setf (sticky--cached-value object) value
+ (sticky--cached-sequence object) (cadar stored))
+ value)
+ ;; Nothing; return the initial value.
+ (sticky--initial-value object))))
+ ;; We have a value, but we want to update in case some other
+ ;; Emacs instance has updated.
+ ((sticky--synchronized object)
+ (let ((stored
+ (car
+ (sqlite-select
+ sticky--db
+ "select value, sequence from sticky where sequence > 0
package = ? and key = ?"
+ (cons (sticky--cached-sequence object) id)))))
+ (if stored
+ (let ((value (read-from-string (caar stored))))
+ (setf (sticky--cached-value object) value
+ (sticky--cached-sequence object) (cadar stored))
+ value)
+ ;; Nothing, return the cached value.
+ (sticky--cached-value object))))
+ ;; Just return the cached value.
+ (t
+ (sticky--cached-value object))))))
+
+(defun sticky--set-value (object value)
+ (if (or (null user-init-file)
+ (not (sqlite-available-p)))
+ ;; We have no backend, so just store the value.
+ (setf (sticky--cached-value object) value)
+ ;; We have a backend.
+ (unwind-protect
+ (progn
+ (sqlite-transaction sticky--db)
+ (let* ((id (list (symbol-name (sticky--package object))
+ (symbol-name (sticky--key object))))
+ (old-sequence
+ (sqlite-select
+ sticky--db
+ "select sequence from sticky where package = ? and key = ?"
id)))
+ (if old-sequence
+ (progn
+ (setf (sticky--cached-sequence object) (1+ old-sequence))
+ (sqlite-execute
+ sticky--db
+ "update sticky set value = ?, sequence = ? where package =
? and key = ?"
+ (cons (prin1-to-string value)
+ (cons (sticky--cached-sequence object)
+ id))))
+ (cl-incf (sticky--cached-sequence object))
+ (sqlite-execute
+ sticky--db
+ "insert into sticky (package, key, value, sequence) values (?,
?, ?, ?)"
+ (cons (prin1-to-string value)
+ (cons (sticky--cached-sequence object)
+ id))))
+ (setf (sticky--cached-value object) value)))
+ (sqlite-commit sticky--db))))
+
+(gv-define-simple-setter sticky-value sticky--set-value)
+
+;; (define-sticky-variable foo 'bar)
+;; (sticky-value foo)
+;; (sticky--set-value foo 'zot)
+;; (setf (sticky-value foo) 'gazonk)
+
+(provide 'sticky)
+
+;;; sticky.el ends here