Shareware Overload/ShartewareOverload.cdr/wp/bmacs.zip/DIR.M

Text File | 1987-07-23 | 21KB | 584 lines

;***
;***  Directory Handling Macro   dir.m
;***
;***  dir  produces a directory listing via DOS and allows files to be
;***  copied, deleted, edited, inserted into the current buffer, & renamed.
;***
;***  Prompts for an acceptable DOS directory command line, such as  b:
;***  or   b:\brief\macros\*.m.
;***  A second parameter (optional and not prompted) causes the display
;***  of file details such as date, time and attribute flags.
;***
;***  Written by Mark U. Edwards  11-17-84 v. 1.00  (dired.m)
;***  Rewritten by Joe R. Doupnik  12 August 1985 to version 2.0  (dir.m)
;***     Remove separate help menu; put help on window border.
;***     Show subdirectory names (files with <DIR> tag) and all file names.
;***     Get path name from DOS.
;***     Show DOS error messages whereever reasonable.
;***     Ensure that ESC does its expected thing (aborts a command).
;***     Add up/down paging of listing.
;***     Revise all external symbols (variables & macros) to d_xxx form.
;***     Clarify code and strengthen same; upgraded to BRIEF v1.2.
;***
;***     One work files, dir$.err, may be created
;***     in the default directory. Both are deleted upon macro completion.
;***     Only BRIEF intrinsic functions, and macros in this file, are used.
;***
;***     Updated by Harold Handelsman, April 12 1987 for Brief v2.0.
;***     Use the new directory searching functions in Brief.
;***     Enhanced the interface to allow multiple files to be added to the
;***     current list of edited files within the one invocation of the
;***     macro with the A (add file) macro.
;***     Added sizing of the directory display window for hardware
;***     display size.
;***     Note: the current implementation of Brief does not allow the
;***     correct display of file size since only the lower word of
;***     the file size is returned.
;***
;***     Updated by Michael Shunfenthal
;***     Home and End cursor positioning added
;***     Window created of variable width depending upon presence of
;***     optional date, time, etc display parameter
;***     Message displays file specification.

(macro dir
   (                    ; This is the only intended entry point!
      (string
         d_path
         temp)

      (int
         d_bottom       ; y-position of last file in directory list window
         d_top
         d_line
         d_orig_buffer
         d_dir_buf
         d_misc         ; optional parameter
         d_wsize)

      (global
         d_bottom
         d_top d_line
         d_orig_buffer
         d_dir_buf
         d_path
         d_misc
         d_wsize)

      (if (get_parm 0 d_path "Directory spec: ")
         (
            (message "Creating file list for %s" d_path)

            (if (! (get_parm 1 d_misc))      ; check for optional param.
               (= d_misc 0)                  ; default it to false
            )
            (= d_orig_buffer (inq_buffer))   ; remember current buffer
            (if (_dsetup)                    ; if setup failed
               (
                  (set_buffer d_orig_buffer) ; restore original
                  (delete_buffer d_dir_buf)
               )
            ; else  all went ok
               (
                  (message "")
                  (inq_screen_size d_wsize)
                  (if d_misc
                     (create_window 11 (- d_wsize 4) 65 2
                     "<Esc> A=Add C=Copy D=Del E=Edit I=Ins R=Ren Home End")
                     ; else
                     (create_window 11 (- d_wsize 4) 45 2
                     "<Esc> Add Copy Del Ed Ins Ren ")
                  )
                  (attach_buffer d_dir_buf)
                  (refresh)

                  (keyboard_push)            ; define active keys, save old
                  (assign_to_key "<Esc>"   "d_exit")        ; ESC
                  (assign_to_key "<Up>"    "d_up")          ; up arrow
                  (assign_to_key "<Down>"  "d_down")        ; down arrow
                  (assign_to_key "<PgUp>"  "d_pgup")        ; PgUp
                  (assign_to_key "<PgDn>"  "d_pgdn")        ; PgDn
                        (assign_to_key "%#71" "d_home")              ; Home
                        (assign_to_key "%#79" "d_end")              ; End
                  (assign_to_key "c"       "d_copy")        ; c
                  (assign_to_key "C"       "d_copy")        ; C
                  (assign_to_key "d"       "d_delete")      ; d
                  (assign_to_key "D"       "d_delete")      ; D
                  (assign_to_key "e"       "d_edit")        ; e
                  (assign_to_key "E"       "d_edit")        ; E
                  (assign_to_key "a"       "d_add_edit")    ; a
                  (assign_to_key "A"       "d_add_edit")    ; A
                  (assign_to_key "<Enter>" "d_edit")        ; <Enter>
                  (assign_to_key "i"       "d_insert")      ; i
                  (assign_to_key "I"       "d_insert")      ; I
                  (assign_to_key "r"       "d_rename")      ; r
                  (assign_to_key "R"       "d_rename")      ; R
                  (process)
                  (keyboard_pop)                ; restore old keyboard
                  (message "")
               )                                      ; end of ok clause
            )                                         ; endif setup
         )                                            ; end got a dir spec
      )                                               ; endif get dir spec
;;;   (delete_macro "dir")       ; uncomment to remove ourselves when done
   )
)

