;;;Automatically generates complete HTML listing all autolisp files in the ;;;selected folder. Only those functions that have an explicit (load ) ;;;statement AND/OR are used in the file in the form ( ...) will ;;;be included in the "Requires" line in the resulting HTML. ;;; ;;;Doslib usage is accounted for separately. ;;; ;;;> Author: Henry C. Francis ;;;> 425 N. Ashe St. ;;;> Southern Pines, NC 28387 ;;;> http://paracadd.com ;;;> All rights reserved. ;;; ;;;> COPYRIGHT: 05-05-2001 ;;;> EDITED: 01-22-2007 ;;; (DEFUN lsplst_error (msg / ) (IF old_lsplst_error (SETQ *ERROR* old_lsplst_error) (SETQ *ERROR* NIL) ) (WRITE-LINE "\n" lst_out) (CLOSE cur_file) (CLOSE lst_out) (PRINC "\n") (PRINC msg) (PRINC) ) (DEFUN c:lsplst (/ descr reqlst myfuns_lst) (SETQ old_lsplst_error *ERROR* *ERROR* lsplst_error ) ;_ end of SETQ (PROGN (IF c:sublst NIL (LOAD "SUBLST" "\nFile SUBLST.LSP not loaded! ") ) ;_ end of IF (IF c:sublst (C:SUBLST) ) ;_ end of IF ) ;_ end of PROGN (IF (AND myfuns_lst c:sublst file_lst lispfiles_path) (PROGN (SETQ lst_out (OPEN (STRCAT lispfiles_path "lisp_lst.htm") "w")) (WRITE-LINE (STRCAT "\n" "\n" "

This HTML document was automatically generated by LSPLST.LSP from
PARAGLIDE

