
(defun d-make-tags ()
  (interactive)
  (progn
    (setq *buf* (find-file (concat *directory* "TAGS")))
    (erase-buffer)
    (let* ((list (directory-files *directory* t "\\.lisp[+][+]$"))
           ptr name str p class-name)
      (setq ptr list)
      (while ptr
        (save-excursion
          (set-buffer *buf*)
          (insert "\f\n")
          (insert (file-name-nondirectory (car ptr)) ",0\n"))
        (find-file (car ptr))
        (goto-char (point-min))
        (while (re-search-forward
                (concat
                 "^ ?(\\(cfunction\\|cmethod\\|cproperty\\|"
                 "c-static-method\\|c-static-property"
                 "c-property-callback\\|cglobal\\|"
                 "c-constructor-method\\|c-destructor-method\\)"
                 " *\\((\\(cret\\|ctype\\|cfptr\\)[^()]*)\\)? *(cname \\([^()]*\\))") nil t)
          (save-excursion
            (setq name (buffer-substring-no-properties
                        (match-beginning 4)
                        (match-end 4)))
            (setq str  (buffer-substring-no-properties
                        (match-beginning 0)
                        (match-end 0)))
            (setq line (d-what-line))
            (setq p    (point))
            (setq class-name (d-inside-class))
            ;;(debug "Foomatic")
            (set-buffer *buf*)
            (goto-char (point-max))
            (insert str)
            (insert "")
            (when class-name
              ;;(debug "Apple Pie")
              (insert class-name "::" name ""))
            (insert (format "%s" line))
            (insert ",")
            (insert (format "%s" p))
            (insert "\n")
            ;;(debug "Cabbage")
            ))
        ;;(setq ptr nil)
        (setq ptr (cdr ptr)))
    )))

(defun d-inside-class ()
  (let (p class-name)
    (save-excursion
      (setq p (point))
      (when (re-search-backward "^(cclass \\([a-zA-Z0-9_]*\\)" nil t)
        (setq class-name (buffer-substring-no-properties
                          (match-beginning 1)
                          (match-end 1)))
        (beginning-of-line)
        (forward-sexp 1)
        (when (> (point) p)
          ;;(debug "Apple Pie")
          class-name)))))

(provide 'd-make-tags)
;;; d-make-tags.el ends here
