;;; 글자 앞뒤 붙이기·바꾸기 - TORVA 무료 리습 (torva.kr/lisp.html)
;;; TXP : 고른 글자 앞에 붙이기        (B1 -> 2B1)
;;; TXS : 고른 글자 뒤에 붙이기        (G1 -> G1A)
;;; TXF : 앞 글자 바꾸기. 입력한 글자 수만큼 앞을 바꾼다 (2G1 -> 3G1 : 3 입력)
;;; TXR : 찾아 바꾸기. 바꿀 글자를 비우면 지운다
;;; TEXT, MTEXT 대상. 잠긴 레이어는 건드리지 않는다. 한 번의 U 로 되돌린다

(vl-load-com)

;; 글자 전부 바꾸기 - 새 글자에 옛 글자가 들어 있어도 끝난다
(defun tv-te-replace (s old new / i)
  (setq i 0)
  (while (setq i (vl-string-search old s i))
    (setq s (strcat (substr s 1 i) new (substr s (+ i 1 (strlen old))))
          i (+ i (strlen new))))
  s)

;; 공통 - 글자를 고르고 fn 으로 바꾼다
(defun tv-te-apply (fn / *error* old ss i ed n)
  (setq old *error*)
  (defun *error* (msg)
    (command "_.UNDO" "_E")
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\n오류: " msg)))
    (princ))
  (setq ss (cond ((ssget "_I" '((0 . "TEXT,MTEXT"))))
                 (T (prompt "\n바꿀 글자 선택: ") (ssget ":L" '((0 . "TEXT,MTEXT"))))))
  (sssetfirst nil nil)
  (if ss
    (progn
      (command "_.UNDO" "_BE")
      (setq i 0 n 0)
      (repeat (sslength ss)
        (setq ed (entget (ssname ss i)) i (1+ i))
        (if (entmod (subst (cons 1 (apply fn (list (cdr (assoc 1 ed))))) (assoc 1 ed) ed)) (setq n (1+ n))))
      (command "_.UNDO" "_E")
      (princ (strcat "\n글자 " (itoa n) "개 바꿈"))))
  (setq *error* old)
  (princ))

(defun c:TXP (/ a)
  (if (/= "" (setq a (getstring T "\n앞에 붙일 글자: ")))
    (tv-te-apply '(lambda (s) (strcat a s))))
  (princ))

(defun c:TXS (/ a)
  (if (/= "" (setq a (getstring T "\n뒤에 붙일 글자: ")))
    (tv-te-apply '(lambda (s) (strcat s a))))
  (princ))

(defun c:TXF (/ a)
  (if (/= "" (setq a (getstring T "\n앞을 바꿀 새 글자 (글자 수만큼 바뀐다): ")))
    (tv-te-apply '(lambda (s) (strcat a (substr s (1+ (strlen a)))))))
  (princ))

(defun c:TXR (/ a b)
  (if (/= "" (setq a (getstring T "\n찾을 글자: ")))
    (progn
      (setq b (getstring T (strcat "\n" a " 를 바꿀 글자 (엔터 = 지우기): ")))
      (tv-te-apply '(lambda (s) (tv-te-replace s a b)))))
  (princ))

(princ "\n글자 붙이기·바꾸기: TXP (앞) / TXS (뒤) / TXF (앞 바꾸기) / TXR (찾아 바꾸기) / torva.kr")
(princ)

;;; ---- 단축키 바꾸기 (TVKEY) - TORVA 리습 공통, torva.kr/lisp-guide.html ----
;;; TVKEY -> 명령 -> 새 단축키. 원래 명령어도 그대로 쓴다
;;; 정한 단축키는 이 PC 에 TORVA-KEYS 로 저장되고, 리습을 불러올 때마다 되살아난다
;;; (TORVA 리습 파일마다 같은 코드가 들어 있다. 여러 개를 불러와도 같은 정의를 덮어쓸 뿐이다)

;; "A1=PY;B2=CN;" -> (("A1" . "PY") ("B2" . "CN"))
(defun tv-key-list (/ s i out)
  (setq s (cond ((getenv "TORVA-KEYS")) ("")) out nil)
  (while (setq i (vl-string-search ";" s))
    (setq out (cons (substr s 1 i) out) s (substr s (+ i 2))))
  (if (/= s "") (setq out (cons s out)))
  (vl-remove nil
    (mapcar '(lambda (x / j) (if (setq j (vl-string-search "=" x)) (cons (substr x 1 j) (substr x (+ j 2)))))
            (reverse out))))

(defun tv-key-save (lst)
  (setenv "TORVA-KEYS" (apply 'strcat (mapcar '(lambda (p) (strcat (car p) "=" (cdr p) ";")) lst))))

;; 불러온 리습 명령인가
(defun tv-key-cmd-p (cmd)
  (member (type (eval (read (strcat "C:" cmd)))) '(SUBR USUBR EXRXSUBR)))

(defun tv-key-def (key cmd)
  (eval (list 'defun (read (strcat "C:" key)) '() (list (read (strcat "C:" cmd))) '(princ))))

;; acad.pgp 에 같은 별칭이 있나 ("L,   *LINE")
(defun tv-key-pgp-p (key / f h l hit)
  (if (setq f (findfile "acad.pgp"))
    (progn
      (setq h (open f "r"))
      (while (and (not hit) (setq l (read-line h)))
        (if (and (not (wcmatch l ";*")) (wcmatch (strcase l) (strcat key ",*"))) (setq hit T)))
      (close h)))
  hit)

;; 쓸 수 없는 단축키면 까닭을, 쓸 수 있으면 nil
(defun tv-key-bad (key lst)
  (cond
    ((not (vl-every '(lambda (c) (or (<= 48 c 57) (<= 65 c 90))) (vl-string->list key))) "영문과 숫자만 씁니다")
    ((getcname key) "AutoCAD 명령과 같은 이름입니다")
    ((tv-key-pgp-p key) "AutoCAD 단축키(acad.pgp)와 같은 이름입니다")
    ((and (tv-key-cmd-p key) (not (assoc key lst))) "이미 있는 리습 명령입니다")))

(defun c:TVKEY (/ cmd key lst why)
  (setq lst (tv-key-list)
        cmd (strcase (getstring "\n단축키를 붙일 명령 [목록(?)]: ")))
  (cond
    ((= cmd ""))
    ((= cmd "?")
     (if lst
       (foreach p lst (princ (strcat "\n  " (car p) " = " (cdr p))))
       (princ "\n정한 단축키가 없습니다")))
    ((not (tv-key-cmd-p cmd)) (princ (strcat "\n" cmd " 는 불러온 리습 명령이 아닙니다")))
    (T
     (setq key (strcase (getstring (strcat "\n" cmd " 의 새 단축키 [지우기(-)]: "))))
     (cond
       ((= key ""))
       ((= key "-")
        (foreach p lst
          (if (= (cdr p) cmd) (set (read (strcat "C:" (car p))) nil)))
        (tv-key-save (vl-remove-if '(lambda (p) (= (cdr p) cmd)) lst))
        (princ (strcat "\n" cmd " 의 단축키를 지웠습니다")))
       ((= key cmd))
       ((setq why (tv-key-bad key lst)) (princ (strcat "\n" key ": " why)))
       (T
        (tv-key-save (cons (cons key cmd) (vl-remove-if '(lambda (p) (= (car p) key)) lst)))
        (tv-key-def key cmd)
        (princ (strcat "\n이제 " key " 로도 " cmd " 가 실행됩니다"))))))
  (princ))

;; 불러올 때 - 저장된 단축키 중 명령이 불러와져 있는 것을 되살린다
(foreach p (tv-key-list)
  (if (tv-key-cmd-p (cdr p)) (tv-key-def (car p) (cdr p))))
(princ "\n단축키 바꾸기: TVKEY")
(princ)