;;;
;;;;;;;; General Error Handling Routines ;;;;;;;;
;;;         Written  Nov 20, 1997.
;
;************************************************************
;   Copyright Vladimir Nesterovsky 1997, All Rights Reserved
;       (some re-naming, Dec 2005 and Apr 2006)
; You may use, copy and distribute this program *unmodified*
; for any non-commercial, non-profit purpose and without
; charging any fee, if you keep this notice in its entirety
;       in all copies and in all your derived works.
;
; This program is provided "AS IS" and has absolutely
;  no warranty of any kind. Use it at your own risk.
;
; You're welcome to contact me about the possibility to use
; this program commercially, and also with any comments and
;        requests at vnestr@netvision.net.il
;************************************************************

;|      sample usage:

(defun my-func ( a1 a2 / a3 )
  (vn-errbegin)                  ;---------- start error handling
  (vn-push-sysvars  '(           ;---------- set sysvars and save old values
      ("CMDECHO" 0) ))           ;----------   to be restored automatically
  (command "._undo" "_g")
  (vn-errpush '(                 ;---------- push new action into error handler
      (command "._undo" "_e")    ;----------   to be done automatically on error
      (princ "\n Use Undo Group to go back!")  ;--- as well as on exit from the
      ))                                       ;--- function via (vn-errend) call
  (vn-push-sysvars  '(
      ("DIMZIN"  0)
      ("CLAYER"   )
      ("AUNITS"  3)
      ))
  (setq a3 (/ a1 a2))
  (vn-errend)                    ;---------- stop error handling and perform all 
  a3                             ;----------   the actions in reverse order and
  )                              ;----------   restore all the saved system variables


Global variables used:
    *vn_hookfuncs*        --  an undo list
    *vn_sysvars*          --  saved sysvars
    *vn_olderr*           --  previous error handler

Functions defined:
    vn-push               --  general utility -- push first element
    vn-pop                --  general utility -- pop first element from
    vn-errpush            --  plug into error handler
    vn-errpop             --  remove first action from error handler
    vn-errpopdo           --  pop it and DO
    vn-push-sysvars       --  change sysvar and save its value
    vn-pop-sysvars        --  restore a number of sysvars
    vn-pop-all-sysvars    --  restore all sysvars
    vn-on-error           --  a standardized error handler
    vn-errbegin           --  start error handling
    vn-errend             --  stop error handling
|;


(defun vn-push (tempval quoted_lst_sym)    ; push first element into a quoted list
  (set quoted_lst_sym
    (cons tempval (eval quoted_lst_sym))))

(defun vn-pop ( quoted_lst_sym / tempval ) ; pop first element from a quoted list and return it
  (setq tempval        (eval quoted_lst_sym))
  (set  quoted_lst_sym (cdr tempval))
  (car  tempval)) 

(defun vn-errpush ( hook_func )
  (vn-push hook_func '*vn_hookfuncs*))

(defun vn-errpop ()                        ; remove the first of the TODO list
  (vn-pop '*vn_hookfuncs*))

(defun vn-errpopdo (/ hook_func)           ; remove and DO
  (setq hook_func (vn-errpop))
  (if hook_func
    (eval (LIST (CONS 'LAMBDA
      (CONS nil hook_func))))))

(defun vn-push-sysvars (vars)              ; change sysvar and save its value
  (foreach p vars                          ; vars is (VAR [NEWVALUE]) pairs
    (vn-push
      (list (car p) (getvar (car p)))
      '*vn_sysvars*)
    (if (cadr p)
      (setvar (car p) (cadr p)))))

(defun vn-pop-sysvars  (n / vv)            ; restore a number of sysvars
  (repeat (min n (length *vn_sysvars*))    ; *vn_sysvars* stores (VAR VALUE) pairs
    (setq vv (vn-pop '*vn_sysvars*))
    (setvar (car vv) (cadr vv))))

(defun vn-pop-all-sysvars  (/ vv)          ; restore all sysvars
  (foreach vv *vn_sysvars*
    (setvar (car vv) (cadr vv)))
  (setq *vn_sysvars* nil))

(defun vn-on-error (msg)                   ; general error handling function:
  (IF (= MSG "Function cancelled")
    (PRINC MSG)
    (IF (/= MSG "quit / exit abort")
      (PRINC (STRCAT "\nError: " MSG ))))
  (vn-errend))

;; now we can define the two working functions here.
;; one is to be called near start of program, and
;; the othere -- near end:

(defun vn-errbegin ()
  (if (null *vn_olderr*)
    (setq *vn_olderr* *error*))
  (setq *error*       vn-on-error
        *vn_hookfuncs* nil)
  (princ))

(defun vn-errend ()                        ; restore previous error handler back
  (setq *error*     *vn_olderr*
        *vn_olderr*  nil)
  ;; if a program uses FD as a standard name
  ;;   for file descriptor, try close it.
  (if (= 'FILE (type fd))
    (setq fd (close fd)))
  (while *vn_hookfuncs*                    ; do all the hook functions 
    (vn-errpopdo))                         ;                   in reverse order
  (vn-pop-all-sysvars)                     ; restore all sysvars
  (princ))

;; in fact I see now that a possible improvement
;; can be to join hook_funcs with sysvars list,
;; thus making possible to restore them in exact
;; reverse order of execution, via checking the
;; argument type; right now you can achieve this
;; by direct calling of (vn-errpopdo) together
;; with (vn-pop-sysvars).

;;;;; EOF