Author Topic: GetKeysFromDCLstring  (Read 10203 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 812
GetKeysFromDCLstring
« on: November 27, 2016, 06:30:04 AM »
Hi guys,
I just wanted to share with you, this subfunction I wrote yesterday:

Code: [Select]
(defun GetKeysFromDCLstring ( DCLstring / ShiftListRightRepeat DCLstring Lst Key LstKeys flg)

(defun ShiftListRightRepeat ( n Lst / nLst )
(if (and (= 'INT (type n)) (listp Lst))
(progn
(setq nLst Lst)
(repeat n (setq nLst (append (cdr nLst) (list (car nLst)))))
)
)
nLst
); defun ShiftListRightRepeat
(if
(or
(eq 'STR (type DCLstring)) ; is a string
(and
(vl-consp DCLstring) ; is a list
(vl-every (function (lambda (x) (eq 'STR (type x)))) DCLstring) ; where each item is a string
(setq DCLstring (apply 'strcat DCLstring)) ; make it a string
); and
); or
(progn
(setq Lst (mapcar 'chr (vl-string->list DCLstring))) ; break down the string into a list of letters
(mapcar
(function
(lambda ( a b c d e f g )
(if (= "key = \"" (apply 'strcat (list a b c d e f g))) ; find the unique combination that can create "key = \"" string
(setq flg 0)
); if
(if (= flg 1)
(if (/= g "\""); start collecting the letters between \" and \" while (lambda) is iterating
(setq Key (cons g Key)) ; collect the letters into a list
(progn
(setq LstKeys (cons (apply 'strcat (reverse Key)) LstKeys)) ; collect the key into the list
(setq flg nil)
(setq Key nil)
); progn
)
); if flg
(and flg (not Key) (setq flg (1+ flg)))
); lambda
); function
Lst ; a 1
(ShiftListRightRepeat 1 Lst) ; (cdr Lst) ; b 2
(ShiftListRightRepeat 2 Lst) ; (cddr Lst) ; c 3
(ShiftListRightRepeat 3 Lst) ; (cdddr Lst) ; d 4
(ShiftListRightRepeat 4 Lst) ; (cddddr Lst) ; e 5
(ShiftListRightRepeat 5 Lst) ; (cdddddr Lst) ; f 6 ???
(ShiftListRightRepeat 6 Lst) ; (cddddddr Lst) ; g 7 ???
); mapcar
); progn
); if
(reverse LstKeys)
); defun GetKeysFromDCLstring
Example:
Code: [Select]
_$ (setq LstDCL ; keys = "case" "SelButton" "SelPrompt" "CtC" "KO" "Text"
(list
" TextTest : dialog // The folowing dialog utilises 1 toggle, 1 image_button, 2 radio_button(s), 1 edit_box"
" {"
" label = \"Edit Text\";"
" spacer;"
" : row"
" {"
" : toggle { label = \"UPPERCASE\"; key = \"case\"; alignment = left; value = 1; }"
" : image_button { key = \"SelButton\"; width = 5; color = 1; } // this color must turn to green when selection is made"
" : text { label = \"< Select object(s)\"; key = \"SelPrompt\"; fixed_width = true; }"
" }"
" : boxed_radio_row"
" {"
" label = \"Layer options\";"
" : radio_button { label = \"Change to Current\"; key = \"CtC\"; value = 1; }"
" : radio_button { label = \"Keep Original\"; key = \"KO\"; }"
" }"
" : edit_box"
" { label = \"Text\"; key = \"Text\"; value =  \"Sample Text\"; width = 12; }"
" spacer;"
" ok_cancel;"
" }"
); list
); setq LstDCL
("\tTextTest : dialog // The folowing dialog utilises 1 toggle, 1 image_button, 2 radio_button(s), 1 edit_box" "\t{" "\t\tlabel = \"Edit Text\";" "\t\tspacer;" "\t\t: row" "\t\t{" "\t\t\t: toggle { label = \"UPPERCASE\"; key = \"case\"; alignment = left; value = 1; }" "\t\t\t: image_button { key = \"SelButton\"; width = 5; color = 1; } // this color must turn to green when selection is made" "\t\t\t: text { label = \"< Select object(s)\"; key = \"SelPrompt\"; fixed_width = true; }" "\t\t}" "\t\t: boxed_radio_row" "\t\t{" "\t\t\tlabel = \"Layer options\";" "\t\t\t: radio_button { label = \"Change to Current\"; key = \"CtC\"; value = 1; }" "\t\t\t: radio_button { label = \"Keep Original\"; key = \"KO\"; }" "\t\t}" "\t\t: edit_box" "\t\t{ label = \"Text\"; key = \"Text\"; value =  \"Sample Text\"; width = 12; }" "\t\tspacer;" "\t\tok_cancel;" "\t\t}")
_$ (GetKeysFromDCLstring LstDCL)
("case" "SelButton" "SelPrompt" "CtC" "KO" "Text")
It expects string, or list of strings that contains the DCL code, and returns all the keys from it.
Hopefully it helps at your daily work. :)
« Last Edit: November 27, 2016, 06:33:10 AM by Grrr1337 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: GetKeysFromDCLstring
« Reply #1 on: December 25, 2017, 04:48:42 PM »
Okay, I'll agree: that was complicated and the approach was bad - so heres a substitute:

Code - Auto/Visual Lisp: [Select]
  1. ; Extracts the specified attribute tile's values from a DCL code, which written as a list of strings
  2. ; NOTE: the routine won't avoid any DCL comments, so don't comment attributes like // key = \"case\";
  3. (defun DCLstring->atttvals ( attt dclcode / rgx r )
  4.   (vl-catch-all-apply
  5.     (function
  6.       (lambda ( / stringp mc2 L tmp )
  7.         (setq stringp (lambda (x) (eq 'STR (type x))))
  8.         (cond
  9.           ( (not (stringp attt)) )
  10.           ( (not (and (listp dclcode) (vl-every 'stringp dclcode))) )
  11.           ( (not (setq rgx (vlax-get-or-create-object "vbscript.regexp"))) )
  12.           (
  13.             (progn
  14.               (mapcar (function (lambda (x) (apply 'vlax-put-property (cons rgx x)))) '((Global 1)(Ignorecase 1)(Multiline 1))) ; actrue = 1 | acfalse = 0
  15.               (vlax-put-property rgx 'Pattern (strcat attt "[\\s]*=[\\s]*\"[\\w\\s<>_:()]*\";" "|" attt "[\\s]*=[\\s]*\\d*;"))
  16.               (setq mc2 (vlax-invoke-method rgx 'Execute (apply 'strcat dclcode)))
  17.               (vlax-for o mc2 (setq L (cons (vlax-get-property o 'Value) L)))
  18.               nil
  19.             )
  20.           )
  21.           ( (not (setq L (reverse L))) )
  22.           (
  23.             (progn
  24.               (vlax-put-property rgx 'pattern (strcat "\"[\\w\\s<>_:()]*\"" "|" "\\d*"))
  25.               (foreach x L
  26.                 (setq mc2 (vlax-invoke-method rgx 'Execute x))
  27.                 (vlax-for o mc2 (and (setq tmp (read (vlax-get-property o 'Value))) (setq r (cons tmp r))))
  28.               ); foreach
  29.               (setq r (reverse r))
  30.             ); progn
  31.           )
  32.         ); cond
  33.       ); lambda
  34.     ); function
  35.   ); vl-catch-all-apply
  36.   (vl-catch-all-apply (function vlax-release-object) (list rgx)) r
  37. ); defun DCLstring->atttvals

So given:
Code - Auto/Visual Lisp: [Select]
  1. (setq dclcode
  2.   '(
  3.     "   TextTest : dialog // The folowing dialog utilises 1 toggle, 1 image_button, 2 radio_button(s), 1 edit_box"
  4.     "   { label = \"Edit Text\"; spacer;"
  5.     "           : row"
  6.     "           { : toggle { label = \"UPPERCASE\"; key   = \"case\"; alignment = left; value = 1; }"
  7.     "                   : image_button { key = \"SelButton\"; width = 5; color = 1; } // this color must turn to green when selection is made"
  8.     "                   : text { label = \"< Select object(s)\"; key    =     \"SelPrompt\"; fixed_width = true; }"
  9.     "           }"
  10.     "           : boxed_radio_row"
  11.     "           { label = \"Layer options\";"
  12.     "                   : radio_button { label = \"Change to Current\"; key = \"CtC\"; value = 1; }"
  13.     "                   : radio_button { label = \"Keep Original\"; key     = \"KO\"; }"
  14.     "           }"
  15.     "           : edit_box { label = \"Text\"; key=\"Text\"; value =  \"Sample Text\"; width = 12; }"
  16.     "           spacer; ok_cancel;"
  17.     "   }"
  18.   )
  19. )

then:
Code - Auto/Visual Lisp: [Select]
  1. _$ (DCLstring->atttvals "key" dclcode) >> ("case" "SelButton" "SelPrompt" "CtC" "KO" "Text")
  2. _$ (DCLstring->atttvals "label" dclcode) >> ("Edit Text" "UPPERCASE" "< Select object(s)" "Layer options" "Change to Current" "Keep Original" "Text")
  3. _$ (DCLstring->atttvals "value" dclcode) >> (1 1 "Sample Text")
  4. _$ (DCLstring->atttvals "width" dclcode) >> (5 12)

Now you might ask me where do I use this:
Usually when I'm writing dialogs that use array of tiles, and also generating a set of keys - I often need to construct a list of these keys in order to set default actions.
Previously I was collecting them, while assembling the DCL-code list of strings. Or in other cases I'm just lazy to manually write them.
Well if you have seen some DCL codes I posted previously you'll understand (although I'm not ready yet to provide a pracitcal example with that subfoo [laziness reasons]).

Thank you for your attention and happy holidays!  :grinwink:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg