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