lisp/ps-def.el

   1 ;;; ps-def.el --- Emacs definitions for ps-print -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
   4
   5 ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
   6 ;;      Kenichi Handa <handa@gnu.org> (multi-byte characters)
   7 ;; Keywords: wp, print, PostScript
   8 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
   9 ;; Package: ps-print
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; See ps-print.el for documentation.
  29
  30 ;;; Code:
  31
  32 (declare-function ps-plot-with-face "ps-print" (from to face))
  33 (declare-function ps-plot-string    "ps-print" (string))
  34
  35 (defvar ps-bold-faces)                  ; in ps-print.el
  36 (defvar ps-italic-faces)
  37
  38
  39 \f
  40
  41 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  43 ;; Emacs Definitions
  44
  45
  46 (defun ps-mark-active-p ()
  47   mark-active)
  48
  49
  50 (defun ps-face-foreground-name (face)
  51   (face-foreground face nil t))
  52
  53
  54 (defun ps-face-background-name (face)
  55   (face-background face nil t))
  56
  57
  58 (defalias 'ps-frame-parameter 'frame-parameter)
  59
  60 ;; Return t if the device (which can be changed during an emacs session) can
  61 ;; handle colors.  This function is not yet implemented for GNU emacs.
  62 (defun ps-color-device ()
  63   (if (fboundp 'color-values)
  64       (funcall 'color-values "Green")
  65     t))
  66
  67
  68 (defun ps-color-values (x-color)
  69   (cond
  70    ((fboundp 'color-values)
  71     (funcall 'color-values x-color))
  72    ((fboundp 'x-color-values)
  73     (funcall 'x-color-values x-color))
  74    (t
  75     (error "No available function to determine X color values"))))
  76
  77
  78 (defun ps-face-bold-p (face)
  79   (or (face-bold-p face)
  80       (memq face ps-bold-faces)))
  81
  82
  83 (defun ps-face-italic-p (face)
  84   (or (face-italic-p face)
  85       (memq face ps-italic-faces)))
  86
  87
  88 (defun ps-face-strikeout-p (face)
  89   (eq (face-attribute face :strike-through) t))
  90
  91
  92 (defun ps-face-overline-p (face)
  93   (eq (face-attribute face :overline) t))
  94
  95
  96 (defun ps-face-box-p (face)
  97   (not (memq (face-attribute face :box) '(nil unspecified))))
  98
  99
 100 ;; Emacs understands the %f format; we'll use it to limit color RGB values
 101 ;; to three decimals to cut down some on the size of the PostScript output.
 102 (defvar ps-color-format "%0.3f %0.3f %0.3f")
 103 (defvar ps-float-format "%0.3f ")
 104
 105
 106 (defun ps-generate-postscript-with-faces1 (from to)
 107   ;; Generate some PostScript.
 108   (let ((face 'default)
 109         (position to)
 110         ;; Emacs
 111         (property-change from)
 112         (overlay-change from)
 113         before-string after-string)
 114     (while (< from to)
 115       (and (< property-change to)  ; Don't search for property change
 116                                         ; unless previous search succeeded.
 117            (setq property-change (next-property-change from nil to)))
 118       (and (< overlay-change to)   ; Don't search for overlay change
 119                                         ; unless previous search succeeded.
 120            (setq overlay-change (min (next-overlay-change from)
 121                                      to)))
 122       (setq position (min property-change overlay-change)
 123             before-string nil
 124             after-string nil)
 125       (setq face
 126             (cond ((invisible-p from)
 127                    'emacs--invisible--face)
 128                   ((get-char-property from 'face))
 129                   (t 'default)))
 130       ;; Plot up to this record.
 131       (and before-string
 132            (ps-plot-string before-string))
 133       (ps-plot-with-face from position face)
 134       (and after-string
 135            (ps-plot-string after-string))
 136       (setq from position))
 137     (ps-plot-with-face from to face)))
 138
 139 \f
 140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 141
 142 (provide 'ps-def)
 143
 144 ;;; ps-def.el ends here