Selecting text from a pop-up window and pasting it on the screen

[bery35]

Hello, I have a lisp code that I have been working on and I have brought it to a certain stage. However, I am having a problem at one point.
In this lisp code, I have a product list with my purpose defined. When the code runs, my product list is listed in the pop-up window. And I choose what I want and paste it to the places I specify on the screen. However, my product list can be up to 500 items, so I created a search button in the popup window. The button works, but it is based on the line number I choose, not the product name I choose, and it writes the product on this line number in the general list to the screen. I need support on how to overcome this problem.

main command
(defun C:prdef (/ dcl_id product_list product filter_list pt index)
  (create-layer "00-Equipment List" 3) ; Number 3 is used for green color
  (setq product_list '("Product-1" "Product-2" "Product-3" "Product-4" "Product-5" "Product-6" "Product-7" "Product-8" "Product-9" "Product-10" "Product-11" "Product-12" "Product-13" "Product-14"))
  (setq dcl_id (load_dialog "product_select.dcl"))
  (if (not (new_dialog "product_select" dcl_id))
    (exit)
  )
  (start_list "product_list")
  (mapcar 'add_list product_list)
  (end_list)
  (action_tile "search_box" "(progn (setq filter_text $value) (update_list filter_text))")
  (action_tile "product_list" "(setq product (nth (atoi $value) product_list))") ; 
  (action_tile "ok" "(done_dialog)")
  (action_tile "search_button" "(update_list filter_text)") ; 
  (start_dialog)
  (unload_dialog dcl_id)
  (initget 1)
  (while (setq pt (getpoint "\nChoose a location (exit with ESC): "))
    (setq index (atoi product)) ; 
    (command "_.-layer" "_S" "00-Equipment List" "") ; 
    (command "_.text" pt default-text-height 0 product) ; 
    (command "_.-layer" "_S" "0" "") ; 
  )
)

; List update function
(defun update_list (filter_text / filtered_list)
  (setq filtered_list
    (if (= filter_text "")
      product_list
      (vl-remove-if-not
        '(lambda (x) (vl-string-search (strcase filter_text) (strcase x)))
        product_list
      )
    )
  )
  (start_list "product_list")
  (mapcar 'add_list filtered_list)
  (end_list)
  (set_tile "product_list" "")
)

In my dcl code as follows

product_select : dialog {
  label = "Product Select";
  : edit_box {
    key = "search_box";
    label = "search";
    width = 40;
  }
  : button {
    key = "search_button";
    label = "search";
    is_default = true;
  }
  : list_box {
    key = "product_list";
    multiple_select = false;
    fixed_width = true;
    width = 40;
  }
  ok_cancel;
}

 

Edited March 16 by bery35
about code

[rlx]

maybe :

(defun C:prdef (/ default-text-height product_list rtn product)
  (defun create-layer (s c)(command "-layer" "make" s "col" c s ""))
  (setq default-text-height 2.5)
  (create-layer "00-Equipment List" 3) ; Number 3 is used for green color
  (setq product_list '("Product-1" "Product-2" "Product-3" "Product-4" "Product-5" "Product-6" "Product-7"
                       "Product-8" "Product-9" "Product-10" "Product-11" "Product-12" "Product-13" "Product-14"))
  (if (setq rtn (dip product_list))
    (progn
      (setq product (car rtn))
      (initget 1)
      (while (setq pt (getpoint "\nChoose a location (exit with ENTER): "))
        (command "_.-layer" "_S" "00-Equipment List" "")
        (command "_.text" pt default-text-height 0 product)
        (command "_.-layer" "_S" "0" "")
      )
    )
  )
)

;;; 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)")
      ;;; test  (action_tile "lb" "(setq lb-sel $value)(alert (strcat \"v = \" $value \" r = \" (itoa $reason)))")
      (action_tile "lb" "(setq lb-sel $value)(done_dialog 1)")
      (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 (eq lb-sel nil) (vl-consp dialog-list))
        (setq return-list (list (nth 0 dialog-list))))
       ((and (distof lb-sel)(vl-consp dialog-list))
        (setq return-list (list (nth (atoi lb-sel) dialog-list))))
       ((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))))


