795 lines
29 KiB
EmacsLisp
795 lines
29 KiB
EmacsLisp
|
;;; pause.el --- Take a break!
|
||
|
|
;;
|
||
|
|
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
|
||
|
|
;; Created: 2008-01-19 Sat
|
||
|
|
(defconst pause:version "0.70");; Version:
|
||
|
|
;; Last-Updated: 2010-01-18 Mon
|
||
|
|
;; URL:
|
||
|
|
;; Keywords:
|
||
|
|
;; Compatibility:
|
||
|
|
;;
|
||
|
|
;; Features that might be required by this library:
|
||
|
|
;;
|
||
|
|
;; None
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;;
|
||
|
|
;; If you are using Emacs then don't you need a little reminder to
|
||
|
|
;; take a pause? This library makes Emacs remind you of that. And
|
||
|
|
;; gives you a link to a yoga exercise to try in the pause.
|
||
|
|
;;
|
||
|
|
;; There are essentially two different ways to use this library.
|
||
|
|
;; Either you run a separate Emacs process that just reminds you of
|
||
|
|
;; pauses. To use it that way see `pause-start-in-new-emacs'.
|
||
|
|
;;
|
||
|
|
;; Or run it in the current Emacs. To do that add to your .emacs
|
||
|
|
;;
|
||
|
|
;; (require 'pause)
|
||
|
|
;;
|
||
|
|
;; and do
|
||
|
|
;;
|
||
|
|
;; M-x customize-group RET pause RET
|
||
|
|
;;
|
||
|
|
;; and set `pause-mode' to t.
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;; Note: I am unsure if it works on all systems to use a separate
|
||
|
|
;; Emacs process. It does work on w32 though. Please tell me
|
||
|
|
;; about other systems.
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Change log:
|
||
|
|
;;
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;; This program 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 2, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program 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 this program; see the file COPYING. If not, write to
|
||
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
|
|
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
|
;;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;
|
||
|
|
;;; Code:
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defgroup pause nil
|
||
|
|
"Customize your health personal Emacs health saver!"
|
||
|
|
:group 'convenience)
|
||
|
|
|
||
|
|
(defcustom pause-after-minutes 15
|
||
|
|
"Pause after this number of minutes."
|
||
|
|
:type 'number
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-1-minute-delay 60
|
||
|
|
"Number of seconds to wait in 1 minutes delay."
|
||
|
|
:type 'number
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-idle-delay 5
|
||
|
|
"Seconds to wait for user to be idle before pause."
|
||
|
|
:type 'number
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-even-if-not-in-emacs t
|
||
|
|
"Jump up pause even if not in Emacs."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-restart-anyway-after 2
|
||
|
|
"If user does not use Emacs restart timer after this minutes.
|
||
|
|
This is used when a user has clicked a link."
|
||
|
|
:type 'number
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-tell-again-after 2
|
||
|
|
"If user does not exit pause tell again after this minutes."
|
||
|
|
:type 'number
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-extra-fun 'pause-start-get-yoga-poses
|
||
|
|
"Function to call for extra fun when pausing.
|
||
|
|
Default is to show a link to a yoga exercise (recommended!).
|
||
|
|
|
||
|
|
Set this variable to nil if you do not want any extra fun.
|
||
|
|
|
||
|
|
If this variable's value is a function it will be called when the
|
||
|
|
pause frame has just been shown."
|
||
|
|
:type '(choice (function :tag "Extra function")
|
||
|
|
(const :tag "No extra function" nil))
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defvar pause-exited-from-button nil)
|
||
|
|
|
||
|
|
(defcustom pause-background-color "orange"
|
||
|
|
"Background color during pause."
|
||
|
|
:type 'color
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-mode-line-color "sienna"
|
||
|
|
"Mode line color during pause."
|
||
|
|
:type 'color
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-1-minute-mode-line-color "yellow"
|
||
|
|
"Mode line color during 1 minute phase of pause."
|
||
|
|
:type 'color
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defface pause-text-face
|
||
|
|
'((t (:foreground "sienna" :height 1.5 :bold t)))
|
||
|
|
"Face main text in pause buffer."
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defface pause-info-text-face
|
||
|
|
'((t (:foreground "yellow")))
|
||
|
|
"Face info text in pause buffer."
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defface pause-message-face
|
||
|
|
'((t (:inherit secondary-selection)))
|
||
|
|
"Face for pause messages."
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defface pause-1-minute-message-face
|
||
|
|
'((t (:inherit mode-line-inactive)))
|
||
|
|
"Face for pause messages."
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defcustom pause-break-text
|
||
|
|
(concat "\n\tHi there,"
|
||
|
|
"\n\tYou are worth a PAUSE!"
|
||
|
|
"\n\nTry some mindfulness:"
|
||
|
|
"\n\t- Look around and observe."
|
||
|
|
"\n\t- Listen."
|
||
|
|
"\n\t- Feel your body.")
|
||
|
|
"Text to show during pause."
|
||
|
|
:type 'integer
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
(defvar pause-el-file (or load-file-name
|
||
|
|
(when (boundp 'bytecomp-filename) bytecomp-filename)
|
||
|
|
buffer-file-name))
|
||
|
|
|
||
|
|
(defvar pause-default-img-dir
|
||
|
|
(let ((this-dir (file-name-directory pause-el-file)))
|
||
|
|
(expand-file-name "../etc/img/pause/" this-dir)))
|
||
|
|
|
||
|
|
(defcustom pause-img-dir pause-default-img-dir
|
||
|
|
"Image directory for pause.
|
||
|
|
A random image is choosen from this directory for pauses."
|
||
|
|
:type 'directory
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(defvar pause-timer nil)
|
||
|
|
|
||
|
|
;;(defvar pause-break-exit-calls nil)
|
||
|
|
|
||
|
|
(defun pause-start-timer ()
|
||
|
|
(pause-start-timer-1 (* 60 pause-after-minutes)))
|
||
|
|
|
||
|
|
(defun pause-start-timer-1 (sec)
|
||
|
|
(pause-cancel-timer)
|
||
|
|
(setq pause-timer (run-with-timer sec nil 'pause-pre-break)))
|
||
|
|
|
||
|
|
(defun pause-one-minute ()
|
||
|
|
"Give you another minute ..."
|
||
|
|
(pause-start-timer-1 pause-1-minute-delay)
|
||
|
|
(message (propertize " OK, I will come back in a minute! -- greatings from pause"
|
||
|
|
'face 'pause-message-face)))
|
||
|
|
|
||
|
|
(defun pause-save-me ()
|
||
|
|
(pause-start-timer)
|
||
|
|
(message (propertize " OK, I will save you again in %d minutes! -- greatings from pause "
|
||
|
|
'face 'pause-message-face)
|
||
|
|
pause-after-minutes))
|
||
|
|
|
||
|
|
(defun pause-pre-break ()
|
||
|
|
(condition-case err
|
||
|
|
(save-match-data ;; runs in timer
|
||
|
|
(pause-cancel-timer)
|
||
|
|
(setq pause-timer (run-with-idle-timer pause-idle-delay nil 'pause-break-in-timer)))
|
||
|
|
(error
|
||
|
|
(lwarn 'pause-pre-break
|
||
|
|
:error "%s" (error-message-string err)))))
|
||
|
|
|
||
|
|
(defvar pause-break-mode-map
|
||
|
|
(let ((map (make-sparse-keymap)))
|
||
|
|
(define-key map [(control meta shift ?p)] 'pause-break-exit)
|
||
|
|
(define-key map [tab] 'forward-button)
|
||
|
|
(define-key map [(meta tab)] 'backward-button)
|
||
|
|
(define-key map [(shift tab)] 'backward-button)
|
||
|
|
(define-key map [backtab] 'backward-button)
|
||
|
|
map))
|
||
|
|
|
||
|
|
(defvar pause-buffer nil)
|
||
|
|
(defvar pause-frame nil)
|
||
|
|
|
||
|
|
(define-derived-mode pause-break-mode nil "Pause"
|
||
|
|
"Mode used during pause in pause buffer.
|
||
|
|
|
||
|
|
It defines the following key bindings:
|
||
|
|
|
||
|
|
\\{pause-break-mode-map}"
|
||
|
|
(set (make-local-variable 'buffer-read-only) t)
|
||
|
|
(setq show-trailing-whitespace nil)
|
||
|
|
;;(set (make-local-variable 'cursor-type) nil)
|
||
|
|
;; Fix-me: workaround for emacs bug
|
||
|
|
;;(run-with-idle-timer 0 nil 'pause-hide-cursor)
|
||
|
|
)
|
||
|
|
|
||
|
|
;; Fix-me: make one state var
|
||
|
|
(defvar pause-break-exit-active nil)
|
||
|
|
(defvar pause-break-1-minute-state nil)
|
||
|
|
|
||
|
|
|
||
|
|
(defun pause-break ()
|
||
|
|
(pause-cancel-timer)
|
||
|
|
(let ((wcfg (current-frame-configuration))
|
||
|
|
(old-mode-line-bg (face-attribute 'mode-line :background))
|
||
|
|
old-frame-bg-color
|
||
|
|
old-frame-left-fringe
|
||
|
|
old-frame-right-fringe
|
||
|
|
old-frame-tool-bar-lines
|
||
|
|
old-frame-menu-bar-lines
|
||
|
|
old-frame-vertical-scroll-bars)
|
||
|
|
(dolist (f (frame-list))
|
||
|
|
(add-to-list 'old-frame-bg-color (cons f (frame-parameter f 'background-color)))
|
||
|
|
(add-to-list 'old-frame-left-fringe (cons f (frame-parameter f 'left-fringe)))
|
||
|
|
(add-to-list 'old-frame-right-fringe (cons f (frame-parameter f 'right-fringe)))
|
||
|
|
(add-to-list 'old-frame-tool-bar-lines (cons f (frame-parameter f 'tool-bar-lines)))
|
||
|
|
(add-to-list 'old-frame-menu-bar-lines (cons f (frame-parameter f 'menu-bar-lines)))
|
||
|
|
(add-to-list 'old-frame-vertical-scroll-bars (cons f (frame-parameter f 'vertical-scroll-bars))))
|
||
|
|
|
||
|
|
;; Fix-me: Something goes wrong with the window configuration, try a short pause
|
||
|
|
(remove-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
(run-with-idle-timer 0.2 nil 'pause-break-show)
|
||
|
|
(setq pause-break-exit-active nil)
|
||
|
|
(setq pause-break-1-minute-state nil) ;; set in `pause-break-show'
|
||
|
|
(setq pause-exited-from-button nil)
|
||
|
|
(unwind-protect
|
||
|
|
(let ((n 0)
|
||
|
|
(debug-on-error nil))
|
||
|
|
(while (and (> 3 (setq n (1+ n)))
|
||
|
|
(not pause-break-exit-active)
|
||
|
|
(not pause-break-1-minute-state))
|
||
|
|
(condition-case err
|
||
|
|
(recursive-edit)
|
||
|
|
(error (message "%s" (error-message-string err))))
|
||
|
|
(unless (or pause-break-exit-active
|
||
|
|
pause-break-1-minute-state)
|
||
|
|
(when (> 2 n) (message "Too early to pause (%s < 2)" n))
|
||
|
|
(add-hook 'window-configuration-change-hook 'pause-break-exit))))
|
||
|
|
|
||
|
|
(remove-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
(pause-tell-again-cancel-timer)
|
||
|
|
;;(set-frame-parameter nil 'background-color "white")
|
||
|
|
(dolist (f (frame-list))
|
||
|
|
(set-frame-parameter f 'background-color (cdr (assq f old-frame-bg-color)))
|
||
|
|
(set-frame-parameter f 'left-fringe (cdr (assq f old-frame-left-fringe)))
|
||
|
|
(set-frame-parameter f 'right-fringe (cdr (assq f old-frame-right-fringe)))
|
||
|
|
(set-frame-parameter f 'tool-bar-lines (cdr (assq f old-frame-tool-bar-lines)))
|
||
|
|
(set-frame-parameter f 'menu-bar-lines (cdr (assq f old-frame-menu-bar-lines)))
|
||
|
|
(set-frame-parameter f 'vertical-scroll-bars (cdr (assq f old-frame-vertical-scroll-bars))))
|
||
|
|
;; Fix-me: The frame grows unless we do redisplay here:
|
||
|
|
(redisplay t)
|
||
|
|
(set-frame-configuration wcfg t)
|
||
|
|
(when pause-frame(lower-frame pause-frame))
|
||
|
|
(set-face-attribute 'mode-line nil :background old-mode-line-bg)
|
||
|
|
(run-with-idle-timer 2.0 nil 'run-hooks 'pause-break-exit-hook)
|
||
|
|
(kill-buffer pause-buffer)
|
||
|
|
(cond (pause-exited-from-button
|
||
|
|
;; Do not start timer until we start working again.
|
||
|
|
(run-with-idle-timer 1 nil 'add-hook 'post-command-hook 'pause-save-me-post-command)
|
||
|
|
;; But if we do not do that within some minutes then start timer anyway.
|
||
|
|
(run-with-idle-timer (* 60 pause-restart-anyway-after) nil 'pause-save-me))
|
||
|
|
(pause-break-1-minute-state
|
||
|
|
(run-with-idle-timer 0 nil 'pause-one-minute))
|
||
|
|
(t
|
||
|
|
(run-with-idle-timer 0 nil 'pause-save-me))))))
|
||
|
|
|
||
|
|
(defun pause-save-me-post-command ()
|
||
|
|
(pause-start-timer))
|
||
|
|
|
||
|
|
(defvar pause-break-exit-hook nil
|
||
|
|
"Hook run after break exit.
|
||
|
|
Frame configuration has been restored when this is run.
|
||
|
|
Please note that it is run in a timer.")
|
||
|
|
|
||
|
|
(defun pause-break-show ()
|
||
|
|
;; In timer
|
||
|
|
(save-match-data
|
||
|
|
(condition-case err
|
||
|
|
(pause-break-show-1)
|
||
|
|
(error
|
||
|
|
;;(remove-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
(pause-break-exit)
|
||
|
|
(message "pause-break-show error: %s" (error-message-string err))))))
|
||
|
|
|
||
|
|
(defvar pause-break-last-wcfg-change (float-time))
|
||
|
|
|
||
|
|
(defun pause-break-show-1 ()
|
||
|
|
;; Do these first if something goes wrong.
|
||
|
|
(setq pause-break-last-wcfg-change (float-time))
|
||
|
|
;;(run-with-idle-timer (* 1.5 (length (frame-list))) nil 'add-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
|
||
|
|
;; fix-me: temporary:
|
||
|
|
;;(add-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
(unless pause-extra-fun (run-with-idle-timer 1 nil 'pause-break-message))
|
||
|
|
(run-with-idle-timer 10 nil 'pause-break-exit-activate)
|
||
|
|
(setq pause-break-1-minute-state t)
|
||
|
|
(set-face-attribute 'mode-line nil :background pause-1-minute-mode-line-color)
|
||
|
|
(with-current-buffer (setq pause-buffer
|
||
|
|
(get-buffer-create "* P A U S E *"))
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(erase-buffer)
|
||
|
|
(pause-break-mode)
|
||
|
|
(setq left-margin-width 25)
|
||
|
|
(pause-insert-img)
|
||
|
|
(insert (propertize pause-break-text 'face 'pause-text-face))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(when (search-forward "mindfulness" nil t)
|
||
|
|
(make-text-button (- (point) 11) (point)
|
||
|
|
'face '(:inherit pause-text-face :underline t)
|
||
|
|
'action (lambda (btn)
|
||
|
|
(browse-url "http://www.jimhopper.com/mindfulness/"))))
|
||
|
|
(goto-char (point-max))
|
||
|
|
(insert (propertize "\n\nClick on a link below to exit pause\n" 'face 'pause-info-text-face))
|
||
|
|
;;(add-text-properties (point-min) (point-max) (list 'keymap (make-sparse-keymap)))
|
||
|
|
(insert-text-button "Exit pause"
|
||
|
|
'action `(lambda (button)
|
||
|
|
(condition-case err
|
||
|
|
(pause-break-exit-from-button)
|
||
|
|
(error (message "%s" (error-message-string err))))))
|
||
|
|
(insert "\n")
|
||
|
|
(dolist (m '(hl-needed-mode))
|
||
|
|
(when (and (boundp m) (symbol-value m))
|
||
|
|
(funcall m -1)))))
|
||
|
|
(dolist (f (frame-list))
|
||
|
|
(pause-max-frame f))
|
||
|
|
(pause-tell-again)
|
||
|
|
(when pause-extra-fun (funcall pause-extra-fun))
|
||
|
|
;;(setq pause-break-exit-calls 0)
|
||
|
|
(setq pause-break-last-wcfg-change (float-time))
|
||
|
|
(pause-tell-again-start-timer))
|
||
|
|
|
||
|
|
(defun pause-max-frame (f)
|
||
|
|
(let* ((avail-width (- (display-pixel-width)
|
||
|
|
(* 2 (frame-parameter f 'border-width))
|
||
|
|
(* 2 (frame-parameter f 'internal-border-width))))
|
||
|
|
(avail-height (- (display-pixel-height)
|
||
|
|
(* 2 (frame-parameter f 'border-width))
|
||
|
|
(* 2 (frame-parameter f 'internal-border-width))))
|
||
|
|
(cols (/ avail-width (frame-char-width)))
|
||
|
|
(rows (- (/ avail-height (frame-char-height)) 2)))
|
||
|
|
;;(set-frame-parameter (selected-frame) 'fullscreen 'fullboth)
|
||
|
|
;;(set-frame-parameter (selected-frame) 'fullscreen 'maximized)
|
||
|
|
(setq pause-break-last-wcfg-change (float-time))
|
||
|
|
(with-selected-frame f
|
||
|
|
(delete-other-windows (frame-first-window f))
|
||
|
|
(with-selected-window (frame-first-window)
|
||
|
|
(switch-to-buffer pause-buffer)
|
||
|
|
(goto-char (point-max))))
|
||
|
|
(modify-frame-parameters f
|
||
|
|
`((background-color . ,pause-background-color)
|
||
|
|
(left-fringe . 0)
|
||
|
|
(right-fringe . 0)
|
||
|
|
(tool-bar-lines . 0)
|
||
|
|
(menu-bar-lines . 0)
|
||
|
|
(vertical-scroll-bars . nil)
|
||
|
|
(left . 0)
|
||
|
|
(top . 0)
|
||
|
|
(width . ,cols)
|
||
|
|
(height . ,rows)
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defvar pause-tell-again-timer nil)
|
||
|
|
|
||
|
|
(defun pause-tell-again-start-timer ()
|
||
|
|
(pause-tell-again-cancel-timer)
|
||
|
|
(setq pause-tell-again-timer
|
||
|
|
(run-with-idle-timer (* 60 pause-tell-again-after) t 'pause-tell-again)))
|
||
|
|
|
||
|
|
(defun pause-tell-again-cancel-timer ()
|
||
|
|
(when (timerp pause-tell-again-timer)
|
||
|
|
(cancel-timer pause-tell-again-timer))
|
||
|
|
(setq pause-tell-again-timer nil))
|
||
|
|
|
||
|
|
(defun pause-tell-again ()
|
||
|
|
(when (and window-system pause-even-if-not-in-emacs)
|
||
|
|
(pause-max-frame pause-frame)
|
||
|
|
(raise-frame pause-frame)))
|
||
|
|
|
||
|
|
|
||
|
|
(defun pause-break-message ()
|
||
|
|
(when (/= 0 (recursion-depth))
|
||
|
|
(message "%s" (propertize "Please take a pause! (Or exit now to take it in 1 minute.)"
|
||
|
|
'face 'pause-1-minute-message-face))))
|
||
|
|
|
||
|
|
(defun pause-break-exit-activate ()
|
||
|
|
(when (/= 0 (recursion-depth))
|
||
|
|
(setq pause-break-exit-active t)
|
||
|
|
(setq pause-break-1-minute-state nil)
|
||
|
|
(set-face-attribute 'mode-line nil :background pause-mode-line-color)
|
||
|
|
(message nil)
|
||
|
|
(with-current-buffer pause-buffer
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
;; Fix-me: This interfere with text buttons.
|
||
|
|
;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
|
||
|
|
))))
|
||
|
|
|
||
|
|
(defun pause-break-exit ()
|
||
|
|
(interactive)
|
||
|
|
(let ((elapsed (- (float-time) pause-break-last-wcfg-change)))
|
||
|
|
;;(message "elapsed=%s pause-break-last-wcfg-change=%s" elapsed pause-break-last-wcfg-change)
|
||
|
|
(setq pause-break-last-wcfg-change (float-time))
|
||
|
|
(when (> elapsed 1.0)
|
||
|
|
(setq pause-break-exit-active t)
|
||
|
|
(remove-hook 'window-configuration-change-hook 'pause-break-exit)
|
||
|
|
;;(pause-tell-again-cancel-timer)
|
||
|
|
(when (/= 0 (recursion-depth))
|
||
|
|
(exit-recursive-edit)))))
|
||
|
|
|
||
|
|
(defun pause-break-exit-from-button ()
|
||
|
|
(setq pause-break-1-minute-state nil)
|
||
|
|
(setq pause-exited-from-button t)
|
||
|
|
(pause-break-exit))
|
||
|
|
|
||
|
|
(defun pause-insert-img ()
|
||
|
|
(let* ((inhibit-read-only t)
|
||
|
|
img
|
||
|
|
src
|
||
|
|
(slice '(0 0 200 300))
|
||
|
|
(imgs (directory-files pause-img-dir nil nil t))
|
||
|
|
skip
|
||
|
|
)
|
||
|
|
(setq imgs (delete nil
|
||
|
|
(mapcar (lambda (d)
|
||
|
|
(unless (file-directory-p d) d))
|
||
|
|
imgs)))
|
||
|
|
(if (not imgs)
|
||
|
|
(setq img "No images found")
|
||
|
|
(setq skip (random (length imgs)))
|
||
|
|
(while (> skip 0)
|
||
|
|
(setq skip (1- skip))
|
||
|
|
(setq imgs (cdr imgs)))
|
||
|
|
(setq src (expand-file-name (car imgs) pause-img-dir))
|
||
|
|
(if (file-exists-p src)
|
||
|
|
(condition-case err
|
||
|
|
(setq img (create-image src nil nil
|
||
|
|
:relief 1
|
||
|
|
;;:margin inlimg-margins
|
||
|
|
))
|
||
|
|
(error (setq img (error-message-string err))))
|
||
|
|
(setq img (concat "Image not found: " src))))
|
||
|
|
(if (stringp img)
|
||
|
|
(insert img)
|
||
|
|
(insert-image img nil 'left-margin slice)
|
||
|
|
)
|
||
|
|
))
|
||
|
|
|
||
|
|
(defun pause-hide-cursor ()
|
||
|
|
;; runs in timer, save-match-data
|
||
|
|
(with-current-buffer pause-buffer
|
||
|
|
(set (make-local-variable 'cursor-type) nil)))
|
||
|
|
|
||
|
|
(defun pause-cancel-timer ()
|
||
|
|
(remove-hook 'post-command-hook 'pause-save-me-post-command)
|
||
|
|
(when (timerp pause-timer) (cancel-timer pause-timer))
|
||
|
|
(setq pause-timer nil))
|
||
|
|
|
||
|
|
(defun pause-break-in-timer ()
|
||
|
|
(save-match-data ;; runs in timer
|
||
|
|
(pause-cancel-timer)
|
||
|
|
(if (or (active-minibuffer-window)
|
||
|
|
(and (boundp 'edebug-active)
|
||
|
|
edebug-active))
|
||
|
|
(let ((pause-idle-delay 5))
|
||
|
|
(pause-pre-break))
|
||
|
|
(let ((there-was-an-error nil))
|
||
|
|
(condition-case err
|
||
|
|
(pause-break)
|
||
|
|
(error
|
||
|
|
(setq there-was-an-error t)))
|
||
|
|
(when there-was-an-error
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(select-frame last-event-frame)
|
||
|
|
(let ((pause-idle-delay nil))
|
||
|
|
(pause-pre-break)))
|
||
|
|
(error
|
||
|
|
(lwarn 'pause-break-in-timer2 :error "%s" (error-message-string err))
|
||
|
|
)))))))
|
||
|
|
|
||
|
|
(defcustom pause-only-when-server-mode t
|
||
|
|
"Allow `pause-mode' inly in the Emacs that has server-mode enabled.
|
||
|
|
This is to prevent multiple Emacs with `pause-mode'."
|
||
|
|
:type 'boolean
|
||
|
|
:group 'pause)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-minor-mode pause-mode
|
||
|
|
"This minor mode tries to make you take a break.
|
||
|
|
It will jump up and temporary stop your work - even if you are
|
||
|
|
not in Emacs. If you are in Emacs it will however try to be
|
||
|
|
gentle and wait until you have been idle with the keyboard for a
|
||
|
|
short while. \(If you are not in Emacs it can't be gentle. How
|
||
|
|
could it?)
|
||
|
|
|
||
|
|
Then it will show you a special screen with a link to a yoga
|
||
|
|
exercise you can do when you pause.
|
||
|
|
|
||
|
|
After the pause you continue your work where you were
|
||
|
|
interrupted."
|
||
|
|
:global t
|
||
|
|
:group 'pause
|
||
|
|
:set-after '(server-mode)
|
||
|
|
(if pause-mode
|
||
|
|
(if (and pause-only-when-server-mode
|
||
|
|
(not server-mode)
|
||
|
|
(not (with-no-warnings (called-interactively-p))))
|
||
|
|
(progn
|
||
|
|
(setq pause-mode nil)
|
||
|
|
(message "Pause mode canceled because not server-mode"))
|
||
|
|
(pause-start-timer))
|
||
|
|
(pause-cancel-timer)))
|
||
|
|
|
||
|
|
;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-temp-err)")
|
||
|
|
;; (emacs-Q "-l" buffer-file-name "--eval" "(run-with-timer 1 nil 'pause-temp-err)")
|
||
|
|
;; (pause-temp-err)
|
||
|
|
(defun pause-temp-err ()
|
||
|
|
(switch-to-buffer (get-buffer-create "pause-temp-err buffer"))
|
||
|
|
(setq buffer-read-only t)
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(add-text-properties (point-min) (point-max) (list 'keymap nil))
|
||
|
|
(insert-text-button "click to test"
|
||
|
|
'action (lambda (btn)
|
||
|
|
(message "Click worked")))
|
||
|
|
;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
|
||
|
|
))
|
||
|
|
|
||
|
|
;; (customize-group-other-window 'pause)
|
||
|
|
;; (apply 'custom-set-variables (pause-get-group-saved-customizations 'pause custom-file))
|
||
|
|
;; (pause-get-group-saved-customizations 'w32shell custom-file)
|
||
|
|
(defun pause-get-group-saved-customizations (group cus-file)
|
||
|
|
"Return customizations saved for GROUP in CUS-FILE."
|
||
|
|
(let* ((cus-buf (find-buffer-visiting cus-file))
|
||
|
|
(cus-old cus-buf)
|
||
|
|
(cus-point (when cus-old (with-current-buffer cus-old (point))))
|
||
|
|
(cusg-all (get group 'custom-group))
|
||
|
|
(cusg-vars (delq nil (mapcar (lambda (elt)
|
||
|
|
(when (eq (nth 1 elt) 'custom-variable)
|
||
|
|
(car elt)))
|
||
|
|
cusg-all)))
|
||
|
|
cus-vars-form
|
||
|
|
cus-face-form
|
||
|
|
cus-saved-vars
|
||
|
|
cus-saved-face)
|
||
|
|
(unless cus-buf (setq cus-buf (find-file-noselect cus-file)))
|
||
|
|
(with-current-buffer cus-buf
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(goto-char (point-min))
|
||
|
|
(while (progn
|
||
|
|
(while (progn (skip-chars-forward " \t\n\^l")
|
||
|
|
(looking-at ";"))
|
||
|
|
(forward-line 1))
|
||
|
|
(not (eobp)))
|
||
|
|
(let ((form (read (current-buffer))))
|
||
|
|
(cond
|
||
|
|
((eq (car form) 'custom-set-variables)
|
||
|
|
(setq cus-vars-form form))
|
||
|
|
((eq (car form) 'custom-set-faces)
|
||
|
|
(setq cus-face-form form))
|
||
|
|
)))))
|
||
|
|
(dolist (vl (cdr cus-vars-form))
|
||
|
|
(when (memq (car (cadr vl)) cusg-vars)
|
||
|
|
(setq cus-saved-vars (cons (cadr vl) cus-saved-vars))))
|
||
|
|
cus-saved-vars))
|
||
|
|
|
||
|
|
;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-start 0.1 nil)")
|
||
|
|
(defun pause-start (after-minutes cus-file)
|
||
|
|
"Start `pause-mode' with interval AFTER-MINUTES.
|
||
|
|
This bypasses `pause-only-when-server-mode'.
|
||
|
|
|
||
|
|
You can use this funciton to start a separate Emacs process that
|
||
|
|
handles pause, for example like this if you want a pause every 15
|
||
|
|
minutes:
|
||
|
|
|
||
|
|
emacs -Q -l pause --eval \"(pause-start 15 nil)\"
|
||
|
|
|
||
|
|
Note: Another easier alternative might be to use
|
||
|
|
`pause-start-in-new-emacs'."
|
||
|
|
(interactive "nPause after how many minutes: ")
|
||
|
|
(pause-start-1 after-minutes cus-file))
|
||
|
|
|
||
|
|
(defun pause-start-1 (after-minutes cus-file)
|
||
|
|
(setq debug-on-error t)
|
||
|
|
(pause-cancel-timer)
|
||
|
|
(when (and cus-file (file-exists-p cus-file))
|
||
|
|
(let ((args (pause-get-group-saved-customizations 'pause cus-file)))
|
||
|
|
;;(message "cus-file=%S" cus-file)
|
||
|
|
;;(message "args=%S" args)
|
||
|
|
(apply 'custom-set-variables args)))
|
||
|
|
(setq pause-after-minutes after-minutes)
|
||
|
|
(let ((pause-only-when-server-mode nil))
|
||
|
|
(pause-mode 1))
|
||
|
|
(switch-to-buffer (get-buffer-create "Pause information"))
|
||
|
|
(insert (propertize "Emacs pause\n"
|
||
|
|
'face '(:inherit variable-pitch :height 1.5)))
|
||
|
|
(insert (format "Pausing every %d minute.\n" after-minutes))
|
||
|
|
(insert "Or, ")
|
||
|
|
(insert-text-button "pause now"
|
||
|
|
'action `(lambda (button)
|
||
|
|
(condition-case err
|
||
|
|
(pause-break)
|
||
|
|
(error (message "%s" (error-message-string err))))))
|
||
|
|
(insert "!\n")
|
||
|
|
;;(setq buffer-read-only t)
|
||
|
|
(pause-break-mode)
|
||
|
|
(delete-other-windows)
|
||
|
|
(setq mode-line-format nil)
|
||
|
|
(setq pause-frame (selected-frame))
|
||
|
|
(message nil)
|
||
|
|
(set-frame-parameter nil 'background-color pause-background-color))
|
||
|
|
|
||
|
|
;; (pause-start-in-new-emacs 0.3)
|
||
|
|
;; (pause-start-in-new-emacs 15)
|
||
|
|
;;;###autoload
|
||
|
|
(defun pause-start-in-new-emacs (after-minutes)
|
||
|
|
"Start pause with interval AFTER-MINUTES in a new Emacs instance.
|
||
|
|
The new Emacs instance will be started with -Q. However if
|
||
|
|
`custom-file' is non-nil it will be loaded so you can still
|
||
|
|
customize pause.
|
||
|
|
|
||
|
|
One way of using this function may be to put in your .emacs
|
||
|
|
something like
|
||
|
|
|
||
|
|
;; for just one Emacs running pause
|
||
|
|
(when server-mode (pause-start-in-new-emacs 15))
|
||
|
|
|
||
|
|
See `pause-start' for more info.
|
||
|
|
|
||
|
|
"
|
||
|
|
(interactive (list pause-after-minutes))
|
||
|
|
(let* ((this-emacs (locate-file invocation-name
|
||
|
|
(list invocation-directory)
|
||
|
|
exec-suffixes))
|
||
|
|
(cus-file (if custom-file custom-file "~/.emacs"))
|
||
|
|
(args `("-l" ,pause-el-file
|
||
|
|
"--geometry=40x3"
|
||
|
|
"-D"
|
||
|
|
"--eval" ,(format "(pause-start %s %S)" after-minutes cus-file))))
|
||
|
|
(setq args (cons "-Q" args))
|
||
|
|
(apply 'call-process this-emacs nil 0 nil args)))
|
||
|
|
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Link to yoga poses
|
||
|
|
|
||
|
|
;; (defun w3-download-callback (fname)
|
||
|
|
;; (let ((coding-system-for-write 'binary))
|
||
|
|
;; (goto-char (point-min))
|
||
|
|
;; (search-forward "\n\n" nil t)
|
||
|
|
;; (write-region (point) (point-max) fname))
|
||
|
|
;; (url-mark-buffer-as-dead (current-buffer))
|
||
|
|
;; (message "Download of %s complete." (url-view-url t))
|
||
|
|
;; (sit-for 3))
|
||
|
|
|
||
|
|
;;(run-with-idle-timer 0 nil 'pause-get-yoga-poses)
|
||
|
|
(defvar pause-yoga-poses-host-url "http://www.abc-of-yoga.com/")
|
||
|
|
|
||
|
|
;;(pause-start-get-yoga-poses)
|
||
|
|
(defun pause-start-get-yoga-poses ()
|
||
|
|
(require 'url-vars)
|
||
|
|
(let ((url-show-status nil)) ;; do not show download messages
|
||
|
|
(url-retrieve (concat pause-yoga-poses-host-url "yogapractice/mountain.asp")
|
||
|
|
'pause-callback-get-yoga-poses)))
|
||
|
|
|
||
|
|
(defun pause-callback-get-yoga-poses (status)
|
||
|
|
(let ((pose (pause-random-yoga-pose (pause-get-yoga-poses-1 (current-buffer)))))
|
||
|
|
(message nil)
|
||
|
|
(when (and pose (buffer-live-p pause-buffer))
|
||
|
|
(pause-insert-yoga-link pose))))
|
||
|
|
|
||
|
|
(defun pause-insert-yoga-link (pose)
|
||
|
|
(with-current-buffer pause-buffer
|
||
|
|
(let ((here (point))
|
||
|
|
(inhibit-read-only t)
|
||
|
|
(pose-url (concat pause-yoga-poses-host-url (car pose))))
|
||
|
|
(goto-char (point-max))
|
||
|
|
(insert "Link to yoga posture for you: ")
|
||
|
|
(insert-text-button (cdr pose)
|
||
|
|
'action `(lambda (button)
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(browse-url ,pose-url)
|
||
|
|
(run-with-idle-timer 1 nil 'pause-break-exit-from-button))
|
||
|
|
(error (message "%s" (error-message-string err))))))
|
||
|
|
(insert "\n")
|
||
|
|
(pause-break-message))))
|
||
|
|
|
||
|
|
(defun pause-get-yoga-poses ()
|
||
|
|
(let* ((url-show-status nil) ;; do not show download messages
|
||
|
|
(buf (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp")))
|
||
|
|
(pause-get-yoga-poses-1 buf)))
|
||
|
|
|
||
|
|
;; (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
|
||
|
|
;; (setq x (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
|
||
|
|
|
||
|
|
;; (defun temp-y ()
|
||
|
|
;; (message "before y")
|
||
|
|
;; ;;(setq y (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
|
||
|
|
;; (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
|
||
|
|
;; (message "after x")
|
||
|
|
;; )
|
||
|
|
;; (run-with-idle-timer 0 nil 'temp-y)
|
||
|
|
|
||
|
|
(defun pause-get-yoga-poses-1 (buf)
|
||
|
|
(require 'url)
|
||
|
|
(setq url-debug t)
|
||
|
|
;; url-insert-file-contents
|
||
|
|
(let* ((first-marker "<p>These are all the Yoga Poses covered in this section:</p>")
|
||
|
|
(table-patt "<table\\(?:.\\|\n\\)*?</table>")
|
||
|
|
table-beg
|
||
|
|
table-end
|
||
|
|
(pose-patt "<A HREF=\"\\([^\"]*?\\)\" class=\"LinkBold\">\\([^<]*?\\)</A>")
|
||
|
|
poses
|
||
|
|
(trouble-msg
|
||
|
|
(catch 'trouble
|
||
|
|
;;(switch-to-buffer-other-window buf)
|
||
|
|
(with-current-buffer buf
|
||
|
|
(goto-char 1)
|
||
|
|
(rename-buffer "YOGA" t)
|
||
|
|
(unless (search-forward first-marker nil t)
|
||
|
|
(throw 'trouble "Can't find marker for the poses on the page"))
|
||
|
|
(backward-char 10)
|
||
|
|
(unless (re-search-forward table-patt nil t)
|
||
|
|
(throw 'trouble "Can't find table with poses on the page"))
|
||
|
|
(setq table-beg (match-beginning 0))
|
||
|
|
(setq table-end (match-end 0))
|
||
|
|
(goto-char table-beg)
|
||
|
|
(while (re-search-forward pose-patt table-end t)
|
||
|
|
(setq poses (cons (cons (match-string 1) (match-string 2))
|
||
|
|
poses)))
|
||
|
|
(unless poses
|
||
|
|
(throw 'trouble "Can't find poses in table on the page"))
|
||
|
|
(kill-buffer)
|
||
|
|
nil))))
|
||
|
|
(if trouble-msg
|
||
|
|
(progn
|
||
|
|
(message "%s" trouble-msg)
|
||
|
|
nil)
|
||
|
|
(message "Number of yoga poses found=%s" (length poses))
|
||
|
|
poses)))
|
||
|
|
|
||
|
|
(defun pause-random-yoga-pose (poses)
|
||
|
|
(when poses
|
||
|
|
(random t)
|
||
|
|
(let* ((n-poses (length poses))
|
||
|
|
(pose-num (random (1- n-poses)))
|
||
|
|
(the-pose (nth pose-num poses)))
|
||
|
|
the-pose)))
|
||
|
|
|
||
|
|
;;(pause-random-yoga-pose (pause-get-yoga-poses))
|
||
|
|
|
||
|
|
(provide 'pause)
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; pause.el ends here
|