[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Auto Save Mode for ZMACS
Alright, here it goes. No strings attached. It's about three pages
of code. Have fun.
..................
... andreas ..:-).
..................
**** cut here ****
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: ZWEI; Base: 10 -*-
(defvar D,#TD1Ps T[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")*checkpoint-interval* (2 0 (NIL 0) (NIL NIL NIL) "CPTFONT")(* 3 60) ;This must be a global variable - not
"Seconds between auto-saving.") ;a per buffer zwei variable.
(defcom 1com-set-checkpoint-interval2 "Set the time in seconds between checkpoints." ()
(setq *checkpoint-interval* (typein-line-accept '(cl:integer 0 *)
:prompt "Time in seconds between checkpoints"
:default *checkpoint-interval*))
dis-none)
(set-comtab *zmacs-comtab* () (make-command-alist '(com-set-checkpoint-interval)))
(defvariable 1*checkpoint-p* 2t :boolean "Checkpoint this buffer.
If true, the buffer will be saved every *checkpoint-interval* seconds to a checkpoint file.
See M-x Set Checkpoint Interval.")
(loop for v in '(1*checkpoint-p*2) do ;(3 0 (NIL 0) (:SWISS :ROMAN :SMALLER) "HL10")What a kludge!!!!
2 (set v (get v 'variable-init)))
;;;;(4 0 (NIL 0) (:SWISS :ROMAN :LARGER) "HL14") (5 0 (NIL 0) (:SWISS NIL :LARGE) "HL14")Checkpoint4 Pathname
2;;;3 By defining methods for this message you can control where auto save files
2;;;3 are created. You can, e.g., modify the following methods to auto save on
2;;;3 a different host.
2(defmethod (1:checkpoint-pathname 2fs:unix42-pathname-mixin) ()
(send self :new-pathname
:raw-name (string-append "#" fs:name)
:raw-type (string-append fs:type "#")))
(defmethod (1:checkpoint-pathname 2fs:lmfs-pathname-mixin) ()
(send self :new-pathname
:raw-name (string-append "#" fs:name "#")
:version 1))
(defun 1checkpoint-demon 2()
(loop for *interval* in *zmacs-buffer-list*
for *major-mode* = (send *interval* :get :major-mode)
when (and *checkpoint-p* ;3This is a tricky ZWEI symbol macro. Needs global
2 ;3variables *interval* and *major-mode*.
2 (typep *interval* 'file-buffer-mixin) ;3Must have an associated file.
2 (send *interval* :modified-p :explicit-saving) ;3Only save modified buffers
2 (let ((checkpoint-tick (send *interval* :get :checkpoint-tick))) ;3that have been modified
2 (or (null checkpoint-tick) ;3since last autosaved.
2 ( checkpoint-tick (send *interval* :tick)))))
do (checkpoint-interval *interval*))
(si:add-timer-queue-entry (list :relative *checkpoint-interval*)
:once
"ZMACS Checkpoint Demon"
#'checkpoint-demon))
(defvar 1*alternate-checkpoint-pathnames* 2nil)
(defcom 1com-set-checkpoint-file2 "Set the name of the checkpoint file." ()
(let* ((pathname (send *interval* :pathname))
(checkpoint-pathname (typein-line-accept '((scl:token-or-type (("Default" . :default)) fs:pathname))
:prompt "Checkpoint pathname or 'Default'"
:default (cl:getf *alternate-checkpoint-pathnames* pathname :default))))
(if (eq checkpoint-pathname :default)
(cl:remf *alternate-checkpoint-pathnames* pathname)
(setf (cl:getf *alternate-checkpoint-pathnames* pathname) checkpoint-pathname)))
dis-none)
(set-comtab *zmacs-comtab* () (make-command-alist '(com-set-checkpoint-file)))
(defun 1checkpoint-interval 2(interval)
(loop with pathname = (send interval :pathname)
with checkpoint-pathname = (or (cl:getf *alternate-checkpoint-pathnames* pathname)
(condition-case ()
(send pathname :checkpoint-pathname)
;;(6 0 (NIL 0) (:DUTCH NIL :SMALLER) "TR10")Pathnames not to be checkpointed.
2 (sys:unclaimed-message
(return-from checkpoint-interval nil))))
do
;;6 We offer multiple restart handlers offering different choices to the user. The conditions
2 ;;6 are the same for each.
2 (catch-error-restart ((sys:host-not-responding
fs:tcp-ftp-file-name-not-allowed
fs:file-not-found) ;6This error is signalled if we have been denied permission
2 ;6to create the checkpoint file. This can happen when we edit another person's file.
2 "Use a different checkpoint file from now on. (see: M-x Set Checkpoint File)")
(catch-error-restart ((sys:host-not-responding fs:tcp-ftp-file-name-not-allowed fs:file-not-found)
"Mark buffer checkpointed; do not write a checkpoint file until next modification.")
(catch-error-restart ((sys:host-not-responding fs:tcp-ftp-file-name-not-allowed fs:file-not-found)
"Turn off checkpointing for this file. (see: M-x Set Variable Checkpoint-P)")
(catch-error-restart ((sys:host-not-responding fs:tcp-ftp-file-name-not-allowed fs:file-not-found)
"Try again after one checkpoint interval (~\\Time-interval\\)." *checkpoint-interval*)
(return-from checkpoint-interval
(with-open-file (stream checkpoint-pathname
:direction :output
:if-exists :supersede
:element-type (if (interval-fat-p interval) 'cl:character
'cl:string-char))
(stream-out-interval stream interval)
(close stream)
(send interval :putprop (send interval :tick) :checkpoint-tick)
#+XXX(typein-line "~\\datime\\ Written: ~A" (send stream :truename)))))
(return-from checkpoint-interval nil))
(send interval :set-variable-value '*checkpoint-p* nil)
(return-from checkpoint-interval nil))
(send interval :putprop (send interval :tick) :checkpoint-tick)
(return-from checkpoint-interval nil))
(setq checkpoint-pathname
(scl:accept 'fs:pathname :prompt (format nil "New checkpoint pathname for ~A" pathname)
:default (let ((new-name (send (si:pathname-history-first-pathname) ;6Really we want our own history.
2 :new-name (send pathname :name))))
(condition-case ()
(send new-name :checkpoint-pathname)
(sys:unclaimed-message
new-name)))))
(setf (cl:getf *alternate-checkpoint-pathnames* pathname) checkpoint-pathname)))
(add-initialization "ZMACS Checkpoint Demon"
(si:add-timer-queue-entry (list :relative *checkpoint-interval*)
:once
"ZMACS Checkpoint Demon"
#'checkpoint-demon)
'(:once))
;;;;(7 0 (NIL 0) (:DUTCH NIL :LARGER) "DUTCH14") Logout
2;;;6 At logout time we need to prevent the system from trying to checkpoint buffers
2;;;6 that have been left around. Also when another user logs in, he/she should not be
2;;;6 bothered with checkpointing of buffers that do not belong to him/her - they would
2;;;6 be written with the new user as the author etc..
2;;;6 Therefore we mark all modified buffers checkpointed. Now, when the next user
2;;;6 who logs in modifies one of these buffers, then the demon will restart attempting
2;;;6 to checkpoint the file. If the user does not have permission to create the
2;;;6 checkpoint file, we offer the following proceed options:
2;;;6 (1) marking the buffer checkpointed without actually checkpointing it,
2;;;6 (2) turning off checkpointing, and
2;;;6 (3) checkpointing it to a different file.
2(add-initialization "Mark buffers checkpointed" '(mark-buffers-checkpointed) nil 'si:logout-initialization-list)
(defun 1mark-buffers-checkpointed2 ()
(loop for *interval* in *zmacs-buffer-list*
for *major-mode* = (send *interval* :get :major-mode)
when (and *checkpoint-p* ;3This is a tricky ZWEI symbol macro. Needs global
2 ;3variables *interval* and *major-mode*.
2 (typep *interval* 'file-buffer-mixin) ;3Must have an associated file.
2 (send *interval* :modified-p :explicit-saving)) ;3Only save modified buffers
2 do (send *interval* :putprop (send *interval* :tick)
:checkpoint-tick)))
**** cut here ****