;; 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:

;; load.el
;; Redefine defun and defvar so that they also
;; put 'defun-source and 'defvar-source properties
;; on the functions and variables so defined.

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

(defvar *load-file* nil
  "Name of file being loaded by (load).
Stored in 'defvar-source and 'defun-source properties of
all symbols so defined while loading the file.")

(defconst Defun (symbol-function 'defun)
  "Original subr definition of 'defun")

(defconst Defvar (symbol-function 'defvar)
  "Original subr definition of 'defvar")

(defconst Load (symbol-function 'load)
  "Original subr definition of 'load")

(defconst Eval-Region (symbol-function 'eval-region)
  "Original definition of 'eval-region")

(defun tagging-load (file &optional missing-ok nomessage nosuffix)
  "Load a file of Lisp code named FILE.
First tries FILE with .elc appended, then tries with .el,
 then tries FILE unmodified.  Searches directories in  load-path.
If optional second arg MISSING-OK is non-nil,
 report no error if FILE doesn't exist.
Print messages at start and end of loading unless
 optional third arg NOMESSAGE is non-nil.
If optional fourth arg NOSUFFIX is non-nil, don't try adding
 suffixes .elc or .el to the specified name FILE.
Sets *load-file* to FILE which is put on the 'defvar-source
and 'defun-source properties of loaded variables and functions.
Return t if file exists."
  (let ((*load-file* file))
    (eval (list 'Load file missing-ok nomessage nosuffix))))

(defmacro tagging-defun (function args &rest body)
  "Like (defun FUNCTION ARGS BODY), but add a 'defun-source property to FUNCTION."
  (if *load-file*
      (put function 'defun-source *load-file*)
      (if (get function 'defun-source)
          (put function 'defun-source nil)))
  (cons 'Defun (cons function (cons args body))))

(defmacro tagging-defvar (var &optional value doc)
  "Like (defvar VARIABLE VALUE DOC) but add a 'defvar-source property to VARIABLE"
  (if *load-file*
      (put var 'defvar-source *load-file*)
      (if (get var 'defvar-source)
          (put var 'defvar-source nil)))
  (list 'Defvar var value doc))


(defun tagging-eval-region (start end arg)
  "Like (eval-region START END ARG), but set *load-file* to allow source tagging."
  (interactive "P")
  (let ((*load-file* (or buffer-file-name (buffer-name (current-buffer)))))
    (eval (list 'Eval-Region start end arg))))



(defvar Tagging-Def nil
  "True after tagging-* functions have replaced the originals.")

;; the cond below allows me to restore/replace the default definition with
;; my new ones.  Each time it is evaluated, it toggles between the default
;; and my definitions.  First time (when file is loaded) it adds my defs.

(cond (Tagging-Def
       (fset 'defvar Defvar)
       (fset 'defun Defun)
       (fset 'load Load)
       (fset 'eval-region Eval-Region)
       (set Tagging-Def nil)
       nil)
      (t
       (fset 'Defvar Defvar)
       (fset 'Defun Defun)
       (fset 'Load Load)
       (fset 'Eval-Region Eval-Region)
       (fset 'defvar (symbol-function 'tagging-defvar))
       (fset 'defun (symbol-function 'tagging-defun))
       (fset 'load (symbol-function 'tagging-load))
       (fset 'eval-region (symbol-function 'tagging-eval-region))
       (setq Tagging-Def 'Tagging-Def)
       )
      )

(defun find-source-file (file)
  (let (path base)
  (cond ((and (setq base (eq file (file-name-nondirectory file)))
              (setq path (which file)))
         (setq file (car path)))
        (base
         (error "Cannot find definition of %s in %s" file load-path)))
  (if (string-match "\\(.*\\)elc" file)
      (setq file (substring file 0 -1)))
  (or (string-match "\\.el" file)
      (setq file (concat file ".el")))
  (find-file file)))

(load-file "~/emacs/emacs.elc")