Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 85 lines (77 sloc) 3.64 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
(let ((path (or (locate-library "ifc-mode") load-file-name)))
  (load-file (expand-file-name "ifc-mode-common.el"
   (file-name-directory path))))

(defun ifc-mode-parse-schema-file (filename)
  (let (types entities enumerations)
    (with-current-buffer (find-file-noselect filename)
      (goto-char (point-min))
      (while (re-search-forward "^TYPE \\([[:word:]]+\\)" nil t)
        (push (match-string 1) types))
      (goto-char (point-min))
      (while (re-search-forward "^ENTITY \\([[:word:]]+\\)" nil t)
        (push (match-string 1) entities))
      (goto-char (point-min))
      (while (re-search-forward "ENUMERATION OF[^(]+(\\([^)]+\\)" nil t)
        (let ((start (match-beginning 1))
              (end (match-end 1)))
          (goto-char start)
          (while (re-search-forward "[_[:word:]]+" end t)
            (push (match-string 0) enumerations)))))
    (values types entities enumerations)))

(defun ifc-mode-generate-syntax-from-schema (schema output)
  "Generates definitions for all types and enumerations from an EXPRESS
schema definition."
  (make-directory (file-name-directory output) t)
  (multiple-value-bind (types entities enumerations)
      (ifc-mode-parse-schema-file schema)
    (with-temp-file output
      (let ((standard-output (current-buffer)))
        (print `(setf ifc-mode-spf-objects
                      ',(mapcar #'upcase (append types entities))))
        (print `(setf ifc-mode-spf-constants
                      '(".T." ".F."
                        ,@(mapcar (lambda (string)
                                    (format ".%s." (upcase string)))
                                  enumerations)))))))
  (values))

(defvar ifc-mode-syntax-files
  '("http://www.steptools.com/support/stdev_docs/express/ifc2x3/ifc2x3_tc1.exp"
    "http://www.steptools.com/support/stdev_docs/express/ifc2x2/ifc2x2_add1.exp"))

(defun ifc-mode-download-syntax-files (directory)
  (make-directory directory t)
  (dolist (exp-file ifc-mode-syntax-files)
    (url-copy-file exp-file (expand-file-name (url-file-nondirectory exp-file) directory) t)))

(defvar ifc-mode-toc-files
  '("alphabeticalorder_definedtype.htm"
    "alphabeticalorder_entities.htm"
    "alphabeticalorder_enumtype.htm"
    "alphabeticalorder_selecttype.htm"))

(defun ifc-mode-download-toc-files (directory)
  (make-directory directory t)
  (dolist (html-file ifc-mode-toc-files)
    (url-copy-file (concat ifc-mode-base-url html-file)
                   (expand-file-name html-file directory)
                   t)))

(defun ifc-mode-parse-toc-files ()
  (setf ifc-mode-names-to-interfaces nil
        ifc-mode-resources nil
        ifc-mode-names nil)
  (dolist (html-file ifc-mode-toc-files)
    (with-current-buffer (find-file-noselect (expand-file-name html-file "html"))
      (goto-char (point-min))
      (while (re-search-forward "A HREF=\"\\(.+?\\)/lexical/\\(.+?\\)\\.htm\"" nil t)
        (let* ((interface (upcase (match-string 1)))
               (type (upcase (match-string 2))))
          (pushnew interface ifc-mode-resources :test #'string=)
          (push (cons type interface) ifc-mode-names-to-interfaces)))))
  (setf ifc-mode-names (append (mapcar #'car ifc-mode-names-to-interfaces)
                               ifc-mode-resources))
  (values))

(defun ifc-mode-generate-tocs (output)
  (ifc-mode-parse-toc-files)
  (with-temp-file output
    (let ((standard-output (current-buffer)))
      (print `(setf ifc-mode-names-to-interfaces ',ifc-mode-names-to-interfaces))
      (print `(setf ifc-mode-resources ',ifc-mode-resources))
      (print `(setf ifc-mode-names ',ifc-mode-names))))
  (values))
Something went wrong with that request. Please try again.