(macro _dsetup
   (                             ; validate listing, get path name from DOS.
                                 ; DOS error messages are placed here & there
      (string  temp)
      (int fsize fdate ftime fattr)

      (= d_dir_buf (create_buffer "Directory" NULL 1))
      (set_buffer d_dir_buf)
      (insert "Directory for: ")                      ; insert heading
      (insert d_path)
      (insert "\n")
      (inq_position d_top)                            ; save position of top
      (++ d_top)

      (if (_d_path_fixup d_path temp)                 ; mess with the path
         (return 1)
      )
      (file_pattern temp)                             ; set the search pattern

      (while (find_file temp fsize fdate ftime fattr) ; loop over all files
         (
            (= temp (+ "\n" temp))                    ; insert the name
            (= temp (+ temp (substr "              " (+ (strlen temp) 1))))
            (if (% (/ fattr 16) 2)                    ; is it a directory?
               (+= temp "<Dir>  ")
            ;else
               (sprintf temp "%s%7u" temp fsize)      ; display size
            )
            (insert temp)
            (if d_misc                                ; requested additional info?
               (insert (_d_gen_misc fdate ftime fattr))
            )
         )
      )
      (inq_position d_bottom)                         ; save position of last line
      (insert "\n")
      (if (> d_top d_bottom)                          ; any files found ?
         (
            (error "No file(s).")
            (return 1)
         )
      ;else
         (
            (move_abs (= d_line d_top) 1)             ; go to first line
            (drop_anchor)                             ; highlight it
            (end_of_line)
            (return 0)                                ; return with no error
         )
      )
   )
)

