;;;-*- Mode: LISP; Package: (USER) -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Abbreviated HTML to HTML Converter ;; ;; Coded by Kanada,Yasusi ;; ;; Tsukuba Research Center, Real-World Computing Partnership ;; Copyright (C) 1994 by Real World Computing Partnership ;; ;; 94.6.19 Ver 1.0 ;; 94.6.25 Ver 1.1 ;; 94.8.19 Ver 1.5 ;; ;; You can use or modify this program freely for your PERSONAL purpose. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (proclaim '(optimize (safety 0) (speed 3) (compilation-speed 0))) (defvar *bib-file*) (setf (logical-pathname-translations "poster") ; '(("poster:**;*.*" "NSL270c-3:Kanada:www:CA:AsyncCA:poster:**:*.*"))) '(("poster:**;*.*" "KanadaAV:www:CA:AsyncCA:poster:**:*.*"))) (setf (logical-pathname-translations "poster-new") '(("poster-new:**;*.*" "KanadaAV:www:CA:AsyncCA:poster-new:**:*.*"))) (proclaim '(inline string-head-equl string-tail-equal trim)) (defun string-head-equal (x y) (and (>= (length x) (length y)) (string-equal x y :end1 (length y)))) (defun string-tail-equal (x y) (and (>= (length x) (length y)) (string-equal x y :start1 (- (length x) (length y))))) (defun trim (string head tail) (unless (string-tail-equal string tail) (error "Line ends without ~s: ~s" tail string)) (subseq string (length head) (- (length string) (length tail)))) (defun interpret-file-name (name) (let ((file-name (substitute #\: #\/ name))) (if (string-head-equal file-name "\"") (trim file-name "\"" "\"") file-name))) (defun convert-html (Input) "Convert abbreviated HTML file (Input) to real HTML." (let ((input-file Input) (*standard-output* *standard-output*) (first-time t)) (with-open-file (*standard-input* input-file) (unwind-protect (do ((line (read-line *standard-input* nil :end-of-file) (read-line *standard-input* nil :end-of-file))) ((eq line :end-of-file)) (cond ((string-head-equal line "
") (let* ((headline (trim line "
" "
")) ; HEADER (label (gentemp))) (format t "

O ~a

" label label headline))) ((string-head-equal line "
")))) (format t "

~%" figure-name figure-name))) ((string-head-equal line ""))) (format t "

[~a] " bib-name bib-name))) ((string-head-equal line ""))) (format t "[~a]" *bib-file* bib-name bib-name))) ((string-head-equal line ""))) (t (error "Invalid BIB command ~s" line)))) ((string-head-equal line "")))) ((string-head-equal line "")))) (if first-time (setq first-time nil) (format t "~%")) (close *standard-output*) (setq *standard-output* (open file-name :direction :output :if-exists :rename-and-delete)) (format t "~%~%"))) ((string-equal line "") ; SIGNATURE (format t "


~%
") (format t "Y. Kanada
~%")) (t (format t "~a~%" line)))) ; OTHERS (format t "~%") (close *standard-output*))))) t