;;; munge-root-window.el
;;;
;;; Copyright (C) 1997, 1998, 2000, 2004, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released under
;;; the terms of the GNU General Public License as published by the
;;; Free Software Foundation; either version 3, or (at your option) any
;;; later version.  There is NO WARRANTY.  See file COPYING for details.

;;; Description: Munge root window in luser-selectable ways.

(require 'cl)
(require 'electric)
(require 'set-keys)
(require 'outside)

(defvar munge-root-window-command-format
  (cond ((= 0 (shell-command "type xlock"))
         "xlock -mode %s -nolock -inroot &")
        ((file-exists-p "/usr/X11R6/lib/xscreensaver")
         "/usr/X11R6/lib/xscreensaver/%s -root &")
        (t "%s &"))
  "*A string suitable for `format'.  One \"%s\" is expanded.
The last character should be \"&\".")

(defun munge-root-window-commands ()
  "Return a list of commands (each a string) to munge the root window.
Those ending in \"&\" are backgroundable."
  (append
   `("xsetroot -solid black"
     "xsetroot -solid gray30"
     ,@(mapcar
        (lambda (s) (format munge-root-window-command-format s))
        '("starfish"
          "ifs"
          "drift -grow"
          "flame"
          "bouboule -delay 10000"
          "bouboule -delay 15000"
          "qix"
          "hop"
          "slip"
          "swarm"
          "coral"
          "rd-bomb -speed 1 -size 0.1"
          "loop"
          "epicycle -min_circles 42 -timestep 1 -holdtime 30 -linewidth 20"
          ;; Add xlock modes here.
          ))
     "oclock -transparent -bd gold -fg gold"
     ;; Add non-xlock programs here.
     )
   (mapcar (lambda (x)
             (concat "kill " (buffer-name x)))
           (delete-if-not (lambda (x)
                            (string-match ".bg job. " (buffer-name x)))
                          (copy-sequence (buffer-list))))))

;;;###autoload
(defun munge-root-window ()
  "Display command list and let user choose one by hitting RET.
Use `Electric-command-loop' to receive input."
  (interactive)
  (let ((cur-win-config (current-window-configuration)))
    (switch-to-buffer-other-window "*Munge Root Window*")
    (delete-region (point-min) (point-max))
    (use-local-map (make-sparse-keymap))
    (local-set-keys
     '("n"    next-line
       "p"    previous-line
       " "    next-line
       "\177" previous-line
       "\C-m" munge-root-window-act))
    (flet ((display (cmd-list)
                    (if (null cmd-list)
                        nil
                      (insert "  " (car cmd-list) "\n")
                      (display (cdr cmd-list)))))
      (display (munge-root-window-commands)))
    (delete-region (1- (point-max)) (point-max))
    (goto-char (point-min))
    (shrink-window-if-larger-than-buffer)
    (catch 'munge-root-window-select
      (Electric-command-loop 'munge-root-window-select
                             "Move cursor and hit RET (or hit C-g to quit)."))
    (kill-buffer "*Munge Root Window*")
    (message "")
    (set-window-configuration cur-win-config)))

(defun munge-root-window-act ()
  "Execute the command on the current line.
If the command starts with \"kill *bg job*\", kill the associated buffer.
If the command ends in \"&\", execute using `bg-shell-command'.
Otherwise execute using `saved-shell-command'.
When done, throw control back to `munge-root-window'."
  (interactive)
  (let* ((end (progn (end-of-line) (point)))
         (beg (progn (beginning-of-line) (+ 2 (point))))
         (cmd (buffer-substring beg end)))
    (cond ((string-match "kill \\(.bg job. .*\\)" cmd)
           (kill-buffer (match-string 1 cmd)))
          ((eq ?& (aref cmd (1- (length cmd))))
           (bg-shell-command (substring cmd 0 -1)))
          (t
           (saved-shell-command cmd))))
  (throw 'munge-root-window-select nil))

(provide 'munge-root-window)

;;; munge-root-window.el ends here