home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Archives / GNU / sdoc.lha / sdoc / sdoc.el next >
Encoding:
Text File  |  1996-02-21  |  10.1 KB  |  268 lines
  1. ;;; sdoc.el
  2. ;;;
  3. ;;; Find information from structured ASCII-files such as Amiga Autodocs,
  4. ;;; Unix man pages and programming language header and include files. It is
  5. ;;; possible to create match entries for any file format really, using the
  6. ;;; appropriate filter function.
  7. ;;;
  8. ;;; Copyright © 1995 Torbjörn Axelsson
  9. ;;;
  10. ;;; This file is NOT part of the GNU Emacs.
  11. ;;;
  12. ;;; Verbatim copies of this file may be freely redistributed together with
  13. ;;; its documentation file.
  14. ;;;
  15. ;;; Modified versions of this file may be redistributed provided that this
  16. ;;; notice remains unchanged, the file contains prominent notice of author
  17. ;;; and time of modifications, and redistribution of the file is not
  18. ;;; further restricted in any way.
  19. ;;;
  20. ;;; This file is distributed `as is', without warranties of any kind. 
  21. ;;;
  22. ;;; To contact the author, send email to torax@ctrl-c.liu.se.
  23. ;;;
  24. ;;; History:
  25. ;;; v1.00 1995-01-14: Developed using GNU Emacs 18.58, Amiga port1.26DG
  26. ;;;                   Features searching, adding matches and merging
  27. ;;;                   databases.
  28. ;;;
  29. ;;; Future:
  30. ;;; Pri Project
  31. ;;; top (Semi)automatic scripts for creating multiple database entries from
  32. ;;;     documentation files.
  33. ;;; top Implementing the filter function. (Such as stripping formatting
  34. ;;;     codes from hypertext documents, should work on a region.)
  35. ;;; low Use techinfo for the doc file.
  36.  
  37. (provide 'sdoc)
  38.  
  39. (defvar sdoc-buffer "*Sdoc*" "*Name of the Sdoc output buffer.")
  40. (defvar sdoc-database "/users/torax/sdoc/sdoc.database" "*Full path to the Sdoc database file.")
  41.  
  42. ;;; These buffer local variables are used for narrowing search and editing of the database file.
  43. (make-variable-buffer-local 'sdoc-eofiles) ; End of file list.
  44. (make-variable-buffer-local 'sdoc-botypes) ; Beginning of type list.
  45. (make-variable-buffer-local 'sdoc-eotypes) ; End of type list.
  46. (make-variable-buffer-local 'sdoc-bomatches)  ; Beginning of matchlist.
  47.  
  48. ;;; Basic search function
  49.  
  50. (defun sdoc (about)
  51.   "Lookup a word using the Sdoc database." 
  52.   (interactive "sSearch for: ")
  53.   (save-excursion
  54.     (with-output-to-temp-buffer sdoc-buffer
  55.       (let ((database-buffer (find-file-noselect sdoc-database))
  56.         (work-buffer (get-buffer-create " sdoc-work-buffer"))
  57.         found-match)
  58.     (sdoc-print "Sdoc looking for: " about "\n\n")
  59.     (setq about (concat "^" about "\^L"))
  60.     (if (not (sdoc-databasep database-buffer))
  61.         (error "%s is not a valid Sdoc database" sdoc-database))
  62.     (set-buffer database-buffer)
  63.     (goto-char sdoc-bomatches)
  64.     (while    (setq found-match (sdoc-grab-match about database-buffer))
  65.       ;; Find and add the text to the help buffer.
  66.       (set-buffer work-buffer)
  67.       (erase-buffer)
  68.       (insert-file-contents (nth 1 found-match))
  69.       (delete-region (nth 5 found-match) (point-max))
  70.       (delete-region (nth 4 found-match) (point-min))
  71.       (sdoc-print (nth 2 found-match) " found: " (car found-match) "\nData file: "
  72.               (nth 1 found-match) "\n----------S-T-A-R-T----------\n"
  73.               (buffer-string)
  74.               (if (not (equal (buffer-substring (point-max) (1- (point-max))) "\n"))
  75.               "\n" "")
  76.               "----------E-N-D--------------\n\n"))
  77.     (kill-buffer work-buffer)))))
  78.  
  79. ;;; Database management
  80.  
  81. (defun sdoc-merge-buffer-to-database (&optional buff)
  82.   "Merges the database in BUFFER with the main Sdoc database file.
  83. BUFFER defaults to the current buffer."
  84.   (interactive "bMerge Sdoc database with buffer ")
  85.   (save-excursion
  86.     (if (not buff)
  87.     (setq buff (current-buffer)))
  88.     (let ((database-buffer (find-file-noselect sdoc-database))
  89.       (newbase-buffer buff))
  90.       (if (not (sdoc-databasep database-buffer))
  91.       (error "Sdoc default database buffer \"%s\" is corrupt." sdoc-database))
  92.       (if (not (sdoc-databasep newbase-buffer))
  93.       (error "Trying to add an incorrect database buffer."))
  94.       (set-buffer newbase-buffer)
  95.       (goto-char sdoc-bomatches)
  96.       (while
  97.       (sdoc-add-match (sdoc-grab-match "^.*\^L" newbase-buffer) database-buffer)))))
  98.  
  99. (defun sdoc-add-region-as-match (id matchtype startpos endpos &optional filter)
  100.   "*Add the current region as an entry in the Sdoc database, supply ID and MATCHTYPE.
  101. When called from other lisp functions, add STARTPOS and ENDPOS and
  102. optional FILTER"
  103.   (interactive "sid: \nsmatchtype: \nr")
  104.   (if buffer-file-name
  105.       (sdoc-add-match (list id buffer-file-name matchtype filter startpos endpos)
  106.           (find-file-noselect sdoc-database))
  107.     (error "Current buffer not visiting a file, cannot add to Sdoc database")))
  108.  
  109. (defun sdoc-add-match (match &optional buff)
  110.   "Add a MATCH entry to the (&optional) BUFFER (current). If MATCH is nil return nil, if all ok return t.
  111. If the buffer is completely empty, will create the database.
  112. Will fail if it is a non empty non sdoc database buffer.
  113.  
  114. The format of the match entry is a list:
  115. matchstring filename matchtype filter startpos endpos
  116.  
  117. matchstring - string with the id of the match
  118. filename - string with the complete filename to look up
  119. matchtype - string saying what type of match this is
  120. filter - string with the name of the filter function or nil if no filter needed
  121. startpos, endpos - integers with the start and end of the region to display"
  122.   (and
  123.    match
  124.    (save-excursion
  125.      (if buff
  126.      (set-buffer buff))
  127.      (if (not (sdoc-databasep (current-buffer)))
  128.      (if (or (/= 1 (point-min))
  129.          (/= 1 (point-max)))
  130.          (error "Trying to add a match to a non sdoc database buffer.")
  131.        (insert
  132.         (concat
  133.          (nth 1 match) "\n\^L\n" (nth 2 match)
  134.          (if (nth 3 match) "\^L")
  135.          (nth 3 match) "\n\^L\n"
  136.          (nth 0 match) "\^L1\^L0\^L" (nth 4 match) "\^L" (nth 5 match) "\n"))
  137.        (sdoc-databasep (current-buffer)))
  138.        (let* ((fileno (sdoc-add-filename (nth 1 match)))
  139.           (matchno (sdoc-add-matchtype (nth 2 match) (nth 3 match)))
  140.           (matchstring (concat (nth 0 match) "\^L" fileno "\^L" matchno "\^L" (nth 4 match) "\^L"
  141.                    (nth 5 match) "\n")))
  142.      (goto-char sdoc-bomatches)
  143.      (if (not (search-forward matchstring nil 1))
  144.          (let (buffer-read-only)
  145.            (insert matchstring))))
  146.        t))))
  147.  
  148. (defun sdoc-databasep (buff)
  149.   "Check if BUFFER is a well formed Sdoc database and if so set the sdoc-bo* and sdoc-eo* variables.."
  150.   (save-excursion
  151.     (set-buffer buff)
  152.     (if (and
  153.      (markerp sdoc-eofiles)
  154.      (markerp sdoc-botypes)
  155.      (markerp sdoc-eotypes)
  156.      (markerp sdoc-bomatches))
  157.     t
  158.       (goto-char (point-min))
  159.       (and
  160.        (looking-at
  161.     (concat "\\`" ; Start of buffer
  162.         "\\(^[^\^L\n]+\n\\)+\^L\n" ;Filenames
  163.         "\\(\\([^\^L\n]+\^L\\)?[^\^L\n]+\n\\)+\^L\n" ; Types (w filter functions)
  164.         "\\(^[^\^L\n]+\^L[0-9]+\^L[0-9]+\^L[0-9]+\^L[0-9]+\n\\)+\\'"))
  165.        (let ((md (match-data)))
  166.      (setq sdoc-eofiles (make-marker))
  167.      (setq sdoc-botypes (make-marker))
  168.      (setq sdoc-eotypes (make-marker))
  169.      (setq sdoc-bomatches (make-marker))
  170.      (set-marker sdoc-eofiles (nth 3 md))
  171.      (set-marker sdoc-botypes (nth 4 md))
  172.      (set-marker sdoc-eotypes (nth 5 md))
  173.      (set-marker sdoc-bomatches (nth (- (length md) 2) md))
  174.      (setq mode-line-buffer-identification '("Sdoc: %18b"))
  175.      (setq buffer-read-only t)
  176.      t)))))
  177.  
  178. ;;; Support functions
  179.  
  180. (defun sdoc-print (&rest l)
  181.   "Print multiple objects to stdout"
  182.   (mapcar 'princ l))
  183.  
  184. (defun sdoc-add-filename (filename)
  185.   "Add FILENAME to the files section of current buffer. Returns the filenumber."
  186.   (if filename
  187.       (save-excursion
  188.     (goto-char (point-min))
  189.     (if (search-forward (concat filename "\n") sdoc-eofiles t)
  190.         (count-lines (point) (point-min))
  191.       (goto-char (1- sdoc-eofiles))
  192.       (let (buffer-read-only)
  193.         (insert "\n" filename))
  194.       (count-lines (point) (point-min))))))
  195.  
  196. (defun sdoc-add-matchtype (type &optional filter)
  197.   "Add a match named TYPE with optional FILTER to database. Return matchno of the TYPE/FILTER pair."
  198.   (save-excursion
  199.     (goto-char sdoc-botypes)
  200.     (let (buffer-read-only (typeline (concat type (if filter "\^L") filter)))
  201.       (if (search-forward (concat typeline "\n") sdoc-eotypes t)
  202.       (1- (count-lines (point) sdoc-botypes))
  203.     (goto-char (1- sdoc-eotypes))
  204.     (let (buffer-read-only)
  205.       (insert "\n" typeline))
  206.     (1- (count-lines (point) sdoc-botypes))))))
  207.   
  208. (defun sdoc-grab-match (regexp &optional buff)
  209.   "Find the next match matching REGEXP in (optional) BUFFER.
  210. Will return a list (match filename matchtype filter startpos endpos)"
  211.   (let ((cbuff (current-buffer)) result)
  212.     (if buff
  213.     (set-buffer buff))
  214.     (if (not (sdoc-databasep (current-buffer)))
  215.     (progn
  216.       (set-buffer cbuff)
  217.       (error "Trying to extract matchdata from non-database buffer.")))
  218.     (cond
  219.      ((re-search-forward regexp nil t)
  220.       (beginning-of-line)
  221.       (if (not (looking-at "^\\([^\^L\n]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\^L\\([0-9]+\\)\n"))
  222.       (error "Bad database entry"))
  223.       (let ((tmp (list (buffer-substring (match-beginning 1) (match-end 1))
  224.                (string-to-int (buffer-substring (match-beginning 2) (match-end 2)))
  225.                (string-to-int (buffer-substring (match-beginning 3) (match-end 3)))
  226.                (string-to-int (buffer-substring (match-beginning 3) (match-end 3)))
  227.                (string-to-int (buffer-substring (match-beginning 4) (match-end 4)))
  228.                (string-to-int (buffer-substring (match-beginning 5) (match-end 5))))))
  229.     (setcar (cdr tmp) (sdoc-grab-filename (nth 1 tmp)))
  230.     (setcar (nthcdr 2 tmp) (sdoc-grab-matchtype (nth 2 tmp)))
  231.     (setcar (nthcdr 3 tmp) (sdoc-grab-filter (nth 3 tmp)))
  232.     (forward-line)
  233.     (setq result tmp))))
  234.     (set-buffer cbuff)
  235.     result))
  236.  
  237. (defun sdoc-grab-filename (fileno &optional buff)
  238.   "Return the filename of FILENO in optional BUFFER."
  239.   (save-excursion
  240.     (if buff
  241.     (set-buffer buff))
  242.     (goto-line fileno)
  243.     (let ((bol (point)))
  244.       (end-of-line)
  245.       (buffer-substring bol (point)))))
  246.  
  247. (defun sdoc-grab-matchtype (matchno &optional buff)
  248.   "Return the matchtype for match number MATCHNO in optional BUFFER."
  249.   (save-excursion
  250.     (if buff
  251.     (set-buffer buff))
  252.     (goto-char sdoc-botypes)
  253.     (forward-line matchno)
  254.     (let ((bol (point)))
  255.       (re-search-forward "[^\^L\n]+")
  256.       (buffer-substring bol (point)))))
  257.  
  258. (defun sdoc-grab-filter (matchno &optional buff)
  259.   "Return the filter for match number MATCHNO in optional BUFFER."
  260.   (save-excursion
  261.     (if buff
  262.     (set-buffer buff))
  263.     (goto-char sdoc-botypes)
  264.     (forward-line matchno)
  265.     (if    (looking-at "[^\^L\n]+\^L\\(.+\\)")
  266.     (buffer-substring (match-beginning 1) (match-end 1)))))
  267.  
  268.