From 0d342f0aee3f2f800e486c0051dabe718a7b2841 Mon Sep 17 00:00:00 2001
From: Tom Willemsen
Date: Wed, 23 Mar 2011 11:14:27 +0100
Subject: I don't like nxhtml
---
emacs.d/nxhtml/util/pause.el | 794 -------------------------------------------
1 file changed, 794 deletions(-)
delete mode 100644 emacs.d/nxhtml/util/pause.el
(limited to 'emacs.d/nxhtml/util/pause.el')
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 "These are all the Yoga Poses covered in this section:
")
- (table-patt "")
- table-beg
- table-end
- (pose-patt "\\([^<]*?\\)")
- 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
--
cgit v1.2.3-54-g00ecf