annotate lisp/printer.el @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 42375619fa45
children 4a27df428c73
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
1 ;;; printer.el --- support for hard-copy printing in XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
2
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
3 ;; Copyright (C) 2000, 2002 Ben Wing.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
4 ;; Copyright (C) 2000 Kirill Katsnelson.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
5
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
7 ;; Keywords: printer, printing, internal, dumped
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
8
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
10
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
11 ;; XEmacs is free software; you can redistribute it and/or modify it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
12 ;; under the terms of the GNU General Public License as published by
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
14 ;; any later version.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
15
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
19 ;; General Public License for more details.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
20
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
24 ;; 02111-1307, USA.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
25
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
26 ;;; Synched up with: Not in FSF.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
27
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
28 ;;; Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
29
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
30 ;; Created 2000 by Ben Wing, to provide the high-level interface onto the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
31 ;; print support implemented by Kirill Katsnelson.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
32
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
33 ;;; Commentary:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
34
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
35 ;; This file is dumped with XEmacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
36
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
37
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
39 ;; generic printing code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
41
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
42 ;; #### should be named print-buffer, but that's currently in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
43 ;; lpr-buffer with some horrible definition: print-buffer == "print with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
44 ;; headings", lpr-buffer == "print without headings", and the headings are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
45 ;; generated by calling the external program "pr"! This is major stone-age
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
46 ;; here!
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
47 ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
48 ;; I propose junking that package entirely and creating a unified,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
49 ;; modern API here that will work well with modern GUI's on top of it,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
50 ;; and with various different actual implementations (e.g. lpr or the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
51 ;; pretty-print package on Unix, built-in msprinter support on
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
52 ;; Windows), where the workings of a particular implementation is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
53 ;; hidden from the user and there is a consistent set of options to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
54 ;; control how to print, which works across all implementations.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
55 ;;
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
56 ;; The code here currently only really supports Windows.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
57
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
58 (defgroup printing nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
59 "Generic printing support."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
60 :group 'wp)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
61
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
62 (defcustom printer-name nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
63 "*Name of printer to print to.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
64 If nil, use default.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
65 Under Windows, use `mswindows-printer-list' to get names of installed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
66 printers."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
67 :type 'string
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
68 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
69
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
70 (defstruct Print-context pageno window start-time printer-name)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
71
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
72 (defvar printer-current-device nil)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
73
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
74 (defun Printer-get-device ()
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
75 (or printer-current-device (setq printer-current-device
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
76 (make-device 'msprinter printer-name))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
77
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
78 (defun Printer-clear-device ()
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
79 (setq printer-current-device nil))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
80
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
81 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
82 "*Controls printed page header.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
83
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
84 This can be:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
85 - nil. Header is not printed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
86 - An fbound symbol or lambda expression. The function is called with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
87 one parameter, a print-context object, every time the headers need
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
88 to be set up. It can use the function `print-context-property' to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
89 query the properties of this object. The return value is treated as
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
90 if it was literally specified: i.e. it will be reprocessed.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
91 - A list of up to three elements, for left, center and right portions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
92 of the header. Each of these can be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
93 - nil, not to print the portion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
94 - A string, which will be printed literally.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
95 - A predefined symbol, on of the following:
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
96 printer-name Name of printer being printed to
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
97 short-file-name File name only, no path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
98 long-file-name File name with its path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
99 buffer-name Buffer name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
100 date Date current when printing started
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
101 time Time current when printing started
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
102 page Current printout page number, 1-based
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
103 user-id User logon id
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
104 user-name User full name
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
105 - A list of three elements: (face FACE-NAME EXPR). EXPR is any of the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
106 items given here. The item will be displayed in the given face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
107 - A cons of an extent and any of the items given here. The item will
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
108 be displayed using the extent's face, begin-glyph and end-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
109 properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
110 - A list, each element of which is any of the items given here.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
111 Each element of the list is rendered in sequence. For example,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
112 '(\"Page \" page) is rendered as \"Page 5\" on the fifth page.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
113 - An fbound symbol or lambda expression, called with one parameter,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
114 a print-context object, as above. The return value is treated as
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
115 if it was literally specified: i.e. it will be reprocessed."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
116 :type 'sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
117 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
118
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
119 (defcustom printer-page-footer '(nil (face bold ("Page " page)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
120 "*Controls printed page footer.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
121
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
122 Format is the same as `printer-page-header'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
123 :type 'sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
124 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
125
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
126 (defun generate-header-element (element context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
127 (cond ((null element) nil)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
128 ((stringp element) (insert element))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
129 ((memq element '(printer-name
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
130 short-file-name long-file-name buffer-name
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
131 date time page user-id user-name))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
132 (insert (print-context-property context element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
133 ((and (consp element) (eq 'face (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
134 (let ((p (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
135 (generate-header-element (third element) context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
136 (let ((x (make-extent p (point))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
137 (set-extent-face x (second element)))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
138 ((and (consp element) (extentp (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
139 (let ((p (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
140 (generate-header-element (cdr element) context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
141 (let ((x (make-extent p (point))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
142 (set-extent-face x (extent-face (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
143 (set-extent-begin-glyph x (extent-begin-glyph (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
144 (set-extent-end-glyph x (extent-end-glyph (car element))))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
145 ((listp element)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
146 (mapcar #'(lambda (el) (generate-header-element el context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
147 element))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
148 ((functionp element)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
149 (generate-header-element (funcall element context) context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
150 (t (error 'invalid-argument "Unknown header element" element))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
151
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
152 (defun generate-header-line (spec context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
153 (let* ((left (first spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
154 (middle (second spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
155 (right (third spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
156 (left-start (point))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
157 (middle-start (progn (generate-header-element left context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
158 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
159 (right-start (progn (generate-header-element middle context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
160 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
161 (right-end (progn (generate-header-element right context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
162 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
163 (left-width (- middle-start left-start))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
164 (middle-width (- right-start middle-start))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
165 (right-width (- right-end right-start))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
166 (winwidth (- (window-width (Print-context-window context)) 1))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
167 (spaces1 (max (- (/ (- winwidth middle-width) 2) left-width) 0))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
168 (spaces2 (max (- (- winwidth right-width)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
169 (+ left-width spaces1 middle-width))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
170 0)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
171 (goto-char right-start)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
172 (insert-char ?\ spaces2)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
173 (goto-char middle-start)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
174 (insert-char ?\ spaces1)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
175
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
176 (defun print-context-property (print-context prop)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
177 "Return property PROP of PRINT-CONTEXT.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
178
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
179 Valid properties are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
180
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
181 print-buffer Buffer being printed
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
182 print-window Window on printer device containing print buffer
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
183 print-frame Frame on printer device corresponding to current page
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
184 print-device Device referring to printer
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
185 print-start-time Time current when printing started (`current-time' format)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
186 print-page Current printout page number, 1-based
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
187 printer-name Name of printer being printed to
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
188 short-file-name File name only, no path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
189 long-file-name File name with its path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
190 buffer-name Buffer name
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
191 date Date current when printing started (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
192 time Time current when printing started (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
193 page Current printout page number, 1-based (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
194 user-id User logon id (as a string)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
195 user-name User full name"
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
196 (let* ((window (Print-context-window print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
197 (pageno (Print-context-pageno print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
198 (start-time (Print-context-start-time print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
199 (printer-name (Print-context-printer-name print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
200 (buffer (window-buffer window)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
201 (case prop
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
202 (print-buffer buffer)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
203 (print-window window)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
204 (print-frame (window-frame window))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
205 (print-device (frame-device (window-frame window)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
206 (print-start-time start-time)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
207 (print-page pageno)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
208 (printer-name printer-name)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
209 (short-file-name (let ((name (buffer-file-name buffer)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
210 (if name (file-name-nondirectory name) "")))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
211 (long-file-name (let ((name (buffer-file-name buffer)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
212 (or name "")))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
213 (buffer-name (buffer-name buffer))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
214 (date (format-time-string "%x" start-time))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
215 (time (format-time-string "%X" start-time))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
216 (page (format "%d" pageno))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
217 (user-id (format "%d" (user-uid)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
218 (user-name (format "%d" (user-login-name)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
219 (t (error 'invalid-argument "Unrecognized print-context property"
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
220 prop)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
221
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
222 (defun generic-page-setup ()
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
223 "Display the Page Setup dialog box.
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
224 Changes made are recorded internally."
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
225 (interactive)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
226 (let* ((d (Printer-get-device))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
227 (props
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
228 (condition-case err
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
229 (make-dialog-box 'page-setup :device d
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
230 :properties (declare-boundp
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
231 default-msprinter-frame-plist))
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
232 (error
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
233 (Printer-clear-device)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
234 (signal (car err) (cdr err))))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
235 (while props
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
236 (with-boundp 'default-msprinter-frame-plist
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
237 (setq default-msprinter-frame-plist
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
238 (plist-put default-msprinter-frame-plist (car props)
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
239 (cadr props))))
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
240 (setq props (cddr props)))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
241
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
242 (defun generic-print-buffer (&optional buffer display-print-dialog)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
243 "Print buffer BUFFER using a printing method appropriate to the O.S. being run.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
244 Under Unix, `lpr' is normally used to spool out a no-frills version of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
245 buffer, or the `ps-print' package is used to pretty-print the buffer to a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
246 PostScript printer. Under MS Windows, the built-in printing support is used.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
247
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
248 If DISPLAY-PRINT-DIALOG is t, the print dialog will first be
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
249 displayed, allowing the user to select various printing settings
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
250 \(e.g. which printer to print to, the range of pages, number of copies,
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
251 modes such landscape/portrait/2-up/4-up [2 or 4 (small!) logical pages
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
252 per physical page], etc.). At this point the user can cancel the printing
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
253 operation using the dialog box, and `generic-print-buffer' will not print
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
254 anything. When called interactively, use a prefix arg to suppress the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
255 display of the print dialog box.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
256
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
257 If BUFFER is nil or omitted, the current buffer is used."
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 491
diff changeset
258 (interactive (list nil (not current-prefix-arg)))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
259 (let* ((print-region (and (interactive-p) (region-active-p)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
260 (start (if print-region (region-beginning) (point-min buffer)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
261 (end (if print-region (region-end) (point-max buffer))))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
262 (if (or (not (valid-specifier-tag-p 'msprinter))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
263 (not display-print-dialog))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
264 (generic-print-region start end buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
265 (let* ((d (Printer-get-device))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
266 (props (condition-case err
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
267 (make-dialog-box 'print :device d
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
268 :allow-selection print-region
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
269 :selected-page-button
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
270 (if print-region 'selection 'all))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
271 (error
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
272 (Printer-clear-device)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
273 (signal (car err) (cdr err))))))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
274 (and props
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
275 (let ((really-print-region
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
276 (eq (plist-get props 'selected-page-button) 'selection)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
277 (generic-print-region (if really-print-region start
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
278 (point-min buffer))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
279 (if really-print-region end
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
280 (point-max buffer))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
281 buffer d props)))))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
282
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
283 (defun generic-print-region (start end &optional buffer print-device props)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
284 "Print region using a printing method appropriate to the O.S. being run.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
285 The region between START and END of BUFFER (defaults to the current
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
286 buffer) is printed.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
287
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
288 Under Unix, `lpr' is normally used to spool out a no-frills version of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
289 buffer, or the `ps-print' package is used to pretty-print the buffer to a
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
290 PostScript printer. Under MS Windows, the built-in printing support is used.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
291
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
292 Optional PRINT-DEVICE is a device, already created, to use to do the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
293 printing. This is typically used when this function was invoked from
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
294 `generic-print-buffer' and it displayed a dialog box. That function created
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
295 the device, and then the dialog box stuffed it with the user's selections
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
296 of how the buffer should be printed.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
297
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
298 PROPS, if given, is typically the plist returned from the call to
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
299 `make-dialog-box' that displayed the Print box. It contains properties
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
300 relevant to us when we print.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
301
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
302 Recognized properties are the same as those in `make-dialog-box':
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
303
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
304 name Printer device name. If omitted, the current system-selected
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
305 printer will be used.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
306 from-page First page to print, 1-based. If omitted, printing starts from
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
307 the beginning.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
308 to-page Last page to print, inclusive, If omitted, printing ends at
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
309 the end.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
310 copies Number of copies to print. If omitted, one copy is printed."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
311 (cond ((valid-specifier-tag-p 'msprinter)
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
312 ;; loop, printing one copy of document per loop. kill and
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
313 ;; re-create the frame each time so that we eject the piece
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
314 ;; of paper at the end even if we're printing more than one
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
315 ;; page per sheet of paper.
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
316 (let ((copies (plist-get props 'copies 1))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
317 ;; This is not relevant to printing and can mess up
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
318 ;; msprinter frame sizing
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
319 default-frame-plist)
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
320 (while (> copies 0)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
321 (let (d f header-buffer footer-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
322 (setq buffer (decode-buffer buffer))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
323 (unwind-protect
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
324 (with-current-buffer buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
325 (save-restriction
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
326 (narrow-to-region start end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
327 (setq d (or print-device (Printer-get-device)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
328 (setq f (make-frame
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
329 (list* 'name
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
330 (concat
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
331 (substitute ?_ ?. (buffer-name buffer))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
332 " - XEmacs")
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
333 '(menubar-visible-p
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
334 nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
335 has-modeline-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
336 default-toolbar-visible-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
337 default-gutter-visible-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
338 minibuffer none
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
339 modeline-shadow-thickness 0
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
340 vertical-scrollbar-visible-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
341 horizontal-scrollbar-visible-p nil))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
342 d))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
343 (let* ((w (frame-root-window f))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
344 (vertdpi
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
345 (cdr (device-system-metric d 'device-dpi)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
346 (pixel-vertical-clip-threshold (/ vertdpi 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
347 (from-page (plist-get props 'from-page 1))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
348 (to-page (plist-get props 'to-page))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
349 (context (make-Print-context
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
350 :start-time (current-time)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
351 ;; #### bogus! we need accessors for
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
352 ;; print-settings objects.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
353 :printer-name
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
354 (or (plist-get props 'name)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
355 printer-name
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
356 (declare-fboundp
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
357 (mswindows-get-default-printer)
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
358 ))))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
359 header-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
360 footer-window)
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
361
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
362 (when printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
363 (let ((window-min-height 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
364 (setq header-window w)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
365 (setq w (split-window w 2)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
366 (setq header-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
367 (generate-new-buffer " *header*"))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
368 (set-window-buffer header-window header-buffer))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
369
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
370 (when printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
371 (let ((window-min-height 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
372 (setq footer-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
373 (split-window w (- (window-height w) 2))))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
374 (setq footer-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
375 (generate-new-buffer " *footer*"))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
376 (set-window-buffer footer-window footer-buffer))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
377
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
378 (setf (Print-context-window context) w)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
379
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
380 (let ((last-end 0) ; bufpos at end of previous page
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
381 reached-end ; t if we've reached the end of the
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
382 ; text we're printing
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
383 (pageno 1))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
384 (set-window-buffer w buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
385 (set-window-start w start)
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
386
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
387 ;; loop, printing one page per loop
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
388 (while (and (not reached-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
389 ;; stop at end of region of text or
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
390 ;; outside of ranges of pages given
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
391 (or (not to-page) (<= pageno to-page)))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
392
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
393 (setf (Print-context-pageno context) pageno)
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
394
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
395 ;; only actually print the page if it's in the
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
396 ;; range.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
397 (when (>= pageno from-page)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
398 (when printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
399 (with-current-buffer header-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
400 (erase-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
401 (generate-header-line printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
402 context)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
403 (goto-char (point-min))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
404 (set-window-start header-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
405 (point-min))))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
406
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
407 (when printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
408 (with-current-buffer footer-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
409 (erase-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
410 (insert "\n")
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
411 (generate-header-line printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
412 context)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
413 (goto-char (point-min))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
414 (set-window-start footer-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
415 (point-min))))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
416
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
417 (redisplay-frame f t)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
418 (print-job-eject-page f)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
419 )
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
420 ;; but use the GUARANTEE argument to `window-end'
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
421 ;; so that we get the right value even if we
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
422 ;; didn't do a redisplay.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
423 (let ((this-end (window-end w t))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
424 (pixvis
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
425 (window-last-line-visible-height w)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
426 ;; in case we get stuck somewhere, bow out
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
427 ;; rather than printing an infinite number of
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
428 ;; pages. #### this will fail with an image
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
429 ;; bigger than an entire page. but we really
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
430 ;; need this check here. we should be more
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
431 ;; clever in our check, to deal with this case.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
432 (if (or (= this-end last-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
433 ;; #### fuckme! window-end returns a
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
434 ;; value outside of the valid range of
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
435 ;; buffer positions!!!
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
436 (>= this-end end))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
437 (setq reached-end t)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
438 (setq last-end this-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
439 (set-window-start w this-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
440 (if pixvis
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
441 (with-selected-window w
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
442 ;; #### scroll-down should take a
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
443 ;; window arg.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
444 (let ((window-pixel-scroll-increment
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
445 pixvis))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
446 (scroll-down 1))))))
546
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
447 (setq pageno (1+ pageno)))))))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
448 (and f (delete-frame f))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
449 (and header-buffer (kill-buffer header-buffer))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
450 (and footer-buffer (kill-buffer footer-buffer))))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
451 (setq copies (1- copies)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
452 ((and (not (eq system-type 'windows-nt))
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 491
diff changeset
453 (fboundp 'lpr-region))
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 863
diff changeset
454 (declare-fboundp (lpr-region start end)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
455 (t (error "No print support available"))))