Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Changes

  • Loading branch information...
commit 21d55770598ab4e0f3d7f2c8ab623170feb64a37 1 parent 83e596b
@jwiegley authored
Showing with 1,074 additions and 3 deletions.
  1. +13 −3 init.el
  2. +421 −0 lib/fame.el
  3. +639 −0 lib/working.el
  4. +1 −0  settings.el
View
16 init.el
@@ -1748,18 +1748,22 @@ The output appears in the buffer `*Async Shell Command*'."
:init
(progn
(defun setup-irc-environment ()
- (interactive)
+ (interactive)
(set-frame-font
"-*-Lucida Grande-normal-normal-normal-*-*-*-*-*-p-0-iso10646-1" nil
nil)
+ (set-frame-parameter (selected-frame) 'width 90)
+ (custom-set-faces
+ '(erc-timestamp-face ((t (:foreground "dark violet")))))
(setq erc-timestamp-only-if-changed-flag nil
erc-timestamp-format "%H:%M "
erc-fill-prefix " "
erc-fill-column 88
- erc-insert-timestamp-function 'erc-insert-timestamp-left)
- (custom-set-faces
+ erc-insert-timestamp-function 'erc-insert-timestamp-left)
+
+ (set-input-method "Agda")
(pabbrev-mode 1))
(add-hook 'erc-mode-hook 'setup-irc-environment)
@@ -2839,6 +2843,12 @@ FORM => (eval FORM)."
(org-agenda-list)
(org-fit-agenda-window)
(org-resolve-clocks))) t)))
+
+;;;_ , pabbrev
+
+(use-package pabbrev
+ :commands pabbrev-mode
+ :diminish pabbrev-mode)
;;;_ , paredit
View
421 lib/fame.el
@@ -0,0 +1,421 @@
+;;; fame.el --- Framework for Applications' MEssages
+;;
+;; Copyright (C) 2004 David Ponce
+;;
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 28 Oct 2004
+;; Keywords: status
+;; X-RCS: $Id: fame.el,v 1.3 2005-09-30 20:07:29 zappo Exp $
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; 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 software 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; This library provides a convenient framework for applications to
+;; send messages distinguished by their level of importance, allowing
+;; to customize how they will be actually rendered.
+;;
+;; The principle is to define a `channel' where to send messages at
+;; particular levels, depending on their importance. A channel is
+;; identified by a non-nil symbol. For example this library could
+;; send its messages to the `fame' channel. Four levels of importance
+;; are recognized, for debug, informational, warning and error
+;; messages.
+;;
+;; Messages at any particular level can be either discarded,
+;; temporarily displayed, recorded in the message log buffer without
+;; showing them in the echo area, or shown the usual way like through
+;; the `message' function. Messages shown in the echo area can be
+;; recorded or not in the message log buffer.
+;;
+;; The `define-fame-channel' macro permits to easily define a new
+;; channel, that is an option to customize how to display the message
+;; levels for this channel, and the level specific functions to use to
+;; send messages to this channel.
+;;
+;; Here is a small example:
+;;
+;; (require 'fame)
+;; ...
+;; (define-fame-channel feature)
+;; ...
+;; (feature-send-debug "Some useful debug message")
+;; ...
+;; (condition-case err
+;; ...
+;; (error
+;; (feature-send-error "%s" (error-message-string err))))
+;; ...
+;; (feature-send-info "Some useful informational message")
+;; ...
+;; (provide 'feature)
+
+;;; History:
+;;
+
+;;; Code:
+
+;;; Constants and options
+;;
+(defconst fame-valid-levels
+ '(:error :warning :info :debug)
+ "Valid message levels.")
+
+(defconst fame-valid-level-values
+ '(t nolog temp temp-nolog log none)
+ "Valid message level values.")
+
+(defconst fame-default-level-values
+ '(:debug log :info temp :warning t :error t)
+ "Default display value of message levels.")
+
+(define-widget 'fame-display-choice 'radio-button-choice
+ "Widget to choose the display value of a level."
+ :format "%v\n"
+ :entry-format " %v%b"
+ :args '((const :format "%v" :value t)
+ (const :format "%v" :value nolog)
+ (const :format "%v" :value temp)
+ (const :format "%v" :value temp-nolog)
+ (const :format "%v" :value log)
+ (const :format "%v" :value none)))
+
+(define-widget 'fame-level-widget 'const
+ "Widget to display a level symbol."
+ :format " %t")
+
+(define-widget 'fame-channel-widget 'list
+ "Widget to customize the messages levels of a channel."
+ :tag "Display value of message levels"
+ :format "%{%t%}:\n%v\n"
+ :args '((fame-level-widget :tag ":debug " :value :debug)
+ (fame-display-choice)
+ (fame-level-widget :tag ":info " :value :info)
+ (fame-display-choice)
+ (fame-level-widget :tag ":warning" :value :warning)
+ (fame-display-choice)
+ (fame-level-widget :tag ":error " :value :error)
+ (fame-display-choice)))
+
+(defgroup fame nil
+ "Framework for Applications' MEssages."
+ :prefix "fame"
+ :group 'lisp)
+
+(defcustom fame-temp-message-delay 1
+ "*Lifetime of a temporary message, in seconds."
+ :group 'fame
+ :type 'number)
+
+;;; Core message functions
+;;
+(eval-and-compile
+
+;;;; Read the message currently displayed in the echo area.
+ (defalias 'fame-current-message
+ (if (fboundp 'current-message)
+ 'current-message
+ 'ignore))
+
+;;;; Show a message in the echo area without logging it.
+ (if (fboundp 'lmessage)
+ ;; XEmacs
+ (defun fame-message-nolog (&rest args)
+ "Display but don't log a message on the echo area.
+ARGS are like those of the function `message'."
+ (and args (apply 'lmessage 'no-log args)))
+ ;; Emacs
+ (defun fame-message-nolog (&rest args)
+ "Display but don't log a message on the echo area.
+ARGS will be passed to the function `message'."
+ (and args
+ (let ((message-log-max nil)) ;; No logging
+ (apply 'message args))))
+ )
+
+;;;; Log a message without showing it in the echo area.
+ (if (fboundp 'log-message)
+ ;; XEmacs
+ (defun fame-log-message (&rest args)
+ "Log but don't display a message.
+ARGS are like those of the function `message'."
+ (and args (log-message 'message (apply 'format args))))
+ ;; Emacs
+ (defun fame-log-message (&rest args)
+ "Log but don't display a message.
+ARGS will be passed to the function `message'."
+ (and args
+ (let ((executing-kbd-macro t)) ;; Inhibit display!
+ (apply 'message args))))
+ )
+ ;; If the above definition fails, here is a portable implementation
+ ;; of a `log-message' function.
+ '(defun fame-log-message (&rest args)
+ "Log but don't display a message.
+ARGS are like those of the function `message'."
+ (when args
+ (let ((text (apply 'format args)))
+ (with-current-buffer
+ (get-buffer-create (if (featurep 'xemacs)
+ " *Message-Log*"
+ "*Messages*"))
+ (goto-char (point-max))
+ (or (bobp) (bolp) (insert "\n"))
+ (forward-line -1)
+ (if (search-forward text nil t)
+ (if (looking-at " \\[\\([0-9]+\\) times\\]")
+ (replace-match
+ (number-to-string
+ (1+ (string-to-number (match-string 1))))
+ nil nil nil 1)
+ (end-of-line)
+ (insert " [2 times]"))
+ (forward-line 1)
+ (insert text))))))
+
+;;;; Log and temporarily show a message in the echo area.
+ (condition-case nil
+ (require 'timer)
+ (error nil))
+ ;; We need timers to display messages temporarily.
+ (if (not (fboundp 'run-with-timer))
+
+ (defun fame-temp-message-internal (fun &rest args)
+ "Display a message temporarily through the function FUN.
+ARGS are like those of the function `message'."
+ ;; Without timers just call FUN.
+ (and args (apply fun args)))
+
+ (defvar fame-temp-message-timer nil)
+ (defvar fame-temp-message-saved nil)
+
+ (defun fame-temp-restore-message ()
+ "Restore a message previously displayed in the echo area."
+ (when (timerp fame-temp-message-timer)
+ (cancel-timer fame-temp-message-timer)
+ (setq fame-temp-message-timer nil))
+ (when fame-temp-message-saved
+ (prog1 (fame-message-nolog "%s" fame-temp-message-saved)
+ (setq fame-temp-message-saved nil))))
+
+ (defun fame-temp-message-internal (fun &rest args)
+ "Display a message temporarily through the function FUN.
+ARGS are like those of the function `message'."
+ (when args
+ (condition-case nil
+ (progn
+ (fame-temp-restore-message)
+ (setq fame-temp-message-saved (fame-current-message))
+ (prog1 (apply fun args)
+ (setq fame-temp-message-timer
+ (run-with-timer fame-temp-message-delay nil
+ 'fame-temp-restore-message))))
+ (error
+ (fame-temp-restore-message)))))
+ )
+ )
+
+(defsubst fame-temp-message (&rest args)
+ "Display a message temporarily and log it.
+ARGS are like those of the function `message'.
+The original message is restored to the echo area after
+`fame-temp-message-delay' seconds."
+ (apply 'fame-temp-message-internal 'message args))
+
+(defsubst fame-temp-message-nolog (&rest args)
+ "Display a message temporarily without logging it.
+ARGS are like those of the function `message'.
+The original message is restored to the echo area after
+`fame-temp-message-delay' seconds."
+ (apply 'fame-temp-message-internal 'fame-message-nolog args))
+
+;;; Handling of message levels
+;;
+(defun fame-check-level (level)
+ "Check that LEVEL is a valid message level.
+If valid, return LEVEL. Signal an error otherwise."
+ (if (memq level fame-valid-levels)
+ level
+ (signal 'wrong-type-argument
+ (list fame-valid-levels level))))
+
+(defun fame-check-level-value (value)
+ "Check that VALUE is a valid message level value.
+If valid, return VALUE. Signal an error otherwise."
+ (if (memq value fame-valid-level-values)
+ value
+ (signal 'wrong-type-argument
+ (list fame-valid-level-values value))))
+
+(defun fame-check-channel (channel)
+ "Check that CHANNEL is a non-nil symbol.
+If valid, return CHANNEL. Signal an error otherwise."
+ (if (and channel (symbolp channel))
+ channel
+ (signal 'wrong-type-argument
+ (list 'symbolp channel))))
+
+(defun fame-check-channel-levels (levels)
+ "Check that LEVELS is a valid specification of channel levels.
+If valid, return a normalized form of the specification.
+Signal an error otherwise."
+ (let (spec)
+ (dolist (level fame-valid-levels)
+ (push (fame-check-level-value
+ ;; A nil level value means to use the default value.
+ (or (plist-get levels level)
+ (plist-get fame-default-level-values level))) spec)
+ (push level spec))
+ spec))
+
+(defsubst fame-channel-symbol (channel)
+ "Return the symbol whose value is CHANNEL's levels."
+ (intern (format "%s-fame-levels" (fame-check-channel channel))))
+
+(defun fame-channel-levels (channel)
+ "Return the message levels display values of CHANNEL.
+If CHANNEL doesn't exist return the default value in constant
+`fame-default-level-values'."
+ (let ((symbol (fame-channel-symbol channel)))
+ (if (boundp symbol)
+ (symbol-value symbol)
+ fame-default-level-values)))
+
+(defsubst fame-level-display (channel level)
+ "For CHANNEL, return the display value of LEVEL.
+See also the option `fame-channels'."
+ (plist-get (fame-channel-levels channel)
+ (fame-check-level level)))
+
+;;; Sending messages to channels
+;;
+(defconst fame-send-functions-alist
+ '((none . nil)
+ (log . fame-log-message)
+ (temp . fame-temp-message)
+ (temp-nolog . fame-temp-message-nolog)
+ (nolog . fame-message-nolog)
+ (t . message)
+ ))
+
+(defun fame-send (channel level &rest args)
+ "Send a message to CHANNEL at level LEVEL.
+ARGS are like those of the function `message'.
+The message will be displayed according to what is specified for
+CHANNEL in the `fame-channels' option."
+ (let ((sender (cdr (assq (fame-level-display channel level)
+ fame-send-functions-alist))))
+ (and sender (apply sender args))))
+
+(defsubst fame-send-debug (channel &rest args)
+ "Send a debug message to CHANNEL.
+CHANNEL must be a non-nil symbol.
+ARGS will be passed to the function `fame-send'."
+ (apply 'fame-send channel :debug args))
+
+(defsubst fame-send-info (channel &rest args)
+ "Send an informational message to CHANNEL.
+CHANNEL must be a non-nil symbol.
+ARGS will be passed to the function `fame-send'."
+ (apply 'fame-send channel :info args))
+
+(defsubst fame-send-warning (channel &rest args)
+ "Send a warning message to CHANNEL.
+CHANNEL must be a non-nil symbol.
+ARGS will be passed to the function `fame-send'."
+ (apply 'fame-send channel :warning args))
+
+(defsubst fame-send-error (channel &rest args)
+ "Send an error message to CHANNEL.
+CHANNEL must be a non-nil symbol.
+ARGS will be passed to the function `fame-send'."
+ (apply 'fame-send channel :error args))
+
+;;; Defining new channels
+;;
+;;;###autoload
+(defmacro define-fame-channel (channel &optional default docstring)
+ "Define the new message channel CHANNEL.
+CHANNEL must be a non-nil symbol.
+The optional argument DEFAULT specifies the default value of message
+levels for this channel. By default it is the value of
+`fame-default-level-values'.
+DOCSTRING is an optional channel documentation.
+
+This defines the option `CHANNEL-fame-levels' to customize the current
+value of message levels. And the functions `CHANNEL-send-debug',
+`CHANNEL-send-info', `CHANNEL-send-warning', and `CHANNEL-send-error',
+that respectively send debug, informational, warning, and error
+messages to CHANNEL."
+ (let ((c-opt (fame-channel-symbol channel)))
+ `(eval-when-compile
+ (defcustom ,c-opt ',(fame-check-channel-levels default)
+ ,(format "*Display value of message levels in the %s channel.
+%s
+This is a plist where a message level is a property whose value
+defines how messages at this level will be displayed.
+
+The possible levels are :debug, :info, :warning, and :error.
+Level values can be:
+ - t to show and log messages the standard way.
+ - nolog to show messages without logging them.
+ - temp to show messages temporarily and log them.
+ - temp-nolog to show messages temporarily without logging them.
+ - log to log but not show messages.
+ - none to discard messages.
+
+The default behavior is specified in `fame-default-level-values'."
+ channel
+ (if docstring (format "%s\n" docstring) ""))
+ :group 'fame
+ :type 'fame-channel-widget)
+ (defsubst ,(intern (format "%s-send-debug" channel))
+ (&rest args)
+ ,(format "Send a debug message to the `%s' channel.
+ARGS will be passed to the function `fame-send'.
+To customize how such messages will be displayed, see the option
+`%s'." channel c-opt)
+ (apply 'fame-send ',channel :debug args))
+ (defsubst ,(intern (format "%s-send-info" channel))
+ (&rest args)
+ ,(format "Send an informational message to the `%s' channel.
+ARGS will be passed to the function `fame-send'.
+To customize how such messages will be displayed, see the option
+`%s'." channel c-opt)
+ (apply 'fame-send ',channel :info args))
+ (defsubst ,(intern (format "%s-send-warn" channel))
+ (&rest args)
+ ,(format "Send a warning message to the `%s' channel.
+ARGS will be passed to the function `fame-send'.
+To customize how such messages will be displayed, see the option
+`%s'." channel c-opt)
+ (apply 'fame-send ',channel :warning args))
+ (defsubst ,(intern (format "%s-send-error" channel))
+ (&rest args)
+ ,(format "Send an error message to the `%s' channel.
+ARGS will be passed to the function `fame-send'.
+To customize how such messages will be displayed, see the option
+`%s'." channel c-opt)
+ (apply 'fame-send ',channel :error args))
+ ;; Return the CHANNEL symbol
+ ',c-opt)))
+
+(provide 'fame)
+
+;;; fame.el ends here
View
639 lib/working.el
@@ -0,0 +1,639 @@
+;;; working --- Display a "working" message in the minibuffer.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2007, 2008, 2009 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Version: 1.5
+;; Keywords: status
+
+;; 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; Working lets Emacs Lisp programmers easily display working messages.
+;; These messages typically come in the form of a percentile, or generic
+;; doodles if a maximum is unknown.
+;;
+;; The working entry points are quite simple. If you have a loop that needs
+;; to display a status as it goes along, it would look like this:
+;;
+;; (working-status-forms "Doing stuff" "done"
+;; (while condition
+;; (working-status (calc-percentile))
+;; (my-work))
+;; (working-status t))
+;;
+;; If you cannot calculate a percentile, use the function
+;; `working-dynamic-status' instead, and pass in what you know. For
+;; both status printing functions, the first argument is optional,
+;; and you may pass in additional arguments as `format' elements
+;; to the first argument of `working-status-forms'.
+;;
+;; See the examples at the end of the buffer.
+
+;;; Backwards Compatibility:
+;;
+;; If you want to use working in your program, but don't want to force people
+;; to install working, use could add this at the beginning of your program for
+;; compatibility.
+;;
+;; (eval-and-compile
+;; (condition-case nil
+;; (require 'working)
+;; (error
+;; (progn
+;; (defmacro working-status-forms (message donestr &rest forms)
+;; "Contain a block of code during which a working status is shown."
+;; (list 'let (list (list 'msg message) (list 'dstr donestr)
+;; '(ref1 0))
+;; (cons 'progn forms)))
+;;
+;; (defun working-status (&optional percent &rest args)
+;; "Called within the macro `working-status-forms', show the status."
+;; (message "%s%s" (apply 'format msg args)
+;; (if (eq percent t) (concat "... " dstr)
+;; (format "... %3d%%"
+;; (or percent
+;; (floor (* 100.0 (/ (float (point))
+;; (point-max)))))))))
+;;
+;; (defun working-dynamic-status (&optional number &rest args)
+;; "Called within the macro `working-status-forms', show the status."
+;; (message "%s%s" (apply 'format msg args)
+;; (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ref1 4))))
+;; (setq ref1 (1+ ref1)))
+;;
+;; (put 'working-status-forms 'lisp-indent-function 2)))))
+;;
+;; Depending on what features you use, it is, of course, easy to
+;; reduce the total size of the above by omitting those features you
+;; do not use.
+
+;;; History:
+;;
+;; 1.0 First Version
+;;
+;; 1.1 Working messages are no longer logged.
+;; Added a generic animation display funciton:
+;; Convert celeron to animator
+;; Added a bounce display
+;; Made working robust under a multi-frame environment (speedbar)
+;;
+;; 1.2 Fix up documentation.
+;; Updated dotgrowth function for exceptionally large numbers of dots.
+;; Added the percentage bubble displays.
+;;
+;; 1.3 Added `working-status-timeout' and `working-status-call-process'.
+;; Added test fns `working-wait-for-keypress' and `working-verify-sleep'.
+;;
+;; 1.4 ???
+;;
+;; 1.5 Use features from the fame library.
+;;
+
+(require 'custom)
+(require 'fame)
+
+;;; Code:
+(defgroup working nil
+ "Working messages display."
+ :prefix "working"
+ :group 'lisp
+ )
+
+;;; User configurable variables
+;;
+(defcustom working-status-percentage-type 'working-bar-percent-display
+ "*Function used to display the percent status.
+Functions provided in `working' are:
+ `working-percent-display'
+ `working-bar-display'
+ `working-bar-percent-display'
+ `working-percent-bar-display'
+ `working-bubble-display'
+ `working-bubble-precent-display'
+ `working-celeron-percent-display'"
+ :group 'working
+ :type '(choice (const working-percent-display)
+ (const working-bar-display)
+ (const working-bar-percent-display)
+ (const working-percent-bar-display)
+ (const working-bubble-display)
+ (const working-bubble-percent-display)
+ (const working-celeron-percent-display)
+ (const nil)))
+
+(defcustom working-status-dynamic-type 'working-celeron-display
+ "*Function used to display an animation indicating progress being made.
+Dynamic working types occur when the program does not know how long
+it will take ahead of time. Functions provided in `working' are:
+ `working-number-display'
+ `working-text-display'
+ `working-spinner-display'
+ `working-dotgrowth-display'
+ `working-celeron-display'
+ `working-bounce-display'"
+ :group 'working
+ :type '(choice (const working-number-display)
+ (const working-text-display)
+ (const working-spinner-display)
+ (const working-dotgrowth-display)
+ (const working-celeron-display)
+ (const working-bounce-display)
+ (const nil)))
+
+(defcustom working-percentage-step 2
+ "*Percentage display step.
+A number representing how large a step must be taken when working a
+percentage display. A number such as `2' means `2%'."
+ :group 'working'
+ :type 'number)
+
+;;; Mode line hacks
+;;
+;; When the user doesn't want messages in the minibuffer, hack the mode
+;; line of the current buffer.
+(if (featurep 'xemacs)
+ (eval-and-compile (defalias 'working-mode-line-update 'redraw-modeline))
+ (eval-and-compile (defalias 'working-mode-line-update 'force-mode-line-update)))
+
+(defvar working-mode-line-message nil
+ "Message used by working when showing status in the mode line.")
+
+(if (boundp 'global-mode-string)
+ (progn
+ ;; If this variable exists, use it to push the working message into
+ ;; an interesting part of the mode line.
+ (if (null global-mode-string)
+ (setq global-mode-string (list "")))
+ (setq global-mode-string
+ (append global-mode-string '(working-mode-line-message))))
+ ;; Else, use minor mode trickery to get a reliable way of doing the
+ ;; same thing across many versions of Emacs.
+ (setq minor-mode-alist (cons
+ '(working-mode-line-message working-mode-line-message)
+ minor-mode-alist))
+ )
+
+(defvar working-use-echo-area-p t
+ "*Non-nil use the echo area to display working messages.")
+
+;;; Variables used in stages
+;;
+(defvar working-message nil
+ "Message stored when in a status loop.")
+(defvar working-donestring nil
+ "Done string stored when in a status loop.")
+(defvar working-ref1 nil
+ "A reference number used in a status loop.")
+(defvar working-last-percent 0
+ "A reference number used in a status loop.")
+
+;;; Programmer functions
+;;
+(eval-when-compile
+ (cond
+ ((fboundp 'noninteractive)
+ ;; Silence the XEmacs byte compiler
+ (defvar noninteractive))
+ ((boundp 'noninteractive)
+ ;; Silence the Emacs byte compiler
+ (defun noninteractive nil))
+ ))
+
+(defsubst working-noninteractive ()
+ "Return non-nil if running without interactive terminal."
+ (if (boundp 'noninteractive)
+ noninteractive
+ (noninteractive)))
+
+(defun working-message-echo (&rest args)
+ "Print but don't log a one-line message at the bottom of the screen.
+See the function `message' for details on ARGS."
+ (or (working-noninteractive)
+ (apply 'fame-message-nolog args)))
+
+(defalias 'working-current-message 'fame-current-message)
+(defalias 'working-temp-message 'fame-temp-message)
+
+(defun working-message (&rest args)
+ "Display a message using `working-message-echo' or in mode line.
+See the function `message' for details on ARGS."
+ (if working-use-echo-area-p
+ (apply 'working-message-echo args)
+ (when (not working-mode-line-message)
+ ;; If we start out nil, put stuff in to show we are up to
+ (setq working-mode-line-message "Working...")
+ (working-mode-line-update)
+ (sit-for 0)
+ )))
+
+;;; Compatibility
+(cond ((fboundp 'run-with-timer)
+ (eval-and-compile (defalias 'working-run-with-timer 'run-with-timer))
+ (eval-and-compile (defalias 'working-cancel-timer 'cancel-timer))
+ )
+ ;;Add compatibility here
+ (t
+ ;; This gets the message out but has no timers.
+ (defun working-run-with-timer (&rest foo)
+ (working-message working-message))
+ (defun working-cancel-timer (&rest foo)
+ (working-message "%s%s"
+ working-message
+ working-donestring)))
+ )
+
+(defmacro working-status-forms (message donestr &rest forms)
+ "Contain a block of code during which a working status is shown.
+MESSAGE is the message string to use and DONESTR is the completed text
+to use when the functions `working-status' is called from FORMS."
+ (let ((current-message (make-symbol "working-current-message")))
+ `(let ((,current-message (working-current-message))
+ (working-message ,message)
+ (working-donestring ,donestr)
+ (working-ref1 0)
+ (working-last-percent 0))
+ (unwind-protect
+ (progn ,@forms)
+ (setq working-mode-line-message nil)
+ (if working-use-echo-area-p
+ (message ,current-message)
+ (working-mode-line-update)
+ (sit-for 0))))
+ ))
+(put 'working-status-forms 'lisp-indent-function 2)
+
+(defmacro working-status-timeout (timeout message donestr &rest forms)
+ "Contain a block of code during which working status is shown.
+The code may call `sit-for' or `accept-process-output', so a timer
+is needed to update the message.
+TIMEOUT is the length of time to wait between message updates.
+MESSAGE is the message string to use and DONESTR is the completed text
+to use when the functions `working-status' is called from FORMS."
+ (let ((current-message (make-symbol "working-current-message")))
+ `(let* ((,current-message (working-current-message))
+ (working-message ,message)
+ (working-donestring ,donestr)
+ (working-ref1 0)
+ (time ,timeout)
+ (working-timer
+ (working-run-with-timer time time 'working-dynamic-status)))
+ (unwind-protect
+ (progn ,@forms)
+ (working-cancel-timer working-timer)
+ (working-dynamic-status t)
+ (setq working-mode-line-message nil)
+ (if working-use-echo-area-p
+ (message ,current-message)
+ (working-mode-line-update)
+ (sit-for 0))))
+ ))
+(put 'working-status-timeout 'lisp-indent-function 3)
+
+(defun working-status-call-process
+ (timeout message donestr program &optional infile buffer display &rest args)
+ "Display working messages while running a process.
+TIMEOUT is how fast to display the messages.
+MESSAGE is the message to show, and DONESTR is the string to add when done.
+CALLPROCESSARGS are the same style of args as passed to `call-process'.
+The are: PROGRAM, INFILE, BUFFER, DISPLAY, and ARGS.
+Since it actually calls `start-process', not all features will work."
+ (working-status-timeout timeout message donestr
+ (let ((proc (apply 'start-process "working"
+ (if (listp buffer) (car buffer) buffer)
+ program args)))
+ (set-process-sentinel proc 'list)
+ (while (eq (process-status proc) 'run)
+ (accept-process-output proc)
+ ;; accept-process-output caused my solaris Emacs 20.3 to crash.
+ ;; If this is unreliable for you, use the below which will work
+ ;; in that situation.
+ ;; (if (not (sit-for timeout)) (read-event))
+ ))))
+
+(defun working-status (&optional percent &rest args)
+ "Called within the macro `working-status-forms', show the status.
+If PERCENT is nil, then calculate PERCENT from the value of `point' in
+the current buffer. If it is a number or float, use it as the raw
+percentile.
+Additional ARGS are passed to fill on % elements of MESSAGE from the
+macro `working-status-forms'."
+ (when (and working-message working-status-percentage-type)
+ (let ((p (or percent
+ (floor (* 100.0 (/ (float (point)) (point-max)))))))
+ (if (or (eq p t)
+ (> (- p working-last-percent) working-percentage-step))
+ (let* ((m1 (apply 'format working-message args))
+ (m2 (funcall working-status-percentage-type (length m1) p)))
+ (working-message "%s%s" m1 m2)
+ (setq working-last-percent p))))))
+
+(defun working-dynamic-status (&optional number &rest args)
+ "Called within the macro `working-status-forms', show the status.
+If NUMBER is nil, then increment a local NUMBER from 0 with each call.
+If it is a number or float, use it as the raw percentile.
+Additional ARGS are passed to fill on % elements of MESSAGE from the
+macro `working-status-forms'."
+ (when (and working-message working-status-dynamic-type)
+ (let* ((n (or number working-ref1))
+ (m1 (apply 'format working-message args))
+ (m2 (funcall working-status-dynamic-type (length m1) n)))
+ (working-message "%s%s" m1 m2)
+ (setq working-ref1 (1+ working-ref1)))))
+
+;;; Utilities
+;;
+(defun working-message-frame-width ()
+ "Return the width of the frame the working message will be in."
+ (let* ((mbw (cond ((fboundp 'frame-parameter)
+ (frame-parameter (selected-frame) 'minibuffer))
+ ((fboundp 'frame-property)
+ (frame-property (selected-frame) 'minibuffer))))
+ (fr (if (windowp mbw)
+ (window-frame mbw)
+ default-minibuffer-frame)))
+ (frame-width fr)))
+
+;;; Percentage display types.
+;;
+(defun working-percent-display (length percent)
+ "Return the percentage of the buffer that is done in a string.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (cond ((eq percent t) (concat "... " working-donestring))
+ ;; All the % signs because it then gets passed to message.
+ (t (format "... %3d%%" percent))))
+
+(defun working-bar-display (length percent)
+ "Return a string with a bar-graph showing percent.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (let ((bs (- (working-message-frame-width) length 5)))
+ (cond ((eq percent t)
+ (concat ": [" (make-string bs ?#) "] " working-donestring))
+ ((< bs 0) "")
+ (t (let ((bsl (floor (* (/ percent 100.0) bs))))
+ (concat ": ["
+ (make-string bsl ?#)
+ (make-string (- bs bsl) ?.)
+ "]"))))))
+
+(defun working-bar-percent-display (length percent)
+ "Return a string with a bar-graph and percentile showing percentage.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (let* ((ps (if (eq percent t)
+ (concat "... " working-donestring)
+ (working-percent-display length percent)))
+ (psl (+ 2 length (length ps))))
+ (cond ((eq percent t)
+ (concat (working-bar-display psl 100) " " ps))
+ (t
+ (setq working-ref1 (length ps))
+ (concat (working-bar-display psl percent) " " ps)))))
+
+(defun working-percent-bar-display (length percent)
+ "Return a string with a percentile and bar-graph showing percentage.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (let* ((ps (if (eq percent t)
+ (concat "... " working-donestring)
+ (working-percent-display length percent)))
+ (psl (+ 1 length (length ps))))
+ (cond ((eq percent t)
+ (concat ps " " (working-bar-display psl 100)))
+ (t
+ (setq working-ref1 (length ps))
+ (concat ps " " (working-bar-display psl percent))))))
+
+(defun working-bubble-display (length percent)
+ "Return a string with a bubble graph indicating the precent completed.
+LENGTH is the amount of the display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (if (eq percent t)
+ (concat " [@@@@@@@@@@@@@@@@@@@@] " working-donestring)
+ (let ((bs " [")
+ (bubbles [ ?. ?- ?o ?O ?@ ]))
+ (if (> percent 5)
+ (setq bs (concat bs (make-string (/ (floor percent) 5) ?@))))
+ (setq bs (concat bs
+ (char-to-string (aref bubbles (% (floor percent) 5)))))
+ (if (< (/ (floor percent) 5) 20)
+ (setq bs (concat bs (make-string (- 19 (/ (floor percent) 5)) ? ))))
+ (concat bs "]"))))
+
+(defun working-bubble-percent-display (length percent)
+ "Return a string with a percentile and bubble graph showing percentage.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (let* ((ps (if (eq percent t)
+ (concat " ... " working-donestring)
+ (working-percent-display length percent)))
+ (psl (+ 1 length (length ps))))
+ (cond ((eq percent t)
+ (concat (working-bubble-display psl t)))
+ (t
+ (setq working-ref1 (length ps))
+ (concat (working-bubble-display psl percent) ps)))))
+
+(defun working-celeron-percent-display (length percent)
+ "Return a string with a celeron and string showing percent.
+LENGTH is the amount of display that has been used. PERCENT
+is t to display the done string, or the percentage to display."
+ (prog1
+ (cond ((eq percent t) (working-celeron-display length t))
+ ;; All the % signs because it then gets passed to message.
+ (t (format "%s %3d%%"
+ (working-celeron-display length 0)
+ percent)))
+ (setq working-ref1 (1+ working-ref1))))
+
+;;; Dynamic display types.
+;;
+(defun working-number-display (length number)
+ "Return a string displaying the number of things that happened.
+LENGTH is the amount of display that has been used. NUMBER
+is t to display the done string, or the number to display."
+ (cond ((eq number t) (concat "... " working-donestring))
+ ;; All the % signs because it then gets passed to message.
+ (t (format "... %d" number))))
+
+(defun working-text-display (length text)
+ "Return a string displaying the name of things that happened.
+LENGTH is the amount of display that has been used. TEXT
+is t to display the done string, or the text to display."
+ (if (eq text t)
+ (concat "... " working-donestring)
+ (format "... %s" text)))
+
+(defun working-spinner-display (length number)
+ "Return a string displaying a spinner based on a number.
+LENGTH is the amount of display that has been used. NUMBER
+is t to display the done string, or the number to display."
+ (cond ((eq number t) (concat "... " working-donestring))
+ ;; All the % signs because it then gets passed to message.
+ (t (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% working-ref1 4))))))
+
+(defun working-dotgrowth-display (length number)
+ "Return a string displaying growing dots due to activity.
+LENGTH is the amount of display that has been used. NUMBER
+is t to display the done string, or the number to display.
+This display happens to ignore NUMBER."
+ (let* ((width (- (working-message-frame-width) 4 length))
+ (num-wrap (/ working-ref1 width))
+ (num-. (% working-ref1 width))
+ (dots [ ?. ?, ?o ?* ?O ?@ ?# ]))
+ (concat " (" (make-string num-. (aref dots (% num-wrap (length dots)))) ")"
+ (if (eq number t) (concat " " working-donestring) ""))))
+
+(defun working-frame-animation-display (length number frames)
+ "Manage a simple frame-based animation for working functions.
+LENGTH is the number of characters left. NUMBER is a passed in
+number (which happens to be ignored.). While coders pass t into
+NUMBER, functions using this should convert NUMBER into a vector
+describing how to render the done message.
+Argument FRAMES are the frames used in the animation."
+ (cond ((vectorp number)
+ (let ((zone (- (length (aref frames 0)) (length (aref number 0))
+ (length (aref number 1)))))
+ (if (< (length working-donestring) zone)
+ (concat " " (aref number 0)
+ (make-string
+ (ceiling (/ (- (float zone)
+ (length working-donestring)) 2)) ? )
+ working-donestring
+ (make-string
+ (floor (/ (- (float zone)
+ (length working-donestring)) 2)) ? )
+ (aref number 1))
+ (concat " " (aref frames (% working-ref1 (length frames)))
+ " " working-donestring))))
+ (t (concat " " (aref frames (% working-ref1 (length frames)))))))
+
+(defvar working-celeron-strings
+ [ "[O ]" "[oO ]" "[-oO ]" "[ -oO ]" "[ -oO ]" "[ -oO]"
+ "[ -O]" "[ O]" "[ Oo]" "[ Oo-]" "[ Oo- ]" "[ Oo- ]"
+ "[Oo- ]" "[O- ]"]
+ "Strings representing a silly celeron.")
+
+(defun working-celeron-display (length number)
+ "Return a string displaying a celeron as things happen.
+LENGTH is the amount of display that has been used. NUMBER
+is t to display the done string, or the number to display."
+ (cond ((eq number t)
+ (working-frame-animation-display length [ "[" "]" ]
+ working-celeron-strings))
+ ;; All the % signs because it then gets passed to message.
+ (t (working-frame-animation-display length number
+ working-celeron-strings))))
+
+(defvar working-bounce-strings
+ [
+ "[_ ]"
+ "[ - ]"
+ "[ ~ ]"
+ "[ - ]"
+ "[ _ ]"
+ "[ - ]"
+ "[ ~ ]"
+ "[ - ]"
+ "[ _ ]"
+ "[ -]"
+
+ ]
+ "Strings for the bounce animation.")
+
+(defun working-bounce-display (length number)
+ "Return a string displaying a celeron as things happen.
+LENGTH is the amount of display that has been used. NUMBER
+is t to display the done string, or the number to display."
+ (cond ((eq number t)
+ (working-frame-animation-display length [ "[" "]" ]
+ working-bounce-strings))
+ ;; All the % signs because it then gets passed to message.
+ (t (working-frame-animation-display length number
+ working-bounce-strings))))
+
+;;; Some edebug hooks
+;;
+(add-hook
+ 'edebug-setup-hook
+ (lambda ()
+ (def-edebug-spec working-status-forms (form form def-body))
+ (def-edebug-spec working-status-timeout (form form form def-body))))
+
+;;; Example function using `working'
+;;
+(defun working-verify-parenthesis-a ()
+ "Verify all the parenthesis in an elisp program buffer."
+ (interactive)
+ (working-status-forms "Scanning" "done"
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; Use default buffer position.
+ (working-status)
+ (forward-sexp 1)
+ (sleep-for 0.05)
+ )
+ (working-status t))
+ (sit-for 1)))
+
+(defun working-verify-parenthesis-b ()
+ "Verify all the parenthesis in an elisp program buffer."
+ (interactive)
+ (working-status-forms "Scanning" "done"
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; Use default buffer position.
+ (working-dynamic-status nil)
+ (forward-sexp 1)
+ (sleep-for 0.05)
+ )
+ (working-dynamic-status t))
+ (sit-for 0)))
+
+(defun working-wait-for-keypress ()
+ "Display funny graphics while waiting for a keypress."
+ (interactive)
+ (working-status-timeout .1 "Working Test: Press a key" "done"
+ (while (sit-for 10)))
+ (when (input-pending-p)
+ (if (fboundp 'read-event)
+ (read-event)
+ (read-char)))
+ )
+
+(defun working-verify-sleep ()
+ "Display funny graphics while waiting for sleep to sleep."
+ (interactive)
+ (working-status-call-process .1 "Zzzzz" "Snort" "sleep" nil nil nil "2"))
+
+(defun working-verify-mode-line ()
+ "Display graphics in the mode-line for timeout."
+ (interactive)
+ (let ((working-use-echo-area-p nil))
+ (message "Pres a Key")
+ (working-status-timeout .1 "" ""
+ (while (sit-for 10)))
+ ))
+
+(provide 'working)
+
+;;; working.el ends here
View
1  settings.el
@@ -230,6 +230,7 @@
'(nxml-sexp-element-flag t)
'(nxml-slash-auto-complete-flag t)
'(offlineimap-command "offlineimap -u machineui")
+ '(pabbrev-idle-timer-verbose nil)
'(package-archives (quote (("gnu" . "http://elpa.gnu.org/packages/") ("ELPA" . "http://tromey.com/elpa/") ("Marmalade" . "http://marmalade-repo.org/packages/"))))
'(parens-require-spaces t)
'(pcomplete-compare-entries-function (quote file-newer-than-file-p))
Please sign in to comment.
Something went wrong with that request. Please try again.