misc-games / advocacy.el

;;; advocacy.el -- blatant XEmacs self promotion
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1996 Chuck Thompson <cthomp@xemacs.org>

;; Original Author:  Steve L Baur <steve@xemacs.org>

;; This file is part of XEmacs.

;; XEmacs 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.

;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;;###autoload
(defvar xemacs-praise-sound-file "im_so_happy"
  "The name of an audio file containing something to play
when praising XEmacs")

;;;###autoload
(defvar xemacs-praise-message
  "All Hail XEmacs!\n"
  "What to praise XEmacs with")

;;;###autoload
(defun praise-be-unto-xemacs (&optional arg)
  "All Hail XEmacs!"
  (interactive "_p")
  (save-window-excursion
    (let ((count (if (null arg)
		     0
		   arg))
 	  (max-faces (length (face-list))))
      (with-output-to-temp-buffer "*Praise*"
	(set-buffer "*Praise*")
        (if (glyphp xemacs-logo)
            (let ((p (point)))
              (insert "\n")
              (indent-to (startup-center-spaces xemacs-logo))
              (set-extent-begin-glyph 
	       (make-extent (point) (point)) xemacs-logo)
              (insert "\n\n")))
	(while (> count 0)
	  (progn
	    (insert-face xemacs-praise-message
			 (get-face (nth (random max-faces) (face-list))))
	    (setq count (- count 1))))))
    (when (load-library "sound")
      (let ((sound-file xemacs-praise-sound-file)
	    (extensions (split-string sound-extension-list ":"))
	    (data-dir (locate-data-directory "sounds")))
	(while (and (not (file-exists-p sound-file))
		    (not (file-exists-p (concat data-dir sound-file)))
		    extensions)
	  (setq sound-file (concat xemacs-praise-sound-file (car extensions))
		extensions (cdr extensions)))
	(setq sound-file
	      (or (and (file-exists-p sound-file)
		       sound-file)
		  (and (file-exists-p
			(concat data-dir sound-file))
		       (concat data-dir sound-file))))
	(if (and (device-sound-enabled-p) sound-file)
	    (progn
	      (sit-for 0)
	      (play-sound-file sound-file)
	      (wait-for-sounds)))))
    (sit-for 10)))

;;;###autoload
(defun praise-be-unto-emacs (&optional arg)
  (interactive "_p")
  (error "Obsolete function.  Use `praise-be-unto-xemacs'."))
(make-compatible 'praise-be-unto-emacs "use praise-be-unto-xemacs")

;;;###autoload
(defun all-hail-xemacs (&optional arg)
  "All Hail XEmacs!"
  (interactive "_p")
  (praise-be-unto-xemacs arg))

;;;###autoload
(defun all-hail-emacs (&optional arg)
  (interactive "_p")
  (error "Obsolete function.  Use `all-hail-xemacs'."))
(make-compatible 'all-hail-emacs "use all-hail-xemacs")

;;; advocacy.el ends here
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.