Mercurial > hg > xemacs-beta
annotate lisp/printer.el @ 5864:750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
src/ChangeLog addition:
2015-02-25 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (read_atom): Use the new calling convention for
parse_integer().
* lisp.h: Change the declaration of parse_integer ().
* number.h (bignum_set_emacs_int, make_bignum_emacs_uint):
New #defines, used in data.c.
* lread.c (read_integer): Ditto.
* lread.c (read1): Ditto.
* data.c (find_highest_value): New.
* data.c (fill_ichar_array): New.
* data.c (build_fixnum_to_char_map): New.
* data.c (Fset_digit_fixnum_map): New.
* data.c (Fdigit_char_p): Moved from cl-extra.el.
* data.c (Fdigit_char): Moved from cl-extra.el.
* data.c (parse_integer): Moved from lread.c.
* data.c (Fparse_integer): Made available to Lisp.
* data.c (syms_of_data): Make the new subrs available.
* data.c (vars_of_data): Make the new vars available.
Expose parse_integer to Lisp, make it follow the Common Lisp API
(with some extensions, to allow us to support non ASCII digit
characters).
lisp/ChangeLog addition:
2015-02-25 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (digit-char-p): Moved to data.c.
* cl-extra.el (digit-char): Moved to data.c.
tests/ChangeLog addition:
2015-02-25 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
parse_integer(), used in #'read, now signals invalid-argument
rather than invalid-read-syntax, check for that.
* automated/lisp-tests.el:
Check #'parse-integer now it's available to Lisp, check
#'digit-char, #'digit-char-p and the congruence in behaviour,
check the XEmacs-specific RADIX-TABLE argument behaviour.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 25 Feb 2015 11:47:12 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 442 | 1 ;;; printer.el --- support for hard-copy printing in XEmacs |
| 2 | |
| 778 | 3 ;; Copyright (C) 2000, 2002 Ben Wing. |
| 442 | 4 ;; Copyright (C) 2000 Kirill Katsnelson. |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: printer, printing, internal, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
14 ;; option) any later version. |
| 442 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
19 ;; for more details. |
| 442 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4459
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 442 | 23 |
| 24 ;;; Synched up with: Not in FSF. | |
| 25 | |
| 26 ;;; Authorship: | |
| 27 | |
| 28 ;; Created 2000 by Ben Wing, to provide the high-level interface onto the | |
| 29 ;; print support implemented by Kirill Katsnelson. | |
| 30 | |
| 31 ;;; Commentary: | |
| 32 | |
| 33 ;; This file is dumped with XEmacs. | |
| 34 | |
| 35 | |
| 36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 37 ;; generic printing code ;; | |
| 38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 39 | |
| 40 ;; #### should be named print-buffer, but that's currently in | |
| 41 ;; lpr-buffer with some horrible definition: print-buffer == "print with | |
| 42 ;; headings", lpr-buffer == "print without headings", and the headings are | |
| 43 ;; generated by calling the external program "pr"! This is major stone-age | |
| 44 ;; here! | |
| 45 ;; | |
| 46 ;; I propose junking that package entirely and creating a unified, | |
| 47 ;; modern API here that will work well with modern GUI's on top of it, | |
| 48 ;; and with various different actual implementations (e.g. lpr or the | |
| 49 ;; pretty-print package on Unix, built-in msprinter support on | |
| 50 ;; Windows), where the workings of a particular implementation is | |
| 51 ;; hidden from the user and there is a consistent set of options to | |
| 52 ;; control how to print, which works across all implementations. | |
| 53 ;; | |
| 506 | 54 ;; The code here currently only really supports Windows. |
| 442 | 55 |
| 56 (defgroup printing nil | |
| 57 "Generic printing support." | |
| 58 :group 'wp) | |
| 59 | |
| 60 (defcustom printer-name nil | |
| 61 "*Name of printer to print to. | |
| 62 If nil, use default. | |
| 63 Under Windows, use `mswindows-printer-list' to get names of installed | |
| 64 printers." | |
| 65 :type 'string | |
| 66 :group 'printing) | |
| 67 | |
| 491 | 68 (defstruct Print-context pageno window start-time printer-name) |
| 69 | |
| 506 | 70 (defvar printer-current-device nil) |
| 71 | |
| 72 (defun Printer-get-device () | |
| 73 (or printer-current-device (setq printer-current-device | |
| 74 (make-device 'msprinter printer-name)))) | |
| 75 | |
| 76 (defun Printer-clear-device () | |
| 903 | 77 ;; relying on GC to delete the device is too error-prone since there |
| 78 ;; only can be one anyway. | |
| 79 (and printer-current-device (delete-device printer-current-device)) | |
| 506 | 80 (setq printer-current-device nil)) |
| 81 | |
| 491 | 82 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name)) |
| 442 | 83 "*Controls printed page header. |
| 84 | |
| 85 This can be: | |
| 86 - nil. Header is not printed. | |
| 87 - An fbound symbol or lambda expression. The function is called with | |
| 88 one parameter, a print-context object, every time the headers need | |
| 89 to be set up. It can use the function `print-context-property' to | |
| 90 query the properties of this object. The return value is treated as | |
| 491 | 91 if it was literally specified: i.e. it will be reprocessed. |
| 442 | 92 - A list of up to three elements, for left, center and right portions |
| 93 of the header. Each of these can be | |
| 94 - nil, not to print the portion | |
| 95 - A string, which will be printed literally. | |
| 96 - A predefined symbol, on of the following: | |
| 491 | 97 printer-name Name of printer being printed to |
| 442 | 98 short-file-name File name only, no path |
| 99 long-file-name File name with its path | |
| 100 buffer-name Buffer name | |
| 101 date Date current when printing started | |
| 102 time Time current when printing started | |
| 103 page Current printout page number, 1-based | |
| 104 user-id User logon id | |
| 105 user-name User full name | |
| 491 | 106 - A list of three elements: (face FACE-NAME EXPR). EXPR is any of the |
| 107 items given here. The item will be displayed in the given face. | |
| 442 | 108 - A cons of an extent and any of the items given here. The item will |
| 109 be displayed using the extent's face, begin-glyph and end-glyph | |
| 110 properties. | |
| 111 - A list, each element of which is any of the items given here. | |
| 112 Each element of the list is rendered in sequence. For example, | |
| 113 '(\"Page \" page) is rendered as \"Page 5\" on the fifth page. | |
| 114 - An fbound symbol or lambda expression, called with one parameter, | |
| 115 a print-context object, as above. The return value is treated as | |
| 116 if it was literally specified: i.e. it will be reprocessed." | |
| 117 :type 'sexp | |
| 118 :group 'printing) | |
| 119 | |
| 491 | 120 (defcustom printer-page-footer '(nil (face bold ("Page " page))) |
| 442 | 121 "*Controls printed page footer. |
| 122 | |
| 123 Format is the same as `printer-page-header'." | |
| 124 :type 'sexp | |
| 125 :group 'printing) | |
| 126 | |
| 491 | 127 (defun generate-header-element (element context) |
| 128 (cond ((null element) nil) | |
| 129 ((stringp element) (insert element)) | |
| 130 ((memq element '(printer-name | |
| 131 short-file-name long-file-name buffer-name | |
| 132 date time page user-id user-name)) | |
| 133 (insert (print-context-property context element))) | |
| 134 ((and (consp element) (eq 'face (car element))) | |
| 135 (let ((p (point))) | |
| 136 (generate-header-element (third element) context) | |
| 137 (let ((x (make-extent p (point)))) | |
| 138 (set-extent-face x (second element))))) | |
| 139 ((and (consp element) (extentp (car element))) | |
| 140 (let ((p (point))) | |
| 141 (generate-header-element (cdr element) context) | |
| 142 (let ((x (make-extent p (point)))) | |
| 143 (set-extent-face x (extent-face (car element))) | |
| 144 (set-extent-begin-glyph x (extent-begin-glyph (car element))) | |
| 145 (set-extent-end-glyph x (extent-end-glyph (car element)))))) | |
| 146 ((listp element) | |
| 147 (mapcar #'(lambda (el) (generate-header-element el context)) | |
| 148 element)) | |
| 149 ((functionp element) | |
| 150 (generate-header-element (funcall element context) context)) | |
| 151 (t (error 'invalid-argument "Unknown header element" element)))) | |
| 152 | |
| 153 (defun generate-header-line (spec context) | |
| 154 (let* ((left (first spec)) | |
| 155 (middle (second spec)) | |
| 156 (right (third spec)) | |
| 157 (left-start (point)) | |
| 158 (middle-start (progn (generate-header-element left context) | |
| 159 (point))) | |
| 160 (right-start (progn (generate-header-element middle context) | |
| 161 (point))) | |
| 162 (right-end (progn (generate-header-element right context) | |
| 163 (point))) | |
| 164 (left-width (- middle-start left-start)) | |
| 165 (middle-width (- right-start middle-start)) | |
| 166 (right-width (- right-end right-start)) | |
| 1346 | 167 (winwidth (- (window-width (Print-context-window context)) 2)) |
| 491 | 168 (spaces1 (max (- (/ (- winwidth middle-width) 2) left-width) 0)) |
| 169 (spaces2 (max (- (- winwidth right-width) | |
| 170 (+ left-width spaces1 middle-width)) | |
| 171 0))) | |
| 172 (goto-char right-start) | |
| 173 (insert-char ?\ spaces2) | |
| 174 (goto-char middle-start) | |
| 175 (insert-char ?\ spaces1))) | |
| 176 | |
| 442 | 177 (defun print-context-property (print-context prop) |
| 178 "Return property PROP of PRINT-CONTEXT. | |
| 179 | |
| 180 Valid properties are | |
| 181 | |
| 491 | 182 print-buffer Buffer being printed |
| 183 print-window Window on printer device containing print buffer | |
| 184 print-frame Frame on printer device corresponding to current page | |
| 185 print-device Device referring to printer | |
| 186 print-start-time Time current when printing started (`current-time' format) | |
| 187 print-page Current printout page number, 1-based | |
| 188 printer-name Name of printer being printed to | |
| 442 | 189 short-file-name File name only, no path |
| 190 long-file-name File name with its path | |
| 191 buffer-name Buffer name | |
| 491 | 192 date Date current when printing started (as a string) |
| 193 time Time current when printing started (as a string) | |
| 194 page Current printout page number, 1-based (as a string) | |
| 195 user-id User logon id (as a string) | |
| 442 | 196 user-name User full name" |
| 491 | 197 (let* ((window (Print-context-window print-context)) |
| 198 (pageno (Print-context-pageno print-context)) | |
| 199 (start-time (Print-context-start-time print-context)) | |
| 200 (printer-name (Print-context-printer-name print-context)) | |
| 201 (buffer (window-buffer window))) | |
| 202 (case prop | |
| 203 (print-buffer buffer) | |
| 204 (print-window window) | |
| 205 (print-frame (window-frame window)) | |
| 206 (print-device (frame-device (window-frame window))) | |
| 207 (print-start-time start-time) | |
| 208 (print-page pageno) | |
| 209 (printer-name printer-name) | |
| 210 (short-file-name (let ((name (buffer-file-name buffer))) | |
| 211 (if name (file-name-nondirectory name) ""))) | |
| 212 (long-file-name (let ((name (buffer-file-name buffer))) | |
| 213 (or name ""))) | |
| 214 (buffer-name (buffer-name buffer)) | |
| 215 (date (format-time-string "%x" start-time)) | |
| 216 (time (format-time-string "%X" start-time)) | |
| 217 (page (format "%d" pageno)) | |
| 218 (user-id (format "%d" (user-uid))) | |
| 219 (user-name (format "%d" (user-login-name))) | |
| 220 (t (error 'invalid-argument "Unrecognized print-context property" | |
| 221 prop))))) | |
| 442 | 222 |
| 506 | 223 (defun generic-page-setup () |
| 224 "Display the Page Setup dialog box. | |
| 225 Changes made are recorded internally." | |
| 226 (interactive) | |
| 227 (let* ((d (Printer-get-device)) | |
| 228 (props | |
| 229 (condition-case err | |
| 230 (make-dialog-box 'page-setup :device d | |
| 778 | 231 :properties (declare-boundp |
| 232 default-msprinter-frame-plist)) | |
| 506 | 233 (error |
| 234 (Printer-clear-device) | |
| 235 (signal (car err) (cdr err)))))) | |
| 236 (while props | |
| 778 | 237 (with-boundp 'default-msprinter-frame-plist |
| 238 (setq default-msprinter-frame-plist | |
| 239 (plist-put default-msprinter-frame-plist (car props) | |
| 240 (cadr props)))) | |
| 506 | 241 (setq props (cddr props))))) |
| 242 | |
| 491 | 243 (defun generic-print-buffer (&optional buffer display-print-dialog) |
| 444 | 244 "Print buffer BUFFER using a printing method appropriate to the O.S. being run. |
| 442 | 245 Under Unix, `lpr' is normally used to spool out a no-frills version of the |
| 246 buffer, or the `ps-print' package is used to pretty-print the buffer to a | |
| 247 PostScript printer. Under MS Windows, the built-in printing support is used. | |
| 248 | |
| 491 | 249 If DISPLAY-PRINT-DIALOG is t, the print dialog will first be |
| 250 displayed, allowing the user to select various printing settings | |
| 251 \(e.g. which printer to print to, the range of pages, number of copies, | |
| 252 modes such landscape/portrait/2-up/4-up [2 or 4 (small!) logical pages | |
| 253 per physical page], etc.). At this point the user can cancel the printing | |
| 254 operation using the dialog box, and `generic-print-buffer' will not print | |
| 255 anything. When called interactively, use a prefix arg to suppress the | |
| 256 display of the print dialog box. | |
| 257 | |
| 444 | 258 If BUFFER is nil or omitted, the current buffer is used." |
| 503 | 259 (interactive (list nil (not current-prefix-arg))) |
| 903 | 260 (condition-case err |
| 261 (let* ((print-region (and (interactive-p) (region-active-p))) | |
| 262 (start (if print-region (region-beginning) (point-min buffer))) | |
| 263 (end (if print-region (region-end) (point-max buffer)))) | |
|
4459
554b9d31e7a5
Handle printing correctly on non-mswindows.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1346
diff
changeset
|
264 (if (or (not (valid-device-type-p 'msprinter)) |
| 903 | 265 (not display-print-dialog)) |
| 266 (generic-print-region start end buffer) | |
| 267 (let* ((d (Printer-get-device)) | |
| 268 (props (make-dialog-box 'print :device d | |
| 510 | 269 :allow-selection print-region |
| 270 :selected-page-button | |
| 903 | 271 (if print-region 'selection 'all)))) |
| 272 (and props | |
| 273 (let ((really-print-region | |
| 274 (eq (plist-get props 'selected-page-button) 'selection))) | |
| 275 (generic-print-region (if really-print-region start | |
| 276 (point-min buffer)) | |
| 277 (if really-print-region end | |
| 278 (point-max buffer)) | |
| 279 buffer d props)))))) | |
| 280 (error | |
| 281 ;; Make sure we catch all errors thrown from the native code. | |
| 282 (Printer-clear-device) | |
| 283 (signal (car err) (cdr err))))) | |
| 442 | 284 |
| 491 | 285 (defun generic-print-region (start end &optional buffer print-device props) |
| 442 | 286 "Print region using a printing method appropriate to the O.S. being run. |
| 444 | 287 The region between START and END of BUFFER (defaults to the current |
| 288 buffer) is printed. | |
| 442 | 289 |
| 290 Under Unix, `lpr' is normally used to spool out a no-frills version of the | |
| 291 buffer, or the `ps-print' package is used to pretty-print the buffer to a | |
| 491 | 292 PostScript printer. Under MS Windows, the built-in printing support is used. |
| 293 | |
| 294 Optional PRINT-DEVICE is a device, already created, to use to do the | |
| 295 printing. This is typically used when this function was invoked from | |
| 296 `generic-print-buffer' and it displayed a dialog box. That function created | |
| 297 the device, and then the dialog box stuffed it with the user's selections | |
| 298 of how the buffer should be printed. | |
| 299 | |
| 300 PROPS, if given, is typically the plist returned from the call to | |
| 301 `make-dialog-box' that displayed the Print box. It contains properties | |
| 302 relevant to us when we print. | |
| 303 | |
| 304 Recognized properties are the same as those in `make-dialog-box': | |
| 305 | |
| 306 name Printer device name. If omitted, the current system-selected | |
| 307 printer will be used. | |
| 308 from-page First page to print, 1-based. If omitted, printing starts from | |
| 309 the beginning. | |
| 310 to-page Last page to print, inclusive, If omitted, printing ends at | |
| 311 the end. | |
| 312 copies Number of copies to print. If omitted, one copy is printed." | |
|
4459
554b9d31e7a5
Handle printing correctly on non-mswindows.
Aidan Kehoe <kehoea@parhasard.net>
parents:
1346
diff
changeset
|
313 (cond ((valid-device-type-p 'msprinter) |
| 510 | 314 ;; loop, printing one copy of document per loop. kill and |
| 315 ;; re-create the frame each time so that we eject the piece | |
| 316 ;; of paper at the end even if we're printing more than one | |
| 317 ;; page per sheet of paper. | |
| 707 | 318 (let ((copies (plist-get props 'copies 1)) |
| 319 ;; This is not relevant to printing and can mess up | |
| 320 ;; msprinter frame sizing | |
| 321 default-frame-plist) | |
| 510 | 322 (while (> copies 0) |
| 323 (let (d f header-buffer footer-buffer) | |
| 324 (setq buffer (decode-buffer buffer)) | |
| 325 (unwind-protect | |
| 326 (with-current-buffer buffer | |
| 327 (save-restriction | |
| 328 (narrow-to-region start end) | |
| 329 (setq d (or print-device (Printer-get-device))) | |
| 330 (setq f (make-frame | |
| 331 (list* 'name | |
| 332 (concat | |
| 491 | 333 (substitute ?_ ?. (buffer-name buffer)) |
| 334 " - XEmacs") | |
| 510 | 335 '(menubar-visible-p |
| 336 nil | |
| 337 has-modeline-p nil | |
| 338 default-toolbar-visible-p nil | |
| 339 default-gutter-visible-p nil | |
| 340 minibuffer none | |
| 341 modeline-shadow-thickness 0 | |
| 342 vertical-scrollbar-visible-p nil | |
| 903 | 343 horizontal-scrollbar-visible-p nil |
| 344 [default foreground] "black" | |
| 345 [default background] "white")) | |
| 510 | 346 d)) |
| 347 (let* ((w (frame-root-window f)) | |
| 348 (vertdpi | |
| 349 (cdr (device-system-metric d 'device-dpi))) | |
| 350 (pixel-vertical-clip-threshold (/ vertdpi 2)) | |
| 351 (from-page (plist-get props 'from-page 1)) | |
| 352 (to-page (plist-get props 'to-page)) | |
| 353 (context (make-Print-context | |
| 354 :start-time (current-time) | |
| 355 ;; #### bogus! we need accessors for | |
| 356 ;; print-settings objects. | |
| 357 :printer-name | |
| 358 (or (plist-get props 'name) | |
| 359 printer-name | |
| 778 | 360 (declare-fboundp |
| 361 (mswindows-get-default-printer) | |
| 362 )))) | |
| 510 | 363 header-window |
| 364 footer-window) | |
| 903 | 365 |
| 510 | 366 (when printer-page-header |
| 367 (let ((window-min-height 2)) | |
| 368 (setq header-window w) | |
| 369 (setq w (split-window w 2))) | |
| 370 (setq header-buffer | |
| 371 (generate-new-buffer " *header*")) | |
| 372 (set-window-buffer header-window header-buffer)) | |
| 903 | 373 |
| 510 | 374 (when printer-page-footer |
| 375 (let ((window-min-height 2)) | |
| 376 (setq footer-window | |
| 377 (split-window w (- (window-height w) 2)))) | |
| 378 (setq footer-buffer | |
| 379 (generate-new-buffer " *footer*")) | |
| 380 (set-window-buffer footer-window footer-buffer)) | |
| 903 | 381 |
| 510 | 382 (setf (Print-context-window context) w) |
| 903 | 383 |
| 510 | 384 (let ((last-end 0) ; bufpos at end of previous page |
| 385 reached-end ; t if we've reached the end of the | |
| 491 | 386 ; text we're printing |
| 510 | 387 (pageno 1)) |
| 388 (set-window-buffer w buffer) | |
| 389 (set-window-start w start) | |
| 491 | 390 |
| 510 | 391 ;; loop, printing one page per loop |
| 392 (while (and (not reached-end) | |
| 393 ;; stop at end of region of text or | |
| 394 ;; outside of ranges of pages given | |
| 395 (or (not to-page) (<= pageno to-page))) | |
| 491 | 396 |
| 510 | 397 (setf (Print-context-pageno context) pageno) |
| 491 | 398 |
| 510 | 399 ;; only actually print the page if it's in the |
| 400 ;; range. | |
| 401 (when (>= pageno from-page) | |
| 402 (when printer-page-header | |
| 403 (with-current-buffer header-buffer | |
| 404 (erase-buffer) | |
| 405 (generate-header-line printer-page-header | |
| 406 context) | |
| 407 (goto-char (point-min)) | |
| 408 (set-window-start header-window | |
| 409 (point-min)))) | |
| 491 | 410 |
| 510 | 411 (when printer-page-footer |
| 412 (with-current-buffer footer-buffer | |
| 413 (erase-buffer) | |
| 414 (insert "\n") | |
| 415 (generate-header-line printer-page-footer | |
| 416 context) | |
| 417 (goto-char (point-min)) | |
| 418 (set-window-start footer-window | |
| 419 (point-min)))) | |
| 491 | 420 |
| 510 | 421 (redisplay-frame f t) |
| 422 (print-job-eject-page f) | |
| 423 ) | |
| 424 ;; but use the GUARANTEE argument to `window-end' | |
| 425 ;; so that we get the right value even if we | |
| 426 ;; didn't do a redisplay. | |
| 427 (let ((this-end (window-end w t)) | |
| 428 (pixvis | |
| 429 (window-last-line-visible-height w))) | |
| 430 ;; in case we get stuck somewhere, bow out | |
| 431 ;; rather than printing an infinite number of | |
| 432 ;; pages. #### this will fail with an image | |
| 433 ;; bigger than an entire page. but we really | |
| 434 ;; need this check here. we should be more | |
| 435 ;; clever in our check, to deal with this case. | |
| 436 (if (or (= this-end last-end) | |
| 437 ;; #### fuckme! window-end returns a | |
| 438 ;; value outside of the valid range of | |
| 439 ;; buffer positions!!! | |
| 440 (>= this-end end)) | |
| 441 (setq reached-end t) | |
| 442 (setq last-end this-end) | |
| 443 (set-window-start w this-end) | |
| 444 (if pixvis | |
| 445 (with-selected-window w | |
| 446 ;; #### scroll-down should take a | |
| 447 ;; window arg. | |
| 448 (let ((window-pixel-scroll-increment | |
| 449 pixvis)) | |
| 450 (scroll-down 1)))))) | |
| 546 | 451 (setq pageno (1+ pageno))))))) |
| 452 (and f (delete-frame f)) | |
| 453 (and header-buffer (kill-buffer header-buffer)) | |
| 454 (and footer-buffer (kill-buffer footer-buffer)))) | |
| 510 | 455 (setq copies (1- copies))))) |
| 442 | 456 ((and (not (eq system-type 'windows-nt)) |
| 503 | 457 (fboundp 'lpr-region)) |
| 872 | 458 (declare-fboundp (lpr-region start end))) |
| 442 | 459 (t (error "No print support available")))) |