;;; sdoc.el
;;;
;;; Find information from structured ASCII-files such as Amiga Autodocs,
;;; Unix man pages and programming language header and include files. It is
;;; possible to create match entries for any file format really, using the
;;; appropriate filter function.
;;;
;;; Copyright © 1995,1996 Torbjörn Axelsson
;;;
;;; This file is NOT part of the GNU Emacs.
;;;
;;; Verbatim copies of this file may be freely redistributed together with
;;; its documentation file.
;;;
;;; Modified versions of this file may be redistributed provided that this
;;; notice remains unchanged, the file contains prominent notice of author
;;; and time of modifications, and redistribution of the file is not
;;; further restricted in any way.
;;;
;;; This file is distributed `as is', without warranties of any kind. 
;;;
;;; To contact the author, send email to torax@lysator.liu.se.
;;;
;;; History:
;;; v1.01 1996-05-19: Fixed a few stupid bugs/inconveniences.
;;;                   Added accept_empty flag to sdoc-databasep.
;;; v1.00 1995-01-14: Developed using GNU Emacs 18.58, Amiga port1.26DG
;;;                   Features searching, adding matches and merging
;;;                   databases.
;;;
;;; Future:
;;; Pri Project
;;; top Implementing the filter function. (Such as stripping formatting
;;;     codes from hypertext documents, should work on a region.)
;;; low Use techinfo for the doc file.
;;;
;;; Past future:
;;; top (Semi)automatic scripts for creating multiple database entries from
;;;     documentation files. - See adocutil.el

(provide 'sdoc)

(defvar sdoc-buffer "*Sdoc*" "*Name of the Sdoc output buffer.")
(defvar sdoc-database "gnuemacs:local/sdoc/sdoc.database" "*Full path to the Sdoc database file.")

;;; These buffer local variables are used for narrowing search and editing of the database file.
(make-variable-buffer-local 'sdoc-eofiles) ; End of file list.
(make-variable-buffer-local 'sdoc-botypes) ; Beginning of type list.
(make-variable-buffer-local 'sdoc-eotypes) ; End of type list.
(make-variable-buffer-local 'sdoc-bomatches)  ; Beginning of matchlist.

;;; Basic search function

(defun sdoc (about)
  "Lookup a word using the Sdoc database." 
  (interactive "sSearch for: ")
  (save-excursion
    (with-output-to-temp-buffer sdoc-buffer
      (let ((database-buffer (find-file-noselect sdoc-database))
	    (work-buffer (get-buffer-create " sdoc-work-buffer"))
	    found-match)
	(sdoc-print "Sdoc looking for: " about "\n\n")
	(setq about (concat "^" about "\^L"))
	(if (not (sdoc-databasep database-buffer))
	    (error "%s is not a valid Sdoc database" sdoc-database))
	(set-buffer database-buffer)
	(goto-char sdoc-bomatches)
	(while	(setq found-match (sdoc-grab-match about database-buffer))
	  ;; Find and add the text to the help buffer.
	  (set-buffer work-buffer)
	  (erase-buffer)
	  (insert-file-contents (nth 1 found-match))
	  (delete-region (nth 5 found-match) (point-max))
	  (delete-region (nth 4 found-match) (point-min))
	  (sdoc-print (nth 2 found-match) " found: " (car found-match) "\nData file: "
		      (nth 1 found-match) "\n----------S-T-A-R-T----------\n"
		      (buffer-string)
		      (if (not (equal (buffer-substring (point-max) (1- (point-max))) "\n"))
			  "\n" "")
		      "----------E-N-D--------------\n\n"))
	(kill-buffer work-buffer)))))

;;; Database management

(defun sdoc-merge-buffer-to-database (&optional buff)
  "Merges the database in BUFFER with the main Sdoc database file.
BUFFER defaults to the current buffer."
  (interactive "bMerge Sdoc database with buffer ")
  (save-excursion
    (if (not buff)
	(setq buff (current-buffer)))
    (let ((database-buffer (find-file-noselect sdoc-database))
	  (newbase-buffer buff))
      (if (not (sdoc-databasep database-buffer t))
	  (error "Sdoc default database buffer \"%s\" is corrupt."
		 sdoc-database))
      (if (not (sdoc-databasep newbase-buffer))
	  (error "Trying to add an incorrect database buffer."))
      (set-buffer newbase-buffer)
      (goto-char sdoc-bomatches)
      (while
	  (sdoc-add-match (sdoc-grab-match "^.*\^L" newbase-buffer) database-buffer)))))

(defun sdoc-add-region-as-match (id matchtype startpos endpos &optional filter buffer)
  "*Add the current region as an entry in the Sdoc database, supply ID and MATCHTYPE.
When called from other lisp functions, add STARTPOS and ENDPOS and
optional FILTER and database BUFFER"
  (interactive "sid: \nsmatchtype: \nr")
  (if buffer-file-name
      (sdoc-add-match (list id buffer-file-name matchtype filter startpos endpos)
		  (or buffer (find-file-noselect sdoc-database)))
    (error "Current buffer not visiting a file, cannot add region as match")))

(defun sdoc-add-match (match &optional buff)
  "Add a MATCH entry to the (&optional) BUFFER (current). If MATCH is nil return nil, if all ok return t.
If the buffer is completely empty, will create the database.
Will fail if it is a non empty non sdoc database buffer.

The format of the match entry is a list:
matchstring filename matchtype filter startpos endpos

matchstring - string with the id of the match
filename - string with the complete filename to look up
matchtype - string saying what type of match this is
filter - string with the name of the filter function or nil if no filter needed
startpos, endpos - integers with the start and end of the region to display"
  (and
   match
   (save-excursion
     (if buff
	 (set-buffer buff))
     (if (not (sdoc-databasep (current-buffer)))
	 (if (/= 0 (buffer-size))
	     (error "Trying to add a match to a non sdoc database buffer (%s)."
		    (current-buffer))
	   (insert
	    (concat
	     (nth 1 match) "\n\^L\n" (nth 2 match)
	     (if (nth 3 match) "\^L")
	     (nth 3 match) "\n\^L\n"
	     (nth 0 match) "\^L1\^L0\^L" (nth 4 match) "\^L" (nth 5 match) "\n"))
	   (sdoc-databasep (current-buffer)))
       (let* ((fileno (sdoc-add-filename (nth 1 match)))
	      (matchno (sdoc-add-matchtype (nth 2 match) (nth 3 match)))
	      (matchstring (concat (nth 0 match) "\^L" fileno "\^L" matchno "\^L" (nth 4 match) "\^L"
				   (nth 5 match) "\n")))
	 (goto-char sdoc-bomatches)
	 (if (not (search-forward matchstring nil 1))
	     (let (buffer-read-only)
	       (insert matchstring))))
       t))))

(defun sdoc-databasep (buff &optional accept_empty)
  "Check if BUFFER is a well formed Sdoc database and if so 
set the sdoc-bo* and sdoc-eo* variables..
If the second optional ACCEPT_EMPTY argument is true, 
an empty buffer will be accepted. This is used by functions 
that may create a new database by adding matches to it."
  (save-excursion
    (set-buffer buff)
    (if (and (= 0 (buffer-size)) accept_empty)
	t
      (if (and
	   (markerp sdoc-eofiles)
	   (markerp sdoc-botypes)
	   (markerp sdoc-eotypes)
	   (markerp sdoc-bomatches))
	  t
	(goto-char (point-min))
	(and
	 (looking-at
	  (concat "\\`" ; Start of buffer
		  "\\(^[^\^L\n]+\n\\)+\^L\n" ;Filenames
		  "\\(\\([^\^L\n]+\^L\\)?[^\^L\n]+\n\\)+\^L\n" ; Types (w filter functions)
		  "\\(^[^\^L\n]+\^L[0-9]+\^L[0-9]+\^L[0-9]+\^L[0-9]+\n\\)+\\'"))
	 (let ((md (match-data)))
	   (setq sdoc-eofiles (make-marker))
	   (setq sdoc-botypes (make-marker))
	   (setq sdoc-eotypes (make-marker))
	   (setq sdoc-bomatches (make-marker))
	   (set-marker sdoc-eofiles (nth 3 md))
	   (set-marker sdoc-botypes (nth 4 md))
	   (set-marker sdoc-eotypes (nth 5 md))
	   (set-marker sdoc-bomatches (nth (- (length md) 2) md))
	   (setq mode-line-buffer-identification '("Sdoc: %18b"))
	   (setq buffer-read-only t)
	   t))))))

