RLX - DIP (Dynamic Input)

[rlx]

Still working on monster project , maybe not 24/7 but 12/7 comes pretty close 

 

IT must hate me because old document control program was suddenly shut down , long live the new program , yeah 

oh dear...  , new program is action based , sounds nice but sadly... well save that for another time. Anyways , it has been decided that button  open document' is too dangerous from now on. So now we can check out document but have to search and open it by hand.

To speed things up tried to find a faster way and decided to lay & hatch another egg.

 

Dynamic Input (DIP) works like auto-complete when typing something in google. It doesn't use an edit_box but works kinda like grread but for dcl.

I have included little test function (c:t1) .

Just load my egg , euh , program and start typing something like "ansi" and see what happens (hopefully)

Just one limitation , you cant use tab , space or enter which are used by dcl itself. So if you need a space type ' (quote character)

Well even though its weekend , its back to work for me , I feel like a freeking cinderella pfff

 

 

p.s. if any bugs please go via forum and don't PM me because have no time for private mail

p.s.s input is a list and output is a list. What you do with this list is your own thing.
 

;;; DIP - Dynamic Input , Rlx Sep'23
;;; sort of (grread) for dcl with exception for space, tab & enter which are reserved by dcl
;;; haven't (yet) found a way to catch character for space.
;;; So gonna use ' (quote) for space, not ideal but it is what it is

(vl-load-com)

(defun dip ( %lst  / dip-list dip-width key-lst imb-str capslock bksp bksl qmrk
                     eb-txt f p d r ib dialog-list drv lb-sel return-list)
  (setq dip-list %lst)
  ;;; make sure all elements are strings
  (setq dip-list (mapcar 'vl-princ-to-string dip-list))
  ;;; find length of longest member
  (setq dip-width (car (vl-sort (mapcar 'strlen dip-list) '>)))
  ;;; create key codes
  (setq key-lst
    (vl-remove-if '(lambda (x)(member x '(34 92))) (append (gnum 33 95) (gnum 123 125))))
  (setq imb-str
    ":image_button {color=dialog_background;width=0.1;height=0.1;fixed_height=true;key=\"ib_")
  ;;; see if acet-sys-keystate function is available
  (setq capslock (member 'acet-sys-keystate (atoms-family 0)) eb-txt ""
        bksp (strcat ":image_button {color=dialog_background;width=0.1;height=0.1;"
                     "fixed_height=true;key=\"ib_bksp\";label=\"&\010\";}")
        bksl (strcat ":image_button {mnemonic=\"\\\\\";color=dialog_background;width=0.1;"
                     "height=0.1;fixed_height=true;key=\"ib_bksl\";label=\"&\\\\\";}")
        qmrk (strcat ":image_button {mnemonic=\"\\\"\";color=dialog_background;width=0.1;"
                     "height=0.1;fixed_height=true;key=\"ib_qmrk\";label=\"&\\\"\";}")
  )
  
  (and
    (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w"))
    
    (mapcar '(lambda (x) (write-line x p))
      (append
        (list "dip:dialog {label=\"DIP - Dynamic Input (Rlx Sep'23)\";:row {")
        (crim) (list bksp bksl qmrk "}")
        (list ":image_button {color=141;height=1;fixed_height=true;key=\"ib_ib\";}"
              ":text_part {key=\"tp\";height=1;width=40;}" )
        (list (strcat ":list_box {height=25;width=" (itoa (fix (* dip-width 0.75)))
                      ";key=\"lb\";multiple_select=true;}") "ok_cancel;" "}") ) )
    
    (not (setq p (close p))) (< 0 (setq d (load_dialog f))) (new_dialog "dip" d)
    (progn
      (upd_lbox)
      (action_tile "ib_bksp" "(upd_txtp $key)") (action_tile "ib_bksl" "(upd_txtp $key)")
      (action_tile "ib_qmrk" "(upd_txtp $key)") (stim) (action_tile "lb" "(setq lb-sel $value)")
      (action_tile "accept"  "(done_dialog 1)") (action_tile "cancel"  "(done_dialog 0)")
      (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f)
    )
  )
  (cond
    ((= drv 0))
    ((= drv 1)
     (cond
       ((and (boundp lb-sel) (vl-consp dialog-list))
        (setq return-list (mapcar '(lambda (x)(nth (atoi x) dialog-list)) (SplitStr lb-sel ""))))
       ((vl-consp dialog-list) (setq return-list dialog-list)) (t (setq return-list nil)) ) )
    (t (setq return-list nil))
  )
  return-list
)


;;; create image_buttons : (setq lst (gimb)) 
(defun crim  ()
  (mapcar '(lambda (x)(strcat imb-str (chr x) "\";label=\"&" (chr x) "\";}")) key-lst))
;;; start image_buttons
(defun stim ()
  (foreach x key-lst (action_tile (strcat "ib_" (chr x)) "(upd_txtp $key)")))

;;; update edit_box , k = key (ib_$)
(defun upd_txtp ( k / s l)
  (cond
    ;;; backspace
    ((and (eq k "ib_bksp") (> (setq l (strlen eb-txt)) 1))
     (setq eb-txt (substr eb-txt 1 (1- l))))
    ;;; backslash
    ((eq k "ib_bksl") (setq eb-txt (strcat eb-txt "\\")))
    ;;; quotation mark
    ((eq k "ib_qmrk") (setq eb-txt (strcat eb-txt "\"")))
    ;;; use ' for space
    ((eq k "ib_'") (setq eb-txt (strcat eb-txt " ")))
    (t (setq eb-txt (strcat eb-txt (case (substr k 4)))))
  )
  (if (wcmatch (strcase eb-txt t) "*bksp")(setq eb-txt ""))
  (start_image "ib_ib")
    (fill_image 0 0 (dimx_tile "ib_ib") (dimy_tile "ib_ib") 141)
  (end_image)
  (set_tile "ib_ib" eb-txt)
  (mode_tile k 2)
  (upd_lbox)
)

(defun upd_lbox ( / filter)
  (if (not (vl-consp dip-list)) (setq dip-list '("void")))
  (cond
    ((= eb-txt "") (setq dialog-list dip-list))
    (t
     (setq filter (strcat "*" eb-txt "*"))
     (setq dialog-list
       (vl-remove-if-not '(lambda (x)(wcmatch (strcase x) (strcase filter))) dip-list))
    )
  )
  (start_list "lb") (mapcar 'add_list dialog-list) (end_list)
  (set_tile "tp" (strcat " selected " (itoa (length dialog-list)) " of " (itoa (length dip-list))))
)

;;; helper functions

;;; determine status caps lock for when typing filter (even though filter uses strcase)
(defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "")
  ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s)))))

;;; generate number (gnum 1 5) -> '(1 2 3 4 5)
(defun gnum (s e / i l)
  (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l))

; (SplitStr "a,b" ",") -> ("a" "b")
(defun SplitStr (s d / p)
  (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s)))

;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil)
(defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d)))
  (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e)))
    (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1))))))
      (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1))))