;;; multiple remove from list (mrfl  '(1 2 3 4) '(1 2))
(defun mrfl (l r) (vl-remove-if '(lambda (x)(member x r)) l))
(defun rfl (r l / i)(setq i -1)(vl-remove-if '(lambda (x)(member (setq i (1+ i)) r)) l))

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

(defun c:t2 ()
  (setq lst (dip (alf "c:/temp/lisp" "*.dwg" t))))

 

just start typing , for example type 1 and only items which contain 1 will be listed , you can now click on product 12 or type 2 to make 12 and so the rest is filtered out.

 

Edited March 16 by rlx
added option to use enter when list has only 1 item left

[bery35]

Hi rlx, I ran the code. First of all, my layer color was not turning green, thank you for fixing it.

 

I ran the code and it works as I wanted, but the "ok" button in the window has no function and goes into the mode of pasting the line I select directly to the screen. Can you help me to make the "ok" button work?

 

Another issue is that my product names may consist of 5-6 words. Do you have the opportunity to make a revision so that the lines containing the word I wrote in the search section are listed? In this case, I need to put "*" at the beginning and end of the word I am looking for.

 

 

[rlx]

I changed my original code a little to be able to click on list box so selected item can directly be used , like type 1 + 2 + enter. Therefore ok button indeed has no function at this moment. I think it returns a list of all items left in listbox. But that was not part of your request.

 

Not sure what what you mean by your second question because you can type any word and only items containing this word should be listed so you dont need * , just feed your list to the beast and start typing.

 

At this moment I'm working on dynamic input's big brother. Hope to have it ready before monday when a six week long freaking big turnaround is starting so gonna work on that now.

[bery35]

 

 

Actually, the "ok" button would prevent me from exiting the window if I accidentally made a selection while browsing through a long list.

 

For example, I shared a video. When I typed "p", all products should have appeared. I had to see the whole list up to the word "product-", but it was not listed. But if I put "*" it is listed.  

 

I wish you success in your ongoing work.

 

[rlx]

actually this doesn't happen with me , when i type only p the list is still complete , but then I don't click on the bar first , I load app and don't click on anything

feel free to mess up the code to fit your need , by looking at your code I 'm confident your not a rooky , good luck

 

[bery35]

Thank you for your help and generous sharing of your knowledge, I am attaching the final version of the code and it is working.
I wish you good work.

(setq *default-text-height* 8)

(defun C:prdef (/ product_list rtn product)
  (defun create-layer (s c)(command "-layer" "make" s "col" c s ""))
  (create-layer "00-Equipment List" 3) ; Number 3 is used for green color
  (setq product_list '("Product-1" "Product-2" "Product-3" "Product-4" "Product-5" "Product-6" "Product-7"
                       "Product-8" "Product-9" "Product-10" "Product-11" "Product-12" "Product-13" "Product-14"))
  (if (setq rtn (dip product_list))
    (progn
      (setq product (car rtn))
      (initget 1)
      (while (setq pt (getpoint "\nChoose a location (exit with ENTER): "))
        (command "_.-layer" "_S" "00-Equipment List" "")
        (command "_.text" pt *default-text-height* 0 product)
        (command "_.-layer" "_S" "0" "")
      )
    )
  )
)

(defun C:prdef-setting (/ new-height)
  (setq new-height (getreal (strcat "\nCurrent height is " (rtos *default-text-height*) ". Enter new height: ")))
  (if new-height
    (setq *default-text-height* new-height)
  )
  (princ (strcat "\nNew default text height is set to " (rtos *default-text-height*)))
)

;;; 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)") ; OK butonu için eylem tanımlaması
   (action_tile "cancel" "(done_dialog 0)") ; İptal butonu için eylem tanımlaması
   (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f)
  )
 )

  (cond
    ((= drv 0))
    ((= drv 1)
     (cond
       ((and (eq lb-sel nil) (vl-consp dialog-list))
        (setq return-list (list (nth 0 dialog-list))))
       ((and (distof lb-sel)(vl-consp dialog-list))
        (setq return-list (list (nth (atoi lb-sel) dialog-list))))
       ((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 "*")) ; Add wildcard characters to the filter
     (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))))


;;; multiple remove from list (mrfl  '(1 2 3 4) '(1 2))
(defun mrfl (l r) (vl-remove-if '(lambda (x)(member x r)) l))
(defun rfl (r l / i)(setq i -1)(vl-remove-if '(lambda (x)(member (setq i (1+ i)) r)) l))

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

(defun c:t2 ()
  (setq lst (dip (alf "c:/temp/lisp" "*.dwg" t))))