1 ;;; tinylock.el --- Simple emacs locking utility
3 ;; This file is not part of Emacs
7 ;; Copyright (C) 1995-2007 Jari Aalto
8 ;; Keywords: extensions
10 ;; Maintainer: Jari Aalto
12 ;; To get information on this program, call -x tinylock-version.
13 ;; Look at the code with folding.el
17 ;; This program is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by the Free
19 ;; Software Foundation; either version 2 of the License, or (at your option)
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
24 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with program; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30 ;; Boston, MA 02110-1301, USA.
32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
37 ;; ....................................................... &t-install ...
38 ;; Put this file on your Emacs-Lisp load path, add one of these into your
39 ;; ~/.emacs startup file
43 ;; (require 'tinylock)
45 ;; Autoload, your emacs starts up faster, prefered, but doesn't
46 ;; activate the auto locking feature.
48 ;; (autoload 'tinylock-lock "tinylock" "Lock emacs" t)
50 ;; ESC-l, suggested keybinding, replaces downcase-word binding
51 ;; because you can accomplish the same with C-x C-l,
54 ;; (global-set-key "\M-l" 'tinylock-lock) ;; Suggested keybinding.
57 ;; If you have any questions, use this function
59 ;; M-x tinylock-submit-feedback
61 ;; See also Example section at the end of file.
66 ;; ..................................................... &t-commentary ...
70 ;; Overview of features
72 ;; o Locks emacs completely until right key is entered.
73 ;; o Auto-locks emacs after NN minutes idle time
74 ;; o False login attemps are stored in history log.
75 ;; o Blanks display or displays message buffer when locked.
76 ;; o Hooks: before and after lock is activated and removed
78 ;; About locking procedure
80 ;; Don't get shocked now... When the lock gets in effect there must be
81 ;; no running processes inside emacs that would generate error and
82 ;; make emacs vulnerable to break in. That's why all the running
83 ;; processes are killed before the lock takes in effect. If you have
84 ;; some valuable processes that are constantly running, you must make
85 ;; a separate "process control" function that would restart any such
86 ;; processes. Use the appropriate hook to activate those processes
87 ;; again after the emacs is unlocked. Use hooks
89 ;; tinylock-:before-lock-hook ;; Save processes here
90 ;; tinylock-:after-lock-hook ;; restore processes here
92 ;; and following function which tells you what processes are running.
96 ;; All extra frames are also deleted. At least for now, because I
97 ;; don't know a reasonable way to save the frame configurations
98 ;; right now. Please send me piece of code or pointer to package
99 ;; that can save and restore frames and the windows back to previous
100 ;; state if you know good solution.
102 ;; About auto locking feature, Emacs prior 19.34
104 ;; When you load this package the `tinylock-:load-hook' runs
105 ;; `tinylock-install-lock-timer' command that setup up a timer process that
106 ;; wakes up periodically. If the emacs has not changed compared to
107 ;; last saved emacs state, then the auto locking takes in effect
110 ;; In old Emacs the activity is determined in simple way
112 ;; o if buffer list order has changed user is doing something.
113 ;; o if `switch-buffer' was used, user is doing something
114 ;; o if any buffer's size has changed, user is doing something.
116 ;; This checking may not be enough: if user just scroll some
117 ;; text in buffer for NN minutes, then from `tinylock-process' 's point of
118 ;; view there has not been any activity and the user may suddenly
119 ;; notice that emacs locks up. Doing nothing but viewing one buffer
120 ;; all the time is fortunately rare.
122 ;; About auto locking feature in new Emacs
124 ;; New Emacs releases have command `run-with-idle-timer' which we use
125 ;; if it is available. When there has been no activity for NN minutes,
126 ;; your Emacs locks up.
128 ;; The advice code and the other tricks we needed to detect idle
129 ;; activity in lower emacs versions aren't installed in these Emacs
130 ;; versions, so you don't have to worry about sudden lock.
132 ;; Auto lock password
134 ;; Do not put password in your ~/.emacs, but answer to the question
135 ;; which is asked when this file is loaded. If you want to change it
136 ;; during your emacs session, call function
138 ;; M-x tinylock-auto-lock-set-password
140 ;; Changing the auto lock interval
142 ;; The auto lock interval depends on the wake up time of timer
143 ;; process. The default time is 20 minutes when you load this
144 ;; file. You can change the time by calling
146 ;; M-x tinylock-auto-lock-set-interval
148 ;; Or by putting this code in your ~/.emacs
150 ;; ;; First define the hook, so that we can append to it
151 ;; (setq tinylock-:load-hook
152 ;; '(tinylock-timer-control tinylock-auto-lock-set-password)
154 ;; ;; add function to the end
155 ;; (add-hook 'tinylock-:load-hook 'my-tinylock-auto-lock-set-interval 'append)
158 ;; (defun my-tinylock-auto-lock-set-interval ()
159 ;; "Change interval to 10 minutes."
160 ;; (tinylock-auto-lock-set-interval 10))
174 ;; If this is not 19.34+, then we need advice code, otherwise it is
176 (unless (fboundp 'run-with-idle-timer)
178 (ti::package-package-require-timer))
180 (eval-when-compile (ti::package-use-dynamic-compilation))
182 (ti::package-defgroup-tiny TinyLock tinylock-: extensions
183 "Simple emacs locking utility.
186 o Locks emacs completely until right key is entered.
187 o Auto-locks emacs after XXX idle time
188 o False attemps are stored in history log.
189 o Blanks or displays buffer message when locked.
190 o Hooks: before and after lock is entered/removed")
193 ;;{{{ setup: variables
195 (defcustom tinylock-:load-hook nil
196 "*Hook run after file is loaded."
200 (defcustom tinylock-:before-lock-hook nil
201 "*Hook that is run when the locking process initiates.
202 This is your chance to save frame configurations or processes before
207 (defcustom tinylock-:after-lock-hook nil
208 "*Hook that is run after lock is removed."
212 ;;; ....................................................... &v-private ...
214 (defconst tinylock-:history nil
215 "\(DATE PASSWD\) A storage where attempts of entering locked Emacs is put.
216 Cleared every time lock takes effect.")
218 (defvar tinylock-:auto-lock-data nil
219 "Data to tell about the idle state, updated by timer process.
221 '(current-time ;; time stamp of user activity
223 (SIZE SIZE SIZE ..)) ;; every buffers size.")
225 (defvar tinylock-:auto-lock-password nil
226 "Password in auto lock situation.
227 Password is asked when you load this file. You shouldn't define
228 this in you ~/.emacs")
230 (defvar tinylock-:auto-lock-interval nil
231 "The timer interval in minutes. Use \\[tinylock-auto-lock-set-interval].")
233 (defvar tinylock-:idle-timer-process nil
234 "19.34+ timer process.")
236 ;;; ........................................................ &v-config ...
238 (defcustom tinylock-:login-error-sleep 2
239 "*Time in seconds that is waited until new login to is possible."
240 :type '(integer :tag "Seconds")
243 (defcustom tinylock-:buffer-login-history "*tinylock-hist*"
244 "*Buffer to output the history data."
248 (defcustom tinylock-:buffer-blank "*blank*"
249 "*Buffer name used when screen is blanked."
253 (defcustom tinylock-:blank-when-locked-flag t
254 "*Non-nil means show `tinylock-:buffer-blank' buffer."
261 ;;; ....................................................... &v-version ...
263 ;;;###autoload (autoload 'tinylock-version "tinylock" "Display commentary." t)
265 (ti::macrof-version-bug-report
269 "$Id: tinylock.el,v 2.42 2007/05/06 23:15:20 jaalto Exp $"
270 '(tinylock-:version-id
271 tinylock-:before-lock-hook
272 tinylock-:after-lock-hook
274 tinylock-:auto-lock-data
275 tinylock-:auto-lock-password
276 tinylock-:auto-lock-interval
277 tinylock-:idle-timer-process
278 tinylock-:login-error-sleep
279 tinylock-:buffer-login-history
280 tinylock-:buffer-blank
281 tinylock-:blank-when-locked-flag)))
284 ;;{{{ code: macros, advices
286 (defmacro tinylock-time-dd (time)
287 "Return Day from TIME."
288 (list 'string-to-int (list 'substring time 8 10)))
290 (defmacro tinylock-time-hh (time)
291 "Return hour from TIME."
292 (list 'string-to-int (list 'substring time -13 -11)))
295 (unless (fboundp 'run-with-idle-timer) ;we need this if not 19.34+
297 ;; What else easy means we have to tell that user is working with
300 ;; The advice shouldn't disturb normal emacs behavior and the functions
301 ;; calls are _inlined_, ie. function is expanded to point
302 ;; when byte compiled, so that the advice works as fast as possible
303 ;; and doesn't take time from the original function.
305 ;; (ti::advice-control '(switch-to-buffer other-window) "^til$" 'dis)
307 (defadvice switch-to-buffer (before til act) ;C-x C-b
308 "Tell to Emacs auto lock that there is user activity."
310 (inline (tinylock-user-activity))))
312 (defadvice execute-extended-command (before til act) ;; M-x called
313 "Tell to Emacs auto lock that there is user activity."
314 (if (interactive-p) (inline (tinylock-user-activity))))
316 (defadvice other-window (before til act) ;C-x o
317 "Tell to Emacs auto lock that there is user activity."
319 (inline (tinylock-user-activity))))))
322 ;;{{{ code: misc funcs
324 ;;; ----------------------------------------------------------------------
326 (defun tinylock-auto-lock-set-interval (minutes)
327 "Set new MINUTES interval by stopping and restarting timer process."
328 (interactive "Nminutes: ")
329 (tinylock-install-lock-timer nil minutes)
332 ;;; ----------------------------------------------------------------------
334 (defun tinylock-auto-lock-set-password ()
335 "Set auto lock password."
338 (if (ti::nil-p (setq pass (ti::query-read-input-as-password
339 "TinyLock, give autolock password: ")))
340 (error "Password is empty.")
341 (setq tinylock-:auto-lock-password pass))
344 ;;; ----------------------------------------------------------------------
346 (defun tinylock-process-on ()
347 "Start auto lock process."
348 (tinylock-install-lock-timer nil tinylock-:auto-lock-interval))
350 ;;; ----------------------------------------------------------------------
352 (defun tinylock-install-lock-timer (&optional uninstall interval)
353 "Install process that locks Emacs when there is no activity.
357 UNINSTALL `tinylock-process'
358 INTERVAL in minutes, by default 20."
360 ;; .......................................................... kill ...
361 (ti::compat-timer-cancel-function 'tinylock-process)
362 (setq tinylock-:idle-timer-process nil)
363 ;; .................................................... set values ...
364 (setq tinylock-:auto-lock-interval
366 tinylock-:auto-lock-interval
367 20)) ;Default 20 minutes
368 ;; ................................................... maybe start ...
371 ((fboundp 'run-with-idle-timer) ;19.34+
373 tinylock-:idle-timer-process
376 (* tinylock-:auto-lock-interval 60)
378 'tinylock-lock-now)))
380 (tinylock-process-data-set)
383 (* tinylock-:auto-lock-interval 60)
384 'tinylock-process))))
386 (message "Autolock process %s"
391 ;;; ----------------------------------------------------------------------
393 (defun tinylock-user-activity ()
394 "Tell to timer process that the has bee user activity."
396 (ignore-errors (setcar tinylock-:auto-lock-data (current-time)))
397 ;; Hmm, data is corrupted... reset it.
398 (tinylock-process-data-set)))
400 ;;; ----------------------------------------------------------------------
402 (defun tinylock-process-data-set ()
403 "Update timer process data."
404 (setq tinylock-:auto-lock-data
411 (with-current-buffer x
416 ;;; ----------------------------------------------------------------------
417 ;;; Just testing... (tinylock-process-data-set) (tinylock-process-data-unchanged-p)
419 (defun tinylock-process-data-unchanged-p ()
420 "Return t if timer data has not changed = No activity in."
421 (let* ((data tinylock-:auto-lock-data)
423 (buffer-list (nth 1 data))
424 (size-list (nth 2 data))
428 (if (null tinylock-:auto-lock-data)
429 (tinylock-process-data-set)
430 ;; o if buffer list order is the same, the user may not have
431 ;; done any new work...
432 ;; o Next we check if buffer sizes have changed, if not, then
433 ;; user hasn't done any work in emacs.
435 (and (> (ti::date-time-difference (current-time) time)
436 (- (* tinylock-:auto-lock-interval 60) 5)) ;5 sec timeframe
437 (equal list buffer-list)
441 (with-current-buffer elt
442 (if (not (eq (buffer-size)
444 ;; Found changed buffer, stop there and
445 ;; reset lock status, and quit the loop by
448 (setq list nil unchanged nil))
450 ;; Data is corrupted somehow, fix it.
452 (tinylock-process-data-set)))
455 ;;; ----------------------------------------------------------------------
457 (defun tinylock-process ()
458 "Lock up Emacs if it there has not been any user activity."
459 (when (tinylock-process-data-unchanged-p)
460 ;; When Emacs locks up, this function process will die too.
462 (tinylock-process-data-set))
464 ;;; ----------------------------------------------------------------------
466 (defun tinylock-add-history (passwd)
467 "Add login attempt to `tinylock-:history'.PASSWD is the attempted login password."
468 (let* ((d (current-time-string)))
469 (setq tinylock-:history
470 (append tinylock-:history
471 (list (list d passwd))))))
473 ;;; ----------------------------------------------------------------------
475 (defun tinylock-kill-process-control (&optional kill)
476 "Return all processes in string format, or KILL all processes (not timer)."
477 (let* ((list (process-list))
485 (setq ret (concat (or ret "") (prin1-to-string x))))
487 ;; let's not kill the timer
488 (if (not (string-match "display-time\\|timer"
489 (prin1-to-string x)))
490 (delete-process x))))))
494 ;;; ----------------------------------------------------------------------
497 (defun tinylock-history ()
498 "Displays login history. Optionally to given buffer BUFFER."
501 (switch-to-buffer-other-window
502 (get-buffer-create tinylock-:buffer-login-history))
504 (dolist (elt tinylock-:history)
505 (insert (format "%2d: %-27s %s\n" i (nth 0 elt) (or (nth 1 elt) "<nil>") ))
508 ;;; ----------------------------------------------------------------------
510 (defun tinylock-blank-control (&optional unblank)
511 "Blank display or UNBLANK."
512 (let* ((blank (get-buffer-create tinylock-:buffer-blank)))
515 (ti::kill-buffer-safe blank))
517 (ti::select-frame-non-dedicated)
518 (dolist (frame (delq (selected-frame) (frame-list)))
519 (delete-frame frame))
520 (switch-to-buffer blank t)
521 (delete-other-windows) ;delete all other windows
522 ;; This is necessary in 19.28 for some unknown reason
523 ;; otw, the sreen is not shown
529 ;;; ----------------------------------------------------------------------
531 (defun tinylock-lock-now ()
533 (tinylock-lock tinylock-:auto-lock-password "Autolocking.. emacs " 'doit ))
535 ;;; ------------------------------------------------------------ &main ---
538 (defun tinylock-lock (psw &optional msg lock-now)
539 "Lock Emacs with PSW password and MSG.
540 Message is displayed if LOCK-NOW is nil.
541 If LOCK-NOW is non-nil emacs is immediately locked with PSW."
545 (message "Now enter lock string...") (sit-for 1)
546 (ti::query-read-input-invisible))))
547 (let* ((cursor-in-echo-area nil)
548 ;; It's good programming style NOT to use globals directly
549 ;; inside code This way maintainer sees at glance what it uses.
550 (key-msg "This emacs is locked, enter key:")
551 (entry-err "Unauthorized access.")
552 (wait tinylock-:login-error-sleep)
554 (msg (or msg "Lock Emacs ? "))
558 (error "Password is empty."))
559 (if (and (null lock-now)
560 (null (y-or-n-p msg)))
562 (save-window-excursion
563 (run-hooks 'tinylock-:before-lock-hook))
564 ;; It's better to save work, you may forgot the password :-/
565 (save-some-buffers 'noAsk)
566 (ti::compat-timer-list-control 'save)
567 (tinylock-install-lock-timer 'kill) ;our process
568 (tinylock-kill-process-control 'kill) ;get rid of them
569 (ti::compat-timer-list-control 'kill) ;Stop all timers
570 (tinylock-blank-control)
571 ;; we need to restore windows config when we return
572 (save-window-excursion
574 ;; Now we make interrupting impossible, C-g won't work now on...
575 (setq inhibit-quit t)
576 (setq tinylock-:history nil) ;clear the log buffer
577 (message "TinyLock: Emacs LOCKED %s " (ti::date-standard-date))
581 (when (input-pending-p) ;wait for kbd event
587 (setq ans (ti::query-read-input-invisible))
589 ((string-equal ans psw)
590 (setq loop nil)) ; right password, let user in
592 (tinylock-add-history ans) ; record to log
595 (tinylock-blank-control 'unblank)
596 (message "TinyLock: Emacs unlocked %s" (ti::date-standard-date))
597 (setq quit-flag nil inhibit-quit nil) ; restore flags
598 (ti::compat-timer-list-control 'restore)
599 (tinylock-process-on)
600 (run-hooks 'tinylock-:after-lock-hook)
604 ;;{{{ Default: hook functions.
606 ;;; ----------------------------------------------------------------------
608 (defun tinylock-before-lock-function ()
609 "Saves emacs state, so that you can recover from accidental crash."
610 (when (fboundp 'tid-save-state)
611 (message "TinyLock: wait, using TinyDesk to save emacs state...")
612 (ti::funcall 'tid-save-state "~/emacs.lock-state.saved")
613 (message "TinyLock: wait, using TinyDesk to save emacs state...done.")))
615 ;;; ----------------------------------------------------------------------
617 (defun tinylock-after-lock-function ()
618 "Restores Emacs state after lock"
619 (display-time) ;re-enable process
620 (when (fboundp 'timi-report-install-maybe)
621 (ti::funcall 'timi-report-install-maybe)))
623 (add-hook 'tinylock-:load-hook 'tinylock-process-on)
625 ;; Ask lock password at startup
627 (if tinylock-:auto-lock-password
628 (remove-hook 'tinylock-:load-hook 'tinylock-auto-lock-set-password)
629 (add-hook 'tinylock-:load-hook 'tinylock-auto-lock-set-password))
631 (add-hook 'tinylock-:before-lock-hook 'tinylock-before-lock-function)
632 (add-hook 'tinylock-:after-lock-hook 'tinylock-after-lock-function)
637 (run-hooks 'tinylock-:load-hook)
639 ;;; tinylock.el ends here