;;; test function
(defun c:t1 ()
  (setq lst (dip (alf (car (fnsplitl (findfile "acad.exe"))) "*.dwg" t))))

 

Edited September 30, 2023 by rlx

[Steven P]

Nice - I was wanting to make up something similar - when I get chance - to search through a list - I think you've saved me a lot of thinking, thanks!!

[rlx]

in times of stress humans get creative , so do dragons haha

[BIGAL]

Another your IT may not like. Is use Everything, its free indexes your hard drive what Windows Explore should do not take 10 minutes. If you keep the database up to date run say twice a day its instant reponse. I indexed like 3 Tb drive pretty amazing to find something.

 

Double click

Edited October 1, 2023 by BIGAL

[rlx]

Thanx for reminding me again to this program Bigal but I can't install anything on work computer.

PC (laptop) is scanned continuously, it sounds like a vacuum cleaner because of all the scanning going on. 

AutoCad (cloud based) crashes a few times a day , I suspect due to this scanning because most cpu time is used up by this process.

I only find comfort in the fact all my colleagues suffer with me haha

[Steven P]

"I only find comfort in the fact all my colleagues suffer with me haha"

Yup!! We have a wellbeing system, one of the criteria is to talk to a colleague who is stressed. I make it my mission that they are all stressed at some point of the conversation. Make all my colleagues suffer with me

[troggarf]

This has become the most true statement I have come across in all of my days on any forum.

("I only find comfort in the fact all my colleagues suffer with me haha")

Way to go RLX, you summarized our lives and explained many of our troubles so succinctly.

If only others would realize that we too struggle with the same things on a daily basis, the CAD-world would be a little bit more gracious...

[my vote for post of the year]

 

~Greg

[SLW210]

On 10/1/2023 at 4:24 AM, rlx said:

Thanx for reminding me again to this program Bigal but I can't install anything on work computer.

PC (laptop) is scanned continuously, it sounds like a vacuum cleaner because of all the scanning going on. 

AutoCad (cloud based) crashes a few times a day , I suspect due to this scanning because most cpu time is used up by this process.

I only find comfort in the fact all my colleagues suffer with me haha

IIRC, "Everything" can be run from a thumb drive.

 

Unfortunately, most of my coworkers are not suffering along with me, or at least to the extent I do. I am the only actual CAD person, though a few have AutoCAD.

 

I have to take a lot of work home to get done.

[rlx]

I like the way you're thinking SLW210 but unfortunately IT has a big sign in their office / building : You name it , we block it

[dexus]

