mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Move some definitions from ps-def.el to ps-print.el

Browse source 
* lisp/ps-def.el (ps-face-bold-p, ps-face-italic-p)
(ps-face-strikeout-p, ps-face-overline-p, ps-face-box-p)
(ps-color-format, ps-float-format)
(ps-generate-postscript-with-faces1): Move from here...
* lisp/ps-print.el (ps-face-bold-p, ps-face-italic-p)
(ps-face-strikeout-p, ps-face-overline-p, ps-face-box-p)
(ps-color-format, ps-float-format)
(ps-generate-postscript-with-faces1): ...to here.
This commit is contained in:
Stefan Kangas 2022-07-31 18:15:55 +02:00
parent 54fed8e1f9
commit 97b80912e9
2 changed files with 52 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

67
lisp/ps-def.el
View file

@ -29,12 +29,6 @@
;;; Code: ;;; Code:
(declare-function ps-plot-with-face "ps-print" (from to face))
(declare-function ps-plot-string "ps-print" (string))
(defvar ps-bold-faces) ; in ps-print.el
(defvar ps-italic-faces)
;; Emacs Definitions ;; Emacs Definitions
@ -54,67 +48,6 @@
(define-obsolete-function-alias 'ps-color-device #'display-color-p "29.1") (define-obsolete-function-alias 'ps-color-device #'display-color-p "29.1")
(define-obsolete-function-alias 'ps-color-values #'color-values "28.1") (define-obsolete-function-alias 'ps-color-values #'color-values "28.1")
(defun ps-face-bold-p (face)
(or (face-bold-p face)
(memq face ps-bold-faces)))
(defun ps-face-italic-p (face)
(or (face-italic-p face)
(memq face ps-italic-faces)))
(defun ps-face-strikeout-p (face)
(eq (face-attribute face :strike-through) t))
(defun ps-face-overline-p (face)
(eq (face-attribute face :overline) t))
(defun ps-face-box-p (face)
(not (memq (face-attribute face :box) '(nil unspecified))))
;; Emacs understands the %f format; we'll use it to limit color RGB values
;; to three decimals to cut down some on the size of the PostScript output.
(defvar ps-color-format "%0.3f %0.3f %0.3f")
(defvar ps-float-format "%0.3f ")
(defun ps-generate-postscript-with-faces1 (from to)
;; Generate some PostScript.
(let ((face 'default)
(position to)
;; Emacs
(property-change from)
(overlay-change from)
before-string after-string)
(while (< from to)
(and (< property-change to) ; Don't search for property change
; unless previous search succeeded.
(setq property-change (next-property-change from nil to)))
(and (< overlay-change to) ; Don't search for overlay change
; unless previous search succeeded.
(setq overlay-change (min (next-overlay-change from)
to)))
(setq position (min property-change overlay-change)
before-string nil
after-string nil)
(setq face
(cond ((invisible-p from)
'emacs--invisible--face)
((get-char-property from 'face))
(t 'default)))
;; Plot up to this record.
(and before-string
(ps-plot-string before-string))
(ps-plot-with-face from position face)
(and after-string
(ps-plot-string after-string))
(setq from position))
(ps-plot-with-face from to face)))
(provide 'ps-def) (provide 'ps-def)
;;; ps-def.el ends here ;;; ps-def.el ends here

52
lisp/ps-print.el
View file

@ -4733,6 +4733,10 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(defun ps-output-boolean (name bool) (defun ps-output-boolean (name bool)
(ps-output (format "/%s %s def\n" name (if bool "true" "false")))) (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
;; Limit color RGB values to three decimals to cut down some on the
;; size of the PostScript output.
(defvar ps-color-format "%0.3f %0.3f %0.3f")
(defvar ps-float-format "%0.3f ")
(defun ps-output-frame-properties (name alist) (defun ps-output-frame-properties (name alist)
(ps-output "/" name " [" (ps-output "/" name " ["
@ -6312,6 +6316,22 @@ If FACE is not a valid face name, use default face."
(setq ps-print-face-alist (cons face-map ps-print-face-alist))) (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
face-map)) face-map))
(defun ps-face-bold-p (face)
(or (face-bold-p face)
(memq face ps-bold-faces)))
(defun ps-face-italic-p (face)
(or (face-italic-p face)
(memq face ps-italic-faces)))
(defun ps-face-strikeout-p (face)
(eq (face-attribute face :strike-through) t))
(defun ps-face-overline-p (face)
(eq (face-attribute face :overline) t))
(defun ps-face-box-p (face)
(not (memq (face-attribute face :box) '(nil unspecified))))
(defun ps-screen-to-bit-face (face) (defun ps-screen-to-bit-face (face)
(cons face (cons face
@ -6325,6 +6345,38 @@ If FACE is not a valid face name, use default face."
(face-background face nil t)))) (face-background face nil t))))
(defun ps-generate-postscript-with-faces1 (from to)
;; Generate some PostScript.
(let ((face 'default)
(position to)
(property-change from)
(overlay-change from)
before-string after-string)
(while (< from to)
(and (< property-change to) ; Don't search for property change
; unless previous search succeeded.
(setq property-change (next-property-change from nil to)))
(and (< overlay-change to) ; Don't search for overlay change
; unless previous search succeeded.
(setq overlay-change (min (next-overlay-change from)
to)))
(setq position (min property-change overlay-change)
before-string nil
after-string nil)
(setq face
(cond ((invisible-p from)
'emacs--invisible--face)
((get-char-property from 'face))
(t 'default)))
;; Plot up to this record.
(and before-string
(ps-plot-string before-string))
(ps-plot-with-face from position face)
(and after-string
(ps-plot-string after-string))
(setq from position))
(ps-plot-with-face from to face)))
(defun ps-generate-postscript-with-faces (from to) (defun ps-generate-postscript-with-faces (from to)
;; Some initialization... ;; Some initialization...
(setq ps-current-effect 0) (setq ps-current-effect 0)