; Next available MSG number is    33 
; MODULE_ID DDRENAME_LSP_
;;;----------------------------------------------------------------------------
;;;
;;;   DDRENAME.LSP   Version 0.5
;;;
;;;   (C) Copyright 1991-1994 by Autodesk, Inc.
;;;      
;;;   Permission to use, copy, modify, and distribute this software 
;;;   for any purpose and without fee is hereby granted, provided 
;;;   that the above copyright notice appears in all copies and that 
;;;   both that copyright notice and this permission notice appear in 
;;;   all supporting documentation.
;;;      
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;   
;;;----------------------------------------------------------------------------
;;;  DESCRIPTION
;;;
;;;  An AutoLISP implementation of the AutoCAD command RENAME with a dialogue 
;;;  interface.  Unlike its command counterpart, DDRENAME supports wildcard
;;;  matching (* and ?), requested particularly by users for manipulating
;;;  bound Xref symbol table items (aka named objects) with long names. 
;;;  
;;;  DESIGN OUTLINE
;;;  
;;;  For each table selected, a list is generated of items in that table.
;;;  Renamed items are substituted into the list and on OK this new list
;;;  is compared to the original list and differing items are put through
;;;  the AutoCAD rename command. 
;;; 
;;;----------------------------------------------------------------------------
;;;   Prefixes in command and keyword strings: 
;;;      "."  specifies the built-in AutoCAD command in case it has been        
;;;           redefined.
;;;      "_"  denotes an AutoCAD command or keyword in the native language
;;;           version, English.
;;;----------------------------------------------------------------------------
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " Application error: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DDRENAME"
                  (strcat "Can't locate file AI_UTILS.LSP."
                          "\n Check support directory.")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DDRENAME" "Can't load file AI_UTILS.LSP"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DDRENAME" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;; ==================== end load-time operations ===========================

