;;;
;;;
;;;
;;;
;;;
;;;Requires: UKWORD.LSP, UPOINT.LSP, and UREAL.LSP
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 11-23-2005
;;;
(DEFUN abbr_error (msg /)
  (PRINC (STRCAT "\nError: " msg))
  (SETQ *error* orig_abbrerror)
  (TERM_DIALOG)
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ABBR ()
  (SETQ orig_abbrerror *error*
        *error* abbr_error
  ) ;_ end of SETQ
  (PROGN
    (SETQ abbr_dlg# (LOAD_DIALOG "abbr"))
    (SETQ newdlg_abbr
           (NEW_DIALOG
             "abbr"
             abbr_dlg#
             (IF defact_abbr
               defact_abbr
               ""
             ) ;_ end of IF
             (IF abbr_loc
               abbr_loc
               '(-1 -1)
             ) ;_ end of IF
           ) ;_ end of NEW_DIALOG
    ) ;_ end of SETQ
    (IF errmsg
      (SET_TILE "error" errmsg)
    ) ;_ end of IF
    (abrlstfun)
    (IF disabr_lst
      (SET_TILE "abbr_list"
                (ITOA (MIN (1- (LENGTH dispabr_lst))
                           (IF abrndx
                             abrndx
                             0
                           ) ;_ end of IF
                      ) ;_ end of MIN
                ) ;_ end of ITOA
      ) ;_ end of SET_TILE
    ) ;_ end of IF
;;;      (ACTION_TILE "abbr_list" "(if(eq $reason 4)(setq acpt T)(setq acpt nil))(abbr_action)")
    (IF abbrdlg_focus
      (MODE_TILE abbrdlg_focus 2)
    ) ;_ end of IF
    (IF skip_headers
      (SET_TILE "skip_headers" "1")
      (SET_TILE "skip_headers" "0")
    ) ;_ end of IF
    (IF abrcolwid
      (SET_TILE "abrcolwid" (RTOS abrcolwid 2 2))
      (SET_TILE "abrcolwid" "0.75")
    ) ;_ end of IF
    (IF abrcolwid2
      (SET_TILE "abrcolwid2" (RTOS abrcolwid2 2 2))
      (SET_TILE "abrcolwid2" "2.75")
    ) ;_ end of IF
    (IF abrcolspc
      (SET_TILE "abrcolspc" (RTOS abrcolspc 2 2))
      (SET_TILE "abrcolspc" "0.5")
    ) ;_ end of IF
    (IF tittxtht
      (SET_TILE "tittxtht" (RTOS tittxtht 2 2))
      (SET_TILE "tittxtht" "0.2")
    ) ;_ end of IF
    (IF hdrtxtht
      (SET_TILE "hdrtxtht" (RTOS hdrtxtht 2 2))
      (SET_TILE "hdrtxtht" "0.14")
    ) ;_ end of IF
    (IF abrtxtht
      (SET_TILE "abrtxtht" (RTOS abrtxtht 2 2))
      (SET_TILE "abrtxtht" "0.11")
    ) ;_ end of IF
    (IF titcolr
      (SET_TILE "titcolr" titcolr)
      (SET_TILE "titcolr" "2")
    ) ;_ end of IF
    (IF hdrcolr
      (SET_TILE "hdrcolr" hdrcolr)
      (SET_TILE "hdrcolr" "4")
    ) ;_ end of IF
    (IF abrcolr
      (SET_TILE "abrcolr" abrcolr)
      (SET_TILE "abrcolr" "6")
    ) ;_ end of IF
    (IF dlg_ttl (SET_TILE "dlg_ttl" dlg_ttl))
    (ACTION_TILE "abbr_add" "(SETQ abradtxt $value)")
    (ACTION_TILE "desc_add" "(SETQ dscadtxt $value)")
    (ACTION_TILE "delabbr_lst" "(SETQ abrndx(GET_TILE\"abbr_list\"))(delabbr_lst)") ;_ end of ACTION_TILE
    (ACTION_TILE
      "Add_it"
      "(abrad_chk)(setq abbr_action \"(c:abbraddn)\")(setq abbr_loc(done_dialog 2)errmsg \"\")"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE
      "Add_sel"
      "(SETQ abradtxt NIL dscadtxt NIL abbr_action \"(c:abbraddn)\")(setq abbr_loc(done_dialog 2)errmsg \"\")"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE
      "Save_it"
      "(setq abbr_action \"(c:abbrsave)\")(setq abbr_loc(done_dialog 2)errmsg \"\")"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE
      "Open_it"
      "(setq abbr_action \"(c:abbrload)\")(IF abbr_list (abbr_alert)(setq ok_abbr T))(IF ok_abbr(setq abbr_loc(done_dialog 2)errmsg \"\"))"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE "abrcolwid" "(setq abrcolwid (atof (get_tile\"abrcolwid\")))")
    (ACTION_TILE "abrcolwid2" "(setq abrcolwid2 (atof (get_tile\"abrcolwid2\")))")
    (ACTION_TILE "abrcolspc" "(setq abrcolspc (atof (get_tile\"abrcolspc\")))")
    (ACTION_TILE "tittxtht" "(setq tittxtht (atof (get_tile\"tittxtht\")))")
    (ACTION_TILE "hdrtxtht" "(setq hdrtxtht (atof (get_tile\"hdrtxtht\")))")
    (ACTION_TILE "abrtxtht" "(setq abrtxtht (atof (get_tile\"abrtxtht\")))")
    (ACTION_TILE "titcolr" "(set_colr \"tit\")")
    (ACTION_TILE "hdrcolr" "(set_colr \"hdr\")")
    (ACTION_TILE "abrcolr" "(set_colr \"abr\")")
    (ACTION_TILE
      "skip_headers"
      "(if(eq(get_tile\"skip_headers\")\"1\")(setq skip_headers T)(setq skip_headers NIL))"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE
      "Draw_it"
      "(setq abbr_action \"(c:abbrdraw)\")(setq abbr_loc(done_dialog 2)errmsg \"\")"
    ) ;_ end of ACTION_TILE
    (ACTION_TILE "Close_it" "(SETQ abbr_action NIL abbr_loc(done_dialog 2)errmsg nil)")
    (ACTION_TILE "Help_it" "(setq abbr_action \"(abbrhelp)\")(setq abbr_loc(done_dialog 2)errmsg \"\")")
    (START_DIALOG)
    (UNLOAD_DIALOG abbr_dlg#)
    (IF abbr_action
      (PROGN (EVAL (READ abbr_action)) (SETQ abbr_action NIL))
    ) ;_ end of IF
  ) ;_ end of PROGN
  (SETQ *error* orig_abbrerror)
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ABBRADDN ()
  (IF ukowrd
    nil
    (LOAD "UKWORD" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (IF (OR abradtxt dscadtxt)
    (PROGN (IF (AND abradtxt dscadtxt)
             (PROGN (SETQ abbr_list (APPEND abbr_list (LIST (LIST abradtxt dscadtxt))))
                    (sort_abbr)
                    (TERM_DIALOG)
                    (c:abbr)
             ) ;_ end of PROGN
             (PROGN (SETQ errmsg
                           "Enter both \"New Abbr:\" and \"Description:\" to add an item or leave them both blank to pick text to add."
                    ) ;_ end of SETQ
                    (TERM_DIALOG)
                    (c:abbr)
             ) ;_ end of PROGN
           ) ;_ end of IF
    ) ;_ end of PROGN
    (PROGN (IF abbr_list
             (SETQ contorno (ukword 1 "Yes No" "Continue adding to current abbreviations?" "Yes"))
           ) ;_ end of IF
           (IF (EQ contorno "No")
             (PROGN (SETQ killlst (ukword 1 "Yes No" "Really discard current abbreviation list?" "No"))
                    (IF (EQ killlst "Yes")
                      (SETQ abbr_list NIL)
                    ) ;_ end of IF
             ) ;_ end of PROGN
           ) ;_ end of IF
           (WHILE (AND (SETQ abbr_pick (ENTSEL "\nSelect abbreviation text: "))
                       (EQ (CDR (ASSOC 0 (ENTGET (CAR abbr_pick)))) "TEXT")
                  ) ;_ end of and
             (SETQ abbr_text (CDR (ASSOC 1 (ENTGET (CAR abbr_pick)))))
             (WHILE (OR (NOT descrip_pick) (NOT (EQ (CDR (ASSOC 0 (ENTGET (CAR descrip_pick)))) "TEXT")))
               (SETQ descrip_pick (ENTSEL (STRCAT "\nSelect description text for " abbr_text ": ")))
             ) ;_ end of while
             (SETQ descrip_text
                    (CDR (ASSOC 1 (ENTGET (CAR descrip_pick))))
                   descrip_pick nil
             ) ;_ end of setq
             (SETQ add_picks (ukword 1
                                     "Yes No"
                                     (STRCAT "Add \"" abbr_text " - " descrip_text "\" to abbreviation list?")
                                     (IF add_picks
                                       add_picks
                                       "Yes"
                                     ) ;_ end of if
                             ) ;_ end of ukword
             ) ;_ end of setq
             (IF (EQ add_picks "Yes")
               (PROGN (SETQ abbr_list (APPEND abbr_list (LIST (LIST abbr_text descrip_text))))
                      (IF (> (LENGTH abbr_list) 1)
                        (sort_abbr)
                      ) ;_ end of if
               ) ;_ end of progn
             ) ;_ end of if
           ) ;_ end of while
           (IF abbr_list
             (PROGN (stripspaces) (TERM_DIALOG) (c:abbr))
           ) ;_ end of IF
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ abbrdlg_focus "abbr_add")
  (PRINC)
) ;_ end of DEFUN
(DEFUN c:abbrshow ()
  (FOREACH n abbr_list (PRINC "\n\t") (PRINC (CAR n)) (PRINC " - ") (PRINC (CADR n)))
  (PRINC)
) ;_ end of defun
(DEFUN c:abbrdraw (/ did_sechdr sect_headr)
  (IF abbr_list
    (PROGN
      (IF upoint
        nil
        (LOAD "UPOINT" "\nFile UPOINT.LSP not loaded! ")
      ) ;_ end of if
      (IF ureal
        nil
        (LOAD "UREAL" "\nFile UREAL.LSP not loaded! ")
      ) ;_ end of if
      (COMMAND ".undo" "begin")
      (SETQ curlayer (GETVAR "clayer"))
      (COMMAND ".layer" "m" "G-ABBR-TEXT" "c" "7" "" "")
      (SETQ abrstrtpt   (upoint 1 "" "Abbreviation list origin" nil nil)
            maxcolpt    (upoint 1 "" "Pick maximum column height" nil abrstrtpt)
            maxcolht    (DISTANCE abrstrtpt maxcolpt)
            abbrbasept  abrstrtpt
            sect_headr  (STRCASE (SUBSTR (CAR (NTH 0 abbr_list)) 1 1))
            abbr_origin abrstrtpt
      ) ;_ end of SETQ
      (IF (MEMBER sect_headr alpha_lst)
        nil
        (PROGN (SETQ sect_headr "SYMBOL")) ;_ end of PROGN
      ) ;_ end of IF
      (IF dimscl
        nil
        (LOAD "dimscl")
      ) ;_ end of if
      (dimscl)
      (IF txtsize
        nil
        (LOAD "txtsize" "\nFile TXTSIZE.LSP not found!")
      ) ;_ end of if
      (IF hdrtxtht
        NIL
        (SETQ hdrtxtht 0.14)
      ) ;_ end of IF
      (SETQ thts (RTOS (* 1000.0 (/ hdrtxtht dimsc)) 2 2))
;;;      (PRINC "\nHeader text size? ")
      (txtsize thts)
      (SETQ hdrtxcolr hdrcolr
            hdrtxtht txtht
      ) ;_ end of setq
      (IF abrtxtht
        NIL
        (SETQ abrtxtht 0.11)
      ) ;_ end of IF
      (SETQ thts (RTOS (* 1000.0 (/ abrtxtht dimsc)) 2 2))
;;;      (PRINC "\nAbbreviation text size? ")
      (txtsize thts)
      (IF titcolr
        (SETQ tittxcolr titcolr)
        (SETQ titcolr "2"
              tittxcolr titcolr
        ) ;_ end of SETQ
      ) ;_ end of IF
      (IF hdrcolr
        (SETQ hdrtxcolr hdrcolr)
        (SETQ hdrcolr "4"
              hdrtxcolr hdrcolr
        ) ;_ end of SETQ
      ) ;_ end of IF
      (IF abrcolr
        (SETQ abrtxcolr abrcolr)
        (SETQ abrcolr "6"
              abrtxcolr abrcolr
        ) ;_ end of SETQ
      ) ;_ end of IF
      (IF abrcolwid
        NIL
        (SETQ abrcolwid (* 7.5 abrtxtht))
      ) ;_ end of IF
      (IF abrcolwid2
        NIL
        (SETQ abrcolwid2 (* 27.5 abrtxtht))
      ) ;_ end of IF
      (IF abrcolspc
        NIL
        (SETQ abrcolspc (* 5.0 txtht))
      ) ;_ end of IF
      (SETQ abbr_ss (SSADD))
      (FOREACH n abbr_list
        (IF (OR (AND (EQ sect_headr (STRCASE (SUBSTR (CAR n) 1 1))) did_sechdr)
                (AND (EQ sect_headr "SYMBOL")
                     did_sechdr
                     (NOT (MEMBER (STRCASE (SUBSTR (CAR n) 1 1)) alpha_lst) ;_ end of MEMBER
                     ) ;_ end of MEMBER
                ) ;_ end of and
                skip_headers
            ) ;_ end of OR
          (PROGN (IF (AND (EQ n (CAR abbr_list)) skip_headers)
                   NIL
                   (SETQ abrstrtpt (POLAR abrstrtpt (* PI 1.5) (* 1.5 txtht)))
                 ) ;_ end of IF
                 (IF (> (DISTANCE abbrbasept abrstrtpt) maxcolht)
                   (SETQ abrstrtpt  (POLAR abbrbasept 0 (+ abrcolspc abrcolwid abrcolwid2))
                         abbrbasept abrstrtpt
                   ) ;_ end of SETQ
                 ) ;_ end of IF
                 (ENTMAKE (LIST (CONS 0 "text")
                                (CONS 1 (CAR n))
                                (CONS 10 abrstrtpt)
                                (CONS 40 abrtxtht)
                                (CONS 62 (ATOI abrcolr))
                          ) ;_ end of LIST
                 ) ;_ end of ENTMAKE
                 (SSADD (ENTLAST) abbr_ss)
                 (SETQ abrdespt (POLAR abrstrtpt 0 abrcolwid))
                 (descr_txt n)
;;;                 (IF (> (SETQ abrdeslen (/ (STRLEN (CADR n)) (* 1.5 (/ abrcolwid2 txtht)))) 1.0)
;;;                   (SETQ abrstrtpt (POLAR abrstrtpt (* PI 1.5) (* 1.5 (FIX abrdeslen) abrtxtht)))
;;;                 ) ;_ end of IF
          ) ;_ end of progn
          (PROGN (IF (OR (EQ sect_headr (STRCASE (SUBSTR (CAR n) 1 1))) (EQ sect_headr (STRCASE (SUBSTR (CADR n) 1 1))))
                   nil
                   (PROGN (SETQ sect_headr (STRCASE (SUBSTR (CAR n) 1 1)))
                          (IF (MEMBER sect_headr alpha_lst)
                            nil
                            (SETQ sect_headr "SYMBOL") ;_ end of setq
                          ) ;_ end of IF
                   ) ;_ end of progn
                 ) ;_ end of if
                 (IF did_sechdr
                   (SETQ abrstrtpt (POLAR abrstrtpt (* PI 1.5) (* 3.0 hdrtxtht)))
                 ) ;_ end of IF
                 (IF (> (DISTANCE abbrbasept (POLAR abrstrtpt (* PI 1.5) (* 2.0 hdrtxtht))) maxcolht)
                   (SETQ abrstrtpt  (POLAR abbrbasept 0 (+ abrcolspc abrcolwid abrcolwid2))
                         abbrbasept abrstrtpt
                   ) ;_ end of SETQ
                 ) ;_ end of IF
                 (ENTMAKE (LIST (CONS 0 "text")
                                (CONS 1 sect_headr)
                                (CONS 10 abrstrtpt)
                                (CONS 40 hdrtxtht)
                                (CONS 62 (ATOI hdrcolr))
                          ) ;_ end of LIST
                 ) ;_ end of ENTMAKE
                 (SSADD (ENTLAST) abbr_ss)
                 (SETQ did_sechdr T
                       abrstrtpt  (POLAR abrstrtpt (* PI 1.5) (* 2.0 hdrtxtht))
                 ) ;_ end of setq
                 (ENTMAKE (LIST (CONS 0 "text")
                                (CONS 1 (CAR n))
                                (CONS 10 abrstrtpt)
                                (CONS 40 abrtxtht)
                                (CONS 62 (ATOI abrcolr))
                          ) ;_ end of LIST
                 ) ;_ end of ENTMAKE
                 (SSADD (ENTLAST) abbr_ss)
                 (SETQ abrdespt (POLAR abrstrtpt 0 abrcolwid))
;;;                 (if abrkstr nil (load "abrkstr" "\nFile ABRKSTR.LSP not loaded! "))
                 (descr_txt n)
;;;                 (setq ab_wrap_len 30)
;;;                 (abrkstr (cdr(assoc 1(entget(entlast)))) ab_wrap_len)
;;; (SETQ abrstrtpt (POLAR(POLAR (cdr(assoc 10(entget(entlast)))) (* PI 1.5) (* 1.5 abrtxtht)) pi (+ (* 2.0 abrcolwid)
;;; abrcolwid2)))
;;;                 (IF (> (SETQ abrdeslen (/ (STRLEN (CADR n)) 30.0)) 1.0)
;;;                   (SETQ abrstrtpt (POLAR abrstrtpt (* PI 1.5) (* 1.5 (FIX abrdeslen) abrtxtht)))
;;;                 ) ;_ end of IF
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of foreach
      (SETQ titlept
             (POLAR
               (POLAR abbr_origin
                      0
                      (/ (+ (DISTANCE abbr_origin (CONS (CAR abrstrtpt) (CDR abbr_origin))) abrcolwid abrcolwid2) 2.0)
               ) ;_ end of POLAR
               (* PI 0.5)
               (* 3.4 hdrtxtht)
             ) ;_ end of POLAR
      ) ;_ end of SETQ
      (SETQ line_pt1 (POLAR abbr_origin (* PI 0.5) (* 2.0 hdrtxtht))
            line_pt2 (POLAR line_pt1 0 (+ (DISTANCE abbr_origin (CONS (CAR abrstrtpt) (CDR abbr_origin))) abrcolwid abrcolwid2))
      )
      (ENTMAKE (LIST (CONS 0 "text")
                     (CONS 1 "ABBREVIATIONS, ACRONYMS, AND SYMBOLS")
                     (CONS 10 titlept)
                     (CONS 11 titlept)
                     (CONS 40 (* 1.4 hdrtxtht))
                     (CONS 62 (ATOI titcolr))
                     (CONS 72 1)
                     (CONS 73 2)
               ) ;_ end of LIST
      ) ;_ end of ENTMAKE
      (SSADD (ENTLAST) abbr_ss)
      (ENTMAKE (LIST (CONS 0 "LINE") (CONS 10 line_pt1) (CONS 11 line_pt2) (CONS 62 (ATOI titcolr))))
      (SSADD (ENTLAST) abbr_ss)
;;;      (TERM_DIALOG)
;;;      (c:abbr)
      (SETQ grp_name_a (RTOS (FIX (GETVAR "cdate")) 2 0)
            grp_name_b (SUBSTR (RTOS (REM (GETVAR "cdate") 1) 2 8) 3)
            grp_name_c "_ABBR"
            bang_str   "Abbreviation List"
      ) ;_ end of setq
      (COMMAND "-group" "create" (STRCAT grp_name_a grp_name_b grp_name_c) bang_str abbr_ss "") ;_ end of COMMAND
      (COMMAND ".layer" "m" curlayer "")
      (COMMAND ".undo" "end")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ABBRLOAD ()
  (IF ok_abbr
    (PROGN (SETQ ok_abbr NIL)
           (SETQ abbr_file (GETFILED "Open Abbreviation Data File" (STRCAT (GETVAR "dwgprefix") "abbrlist.dat") "dat" 4))
           (IF abbr_file
             (PROGN (IF (SETQ abbr_open (OPEN abbr_file "r"))
                      (PROGN (SETQ abbr_list (READ (READ-LINE abbr_open)))
                             (CLOSE abbr_open)
                             (PRINC "\nAbbreviation data loaded! ")
                             (SETQ abbr_saved abbr_list)
                             (SETQ dlg_ttl abbr_file)
                             (TERM_DIALOG)
                             (c:abbr)
                      ) ;_ end of PROGN
                      (PRINC "\nERROR!: Unable to load abbreviation data! ")
                    ) ;_ end of IF
             ) ;_ end of PROGN
             (PRINC "\nERROR!: No abbreviation data file found! ")
           ) ;_ end of IF
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN C:ABBRSAVE ()
  (SETQ abbr_file (GETFILED "Create Abbreviation Data File" (STRCAT (GETVAR "dwgprefix") "abbrlist.dat") "dat" 1))
  (IF abbr_file
    (PROGN (IF (SETQ abbr_open (OPEN abbr_file "w"))
             (PROGN (PRIN1 abbr_list abbr_open)
                    (CLOSE abbr_open)
                    (PRINC (STRCAT "\nAbbreviation data file \"" abbr_file "\" written! "))
                    (SETQ abbr_saved abbr_list)
                    (TERM_DIALOG)
                    (c:abbr)
             ) ;_ end of PROGN
             (PRINC "\nERROR!: Unable to write abbreviation data! ")
           ) ;_ end of IF
    ) ;_ end of PROGN
    (PRINC "\nERROR!: Abbreviation data file not specified! ")
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN stripspaces ()
  (FOREACH n abbr_list
    (IF (WCMATCH (CAR n) " *")
      (PROGN (SETQ carn (CAR n))
             (WHILE (WCMATCH carn " *") (SETQ carn (SUBSTR carn 2)))
             (SETQ abbr_list (SUBST (LIST carn (CADR n)) n abbr_list))
      ) ;_ end of PROGN
    ) ;_ end of IF
    (IF (WCMATCH (CAR n) "* ")
      (PROGN (SETQ carn (CAR n))
             (WHILE (WCMATCH carn "* ") (SETQ carn (SUBSTR carn 1 (1- (STRLEN carn)))))
             (SETQ abbr_list (SUBST (LIST carn (CADR n)) n abbr_list))
      ) ;_ end of PROGN
    ) ;_ end of IF
    (IF (WCMATCH (CADR n) " *")
      (PROGN (SETQ cadrn (CADR n))
             (WHILE (WCMATCH cadrn " *") (SETQ cadrn (SUBSTR cadrn 2)))
             (SETQ abbr_list (SUBST (LIST (CAR n) cadrn) n abbr_list))
      ) ;_ end of PROGN
    ) ;_ end of IF
    (IF (WCMATCH (CADR n) "* ")
      (PROGN (SETQ cadrn (CADR n))
             (WHILE (WCMATCH cadrn "* ") (SETQ cadrn (SUBSTR cadrn 1 (1- (STRLEN cadrn)))))
             (SETQ abbr_list (SUBST (LIST (CAR n) cadrn) n abbr_list))
      ) ;_ end of PROGN
    ) ;_ end of IF
  ) ;_ end of foreach
  (PRINC)
) ;_ end of defun
(DEFUN delabbr_lst ()
;;;  (PRINC "\nabrndx = ")
;;;  (PRINC abrndx)
  (SETQ abrndx (ATOI abrndx))
  (IF abbr_list
    (SETQ abbr_list (APPEND (REVERSE (CDR (MEMBER (NTH abrndx abbr_list) (REVERSE abbr_list))))
                            (CDR (MEMBER (NTH abrndx abbr_list) abbr_list))
                    ) ;_ end of append
    ) ;_ end of setq
  ) ;_ end of IF
  (abrlstfun)
  (SET_TILE "abbr_list"
            (ITOA (MIN (1- (LENGTH dispabr_lst))
                       (IF abrndx
                         abrndx
                         0
                       ) ;_ end of IF
                  ) ;_ end of MIN
            ) ;_ end of ITOA
  ) ;_ end of SET_TILE
  (PRINC)
) ;_ end of defun
(DEFUN abrlstfun ()
  (IF abbr_list
    (PROGN (IF alpha_lst
             NIL
             (SETQ alpha_lst '("A"
                               "B"
                               "C"
                               "D"
                               "E"
                               "F"
                               "G"
                               "H"
                               "I"
                               "J"
                               "K"
                               "L"
                               "M"
                               "N"
                               "O"
                               "P"
                               "Q"
                               "R"
                               "S"
                               "T"
                               "U"
                               "V"
                               "W"
                               "X"
                               "Y"
                               "Z"
                              )
             ) ;_ end of SETQ
           ) ;_ end of IF
           (IF (MEMBER (SUBSTR (CAR (NTH 0 abbr_list)) 1 1) alpha_lst)
             (sort_abbr)
           ) ;_ end of IF
           (SETQ dispabr_lst (MAPCAR '(LAMBDA (alstn) (STRCAT (CAR alstn) "\t" (CADR alstn))) abbr_list))
           (START_LIST "abbr_list")
           (MAPCAR 'ADD_LIST dispabr_lst)
           (END_LIST)
    ) ;_ end of PROGN
    (PROGN (sort_abbr) (START_LIST "abbr_list") (MAPCAR 'ADD_LIST (LIST "")) (END_LIST))
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN ABBR_ALERT (/)
  (IF (AND (NOT (EQ abbr_saved abbr_list)) abbr_list)
    (PROGN (IF abbr_dlg#
             nil
             (SETQ abbr_dlg# (LOAD_DIALOG "abbr"))
           ) ;_ end of IF
           (SETQ newdlg_abbr_alert
                  (NEW_DIALOG
                    "abbr_alert"
                    abbr_dlg#
                    (IF defact_abbr_alert
                      defact_abbr_alert
                      ""
                    ) ;_ end of IF
                    (IF abbralt_loc
                      abbralt_loc
                      '(-1 -1)
                    ) ;_ end of IF
                  ) ;_ end of NEW_DIALOG
           ) ;_ end of SETQ
           (ACTION_TILE "accept" "(SETQ ok_abbr T abbralt_loc(done_dialog 1))") ;
           (ACTION_TILE "cancel" "(SETQ ok_abbr nil abbralt_loc(done_dialog 0))") ;
           (COND (newdlg_abbr_alert (START_DIALOG) (SETQ newdlg_abbr_alert NIL))
                 (T (PRINC "\nERROR! Unable to start dialog. "))
           ) ;_ end of COND
    ) ;_ end of PROGN
    (SETQ ok_abbr T)
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN
(DEFUN abbrhelp ()
  (COMMAND ".browser" "http:\\\\paracadd.com\\abbr_help.htm")
  (TERM_DIALOG)
  (c:abbr)
) ;_ end of defun
(DEFUN sort_abbr ()
  (IF abbr_list
    (PROGN (SETQ abbrsorted NIL)
           (FOREACH n (ACAD_STRLSORT (MAPCAR 'CAR abbr_list))
             (SETQ abbrsorted (APPEND abbrsorted (LIST (ASSOC n abbr_list))))
           ) ;_ end of foreach
           (SETQ abbr_list abbrsorted)
    ) ;_ end of PROGN
;;;    (SETQ abbr_list (VL-SORT abbr_list
;;;                             (FUNCTION (LAMBDA (e1 e2)
;;;                                         (COND
;;;                                           ((AND(NOT (MEMBER (STRCASE (SUBSTR (CAR e1) 1 1)) alpha_lst))
;;;                                                (NOT (MEMBER (STRCASE (SUBSTR (CAR e2) 1 1)) alpha_lst))
;;;                                                )
;;;                                            (IF (< (CAR e1) (CAR e2)) T)
;;;                                            )
;;;                                           ((NOT (MEMBER (STRCASE (SUBSTR (CAR e1) 1 1)) alpha_lst))
;;;                                            T)
;;;                                           ((NOT (MEMBER (STRCASE (SUBSTR (CAR e2) 1 1)) alpha_lst))
;;;                                            T)
;;;                                           ((WCMATCH (CAR e1) "`@*")T)
;;;                                           ((< (CAR e1) (CAR e2))T)
;;;                                         )
;;;                                       ) ;_ end of LAMBDA
;;;                             ) ;_ end of FUNCTION
;;;                    ) ;_ end of VL-SORT
;;;    ) ;_ end of SETQ
  ) ;_ end of IF
) ;_ end of defun
(DEFUN descr_txt (n /)
  (SETQ descr_txt_lst (LIST (CONS 0 "text")
                            (CONS 1 (CADR n))
                            (CONS 10 abrdespt)
                            (CONS 40 abrtxtht)
                            (CONS 62 (ATOI abrcolr))
                      ) ;_ end of LIST
        descr_box     (TEXTBOX descr_txt_lst)
        descr_len     (DISTANCE (CAR descr_box) (APPEND (LIST (CAADR descr_box)) (CDAR descr_box)))
  ) ;_ end of SETQ
;;;                 (PRINC "\nStart: ")
;;;                 (PRINC (CADR n))
;;;                 (PRINC "\nDistance: ")
;;;                 (PRINC descr_len)
;;;                 (PRINC)
  (IF (< descr_len abrcolwid2)
    (PROGN (ENTMAKE descr_txt_lst)
           (SSADD (ENTLAST) abbr_ss)
           (SETQ abrdespt  (POLAR abrdespt (* PI 1.5) (* 0.75 abrtxtht))
                 abrstrtpt (POLAR abrdespt PI abrcolwid)
           ) ;_ end of SETQ
    ) ;_ end of PROGN
    (PROGN (SETQ descr_strlen (STRLEN (CADR n))
                 text_strlen  descr_strlen
                 text_lst     (LIST (CONS 0 "text")
                                    (CONS 1 (CADR n))
                                    (CONS 10 abrdespt)
                                    (CONS 40 abrtxtht)
                                    (CONS 62 (ATOI abrcolr))
                              ) ;_ end of LIST
                 descr_box    (TEXTBOX text_lst)
                 descr_len    (DISTANCE (CAR descr_box) (APPEND (LIST (CAADR descr_box)) (CDAR descr_box)))
                 text_cnt     1
           ) ;_ end of SETQ
           (WHILE (> descr_len abrcolwid2)
             (WHILE (> descr_len abrcolwid2)
               (SETQ text_lst  (LIST (CONS 0 "text")
                                     (CONS 1 (SUBSTR (CADR n) text_cnt (SETQ text_strlen (1- text_strlen))))
                                     (CONS 10 abrdespt)
                                     (CONS 40 abrtxtht)
                                     (CONS 62 (ATOI abrcolr))
                               ) ;_ end of LIST
                     descr_box (TEXTBOX text_lst)
                     descr_len (DISTANCE (CAR descr_box) (APPEND (LIST (CAADR descr_box)) (CDAR descr_box)))
               ) ;_ end of SETQ
;;;                 (PRINC "\nWhile (2) ")
;;;                 (PRINC (SUBSTR (CADR n) text_cnt text_strlen))
;;;                 (PRINC)
             ) ;_ end of WHILE
             (WHILE (AND (WCMATCH (SUBSTR (CADR n) text_cnt text_strlen) "* *")
                         (NOT (EQ (SUBSTR (CADR n) (+ text_cnt text_strlen) 1) " "))
                    ) ;_ end of AND
               (SETQ text_lst (LIST (CONS 0 "text")
                                    (CONS 1 (SUBSTR (CADR n) text_cnt (SETQ text_strlen (1- text_strlen))))
                                    (CONS 10 abrdespt)
                                    (CONS 40 abrtxtht)
                                    (CONS 62 (ATOI abrcolr))
                              ) ;_ end of LIST
               ) ;_ end of SETQ
;;;                 (PRINC "\nWhile (3) ")
;;;                 (PRINC (SUBSTR (CADR n) text_cnt text_strlen))
;;;                 (PRINC)
             ) ;_ end of WHILE
;;;                 (PRINC "\n MAKE TEXT: (1) ")
;;;                 (PRINC (SUBSTR (CADR n) text_cnt text_strlen))
;;;                 (PRINC)
             (ENTMAKE text_lst)
             (SSADD (ENTLAST) abbr_ss)
             (SETQ text_strlen (STRLEN (SUBSTR (CADR n) (1+ text_strlen)))
                   text_cnt    (+ text_cnt (STRLEN (CDR (ASSOC 1 text_lst))) 1)
                   text_lst    (LIST (CONS 0 "text")
                                     (CONS 1 (SUBSTR (CADR n) text_cnt))
                                     (CONS 10 abrdespt)
                                     (CONS 40 abrtxtht)
                                     (CONS 62 (ATOI abrcolr))
                               ) ;_ end of LIST
                   descr_box   (TEXTBOX text_lst)
                   descr_len   (DISTANCE (CAR descr_box) (APPEND (LIST (CAADR descr_box)) (CDAR descr_box)))
                   abrdespt    (POLAR abrdespt (* PI 1.5) (* 1.5 abrtxtht))
                   abrstrtpt   (POLAR abrdespt PI abrcolwid)
             ) ;_ end of SETQ
           ) ;_ end of WHILE
;;;                 (PRINC "\n MAKE TEXT: (2) ")
;;;                 (PRINC (CDR (ASSOC 1 text_lst)))
;;;                 (PRINC "\n")
;;;                 (PRINC " ***** END OF DESCRIPTION ***** ")
;;;                 (PRINC "\n")
;;;                 (PRINC)
           (SETQ ;abrdespt (POLAR abrdespt (* PI 1.5) (* 1.5 abrtxtht))
             text_lst (LIST (CONS 0 "text")
                            (CONS 1 (SUBSTR (CADR n) text_cnt))
                            (CONS 10 abrdespt)
                            (CONS 40 abrtxtht)
                            (CONS 62 (ATOI abrcolr))
                      ) ;_ end of LIST
;;;                           abrstrtpt (POLAR abrdespt PI abrcolwid))
           ) ;_ end of SETQ
           (ENTMAKE text_lst)
           (SSADD (ENTLAST) abbr_ss)
           (SETQ abrdespt  (POLAR abrdespt (* PI 1.5) (* 0.75 abrtxtht))
                 abrstrtpt (POLAR abrdespt PI abrcolwid)
           ) ;_ end of SETQ
    ) ;_ end of PROGN
  ) ;_ end of IF
) ;_ end of DEFUN
(DEFUN set_colr (pre /)
  (if (and (> (atoi (get_tile (strcat pre "colr")))0)(< (atoi (get_tile (strcat pre "colr")))256))
    (set (read (strcat pre "colr")) (get_tile (strcat pre "colr")))
    (progn
      (SET_TILE "error" (strcat (get_tile (strcat pre "colr")) " is an invalid color.  Enter a color number 1-255. "))
      (set (read (strcat pre "colr")) "1")
      (set_tile (strcat pre "colr") "1")
      (mode_tile (strcat pre "colr") 2)
    )
  )
)
(DEFUN abrad_chk ()
  (SETQ abradtxt (GET_TILE "abbr_add"))
  (SETQ dscadtxt (GET_TILE "desc_add"))
  (IF (EQ abradtxt "")
    (SETQ abradtxt NIL)
  ) ;_ end of IF
  (IF (EQ dscadtxt "")
    (SETQ dscadtxt NIL)
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun

 ;|«Visual LISP© Format Options»
(120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T)
;*** DO NOT add text below the comment! ***|;