code.delx.au - gnu-emacs-elpa/blob - packages/auctex/prv-emacs.el

   1 ;;; prv-emacs.el --- GNU Emacs specific code for preview.el
   2
   3 ;; Copyright (C) 2001, 02, 03, 04, 05  Free Software Foundation, Inc.
   4
   5 ;; Author: David Kastrup
   6 ;; Keywords: convenience, tex, wp
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;
  26
  27 ;;; Code:
  28
  29 (require 'tex-site)
  30 (require 'tex)
  31 (require 'latex)
  32
  33 (defvar preview-compatibility-macros nil
  34   "List of macros only present when compiling/loading.")
  35
  36 (defcustom preview-transparent-color '(highlight :background)
  37   "Color to appear transparent in previews.
  38 Set this to something unusual when using `preview-transparent-border',
  39 to the default background in most other cases."
  40   :type '(radio (const :tag "None" nil)
  41                  (const :tag "Autodetect" t)
  42                  (color :tag "By name" :value "white")
  43                  (list :tag "Take from face"
  44                        :value (default :background)
  45                        (face)
  46                        (choice :tag "What to take"
  47                         (const :tag "Background" :value :background)
  48                         (const :tag "Foreground" :value :foreground))))
  49   :group 'preview-appearance)
  50
  51 ;;; Note that the following default introduces a border only when
  52 ;;; Emacs blinks politely when point is on an image (the tested
  53 ;;; unrelated function was introduced at about the time image blinking
  54 ;;; became tolerable).
  55 (defcustom preview-transparent-border (unless (fboundp 'posn-object-x-y) 1.5)
  56   "Width of transparent border for previews in pt.
  57 Setting this to a numeric value will add a border of
  58 `preview-transparent-color' around images, and will turn
  59 the heuristic-mask setting of images to default to 't since
  60 then the borders are correctly detected even in case of
  61 palette operations.  If the transparent color is something
  62 not present otherwise in the image, the cursor display
  63 will affect just this border.  A width of 0 is interpreted
  64 by PostScript as meaning a single pixel, other widths are
  65 interpreted as PostScript points (1/72 of 1in)"
  66   :group 'preview-appearance
  67   :type '(choice (const :value nil :tag "No border")
  68                  (number :value 1.5 :tag "Border width in pt")))
  69
  70 (defun preview-get-heuristic-mask ()
  71   "Get heuristic-mask to use for previews.
  72 Consults `preview-transparent-color'."
  73   (cond ((stringp preview-transparent-color)
  74          (color-values preview-transparent-color))
  75         ((or (not (consp preview-transparent-color))
  76              (integerp (car preview-transparent-color)))
  77          preview-transparent-color)
  78         (t (color-values (preview-inherited-face-attribute
  79                           (nth 0 preview-transparent-color)
  80                           (nth 1 preview-transparent-color)
  81                           'default)))))
  82
  83 (defsubst preview-create-icon-1 (file type ascent border)
  84   `(image
  85     :file ,file
  86     :type ,type
  87     :ascent ,ascent
  88     ,@(and border
  89            '(:mask (heuristic t)))))
  90
  91 (defun preview-create-icon (file type ascent border)
  92   "Create an icon from FILE, image TYPE, ASCENT and BORDER."
  93   (list
  94    (preview-create-icon-1 file type ascent border)
  95    file type ascent border))
  96
  97 (put 'preview-filter-specs :type
  98      #'(lambda (keyword value &rest args)
  99          (if (image-type-available-p value)
 100              `(image :type ,value
 101                      ,@(preview-filter-specs-1 args))
 102            (throw 'preview-filter-specs nil))))
 103
 104 ;; No defcustom here: does not seem to make sense.
 105
 106 (defvar preview-tb-icon-specs
 107   '((:type xpm :file "prvtex24.xpm")
 108     (:type xbm :file "prvtex24.xbm")))
 109
 110 (defvar preview-tb-icon nil)
 111
 112 (defun preview-add-urgentization (fun ov &rest rest)
 113   "Cause FUN (function call form) to be called when redisplayed.
 114 FUN must be a form with OV as first argument,
 115 REST as the remainder, returning T."
 116   (let ((dispro (overlay-get ov 'display)))
 117     (unless (eq (car dispro) 'when)
 118       (overlay-put ov 'display `(when (,fun ,ov ,@rest)  . ,dispro)))))
 119
 120 (defun preview-remove-urgentization (ov)
 121   "Undo urgentization of OV by `preview-add-urgentization'.
 122 Returns the old arguments to `preview-add-urgentization'
 123 if there was any urgentization."
 124   (let ((dispro (overlay-get ov 'display)))
 125     (when (eq (car-safe dispro) 'when)
 126       (prog1
 127           (car (cdr dispro))
 128         (overlay-put ov 'display (cdr (cdr dispro)))))))
 129
 130 (defsubst preview-icon-copy (icon)
 131   "Prepare a later call of `preview-replace-active-icon'."
 132
 133   ;; This is just a GNU Emacs specific efficiency hack because it
 134   ;; is easy to do.  When porting, don't do anything complicated
 135   ;; here, rather deliver just the unchanged icon and make
 136   ;; `preview-replace-active-icon' do the necessary work of replacing
 137   ;; the icon where it actually has been stored, probably
 138   ;; in the car of the strings property of the overlay.  This string
 139   ;; might probably serve as a begin-glyph as well, in which case
 140   ;; modifying the string in the strings property would change that
 141   ;; glyph automatically.
 142
 143   (cons 'image (cdr icon)))
 144
 145 (defsubst preview-replace-active-icon (ov replacement)
 146   "Replace the active Icon in OV by REPLACEMENT, another icon."
 147   (let ((img (overlay-get ov 'preview-image)))
 148     (setcdr (car img) (cdar replacement))
 149     (setcdr img (cdr replacement))))
 150
 151 (defvar preview-button-1 [mouse-2])
 152 (defvar preview-button-2 [mouse-3])
 153
 154 (defmacro preview-make-clickable (&optional map glyph helpstring click1 click2)
 155   "Generate a clickable string or keymap.
 156 If MAP is non-nil, it specifies a keymap to add to, otherwise
 157 a new one is created.  If GLYPH is given, the result is made
 158 to display it wrapped in a string.  In that case,
 159 HELPSTRING is a format string with one or two %s specifiers
 160 for preview's clicks, displayed as a help-echo.  CLICK1 and CLICK2
 161 are functions to call on preview's clicks."
 162   `(let ((resmap ,(or map '(make-sparse-keymap))))
 163      ,@(if click1
 164            `((define-key resmap preview-button-1 ,click1)))
 165      ,@(if click2
 166            `((define-key resmap preview-button-2 ,click2)))
 167      ,(if glyph
 168           `(propertize
 169             "x"
 170             'display ,glyph
 171             'mouse-face 'highlight
 172             'help-echo
 173             ,(if (stringp helpstring)
 174                  (format helpstring preview-button-1 preview-button-2)
 175                `(format ,helpstring preview-button-1 preview-button-2))
 176             'keymap resmap)
 177         'resmap)))
 178
 179 (defvar preview-overlay nil)
 180
 181 (put 'preview-overlay
 182      'modification-hooks
 183      '(preview-handle-modification))
 184
 185 (put 'preview-overlay
 186      'insert-in-front-hooks
 187      '(preview-handle-insert-in-front))
 188
 189 (put 'preview-overlay
 190      'insert-behind-hooks
 191      '(preview-handle-insert-behind))
 192
 193 ;; We have to fake our way around atomicity.
 194
 195 ;; Here is the beef: for best intuitiveness, we want to have
 196 ;; insertions be carried out as expected before iconized text
 197 ;; passages, but we want to insert *into* the overlay when not
 198 ;; iconized.  A preview that has become empty can not get content
 199 ;; again: we remove it.  A disabled preview needs no insert-in-front
 200 ;; handler.
 201
 202 (defvar preview-change-list nil
 203   "List of tentatively changed overlays.")
 204
 205 (defcustom preview-dump-threshold
 206   "^ *\\\\begin *{document}[ %]*$"
 207   "*Regexp denoting end of preamble.
 208 This is the location up to which preamble changes are considered
 209 to require redumping of a format."
 210   :group 'preview-latex
 211   :type 'string)
 212
 213 (defun preview-preamble-changed-function
 214   (ov after-change beg end &optional length)
 215   "Hook function for change hooks on preamble.
 216 See info node `(elisp) Overlay Properties' for
 217 definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
 218   (let ((format-cons (overlay-get ov 'format-cons)))
 219     (preview-unwatch-preamble format-cons)
 220     (preview-format-kill format-cons)
 221     (setcdr format-cons t)))
 222
 223 (defun preview-watch-preamble (file command format-cons)
 224   "Set up a watch on master file FILE.
 225 FILE can be an associated buffer instead of a filename.
 226 COMMAND is the command that generated the format.
 227 FORMAT-CONS contains the format info for the main
 228 format dump handler."
 229   (let ((buffer (if (bufferp file)
 230                     file
 231                   (find-buffer-visiting file))) ov)
 232     (setcdr
 233      format-cons
 234      (cons command
 235            (when buffer
 236              (with-current-buffer buffer
 237                (save-excursion
 238                  (save-restriction
 239                    (widen)
 240                    (goto-char (point-min))
 241                    (unless (re-search-forward preview-dump-threshold nil t)
 242                      (error "Can't find preamble of `%s'" file))
 243                    (setq ov (make-overlay (point-min) (point)))
 244                    (overlay-put ov 'format-cons format-cons)
 245                    (overlay-put ov 'insert-in-front-hooks
 246                                 '(preview-preamble-changed-function))
 247                    (overlay-put ov 'modification-hooks
 248                                 '(preview-preamble-changed-function))
 249                    ov))))))))
 250
 251 (defun preview-unwatch-preamble (format-cons)
 252   "Stop watching a format on FORMAT-CONS.
 253 The watch has been set up by `preview-watch-preamble'."
 254   (when (consp (cdr format-cons))
 255     (when (cddr format-cons)
 256       (delete-overlay (cddr format-cons)))
 257     (setcdr (cdr format-cons) nil)))
 258
 259 (defun preview-register-change (ov)
 260   "Register not yet changed OV for verification.
 261 This stores the old contents of the overlay in the
 262 `preview-prechange' property and puts the overlay into
 263 `preview-change-list' where `preview-check-changes' will
 264 find it at some later point of time."
 265   (unless (overlay-get ov 'preview-prechange)
 266     (if (eq (overlay-get ov 'preview-state) 'disabled)
 267         (overlay-put ov 'preview-prechange t)
 268       (overlay-put ov 'preview-prechange
 269                    (save-restriction
 270                      (widen)
 271                      (buffer-substring-no-properties
 272                       (overlay-start ov) (overlay-end ov)))))
 273     (push ov preview-change-list)))
 274
 275 (defun preview-check-changes ()
 276   "Check whether the contents under the overlay have changed.
 277 Disable it if that is the case.  Ignores text properties."
 278   (dolist (ov preview-change-list)
 279     (condition-case nil
 280         (with-current-buffer (overlay-buffer ov)
 281           (let ((text (save-restriction
 282                         (widen)
 283                         (buffer-substring-no-properties
 284                          (overlay-start ov) (overlay-end ov)))))
 285             (if (zerop (length text))
 286                 (preview-delete ov)
 287               (unless
 288                   (or (eq (overlay-get ov 'preview-state) 'disabled)
 289                       (preview-relaxed-string=
 290                        text (overlay-get ov 'preview-prechange)))
 291                 (overlay-put ov 'insert-in-front-hooks nil)
 292                 (overlay-put ov 'insert-behind-hooks nil)
 293                 (preview-disable ov)))))
 294       (error nil))
 295     (overlay-put ov 'preview-prechange nil))
 296   (setq preview-change-list nil))
 297
 298 (defun preview-handle-insert-in-front
 299   (ov after-change beg end &optional length)
 300   "Hook function for `insert-in-front-hooks' property.
 301 See info node `(elisp) Overlay Properties' for
 302 definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
 303   (if after-change
 304       (unless undo-in-progress
 305         (if (eq (overlay-get ov 'preview-state) 'active)
 306             (move-overlay ov end (overlay-end ov))))
 307     (preview-register-change ov)))
 308
 309 (defun preview-handle-insert-behind
 310   (ov after-change beg end &optional length)
 311   "Hook function for `insert-behind-hooks' property.
 312 This is needed in case `insert-before-markers' is used at the
 313 end of the overlay.  See info node `(elisp) Overlay Properties'
 314 for definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
 315   (if after-change
 316       (unless undo-in-progress
 317         (if (eq (overlay-get ov 'preview-state) 'active)
 318             (move-overlay ov (overlay-start ov) beg)))
 319     (preview-register-change ov)))
 320
 321 (defun preview-handle-modification
 322   (ov after-change beg end &optional length)
 323   "Hook function for `modification-hooks' property.
 324 See info node `(elisp) Overlay Properties' for
 325 definition of OV, AFTER-CHANGE, BEG, END and LENGTH."
 326   (unless after-change
 327     (preview-register-change ov)))
 328
 329 (defun preview-toggle (ov &optional arg event)
 330   "Toggle visibility of preview overlay OV.
 331 ARG can be one of the following: t displays the overlay,
 332 nil displays the underlying text, and 'toggle toggles.
 333 If EVENT is given, it indicates the window where the event
 334 occured, either by being a mouse event or by directly being
 335 the window in question.  This may be used for cursor restoration
 336 purposes."
 337   (let ((old-urgent (preview-remove-urgentization ov))
 338         (preview-state
 339          (if (if (eq arg 'toggle)
 340                  (null (eq (overlay-get ov 'preview-state) 'active))
 341                arg)
 342              'active
 343            'inactive))
 344         (strings (overlay-get ov 'strings)))
 345     (unless (eq (overlay-get ov 'preview-state) 'disabled)
 346       (overlay-put ov 'preview-state preview-state)
 347       (if (eq preview-state 'active)
 348           (progn
 349             (overlay-put ov 'category 'preview-overlay)
 350             (if (eq (overlay-start ov) (overlay-end ov))
 351                 (overlay-put ov 'before-string (car strings))
 352               (dolist (prop '(display keymap mouse-face help-echo))
 353                 (overlay-put ov prop
 354                              (get-text-property 0 prop (car strings))))
 355               (overlay-put ov 'before-string nil))
 356             (overlay-put ov 'face nil))
 357         (dolist (prop '(display keymap mouse-face help-echo))
 358           (overlay-put ov prop nil))
 359         (overlay-put ov 'face 'preview-face)
 360         (unless (cdr strings)
 361           (setcdr strings (preview-inactive-string ov)))
 362         (overlay-put ov 'before-string (cdr strings)))
 363       (if old-urgent
 364           (apply 'preview-add-urgentization old-urgent))))
 365   (if event
 366       (preview-restore-position
 367        ov
 368        (if (windowp event)
 369            event
 370          (posn-window (event-start event))))))
 371
 372 (defsubst preview-buffer-recode-system (base)
 373   "This is supposed to translate unrepresentable base encodings
 374 into something that can be used safely for byte streams in the
 375 run buffer.  A noop for Emacs."
 376   base)
 377
 378 (defun preview-mode-setup ()
 379   "Setup proper buffer hooks and behavior for previews."
 380   (set (make-local-variable 'desktop-save-buffer)
 381        #'desktop-buffer-preview-misc-data)
 382   (add-hook 'pre-command-hook #'preview-mark-point nil t)
 383   (add-hook 'post-command-hook #'preview-move-point nil t)
 384   (easy-menu-add preview-menu LaTeX-mode-map)
 385   (unless preview-tb-icon
 386     (setq preview-tb-icon (preview-filter-specs preview-tb-icon-specs)))
 387   (when preview-tb-icon
 388     (define-key LaTeX-mode-map [tool-bar preview]
 389       `(menu-item "Preview at point" preview-at-point
 390                   :image ,preview-tb-icon
 391                   :help "Preview on/off at point")))
 392   (when buffer-file-name
 393     (let* ((filename (expand-file-name buffer-file-name))
 394            format-cons)
 395       (when (string-match (concat "\\." TeX-default-extension "\\'")
 396                           filename)
 397         (setq filename (substring filename 0 (match-beginning 0))))
 398       (setq format-cons (assoc filename preview-dumped-alist))
 399       (when (consp (cdr format-cons))
 400         (preview-unwatch-preamble format-cons)
 401         (preview-watch-preamble (current-buffer)
 402                                 (cadr format-cons)
 403                                 format-cons)))))
 404
 405 (defvar preview-marker (make-marker)
 406   "Marker for fake intangibility.")
 407
 408 (defvar preview-temporary-opened nil)
 409
 410 (defvar preview-last-location nil
 411   "Restored cursor position marker for reopened previews.")
 412 (make-variable-buffer-local 'preview-last-location)
 413
 414 (defun preview-mark-point ()
 415   "Mark position for fake intangibility."
 416   (when (eq (get-char-property (point) 'preview-state) 'active)
 417     (unless preview-last-location
 418       (setq preview-last-location (make-marker)))
 419     (set-marker preview-last-location (point))
 420     (set-marker preview-marker (point))
 421     (preview-move-point))
 422   (set-marker preview-marker (point)))
 423
 424 (defun preview-restore-position (ov window)
 425   "Tweak position after opening/closing preview.
 426 The treated overlay OV has been triggered in WINDOW.  This function
 427 records the original buffer position for reopening, or restores it
 428 after reopening.  Note that by using the mouse, you can open/close
 429 overlays not in the active window."
 430   (when (eq (overlay-buffer ov) (window-buffer window))
 431     (with-current-buffer (overlay-buffer ov)
 432       (if (eq (overlay-get ov 'preview-state) 'active)
 433           (setq preview-last-location
 434                 (set-marker (or preview-last-location (make-marker))
 435                             (window-point window)))
 436         (when (and
 437                (markerp preview-last-location)
 438                (eq (overlay-buffer ov) (marker-buffer preview-last-location))
 439                (< (overlay-start ov) preview-last-location)
 440                (> (overlay-end ov) preview-last-location))
 441           (set-window-point window preview-last-location))))))
 442
 443 (defun preview-move-point ()
 444   "Move point out of fake-intangible areas."
 445   (preview-check-changes)
 446   (let* (newlist (pt (point)) (lst (overlays-at pt)) distance)
 447     (setq preview-temporary-opened
 448           (dolist (ov preview-temporary-opened newlist)
 449             (and (overlay-buffer ov)
 450                  (eq (overlay-get ov 'preview-state) 'inactive)
 451                  (if (and (eq (overlay-buffer ov) (current-buffer))
 452                           (or (<= pt (overlay-start ov))
 453                               (>= pt (overlay-end ov))))
 454                      (preview-toggle ov t)
 455                    (push ov newlist)))))
 456     (when lst
 457       (if (or disable-point-adjustment
 458               global-disable-point-adjustment
 459               (preview-auto-reveal-p
 460                preview-auto-reveal
 461                (setq distance
 462                      (and (eq (marker-buffer preview-marker)
 463                               (current-buffer))
 464                           (- pt (marker-position preview-marker))))))
 465           (preview-open-overlays lst)
 466         (while lst
 467           (setq lst
 468                 (if (and
 469                      (eq (overlay-get (car lst) 'preview-state) 'active)
 470                      (> pt (overlay-start (car lst))))
 471                     (overlays-at
 472                      (setq pt (if (and distance (< distance 0))
 473                                   (overlay-start (car lst))
 474                                 (overlay-end (car lst)))))
 475                   (cdr lst))))
 476         (goto-char pt)))))
 477
 478 (defun preview-open-overlays (list &optional pos)
 479   "Open all previews in LIST, optionally restricted to enclosing POS."
 480   (dolist (ovr list)
 481     (when (and (eq (overlay-get ovr 'preview-state) 'active)
 482                (or (null pos)
 483                    (and
 484                     (> pos (overlay-start ovr))
 485                     (< pos (overlay-end ovr)))))
 486       (preview-toggle ovr)
 487       (push ovr preview-temporary-opened))))
 488
 489 (defadvice replace-highlight (before preview)
 490   "Make `query-replace' open preview text about to be replaced."
 491   (preview-open-overlays
 492    (overlays-in (ad-get-arg 0) (ad-get-arg 1))))
 493
 494 (defcustom preview-query-replace-reveal t
 495   "*Make `query-replace' autoreveal previews."
 496   :group 'preview-appearance
 497   :type 'boolean
 498   :require 'preview
 499   :set (lambda (symbol value)
 500          (set-default symbol value)
 501          (if value
 502              (ad-enable-advice 'replace-highlight 'before 'preview)
 503            (ad-disable-advice 'replace-highlight 'before 'preview))
 504          (ad-activate 'replace-highlight))
 505   :initialize #'custom-initialize-reset)
 506
 507 ;; Check whether the four-argument form of `face-attribute' exists.
 508 ;; If not, we will get a `wrong-number-of-arguments' error thrown.
 509 ;; Use `defun' instead of `defsubst' here so that the decision may be
 510 ;; reverted at load time if you are compiling with one Emacs and using
 511 ;; another.
 512 (if (condition-case nil
 513         (progn
 514           (face-attribute 'default :height nil nil)
 515           t)
 516       (wrong-number-of-arguments nil))
 517
 518     (defun preview-inherited-face-attribute (face attribute &optional inherit)
 519       "Fetch face attribute while adhering to inheritance.
 520 This searches FACE for an ATTRIBUTE, using INHERIT
 521 for resolving unspecified or relative specs.  See the fourth
 522 argument of function `face-attribute' for details."
 523       (face-attribute face attribute nil inherit))
 524
 525   (defun preview-inherited-face-attribute (face attribute &optional inherit)
 526     "Fetch face attribute while adhering to inheritance.
 527 This searches FACE for an ATTRIBUTE.  If it is 'unspecified,
 528 first inheritance is consulted (if INHERIT is non-NIL), then
 529 INHERIT is searched if it is a face or a list of faces.
 530 Relative specs are evaluated recursively until they get absolute or
 531 are not resolvable.  Relative specs are float values."
 532     (let ((value (face-attribute face attribute)))
 533       (when inherit
 534         (setq inherit
 535               (append
 536                (let ((ancestors (face-attribute face :inherit)))
 537                  (cond ((facep ancestors) (list ancestors))
 538                        ((consp ancestors) ancestors)))
 539                (cond ((facep inherit) (list inherit))
 540                      ((consp inherit) inherit)))))
 541       (cond ((null inherit) value)
 542             ((floatp value)
 543              (let ((avalue
 544                     (preview-inherited-face-attribute
 545                      (car inherit) attribute (or (cdr inherit) t))))
 546                (cond ((integerp avalue)
 547                       (round (* avalue value)))
 548                      ((floatp avalue)
 549                       (* value avalue))
 550                      (t value))))
 551             ((eq value 'unspecified)
 552              (preview-inherited-face-attribute
 553               (car inherit) attribute (or (cdr inherit) t)))
 554             (t value)))))
 555
 556 (defun preview-get-colors ()
 557   "Return colors from the current display.
 558 Fetches the current screen colors and makes a vector
 559 of colors as numbers in the range 0..65535.
 560 Pure borderless black-on-white will return triple NIL.
 561 The fourth value is the transparent border thickness."
 562   (let
 563       ((bg (color-values (preview-inherited-face-attribute
 564                           'preview-reference-face :background 'default)))
 565        (fg (color-values (preview-inherited-face-attribute
 566                           'preview-reference-face :foreground 'default)))
 567        (mask (preview-get-heuristic-mask)))
 568     (if (equal '(65535 65535 65535) bg)
 569         (setq bg nil))
 570     (if (equal '(0 0 0) fg)
 571         (setq fg nil))
 572     (unless (and (numberp preview-transparent-border)
 573                  (consp mask) (integerp (car mask)))
 574       (setq mask nil))
 575     (vector bg fg mask preview-transparent-border)))
 576
 577 (defmacro preview-mark-active ()
 578   "Return t if the mark is active."
 579   'mark-active)
 580
 581 (defun preview-import-image (image)
 582   "Convert the printable IMAGE rendition back to an image."
 583   (cond ((stringp image)
 584          (propertize image 'face 'preview-face))
 585         ((eq (car image) 'image)
 586          image)
 587         (t
 588          (preview-create-icon-1 (nth 0 image)
 589                                 (nth 1 image)
 590                                 (nth 2 image)
 591                                 (if (< (length image) 4)
 592                                     (preview-get-heuristic-mask)
 593                                   (nth 3 image))))))
 594
 595 (defsubst preview-supports-image-type (imagetype)
 596   "Check if IMAGETYPE is supported."
 597   (image-type-available-p imagetype))
 598
 599 (provide 'prv-emacs)
 600 ;;; prv-emacs.el ends here