;;; ---------------------------------------------------------------------------
;;; UsageLog.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Records which of your custom LISP commands actually get used, and how often.
;;;
;;; The point of this is pruning. Once a library runs to a hundred routines,
;;; nobody knows which ones earn their keep. Run this for a month and the
;;; answer is in a spreadsheet: the commands nobody has invoked once are
;;; candidates for deletion, and the ones used forty times a day are the ones
;;; worth polishing.
;;;
;;; COMMANDS
;;;   USAGELOGON   - start logging
;;;   USAGELOGOFF  - stop logging and discard anything not yet written
;;;
;;; Logging starts automatically when this file loads. For it to be useful it
;;; should be loaded at startup - putting it in your acaddoc.lsp is the usual
;;; way, and ACADDOCMAKER in this library will UsageLog:Build that file for you.
;;;
;;; WHERE THE LOGS GO
;;; Set UsageLog:Folder below. One CSV is written per day, filed in a folder
;;; per month:
;;;
;;;     C:\LISP-Logs\AUGUST 2026\Log_20260802.csv
;;;
;;; Each file lists, per drawing, every command used in it and the number of
;;; times. Folders are created automatically if they do not exist.
;;;
;;; WHEN THE LOG IS WRITTEN
;;; Counts accumulate in memory and are flushed to disk when the drawing is
;;; SAVED. That is a deliberate trade: writing on every command would mean a
;;; file operation on every single invocation, which would be felt. It does
;;; mean an AutoCAD session that crashes without ever saving loses its counts.
;;;
;;; If a log already exists for today, its contents are read and merged rather
;;; than overwritten - so several drawings, and several sessions in one day,
;;; all accumulate into the same file.
;;;
;;; The two logging commands themselves are excluded from the counts, since
;;; recording that you switched logging on is of no interest.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; LOG FILE FOLDER - edit to suit. Created automatically if absent. If set to
;;; nil, logs are written alongside the current drawing instead.
;;; ---------------------------------------------------------------------------
(setq UsageLog:Folder "C:\\LISP-Logs")

;;; ---------------------------------------------------------------------------
;;; A NOTE ON THE GLOBALS BELOW
;;;
;;; These cannot be localised. Reactor callbacks fire long after the command
;;; that created the reactor has returned, so anything they use must persist at
;;; global scope.
;;;
;;; *UsageLog:Data* additionally uses vl-propagate, which copies the value into
;;; every open drawing's namespace. Each drawing document in AutoCAD has its
;;; own separate LISP environment, so without propagation the counts gathered
;;; in one drawing would be invisible to the save reactor firing in another.
;;; ---------------------------------------------------------------------------
(setq *UsageLog:LispReactor* nil    ; watches for LISP commands starting
      *UsageLog:SaveReactor* nil    ; watches for the drawing being saved
      *UsageLog:Data*        nil    ; accumulated counts, not yet written
)

;; ---------------------------------------------------------------------------
;; UsageLog:Date
;; ---------------------------------------------------------------------------
;; Returns the current date formatted by an AutoCAD $(edtime) picture string,
;; e.g. "MONTH YYYY" or "YYYYMODD".
;; ---------------------------------------------------------------------------
(defun UsageLog:Date ( format )
    (menucmd (strcat "m=$(edtime,$(getvar,DATE)," format ")"))
)

;; ---------------------------------------------------------------------------
;; UsageLog:Split
;; ---------------------------------------------------------------------------
;; Splits a string on a delimiter, discarding empty pieces.
;; ---------------------------------------------------------------------------
(defun UsageLog:Split ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (vl-remove ""
            (cons (substr str 1 pos)
                  (UsageLog:Split (substr str (+ pos 1 (strlen del))) del)
            )
        )
        (list str)
    )
)

;; ---------------------------------------------------------------------------
;; UsageLog:MakeDirectory
;; ---------------------------------------------------------------------------
;; Creates a directory and every missing parent above it.
;;
;; vl-mkdir will only create one level at a time, so the path is split and each
;; level created in turn from the drive root downwards.
;; ---------------------------------------------------------------------------
(defun UsageLog:MakeDirectory ( dir / UsageLog:Build folders )

    (defun UsageLog:Build ( root folders )
        (if folders
            (   (lambda ( path ) (vl-mkdir path) (UsageLog:Build path (cdr folders)))
                (strcat root "\\" (car folders))
            )
        )
    )

    (if (setq folders (UsageLog:Split (vl-string-translate "/" "\\" dir) "\\"))
        (UsageLog:Build (car folders) (cdr folders))
    )
    (vl-file-directory-p dir)
)