" ) ;_ end of STRCAT lst_out ) ;_ end of WRITE-LINE (SETQ file_cnt 0) (SETQ back_spaces "" front_spaces "" space_len (STRLEN (STRCAT (IF (EQ (STRCASE renew_or_open) "OPEN") "Existing C" "C" ) ;_ end of IF "atalog has been " renew_or_open "ed. " ) ;_ end of STRCAT ) ;_ end of STRLEN ) ;_ end of SETQ (REPEAT space_len (SETQ back_spaces (STRCAT back_spaces "\010"))) (REPEAT space_len (SETQ front_spaces (STRCAT front_spaces " "))) (PRINC back_spaces) (PRINC front_spaces) (PRINC back_spaces) (PRINC) (FOREACH n file_lst (SETQ alltokens NIL) (SETQ file_cnt (1+ file_cnt)) (PRINC "\010\010\010\010") (PRINC file_cnt) (PRINC) ;;; ) ;;; ) ;;; (IF myfuns_lst ;;; (fundefloc n) ;;; ) ;_ end of IF (SETQ end_descr nil) (SETQ cur_file (OPEN (STRCAT lispfiles_path n) "r")) (WHILE (SETQ rd_line (READ-LINE cur_file)) (WHILE (AND (NOT (AND (WCMATCH (STRCASE rd_line) (STRCASE "*[~;]defun")) (WCMATCH (STRCASE rd_line) (STRCASE (STRCAT "*" (CHR 40) "defun"))) ) ;_ end of AND ) ;_ end of NOT (NOT (WCMATCH rd_line "*PROTECTED*")) (NOT end_descr) (OR (WCMATCH rd_line ";*") (WCMATCH rd_line "") (WCMATCH rd_line " ")) ) ;_ end of AND (IF DEBUG_DESCR (PROGN (PRINC "\n(STRCASE rd_line)=") (PRINC (STRCASE rd_line)) (PRINC "\n(STRCASE \"*[~;]defun\"))=") (PRINC (STRCASE "*[~;]defun")) (PRINC "\n(WCMATCH (STRCASE rd_line) (STRCASE \"*[~;]defun\"))=") (PRINC (WCMATCH (STRCASE rd_line) (STRCASE "*[~;]defun"))) (PRINC "\n(WCMATCH (STRCASE rd_line) (STRCASE (STRCAT \"*\" (CHR 40) \"defun\")))=") (PRINC (WCMATCH (STRCASE rd_line) (STRCASE (STRCAT "*" (CHR 40) "defun")))) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF (> (STRLEN rd_line) 80) (PROGN (SETQ rd_line_0 NIL rd_line_1 NIL rd_line_lst NIL ) (SETQ rd_line_0 (DOS_STRTOKENS rd_line " \t ")) (SETQ rd_line_cnt 0 rd_line_1 (NTH 0 rd_line_0) ) ;_ end of SETQ (WHILE (< rd_line_cnt (LENGTH rd_line_0)) (WHILE (AND (< rd_line_cnt (LENGTH rd_line_0)) (< (+ (STRLEN rd_line_1) (1-(STRLEN (NTH rd_line_cnt rd_line_0))) 1) 80) ) ;_ end of AND (SETQ rd_line_1 (STRCAT rd_line_1 " " (NTH rd_line_cnt rd_line_0)) rd_line_cnt (1+ rd_line_cnt) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ rd_line_lst (IF rd_line_lst (APPEND rd_line_lst (LIST "\n" rd_line_1)) (LIST rd_line_1) ) ;_ end of IF rd_line_1 (NTH rd_line_cnt rd_line_0) rd_line_cnt (1+ rd_line_cnt) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ rd_line_lst (APPEND rd_line_lst (LIST "\n" (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT " " x)) (MEMBER (NTH (1- rd_line_cnt) rd_line_0) rd_line_0) ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ rd_line_lst (MAPCAR '(LAMBDA (x) (IF (EQ (SUBSTR x 1 1) " ") (SETQ x (SUBSTR x 2)) x ) ;_ end of IF ) ;_ end of LAMBDA rd_line_lst ) ;_ end of MAPCAR ) ;_ end of SETQ (SETQ rd_line (EVAL (CONS 'STRCAT rd_line_lst))) ) ;_ end of PROGN ) ;_ end of IF (IF (AND descr (NOT (EQ descr ""))) (SETQ descr (STRCAT descr "\n" rd_line)) (SETQ descr rd_line) ) ;_ end of if (IF (AND (WCMATCH (STRCASE rd_line) (STRCASE "*[~;]defun")) (WCMATCH (STRCASE rd_line) (STRCASE (STRCAT "*" (CHR 40) "defun"))) ) ;_ end of AND (SETQ end_descr T) ) ;_ end of IF (SETQ rd_line (READ-LINE cur_file)) ) ;_ end of while (SETQ end_descr T) (IF rd_line (PROGN (IF addtokens NIL (LOAD "addtokens" "\nFile ADDTOKENS.LSP not loaded! ") ) ;_ end of IF (IF addtokens (addtokens rd_line) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of WHILE (CLOSE cur_file) (SETQ defunfile_lst NIL reqfile_lst NIL ) ;_ end of SETQ (IF (MEMBER (STRCAT (SUBSTR n 1 (-(STRLEN n)4)) ".dcl") alltokens) NIL (SETQ alltokens (CONS (STRCAT (CHR 40)(SUBSTR n 1 (-(STRLEN n)4)) ".dcl") alltokens)) ) (FOREACH o (MAPCAR '(LAMBDA (x) (SUBSTR x 2)) alltokens) ;(APPEND alltokens (MAPCAR '(LAMBDA (x) (STRCAT "C:" x)) alltokens)) (fundefloc o) (IF defunfile_lst (IF (AND (NOT (WCMATCH (STRCASE n) "*.DCL"))(MEMBER (STRCASE n) (MAPCAR 'STRCASE defunfile_lst))) NIL (FOREACH p defunfile_lst (IF (MEMBER p reqfile_lst) NIL (SETQ reqfile_lst (APPEND reqfile_lst (LIST p))) ) ;_ end of IF ) ;_ end of foreach ) ;_ end of IF ) ;_ end of IF ) ;_ end of FOREACH (IF reqfile_lst (PROGN (WHILE (AND (SETQ capreqfiles (MAPCAR '(LAMBDA (x) (STRCASE x)) reqfile_lst)) (MEMBER "UUTILS.LSP" capreqfiles) (OR (MEMBER "UANGLE.LSP" capreqfiles) (MEMBER "UPOINT.LSP" capreqfiles) (MEMBER "UREAL.LSP" capreqfiles) (MEMBER "UINT.LSP" capreqfiles) (MEMBER "UKWORD.LSP" capreqfiles) (MEMBER "UDIST.LSP" capreqfiles) (MEMBER "USTR.LSP" capreqfiles) ) ;_ end of OR ) ;_ end of AND (SETQ reqfile_cnt (- (LENGTH capreqfiles) (LENGTH (MEMBER "UUTILS.LSP" capreqfiles)))) (SETQ reqfile_lst (APPEND (REVERSE (CDR (MEMBER (NTH reqfile_cnt reqfile_lst) (REVERSE reqfile_lst)))) (CDR (MEMBER (NTH reqfile_cnt reqfile_lst) reqfile_lst)) ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of WHILE (IF (MEMBER "(DOS_" (MAPCAR '(LAMBDA (x) (STRCASE (SUBSTR x 1 5))) alltokens)) (SETQ reqfile_lst (APPEND reqfile_lst (LIST "Doslib"))) ) ;_ end of IF (SETQ reqlst "Requires") (FOREACH q reqfile_lst (IF (WCMATCH (STRCASE n) (STRCASE (STRCAT q "*"))) NIL (SETQ reqlst (STRCAT reqlst (IF (WCMATCH q "Doslib") (IF (WCMATCH reqlst "*,*") ",\neither requires or can use Doslib" "\nor can use Doslib" ) ;_ end of IF (STRCAT (IF (WCMATCH reqlst "*,*") ",\n" (IF (WCMATCH (STRCASE q) "*.DCL") (STRCASE q T) (SUBSTR (STRCASE q T) 1 (- (STRLEN q) 4)) ) "" ) ;_ end of STRCAT ) ;_ end of IF ) ;_ end of strcat ) ;_ end of setq ) ;_ end of IF ) ;_ end of FOREACH ) ;_ end of progn ) ;_ end of IF (WRITE-LINE (STRCAT "" "\n \n \n \n " (IF (EQ reqlst "Requires") (STRCAT "\n \n " "\n \n
" (STRCASE n T) "\n \n 
\n"
            (IF descr
              descr
              ""
            ) ;_ end of IF
            "\n
\n
\n" "" "\n
" ) ;_ end of STRCAT (STRCAT "\n \n \n" (IF reqlst reqlst "" ) ;_ end of IF "\n \n \n\n" "\n \n " "\n \n
\n" "" "\n
" ) ;_ end of STRCAT ) ;_ end of if ) ;_ end of strcat lst_out ) ;_ end of write-line (SETQ descr nil reqlst nil ) ;_ end of setq ) ;_ end of FOREACH (WRITE-LINE "\n" lst_out) (CLOSE lst_out) ) ;_ end of PROGN ) ;_ end of IF (IF old_lsplst_error (SETQ *ERROR* old_lsplst_error) (SETQ *ERROR* NIL) ) (PRINC) ) ;_ end of defun ;;;(DEFUN lsplst_error () ;;; (SET *ERROR* old_lsplst_error) ;;; (CLOSE cur_file) ;;; (WRITE-LINE "\n" lst_out) ;;; (CLOSE lst_out) ;;; (PRINC) ;;;) ;_ end of defun ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ***Don't add text below the comment!***|;