;;;----------------------------------------------------------------------------
;;;  The main function.
;;;----------------------------------------------------------------------------
(defun c:ddrename (/ 
        $value                             olderr               style_items     
                          globals          old_cmd              tables          
        block_items       highlight        old_indices          table_item      
        chflag            i                old_pattern          table_items     
        cmd               item1            old_pattern_length   table_list      
        cmd_old           item2            old_star             table_name      
        command_rename    j                one_index            table_selection 
        count             just_name        orig_list            ucs_items       
        current_items     layer_items      pat_length           update_list     
        dcl_id            list1            pat_letter           view_items      
        list_name_new     group_items      pick_items           vport_items     
        defined_names     ltype_items      rename               undo_init
        dimstyle_items    n                rename_err          
        ddrename_main     n1               rename_list         
        do_new            new_item_list    report_error        
        do_old            new_name         rs_error            
        do_tables1        new_name_list    s                   
        do_tables2        new_pattern                      
       ) 
  ;;
  ;; Action on Old Name edit box.
  ;;
  ;(defun do_old()
  ;  (set_tile "table_items" "")
  ;  (rs_error)
  ;  (setq report_error 1)
  ;  (do_old)
  ;)
  ;;
  ;; Reset the error tile.
  ;;
  (defun rs_error()
    (set_tile "error" "")
  )
  ;;
  ;; This routine is called when a pick is made in the table list box, the
  ;; one that displays Block, Layer, Linetype, etc.  
  ;;
  (defun table_selection()
    (set_tile "error" "")               ; Clear the error tile.
    (do_tables1)                        ; Display items in selected table.
    (if (= "*varies*" (get_tile "old")) ; If old name is *varies*, 
      (set_tile "old" "")                 ; clear it,
      (progn                              ; else use it to highlight new items.
        (setq report_error 0)
        (do_old)
      )
    )
  )
  ;;
  ;; This routine is called when a pick is made in the table items list box,
  ;; the one that displays the items in the selected table. 
  ;;
  (defun table_items()
    (set_tile "error" "")               ; clear the error tile.
    (setq pick_items (get_tile "table_items"))   ; find the highlight items.
    (cond
      ((= "" pick_items) (set_tile "old" ""))    ; no items selected
      ((= "" (substr pick_items (+ 2 (strlen (itoa (read pick_items))))))  
        (set_tile "old" (nth (atoi $value) current_items)) ; if 1 item selected
      )                                                    ; display its name.
      (T (set_tile "old" "*varies*"))          ; else display *varies*.
    )
  )
  ;;
  ;;  This routine displays a new title on the table item list box.
  ;;
  (defun do_tables1()
    (setq table_name (nth (atoi $value) tables))

    ;; This (cond) is added for translation purposes.  The list of symbol
    ;; tables in the dialogue box will appear in the local language but 
    ;; they must be translated to American so that AutoCAD can understand.
    ;; When translating these strings make sure they correspond exactly
    ;; and precisely to those modified in the table list defined at the
    ;; start of the ddrename_main() function further down the file.
    (cond
      ((= table_name "Block")         ; translate this
        (setq table_name ;|MSG0|;"block")     ; do not translate
      )
      ((= table_name "Dimstyle")      ; translate this  
        (setq table_name ;|MSG0|;"dimstyle")  ; do not translate
      )
      ((= table_name "Layer")         ; translate this   
        (setq table_name ;|MSG0|;"layer")     ; do not translate 
      )                                                  
      ((= table_name "Ltype")         ; translate this   
        (setq table_name ;|MSG0|;"ltype")     ; do not translate 
      )
      ((= table_name "Style")         ; translate this    
        (setq table_name ;|MSG0|;"style")     ; do not translate  
      )                                                   
      ((= table_name "Ucs")           ; translate this    
        (setq table_name ;|MSG0|;"ucs")       ; do not translate  
      )                                                   
      ((= table_name "View")          ; translate this    
        (setq table_name ;|MSG0|;"view")      ; do not translate  
      )                                                   
      ((= table_name "Vport")         ; translate this    
        (setq table_name ;|MSG0|;"vport")     ; do not translate  
      )
    )
    (do_tables2)
  )
  ;;
  ;; Displays the defined items in a the selected table.
  ;;
  (defun do_tables2()
    ;; If this is the first time this table is selected, set the "table"_items
    ;; list to the currently defined items in the drawing by using ai_table.
    (if (not (eval (read (strcat table_name "_items"))))
      (set (read (eval (strcat table_name "_items")))
           (ai_table table_name 7)
      )
    )
    ;; Set current_items to a sorted version of "table"_items.
    (if (and (>= (getvar "maxsort") 
               (length (eval (read (strcat table_name "_items"))))
             )
             (eval (read (strcat table_name "_items")))
        )
      (setq current_items 
            (acad_strlsort (eval (read (strcat table_name "_items"))))
      )
      (setq current_items (eval (read (strcat table_name "_items"))))
    )
    (start_list "table_items")          ; display the sorted version.
    (mapcar 'add_list current_items)
    (end_list)
  )
  ;;
  ;; On Apply, check input, generate lists, and update the new list if all
  ;; is well.  
  ;;
  (defun rename()
    (setq report_error 1)
    (and (do_old)
         (do_new)
         (update_list)
    )
    (setq report_error 0)
  )
  ;;
  ;; Validation checking for old name.  Called on OK and when focus is removed
  ;; from the old name edit box.
  ;;
  (defun do_old()
    (setq rename_list '())
    (setq new_name_list '())

    (cond 
      ((and (/= "" (setq old_pattern (ai_strtrim (get_tile "old")))) 
            (/= "*varies*" old_pattern))
        (setq i 0)
        (setq j 1)
        (setq old_star 1)   ; was nil
        (setq highlight "")
        ; Find first * in old_pattern.
        (setq old_pattern_length (strlen old_pattern))
        (while (<= j old_pattern_length)
          (cond 
            ((= "*" (substr old_pattern j 1)) (setq old_star j))
             (T)
           )
           (setq j (1+ j))
        )
;        (if (not (wcmatch old_pattern
;                        "*[]`#`@`.`~`[`,`'!%^&()+={}|`\\:;\"<>/]*"
;                 )
;            )
;          (progn
            (foreach n current_items
              (if (wcmatch n (xstrcase old_pattern))
                (progn
                  (setq rename_list (cons n rename_list))
                  (set_tile "table_items" (itoa i))
                  (setq highlight (strcat highlight (itoa i) " "))
                )
              )
              (setq i (1+ i))
            )    
;          )
;        )
        (if rename_list 
          (progn   
            (set_tile "table_items" highlight)
             T)                ; if there is a list return T to continue
          (progn 
            (if (= 1 report_error)
              (set_tile "error" "Invalid old name.")
            )
            nil             ; else set errtile and drop out.
          )
        )
      )
      (T 
        (if (/= "" (setq old_indices (get_tile "table_items"))) ; get indices
          (progn
            (setq old_star 1)                   
            (while (read old_indices)                 ; while an index remains
              (setq one_index (itoa (read old_indices)))    ; get first index
              (setq old_indices (substr old_indices (+ 2 (strlen one_index))))
                                                            ; chop from string
              (setq rename_list 
                    (cons (nth (atoi one_index) current_items) rename_list)
              )
            )
          )
          (progn
            (if (= 1 report_error)
              (set_tile "error" "No old name selected.")
            )
            nil
          )
        )                                            
      )
    )
  )
  ;;
  ;; Check the validity of new name and generates new names.
  ;;
  (defun do_new()
    (setq new_pattern (xstrcase (ai_strtrim (get_tile "new"))))
    (foreach n1 rename_list
      (setq pat_length (strlen new_pattern)
            i          1
            new_name   ""
      )
      (while (<= i pat_length)
        (setq pat_letter (substr new_pattern i 1))
        (cond 
          ((= "*" pat_letter) 
            (cond 
              ((and old_star 
                    (>= (strlen n1) old_star)
               )
                ;; if there is a * in old_pattern and the length of the old 
                ;; name is longer then tag the rest of the letters on.
                (setq new_name (strcat new_name (substr n1 old_star)))
              )
              (T (setq new_name (strcat new_name (substr n1 i))) )
            )  
            (setq i (1+ pat_length))
          )
          ;; alphabetic, numeric, or one of three allowables.
          ((wcmatch pat_letter "@,#,_,-,$,\\,+")
            (setq new_name (strcat new_name (substr new_pattern i 1))
               i        (1+ i)
            )
          )
          ((= "?" pat_letter)
            (setq new_name (strcat new_name (substr n1 i 1))
                  i        (1+ i)
            )
          )
          ;; if weird characters, set new_name to null and catch it later.
          (T (setq new_name "")(setq i (1+ pat_length)))
        )
      )
      (setq new_name_list (cons new_name new_name_list))
    )
    (setq i             -1
          list_name_new (reverse new_name_list)
          defined_names (ai_table table_name 7)
    )

    (while (< i (- (length list_name_new) 1))
      (setq i (1+ i)
            n (nth i list_name_new)
      )
      (cond
        ;; It's OK to rename an item back to original name.  If the new item
        ;; is a member of the original list of items and its position in the
        ;; original list corresponds to the position of the new name then the
        ;; user is renaming an item back to its original name.  If it doesn't
        ;; correspond then give an error message.
        ((and (member n defined_names) 
              (/= (length (member n defined_names)) ; old position in list
                  (length (member (nth i rename_list) ; new position
                                  (eval (read (strcat table_name "_items")))
                          )
                  )
              )
         )
         (set_tile "error" "Invalid new name.")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((not (snvalid n) )
         (set_tile "error" "Invalid new name.")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((= "" n)
         (set_tile "error" "Invalid new name.")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((member n (cdr (member n new_name_list)))
         (set_tile "error" "Invalid - duplicate new name.")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        ((member n (eval (read (strcat table_name "_items"))))
         (set_tile "error" "Invalid - duplicate new name.")
         (setq i (1+ (length list_name_new)))  ; break out
        )
        (T (set (read (eval (strcat table_name "_items")))
                (subst 
                      n                                            ; new
                      (nth i rename_list)                          ; old
                      (eval (read (strcat table_name "_items"))))) ; list
        )
      )
    )  
    (if (= i (- (length list_name_new) 1))
      (progn 
        (if (and (>= (getvar "maxsort") (length list_name_new))
                 (eval (read (strcat table_name "_items")))
            )
          (setq current_items 
            (acad_strlsort (eval (read (strcat table_name "_items"))))
          ) 
          (setq current_items (eval (read (strcat table_name "_items"))))
        )
      )
      nil
    )
  )
  ;;
  ;; Called by Apply, substitutes the new name for the current item name.
  ;;
  (defun update_list(/ i)
    (setq i             0
          new_item_list current_items
    )
    (foreach n rename_list 
      (setq new_item_list (subst (nth i list_name_new) n new_item_list)
            i             (1+ i)
      )
    )
    (start_list "table_items")
    (mapcar 'add_list new_item_list)
    (end_list)
    (setq chflag 1)
    (if (= "*varies*" old_pattern) (set_tile "old" ""))  ; clear old name.
    T
  )
  ;;
  ;; If all input checks out, then for each table that has a corresponding
  ;; old name and new name list, corresponding items in the old list and the new 
  ;; list are compared and renamed if different.  For each updated table, a 
  ;; message reporting the number of items renamed is displayed.
  ;;
  ;; Modification for foreign language use
  (defun command_rename(/ orig_list count)
    (foreach n tables                  
      (setq tmp n)              ; restore the table entry for printing
      (cond
       ((= n "Block")         ; translate this
         (setq n ;|MSG0|;"block")     ; do not translate
       )
       ((= n "Dimstyle")      ; translate this
         (setq n ;|MSG0|;"dimstyle")  ; do not translate
       )
       ((= n "Layer")         ; translate this
         (setq n ;|MSG0|;"layer")     ; do not translate
       )
       ((= n "Ltype")         ; translate this
         (setq n ;|MSG0|;"ltype")     ; do not translate
       )
       ((= n "Style")         ; translate this
         (setq n ;|MSG0|;"style")     ; do not translate
       )
       ((= n "Ucs")           ; translate this
         (setq n ;|MSG0|;"ucs")       ; do not translate
       )
       ((= n "View")          ; translate this
         (setq n ;|MSG0|;"view")      ; do not translate
       )
       ((= n "Vport")         ; translate this
         (setq n ;|MSG0|;"vport")     ; do not translate
       )
      )
      (setq count 0)
      (if (eval (read (strcat n "_items")))  
        (progn 
          (setq orig_list (ai_table n 7))
          (setq i 0)
          (foreach n1 (eval (read (strcat n "_items")))
            (if (not (wcmatch n1 (nth i orig_list)))
              (progn
                (command "_.rename" (strcat "_" n) (nth i orig_list) n1)
                (setq count (1+ count))
              )
            )
            (setq i (1+ i))
          )
          (if (/= count 0)
            (if (= count 1)  ;; singular
                (princ (strcat "\n" (itoa count) " " tmp " renamed."))
                (progn       ;; plural
                   (cond
                     ((= n ;|MSG0|;"block")         ; do not translate
                      (setq tmp "Blocks")   ; translate this (plural form)
                     )
                     ((= n ;|MSG0|;"dimstyle")      ; do not translate
                      (setq tmp "Dimstyles"); translate this
                     )
                     ((= n ;|MSG0|;"layer")         ; do not translate 
                      (setq tmp "Layers")   ; translate this
                     )
                     ((= n ;|MSG0|;"ltype")         ; do not translate 
                      (setq tmp "Ltypes")   ; translate this
                     )
                     ((= n ;|MSG0|;"style")         ; do not translate
                      (setq tmp "Styles")   ; translate this
                     )
                     ((= n ;|MSG0|;"ucs")           ; do not translate
                      (setq tmp "Ucs")      ; translate this
                     )
                     ((= n ;|MSG0|;"view")          ; do not translate 
                       (setq tmp "Views")   ; translate this
                     )
                     ((= n ;|MSG0|;"vport")         ; do not translate 
                       (setq tmp "Vports")  ; translate this
                     )
                   )
                   (princ (strcat "\n" (itoa count) " " tmp " renamed."))
                )
             )
          )
        )
      )
    )
  )
  ;;
  ;; Put up the dialogue.
  ;;
  (defun ddrename_main()

    (if (not (new_dialog "ddrename" dcl_id)) (exit))
    ;; This is the list of symbol table names that are dispalyed in the 
    ;; listbox.  When translating these strings, make sure that the (cond)
    ;; in  do_tables1() is updated to contain exact copies of these strings.
    ;; Re-ordering this list for alphabetising purposes should not cause
    ;; problems, but test it thoroughly.  
    ;; If reordered, check out the default selection below.

    (setq tables    
          '("Block"  "Dimstyle"
            "Layer"  "Ltype"
            "Style" "Ucs"
            "View"  "Vport" ))
  
    (setq chflag       0      ; OK needs to k now if anything has changed
          report_error 0)     ; Only print the old name errors during Apply.

    (start_list "tables")
    (mapcar 'add_list tables)
    (end_list)

    ;; Make layer the default selection and display layer list.
    (set_tile "tables" "2")  ; zero-based index
    (setq table_name ;|MSG0|;"Layer")
    (do_tables2)

    (action_tile "tables" "(table_selection)")
    (action_tile "table_items" "(table_items)")
    (action_tile "old" "(set_tile \"table_items\" \"\")(do_old)")
    (action_tile "new" "(rs_error)")
    (action_tile "rename" "(rs_error)(rename)")
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "help" "(help \"\" \"ddrename\")")

    (if (and (= 1 (start_dialog)) (= 1 chflag))
      (command_rename)
      (princ "\nNo items renamed. ")
    )
  )

  ;; Set up error function.
  (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
        old_error  *error*            ; save current error function
        *error* ai_error              ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
     (  (not (ai_notrans)))                      ; transparent not OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "ddrename"))))  ; is .DCL file loaded?

     (t 
        (ai_undo_push)
        (ddrename_main)                          ; proceed!
        (ai_undo_pop)
     )
  )

  (setq *error* old_error) 
  (setvar "cmdecho" old_cmd)
  (princ)
)
 
;;;----------------------------------------------------------------------------
(princ "  DDRENAME loaded.  ")
(princ)
