nxhtml/util/pause.el

   1 ;;; pause.el --- Take a break!
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2008-01-19 Sat
   5 (defconst pause:version "0.70");; Version:
   6 ;; Last-Updated: 2010-01-18 Mon
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; If you are using Emacs then don't you need a little reminder to
  20 ;; take a pause?  This library makes Emacs remind you of that.  And
  21 ;; gives you a link to a yoga exercise to try in the pause.
  22 ;;
  23 ;; There are essentially two different ways to use this library.
  24 ;; Either you run a separate Emacs process that just reminds you of
  25 ;; pauses.  To use it that way see `pause-start-in-new-emacs'.
  26 ;;
  27 ;; Or run it in the current Emacs.  To do that add to your .emacs
  28 ;;
  29 ;;   (require 'pause)
  30 ;;
  31 ;; and do
  32 ;;
  33 ;;   M-x customize-group RET pause RET
  34 ;;
  35 ;; and set `pause-mode' to t.
  36 ;;
  37 ;;
  38 ;; Note: I am unsure if it works on all systems to use a separate
  39 ;;       Emacs process.  It does work on w32 though.  Please tell me
  40 ;;       about other systems.
  41 ;;
  42 ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;
  45 ;;; Change log:
  46 ;;
  47 ;;
  48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  49 ;;
  50 ;; This program is free software; you can redistribute it and/or
  51 ;; modify it under the terms of the GNU General Public License as
  52 ;; published by the Free Software Foundation; either version 2, or
  53 ;; (at your option) any later version.
  54 ;;
  55 ;; This program is distributed in the hope that it will be useful,
  56 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  57 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  58 ;; General Public License for more details.
  59 ;;
  60 ;; You should have received a copy of the GNU General Public License
  61 ;; along with this program; see the file COPYING.  If not, write to
  62 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  63 ;; Floor, Boston, MA 02110-1301, USA.
  64 ;;
  65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66 ;;
  67 ;;; Code:
  68
  69 ;;;###autoload
  70 (defgroup pause nil
  71   "Customize your health personal Emacs health saver!"
  72   :group 'convenience)
  73
  74 (defcustom pause-after-minutes 15
  75   "Pause after this number of minutes."
  76   :type 'number
  77   :group 'pause)
  78
  79 (defcustom pause-1-minute-delay 60
  80   "Number of seconds to wait in 1 minutes delay."
  81   :type 'number
  82   :group 'pause)
  83
  84 (defcustom pause-idle-delay 5
  85   "Seconds to wait for user to be idle before pause."
  86   :type 'number
  87   :group 'pause)
  88
  89 (defcustom pause-even-if-not-in-emacs t
  90   "Jump up pause even if not in Emacs."
  91   :type 'boolean
  92   :group 'pause)
  93
  94 (defcustom pause-restart-anyway-after 2
  95   "If user does not use Emacs restart timer after this minutes.
  96 This is used when a user has clicked a link."
  97   :type 'number
  98   :group 'pause)
  99
 100 (defcustom pause-tell-again-after 2
 101   "If user does not exit pause tell again after this minutes."
 102   :type 'number
 103   :group 'pause)
 104
 105 (defcustom pause-extra-fun 'pause-start-get-yoga-poses
 106   "Function to call for extra fun when pausing.
 107 Default is to show a link to a yoga exercise (recommended!).
 108
 109 Set this variable to nil if you do not want any extra fun.
 110
 111 If this variable's value is a function it will be called when the
 112 pause frame has just been shown."
 113   :type '(choice (function :tag "Extra function")
 114                  (const :tag "No extra function" nil))
 115   :group 'pause)
 116
 117 (defvar pause-exited-from-button nil)
 118
 119 (defcustom pause-background-color "orange"
 120   "Background color during pause."
 121   :type 'color
 122   :group 'pause)
 123
 124 (defcustom pause-mode-line-color "sienna"
 125   "Mode line color during pause."
 126   :type 'color
 127   :group 'pause)
 128
 129 (defcustom pause-1-minute-mode-line-color "yellow"
 130   "Mode line color during 1 minute phase of pause."
 131   :type 'color
 132   :group 'pause)
 133
 134 (defface pause-text-face
 135   '((t (:foreground "sienna" :height 1.5 :bold t)))
 136   "Face main text in pause buffer."
 137   :group 'pause)
 138
 139 (defface pause-info-text-face
 140   '((t (:foreground "yellow")))
 141   "Face info text in pause buffer."
 142   :group 'pause)
 143
 144 (defface pause-message-face
 145   '((t (:inherit secondary-selection)))
 146   "Face for pause messages."
 147   :group 'pause)
 148
 149 (defface pause-1-minute-message-face
 150   '((t (:inherit mode-line-inactive)))
 151   "Face for pause messages."
 152   :group 'pause)
 153
 154 (defcustom pause-break-text
 155   (concat "\n\tHi there,"
 156           "\n\tYou are worth a PAUSE!"
 157           "\n\nTry some mindfulness:"
 158           "\n\t- Look around and observe."
 159           "\n\t- Listen."
 160           "\n\t- Feel your body.")
 161   "Text to show during pause."
 162   :type 'integer
 163   :group 'pause)
 164
 165 (defvar pause-el-file (or load-file-name
 166                           (when (boundp 'bytecomp-filename) bytecomp-filename)
 167                           buffer-file-name))
 168
 169 (defvar pause-default-img-dir
 170   (let ((this-dir (file-name-directory pause-el-file)))
 171     (expand-file-name "../etc/img/pause/" this-dir)))
 172
 173 (defcustom pause-img-dir pause-default-img-dir
 174   "Image directory for pause.
 175 A random image is choosen from this directory for pauses."
 176   :type 'directory
 177   :group 'pause)
 178
 179
 180
 181 (defvar pause-timer nil)
 182
 183 ;;(defvar pause-break-exit-calls nil)
 184
 185 (defun pause-start-timer ()
 186   (pause-start-timer-1 (* 60 pause-after-minutes)))
 187
 188 (defun pause-start-timer-1 (sec)
 189   (pause-cancel-timer)
 190   (setq pause-timer (run-with-timer sec nil 'pause-pre-break)))
 191
 192 (defun pause-one-minute ()
 193   "Give you another minute ..."
 194   (pause-start-timer-1 pause-1-minute-delay)
 195   (message (propertize " OK, I will come back in a minute! -- greatings from pause"
 196                        'face 'pause-message-face)))
 197
 198 (defun pause-save-me ()
 199   (pause-start-timer)
 200   (message (propertize " OK, I will save you again in %d minutes! -- greatings from pause "
 201                        'face 'pause-message-face)
 202            pause-after-minutes))
 203
 204 (defun pause-pre-break ()
 205   (condition-case err
 206       (save-match-data ;; runs in timer
 207         (pause-cancel-timer)
 208         (setq pause-timer (run-with-idle-timer pause-idle-delay nil 'pause-break-in-timer)))
 209     (error
 210      (lwarn 'pause-pre-break
 211             :error "%s" (error-message-string err)))))
 212
 213 (defvar pause-break-mode-map
 214   (let ((map (make-sparse-keymap)))
 215     (define-key map [(control meta shift ?p)] 'pause-break-exit)
 216     (define-key map [tab]         'forward-button)
 217     (define-key map [(meta tab)]  'backward-button)
 218     (define-key map [(shift tab)] 'backward-button)
 219     (define-key map [backtab]     'backward-button)
 220     map))
 221
 222 (defvar pause-buffer nil)
 223 (defvar pause-frame nil)
 224
 225 (define-derived-mode pause-break-mode nil "Pause"
 226   "Mode used during pause in pause buffer.
 227
 228 It defines the following key bindings:
 229
 230 \\{pause-break-mode-map}"
 231   (set (make-local-variable 'buffer-read-only) t)
 232   (setq show-trailing-whitespace nil)
 233   ;;(set (make-local-variable 'cursor-type) nil)
 234   ;; Fix-me: workaround for emacs bug
 235   ;;(run-with-idle-timer 0 nil 'pause-hide-cursor)
 236   )
 237
 238 ;; Fix-me: make one state var
 239 (defvar pause-break-exit-active nil)
 240 (defvar pause-break-1-minute-state nil)
 241
 242
 243 (defun pause-break ()
 244   (pause-cancel-timer)
 245   (let ((wcfg (current-frame-configuration))
 246         (old-mode-line-bg (face-attribute 'mode-line :background))
 247         old-frame-bg-color
 248         old-frame-left-fringe
 249         old-frame-right-fringe
 250         old-frame-tool-bar-lines
 251         old-frame-menu-bar-lines
 252         old-frame-vertical-scroll-bars)
 253     (dolist (f (frame-list))
 254       (add-to-list 'old-frame-bg-color (cons f (frame-parameter f 'background-color)))
 255       (add-to-list 'old-frame-left-fringe (cons f (frame-parameter f 'left-fringe)))
 256       (add-to-list 'old-frame-right-fringe (cons f (frame-parameter f 'right-fringe)))
 257       (add-to-list 'old-frame-tool-bar-lines (cons f (frame-parameter f 'tool-bar-lines)))
 258       (add-to-list 'old-frame-menu-bar-lines (cons f (frame-parameter f 'menu-bar-lines)))
 259       (add-to-list 'old-frame-vertical-scroll-bars (cons f (frame-parameter f 'vertical-scroll-bars))))
 260
 261     ;; Fix-me: Something goes wrong with the window configuration, try a short pause
 262     (remove-hook 'window-configuration-change-hook 'pause-break-exit)
 263     (run-with-idle-timer 0.2 nil 'pause-break-show)
 264     (setq pause-break-exit-active nil)
 265     (setq pause-break-1-minute-state nil) ;; set in `pause-break-show'
 266     (setq pause-exited-from-button nil)
 267     (unwind-protect
 268         (let ((n 0)
 269               (debug-on-error nil))
 270           (while (and (> 3 (setq n (1+ n)))
 271                       (not pause-break-exit-active)
 272                       (not pause-break-1-minute-state))
 273             (condition-case err
 274                 (recursive-edit)
 275               (error (message "%s" (error-message-string err))))
 276             (unless (or pause-break-exit-active
 277                         pause-break-1-minute-state)
 278               (when (> 2 n) (message "Too early to pause (%s < 2)" n))
 279               (add-hook 'window-configuration-change-hook 'pause-break-exit))))
 280
 281       (remove-hook 'window-configuration-change-hook 'pause-break-exit)
 282       (pause-tell-again-cancel-timer)
 283       ;;(set-frame-parameter nil 'background-color "white")
 284       (dolist (f (frame-list))
 285         (set-frame-parameter f 'background-color     (cdr (assq f old-frame-bg-color)))
 286         (set-frame-parameter f 'left-fringe          (cdr (assq f old-frame-left-fringe)))
 287         (set-frame-parameter f 'right-fringe         (cdr (assq f old-frame-right-fringe)))
 288         (set-frame-parameter f 'tool-bar-lines       (cdr (assq f old-frame-tool-bar-lines)))
 289         (set-frame-parameter f 'menu-bar-lines       (cdr (assq f old-frame-menu-bar-lines)))
 290         (set-frame-parameter f 'vertical-scroll-bars (cdr (assq f old-frame-vertical-scroll-bars))))
 291       ;; Fix-me: The frame grows unless we do redisplay here:
 292       (redisplay t)
 293       (set-frame-configuration wcfg t)
 294       (when pause-frame(lower-frame pause-frame))
 295       (set-face-attribute 'mode-line nil :background old-mode-line-bg)
 296       (run-with-idle-timer 2.0 nil 'run-hooks 'pause-break-exit-hook)
 297       (kill-buffer pause-buffer)
 298       (cond (pause-exited-from-button
 299              ;; Do not start timer until we start working again.
 300              (run-with-idle-timer 1 nil 'add-hook 'post-command-hook 'pause-save-me-post-command)
 301              ;; But if we do not do that within some minutes then start timer anyway.
 302              (run-with-idle-timer (* 60 pause-restart-anyway-after) nil 'pause-save-me))
 303             (pause-break-1-minute-state
 304              (run-with-idle-timer 0 nil 'pause-one-minute))
 305             (t
 306              (run-with-idle-timer 0 nil 'pause-save-me))))))
 307
 308 (defun pause-save-me-post-command ()
 309   (pause-start-timer))
 310
 311 (defvar pause-break-exit-hook nil
 312   "Hook run after break exit.
 313 Frame configuration has been restored when this is run.
 314 Please note that it is run in a timer.")
 315
 316 (defun pause-break-show ()
 317   ;; In timer
 318   (save-match-data
 319     (condition-case err
 320         (pause-break-show-1)
 321       (error
 322        ;;(remove-hook 'window-configuration-change-hook 'pause-break-exit)
 323        (pause-break-exit)
 324        (message "pause-break-show error: %s" (error-message-string err))))))
 325
 326 (defvar pause-break-last-wcfg-change (float-time))
 327
 328 (defun pause-break-show-1 ()
 329   ;; Do these first if something goes wrong.
 330   (setq pause-break-last-wcfg-change (float-time))
 331   ;;(run-with-idle-timer (* 1.5 (length (frame-list))) nil 'add-hook 'window-configuration-change-hook 'pause-break-exit)
 332
 333   ;; fix-me: temporary:
 334   ;;(add-hook 'window-configuration-change-hook 'pause-break-exit)
 335   (unless pause-extra-fun (run-with-idle-timer 1  nil 'pause-break-message))
 336   (run-with-idle-timer 10 nil 'pause-break-exit-activate)
 337   (setq pause-break-1-minute-state t)
 338   (set-face-attribute 'mode-line nil :background pause-1-minute-mode-line-color)
 339   (with-current-buffer (setq pause-buffer
 340                              (get-buffer-create "* P A U S E *"))
 341     (let ((inhibit-read-only t))
 342       (erase-buffer)
 343       (pause-break-mode)
 344       (setq left-margin-width 25)
 345       (pause-insert-img)
 346       (insert (propertize pause-break-text 'face 'pause-text-face))
 347       (goto-char (point-min))
 348       (when (search-forward "mindfulness" nil t)
 349         (make-text-button (- (point) 11) (point)
 350                           'face '(:inherit pause-text-face :underline t)
 351                           'action (lambda (btn)
 352                                     (browse-url "http://www.jimhopper.com/mindfulness/"))))
 353       (goto-char (point-max))
 354       (insert (propertize "\n\nClick on a link below to exit pause\n" 'face 'pause-info-text-face))
 355       ;;(add-text-properties (point-min) (point-max) (list 'keymap (make-sparse-keymap)))
 356       (insert-text-button "Exit pause"
 357                           'action `(lambda (button)
 358                                      (condition-case err
 359                                          (pause-break-exit-from-button)
 360                                        (error (message "%s" (error-message-string err))))))
 361       (insert "\n")
 362       (dolist (m '(hl-needed-mode))
 363         (when (and (boundp m) (symbol-value m))
 364           (funcall m -1)))))
 365     (dolist (f (frame-list))
 366       (pause-max-frame f))
 367     (pause-tell-again)
 368     (when pause-extra-fun (funcall pause-extra-fun))
 369     ;;(setq pause-break-exit-calls 0)
 370     (setq pause-break-last-wcfg-change (float-time))
 371     (pause-tell-again-start-timer))
 372
 373 (defun pause-max-frame (f)
 374   (let* ((avail-width (- (display-pixel-width)
 375                          (* 2 (frame-parameter f 'border-width))
 376                          (* 2 (frame-parameter f 'internal-border-width))))
 377          (avail-height (- (display-pixel-height)
 378                           (* 2 (frame-parameter f 'border-width))
 379                           (* 2 (frame-parameter f 'internal-border-width))))
 380          (cols (/ avail-width (frame-char-width)))
 381          (rows (- (/ avail-height (frame-char-height)) 2)))
 382     ;;(set-frame-parameter (selected-frame) 'fullscreen 'fullboth)
 383     ;;(set-frame-parameter (selected-frame) 'fullscreen 'maximized)
 384     (setq pause-break-last-wcfg-change (float-time))
 385     (with-selected-frame f
 386       (delete-other-windows (frame-first-window f))
 387       (with-selected-window (frame-first-window)
 388         (switch-to-buffer pause-buffer)
 389         (goto-char (point-max))))
 390     (modify-frame-parameters f
 391                              `((background-color . ,pause-background-color)
 392                                (left-fringe . 0)
 393                                (right-fringe . 0)
 394                                (tool-bar-lines . 0)
 395                                (menu-bar-lines . 0)
 396                                (vertical-scroll-bars . nil)
 397                                (left . 0)
 398                                (top . 0)
 399                                (width  . ,cols)
 400                                (height . ,rows)
 401                                ))))
 402
 403 (defvar pause-tell-again-timer nil)
 404
 405 (defun pause-tell-again-start-timer ()
 406   (pause-tell-again-cancel-timer)
 407   (setq pause-tell-again-timer
 408         (run-with-idle-timer (* 60 pause-tell-again-after) t 'pause-tell-again)))
 409
 410 (defun pause-tell-again-cancel-timer ()
 411   (when (timerp pause-tell-again-timer)
 412     (cancel-timer pause-tell-again-timer))
 413   (setq pause-tell-again-timer nil))
 414
 415 (defun pause-tell-again ()
 416   (when (and window-system pause-even-if-not-in-emacs)
 417     (pause-max-frame pause-frame)
 418     (raise-frame pause-frame)))
 419
 420
 421 (defun pause-break-message ()
 422   (when (/= 0 (recursion-depth))
 423     (message "%s" (propertize "Please take a pause! (Or exit now to take it in 1 minute.)"
 424                               'face 'pause-1-minute-message-face))))
 425
 426 (defun pause-break-exit-activate ()
 427   (when (/= 0 (recursion-depth))
 428     (setq pause-break-exit-active t)
 429     (setq pause-break-1-minute-state nil)
 430     (set-face-attribute 'mode-line nil :background pause-mode-line-color)
 431     (message nil)
 432     (with-current-buffer pause-buffer
 433       (let ((inhibit-read-only t))
 434         ;; Fix-me: This interfere with text buttons.
 435         ;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
 436         ))))
 437
 438 (defun pause-break-exit ()
 439   (interactive)
 440   (let ((elapsed (- (float-time) pause-break-last-wcfg-change)))
 441     ;;(message "elapsed=%s pause-break-last-wcfg-change=%s" elapsed pause-break-last-wcfg-change)
 442     (setq pause-break-last-wcfg-change (float-time))
 443     (when (> elapsed 1.0)
 444       (setq pause-break-exit-active t)
 445       (remove-hook 'window-configuration-change-hook 'pause-break-exit)
 446       ;;(pause-tell-again-cancel-timer)
 447       (when (/= 0 (recursion-depth))
 448         (exit-recursive-edit)))))
 449
 450 (defun pause-break-exit-from-button ()
 451   (setq pause-break-1-minute-state nil)
 452   (setq pause-exited-from-button t)
 453   (pause-break-exit))
 454
 455 (defun pause-insert-img ()
 456   (let* ((inhibit-read-only t)
 457         img
 458         src
 459         (slice '(0 0 200 300))
 460         (imgs (directory-files pause-img-dir nil nil t))
 461         skip
 462         )
 463     (setq imgs (delete nil
 464                        (mapcar (lambda (d)
 465                                  (unless (file-directory-p d) d))
 466                                imgs)))
 467     (if (not imgs)
 468         (setq img "No images found")
 469       (setq skip (random (length imgs)))
 470       (while (> skip 0)
 471         (setq skip (1- skip))
 472         (setq imgs (cdr imgs)))
 473       (setq src (expand-file-name (car imgs) pause-img-dir))
 474       (if (file-exists-p src)
 475           (condition-case err
 476               (setq img (create-image src nil nil
 477                                       :relief 1
 478                                       ;;:margin inlimg-margins
 479                                       ))
 480             (error (setq img (error-message-string err))))
 481         (setq img (concat "Image not found: " src))))
 482     (if (stringp img)
 483         (insert img)
 484       (insert-image img nil 'left-margin slice)
 485       )
 486     ))
 487
 488 (defun pause-hide-cursor ()
 489   ;; runs in timer, save-match-data
 490   (with-current-buffer pause-buffer
 491     (set (make-local-variable 'cursor-type) nil)))
 492
 493 (defun pause-cancel-timer ()
 494   (remove-hook 'post-command-hook 'pause-save-me-post-command)
 495   (when (timerp pause-timer) (cancel-timer pause-timer))
 496   (setq pause-timer nil))
 497
 498 (defun pause-break-in-timer ()
 499   (save-match-data ;; runs in timer
 500     (pause-cancel-timer)
 501     (if (or (active-minibuffer-window)
 502             (and (boundp 'edebug-active)
 503                  edebug-active))
 504         (let ((pause-idle-delay 5))
 505           (pause-pre-break))
 506       (let ((there-was-an-error nil))
 507         (condition-case err
 508             (pause-break)
 509           (error
 510            (setq there-was-an-error t)))
 511         (when there-was-an-error
 512           (condition-case err
 513               (progn
 514                 (select-frame last-event-frame)
 515                 (let ((pause-idle-delay nil))
 516                   (pause-pre-break)))
 517             (error
 518              (lwarn 'pause-break-in-timer2 :error "%s" (error-message-string err))
 519              )))))))
 520
 521 (defcustom pause-only-when-server-mode t
 522   "Allow `pause-mode' inly in the Emacs that has server-mode enabled.
 523 This is to prevent multiple Emacs with `pause-mode'."
 524   :type 'boolean
 525   :group 'pause)
 526
 527 ;;;###autoload
 528 (define-minor-mode pause-mode
 529   "This minor mode tries to make you take a break.
 530 It will jump up and temporary stop your work - even if you are
 531 not in Emacs.  If you are in Emacs it will however try to be
 532 gentle and wait until you have been idle with the keyboard for a
 533 short while. \(If you are not in Emacs it can't be gentle. How
 534 could it?)
 535
 536 Then it will show you a special screen with a link to a yoga
 537 exercise you can do when you pause.
 538
 539 After the pause you continue your work where you were
 540 interrupted."
 541   :global t
 542   :group 'pause
 543   :set-after '(server-mode)
 544   (if pause-mode
 545       (if (and pause-only-when-server-mode
 546                (not server-mode)
 547                (not (with-no-warnings (called-interactively-p))))
 548           (progn
 549             (setq pause-mode nil)
 550             (message "Pause mode canceled because not server-mode"))
 551         (pause-start-timer))
 552     (pause-cancel-timer)))
 553
 554 ;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-temp-err)")
 555 ;; (emacs-Q "-l" buffer-file-name "--eval" "(run-with-timer 1 nil 'pause-temp-err)")
 556 ;; (pause-temp-err)
 557 (defun pause-temp-err ()
 558   (switch-to-buffer (get-buffer-create "pause-temp-err buffer"))
 559   (setq buffer-read-only t)
 560   (let ((inhibit-read-only t))
 561     (add-text-properties (point-min) (point-max) (list 'keymap nil))
 562     (insert-text-button "click to test"
 563                         'action (lambda (btn)
 564                                   (message "Click worked")))
 565     ;;(add-text-properties (point-min) (point-max) (list 'keymap nil))
 566     ))
 567
 568 ;; (customize-group-other-window 'pause)
 569 ;; (apply 'custom-set-variables (pause-get-group-saved-customizations 'pause custom-file))
 570 ;; (pause-get-group-saved-customizations 'w32shell custom-file)
 571 (defun pause-get-group-saved-customizations (group cus-file)
 572   "Return customizations saved for GROUP in CUS-FILE."
 573   (let* ((cus-buf (find-buffer-visiting cus-file))
 574          (cus-old cus-buf)
 575          (cus-point (when cus-old (with-current-buffer cus-old (point))))
 576          (cusg-all (get group 'custom-group))
 577          (cusg-vars (delq nil (mapcar (lambda (elt)
 578                                         (when (eq (nth 1 elt) 'custom-variable)
 579                                           (car elt)))
 580                                       cusg-all)))
 581          cus-vars-form
 582          cus-face-form
 583          cus-saved-vars
 584          cus-saved-face)
 585     (unless cus-buf (setq cus-buf (find-file-noselect cus-file)))
 586     (with-current-buffer cus-buf
 587       (save-restriction
 588         (widen)
 589         (goto-char (point-min))
 590         (while (progn
 591                  (while (progn (skip-chars-forward " \t\n\^l")
 592                                (looking-at ";"))
 593                    (forward-line 1))
 594                  (not (eobp)))
 595           (let ((form (read (current-buffer))))
 596             (cond
 597              ((eq (car form) 'custom-set-variables)
 598               (setq cus-vars-form form))
 599              ((eq (car form) 'custom-set-faces)
 600               (setq cus-face-form form))
 601             )))))
 602     (dolist (vl (cdr cus-vars-form))
 603       (when (memq (car (cadr vl)) cusg-vars)
 604         (setq cus-saved-vars (cons (cadr vl) cus-saved-vars))))
 605     cus-saved-vars))
 606
 607 ;; (emacs-Q "-l" buffer-file-name "--eval" "(pause-start 0.1 nil)")
 608 (defun pause-start (after-minutes cus-file)
 609   "Start `pause-mode' with interval AFTER-MINUTES.
 610 This bypasses `pause-only-when-server-mode'.
 611
 612 You can use this funciton to start a separate Emacs process that
 613 handles pause, for example like this if you want a pause every 15
 614 minutes:
 615
 616   emacs -Q -l pause --eval \"(pause-start 15 nil)\"
 617
 618 Note: Another easier alternative might be to use
 619       `pause-start-in-new-emacs'."
 620   (interactive "nPause after how many minutes: ")
 621   (pause-start-1 after-minutes cus-file))
 622
 623 (defun pause-start-1 (after-minutes cus-file)
 624   (setq debug-on-error t)
 625   (pause-cancel-timer)
 626   (when (and cus-file (file-exists-p cus-file))
 627     (let ((args (pause-get-group-saved-customizations 'pause cus-file)))
 628       ;;(message "cus-file=%S" cus-file)
 629       ;;(message "args=%S" args)
 630       (apply 'custom-set-variables args)))
 631   (setq pause-after-minutes after-minutes)
 632   (let ((pause-only-when-server-mode nil))
 633     (pause-mode 1))
 634   (switch-to-buffer (get-buffer-create "Pause information"))
 635   (insert (propertize "Emacs pause\n"
 636                       'face '(:inherit variable-pitch :height 1.5)))
 637   (insert (format "Pausing every %d minute.\n" after-minutes))
 638   (insert "Or, ")
 639   (insert-text-button "pause now"
 640                       'action `(lambda (button)
 641                                  (condition-case err
 642                                      (pause-break)
 643                                    (error (message "%s" (error-message-string err))))))
 644   (insert "!\n")
 645   ;;(setq buffer-read-only t)
 646   (pause-break-mode)
 647   (delete-other-windows)
 648   (setq mode-line-format nil)
 649   (setq pause-frame (selected-frame))
 650   (message nil)
 651   (set-frame-parameter nil 'background-color pause-background-color))
 652
 653 ;; (pause-start-in-new-emacs 0.3)
 654 ;; (pause-start-in-new-emacs 15)
 655 ;;;###autoload
 656 (defun pause-start-in-new-emacs (after-minutes)
 657   "Start pause with interval AFTER-MINUTES in a new Emacs instance.
 658 The new Emacs instance will be started with -Q.  However if
 659 `custom-file' is non-nil it will be loaded so you can still
 660 customize pause.
 661
 662 One way of using this function may be to put in your .emacs
 663 something like
 664
 665   ;; for just one Emacs running pause
 666   (when server-mode (pause-start-in-new-emacs 15))
 667
 668 See `pause-start' for more info.
 669
 670 "
 671   (interactive (list pause-after-minutes))
 672   (let* ((this-emacs (locate-file invocation-name
 673                                   (list invocation-directory)
 674                                   exec-suffixes))
 675          (cus-file (if custom-file custom-file "~/.emacs"))
 676          (args `("-l" ,pause-el-file
 677                  "--geometry=40x3"
 678                  "-D"
 679                  "--eval" ,(format "(pause-start %s %S)" after-minutes cus-file))))
 680     (setq args (cons "-Q" args))
 681     (apply 'call-process this-emacs nil 0 nil args)))
 682
 683 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 684 ;;; Link to yoga poses
 685
 686 ;; (defun w3-download-callback (fname)
 687 ;;   (let ((coding-system-for-write 'binary))
 688 ;;     (goto-char (point-min))
 689 ;;     (search-forward "\n\n" nil t)
 690 ;;     (write-region (point) (point-max) fname))
 691 ;;   (url-mark-buffer-as-dead (current-buffer))
 692 ;;   (message "Download of %s complete." (url-view-url t))
 693 ;;   (sit-for 3))
 694
 695 ;;(run-with-idle-timer 0 nil 'pause-get-yoga-poses)
 696 (defvar pause-yoga-poses-host-url "http://www.abc-of-yoga.com/")
 697
 698 ;;(pause-start-get-yoga-poses)
 699 (defun pause-start-get-yoga-poses ()
 700   (require 'url-vars)
 701   (let ((url-show-status nil)) ;; do not show download messages
 702     (url-retrieve (concat pause-yoga-poses-host-url "yogapractice/mountain.asp")
 703                   'pause-callback-get-yoga-poses)))
 704
 705 (defun pause-callback-get-yoga-poses (status)
 706   (let ((pose (pause-random-yoga-pose (pause-get-yoga-poses-1 (current-buffer)))))
 707     (message nil)
 708     (when (and pose (buffer-live-p pause-buffer))
 709       (pause-insert-yoga-link pose))))
 710
 711 (defun pause-insert-yoga-link (pose)
 712   (with-current-buffer pause-buffer
 713     (let ((here (point))
 714           (inhibit-read-only t)
 715           (pose-url (concat pause-yoga-poses-host-url (car pose))))
 716       (goto-char (point-max))
 717       (insert "Link to yoga posture for you: ")
 718       (insert-text-button (cdr pose)
 719                           'action `(lambda (button)
 720                                      (condition-case err
 721                                          (progn
 722                                            (browse-url ,pose-url)
 723                                            (run-with-idle-timer 1 nil 'pause-break-exit-from-button))
 724                                        (error (message "%s" (error-message-string err))))))
 725       (insert "\n")
 726       (pause-break-message))))
 727
 728 (defun pause-get-yoga-poses ()
 729   (let* ((url-show-status nil) ;; do not show download messages
 730          (buf (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp")))
 731     (pause-get-yoga-poses-1 buf)))
 732
 733 ;; (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
 734 ;; (setq x (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
 735
 736 ;; (defun temp-y ()
 737 ;;   (message "before y")
 738 ;;   ;;(setq y (url-retrieve-synchronously "http://www.emacswiki.org/emacs/EmacsFromBazaar"))
 739 ;;   (setq x (url-retrieve-synchronously "http://www.abc-of-yoga.com/yogapractice/mountain.asp"))
 740 ;;   (message "after x")
 741 ;;   )
 742 ;; (run-with-idle-timer 0 nil 'temp-y)
 743
 744 (defun pause-get-yoga-poses-1 (buf)
 745   (require 'url)
 746   (setq url-debug t)
 747   ;; url-insert-file-contents
 748   (let* ((first-marker "<p>These are all the Yoga Poses covered in this section:</p>")
 749          (table-patt "<table\\(?:.\\|\n\\)*?</table>")
 750          table-beg
 751          table-end
 752          (pose-patt "<A HREF=\"\\([^\"]*?\\)\" class=\"LinkBold\">\\([^<]*?\\)</A>")
 753          poses
 754          (trouble-msg
 755           (catch 'trouble
 756             ;;(switch-to-buffer-other-window buf)
 757             (with-current-buffer buf
 758               (goto-char 1)
 759               (rename-buffer "YOGA" t)
 760               (unless (search-forward first-marker nil t)
 761                 (throw 'trouble "Can't find marker for the poses on the page"))
 762               (backward-char 10)
 763               (unless (re-search-forward table-patt nil t)
 764                 (throw 'trouble "Can't find table with poses on the page"))
 765               (setq table-beg (match-beginning 0))
 766               (setq table-end (match-end 0))
 767               (goto-char table-beg)
 768               (while (re-search-forward pose-patt table-end t)
 769                 (setq poses (cons (cons (match-string 1) (match-string 2))
 770                                   poses)))
 771               (unless poses
 772                 (throw 'trouble "Can't find poses in table on the page"))
 773               (kill-buffer)
 774               nil))))
 775     (if trouble-msg
 776         (progn
 777           (message "%s" trouble-msg)
 778           nil)
 779       (message "Number of yoga poses found=%s" (length poses))
 780       poses)))
 781
 782 (defun pause-random-yoga-pose (poses)
 783   (when poses
 784     (random t)
 785     (let* ((n-poses (length poses))
 786            (pose-num (random (1- n-poses)))
 787            (the-pose (nth pose-num poses)))
 788       the-pose)))
 789
 790 ;;(pause-random-yoga-pose (pause-get-yoga-poses))
 791
 792 (provide 'pause)
 793 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 794 ;;; pause.el ends here