;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;;        David J. Biesack

;; This file is not part of GNU Emacs.

;; GNU Emacs 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.

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

;;; Commentary:

;; Various functions for Emacs Lisp and .el files

;; Author: David Biesack (David.Biesack@sas.com  or biesack@mindspring.com)
;; Last Modified By: biesack@mindspring.com
;; Last Modified: Thu Mar 15 17:42:45 2001

(defun eval-and-compile-defun ()
  "Like eval-defun, but compile the function as well."
  (interactive)
  (eval-defun nil); life would be much easier if eval-defun returned the symbol
		  ; of the defun just evalled!
  (save-excursion
    (end-of-defun) (beginning-of-defun)
    (forward-word 1)(backward-word 1) ; move to beginning of def symbol
    (cond ((looking-at "def")
           (require 'byte-compile "bytecomp")
           (forward-sexp 1) ; skip past the defun/defmacro symbol
           (let ((fn-name (read (current-buffer))))
             (byte-compile fn-name)
             (message "compiled %s" fn-name)
             fn-name)))))

(defun byte-compile-this-file ()
  "Byte compile the current file, writing it first if necessary."
  (interactive)
  (let* ((do-compile-p t)
	 (file (buffer-file-name (current-buffer)))
	 (compiled-file (concat file "c")))
    (or (buffer-file-name (current-buffer))
	(error "This buffer, %s, not a file buffer! Can't byte-compile it."
	       (buffer-name (current-buffer))))
    (if (buffer-modified-p (current-buffer))
	(progn (save-buffer (current-buffer))
	       (sit-for 0)))
    (and (file-exists-p compiled-file)
	 (file-newer-than-file-p compiled-file file)
	 (or noninteractive
	     (setq do-compile-p (y-or-n-p (concat "Compiled file \""
					     (file-name-nondirectory compiled-file)
					     "\" is newer than \""
					     (file-name-nondirectory file)
					     "\". Compile anyway? ")))))
    (and do-compile-p
         (let (glyph screen)
           (unwind-protect
                (progn
;;;                   (and (boundp 'epoch::version)
;;;                        (setq screen (current-screen)
;;;                              glyph (epoch::cursor-glyph nil screen))
;;;                        (epoch::cursor-glyph 150 screen) ; 150 is watch
;;;                        )
                  (and (fboundp 'ad-deactivate-all)
                       (ad-deactivate-all))
                  (byte-compile-file (buffer-file-name (current-buffer))))
             (progn
;;;                (and (boundp 'epoch::version)
;;;                     (epoch::cursor-glyph glyph screen))
               (and (fboundp 'ad-activate-all)
                       (ad-activate-all)))))
           )))


(defun describe-key-briefly (key arg)
  "Print the name of the function KEY invokes.  KEY is a string.
With ARG, also run find-tag on function definition."
  (interactive "kDescribe key briefly: \nP")
  (let ((defn (key-binding key)))
    (if (or (null defn) (integerp defn))
        (message "%s is undefined" (key-description key))
        (message "%s runs the command %s"
                 (key-description key)
                 (if (symbolp defn) defn (prin1-to-string defn)))
        (if (and arg (symbolp defn))
            (let ((tags-file-name *emacs-lisp-tag*))
              (find-tag (concat "defun *" (regexp-quote (symbol-name defn)) " ")))))))

(defun describe-function (function &optional arg)
  "Display the full documentation of FUNCTION (a symbol).
With ARG, also try to edit the definition via find-tag in
the TAGS file named in *emacs-lisp-tag*"
  (interactive
    (let ((fn (function-called-at-point))
          (enable-recursive-minibuffers t)
          val)
      (setq val (completing-read (if fn
                                     (format "Describe function (default %s): " fn)
                                     "Describe function: ")
                                 obarray 'fboundp t))
      (list (if (equal val "")
                fn (intern val))
            current-prefix-arg)))
  (with-output-to-temp-buffer "*Help*"
    (prin1 function)
    (princ ":
")
    (if (documentation function)
        (princ (documentation function))
        (princ "not documented"))
    (princ "

\(symbol-function '")
    (prin1 function)
    (princ "\) => ")
    (prin1 (symbol-function function))
    (print-help-return-message))
  (and arg
       (let ((tags-file-name *emacs-lisp-tag*))
         (find-tag (concat "defun " (regexp-quote (symbol-name function)) " ") ))
    ))


(defun describe-variable (variable &optional arg)
  "Display the full documentation of VARIABLE (a symbol).
With ARG, also try to edit the definition  via find-tag in
the TAGS file named in *emacs-lisp-tag*"
  (interactive
    (let ((v (variable-at-point))
          (enable-recursive-minibuffers t)
          val)
      (setq val (completing-read (if v
                                     (format "Describe variable (default %s): " v)
                                     "Describe variable: ")
                                 obarray 'boundp t))
      (list (if (equal val "")
                v (intern val))
            current-prefix-arg)))
  (with-output-to-temp-buffer "*Help*"
    (prin1 variable)
    (princ "'s value is ")
    (if (not (boundp variable))
        (princ "void.")
        (prin1 (symbol-value variable)))
    (terpri) (terpri)
    (princ "Documentation:")
    (terpri)
    (let ((doc (documentation-property variable 'variable-documentation)))
      (if doc
	  (princ (substitute-command-keys doc))
          (princ "not documented as a variable.")))
    (print-help-return-message))
  (and arg
       (let ((tags-file-name *emacs-lisp-tag*))
         (find-tag (concat "defvar " (regexp-quote (symbol-name variable)) " ") ))
       )
  )


(defun is-function-p (function-looking-at)
  "Display the full documentation of VARIABLE (a symbol)."
  (interactive (list (symbol-at-point)))
  (if function-looking-at
      (if (fboundp function-looking-at)
	  (message "function %s is bound" function-looking-at)
	  (message "%s is not a bound function!" function-looking-at))
      (message "Point is not on a function!"))
  (boundp function-looking-at))

(defun is-variable-p (variable-looking-at)
  "Display the full documentation of VARIABLE (a symbol)."
  (interactive (list (symbol-at-point)))
  (if (boundp variable-looking-at)
      (message "Variable %s is bound" variable-looking-at)
      (message "%s is not a bound variable!" variable-looking-at))
  (boundp variable-looking-at))

(defun which (library)
  "Find a library in the load path"
  (interactive "sWhich library: ")
  (let ((paths (apply 'append (mapcar (function (lambda (f)
                           (let ((pathname  (concat f "/" library ".el")))
                           (if (file-exists-p pathname)
                               (list pathname)))))
                         load-path))))
    (if (car paths)
        (message "%s %s" (car paths) paths)
        (message "%s not found in %s" library load-path))
    paths))

(defun edit-elisp (library)
  "find-file of a emacs lisp library"
  (interactive "sFind Emacs Lisp Library: ")
  (let ((paths (which library)))
    (if paths
        (find-file (car paths))
        (error "%s not found in %s" library load-path) )))

(fset 'el 'edit-elisp)