Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
#! $HOME/scheme/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
- !#
;;;;"hitch" HIghlighT Changed Hypertext red.
;;; Copyright 1998-1999 Aubrey Jaffer
;;; See the file "COPYING" for terms applying to this program.
(define (go-script)
(cond ((not *script*))
((= 3 (- (length *argv*) *optind*))
(apply hitch (list-tail *argv* *optind*)))
(else
(display "\
\
Usage: hitch old.html new.html dest
\
Writes DEST with a copy of NEW.HTML in which lines which differ
(ignoring whitespace) between OLD.HTML and NEW.HTML are marked by
turning the text foreground color red.
OLD.HTML, NEW.HTML, and DEST may contain GLOB wildcards, in which
case all the files matching NEW.HTML are copied. If DEST contains
wildcard characters, then it is taken as a pattern for the copied
files; otherwise it is taken as a directory name.
HITCH compares concatenated copies of these files; boundary movement
will not foil the comparison.
http://swissnet.ai.mit.edu/~jaffer/infobar/index.html
"
(current-error-port))
(exit #f))))
(require 'sort)
(require 'scanf)
(require 'line-i/o)
(require 'net-clients)
(require 'string-search)
(require 'chapter-order)
(require 'i/o-extensions)
(define (split-pathname path)
(let ((len (string-length path))
(idx (or (string-reverse-index path #\/)
(string-reverse-index path #\\))))
(if (and idx (< idx len))
(list (substring path 0 (+ 1 idx))
(substring path (+ 1 idx) len))
(list "./" path))))
(define (strip-markups dest dir . glob)
(define splits '())
(apply directory-for-each
(lambda (fname) (set! splits (cons fname splits)))
dir
glob)
(set! splits (sort! splits chap:string))
(if (string-index lne #\>)
(let ((len (string-length lne))
(idx (string-index lne #\>)))
(set! line (substring lne (+ idx 1) len))
(set! linum lnum))))
(newline oport)))))))
splits))))
(define splits '())
(define changes '())
(define total-lines 1)
(define (slurp-diff diffname)
(define changes '())
(call-with-input-file diffname
(lambda (port)
(do ((line (read-line port) (read-line port)))
((eof-object? line))
(case (string-ref line 0)
((#\< #\> #\-) #f)
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
(let ((typ #f) (slin #f) (elin #f))
(sscanf line "%*d,%*d%[acd]%d,%d" typ slin elin)
(if (not typ) (sscanf line "%*d%[acd]%d,%d" typ slin elin))
(if (not slin) (slib:error 'funny line))
(set! changes
(cons (if elin (list slin elin) slin)
changes))))))))
(reverse changes))
(define (string-whitespace? str)
(do ((idx (+ -1 (string-length str)) (+ -1 idx)))
((or (negative? idx) (not (char-whitespace? (string-ref str idx))))
(negative? idx))))
(define (advertise oport)
(for-each
(lambda (str) (display str oport))
'(" Lines changed since last version are marked "
"in red by HITCH.
"))
(newline oport))
(define (colorize newdir splits changes dstdir globber)
(define change (car changes))
(define (bump-changes)
(cond ((null? (cdr changes)) (set! change 0))
(else (set! changes (cdr changes))
(set! change (car changes))
(if (list? change) (set! change (car change))))))
(define (update-changes linum)
(cond ((> linum change) (bump-changes))
((not (= linum change)))
((number? (car changes)) (bump-changes))
((< linum (cadar changes)) (set! change (+ 1 change)))
(else (bump-changes))))
(if (list? change) (set! change (car change)))
(for-each
(lambda (fname)
(call-with-input-file (string-append newdir fname)
(lambda (iport)
(call-with-output-file (string-append dstdir (globber fname))
(lambda (oport)
(define unadvertised? #t)
(define marked? #f)
(define mark? #f)
(define disp-text
(lambda (str oport)
(cond ((string-whitespace? str)
(display str oport))
(mark? (display "" oport)
(display str oport)
(display "" oport))
(else (display str oport)))))
(do ((line (read-line iport) (read-line iport))
(linum total-lines (+ 1 linum)))
((eof-object? line) ; (update-changes linum)
(set! total-lines linum))
(set! mark? (= linum change))
(if mark? (set! marked? #t))
(cond
((and unadvertised? marked? (string=? "