;***
;*** This macro will fix up a user specified path/filename and returns a
;*** complete path (including trailing backslash as well as a directory
;*** search string. Returns 0 if all is OK, 1 only if no file is found.
;*** Note: Currently, the routine will not generate a wildcard search string
;*** if no extension is specified.
;***
;*** e.g. Calling the macro with the first argument = "\brief\macros" will
;***      check if the path specified is a directory or a file and will
;***      return "\brief\macros\" in the first argument and in the second
;***      it will return "\brief\macros\*.*" if it was a directory. The
;***      second string can be used to initiate a directory search.
;***

(macro _d_path_fixup
   (
      (int fattr)
      (string str1 str2)

      (get_parm 0 str1)

      ;** Check if the specified path consists of just the driver specifier.

      (if (&& (== (substr str1 2 1) ":") (== (strlen str1) 2))
         (

            ;** Just add the wildcards *.* to the directory search string.

            (put_parm 1 (+ str1 "*.*"))
            (return 0)
         )
      )

      ;** Check if the path is null or there is a trailing backslash.

      (if (|| (== (substr str1 (strlen str1) 1) "\\") (== str1 ""))
         (

            ;** Just add the wildcards *.* to the directory search string.

            (put_parm 1 (+ str1 "*.*"))
            (return 0)
         )
      )

      ;** Check if there are NO wildcards in the path string.

      (if (! (search_string "[\\?\\*]" str1 1))
         (
            ;** Search for the file and check if it is a directory

            (file_pattern str1)
            (if (! (find_file str2 NULL NULL NULL fattr))
               (
                  (error "No file(s).")
                  (return 1)
               )
            )

            ;** Check if it is a directory

            (if (% (/ fattr 16) 2)
               (

                  ;** Add the trailing backslash to the path and the
                  ;** wildcards *.* to the search string.

                  (put_parm 0 (+ str1 "\\"))
                  (put_parm 1 (+ str1 "\\*.*"))
                  (return 0)
               )
            )
         )
      )

      ;** Check if there is a directory specified in the path string.

      (if (= fattr (rindex str1 "\\"))
         (

            ;** Strip the trailing filename and return the just the directory
            ;** as the path and the full path/filename as the search string.

            (put_parm 0 (substr str1 1 fattr))
            (put_parm 1 str1)
            (return 0)
         )
      ;else

         ;** No directory, check for a drive specification.

         (if (= fattr (rindex str1 ":"))
            (
               ;** Strip the trailing filename and return just the drive as
               ;** the path and the full filename as the search string.

               (put_parm 0 (substr str1 1 fattr))
               (put_parm 1 str1)
               (return 0)
            )
         ;else
            (
               ;** No directory or drive specified. Return the null string for
               ;** the path and the filename as the search string.

               (put_parm 0 "")
               (put_parm 1 str1)
               (return 0)
            )
         )
      )
   )
)

(macro d_exit                          ; exit for this dir macro
   (
      (exit)                                       ; exit from process command
      (delete_window)                              ; clean up buffers
      (set_buffer d_orig_buffer)
      (delete_buffer d_dir_buf)
   )
)

(macro d_up                            ; line up
   (
      (message "")
      (raise_anchor)
      (if (< (-- d_line) d_top)                    ; first file is on line 5
         (
            (= d_line d_top)
            (top_of_buffer)
            (refresh)
         )
      )                                            ; endif
      (move_abs d_line 1)
      (drop_anchor)                                ; display choice bar
      (end_of_line)
   )
)

(macro d_down                          ; line down
   (
      (message "")
      (raise_anchor)
      (if (> (++ d_line) d_bottom)                 ; last file is on line d_bottom
         (
            (= d_line d_bottom)
            (end_of_buffer)
            (refresh)
         )
      )                                            ; endif
      (move_abs d_line 1)
      (drop_anchor)                                ; display choice bar
      (end_of_line)
   )
)

(macro d_pgup                          ; page up
   (
      (-= d_line d_wsize)
      (d_up)
   )
)

(macro d_pgdn                          ; page down
   (
      (+= d_line d_wsize)
      (d_down)
   )
)


(macro d_home                                                        ;go to first file
    (
        (= d_line d_top)                                            ;force top of buffer
        (d_up)                                                        ;line up
    )
)

(macro d_end                                                        ;go to last file
    (
        (= d_line d_bottom)                                        ;force end of buffer
        (d_down)                                                        ;line down
    )
)

(macro d_edit                          ; edit the file and exit
   (
      (string temp)

      (= temp (_dfilename))
      (d_exit)
      (edit_file temp)
   )
)

(macro d_add_edit                      ; edit the file, but remain
   (
      (string temp)

      (= temp (_dfilename))
      (d_down)
      (edit_file temp)
      (message "Added file: %s" temp)
      (set_buffer d_dir_buf)
      (attach_buffer d_dir_buf)
   )
)

(macro d_insert                        ; insert file into current buffer
   (
      (string temp)

      (= temp (_dfilename))
      (d_exit)
      (read_file temp)
   )
)

(macro d_delete                        ; delete selected file
   (
      (int  old_line  old_col  char)

      (inq_position old_line old_col)
      (keyboard_flush)
      (insert " - del? (y/n)")                        ; ask for permission
      (refresh)                                       ; show the tag line
      (while (== (= char (read_char)) -1))            ; read a keystroke
      (move_abs old_line old_col)                     ; remove the tag line
      (delete_to_eol)
      (%= char 256)                                   ; remove scan code
      (if (|| (== char 'y') (== char 'Y'))            ; then 'y' or 'Y'
         (
            (if (> (del (_dfilename)) 0)
               (                                      ; delete succeeded
                  (delete_line)
                  (if (> old_line (-- d_bottom))      ; below new bottom?
                     (if (< d_bottom d_top)           ; deleted last file?
                        (d_exit)                      ; yes, exit
                     ; else
                        (d_up)                        ; bump choice bar
                     )                                ; endif no more files
                  )                                   ; endif below new bottom
               )
               ; else
                  (error "Can't delete that file.")   ; delete failed
            )                                         ; endif
         )
      )                                               ; endif yes
   )
)

(macro d_rename
   (                                   ; rename an existing file.
                                          ; Note: trying to rename a directory
                                          ; can produce unwanted side effects
   (int   dot)
      (string  path  new_name  new_2)

      (if (get_parm 0 new_name "Rename to: ")
         (
            (if (strlen new_name)                        ; new name given?
               (                                         ; yes
                  (= new_name (_dupcase new_name))

                  (message "%s" (+ "REN " (+ (_dfilename) (+ " " new_name))))
                  (getwd NULL path)                      ; avoid BRIEF|DOS bug
                  (dos (+ "REN >&$dir$.err " (+ (_dfilename) (+ " " new_name))))
                  (cd  path)                             ; bug remover #2

                  (if (! (_derror))                      ; did it work?
                     (                                   ; yes
                        (move_abs 0 12)
                        (delete_block)                   ; clear name field
                        (= new_2 (+ (upper new_name)
                           (substr "            " (+ (strlen new_name) 1))))
                        (drop_anchor)                    ; make choice bar
                        (insert new_2)                   ; insert new name
                        (end_of_line)
                        (refresh)
                     )                                   ; end no error clause
                  )                                      ; endif no error
               )
            ; else
               (message "Command terminated.")           ; no new name
            )                                            ; endif new name given
         )                                               ; end parm given clause
      )                                                  ; endif get_parm
   )
)

(macro d_copy                          ; copy chosen file to another file
   (
      (string  dest_name)

      (if (get_parm 0 dest_name "Copy to: ")
         (
            (if  (strlen dest_name)                      ; destination given?
               (
                  (= dest_name (_dupcase dest_name))
                  (message "%s" (+ "COPY " (+ (_dfilename)
                                                   (+ " " dest_name))))
                  (dos (+ "COPY >&$dir$.err "
                                 (+ (_dfilename) (+ " " dest_name))))
                  (_derror)                              ; show status
               )
               ; else
                  (error "No destination - copy not done.")
            )                                            ; endif file ok
         )                                               ; end do a copy
      )                                                  ; endif do a copy
   )
)

(macro _d_gen_misc
   (
      (int fdate ftime fattr i j)
      (string temp)

      (get_parm 0 fdate)
      (get_parm 1 ftime)
      (get_parm 2 fattr)

      (= i (/ fdate 32))
      (= j (+ 80 (/ i 16)))
      (%= i 16)
      (sprintf temp "  %2d/%02d/%2d " i (% fdate 32) j)
      (= j (/ ftime 32))
      (if (< j 0)
         (+= j 2048)
      )
      (= i (/ j 64))
      (%= j 64)
      (sprintf temp "%s%2d:%02d " temp i j)
      (if (% (/ fattr 32) 2)
         (+= temp "A")
      ;else
         (+= temp " ")
      )
      (if (% fattr 2)
         (+= temp "R")
      ;else
         (+= temp " ")
      )
      (if (% (/ fattr 2) 2)
         (+= temp "H")
      ;else
         (+= temp " ")
      )
      (if (% (/ fattr 4) 2)
         (+= temp "S")
      ;else
         (+= temp " ")
      )
   )
)

(macro _dfilename
   (                                   ; get filename from display list
      (string temp)

      (beginning_of_line)
      (= temp (read 12))                              ; read filename + tag
      (end_of_line)                                   ; restore cursor position
      (returns (trim (+ d_path temp)))                ; prepend path name
   )
)

(macro _derror
   (                          ; get and display dos command's message line.
                              ; Note: DOS error messages begin with ascii
                              ; text in column 1, informational messages
                              ; start with spaces or are completely null.
   (int  _derror_buf)
      (string temp)

      (= _derror_buf (create_buffer "error" "$dir$.err" 1)) ; make a buffer
      (set_buffer _derror_buf)                           ; look in it
      (end_of_buffer)                                    ; add two blank lines
      (insert " \n \n")                                  ; in case file is empty
      (move_abs 2 1)                                     ; message coordinates
      (= temp (read))
      (= temp (substr temp 1 (- (strlen temp) 1)))       ; trim trailing c/r
      (set_buffer d_dir_buf)                             ; restore popup
      (delete_buffer _derror_buf)                        ; remove temp buf
      (del "$dir$.err")                                  ; delete work file
      (message "%s" temp)                                ; show DOS message
      (if (> (substr temp 1 1) " ")                      ; text means error
         (returns 1)                                     ; say DOS error
      ; else
         (returns 0)                                     ; DOS success msg
      )                                                  ; endif
   )
)

(macro _dupcase
   (                             ; convert string old to upper case string new
      (string  old)

      (get_parm 0 old)
      (return (upper old))
   )
)