;;; Support functions

(defun sdoc-print (&rest l)
  "Print multiple objects to stdout"
  (mapcar 'princ l))

(defun sdoc-add-filename (filename)
  "Add FILENAME to the files section of current buffer. Returns the filenumber."
  (if filename
      (save-excursion
	(goto-char (point-min))
	(if (search-forward (concat filename "\n") sdoc-eofiles t)
	    (count-lines (point) (point-min))
	  (goto-char (1- sdoc-eofiles))
	  (let (buffer-read-only)
	    (insert "\n" filename))
	  (count-lines (point) (point-min))))))

(defun sdoc-add-matchtype (type &optional filter)
  "Add a match named TYPE with optional FILTER to database. Return matchno of the TYPE/FILTER pair."
  (save-excursion
    (goto-char sdoc-botypes)
    (let (buffer-read-only (typeline (concat type (if filter "\^L") filter)))
      (if (search-forward (concat typeline "\n") sdoc-eotypes t)
	  (1- (count-lines (point) sdoc-botypes))
	(goto-char (1- sdoc-eotypes))
	(let (buffer-read-only)
	  (insert "\n" typeline))
	(1- (count-lines (point) sdoc-botypes))))))
  
(defun sdoc-grab-match (regexp &optional buff)
  "Find the next match matching REGEXP in (optional) BUFFER.
Will return a list (match filename matchtype filter startpos endpos)"
  (let ((cbuff (current-buffer)) result)
    (if buff
	(set-buffer buff))
    (if (not (sdoc-databasep (current-buffer)))
	(progn
	  (set-buffer cbuff)
	  (error "Trying to extract matchdata from non-database buffer.")))
    (cond
     ((re-search-forward regexp nil t)
      (beginning-of-line)
      (if (not (looking-at "^\\([^\^L\n]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\n"))
	  (error "Bad database entry"))
      (let ((tmp (list (buffer-substring (match-beginning 1) (match-end 1))
		       (string-to-int (buffer-substring (match-beginning 2) (match-end 2)))
		       (string-to-int (buffer-substring (match-beginning 3) (match-end 3)))
		       (string-to-int (buffer-substring (match-beginning 3) (match-end 3)))
		       (string-to-int (buffer-substring (match-beginning 4) (match-end 4)))
		       (string-to-int (buffer-substring (match-beginning 5) (match-end 5))))))
	(setcar (cdr tmp) (sdoc-grab-filename (cadr tmp)))
	(setcar (nthcdr 2 tmp) (sdoc-grab-matchtype (nth 2 tmp)))
	(setcar (nthcdr 3 tmp) (sdoc-grab-filter (nth 3 tmp)))
	(forward-line)
	(setq result tmp))))
    (set-buffer cbuff)
    result))

(defun sdoc-grab-filename (fileno &optional buff)
  "Return the filename of FILENO in optional BUFFER."
  (save-excursion
    (if buff
	(set-buffer buff))
    (goto-line fileno)
    (let ((bol (point)))
      (end-of-line)
      (buffer-substring bol (point)))))

(defun sdoc-grab-matchtype (matchno &optional buff)
  "Return the matchtype for match number MATCHNO in optional BUFFER."
  (save-excursion
    (if buff
	(set-buffer buff))
    (goto-char sdoc-botypes)
    (forward-line matchno)
    (let ((bol (point)))
      (re-search-forward "[^\^L\n]+")
      (buffer-substring bol (point)))))

(defun sdoc-grab-filter (matchno &optional buff)
  "Return the filter for match number MATCHNO in optional BUFFER."
  (save-excursion
    (if buff
	(set-buffer buff))
    (goto-char sdoc-botypes)
    (forward-line matchno)
    (if	(looking-at "[^\^L\n]+\^L\\(.+\\)")
	(buffer-substring (match-beginning 1) (match-end 1)))))