home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-save.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  5KB  |  150 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-save.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
  3. ;;;
  4. ;;; **********************************************************************
  5. ;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
  6. ;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
  7. ;;; 100025.3303@COMPUSERVE.COM
  8. ;;; Suggestions, comments and requests for improvements are welcome.
  9. ;;; **********************************************************************
  10. ;;;
  11. ;;; This version works with both Emacs version 18 and 19, and I want
  12. ;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
  13. ;;; package for Emacs 18 and 19.
  14. ;;;
  15. ;;; This file contains the code related to writing trees to disk.
  16. ;;; 
  17.  
  18. ;; This file may be made part of the Emacs distribution at the option
  19. ;; of the FSF.
  20.  
  21. ;; This code is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  23. ;; accepts responsibility to anyone for the consequences of using it
  24. ;; or for whether it serves any particular purpose or works at all,
  25. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  26. ;; License for full details.
  27.  
  28. ;; Everyone is granted permission to copy, modify and redistribute
  29. ;; this code, but only under the conditions described in the
  30. ;; GNU Emacs General Public License.   A copy of this license is
  31. ;; supposed to have been given to you along with GNU Emacs so you
  32. ;; can know your rights and responsibilities.  It should be in a
  33. ;; file named COPYING.  Among other things, the copyright notice
  34. ;; and this notice must be preserved on all copies.
  35.  
  36. (require 'cl-19 "cl")
  37. (require 'backquote)
  38. (require 'br-macro)
  39. (require 'br-struc)
  40.  
  41.  
  42. ;;;
  43. ;;; Write regular expressions to FILENAME. If FILENAME is NIL
  44. ;;; read a filename from the minibuffer.
  45. ;;;
  46.  
  47. ;;###autoload
  48. (defun tree-write-regexps (&optional filename)
  49.   (interactive "FFile to save regexps in: ")
  50.   (let ((temp-buffer (get-buffer-create "*Tree Output"))
  51.     (old-standard-output standard-output)
  52.     (tree @tree))
  53.     (unwind-protect
  54.     (save-excursion
  55.       (set-buffer (setq standard-output temp-buffer))
  56.       (erase-buffer)
  57.       (mapcar 'tree-write-class-regexps tree)
  58.       (write-file filename)
  59.       (message "Regexps written to file %s." filename))
  60.       (kill-buffer temp-buffer)
  61.       (setq standard-output old-standard-output))))
  62.  
  63. ;;;
  64. ;;; Write regular expressions of a single class. Replace former
  65. ;;; regular expressions in the tree with buffer positions in the
  66. ;;; file written.
  67. ;;; 
  68.  
  69. (defun tree-write-class-regexps (class)
  70.   (let ((point (point)))
  71.     (message "%s..." (class-name (tree-class class)))
  72.     (prin1 (class-file (tree-class class)))
  73.     (prin1 (class-pattern (tree-class class)))
  74.     (setf (class-pattern (tree-class class)) point
  75.       (class-file (tree-class class)) nil)
  76.     (mapcar 'tree-write-class-regexps (tree-subclasses class))
  77.     (dolist (func member-lists)
  78.       (dolist (m (funcall func class))
  79.     (setq point (point))
  80.     (prin1 (member-file m))
  81.     (prin1 (member-pattern m))
  82.     (setf (member-pattern m) point
  83.           (member-file m) nil
  84.           point (point))
  85.     (prin1 (member-definition-file m))
  86.     (prin1 (member-definition-pattern m))
  87.     (setf (member-definition-pattern m) point
  88.           (member-definition-file m) nil)))))
  89.  
  90. ;;;
  91. ;;; Save tree to file is was loaded from.
  92. ;;; ###autoload
  93.  
  94.  
  95. (defun tree-save ()
  96.   "Save tree in same file it was loaded from."
  97.   (interactive)
  98.   (tree-write (or buffer-file-name @tags-filename)))
  99.  
  100. ;;;
  101. ;;; Write tree to disk.
  102. ;;; 
  103.  
  104. ;;###autoload
  105. (defun tree-write (&optional filename)
  106.   "Write the tree data structure to a file. Note that we have to make
  107. up a local reference to the tree to be written because switching to
  108. another buffer will make the local variable @TREE unavailable."
  109.   (interactive "FFile to save tree in: ")
  110.   (let ((temp-buffer (get-buffer-create "*Tree Output"))
  111.     (old-standard-output standard-output)
  112.     (header @header)
  113.     (tree @tree))
  114.     (unwind-protect
  115.     (save-excursion
  116.       (set-buffer (setq standard-output temp-buffer))
  117.       (erase-buffer)
  118.       (insert (if (memq 'quiroz-cl browse-options)
  119.               "[tree-header " "[cl-struct-tree-header ")
  120.           (tree-header-version header)
  121.           (tree-header-regexp-file header)
  122.           "()]")
  123.       (insert " ")
  124.       (mapcar 'tree-write-class tree)
  125.       (write-file filename)
  126.       (message "Tree written to file %s." filename))
  127.       (kill-buffer temp-buffer)
  128.       (set-buffer-modified-p nil)
  129.       (tree-update-mode-line)
  130.       (setq standard-output old-standard-output))))
  131.  
  132. ;;;
  133. ;;; Write single class to a buffer.
  134. ;;; 
  135.  
  136. (defun tree-write-class (class)
  137.   (message "%s..." (class-name (tree-class class)))
  138.   (insert "[tree ")
  139.   (prin1 (tree-class class))        ;class name
  140.   (insert "(")                ;list of subclasses
  141.   (mapcar 'tree-write-class (tree-subclasses class))
  142.   (insert ")")
  143.   (dolist (func member-lists)
  144.     (prin1 (funcall func class))
  145.     (insert "\n"))
  146.   (insert "()")                ;superclasses slot
  147.   (prin1 (tree-mark class))
  148.   (insert "]\n"))
  149.  
  150. ;;; end of `save.el'.