;;; ---------------------------------------------------------------------------
;;; PortLock.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Locks every viewport on every layout in the drawing.
;;;
;;; A locked viewport cannot have its zoom scale changed by accident. This is
;;; the single cheapest piece of drawing hygiene there is: once a sheet is set
;;; up at 1:50, locking the viewport means an absent-minded scroll wheel while
;;; inside it can no longer quietly rescale the drawing.
;;;
;;; Model space has no viewports to lock and is skipped automatically, since
;;; layoutlist returns only paper space layouts.
;;;
;;; WHY THE ERROR HANDLER MATTERS HERE
;;; This routine walks the layouts by changing CTAB, the current tab. If it
;;; failed part way through without a handler - a layout containing no
;;; viewports at all is enough to upset the -VPORTS command - the user would
;;; be dumped on whichever random layout the loop had reached. The handler
;;; always returns them to the tab they started on.
;;;
;;; COMMAND:  PORTLOCK  - lock all viewports on all layouts
;;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; c:PORTLOCK  -  main routine
;; ---------------------------------------------------------------------------
(defun c:PORTLOCK ( / *error* vars vals layout count )

    ;; -----------------------------------------------------------------------
    ;; CTAB is included here as a system variable like any other - returning
    ;; the user to their starting tab is simply part of restoring state.
    ;; -----------------------------------------------------------------------
    (setq vars '("CMDECHO" "CTAB")
          vals (mapcar 'getvar vars)
    )

    (defun PortLock:Restore ( )
        (mapcar 'setvar vars vals)
        (if (= 8 (logand 8 (getvar "UNDOCTL")))
            (command "_.UNDO" "_End")
            (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        )
        (princ)
    )

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

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (setq count 0)

    ;; -----------------------------------------------------------------------
    ;; layoutlist returns the paper space layout names only, so Model is never
    ;; visited. Each layout must be made current before -VPORTS will act on
    ;; its viewports.
    ;;
    ;; vl-catch-all-apply wraps the lock so that one awkward layout cannot
    ;; abort the whole sweep - the remaining layouts still get locked, and the
    ;; problem tab is reported at the end.
    ;; -----------------------------------------------------------------------
    (foreach layout (layoutlist)
        (setvar "CTAB" layout)
        (if (vl-catch-all-error-p
                (vl-catch-all-apply
                    'command
                    (list "_.-VPORTS" "_Lock" "_ON" "_All" "")
                )
            )
            (princ (strcat "\n  - skipped layout \"" layout "\" (no viewports to lock)"))
            (setq count (1+ count))
        )
    )

    (princ (strcat "\nViewports locked on " (itoa count)
                   " of " (itoa (length (layoutlist)))
                   " layout"
                   (if (= 1 (length (layoutlist))) "" "s")
                   "."
           )
    )

    (PortLock:Restore)
    (princ)
)

(princ)
