psc/acaddoc.lsp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; weird documentation load stuff going on here ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; early versions, to be redefined later
;; see util/documentation
(defun defun-r (func-sym)
  (setq *delayed-doc* (append *delayed-doc* (list (list *file-name* func-sym)))))
;; functions that are used in defun-r can't have declares but we should add them later
;; DECLARES should be a quoted list without 'declare on the front
(defun declare-late (func-sym declares)
  (setq *delayed-decl* (append *delayed-decl* (list (cons func-sym declares)))))
;; see util/test
(defun defun-t (func-sym)
  (setq *delayed-test* (append *delayed-test* (list (list *file-name* func-sym)))))

;; defined here so it can be used immediately
;; defun-r called later
(defun-q set-file-docstring (docstring)
  "Registers the current file's docstring

When *doc-build-p* is non-nil, set global *file-docstring* to DOCSTRING and register it in
the global *file-docs*. This instructs %defun-r to register function documentation."
  (if *doc-build-p*
      (setq *file-docstring* docstring
            *file-docs*
            (append *file-docs*
                    (list
                     (list *file-name*
                           (substr *file-docstring* 1 (vl-string-position (ascii "\n")
                                                                          *file-docstring*))
                           *file-docstring*))))))

((lambda(/ *doc-build-p*)
   (setq *doc-build-p* t
         *file-name* "acaddoc.lsp"
         *file-docs* nil)
   (set-file-docstring
    "Init file. This file is the entrypoint into the code base")))

(defun-r 'set-file-docstring)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; end weird documentation stuff ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun-q calc-src-dir ( / devs loginname filename)
  "Return the source directory for the current user

If the user is a developer, set *dev-mode* to t."
  (setq devs '(("pley" . "Q:/home/pete/src/code/")
               ("Dennis Dreischmeyer" . "C:/dd-dev/")))
  (if (setq filename (assoc (getvar "LoginName") devs))
      (progn
        (if (not *inhibit-dev-mode*)
            (setq *dev-mode* t))
        (cdr filename))
      "S:/psc-src/"))
