TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: taner on August 02, 2007, 03:31:13 AM

Title: who can rewrite these two acet functions?
Post by: taner on August 02, 2007, 03:31:13 AM
(acet-error-init args)

Error handler.

Note:
This function should be paired with (acet-error-restore) below to encapsulate error handling for LISP functions or commands that may be aborted by the user.

Arguments
args A list containing up to three elements (described below).

Arguments are provided in a list to allow for future enhancements. The list can currently be nil or can contain up to three elements:

A list containing pairs of system variable names along with an initial value for each variable, in the form:
("sysvar" value "sysvar" value ...)
The (acet-error-init) function will preserve the initial value of these variables (see (acet-error-restore) below) and then set the new values.
A flag value indicating whether UNDO should be used as part of the error handling operation. This value can be one of: nil Do not use undo.
0 Enable Undo and place begin and end marks, but do not issue the UNDO command in the event of an error.
1 Enable Undo and use the UNDO command in the event of an error.

A quoted function call that will be executed as part of the error handling operation. A nil argument indicates that no additional error handling is required.
Return Values
nil

Example
(acet-error-init '(("CMDECHO" 0)
                   1
                   (if ename (redraw ename 4)) ) )


--------------------------------------------------------------------------------

(acet-error-restore)

Reset error handling.

This function restores the values saved by the matching call to (acet-error-init). It should be called after all user input has been completed. This function ends with a (princ) call for a quiet finish.

Return Values
nil

Library: acetutil.fas

Title: Re: who can rewrite these two acet functions?
Post by: Kerry on August 02, 2007, 04:58:57 AM
Someone has to, so it may as well be me ..

Why do you want to rewrite it ?
a) It works fine as far as I know, and
b) there are probably at least half a dozen versions with similar functionality on this site alone ..

 ... but in answer to your actual question ; there are several people here who could/can rewrite it. Personally I'd need significant inducement.
Title: Re: who can rewrite these two acet functions?
Post by: JohnK on August 02, 2007, 08:04:22 AM
You can.

Take the error handle i did and add-to/alter-it to fit your needs.
Title: Re: who can rewrite these two acet functions?
Post by: CAB on August 02, 2007, 09:17:08 AM
Tanar
Welcome to the swamp.

Use the Search option at the top of this page to find the error handler codes mentioned above.
Title: Re: who can rewrite these two acet functions?
Post by: It's Alive! on August 02, 2007, 09:30:14 AM
Welcome to the swamp Taner. 
Title: Re: who can rewrite these two acet functions?
Post by: taner on August 02, 2007, 10:01:17 AM
Thanks all!

I have writen some code to put on the beginning and the end of the program as below,

I want it call the undo end if the main program have used command,otherwise,do not call undo end.
how to realize it?
Title: Re: who can rewrite these two acet functions?
Post by: JohnK on August 02, 2007, 10:09:41 AM
http://www.theswamp.org/index.php?topic=13730.0
Title: Re: who can rewrite these two acet functions?
Post by: hmspe on August 03, 2007, 12:56:27 AM
I believe these are the actual routines from the .fas files.  They're from a file that comes with a demo for a commercial program.  There's no copyright statement or use restriction in the file, and the file remains available after the demo times out.  There's no acet-ui-progress function in the lisp file.

