;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: ;;; Edited: ;;; ;;;****************************************************************************** (DEFUN C:MYTIME ( / );a-day a-project-record a-time-record day-bounds-lst day-job-lst day-lst job-lst record-time-lst the-job-lst day-files-lst day-time-lst edit-grp-lst this-day-files-lst this-edit-grp this-rdline this-time-lst time-lst x y z) (SETQ edit-grp-lst NIL edit-day-lst NIL ) ;_ end of setq (SETQ princprfx (IF princprfx (STRCAT princprfx " ") "[DEBUG] " ) ;_ end of IF ) ;_ end of SETQ (IF debug_princs (PROGN (PRINC (STRCAT "\n" princprfx "Begin MYTIME function ")) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (IF check_for_doslib NIL (LOAD "check_for_doslib" "\nFile CHECK_FOR_DOSLIB.LSP not loaded! " ) ;_ end of LOAD ) ;_ end of IF (IF DOS_SYSDIR NIL (check_for_doslib) ) ;_ end of IF (IF DOS_SYSDIR (PROGN (SETQ dos_root_drive (CAR (DOS_SPLITPATH (DOS_SYSDIR)))) (DOS_DRIVE dos_root_drive) (DOS_CHDIR "\\") (IF (DOS_DIRP (STRCAT dos_root_drive "\\ACAD\\")) (PROGN (SETQ tnam (IF onam onam (IF (AND DOS_USERNAME (DOS_USERNAME)) (DOS_USERNAME) "Unknown" ) ;_ end of if ) ;_ end of if ) ;_ end of setq (SETQ dmach (IF DOS_COMPUTER (STRCAT " on " (DOS_COMPUTER)) "" ) ;_ end of if ) ;_ end of setq (SETQ the-logf (GETFILED "Select log file" (STRCAT dos_root_drive "/acad/dwg_edit.log") "log" 4)) (SETQ datm (RTOS (GETVAR "cdate") 2 6)) (SETQ dwgp (GETVAR "dwgprefix") ;;; the-logf (OPEN (STRCAT dos_root_drive "/acad/dwg_edit.log") "r") dwgn (GETVAR "dwgname") ) ;_ end of SETQ (COND ;;; ((AND dos_root_drive (NOT the-logf)) ;;; (ALERT (STRCAT "Failed to open a log file" ;;; ) ;_ end of STRCAT ;;; ) ;_ end of ALERT ;;; ) ((NOT the-logf) (ALERT (STRCAT "Failed to open a log file" ) ;_ end of STRCAT ) ;_ end of ALERT ) (the-logf (SETQ cnt 1) (WHILE (SETQ this-rdline (READ-LINE the-logf)) ;;; (PRINC (STRCAT "\nTHIS-RDLINE (" (ITOA cnt) ") = ")) ;;; (PRINC this-rdline) ;;; (PRINC) (COND ((EQ this-rdline "") nil) ((WCMATCH this-rdline "@:*") ;;; (PRINC (STRCAT "\nTHIS-RDLINE (" (ITOA cnt) ") = ")) ;;; (PRINC this-rdline) ;;; (PRINC) (IF this-edit-grp (SETQ edit-grp-lst (APPEND edit-grp-lst (LIST this-edit-grp) ) ;_ end of APPEND this-edit-grp NIL ) ;_ end of SETQ ) ;_ end of IF (SETQ this-edit-grp (LIST this-rdline)) ) ((AND this-rdline this-edit-grp) (SETQ this-edit-grp (APPEND this-edit-grp (LIST this-rdline) ) ;_ end of APPEND ) ;_ end of SETQ ) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (SETQ edit-day-lst NIL) (get-edit-day-lst) (SETQ day-lst (ACAD_STRLSORT (MAPCAR 'CAR edit-day-lst))) (SETQ day-files-lst NIL) (FOREACH n edit-day-lst (SETQ day-time-lst (ACAD_STRLSORT (MAPCAR '(LAMBDA (x) (NTH 2 x)) (CDR n)) ) ;_ end of ACAD_STRLSORT ) ;_ end of SETQ ;;; (IF sav-day-time-lst NIL (SETQ sav-day-time-lst day-time-lst)) (SETQ this-day-files-lst NIL) (FOREACH o (CDR n) (IF (ASSOC (CAR o) this-day-files-lst) (SETQ this-day-files-lst (SUBST (APPEND (ASSOC (CAR o) this-day-files-lst) (LIST (LAST o)) ) ;_ end of APPEND (ASSOC (CAR o) this-day-files-lst) this-day-files-lst ) ;_ end of SUBST ) ;_ end of SETQ (SETQ this-day-files-lst (APPEND this-day-files-lst (LIST (LIST (CAR o) (LAST o))) ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of FOREACH (FOREACH p this-day-files-lst (SETQ this-time-lst (MAPCAR '(LAMBDA (x) (IF (MEMBER x p) x (STRCAT "-" x) ) ;_ end of IF ) ;_ end of LAMBDA day-time-lst ) ;_ end of MAPCAR ) ;_ end of SETQ (SETQ this-day-files-lst (SUBST (LIST (CAR p) (CONS (CAR n) this-time-lst)) p this-day-files-lst ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of FOREACH (SETQ day-files-lst (APPEND day-files-lst this-day-files-lst) ) ;_ end of SETQ ) ;_ end of FOREACH (SETQ mytime-lst NIL) (FOREACH n day-files-lst (SETQ time-lst (MAPCAR '(LAMBDA (z) (* (IF (<(CAR z)0) -1.0 1.0) (+ (ABS (CAR z)) (/ (+ (CADR z) (/ (CADDR z) 60.0)) 60.0 ) ;_ end of / ) ;_ end of + ) ) ;_ end of LAMBDA (MAPCAR '(LAMBDA (x) (MAPCAR '(LAMBDA (y) (ATOI y)) (DOS_STRTOKENS x ":") ) ;_ end of MAPCAR ) ;_ end of LAMBDA (CDADR n) ) ;_ end of MAPCAR ) ;_ end of MAPCAR ) ;_ end of SETQ (IF mytime-lst (SETQ mytime-lst (APPEND mytime-lst (LIST (LIST (CAR n) (CONS (CAADR n) time-lst)))) ) ;_ end of SETQ (SETQ mytime-lst (LIST (LIST (CAR n) (CONS (CAADR n) time-lst)))) ) ;_ end of IF ) ;_ end of FOREACH (get-job-time) ) ) ;_ end of COND (IF the-logf (CLOSE the-logf) ) ;_ end of IF ) ;_ end of progn (ALERT "DOS_SYSDIR undefined! Drawing activity is not logged!" ) ;_ end of ALERT ) ;_ end of if (IF debug_princs (PROGN (PRINC (STRCAT "\n" princprfx "End MYTIME function ")) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SETQ princprfx (COND ((AND princprfx (WCMATCH princprfx "`[DEBUG`] *")) (SUBSTR princprfx 1 (- (STRLEN princprfx) 2)) ) (T "[DEBUG] ") ) ;_ end of COND ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ;;; (if collist nil (load "stacklist")) ;;; (setq tst1 (mapcar 'collist edit-grp-lst)) (PRINC) ) ;_ end of DEFUN ;;;****************************************************************************** (DEFUN get-edit-day-lst ( / );cnt edit-grp-lst new-token-lst o_cnt this-token-lst) (SETQ edit-day-lst NIL) (FOREACH n edit-grp-lst (FOREACH o (CDR n) (SETQ o_cnt 1) (IF (WCMATCH o "*: ##-##-####*") (PROGN (WHILE (NOT (WCMATCH (SUBSTR o o_cnt) ": ##-##-####*")) (SETQ o_cnt (1+ o_cnt)) ) ;_ end of WHILE (SETQ this-token-lst (DOS_STRTOKENS (SUBSTR o (+ o_cnt 3)) " ") ) ;_ end of SETQ (SETQ new-token-lst NIL) ) ;_ end of PROGN ) ;_ end of IF (FOREACH p this-token-lst (SETQ cnt 1) (WHILE (WCMATCH (SUBSTR p cnt) " *") (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (SETQ new-token-lst (APPEND new-token-lst (LIST (SUBSTR p cnt))) ) ;_ end of SETQ ) ;_ end of foreach (IF (ASSOC (CAR new-token-lst) edit-day-lst) (SETQ edit-day-lst (SUBST (APPEND (ASSOC (CAR new-token-lst) edit-day-lst) (LIST (LIST (CAR n) (SUBSTR o 1 o_cnt) (CADR new-token-lst)) ) ;_ end of LIST ) ;_ end of APPEND (ASSOC (CAR new-token-lst) edit-day-lst) edit-day-lst ) ;_ end of SUBST ) ;_ end of SETQ (IF edit-day-lst (SETQ edit-day-lst (APPEND edit-day-lst (LIST (LIST (CAR new-token-lst) (LIST (CAR n) (SUBSTR o 1 o_cnt) (CADR new-token-lst)) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ edit-day-lst (LIST (LIST (CAR new-token-lst) (LIST (CAR n) (SUBSTR o 1 o_cnt) (CADR new-token-lst)) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of IF ) ;_ end of FOREACH ) ;_ end of foreach (PRINC) ) ;_ end of defun ;;;****************************************************************************** (DEFUN get-job-time (/ prev-thedate) (SETQ timeout (OPEN "C:\\ACAD\\Timeout.txt" "w")) (FOREACH n mytime-lst (SETQ thestr (CAR n)) (SETQ tokened-lst (DOS_STRTOKENS thestr "\\")) (IF (AND (NOT (WCMATCH (CADR tokened-lst) "*@*##*"))(WCMATCH thestr "*@*##*\\*")) (SETQ theproject (STRCAT (CAR tokened-lst) "\\" (CADR tokened-lst) "\\" (CADDR tokened-lst))) (SETQ theproject (STRCAT (CAR tokened-lst) "\\" (CADR tokened-lst))) ) (SETQ thedate (CAADR n)) (SETQ thetime-lst (CDADR n)) (SETQ cnt 1) (WHILE (AND (WCMATCH thestr "*on *")(NOT (WCMATCH (SUBSTR thestr cnt) " on *"))) (SETQ cnt (1+ cnt)) (SETQ thefile (SUBSTR thestr 1 (1- cnt))) ) (WHILE (AND (WCMATCH thestr "*by: *")(NOT (WCMATCH (SUBSTR thestr cnt) " by: *"))) (SETQ cnt (1+ cnt)) (SETQ theuser (SUBSTR thestr (+ cnt 5))) ) (SETQ cnt1 0 cnt2 0 ) (SETQ this-time-lst NIL) (WHILE (AND (< cnt1 (LENGTH thetime-lst))(< cnt2 (LENGTH thetime-lst))) (WHILE (AND (< (NTH cnt1 thetime-lst) 0)(< cnt1 (LENGTH thetime-lst))) (SETQ cnt1 (1+ cnt1)) ) (SETQ cnt2 (1+ cnt1)) (WHILE (AND (> (NTH cnt2 thetime-lst) 0)(< cnt2 (LENGTH thetime-lst))) (SETQ cnt2 (1+ cnt2)) ) (IF (AND cnt1 cnt2 (< cnt1 cnt2)(< cnt1 (LENGTH thetime-lst))(< cnt2 (LENGTH thetime-lst))) (PROGN (IF this-time-lst (SETQ this-time-lst (APPEND this-time-lst (LIST (- (ABS (NTH cnt2 thetime-lst))(ABS (NTH (MAX 0 cnt1) thetime-lst)))))) (SETQ this-time-lst (LIST (- (ABS (NTH cnt2 thetime-lst))(ABS (NTH (MAX 0 cnt1) thetime-lst))))) ) (SETQ cnt1 (1+ cnt2) cnt2 (1+ cnt1) ) ) ) ) (IF (> (EVAL (CONS '+ this-time-lst)) 0.01) (PROGN (IF (AND thedate prev-thedate (NOT (WCMATCH thedate prev-thedate))) (WRITE-LINE prev-thedate timeout) ) (WRITE-LINE (STRCAT thedate "\t" (STRCASE theproject) "\t" (STRCASE thefile) "\t" theuser "\t" (RTOS (EVAL (CONS '+ this-time-lst)) 2 3)) timeout) (SETQ prev-thedate thedate) ) ) ) (CLOSE timeout) (PRINC) ) ;_ end of DEFUN ;;;****************************************************************************** (PRINC) ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;