Mercurial > hg > xemacs-beta

comparison lisp/printer.el @ 903:4a27df428c73

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-07-06 05:48:14 by andyp] sync with 21.4
author andyp
date Sat, 06 Jul 2002 05:48:22 +0000
parents 79c6ff3eef26
children 01c57eb70ae9
comparison
equal deleted inserted replaced
902:2fd2239ea63a 903:4a27df428c73
74 (defun Printer-get-device () 74 (defun Printer-get-device ()
75 (or printer-current-device (setq printer-current-device 75 (or printer-current-device (setq printer-current-device
76 (make-device 'msprinter printer-name)))) 76 (make-device 'msprinter printer-name))))
77 77
78 (defun Printer-clear-device () 78 (defun Printer-clear-device ()
79 ;; relying on GC to delete the device is too error-prone since there
80 ;; only can be one anyway.
81 (and printer-current-device (delete-device printer-current-device))
79 (setq printer-current-device nil)) 82 (setq printer-current-device nil))
80 83
81 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name)) 84 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
82 "*Controls printed page header. 85 "*Controls printed page header.
83 86
254 anything. When called interactively, use a prefix arg to suppress the 257 anything. When called interactively, use a prefix arg to suppress the
255 display of the print dialog box. 258 display of the print dialog box.
256 259
257 If BUFFER is nil or omitted, the current buffer is used." 260 If BUFFER is nil or omitted, the current buffer is used."
258 (interactive (list nil (not current-prefix-arg))) 261 (interactive (list nil (not current-prefix-arg)))
259 (let* ((print-region (and (interactive-p) (region-active-p))) 262 (condition-case err
260 (start (if print-region (region-beginning) (point-min buffer))) 263 (let* ((print-region (and (interactive-p) (region-active-p)))
261 (end (if print-region (region-end) (point-max buffer)))) 264 (start (if print-region (region-beginning) (point-min buffer)))
262 (if (or (not (valid-specifier-tag-p 'msprinter)) 265 (end (if print-region (region-end) (point-max buffer))))
263 (not display-print-dialog)) 266 (if (or (not (valid-specifier-tag-p 'msprinter))
264 (generic-print-region start end buffer) 267 (not display-print-dialog))
265 (let* ((d (Printer-get-device)) 268 (generic-print-region start end buffer)
266 (props (condition-case err 269 (let* ((d (Printer-get-device))
267 (make-dialog-box 'print :device d 270 (props (make-dialog-box 'print :device d
268 :allow-selection print-region 271 :allow-selection print-region
269 :selected-page-button 272 :selected-page-button
270 (if print-region 'selection 'all)) 273 (if print-region 'selection 'all))))
271 (error 274 (and props
272 (Printer-clear-device) 275 (let ((really-print-region
273 (signal (car err) (cdr err)))))) 276 (eq (plist-get props 'selected-page-button) 'selection)))
274 (and props 277 (generic-print-region (if really-print-region start
275 (let ((really-print-region 278 (point-min buffer))
276 (eq (plist-get props 'selected-page-button) 'selection))) 279 (if really-print-region end
277 (generic-print-region (if really-print-region start 280 (point-max buffer))
278 (point-min buffer)) 281 buffer d props))))))
279 (if really-print-region end 282 (error
280 (point-max buffer)) 283 ;; Make sure we catch all errors thrown from the native code.
281 buffer d props))))))) 284 (Printer-clear-device)
285 (signal (car err) (cdr err)))))
282 286
283 (defun generic-print-region (start end &optional buffer print-device props) 287 (defun generic-print-region (start end &optional buffer print-device props)
284 "Print region using a printing method appropriate to the O.S. being run. 288 "Print region using a printing method appropriate to the O.S. being run.
285 The region between START and END of BUFFER (defaults to the current 289 The region between START and END of BUFFER (defaults to the current
286 buffer) is printed. 290 buffer) is printed.
336 default-toolbar-visible-p nil 340 default-toolbar-visible-p nil
337 default-gutter-visible-p nil 341 default-gutter-visible-p nil
338 minibuffer none 342 minibuffer none
339 modeline-shadow-thickness 0 343 modeline-shadow-thickness 0
340 vertical-scrollbar-visible-p nil 344 vertical-scrollbar-visible-p nil
341 horizontal-scrollbar-visible-p nil)) 345 horizontal-scrollbar-visible-p nil
346 [default foreground] "black"
347 [default background] "white"))
342 d)) 348 d))
343 (let* ((w (frame-root-window f)) 349 (let* ((w (frame-root-window f))
344 (vertdpi 350 (vertdpi
345 (cdr (device-system-metric d 'device-dpi))) 351 (cdr (device-system-metric d 'device-dpi)))
346 (pixel-vertical-clip-threshold (/ vertdpi 2)) 352 (pixel-vertical-clip-threshold (/ vertdpi 2))
356 (declare-fboundp 362 (declare-fboundp
357 (mswindows-get-default-printer) 363 (mswindows-get-default-printer)
358 )))) 364 ))))
359 header-window 365 header-window
360 footer-window) 366 footer-window)
361 367
362 (when printer-page-header 368 (when printer-page-header
363 (let ((window-min-height 2)) 369 (let ((window-min-height 2))
364 (setq header-window w) 370 (setq header-window w)
365 (setq w (split-window w 2))) 371 (setq w (split-window w 2)))
366 (setq header-buffer 372 (setq header-buffer
367 (generate-new-buffer " *header*")) 373 (generate-new-buffer " *header*"))
368 (set-window-buffer header-window header-buffer)) 374 (set-window-buffer header-window header-buffer))
369 375
370 (when printer-page-footer 376 (when printer-page-footer
371 (let ((window-min-height 2)) 377 (let ((window-min-height 2))
372 (setq footer-window 378 (setq footer-window
373 (split-window w (- (window-height w) 2)))) 379 (split-window w (- (window-height w) 2))))
374 (setq footer-buffer 380 (setq footer-buffer
375 (generate-new-buffer " *footer*")) 381 (generate-new-buffer " *footer*"))
376 (set-window-buffer footer-window footer-buffer)) 382 (set-window-buffer footer-window footer-buffer))
377 383
378 (setf (Print-context-window context) w) 384 (setf (Print-context-window context) w)
379 385
380 (let ((last-end 0) ; bufpos at end of previous page 386 (let ((last-end 0) ; bufpos at end of previous page
381 reached-end ; t if we've reached the end of the 387 reached-end ; t if we've reached the end of the
382 ; text we're printing 388 ; text we're printing
383 (pageno 1)) 389 (pageno 1))
384 (set-window-buffer w buffer) 390 (set-window-buffer w buffer)