X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b2e6b10fe2d40020a75ab0025af98a4abf339cd2..08974112ae68aefba658a8516c8faa3374edc924:/lisp/ps-def.el diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 547939ef32..60016285e7 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -1,30 +1,29 @@ ;;; ps-def.el --- XEmacs and Emacs definitions for ps-print -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007-2016 Free Software Foundation, Inc. ;; Author: Vinicius Jose Latorre ;; Kenichi Handa (multi-byte characters) ;; Maintainer: Kenichi Handa (multi-byte characters) ;; Vinicius Jose Latorre ;; Keywords: wp, print, PostScript -;; Version: 7.2.2 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; Package: ps-print ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2, or (at your option) any later -;; version. +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY -;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -;; details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. -;; You should have received a copy of the GNU General Public License along with -;; GNU Emacs; see the file COPYING. If not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,6 +31,15 @@ ;;; Code: +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))) + +(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) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,95 +50,25 @@ (cond ((featurep 'xemacs) ; XEmacs - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ps-bdf (defvar installation-directory nil) (defvar coding-system-for-read) - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ps-mule - (defvar leading-code-private-22 157) - - (or (fboundp 'charset-bytes) - (defun charset-bytes (charset) 1)) ; ascii - (or (fboundp 'charset-dimension) - (defun charset-dimension (charset) 1)) ; ascii - - (or (fboundp 'charset-id) - (defun charset-id (charset) 0)) ; ascii - - (or (fboundp 'charset-width) - (defun charset-width (charset) 1)) ; ascii - - (or (fboundp 'find-charset-region) - (defun find-charset-region (beg end &optional table) - (list 'ascii))) + (defun charset-dimension (_charset) 1)) ; ascii (or (fboundp 'char-width) - (defun char-width (char) 1)) ; ascii - - (or (fboundp 'chars-in-region) - (defun chars-in-region (beg end) - (- (max beg end) (min beg end)))) - - (or (fboundp 'forward-point) - (defun forward-point (arg) - (save-excursion - (let ((count (abs arg)) - (step (if (zerop arg) - 0 - (/ arg arg)))) - (while (and (> count 0) - (< (point-min) (point)) (< (point) (point-max))) - (forward-char step) - (setq count (1- count))) - (+ (point) (* count step)))))) - - (or (fboundp 'decompose-composite-char) - (defun decompose-composite-char (char &optional type - with-composition-rule) - nil)) - - (or (fboundp 'encode-coding-string) - (defun encode-coding-string (string coding-system &optional nocopy) - (if nocopy - string - (copy-sequence string)))) - - (or (fboundp 'coding-system-p) - (defun coding-system-p (obj) nil)) - - (or (fboundp 'ccl-execute-on-string) - (defun ccl-execute-on-string (ccl-prog status str - &optional contin unibyte-p) - str)) - - (or (fboundp 'define-ccl-program) - (defmacro define-ccl-program (name ccl-program &optional doc) - `(defconst ,name nil ,doc))) - - (or (fboundp 'multibyte-string-p) - (defun multibyte-string-p (str) - (let ((len (length str)) - (i 0) - multibyte) - (while (and (< i len) (not (setq multibyte (> (aref str i) 255)))) - (setq i (1+ i))) - multibyte))) - - (or (fboundp 'string-make-multibyte) - (defalias 'string-make-multibyte 'copy-sequence)) + (defun char-width (_char) 1)) ; ascii (or (fboundp 'encode-char) - (defun encode-char (ch ccs) + (defun encode-char (ch _ccs) ch)) - ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ps-print @@ -170,17 +108,8 @@ ;; Return t if the device (which can be changed during an emacs session) ;; can handle colors. - ;; XEmacs change: Need to check for emacs-major-version too. - (if (or (> emacs-major-version 19) - (and (= emacs-major-version 19) - (>= emacs-minor-version 12))) - ;; xemacs >= 19.12 - (defun ps-color-device () - (eq (device-class) 'color)) - ;; xemacs < 19.12 - (setq ps-print-color-p nil) - (defalias 'ps-color-device 'ignore)) - + (defun ps-color-device () + (eq (device-class) 'color)) (defun ps-mapper (extent list) (nconc list @@ -241,6 +170,15 @@ (memq face ps-italic-faces))) ; Kludge-compatible + (defalias 'ps-face-strikeout-p 'ignore) + + + (defalias 'ps-face-overline-p 'ignore) + + + (defalias 'ps-face-box-p 'ignore) + + ;; XEmacs will have to make do with %s (princ) for floats. (defvar ps-color-format "%s %s %s") (defvar ps-float-format "%s ") @@ -362,6 +300,18 @@ (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") @@ -375,8 +325,6 @@ ;; Emacs (property-change from) (overlay-change from) - (save-buffer-invisibility-spec buffer-invisibility-spec) - (buffer-invisibility-spec nil) before-string after-string) (while (< from to) (and (< property-change to) ; Don't search for property change @@ -389,53 +337,11 @@ (setq position (min property-change overlay-change) before-string nil after-string nil) - ;; The code below is not quite correct, - ;; because a non-nil overlay invisible property - ;; which is inactive according to the current value - ;; of buffer-invisibility-spec nonetheless overrides - ;; a face text property. (setq face - (cond ((let ((prop (get-text-property from 'invisible))) - ;; Decide whether this invisible property - ;; really makes the text invisible. - (if (eq save-buffer-invisibility-spec t) - (not (null prop)) - (or (memq prop save-buffer-invisibility-spec) - (assq prop save-buffer-invisibility-spec)))) + (cond ((invisible-p from) 'emacs--invisible--face) - ((get-text-property from 'face)) + ((get-char-property from 'face)) (t 'default))) - (let ((overlays (overlays-at from)) - (face-priority -1)) ; text-property - (while (and overlays - (not (eq face 'emacs--invisible--face))) - (let* ((overlay (car overlays)) - (overlay-invisible - (overlay-get overlay 'invisible)) - (overlay-priority - (or (overlay-get overlay 'priority) 0))) - (and (> overlay-priority face-priority) - (setq before-string - (or (overlay-get overlay 'before-string) - before-string) - after-string - (or (and (<= (overlay-end overlay) position) - (overlay-get overlay 'after-string)) - after-string) - face-priority overlay-priority - face - (cond - ((if (eq save-buffer-invisibility-spec t) - (not (null overlay-invisible)) - (or (memq overlay-invisible - save-buffer-invisibility-spec) - (assq overlay-invisible - save-buffer-invisibility-spec))) - 'emacs--invisible--face) - ((overlay-get overlay 'face)) - (t face) - )))) - (setq overlays (cdr overlays)))) ;; Plot up to this record. (and before-string (ps-plot-string before-string)) @@ -452,5 +358,4 @@ (provide 'ps-def) -;; arch-tag: 4edde45b-af10-4685-b8ee-7cd0f951095a ;;; ps-def.el ends here