Nice work rlx!

 

I was making something very similar to this. It also filtered a list using the hidden buttons en the mnemonics.

But I never realised that backspace could be a mnemonic .

So mine worked with a timer, you can search when you type, but the filter is cleared when you wait for more than a second.

Kind of like the Windows explorer quicksearch.

The big disadvantage is that there is no feedback of the clearing until you start typing again.

Thanks for the backspace insight!

 

I did manage to get spacebar working though.

What I did is I made a button with the key="hiddenspacebar".

Made sure its focussed at the start with (mode_tile "hiddenspacebar" 2).

Of course (action_tile "hiddenspacebar" "(upd_txtp \" \")") so it adds a spacebar to the filter.

And at the end of upd_txtp you focus this button again with (mode_tile "hiddenspacebar" 2).

 

This way it is always the default button which is triggered with spacebar and it adds a spacebar, instead of adding the last key again like yours does at the moment.

[dexus]

I've updated the version I was putting together with code from your dynamic input function.

Mine was mostly based on Filter List Box from Lee Mac.

 

(defun keyfilterlistbox ( msg lst mtp / _addlist _gnum _quicksearch dch dcl des rtn sel tmp pressed key-lst1 key-lst2 LM:escapewildcards stringp)

  ;; Filter List Box with key input
  ;;
  ;; Combined code from:
  ;;   Filtered List Box      - Lee Mac    http://www.lee-mac.com/filtlistbox.html
  ;;   Dynamic Input          - rlx        https://www.cadtutor.net/forum/topic/78410-rlx-dip-dynamic-input
  ;;   Escape Wildcards       - Lee Mac    http://www.lee-mac.com/escapewildcards.html
  ;;   Putting it together    - dexus      https://www.cadtutor.net/forum/topic/78410-rlx-dip-dynamic-input/#comment-626261
  ;;
  ;; Displays a list box interface from which the user may select one or more items.
  ;; Includes a filter when the user types to enable the user to filter the displayed list of items.
  ;; msg - [str] List box dialog title
  ;; lst - [lst] List of strings to display in the list box
  ;; mtp - [bol] T=Allow multiple items; nil=Single item selection
  ;; Returns: [lst] List of selected items, else nil
 
  (defun _addlist ( key lst ) ; By Lee Mac
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
  )

  ;; generate number (_gnum 1 5) -> '(1 2 3 4 5) by rlx
  (defun _gnum (s e / i l)
    (and
      (numberp s)
      (numberp e)
      (setq i s)
      (while (<= i e)
        (setq l (cons i l)
              i (1+ i))
      )
    )
    (reverse l)
  )

  (defun _quicksearch (key)
    (setq pressed
            (cond
              ((stringp pressed)
                (if (= key "bksp")
                  (substr pressed 1 (1- (strlen pressed)))
                  (strcat pressed key)
                )
              )
              ((= key "bksp") "")
              (key)
            )
          flt (strcat (LM:escapewildcards (strcase pressed)) "*")
          sel (if tmp (mapcar (function (lambda ( n ) (nth n tmp))) (read (strcat "(" rtn ")")))))
    (_addlist "lst" (setq tmp (vl-remove-if-not (function (lambda ( x ) (wcmatch (strcase x) flt))) lst)))
    (set_tile "lst"
      (setq rtn
        (vl-string-trim "()"
          (vl-princ-to-string
            (cond
              ((vl-sort (vl-remove nil (mapcar (function (lambda ( x ) (vl-position x tmp))) sel)) '<))
              ('(0))
            )
          )
        )
      )
    )
    (set_tile "text" (strcat "Filter: " pressed))
    (mode_tile "hidden_space" 2)
  )
  
  ;; Check of variable een string is
  (defun stringp (str)
    (= (type str) 'str)
  )

  ;; Escape Wildcards  -  Lee Mac
  ;; Escapes wildcard special characters in a supplied string
  (defun LM:escapewildcards ( str )
      (if (wcmatch str "*[-#@.*?~`[`,]*,*`]*")
          (if (wcmatch str "[-#@.*?~`[`,]*,`]*")
              (strcat "`" (substr str 1 1) (LM:escapewildcards (substr str 2)))
              (strcat     (substr str 1 1) (LM:escapewildcards (substr str 2)))
          )
          str
      )
  )

  (if
    (and
      (setq dcl (vl-filename-mktemp nil nil ".dcl"))
      (setq des (open dcl "w"))
      (setq key-lst1 (vl-remove 34 (_gnum 33 67))) ; create key codes
      (setq key-lst2 (vl-remove 92 (append (_gnum 68 95) (_gnum 123 125))))
      (write-line
          (strcat
              "hidden:image_button{"
              "  width=0.1;"
              "  height=0.1;"
              "  fixed_width=true;"
              "  boxed=false;"
              "  allow_accept=true;"
              "  color=-15;"
              "}"
              "keyfiltlistbox:dialog { label = \"" msg "\"; spacer;"
              ": list_box { key = \"lst\"; width = 50; fixed_width = true; height = 15; fixed_height = true; allow_accept = true; "
              "  multiple_select = " (if mtp "true" "false") "; }"
              "  :row{alignment=centered;"
              "    :text{fixed_width_font=true;width=30;height=1.2;key=\"text\";label=\"Filter:\";}"
              "  }"
              "  :row{"
              (apply 'strcat
                (mapcar ; Eerste gedeelte van filter knoppen
                  (function (lambda (n) (strcat ":hidden{key = \"hidden" (chr n) "\"; label = \"&" (chr n) "\";}")))
                  key-lst1
                )
              )
              "  }"
              "ok_cancel;"
              "  :row{"
              (apply 'strcat
                (mapcar ; Tweede gedeelte van filter knoppen
                  (function (lambda (n) (strcat ":hidden{key = \"hidden" (chr n) "\"; label = \"&" (chr n) "\";}")))
                  key-lst2
                )
              )
              "    :hidden {key=\"hidden_space\";}"
              "    :hidden {label=\"&\010\";key=\"hidden_bksp\";}"
              "    :hidden {label=\"&\\\\\";mnemonic=\"\\\\\";key=\"hidden_bksl\";}"
              "    :hidden {label=\"&\\\"\";mnemonic=\"\\\"\";key=\"hidden_qmrk\";}"
              "  }"
              "}"
          )
          des
      )
      (not (close des))
      (< 0 (setq dch (load_dialog dcl)))
      (new_dialog "keyfiltlistbox" dch)
    )
    (progn
      (_addlist "lst" (setq tmp lst))
      (set_tile "lst" (setq rtn "0"))
      (setq pressed "")
      (foreach n (append key-lst1 key-lst2)
        (action_tile (strcat "hidden" (chr n)) (strcat "(_quicksearch \"" (chr n) "\")"))
      )
      (action_tile "hidden_bksp" "(_quicksearch \"bksp\")")
      (action_tile "hidden_bksl" "(_quicksearch \"\\\\\")")
      (action_tile "hidden_qmrk" "(_quicksearch \"\\\"\")")
      (action_tile "hidden_space" "(_quicksearch \" \")")
      (mode_tile "hidden_space" 2)

      (set_tile "flt" "*")
      (action_tile "lst" "(setq rtn $value)")
      (action_tile "flt"
        (vl-prin1-to-string
         '(progn
            (setq flt (strcat "*" (LM:escapewildcards (strcase $value)) "*")
                  sel (mapcar (function (lambda ( n ) (nth n tmp))) (read (strcat "(" rtn ")"))))
            (_addlist "lst" (setq tmp (vl-remove-if-not (function (lambda ( x ) (wcmatch (strcase x) flt))) lst)))
            (set_tile "lst"
              (setq rtn
                (vl-string-trim "()"
                  (vl-princ-to-string
                    (cond
                      ((vl-sort (vl-remove nil (mapcar (function (lambda ( x ) (vl-position x tmp))) sel)) '<))
                      ('(0))
                    )
                  )
                )
              )
            )
          )
        )
      )
      (mode_tile "flt" 2) ; Select filter box
      (setq rtn
        (if (and (= 1 (start_dialog)) tmp)
          (mapcar (function (lambda ( x ) (nth x tmp))) (read (strcat "(" rtn ")")))
        )
      )
    )
  )
  (if (< 0 dch)
    (setq dch (unload_dialog dch))
  )
  (if (and (= 'str (type dcl)) (findfile dcl))
    (vl-file-delete dcl)
  )
  rtn
)

(defun c:ll (/ lst def lay)
  ;; Change layer - dexus
  ;; Example program for Filter List Box with key input
  (while (setq def (tblnext "layer" (not def)))
    (setq lst (cons (cdr (assoc 2 def)) lst))
  )
  (if (setq lay (car (keyfilterlistbox "Select a Layer" (acad_strlsort lst) t)))
    (progn
      (setvar 'clayer lay)
      (princ (strcat "\nChosen layer: " lay))
    )
  )
  (princ)
)

Edited December 15, 2023 by dexus
Added LM:escapewildcards for correct wcmatch and adden missing stringp function.

[rlx]

I had started to work on kinda getfolder with options , including dynamic input , but added to many options to fast and code at this moment is in a sorry state (I messed it up). But haven't been able to do any lisp for the last couple of months , maybe next year I'll have (hopefully in a positve way) more time.

 

 

[dexus]

Hope you will get it working, looks very promising!

I'm trying to add dynamic input to all of my dcl listboxes, it feels quicker than clicking all the time.

 

Ps. Geweldige naam trouwens