;; From: Karl Fogel <kfogel@floss.cyclic.com>
;; To: jimb@floss.life.uiuc.edu, friedman@floss.life.uiuc.edu,
;;         roland@floss.life.uiuc.edu
;; Subject: cut little library
;; Date: Tue, 18 Apr 1995 12:46:08 -0500
;; Reply-To: kfogel@cyclic.com
;;
;;         I use this to be able to type "M-x from" and see who I have
;; mail from, or "M-x who" and see who's logged in, etc.  It's handy...

;; $Id: kf-frobs.el,v 1.2 1999/06/09 08:23:34 friedman Exp $

(defun kf-nf-non-whitespace-regexp (&optional table)
  "Return a regular expression matching a non-whitespace character.
This function is sensitive to the current buffer's syntax table."
  (or table
      (setq table (syntax-table)))
  (let ((s "")
        (ws-syntax '(?- ?\ )))
    (cond ((fboundp 'map-syntax-table)
           ;; XEmacs 20 way.
           (map-syntax-table
            (function (lambda (key val)
                        (and (memq (char-syntax key table) ws-syntax)
                             (setq s (concat s (char-to-string key))))
                        nil))
            table))
          (t
           (let ((orig-table (syntax-table))
                 (i 0)
                 (l (min 256 (length table))))
             (set-syntax-table table)
             (unwind-protect
                 (while (< i l)
                   (and (memq (char-syntax i) ws-syntax)
                        (setq s (concat s (char-to-string i))))
                   (setq i (1+ i)))
               (set-syntax-table orig-table)))))
    (concat "[^" s "]")))

(defconst kf-nf-non-whitespace-regexp
  (kf-nf-non-whitespace-regexp (standard-syntax-table)))

(defun kf-display-buffer (buffer &optional kill-after-display)
  "Display BUFFER.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way."
  (let ((wc (current-window-configuration)))
    (display-buffer buffer)
    (shrink-window-if-larger-than-buffer (get-buffer-window buffer))
    (setq unread-command-char (read-char-exclusive))
    (set-window-configuration wc)
    (if kill-after-display
        (kill-buffer buffer))))

(defun kf-display-command-output (command &optional empty-msg)
  "Display output of COMMAND.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way.
Optional second argument EMPTY-MSG is a message to display if COMMAND
produces no output."
  (let ((cbuf (get-buffer-create "*Output*")))
    (set-buffer cbuf)
    (fundamental-mode)
    (erase-buffer)
    (goto-char (point-min))
    (shell-command command t)
    (cond ((re-search-forward kf-nf-non-whitespace-regexp nil t)
           (goto-char (point-min))
           (kf-display-buffer cbuf t))
          (t
           (kill-buffer cbuf)
           (message empty-msg)))))

;; Now some commands using above mini-library:

(defun kf-who ()
  "Show users.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way."
  (interactive)
  (kf-display-command-output "w"))
(defalias 'who 'kf-who)

(defun kf-ps ()
  "Show processes.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way."
  (interactive)
  (kf-display-command-output "ps -aux"))
;(defalias 'ps 'kf-ps)

(defun kf-cookie ()
  "Show a cookie.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way."
  (interactive)
  (kf-display-command-output "cookie"))
;; the function `cookie' is defined by cookie1, for use with yow, etc.
(defalias 'fortune 'kf-cookie)

(defun kf-from ()
  "Show mail from.  Hit any key to make the window go away.
The character typed is treated normally, not lost, by the way."
  (interactive)
  (kf-display-command-output
   (format "from -c %d" (1- (screen-width))) "No mail."))
(defalias 'from 'kf-from)

(provide 'kf-frobs)