Liren Large Software Subsidy 13/13.iso/p/p024/5.img/SUPPORT3.LIB/APPLOAD.LSP

Text File | 1993-01-23 | 11.9 KB | 405 lines

;;;----------------------------------------------------------------------------
;;;
;;;   APPLOAD.LSP   ¬⌐Ñ╗ 0.5
;;;
;;;   ¬⌐┼v (C) 1991-1992  Autodesk ñ╜Ñq
;;;
;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
;;;   ¡∞½h :
;;;
;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
;;;
;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
;;;
;;;
;;;----------------------------------------------------------------------------
;;;   DESCRIPTION
;;;
;;;  An AutoLISP routine with a dialogue interface allowing users select
;;;  AutoLISP and ADS routines to load or unload.  Frequently used routines
;;;  can be saved to a file so that subsequent loads or unloads can be
;;;  performed quickly and easily from a small list of favorites rather than
;;;  scrolling through complete directory listings.
;;;
;;;----------------------------------------------------------------------------
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
                      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 "APPLOAD"
                  (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
                          "\n  ╜╨└╦¼díusupportívÑ╪┐²íC")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "APPLOAD" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  )

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

;;; ==================== end load-time operations ===========================
;;;----------------------------------------------------------------------------
;;; The main fuinction.
;;;----------------------------------------------------------------------------
(defun c:appload (/
                    a             fp_list1      pickf
                    add2lists     from          pickf1        the_list
                    addfile       globals       pickf_list    ub
                    appload_err   grey          pickf_no      unloadf
                    cmd           is_one_ads    pos           updbox
                    dcl_id        item          read_dfs      what
                    lb            remfile       what_next     appload_main
                    er            loadf         remove        what_pos
                    f             make_list     rs_err        yep
                    filetype      no_load       s
                    fname         no_unload     save_list
                    fp_list       olderr        save_tog
                  )
  ;;
  ;; Make a list of all highlighted files for loading or unloading.  Similar
  ;; code to remfile below.  Returns the list.
  ;;
  (defun make_list(/ pickf_no pickf_list fp_list1 n)
    (setq pickf1 pickf)
    (while (setq pickf_no (read pickf1))
      (setq pickf_list (cons pickf_no pickf_list))
      (setq pickf1 (substr pickf1 (+ 2 (strlen (itoa pickf_no)))))
    )
    (setq n 0)
    (while (< n (length fp_list))
      (if (member n pickf_list)
        (progn
          (setq fp_list1 (cons (nth n fp_list) fp_list1))
        )
      )
      (setq n (1+ n))
    )
    fp_list1
  )
  ;;
  ;; Load the files.
  ;;
  (defun loadf( / n)
    (setq no_load 0)
    (foreach n (setq er (make_list))
      (princ (strcat "\n╕ⁿñJ " n " ..."))
      (cond
        ((= "lsp" (strcase (substr n (- (strlen n) 2)) T))
          (load n (strcat "ºΣñú¿∞└╔«╫íu" n "ívíC"))
        )
        ((member n (ads))
          (princ (strcat "\n└│Ñ╬╡{ªííu" n "ívñw╕ⁿñJíC"))
        )
        (T
          (if (= (xload n "invalid") "invalid")
              (princ (strcat "\n└╔«╫íu" n "ív╡L«─íC"))
              (princ (strcat "\n└╔«╫íu" n "ívñw╕ⁿñJíC"))
          )
        )
      )
    )
  )
  ;;
  ;; Unload the files.
  ;;
  (defun unloadf(/ n)
    (setq no_unload 0)
    (foreach n (make_list)
      (princ (strcat "\n─└⌐±íu" n "ív..."))
      (cond
        ((= "lsp" (strcase (substr n (- (strlen n) 2)) T))
          (princ (strcat "\níu" n
                         "ív└╔ªW╡L«─ - AutoLISP └╔«╫╡L¬k─└⌐±íC"))
        )
        ((not (member n (ads)))
          (princ (strcat "\níu" n
                         "ív└╔«╫╡L«─ - └│Ñ╬╡{ªíÑ╝╕ⁿñJíC"))
        )
        ((xunload n))
      )
    )
  )
  ;;
  ;; Check the list to find out whether the load and unload buttons should be
  ;; enabled or not.  Returns a list which consist of two numbers, l and u.
  ;; The buttons are enabled if the corresponding value is greater than 0.
  ;;
  (defun is_one_ads(/ yep n)
    (setq lb 0)
    (setq ub 0)
    (foreach n (make_list)
      (if (/= ".lsp" (strcase (substr n (- (strlen n) 3)) T))
        (progn
          (if (member n (ads))
            (setq ub (1+ ub))  ; enable unload button
            (setq lb (1+ lb))  ; enable load button
          )
        )
        (setq lb (1+ lb))
      )
    )
    (list lb ub)
  )
  ;;
  ;; Disable the Remove control if no items are highlighted.
  ;;
  (defun grey()
    (if (read (get_tile "fp_list"))
      (progn
        (mode_tile "remove_item" 0)
        (if (< 0 (car (is_one_ads)))
          (mode_tile "load" 0)
          (mode_tile "load" 1)
        )
        (if (< 0 (cadr (is_one_ads)))
          (mode_tile "unload" 0)
          (mode_tile "unload" 1)
        )
      )
      (progn
        (mode_tile "remove_item" 1)
        (mode_tile "load" 1)
        (mode_tile "unload" 1)
      )
    )
  )
  ;;
  ;; Reset the error tile.
  ;;
  (defun rs_err()
    (set_tile "error" "")
  )
  ;;
  ;; Read appload.dfs for defaults.
  ;;
  (defun read_dfs()
    (if (setq f (open "appload.dfs" "r"))
      (progn
        (while (setq a (read-line f))
          (setq fp_list (cons a fp_list))
        )
        (close f)
        (if (and fp_list (>= (getvar "maxsort") (length fp_list)))
          (setq fp_list (acad_strlsort fp_list))
        )
        (updbox)
      )
    )
  )
  ;;
  ;; Save the current list to file.  Null lists are allowed.
  ;;
  (defun save_list()
    (if (= "1" save_tog)
      (progn
        (if (setq f (open "appload.dfs" "w"))
          (progn
            (if fp_list
              (progn
                (foreach n fp_list
                  (write-line n f)
                )
              )
            )
            (close f)
          )
          (alert (strcat "╡L¬k▒Níu▓M│µívªsñJÑ╪½eÑ╪┐²\n"
                         " - Ñ▓╢╖╛╓ª│ª╣Ñ╪┐²¬║íu╝gñJñ╣╖╟ívíC")
          )
        )
      )
    )
  )
  ;;
  ;; Add a file to the list, using the File Dialog box
  ;;
  (defun addfile ()
    (setq fname (getfiled "┐∩╛▄íuLISP/ADSív▒`ªí" "" filetype 2))
    (if fname
      (progn
        (add2lists fname)
      )
    )
  )
  ;;
  ;; Add a file to the internal lists used for loading
  ;;
  (defun add2lists (fname)
    (if (not (member fname fp_list))
      (progn
        (setq fp_list (append fp_list (list fname)))
        (if (and fp_list (>= (getvar "maxsort") (length fp_list)))
          (setq fp_list (acad_strlsort fp_list))
        )
        (updbox)
        (set_tile "fp_list" (itoa (what_pos fname fp_list)))
        (setq pickf (get_tile "fp_list"))
        (grey)
      )
    )
  )
  ;;
  ;; Pass an item and a list and recieve a number showing it's position in
  ;; the list, nil otherwise.  Item must be in the list, and the list must
  ;; contain unique names. 0 if first item.
  ;;
  (defun what_pos (item the_list / pos)
    (setq pos (- (length the_list)
                 (length (member item the_list)))
    )
  )
  ;;
  ;;  Remove the currently highlighted selections fp_list
  ;;
  (defun remfile (/ pickf_list pickf_no fp_list1)
    (while (setq pickf_no (read pickf))
      (setq pickf_list (cons pickf_no pickf_list))
      (setq pickf (substr pickf (+ 2 (strlen (itoa pickf_no)))))
    )
    (setq n 0)
    (while (< n (length fp_list))
      (if (not (member n pickf_list))
        (progn
          (setq fp_list1 (cons (nth n fp_list) fp_list1))
        )
      )
      (setq n (1+ n))
    )
    (setq fp_list (reverse fp_list1))
    (updbox)
    (setq pickf "")
    (grey)
  )
  ;;
  ;;  Remove an item from the list.
  ;;
  (defun remove (what from)
    (append (reverse (cdr (member what (reverse from))))
            (cdr (member what from))
    )
  )
  ;;
  ;; Build and display a list in the list_box
  ;;
  (defun updbox ()
    (start_list "fp_list")
    (mapcar 'add_list fp_list)
    (end_list)
  )

  ;;
  ;; Put up the dialogue.
  ;;
  (defun appload_main()

    (setq fp_list nil)
    (cond
      ((= (getvar "platform") "386 DOS Extender")
       (setq filetype "lsp;exp")
      )
      ((= (getvar "platform") "Windows")
       (setq filetype "lsp;exe")
      )
      (t (setq filetype "*"))
    )

    (if (not (new_dialog "appload" dcl_id)) (exit))
    (read_dfs)
    (if fp_list
      (progn
        (set_tile "fp_list" "0")
        (setq pickf "0")
        (grey)
      )
      (progn
        (mode_tile "remove_item" 1)
        (mode_tile "load" 1)
        (mode_tile "unload" 1)
      )
    )
    ;; If a default exists for the save list toggle, use it.  Else set the
    ;; toggle to 1.
    (if (setq save_tog (cadr (assoc "appload" ai_defaults)))
      (set_tile "save_list" save_tog)
      (set_tile "save_list" (setq save_tog "1"))
    )
    (action_tile "fp_list"      "(rs_err)(setq pickf $value)(grey)" )
    (action_tile "add_to_list"  "(rs_err)(addfile)" )
    (action_tile "remove_item"  "(rs_err)(remfile)" )
    (action_tile "save_list"    "(rs_err)(setq save_tog $value)")
    (action_tile "load"         "(save_list)(done_dialog 2)")
    (action_tile "unload"       "(save_list)(done_dialog 3)")
    (action_tile "cancel"       "(save_list)(done_dialog 0)")
    (action_tile "help"         "(acad_helpdlg \"acad.hlp\" \"appload\")")
    (setq what_next (start_dialog))
    (cond
      ((= 2 what_next) (loadf))
      ((= 3 what_next) (unloadf))
    )
    (if (assoc "appload" ai_defaults)
      (setq ai_defaults (subst (list "appload" save_tog)
                               (assoc "appload" ai_defaults)
                               ai_defaults
                        )
      )
      (setq ai_defaults (cons (list "appload" save_tog) ai_defaults))
    )
  )

  ;; 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_transd)))                       ; transparent OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "appload"))))  ; is .DCL file loaded?
     (t (appload_main))                          ; proceed!
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)

  (princ)
)

;;;----------------------------------------------------------------------------
(princ "  íuAPPLOADívñw╕ⁿñJíC  ")
(princ)