Как вызвать диалог открытия файла с позвожностью выбора более одного файла (Страница 2 из 2)

(defun get_file_list  (start_dir file_type / dcl_id list_of_disc temp test start-dir list_of_dir
               list_of_file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
               change_dir add_space_rec    String_delim)
              ;|

Selection function of multiple files
(get_file_list start_dir file_type)

Arguments:
start_dir - (string) start path, for example "C: \ \ Program Files \ \ Autodesk \ \ AutoCAD \ \ 2011 \ \ Support", or nil
file_type - (list) a sample file, for example '("*.tab" "*.jgw") , or nil


Returns:
list whose first element is the path to the files, all following names of selected files

(get_file_list "D:\\My Dropbox" '("*.tif" "*.jpg"))

|;
  (vl-load-com)
;;;-----------------------------------
;;;
;;;change_dir
;;;
  (defun change_dir  (/ start-dir_2 space list-of-dir)
    (setq start_dir    (if (or (not start_dir) (not (vl-file-directory-p start_dir)))
             (car list_of_disc)
             start_dir)
      start-dir    (String_delim start_dir "\\")
      start-dir_2  (cons (car start-dir)
                 (mapcar (function (lambda (x) (strcat "\U+2514" x)))
                     (cdr start-dir)))
      start-dir_2  (add_space_rec start-dir_2)
      list_of_dir  (vl-remove-if (function (lambda (x) (or (eq x ".") (eq x ".."))))
                     (vl-directory-files start_dir "*.*" -1))
      space           ""
      list_of_file (apply 'append
                  (mapcar (function (lambda (x) (vl-directory-files start_dir x 1)))
                      file_type)))
    (repeat (length start-dir) (setq space (strcat space "  ")))
    (if    list_of_dir
      (setq list-of-dir    (append    (mapcar    (function (lambda (x) (strcat "\U+251C" x)))
                    (reverse (cdr (reverse list_of_dir))))
                (list (strcat "\U+2514" (car (reverse list_of_dir)))))
        list-of-dir    (mapcar    (function (lambda (x) (strcat space x)))
                list-of-dir))
      (setq list-of-dir nil))
    (start_list "dir")
    (mapcar 'add_list (append start-dir_2 list-of-dir))
    (end_list)
    (start_list "_file")
    (mapcar 'add_list list_of_file)
    (end_list))
;;;
;;;add_space_rec
;;;
  (defun add_space_rec    (list_ /)
    (if    (cdr list_)
      (cons (car list_)
        (add_space_rec
          (mapcar (function (lambda (x) (strcat "  " x))) (cdr list_))))
      list_))
;;;
;;;;;;String_delim
;;;
  (defun String_delim  (string_ delim_ / delim_length string_list temp)
    (setq delim_length (strlen delim_)
      string_list  '()
      temp           "")
    (while (/= string_ "")
      (setq
    string_list (cons (while (and (/= string_ "")
                      (not (eq delim_ (substr string_ 1 delim_length))))
                (setq temp      (strcat temp (substr string_ 1 1))
                  string_ (substr string_ 2)
                  temp      temp))
              string_list))
      (setq string_ (substr string_ (1+ delim_length))
        temp    ""))
    (reverse string_list))
;;;-----------------------------------
;;;;;;  Загружаем диалог
  (if (< (setq dcl_id (load_dialog "load_list_file.DCL")) 0)
    (exit))
;;;;;;  Список дисков
  (setq    list_of_disc
     (vl-sort
       (mapcar
         (function (lambda (x) (substr x 13)))
         (vl-remove-if-not (function (lambda (x)
                       (and    (wcmatch x "*DosDevices*")
                        (vl-directory-files (substr x 13)))))
                   (vl-registry-descendents
                 "HKEY_LOCAL_MACHINE\\SYSTEM\\MountedDevices\\"
                 "")))
       '<)
    file_type     (if (and file_type
              (not(vl-member-if 'not (mapcar(function(lambda (x) (and
                                     (eq (type x)'STR)
                                     (wcmatch x "*.*"))))file_type)))
             )
           file_type
           '("*.*")
         )
    )
;;;;;;  
  (new_dialog (if (= (getvar "SysCodePage") "ANSI_1251")
        "load_list_file_dial_ru"
        "load_list_file_dial_en")
          dcl_id)
  (change_dir)
  (start_list "disk")
  (mapcar 'add_list list_of_disc)
  (end_list)
  (set_tile "disk"
        (itoa (vl-position (car start-dir) list_of_disc)))
  (action_tile "_file" "(setq test $value)")
  (action_tile "accept" "(done_dialog 111)")
  (action_tile "disk"
           "(setq start_dir (nth (atoi $value) list_of_disc))
    (change_dir)")
  (action_tile
    "dir"
    (vl-prin1-to-string
      (quote
    (progn (setq temp (atoi $value))
           (cond ((< temp (length start-dir))
              (setq start_dir (car start-dir))
              (repeat temp
            (setq start-dir    (cdr start-dir)
                  start_dir    (strcat start_dir "\\" (car start-dir)))))
             (t
              (setq start_dir (strcat start_dir
                          "\\"
                          (nth (- temp (length start-dir)) list_of_dir)))))
           (change_dir)))))
  (action_tile "cancel" "(done_dialog)")
  (if (eq (start_dialog) 111)
    (cons start_dir
      (if test
        (mapcar (function (lambda (x) (nth (atoi x) list_of_file)))
            (String_delim test " "))))))

load_list_file_dial_en: dialog{label="Select the files";
:column{label=" ";
:row{
:column{label="Path";key="Path";
:popup_list{label="disk drive";key="disk";fixed_width=true; width=5;}
:list_box{key="dir";width=35;}
}
:column{label="Files";
:list_box{key="_file";multiple_select=true;width=30;}
}}
:spacer{height=0.5;}
}
ok_cancel;
}

load_list_file_dial_ru: dialog{label="Выбор файлов";
:column{label=" ";
:row{
:column{label="Путь";key="Path";
:popup_list{label="Диски";key="disk";fixed_width=true; width=5;}
:list_box{key="dir";width=35;height=20;}
}
:column{label="Файлы";
:list_box{key="_file";multiple_select=true;width=30;}
}
}
:spacer{height=0.5;}
}
ok_cancel;
}