;;Error Init for ET
(defun acet-error-init (errlist / syslist sysvar sysval)

  (setq   ET$OldErrorHandler *error*
   *error*   ET$ErrorHandler
  )
  (setq *error* '((MSG /) (ET$ErrorHandler msg)))

  (setq ET$OldSysVars NIL)
  ;; previous sysvar values for Restore
  (acet-ui-progress-done)

  (setq   ET$SysVars (car errlist)
   errlist      (cdr errlist)
  )
  (setq   ET$UndoFlag (car errlist)
   errlist       (cdr errlist)
  )
  (setq   ET$UndoCode (car errlist)
   errlist       (cdr errlist)
  )

  (setq ET$OldSysVars NIL)
  (setq ET$OldSysVars (cons (getvar "ucsicon") ET$OldSysVars))
  (setq ET$OldSysVars (cons "ucsicon" ET$OldSysVars))
  (setq syslist ET$SysVars)

  (while syslist
    (setq sysvar  (car syslist)
     syslist (cdr syslist)
    )
    (setq sysval  (car syslist)
     syslist (cdr syslist)
    )
    (if   (and sysvar sysval)
      (progn
   (setq ET$OldSysVars (cons (getvar sysvar) ET$OldSysVars))
   (setq ET$OldSysVars (cons sysvar ET$OldSysVars))
   (setvar sysvar sysval)
      )
    )
  )

  (setvar "cmdecho" 0)
  (if ET$UndoFlag
    (command "_.undo" "_begin")
  )

  ET$OldSysVars
)

;;Error Restore for ET
(defun acet-error-restore (/ sysvar sysval)
  (acet-ui-progress-done)
  (if ET$UndoFlag
    (progn
      (setvar "cmdecho" 0)
      (command "_.undo" "_end")
    )
  )
  (while ET$OldSysVars
    (setq sysvar   (car ET$OldSysVars)
     ET$OldSysVars   (cdr ET$OldSysVars)
    )
    (setq sysval   (car ET$OldSysVars)
     ET$OldSysVars   (cdr ET$OldSysVars)
    )
    (if   (and sysvar sysval)
      (setvar sysvar sysval)
    )
  )
  (setq   ET$OldSysVars NIL
   ET$SysVars NIL
   ET$UndoFlag NIL
   ET$UndoCode NIL
  )

  (if ET$OldErrorHandler
    (setq *error* ET$OldErrorHandler)
  )

  (setvar "highlight" 1)
  (setvar "cmdecho" 1)
  (princ)
)

;;done progress
(defun acet-ui-progress-done (/)
  (if ET$ProgressActive
    (setq ET$ProgressActive (acet-ui-progress))
  )
  NIL
)
Title: Re: who can rewrite these two acet functions?
Post by: taner on August 03, 2007, 02:06:17 AM
already solved.
varlst is the a list as '(("cmdecho" 0)("osmode" 512)...("clayer" "dim"))
mark,when the main program used command function,mark is set to t.otherwise nil.
Code: [Select]
(defun t2x2t (varlst mark / sysnamelst valuelst)
  (setq undo$mark mark)
  (if undo$mark
    (command "undo" "be")
  )
  (if varlst
    (setq *#$*sysvarnl*#$* (mapcar
     'car
     varlst
   )
  sysnamelst *#$*sysvarnl*#$*
  valuelst (mapcar
     'cadr
     varlst
   )
    )
  )
  (defun myerr (errmsg)
    (if (not (member errmsg '("console break" "Function Cancelled")))
      (princ (strcat "\nError: " errmsg))
    )
    (2txt2)
  )
  (setq errtmp *error*)
  (setq *error* myerr)
  (if *#$*sysvarnl*#$*
    (progn
      (setq *#$*svarl*#$* (mapcar
    'getvar
    *#$*sysvarnl*#$*
  )
      )
      (mapcar
'setvar
sysnamelst
valuelst
      )
    )
  )
  (princ)
)
(defun 2txt2 ()
  (if undo$mark
    (command ".undo" "E")
  )
  (if *#$*svarl*#$*
    (mapcar
      'setvar
      *#$*sysvarnl*#$*
      *#$*svarl*#$*
    )
  )
  (setq *error* errtmp)
  (setq *#$*sysvarnl*#$* nil
*#$*svarl*#$* nil
errtmp nil
  )
  (princ)
)
Title: Re: who can rewrite these two acet functions?
Post by: JohnK on August 03, 2007, 08:32:22 AM
The first few lines can be replaced
Code: [Select]
;;   (setq undo$mark mark)
;;   (if undo$mark
;;     (command "undo" "be")
;;   )
  (set undo$mark (if mark mark))

That is about as far as i have time to look into today.
Title: Re: who can rewrite these two acet functions?
Post by: taner on August 03, 2007, 10:45:33 AM
The first few lines can be replaced
Code: [Select]
;;   (setq undo$mark mark)
;;   (if undo$mark
;;     (command "undo" "be")
;;   )
  (set undo$mark (if mark mark))

That is about as far as i have time to look into today.

I do not understand why, could you please explain it more clearly. thanks a lot.
Title: Re: who can rewrite these two acet functions?
Post by: JohnK on August 03, 2007, 10:59:40 AM
Oops, i commented out to many lines. sorry, i was going to fast. But a quick retype will be as below.

``set'' is much the same as `setq' but it will evaluate its argument. Therefore my statement is saying, ``If mark is not nil set the variable to its value otherwise keep the var nil''.

(set 'undo$mark (if mark (progn (command "undo" "be") mark)))

Title: Re: who can rewrite these two acet functions?
Post by: JohnK on August 03, 2007, 11:09:30 AM
I looked at your code a bit more and i noticed a potential problem i think; what about the `clayer' var. you will not have a value when you ``setvar clayer''. It was a problem i noticed in my own error trap procedure i had to account for later.