diff options
Diffstat (limited to 'emacs.d/nxhtml/util/pause.el')
| -rw-r--r-- | emacs.d/nxhtml/util/pause.el | 794 |
1 files changed, 794 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/util/pause.el b/emacs.d/nxhtml/util/pause.el new file mode 100644 index 0000000..2e98d36 --- /dev/null +++ b/emacs.d/nxhtml/util/pause.el @@ -0,0 +1,794 @@ +;;; 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 |