1 ;;; fame.el --- Framework for Applications' MEssages
3 ;; Copyright (C) 2004 David Ponce
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 28 Oct 2004
9 ;; X-RCS: $Id: fame.el,v 1.3 2005-09-30 20:07:29 zappo Exp $
11 ;; This file is not part of GNU Emacs.
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This software is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
30 ;; This library provides a convenient framework for applications to
31 ;; send messages distinguished by their level of importance, allowing
32 ;; to customize how they will be actually rendered.
34 ;; The principle is to define a `channel' where to send messages at
35 ;; particular levels, depending on their importance. A channel is
36 ;; identified by a non-nil symbol. For example this library could
37 ;; send its messages to the `fame' channel. Four levels of importance
38 ;; are recognized, for debug, informational, warning and error
41 ;; Messages at any particular level can be either discarded,
42 ;; temporarily displayed, recorded in the message log buffer without
43 ;; showing them in the echo area, or shown the usual way like through
44 ;; the `message' function. Messages shown in the echo area can be
45 ;; recorded or not in the message log buffer.
47 ;; The `define-fame-channel' macro permits to easily define a new
48 ;; channel, that is an option to customize how to display the message
49 ;; levels for this channel, and the level specific functions to use to
50 ;; send messages to this channel.
52 ;; Here is a small example:
56 ;; (define-fame-channel feature)
58 ;; (feature-send-debug "Some useful debug message")
60 ;; (condition-case err
63 ;; (feature-send-error "%s" (error-message-string err))))
65 ;; (feature-send-info "Some useful informational message")
74 ;;; Constants and options
76 (defconst fame-valid-levels
77 '(:error :warning :info :debug)
78 "Valid message levels.")
80 (defconst fame-valid-level-values
81 '(t nolog temp temp-nolog log none)
82 "Valid message level values.")
84 (defconst fame-default-level-values
85 '(:debug log :info temp :warning t :error t)
86 "Default display value of message levels.")
88 (define-widget 'fame-display-choice 'radio-button-choice
89 "Widget to choose the display value of a level."
92 :args '((const :format "%v" :value t)
93 (const :format "%v" :value nolog)
94 (const :format "%v" :value temp)
95 (const :format "%v" :value temp-nolog)
96 (const :format "%v" :value log)
97 (const :format "%v" :value none)))
99 (define-widget 'fame-level-widget 'const
100 "Widget to display a level symbol."
103 (define-widget 'fame-channel-widget 'list
104 "Widget to customize the messages levels of a channel."
105 :tag "Display value of message levels"
106 :format "%{%t%}:\n%v\n"
107 :args '((fame-level-widget :tag ":debug " :value :debug)
108 (fame-display-choice)
109 (fame-level-widget :tag ":info " :value :info)
110 (fame-display-choice)
111 (fame-level-widget :tag ":warning" :value :warning)
112 (fame-display-choice)
113 (fame-level-widget :tag ":error " :value :error)
114 (fame-display-choice)))
117 "Framework for Applications' MEssages."
121 (defcustom fame-temp-message-delay 1
122 "*Lifetime of a temporary message, in seconds."
126 ;;; Core message functions
130 ;;;; Read the message currently displayed in the echo area.
131 (defalias 'fame-current-message
132 (if (fboundp 'current-message)
136 ;;;; Show a message in the echo area without logging it.
137 (if (fboundp 'lmessage)
139 (defun fame-message-nolog (&rest args)
140 "Display but don't log a message on the echo area.
141 ARGS are like those of the function `message'."
142 (and args (apply 'lmessage 'no-log args)))
144 (defun fame-message-nolog (&rest args)
145 "Display but don't log a message on the echo area.
146 ARGS will be passed to the function `message'."
148 (let ((message-log-max nil)) ;; No logging
149 (apply 'message args))))
152 ;;;; Log a message without showing it in the echo area.
153 (if (fboundp 'log-message)
155 (defun fame-log-message (&rest args)
156 "Log but don't display a message.
157 ARGS are like those of the function `message'."
158 (and args (log-message 'message (apply 'format args))))
160 (defun fame-log-message (&rest args)
161 "Log but don't display a message.
162 ARGS will be passed to the function `message'."
164 (let ((executing-kbd-macro t)) ;; Inhibit display!
165 (apply 'message args))))
167 ;; If the above definition fails, here is a portable implementation
168 ;; of a `log-message' function.
169 '(defun fame-log-message (&rest args)
170 "Log but don't display a message.
171 ARGS are like those of the function `message'."
173 (let ((text (apply 'format args)))
175 (get-buffer-create (if (featurep 'xemacs)
178 (goto-char (point-max))
179 (or (bobp) (bolp) (insert "\n"))
181 (if (search-forward text nil t)
182 (if (looking-at " \\[\\([0-9]+\\) times\\]")
185 (1+ (string-to-number (match-string 1))))
188 (insert " [2 times]"))
192 ;;;; Log and temporarily show a message in the echo area.
196 ;; We need timers to display messages temporarily.
197 (if (not (fboundp 'run-with-timer))
199 (defun fame-temp-message-internal (fun &rest args)
200 "Display a message temporarily through the function FUN.
201 ARGS are like those of the function `message'."
202 ;; Without timers just call FUN.
203 (and args (apply fun args)))
205 (defvar fame-temp-message-timer nil)
206 (defvar fame-temp-message-saved nil)
208 (defun fame-temp-restore-message ()
209 "Restore a message previously displayed in the echo area."
210 (when (timerp fame-temp-message-timer)
211 (cancel-timer fame-temp-message-timer)
212 (setq fame-temp-message-timer nil))
213 (when fame-temp-message-saved
214 (prog1 (fame-message-nolog "%s" fame-temp-message-saved)
215 (setq fame-temp-message-saved nil))))
217 (defun fame-temp-message-internal (fun &rest args)
218 "Display a message temporarily through the function FUN.
219 ARGS are like those of the function `message'."
223 (fame-temp-restore-message)
224 (setq fame-temp-message-saved (fame-current-message))
225 (prog1 (apply fun args)
226 (setq fame-temp-message-timer
227 (run-with-timer fame-temp-message-delay nil
228 'fame-temp-restore-message))))
230 (fame-temp-restore-message)))))
234 (defsubst fame-temp-message (&rest args)
235 "Display a message temporarily and log it.
236 ARGS are like those of the function `message'.
237 The original message is restored to the echo area after
238 `fame-temp-message-delay' seconds."
239 (apply 'fame-temp-message-internal 'message args))
241 (defsubst fame-temp-message-nolog (&rest args)
242 "Display a message temporarily without logging it.
243 ARGS are like those of the function `message'.
244 The original message is restored to the echo area after
245 `fame-temp-message-delay' seconds."
246 (apply 'fame-temp-message-internal 'fame-message-nolog args))
248 ;;; Handling of message levels
250 (defun fame-check-level (level)
251 "Check that LEVEL is a valid message level.
252 If valid, return LEVEL. Signal an error otherwise."
253 (if (memq level fame-valid-levels)
255 (signal 'wrong-type-argument
256 (list fame-valid-levels level))))
258 (defun fame-check-level-value (value)
259 "Check that VALUE is a valid message level value.
260 If valid, return VALUE. Signal an error otherwise."
261 (if (memq value fame-valid-level-values)
263 (signal 'wrong-type-argument
264 (list fame-valid-level-values value))))
266 (defun fame-check-channel (channel)
267 "Check that CHANNEL is a non-nil symbol.
268 If valid, return CHANNEL. Signal an error otherwise."
269 (if (and channel (symbolp channel))
271 (signal 'wrong-type-argument
272 (list 'symbolp channel))))
274 (defun fame-check-channel-levels (levels)
275 "Check that LEVELS is a valid specification of channel levels.
276 If valid, return a normalized form of the specification.
277 Signal an error otherwise."
279 (dolist (level fame-valid-levels)
280 (push (fame-check-level-value
281 ;; A nil level value means to use the default value.
282 (or (plist-get levels level)
283 (plist-get fame-default-level-values level))) spec)
287 (defsubst fame-channel-symbol (channel)
288 "Return the symbol whose value is CHANNEL's levels."
289 (intern (format "%s-fame-levels" (fame-check-channel channel))))
291 (defun fame-channel-levels (channel)
292 "Return the message levels display values of CHANNEL.
293 If CHANNEL doesn't exist return the default value in constant
294 `fame-default-level-values'."
295 (let ((symbol (fame-channel-symbol channel)))
297 (symbol-value symbol)
298 fame-default-level-values)))
300 (defsubst fame-level-display (channel level)
301 "For CHANNEL, return the display value of LEVEL.
302 See also the option `fame-channels'."
303 (plist-get (fame-channel-levels channel)
304 (fame-check-level level)))
306 ;;; Sending messages to channels
308 (defconst fame-send-functions-alist
310 (log . fame-log-message)
311 (temp . fame-temp-message)
312 (temp-nolog . fame-temp-message-nolog)
313 (nolog . fame-message-nolog)
317 (defun fame-send (channel level &rest args)
318 "Send a message to CHANNEL at level LEVEL.
319 ARGS are like those of the function `message'.
320 The message will be displayed according to what is specified for
321 CHANNEL in the `fame-channels' option."
322 (let ((sender (cdr (assq (fame-level-display channel level)
323 fame-send-functions-alist))))
324 (and sender (apply sender args))))
326 (defsubst fame-send-debug (channel &rest args)
327 "Send a debug message to CHANNEL.
328 CHANNEL must be a non-nil symbol.
329 ARGS will be passed to the function `fame-send'."
330 (apply 'fame-send channel :debug args))
332 (defsubst fame-send-info (channel &rest args)
333 "Send an informational message to CHANNEL.
334 CHANNEL must be a non-nil symbol.
335 ARGS will be passed to the function `fame-send'."
336 (apply 'fame-send channel :info args))
338 (defsubst fame-send-warning (channel &rest args)
339 "Send a warning message to CHANNEL.
340 CHANNEL must be a non-nil symbol.
341 ARGS will be passed to the function `fame-send'."
342 (apply 'fame-send channel :warning args))
344 (defsubst fame-send-error (channel &rest args)
345 "Send an error message to CHANNEL.
346 CHANNEL must be a non-nil symbol.
347 ARGS will be passed to the function `fame-send'."
348 (apply 'fame-send channel :error args))
350 ;;; Defining new channels
353 (defmacro define-fame-channel (channel &optional default docstring)
354 "Define the new message channel CHANNEL.
355 CHANNEL must be a non-nil symbol.
356 The optional argument DEFAULT specifies the default value of message
357 levels for this channel. By default it is the value of
358 `fame-default-level-values'.
359 DOCSTRING is an optional channel documentation.
361 This defines the option `CHANNEL-fame-levels' to customize the current
362 value of message levels. And the functions `CHANNEL-send-debug',
363 `CHANNEL-send-info', `CHANNEL-send-warning', and `CHANNEL-send-error',
364 that respectively send debug, informational, warning, and error
365 messages to CHANNEL."
366 (let ((c-opt (fame-channel-symbol channel)))
368 (defcustom ,c-opt ',(fame-check-channel-levels default)
369 ,(format "*Display value of message levels in the %s channel.
371 This is a plist where a message level is a property whose value
372 defines how messages at this level will be displayed.
374 The possible levels are :debug, :info, :warning, and :error.
376 - t to show and log messages the standard way.
377 - nolog to show messages without logging them.
378 - temp to show messages temporarily and log them.
379 - temp-nolog to show messages temporarily without logging them.
380 - log to log but not show messages.
381 - none to discard messages.
383 The default behavior is specified in `fame-default-level-values'."
385 (if docstring (format "%s\n" docstring) ""))
387 :type 'fame-channel-widget)
388 (defsubst ,(intern (format "%s-send-debug" channel))
390 ,(format "Send a debug message to the `%s' channel.
391 ARGS will be passed to the function `fame-send'.
392 To customize how such messages will be displayed, see the option
393 `%s'." channel c-opt)
394 (apply 'fame-send ',channel :debug args))
395 (defsubst ,(intern (format "%s-send-info" channel))
397 ,(format "Send an informational message to the `%s' channel.
398 ARGS will be passed to the function `fame-send'.
399 To customize how such messages will be displayed, see the option
400 `%s'." channel c-opt)
401 (apply 'fame-send ',channel :info args))
402 (defsubst ,(intern (format "%s-send-warn" channel))
404 ,(format "Send a warning message to the `%s' channel.
405 ARGS will be passed to the function `fame-send'.
406 To customize how such messages will be displayed, see the option
407 `%s'." channel c-opt)
408 (apply 'fame-send ',channel :warning args))
409 (defsubst ,(intern (format "%s-send-error" channel))
411 ,(format "Send an error message to the `%s' channel.
412 ARGS will be passed to the function `fame-send'.
413 To customize how such messages will be displayed, see the option
414 `%s'." channel c-opt)
415 (apply 'fame-send ',channel :error args))
416 ;; Return the CHANNEL symbol
421 ;;; fame.el ends here