persist.el

   1 ;;;_ tinydb/persist.el --- Create persisting data
   2
   3 ;;;_. Headers
   4 ;;;_ , License
   5 ;; Copyright (C) 2007,2010  Tom Breton (Tehom)
   6
   7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
   8 ;; Keywords:
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;;_ , Commentary:
  26
  27 ;; This was originally part of my `password' library.  I separated it
  28 ;; so that it could be re-used.
  29
  30 ;;Drawbacks: It only makes one object persist per buffer.  This could
  31 ;;be remedied with a major rewrite.  Even so, it would probably be
  32 ;;less safe.
  33
  34 ;;;_ , Requires
  35 (require 'pp)
  36 (require 'tinydb/asynq)
  37
  38
  39 ;;;_. Code:
  40
  41 ;;;_ , Internal:
  42
  43 ;;;_  . tehom-persist-sync-obj-to-buffer
  44 ;;$$OBSOLESCENT.
  45 ;;Internal only
  46 (defun tehom-persist-sync-obj-to-buffer (initial-obj &optional type-pred)
  47    "Return the current buffer's data as an object.
  48 If we can't read an object, signal error.
  49 If TYPE-PRED is given and object doesn't satisfy it, signal error.
  50
  51 Do NOT call this unless you know what you are doing.  It must only be
  52 called in a buffer visiting a file meant to store sexps persistently."
  53
  54    (let
  55       ((obj
  56           (condition-case err
  57              (if
  58                 (= (buffer-size) 0)
  59                 initial-obj
  60                 (progn
  61                    (goto-char (point-min))
  62                    (read (current-buffer))))
  63              (error
  64                 (error
  65                    "In persist buffer %s, contents could not be read"
  66                    (current-buffer))
  67                 '()))))
  68
  69       (if
  70          (or (null type-pred) (funcall type-pred obj))
  71          obj
  72          (progn
  73             (error
  74                "In persist buffer %s, object was wrong type"
  75                (current-buffer))
  76             '()))))
  77
  78
  79 ;;$$OBSOLESCENT.
  80 (defalias 'tehom-persist-sync-list-to-buffer
  81    'tehom-persist-sync-obj-to-buffer)
  82
  83 ;;;_  . tehom-persist-sync-file-to-obj
  84
  85 ;;$$OBSOLESCENT.  Use `tinydb-persist--write-obj'
  86 ;;Internal only
  87 (defun tehom-persist-sync-file-to-obj (obj &optional force-save type-pred)
  88    "Sync to the current buffer and file to OBJ
  89
  90 Do NOT call this unless you know what you are doing.  It will ERASE
  91 the contents of the buffer and write another object into it."
  92
  93    (unless
  94       (or
  95          (not type-pred)
  96          (funcall type-pred obj))
  97       (error "Object %s does not satisfy %s" obj type-pred))
  98
  99    (let
 100       ((old-str (buffer-string)))
 101       (erase-buffer)
 102       (insert (pp-to-string obj))
 103       (condition-case err
 104          (progn
 105             (goto-char (point-min))
 106             (read (current-buffer)))
 107          (error
 108             (erase-buffer)
 109             (insert old-str)
 110             (apply #'signal (car err) (cdr err)))))
 111
 112
 113    (when force-save
 114       (let
 115          ((file-precious-flag t))
 116          ;;Save, forcing backups to exist.
 117          (save-buffer 64))))
 118
 119 ;;$$OBSOLESCENT.
 120 (defalias 'tehom-persist-sync-file-to-list 'tehom-persist-sync-file-to-obj)
 121 ;;;_  . tinydb-persist--write-obj
 122 (defun tinydb-persist--write-obj (obj &optional force-save)
 123    ""
 124
 125    (let
 126       ((old-str (buffer-string)))
 127       (erase-buffer)
 128       (insert (pp-to-string obj))
 129       ;;If it can't be read back, it's an error
 130       (condition-case err
 131          (progn
 132             (goto-char (point-min))
 133             (read (current-buffer)))
 134          (error
 135             (erase-buffer)
 136             (insert old-str)
 137             (apply #'signal (car err) (cdr err)))))
 138
 139    (when force-save
 140       ;;Save, forcing backups to exist.
 141       (let
 142          ((file-precious-flag t))
 143          (save-buffer 64))))
 144
 145 ;;;_ , Macros to use the persisting object
 146
 147 ;;;_  . tehom-persist-buffer-as-const-obj
 148 ;;$$OBSOLESCENT.
 149 (defmacro tehom-persist-buffer-as-const-obj
 150    (persist-file var initial-obj type-pred &rest body)
 151    "Treat the password buffer as an immutable object named VAR"
 152
 153    `(with-current-buffer (find-file-noselect ,persist-file)
 154        (let
 155           ((,var
 156               (tehom-persist-sync-obj-to-buffer ,initial-obj ,type-pred)))
 157           ,@body)))
 158
 159 ;;;_  . tehom-persist-buffer-as-const-list
 160 ;;$$OBSOLESCENT.
 161 (defmacro tehom-persist-buffer-as-const-list (persist-file var &rest body)
 162    "Treat the password buffer as an immutable list named VAR"
 163    `(tehom-persist-buffer-as-const-obj
 164        ,persist-file ,var () #'listp ,@body))
 165
 166
 167 ;;;_  . tehom-persist-buffer-as-mutable-obj
 168 ;;$$OBSOLESCENT.
 169 (defmacro tehom-persist-buffer-as-mutable-obj
 170    (persist-file var initial-obj type-pred &rest body)
 171    ""
 172    `
 173    (with-current-buffer (find-file-noselect ,persist-file)
 174        (let
 175           ((,var (tehom-persist-sync-obj-to-buffer ,initial-obj ,type-pred)))
 176           (prog1
 177              (progn ,@body)
 178              (tehom-persist-sync-file-to-obj ,var t ,type-pred)))))
 179
 180
 181 ;;;_  . tehom-persist-buffer-as-mutable-list
 182
 183 ;;$$OBSOLESCENT.
 184 (defmacro tehom-persist-buffer-as-mutable-list (persist-file var &rest body)
 185    "Treat the file PERSIST-FILE as a mutable object named by the
 186 symbol VAR."
 187    `(tehom-persist-buffer-as-mutable-obj
 188        ,persist-file ,var () #'listp ,@body))
 189
 190 ;;;_  . tehom-update-persist-buffer
 191
 192 ;;$$OBSOLESCENT.
 193 (defun tehom-update-persist-buffer
 194    (persist-file obj &optional force-save type-pred)
 195    "Assign OBJ to the persisting object in the buffer visiting PERSIST-FILE.
 196 If TYPE-PRED is given, only write OBJ if it satisfies TYPE-PRED,
 197 otherwise signal error."
 198
 199    (with-current-buffer (find-file-noselect persist-file)
 200       (tehom-persist-sync-file-to-obj obj force-save type-pred)))
 201
 202
 203 ;;;_ , File-buffer instantiation of asynq
 204
 205 ;;;_  . tinydb-persist-make-q
 206 (defun tinydb-persist-make-q
 207    (filename initial-obj &optional eager-save type-pred)
 208    "Make a file-based persisting queue"
 209    (tinydb-make-q
 210       ;;This is the setup for file-based asynq
 211       #'(lambda (filename initial-object eager-save)
 212            (with-current-buffer
 213               (find-file-noselect filename eager-save)
 214               (declare (special persist-eager-save))
 215               (set
 216                  (make-local-variable
 217                     'persist-eager-save)
 218                  eager-save)
 219               (when
 220                  (= (buffer-size) 0)
 221                  ;;$$USE ME INSTEAD
 222                  '(tinydb-persist--write-obj initial-object eager-save)
 223                  (tehom-persist-sync-file-to-obj
 224                     initial-object eager-save))
 225               (current-buffer)))
 226
 227       ;;get
 228       #'(lambda (buffer)
 229            (with-current-buffer buffer
 230               ;;$$USE ME INSTEAD after testing.
 231               '
 232               (condition-case err
 233                  (progn
 234                     (goto-char (point-min))
 235                     (read (current-buffer)))
 236                  (error
 237                     (error
 238                        "In persist buffer %s, contents could not be read"
 239                        (current-buffer))
 240                     '()))
 241               (tehom-persist-sync-obj-to-buffer nil)))
 242
 243       ;;put
 244       #'(lambda (buffer obj)
 245            (with-current-buffer buffer
 246               (declare (special persist-eager-save))
 247               ;;Type check is handled by asynq now
 248               ;;$$USE ME INSTEAD
 249               '(tinydb-persist--write-obj obj persist-eager-save)
 250               (tehom-persist-sync-file-to-obj
 251                  obj
 252                  persist-eager-save)
 253               buffer))
 254       type-pred
 255       filename initial-obj eager-save))
 256
 257
 258
 259 ;;;_: Footers
 260
 261 ;;;_ * Local emacs vars.
 262 ;;;_  + Local variables:
 263 ;;;_  + mode: allout
 264 ;;;_  + End:
 265
 266 (provide 'tinydb/persist)
 267 ;;; tinydb/persist.el ends here