From: Chris Hanson Date: Thu, 5 Nov 1992 20:45:41 +0000 (+0000) Subject: Add new editor variable LPR-PROCEDURE to allow complete customization X-Git-Tag: 20090517-FFI~8800 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=78df919250596b160cd710b734e53fd6f67ef4dc;p=mit-scheme.git Add new editor variable LPR-PROCEDURE to allow complete customization of the printing method. --- diff --git a/v7/src/edwin/loadef.scm b/v7/src/edwin/loadef.scm index ced2fa71a..7a265fc7b 100644 --- a/v7/src/edwin/loadef.scm +++ b/v7/src/edwin/loadef.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/loadef.scm,v 1.16 1992/08/21 23:52:31 cph Exp $ +;;; $Id: loadef.scm,v 1.17 1992/11/05 20:45:32 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology ;;; @@ -119,7 +119,7 @@ "These keywords cause the lines below them to be indented to the right. This must be a regular expression, or #F to disable the option." false) - + (define-library 'TEXINFO-MODE '("tximod" (EDWIN))) @@ -154,24 +154,30 @@ Otherwise, a new buffer is created for each topic." (define-library 'print '("print" (EDWIN))) -(define-variable lpr-switches - "List of strings to pass as extra switch args to lpr when it is invoked." - '() - list-of-strings?) +(define-variable lpr-procedure + "Procedure that spools some text to the printer, or #F for the default. +Procedure is called with four arguments: a region to be printed, a flag +indicating that the text should be printed with page headers, a title string +to appear in the header lines and on the title page, and the buffer in which +the text was originally stored (for editor variable references). If this +variable's value is #F, the text is printed using LPR-COMMAND." + false + (lambda (object) (or (not object) (procedure? object)))) (define-variable lpr-command "Shell command for printing a file" "lpr" string?) +(define-variable lpr-switches + "List of strings to pass as extra switch args to lpr when it is invoked." + '() + list-of-strings?) + (define lpr-prompt-for-name? ;; If true, lpr commands prompt for a name to appear on the title page. false) -(define lpr-most-recent-name - ;; If name prompting is enabled, the last name is saved here. - false) - (define lpr-print-not-special? ;; If true, the print-* commands are just like the lpr-* commands. false) diff --git a/v7/src/edwin/print.scm b/v7/src/edwin/print.scm index c3de8d314..833574c22 100644 --- a/v7/src/edwin/print.scm +++ b/v7/src/edwin/print.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/print.scm,v 1.11 1992/09/02 02:04:19 cph Exp $ +;;; $Id: print.scm,v 1.12 1992/11/05 20:45:41 cph Exp $ ;;; ;;; Copyright (c) 1991-92 Massachusetts Institute of Technology ;;; @@ -74,34 +74,37 @@ Variable LPR-SWITCHES is a list of extra switches (strings) to pass to lpr." (lambda (region) (print-region/internal region true))) -(define (print-region/internal region print-command?) - (let ((switches (print-region-switches region print-command?)) - (source-buffer (mark-buffer (region-start region)))) - (message "Spooling...") - (call-with-temporary-buffer " *spool temp*" - (lambda (temp-buffer) - (insert-region (region-start region) - (region-end region) - (buffer-point temp-buffer)) - (let ((width (ref-variable tab-width source-buffer))) - (if (not (= width 8)) - (begin - (define-variable-local-value! temp-buffer - (ref-variable-object tab-width) - width) - (untabify-region (buffer-start temp-buffer) - (buffer-end temp-buffer))))) - (shell-command region (buffer-end temp-buffer) false false - (string-append (ref-variable lpr-command source-buffer) - switches)))) - (append-message "done"))) +(define (print-region/internal region print-headers?) + (message "Spooling...") + (let ((buffer (mark-buffer (region-start region))) + (print-headers? (and print-headers? (not lpr-print-not-special?))) + (title (print-region-title-string region))) + (let ((call-printer + (lambda (region) + ((or (ref-variable lpr-procedure buffer) print-region/default) + region print-headers? title buffer))) + (width (ref-variable tab-width buffer))) + (if (= width 8) + (call-printer region) + (call-with-temporary-buffer " *spool temp*" + (lambda (temp-buffer) + (insert-region (region-start region) + (region-end region) + (buffer-point temp-buffer)) + (define-variable-local-value! temp-buffer + (ref-variable-object tab-width) + width) + (untabify-region (buffer-start temp-buffer) + (buffer-end temp-buffer)) + (call-printer (buffer-region temp-buffer))))))) + (append-message "done")) -(define (print-region-switches region print-command?) - (print/assemble-switches - (print-region-title-string region) - (if (and print-command? (not lpr-print-not-special?)) - '("-p") - '()))) +(define (print-region/default region print-headers? title buffer) + (shell-command region false false false + (string-append + (ref-variable lpr-command buffer) + (print/assemble-switches title + (if print-headers? '("-p") '()))))) (define (print-region-title-string region) (let ((buffer-title @@ -142,14 +145,16 @@ Variable LPR-SWITCHES is a list of extra switches (strings) to pass to lpr." (car switches) (loop (cdr switches))))))) -(define (print/job-name) - (and lpr-prompt-for-name? - (let ((job-name - (prompt-for-string "Name to print on title page" - lpr-most-recent-name - 'INSERTED-DEFAULT))) - (if (string-null? job-name) - false - (begin - (set! lpr-most-recent-name job-name) - job-name))))) \ No newline at end of file +(define print/job-name + (let ((most-recent-name false)) + (lambda () + (and lpr-prompt-for-name? + (let ((job-name + (prompt-for-string "Name to print on title page" + most-recent-name + 'INSERTED-DEFAULT))) + (if (string-null? job-name) + false + (begin + (set! most-recent-name job-name) + job-name))))))) \ No newline at end of file