Mercurial > hg > xemacs-beta

comparison lisp/prim/advocacy.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; advocacy.el -- blatant XEmacs self promotion
2 ;; Copyright (C) 1996 Miranova Systems, Inc.
3 ;; Copyright (C) 1996 Chuck Thompson <cthomp@xemacs.org>
4
5 ;; Original Author: Steve L Baur <steve@miranova.com>
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;;###autoload
24 (defvar xemacs-praise-sound-file "sounds/im_so_happy.au"
25 "The name of an audio file containing something to play
26 when praising XEmacs")
27
28 ;;;###autoload
29 (defvar xemacs-praise-message
30 "All Hail XEmacs!\n"
31 "What to praise XEmacs with")
32
33 ;;;###autoload
34 (defun praise-be-unto-xemacs (&optional arg)
35 "All Hail XEmacs!"
36 (interactive "_p")
37 (save-window-excursion
38 (let ((count (if (null arg)
39 0
40 arg))
41 (max-faces (length (face-list))))
42 (with-output-to-temp-buffer "*Praise*"
43 (set-buffer "*Praise*")
44 (while (> count 0)
45 (progn
46 (insert-face xemacs-praise-message
47 (get-face (nth (random max-faces) (face-list))))
48 (setq count (- count 1))))))
49 (let ((sound-file
50 (or (file-exists-p xemacs-praise-sound-file)
51 (file-exists-p
52 (concat data-directory xemacs-praise-sound-file)))))
53 (if (and (device-sound-enabled-p) sound-file)
54 (progn
55 (sit-for 0)
56 (play-sound-file sound-file))
57 (sit-for 10)))))
58
59 ;;;###autoload
60 (defun praise-be-unto-emacs (&optional arg)
61 (interactive "_p")
62 (error "Obsolete function. Use `praise-be-unto-xemacs'."))
63 (make-obsolete 'praise-be-unto-emacs "use praise-be-unto-xemacs")
64
65 ;;;###autoload
66 (defun all-hail-xemacs (&optional arg)
67 "All Hail XEmacs!"
68 (interactive "_p")
69 (praise-be-unto-xemacs arg))
70
71 ;;;###autoload
72 (defun all-hail-emacs (&optional arg)
73 (interactive "_p")
74 (error "Obsolete function. Use `all-hail-xemacs'."))
75 (make-obsolete 'all-hail-emacs "use all-hail-xemacs")