;; ---------------------------------------------------------------------------
;; UsageLog:Increment
;; ---------------------------------------------------------------------------
;; Increments a count held in a nested association list, creating whatever
;; levels are missing.
;;
;; The structure is two deep - drawing name, then command name - so key arrives
;; as ("C:\path\drawing.dwg" "MYCOMMAND") and the function recurses one level
;; per key element, bottoming out by incrementing the count.
;; ---------------------------------------------------------------------------
(defun UsageLog:Increment ( key lst / pair )
    (if key
        (if (setq pair (assoc (car key) lst))
            (subst (cons (car key) (UsageLog:Increment (cdr key) (cdr pair))) pair lst)
            (cons  (cons (car key) (UsageLog:Increment (cdr key) nil)) lst)
        )
        (if lst (list (1+ (car lst))) '(1))
    )
)

;; ---------------------------------------------------------------------------
;; UsageLog:Read
;; ---------------------------------------------------------------------------
;; Reads an existing log file back into the in-memory structure, so today's
;; counts can be merged into it rather than replacing it.
;;
;; The file format alternates: a line with one field is a drawing name, a line
;; with two is a command and its count, and a blank line separates groups.
;; ---------------------------------------------------------------------------
(defun UsageLog:Read ( filename / file line lst dwg cmds )
    (if (setq file (open filename "r"))
        (progn
            (while (setq line (read-line file))
                (cond
                    (   (= "" line))

                    ;; One field - a drawing name, so close off the previous
                    ;; group before starting the new one.
                    (   (= 1 (length (setq line (UsageLog:Split line ","))))
                        (if (and dwg cmds)
                            (setq lst  (cons (cons dwg cmds) lst)
                                  dwg  nil
                                  cmds nil
                            )
                        )
                        (setq dwg (car line))
                    )

                    ;; Two fields - a command and its count.
                    (   (= 2 (length line))
                        (setq cmds (cons (list (car line) (atoi (cadr line))) cmds))
                    )
                )
            )
            ;; The final group has no blank line after it.
            (if (and dwg cmds)
                (setq lst (cons (cons dwg cmds) lst))
            )
            (close file)
            lst
        )
    )
)

;; ---------------------------------------------------------------------------
;; UsageLog:Merge
;; ---------------------------------------------------------------------------
;; Merges two log structures, summing the counts of commands appearing in both.
;; ---------------------------------------------------------------------------
(defun UsageLog:Merge ( new old / items item )
    (foreach group old
        (if (setq items (cdr (assoc (car group) new)))
            (progn
                (foreach pair (cdr group)
                    (if (setq item  (assoc (car pair) items))
                        (setq items (subst (list (car pair) (+ (cadr pair) (cadr item))) item items))
                        (setq items (cons pair items))
                    )
                )
                (setq new (subst (cons (car group) items) (assoc (car group) new) new))
            )
            (setq new (cons group new))
        )
    )
    new
)

;; ---------------------------------------------------------------------------
;; UsageLog:CommandStarted  -  :vlr-lispWillStart callback
;; ---------------------------------------------------------------------------
;; Fires as each LISP expression begins. Only expressions of the form (C:NAME)
;; are counted - those are command invocations; everything else is ordinary
;; function evaluation and of no interest.
;;
;; The count is keyed by full drawing path as well as command name, so the log
;; shows which drawings each command was used in.
;; ---------------------------------------------------------------------------
(defun UsageLog:CommandStarted ( reactor params )
    (if (and (wcmatch (setq params (strcase (car params))) "(C:*")
             (not (member params '("(C:USAGELOGON)" "(C:USAGELOGOFF)")))
        )
        (progn
            (setq *UsageLog:Data*
                (UsageLog:Increment
                    (list (strcat (getvar 'DWGPREFIX) (getvar 'DWGNAME))
                          ;; Strip the surrounding brackets and the "C:" prefix.
                          (substr (vl-string-trim "()" params) 3)
                    )
                    *UsageLog:Data*
                )
            )
            ;; Share the updated counts with every other open drawing.
            (vl-propagate '*UsageLog:Data*)
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; UsageLog:Flush  -  :vlr-beginSave callback
;; ---------------------------------------------------------------------------
;; Writes the accumulated counts to today's CSV, merging with anything already
;; there, then clears the in-memory store.
;; ---------------------------------------------------------------------------
(defun UsageLog:Flush ( reactor params / *error* folder directory filename existing file )

    ;; A file handle left open by a failure here would lock the log for the
    ;; rest of the session, so the handler closes it explicitly.
    (defun *error* ( msg )
        (if (and file (= 'FILE (type file)))
            (close file)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** UsageLog error: " msg " **"))
        )
        (princ)
    )

    (if *UsageLog:Data*
        (progn
            ;; Normalise the folder: forward slashes to back, no trailing
            ;; separator. Falling back to the drawing's own folder if unset.
            (setq folder
                (if UsageLog:Folder
                    (vl-string-right-trim "\\" (vl-string-translate "/" "\\" UsageLog:Folder))
                    (vl-string-right-trim "\\" (getvar 'DWGPREFIX))
                )
            )
            (setq directory (strcat folder "\\" (UsageLog:Date "MONTH YYYY"))
                  filename  (strcat directory "\\Log_" (UsageLog:Date "YYYYMODD") ".csv")
            )

            (if (null (vl-file-directory-p directory))
                (UsageLog:MakeDirectory directory)
            )

            (if (findfile filename)
                (setq existing (UsageLog:Read filename))
            )

            (if (setq file (open filename "w"))
                (progn
                    (if existing
                        (setq *UsageLog:Data* (UsageLog:Merge *UsageLog:Data* existing))
                    )

                    ;; Drawings alphabetically; within each, commands ordered by
                    ;; descending use, so the most-used appear first.
                    (foreach dwg (vl-sort *UsageLog:Data*
                                     (function (lambda ( a b ) (< (car a) (car b)))))
                        (write-line (car dwg) file)
                        (foreach cmd (vl-sort (cdr dwg)
                                         (function (lambda ( a b ) (> (cadr a) (cadr b)))))
                            (write-line (strcat (car cmd) "," (itoa (cadr cmd))) file)
                        )
                        (write-line "" file)
                    )

                    (close file)
                    (setq *UsageLog:Data* nil)
                    (vl-propagate '*UsageLog:Data*)
                )
                (princ "\nUnable to write the usage log - check the file is not open elsewhere.")
            )
        )
    )
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:USAGELOGON  -  start logging
;; ---------------------------------------------------------------------------
;; Each reactor is only created if not already present, so running this twice
;; cannot produce duplicates that would double-count every command.
;; ---------------------------------------------------------------------------
(defun c:USAGELOGON ( / *error* )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** USAGELOGON error: " msg " **"))
        )
        (princ)
    )

    (if (null *UsageLog:LispReactor*)
        (setq *UsageLog:LispReactor*
            (vlr-lisp-reactor "UsageLog"
               '((:vlr-lispWillStart . UsageLog:CommandStarted))
            )
        )
    )
    (if (null *UsageLog:SaveReactor*)
        (setq *UsageLog:SaveReactor*
            (vlr-editor-reactor "UsageLog"
               '((:vlr-beginSave . UsageLog:Flush))
            )
        )
    )

    (princ "\nCommand usage logging enabled.")
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:USAGELOGOFF  -  stop logging
;; ---------------------------------------------------------------------------
;; Note that this DISCARDS counts not yet written to disk. Save the drawing
;; first if the current session's figures matter.
;; ---------------------------------------------------------------------------
(defun c:USAGELOGOFF ( / *error* )

    (defun *error* ( msg )
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** USAGELOGOFF error: " msg " **"))
        )
        (princ)
    )

    (if *UsageLog:LispReactor*
        (progn (vlr-remove *UsageLog:LispReactor*)
               (setq *UsageLog:LispReactor* nil)
        )
    )
    (if *UsageLog:SaveReactor*
        (progn (vlr-remove *UsageLog:SaveReactor*)
               (setq *UsageLog:SaveReactor* nil)
        )
    )

    (setq *UsageLog:Data* nil)
    (vl-propagate '*UsageLog:Data*)

    (princ "\nCommand usage logging disabled (unsaved counts discarded).")
    (princ)
)

;; Enabled on load, matching the original behaviour.
(c:USAGELOGON)
(princ)