(defun-r 'calc-src-dir)

(defun-q psc-load (*file-name* / job-dir name)
  "Alias for load so that *FILE-NAME* is set automatically for each file

Assumes the file lives in psc-src-dir. Returns the file name as a string."
  (load (strcat psc-src-dir *file-name*))
  *file-name*)
(defun-r 'psc-load)

(defun-q psc-include (filenames)
  "Include all files in FILENAMES

Load each file and add it to psc-included-files. Ignore files that are already present
there. Assumes the file lives in psc-src-dir."
  (foreach filename filenames
     (if (not (wcmatch filename "*.lsp"))
	 (setq filename (strcat filename ".lsp")))
     (if (not (member filename psc-included-files))
         (progn
           (setq psc-included-files (vl-sort (cons filename psc-included-files) '<))
           (psc-load filename)))))
(defun-r 'psc-include)

(defun-q psc-remove (filenames)
  "Remove all members of FILENAMES from psc-included-files"
  (foreach filename filenames
    (if (member filename psc-included-files)
        (setq psc-included-files (vl-remove filename psc-included-files)))))
(defun-r 'psc-remove)

(defun-q psc-autoload (cmds / file)
  "Used in %s::startup to register autoloads

CMDS is a list whose car is a filename and cdr is a list of command names.

This function uses %psc-include as its load mechanism. It registers all the commands as
command functions that only load their defining file, which causes them to redefine
themselves after first run."
  (setq file (pop! 'cmds))
  (mapcar '(lambda (cmd / cmdsym)
            (setq cmdsym (read (strcat "C:" cmd)))
            (eval (#!
                   '(defun-q #cmdsym ()
                     (psc-include (list #(strcat "commands/" file)))
                     (#cmdsym)))))
          cmds))
(defun-r 'psc-autoload)

(defun-q s::startup ()
  "Routine automatically called by AutoCAD after drawing initializes"
  (vl-load-com)
  (setq acadObj (vlax-get-acad-object)
        acadDoc (vla-get-ActiveDocument acadObj)
        modelSpace (vla-get-ModelSpace acadDoc)
        psc-src-dir (calc-src-dir)
        psc-data-dir (strcat "C:/Users/" (getvar "LoginName") "/AppData/Local/psc/")
        tmpdir (strcat "C:/Users/" (getvar "LoginName") "/AppData/Local/Temp/"))

  ;; create data dir if necessary
  (if (not (vl-file-directory-p psc-data-dir))
      (vl-mkdir psc-data-dir))

  ;; util always loaded early
  (psc-load "util.lsp")
  (setq psc-included-files '("util.lsp"))

  (mapcar (if (or *doc-build-p* *test-build-p*)
              ;; auto-include all files for doc build
              '(lambda(f) (psc-include (list (strcat "commands/" (car f)))))
              'psc-autoload)
          '(
            ("3d-model.lsp"
             "3D-MODEL"
             "3D-RET"
             "3D-IN-PLACE"
             "3D-BATCH-PLAN"
             "LINE->PIPE")
            ("codemanual.lsp" "CODEMANUAL")
            ("dd-guard.lsp" "DD-GUARD")
            ("devmode.lsp" "DEVMODE")
            ("dimensions.lsp"
             "STAIR-DIM-HOR"
             "STAIR-DIM-HOR-OVR"
             "STAIR-DIM-VER"
             "STAIR-DIM-VER-OVR"
             "STAIR-ADD-DET")
            ("distfromorigin.lsp" "DISTFROMORIGIN")
            ("drawshape.lsp" "DRAWSHAPE")
            ("draw-xbrace.lsp" "DRAW-XBRACE")
            ("dualoffset.lsp" "DUALOFFSET")
            ("dumpstairs.lsp" "DUMPSTAIRS")
            ("dumplands.lsp" "DUMPLANDS")
            ("editblock.lsp" "EDITBLOCK")
            ("editfinish.lsp" "EDITFINISH")
            ("edittable.lsp" "EDITTABLE")
            ("embed.lsp" "EMBED")
            ("embed-totals.lsp" "EMBED-TOTALS")
            ("endview.lsp" "ENDVIEW")
            ("fab.lsp" "FAB")
            ("fabdata.lsp" "FABDATA")
            ("fabtemplate.lsp" "FABTEMPLATE")
            ("guard-rail.lsp" "GUARDRAIL")
            ("insertrows.lsp" "INSERTROWS")
            ("jobinfo.lsp" "JOBINFO")
            ("land.lsp" "LANDING")
            ("landing-embeds.lsp" "LANDING-EMBEDS")
            ("manual.lsp" "MANUAL")
            ("markprefix.lsp" "MARKPREFIX")
            ("mrotate.lsp" "MROTATE")
            ("qt-takeoff.lsp" "QT-TAKEOFF")
            ("rails.lsp" "RAILS")
            ("railcircle.lsp" "RAILCIRCLE")
            ("rail-section.lsp" "RAIL-SECTION")
            ("reloadall.lsp" "RELOADALL")
            ("return.lsp" "RETURN")
            ("savequit.lsp" "SAVEQUIT")
            ("shape-line.lsp" "SHAPE-LINE")
            ("shape-text.lsp" "SHAPE-TEXT")
            ("stair.lsp" "STAIR")
            ("topview.lsp" "TOPVIEW")
            ("topviewhandgrab.lsp" "TOPVIEWHANDGRAB")
            ("topviewrails.lsp" "TOPVIEWRAILS")
            ("translatexdata.lsp" "TRANSLATEXDATA")
            ("trimrows.lsp" "TRIMROWS")
            ("updatemarkno.lsp" "UPDATEMARKNO")
            ("update-chk.lsp" "UPDATE-CHK")
            ("xdatalist.lsp" "XDATALIST")
            ))
  (if *doc-build-p*
      (doc-build-html))
  (if *test-build-p*
      (test-build-lsp))
  (if (or *doc-build-p* *test-build-p*)
      (progn
        (propagate '*doc-build-p* nil)
        (propagate '*test-build-p* nil)
        (command "close" "y")))
  (gc))
(defun-r 's::startup)