Mercurial > emacs
comparison lisp/ps-print.el @ 76259:c3f6909185f7
Minor fix.
| author | Vinicius Jose Latorre <viniciusjl@ig.com.br> |
|---|---|
| date | Thu, 01 Mar 2007 19:53:32 +0000 |
| parents | 6f45466672db |
| children | 3823acfb56c7 |
comparison
equal
deleted
inserted
replaced
| 76258:ec75921d5b7b | 76259:c3f6909185f7 |
|---|---|
| 1448 (or (featurep 'lisp-float-type) | 1448 (or (featurep 'lisp-float-type) |
| 1449 (error "`ps-print' requires floating point support")) | 1449 (error "`ps-print' requires floating point support")) |
| 1450 | 1450 |
| 1451 (let ((case-fold-search t)) | 1451 (let ((case-fold-search t)) |
| 1452 (cond ((string-match "XEmacs" emacs-version)) | 1452 (cond ((string-match "XEmacs" emacs-version)) |
| 1453 ((string-match "Lucid" emacs-version) | 1453 ((string-match "Lucid" emacs-version) |
| 1454 (error "`ps-print' doesn't support Lucid")) | 1454 (error "`ps-print' doesn't support Lucid")) |
| 1455 ((string-match "Epoch" emacs-version) | 1455 ((string-match "Epoch" emacs-version) |
| 1456 (error "`ps-print' doesn't support Epoch")) | 1456 (error "`ps-print' doesn't support Epoch")) |
| 1457 (t | 1457 (t |
| 1458 (unless (and (boundp 'emacs-major-version) | 1458 (unless (and (boundp 'emacs-major-version) |
| 1459 (>= emacs-major-version 22)) | 1459 (>= emacs-major-version 22)) |
| 1460 (error "`ps-print' only supports Emacs 22 and higher"))))) | 1460 (error "`ps-print' only supports Emacs 22 and higher"))))) |
| 1461 | 1461 |
| 1462 | 1462 |
| 1463 ;; GNU Emacs | 1463 ;; GNU Emacs |
| 1464 (or (fboundp 'line-beginning-position) | 1464 (or (fboundp 'line-beginning-position) |
| 1465 (defun line-beginning-position (&optional n) | 1465 (defun line-beginning-position (&optional n) |
| 1496 (defalias 'ps-e-overlay-get 'overlay-get) | 1496 (defalias 'ps-e-overlay-get 'overlay-get) |
| 1497 (defalias 'ps-e-overlay-end 'overlay-end) | 1497 (defalias 'ps-e-overlay-end 'overlay-end) |
| 1498 (defalias 'ps-e-x-color-values 'x-color-values) | 1498 (defalias 'ps-e-x-color-values 'x-color-values) |
| 1499 (defalias 'ps-e-color-values 'color-values) | 1499 (defalias 'ps-e-color-values 'color-values) |
| 1500 (defalias 'ps-e-find-composition (if (fboundp 'find-composition) | 1500 (defalias 'ps-e-find-composition (if (fboundp 'find-composition) |
| 1501 'find-composition | 1501 'find-composition |
| 1502 'ignore)) | 1502 'ignore)) |
| 1503 | 1503 |
| 1504 | 1504 |
| 1505 (defconst ps-windows-system | 1505 (defconst ps-windows-system |
| 1506 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) | 1506 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) |
| 1507 (defconst ps-lp-system | 1507 (defconst ps-lp-system |
| 1513 (ps-x-color-name color) | 1513 (ps-x-color-name color) |
| 1514 color)) | 1514 color)) |
| 1515 | 1515 |
| 1516 (defalias 'ps-frame-parameter | 1516 (defalias 'ps-frame-parameter |
| 1517 (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property)) | 1517 (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property)) |
| 1518 | |
| 1518 (defalias 'ps-mark-active-p | 1519 (defalias 'ps-mark-active-p |
| 1519 (if (fboundp 'region-active-p) | 1520 (if (fboundp 'region-active-p) |
| 1520 'region-active-p ; XEmacs | 1521 'region-active-p ; XEmacs |
| 1521 (defvar mark-active) ; To shup up XEmacs's byte compiler. | 1522 (defvar mark-active) ; To shup up XEmacs's byte compiler. |
| 1522 (lambda () mark-active))) ; Emacs | 1523 (lambda () mark-active))) ; Emacs |
| 1523 | 1524 |
| 1524 (cond ((featurep 'xemacs) ; XEmacs | 1525 (cond ((featurep 'xemacs) ; XEmacs |
| 1525 (defun ps-face-foreground-name (face) | 1526 (defun ps-face-foreground-name (face) |
| 1526 (ps-xemacs-color-name (face-foreground face))) | 1527 (ps-xemacs-color-name (face-foreground face))) |
| 1527 (defun ps-face-background-name (face) | 1528 (defun ps-face-background-name (face) |
| 3583 "Return the current PostScript-generation setup." | 3584 "Return the current PostScript-generation setup." |
| 3584 (let (ps-prefix-quote) | 3585 (let (ps-prefix-quote) |
| 3585 (mapconcat | 3586 (mapconcat |
| 3586 #'ps-print-quote | 3587 #'ps-print-quote |
| 3587 (list | 3588 (list |
| 3588 (concat "\n;;; ps-print version " ps-print-version "\n") | 3589 (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs") |
| 3590 ") ps-print version " ps-print-version "\n") | |
| 3589 ";; internal vars" | 3591 ";; internal vars" |
| 3590 (ps-comment-string "emacs-version " emacs-version) | 3592 (ps-comment-string "emacs-version " emacs-version) |
| 3591 (ps-comment-string "ps-windows-system " ps-windows-system) | 3593 (ps-comment-string "ps-windows-system " ps-windows-system) |
| 3592 (ps-comment-string "ps-lp-system " ps-lp-system) | 3594 (ps-comment-string "ps-lp-system " ps-lp-system) |
| 3593 nil | 3595 nil |
| 3594 '(25 . ps-print-color-p) | 3596 '(25 . ps-print-color-p) |
| 3595 '(25 . ps-lpr-command) | 3597 '(25 . ps-lpr-command) |
| 3596 '(25 . ps-lpr-switches) | 3598 '(25 . ps-lpr-switches) |
| 3597 '(25 . ps-printer-name) | 3599 '(25 . ps-printer-name) |
| 3841 ;; Return t if the device (which can be changed during an emacs session) | 3843 ;; Return t if the device (which can be changed during an emacs session) |
| 3842 ;; can handle colors. | 3844 ;; can handle colors. |
| 3843 ;; This function is not yet implemented for GNU emacs. | 3845 ;; This function is not yet implemented for GNU emacs. |
| 3844 (defalias 'ps-color-device | 3846 (defalias 'ps-color-device |
| 3845 (cond ((and (featurep 'xemacs) | 3847 (cond ((and (featurep 'xemacs) |
| 3846 ;; XEmacs change: Need to check for emacs-major-version too. | 3848 ;; XEmacs change: Need to check for emacs-major-version too. |
| 3847 (or (> emacs-major-version 19) | 3849 (or (> emacs-major-version 19) |
| 3848 (and (= emacs-major-version 19) | 3850 (and (= emacs-major-version 19) |
| 3849 (>= emacs-minor-version 12)))) ; XEmacs >= 19.12 | 3851 (>= emacs-minor-version 12)))) ; XEmacs >= 19.12 |
| 3850 (lambda () | 3852 (lambda () |
| 3851 (eq (ps-x-device-class) 'color))) | 3853 (eq (ps-x-device-class) 'color))) |
| 3852 | 3854 |
| 3853 (t ; Emacs | 3855 (t ; Emacs |
| 3854 (lambda () | 3856 (lambda () |
| 3855 (if (fboundp 'color-values) | 3857 (if (fboundp 'color-values) |
| 3856 (ps-e-color-values "Green") | 3858 (ps-e-color-values "Green") |
| 3857 t))))) | 3859 t))))) |
| 3858 | 3860 |
| 3859 | 3861 |
| 3860 (defun ps-mapper (extent list) | 3862 (defun ps-mapper (extent list) |
| 3861 (nconc list | 3863 (nconc list |
| 3862 (list (list (ps-x-extent-start-position extent) 'push extent) | 3864 (list (list (ps-x-extent-start-position extent) 'push extent) |