From 97ae83b33c2a5b1860bb981597d3534db5942f29 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 14 Feb 1995 00:30:44 +0000 Subject: [PATCH] Add new file "diros2.scm" that supports compressed files under OS/2. --- v7/src/edwin/decls.scm | 5 +++-- v7/src/edwin/dired.scm | 37 +++++++++++++++++++++++++++++++------ v7/src/edwin/dirunx.scm | 29 ++++------------------------- v7/src/edwin/ed-ffi.scm | 6 ++++-- v7/src/edwin/edwin.ldr | 7 ++++--- v7/src/edwin/edwin.pkg | 38 ++++++-------------------------------- 6 files changed, 52 insertions(+), 70 deletions(-) diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm index 7e591c1dc..65899f795 100644 --- a/v7/src/edwin/decls.scm +++ b/v7/src/edwin/decls.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: decls.scm,v 1.53 1994/12/19 19:38:30 cph Exp $ +$Id: decls.scm,v 1.54 1995/02/14 00:29:58 cph Exp $ -Copyright (c) 1989-94 Massachusetts Institute of Technology +Copyright (c) 1989-95 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -139,6 +139,7 @@ MIT in each case. |# "debug" "debuge" "dired" + "diros2" "dirunx" "docstr" "dos" diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm index a018fe72a..22ae36b14 100644 --- a/v7/src/edwin/dired.scm +++ b/v7/src/edwin/dired.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dired.scm,v 1.153 1995/01/31 21:38:09 cph Exp $ +;;; $Id: dired.scm,v 1.154 1995/02/14 00:30:11 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology ;;; @@ -244,10 +244,14 @@ Type `h' after entering dired for more info." (define (read-directory pathname file-list switches mark) (if (eq? 'ALL file-list) - (insert-directory! pathname switches mark - (if (file-directory? pathname) - 'DIRECTORY - 'WILDCARD)) + (insert-directory! (if (and (not (pathname-wild? pathname)) + (file-directory? pathname)) + (pathname-as-directory pathname) + pathname) + switches mark + (if (pathname-wild? pathname) + 'WILDCARD + 'DIRECTORY)) (let ((mark (mark-left-inserting-copy mark))) (for-each (lambda (file) (insert-directory! (merge-pathnames file pathname) @@ -934,4 +938,25 @@ Actions controlled by variables list-directory-brief-switches (for-each (lambda (file) (procedure (car file)) (dired-mark-1 (cdr file) #\space)) - (dired-marked-files buffer))) \ No newline at end of file + (dired-marked-files buffer))) + +(define (dired-change-files verb argument procedure) + (let ((filenames + (if argument + (dired-next-files (command-argument-value argument)) + (let ((files (dired-marked-files))) + (if (null? files) + (dired-next-files 1) + files))))) + (if (null? filenames) + (message "No files to " verb ".") + (begin + (for-each (lambda (filename) + (set-cdr! filename + (mark-right-inserting-copy (cdr filename)))) + filenames) + (for-each (lambda (filename) + (procedure (car filename) (cdr filename)) + (mark-temporary! (cdr filename))) + filenames))) + (length filenames))) \ No newline at end of file diff --git a/v7/src/edwin/dirunx.scm b/v7/src/edwin/dirunx.scm index f15c430a4..61b27c000 100644 --- a/v7/src/edwin/dirunx.scm +++ b/v7/src/edwin/dirunx.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dirunx.scm,v 1.9 1995/01/31 21:38:17 cph Exp $ +;;; $Id: dirunx.scm,v 1.10 1995/02/14 00:30:21 cph Exp $ ;;; ;;; Copyright (c) 1992-95 Massachusetts Institute of Technology ;;; @@ -42,8 +42,8 @@ ;;; of that license should have been included along with this file. ;;; -;;;; Directory Editor -;; package: (edwin dired) +;;;; Directory Editor (Unix Customizations) +;;; package: (edwin dired) (declare (usual-integrations)) @@ -104,25 +104,4 @@ The files are compressed or uncompressed using gzip." "gz"))) lstart)))))))) (if (positive? n) - (message "Compressed or uncompressed " n " files."))))) - -(define (dired-change-files verb argument procedure) - (let ((filenames - (if argument - (dired-next-files (command-argument-value argument)) - (let ((files (dired-marked-files))) - (if (null? files) - (dired-next-files 1) - files))))) - (if (null? filenames) - (message "No files to " verb ".") - (begin - (for-each (lambda (filename) - (set-cdr! filename - (mark-right-inserting-copy (cdr filename)))) - filenames) - (for-each (lambda (filename) - (procedure (car filename) (cdr filename)) - (mark-temporary! (cdr filename))) - filenames))) - (length filenames))) \ No newline at end of file + (message "Compressed or uncompressed " n " files."))))) \ No newline at end of file diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm index 11b797085..fd3b1e652 100644 --- a/v7/src/edwin/ed-ffi.scm +++ b/v7/src/edwin/ed-ffi.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: ed-ffi.scm,v 1.36 1994/12/19 19:38:44 cph Exp $ +$Id: ed-ffi.scm,v 1.37 1995/02/14 00:30:28 cph Exp $ -Copyright (c) 1990-94 Massachusetts Institute of Technology +Copyright (c) 1990-95 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -111,6 +111,8 @@ of that license should have been included along with this file. edwin-syntax-table) ("dired" (edwin dired) edwin-syntax-table) + ("diros2" (edwin dired) + edwin-syntax-table) ("dirunx" (edwin dired) edwin-syntax-table) ("display" (edwin display-type) diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr index 97dcd8585..4aa6b7794 100644 --- a/v7/src/edwin/edwin.ldr +++ b/v7/src/edwin/edwin.ldr @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.ldr,v 1.53 1995/01/06 01:03:24 cph Exp $ +$Id: edwin.ldr,v 1.54 1995/02/14 00:30:37 cph Exp $ Copyright (c) 1989-95 Massachusetts Institute of Technology @@ -203,8 +203,9 @@ MIT in each case. |# (let ((env (->environment '(EDWIN DIRED)))) (load "dired" env) - (if (eq? (lookup 'OS-TYPE) 'unix) - (load "dirunx" env))) + (case (lookup 'OS-TYPE) + ((UNIX) (load "dirunx" env)) + ((OS/2) (load "diros2" env)))) (load "argred" (->environment '(EDWIN COMMAND-ARGUMENT))) (load "autold" environment) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index fe4d4076e..ea3381ba1 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.162 1995/02/08 01:20:55 cph Exp $ +$Id: edwin.pkg,v 1.163 1995/02/14 00:30:44 cph Exp $ Copyright (c) 1989-95 Massachusetts Institute of Technology @@ -1156,6 +1156,11 @@ MIT in each case. |# (extend-package (edwin) (files "os2")) + (extend-package (edwin dired) + (files "diros2") + (export (edwin) + edwin-command$dired-do-compress)) + (extend-package (edwin process) (files "process")) @@ -1183,11 +1188,6 @@ MIT in each case. |# screen-pel-width screen-pel-height) (import (runtime os2-window-primitives) - bbo_and - bbo_ignore - bbo_no_color_info - bbo_or - bbo_pal_colors button-event-type:down button-event/number button-event/type @@ -1215,20 +1215,9 @@ MIT in each case. |# key-event/flags key-event/repeat number-of-event-types - os2ps-bitblt os2ps-clear - os2ps-close-bitmap - os2ps-line - os2ps-move-graphics-cursor - os2ps-open-bitmap - os2ps-poly-line - os2ps-poly-line-disjoint - os2ps-query-capabilities - os2ps-query-capability os2ps-set-colors os2ps-set-font - os2ps-set-line-type - os2ps-set-mix os2ps-write os2win-activate os2win-beep @@ -1263,21 +1252,6 @@ MIT in each case. |# paint-event/yl resize-event/height resize-event/width - rop_dstinvert - rop_mergecopy - rop_mergepaint - rop_notsrccopy - rop_notsrcerase - rop_one - rop_patcopy - rop_patinvert - rop_patpaint - rop_srcand - rop_srccopy - rop_srcerase - rop_srcinvert - rop_srcpaint - rop_zero virtual-key-supremum visibility-event/shown? vk_backspace -- 2.25.1