1 ;;; pause.el --- Take a break!
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
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.
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'.
27 ;; Or run it in the current Emacs. To do that add to your .emacs
33 ;; M-x customize-group RET pause RET
35 ;; and set `pause-mode' to t.
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.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.
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.
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.
65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 "Customize your health personal Emacs health saver!"
74 (defcustom pause-after-minutes 15
75 "Pause after this number of minutes."
79 (defcustom pause-1-minute-delay 60
80 "Number of seconds to wait in 1 minutes delay."
84 (defcustom pause-idle-delay 5
85 "Seconds to wait for user to be idle before pause."
89 (defcustom pause-even-if-not-in-emacs t
90 "Jump up pause even if not in Emacs."
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."
100 (defcustom pause-tell-again-after 2
101 "If user does not exit pause tell again after this minutes."
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!).
109 Set this variable to nil if you do not want any extra fun.
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))
117 (defvar pause-exited-from-button nil)
119 (defcustom pause-background-color "orange"
120 "Background color during pause."
124 (defcustom pause-mode-line-color "sienna"
125 "Mode line color during pause."
129 (defcustom pause-1-minute-mode-line-color "yellow"
130 "Mode line color during 1 minute phase of pause."
134 (defface pause-text-face
135 '((t (:foreground "sienna" :height 1.5 :bold t)))
136 "Face main text in pause buffer."
139 (defface pause-info-text-face
140 '((t (:foreground "yellow")))
141 "Face info text in pause buffer."
144 (defface pause-message-face
145 '((t (:inherit secondary-selection)))
146 "Face for pause messages."
149 (defface pause-1-minute-message-face
150 '((t (:inherit mode-line-inactive)))
151 "Face for pause messages."
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."
160 "\n\t- Feel your body.")
161 "Text to show during pause."
165 (defvar pause-el-file (or load-file-name
166 (when (boundp 'bytecomp-filename) bytecomp-filename)
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)))
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."
181 (defvar pause-timer nil)
183 ;;(defvar pause-break-exit-calls nil)
185 (defun pause-start-timer ()
186 (pause-start-timer-1 (* 60 pause-after-minutes)))
188 (defun pause-start-timer-1 (sec)
190 (setq pause-timer (run-with-timer sec nil 'pause-pre-break)))
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)))
198 (defun pause-save-me ()
200 (message (propertize " OK, I will save you again in %d minutes! -- greatings from pause "
201 'face 'pause-message-face)
202 pause-after-minutes))
204 (defun pause-pre-break ()
206 (save-match-data ;; runs in timer
208 (setq pause-timer (run-with-idle-timer pause-idle-delay nil 'pause-break-in-timer)))
210 (lwarn 'pause-pre-break
211 :error "%s" (error-message-string err)))))
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)
222 (defvar pause-buffer nil)
223 (defvar pause-frame nil)
225 (define-derived-mode pause-break-mode nil "Pause"
226 "Mode used during pause in pause buffer.
228 It defines the following key bindings:
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)
238 ;; Fix-me: make one state var
239 (defvar pause-break-exit-active nil)
240 (defvar pause-break-1-minute-state nil)
243 (defun pause-break ()
245 (let ((wcfg (current-frame-configuration))
246 (old-mode-line-bg (face-attribute 'mode-line :background))
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))))
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)
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))
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))))
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:
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))
306 (run-with-idle-timer 0 nil 'pause-save-me))))))
308 (defun pause-save-me-post-command ()
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.")
316 (defun pause-break-show ()
322 ;;(remove-hook 'window-configuration-change-hook 'pause-break-exit)
324 (message "pause-break-show error: %s" (error-message-string err))))))
326 (defvar pause-break-last-wcfg-change (float-time))
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)
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))
344 (setq left-margin-width 25)
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)
359 (pause-break-exit-from-button)
360 (error (message "%s" (error-message-string err))))))
362 (dolist (m '(hl-needed-mode))
363 (when (and (boundp m) (symbol-value m))
365 (dolist (f (frame-list))
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))
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)
396 (vertical-scroll-bars . nil)
403 (defvar pause-tell-again-timer nil)
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)))
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))
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)))
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))))
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)
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))
438 (defun pause-break-exit ()
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)))))
450 (defun pause-break-exit-from-button ()
451 (setq pause-break-1-minute-state nil)
452 (setq pause-exited-from-button t)
455 (defun pause-insert-img ()
456 (let* ((inhibit-read-only t)
459 (slice '(0 0 200 300))
460 (imgs (directory-files pause-img-dir nil nil t))
463 (setq imgs (delete nil
465 (unless (file-directory-p d) d))
468 (setq img "No images found")
469 (setq skip (random (length imgs)))
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)
476 (setq img (create-image src nil nil
478 ;;:margin inlimg-margins
480 (error (setq img (error-message-string err))))
481 (setq img (concat "Image not found: " src))))
484 (insert-image img nil 'left-margin slice)
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)))
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))
498 (defun pause-break-in-timer ()
499 (save-match-data ;; runs in timer
501 (if (or (active-minibuffer-window)
502 (and (boundp 'edebug-active)
504 (let ((pause-idle-delay 5))
506 (let ((there-was-an-error nil))
510 (setq there-was-an-error t)))
511 (when there-was-an-error
514 (select-frame last-event-frame)
515 (let ((pause-idle-delay nil))
518 (lwarn 'pause-break-in-timer2 :error "%s" (error-message-string err))
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'."
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
536 Then it will show you a special screen with a link to a yoga
537 exercise you can do when you pause.
539 After the pause you continue your work where you were
543 :set-after '(server-mode)
545 (if (and pause-only-when-server-mode
547 (not (with-no-warnings (called-interactively-p))))
549 (setq pause-mode nil)
550 (message "Pause mode canceled because not server-mode"))
552 (pause-cancel-timer)))
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)")
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))
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))
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)
585 (unless cus-buf (setq cus-buf (find-file-noselect cus-file)))
586 (with-current-buffer cus-buf
589 (goto-char (point-min))
591 (while (progn (skip-chars-forward " \t\n\^l")
595 (let ((form (read (current-buffer))))
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))
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))))
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'.
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
616 emacs -Q -l pause --eval \"(pause-start 15 nil)\"
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))
623 (defun pause-start-1 (after-minutes cus-file)
624 (setq debug-on-error t)
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))
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))
639 (insert-text-button "pause now"
640 'action `(lambda (button)
643 (error (message "%s" (error-message-string err))))))
645 ;;(setq buffer-read-only t)
647 (delete-other-windows)
648 (setq mode-line-format nil)
649 (setq pause-frame (selected-frame))
651 (set-frame-parameter nil 'background-color pause-background-color))
653 ;; (pause-start-in-new-emacs 0.3)
654 ;; (pause-start-in-new-emacs 15)
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
662 One way of using this function may be to put in your .emacs
665 ;; for just one Emacs running pause
666 (when server-mode (pause-start-in-new-emacs 15))
668 See `pause-start' for more info.
671 (interactive (list pause-after-minutes))
672 (let* ((this-emacs (locate-file invocation-name
673 (list invocation-directory)
675 (cus-file (if custom-file custom-file "~/.emacs"))
676 (args `("-l" ,pause-el-file
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)))
683 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
684 ;;; Link to yoga poses
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))
695 ;;(run-with-idle-timer 0 nil 'pause-get-yoga-poses)
696 (defvar pause-yoga-poses-host-url "http://www.abc-of-yoga.com/")
698 ;;(pause-start-get-yoga-poses)
699 (defun pause-start-get-yoga-poses ()
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)))
705 (defun pause-callback-get-yoga-poses (status)
706 (let ((pose (pause-random-yoga-pose (pause-get-yoga-poses-1 (current-buffer)))))
708 (when (and pose (buffer-live-p pause-buffer))
709 (pause-insert-yoga-link pose))))
711 (defun pause-insert-yoga-link (pose)
712 (with-current-buffer pause-buffer
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)
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))))))
726 (pause-break-message))))
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)))
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"))
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")
742 ;; (run-with-idle-timer 0 nil 'temp-y)
744 (defun pause-get-yoga-poses-1 (buf)
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>")
752 (pose-patt "<A HREF=\"\\([^\"]*?\\)\" class=\"LinkBold\">\\([^<]*?\\)</A>")
756 ;;(switch-to-buffer-other-window buf)
757 (with-current-buffer buf
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"))
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))
772 (throw 'trouble "Can't find poses in table on the page"))
777 (message "%s" trouble-msg)
779 (message "Number of yoga poses found=%s" (length poses))
782 (defun pause-random-yoga-pose (poses)
785 (let* ((n-poses (length poses))
786 (pose-num (random (1- n-poses)))
787 (the-pose (nth pose-num poses)))
790 ;;(pause-random-yoga-pose (pause-get-yoga-poses))
793 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
794 ;;; pause.el ends here