+ (put-text-property 0 1 'invisible t delimiter) ;hide "\r"
+ (put-text-property
+ (point)
+ (progn
+ (insert delimiter)
+ (while x-face
+ (funcall lsdb-insert-x-face-function (pop x-face)))
+ (point))
+ 'lsdb-record record))))
+
+(defun lsdb-insert-x-face-image (data type marker)
+ (static-if (featurep 'xemacs)
+ (save-excursion
+ (set-buffer (marker-buffer marker))
+ (goto-char marker)
+ (let* ((inhibit-read-only t)
+ buffer-read-only
+ (glyph (make-glyph (vector type :data data))))
+ (set-extent-begin-glyph
+ (make-extent (point) (point))
+ glyph)))
+ (save-excursion
+ (set-buffer (marker-buffer marker))
+ (goto-char marker)
+ (let* ((inhibit-read-only t)
+ buffer-read-only
+ (image (create-image data type t :ascent 'center))
+ (record (get-text-property (point) 'lsdb-record)))
+ (put-text-property (point) (progn
+ (insert-image image)
+ (point))
+ 'lsdb-record record)))))
+
+(defun lsdb-insert-x-face-asynchronously (x-face)
+ (let* ((type (or lsdb-x-face-image-type
+ (lsdb-x-face-available-image-type)))
+ (shell-file-name lsdb-shell-file-name)
+ (shell-command-switch lsdb-shell-command-switch)
+ (coding-system-for-read 'binary)
+ (process-connection-type nil)
+ (cached (cdr (assq type (lsdb-gethash x-face lsdb-x-face-cache))))
+ (marker (point-marker))
+ (buffer (generate-new-buffer " *lsdb work*"))
+ process)
+ (if cached
+ (lsdb-insert-x-face-image cached type marker)
+ (setq process
+ (start-process-shell-command
+ "lsdb-x-face-command" buffer
+ (concat "{ "
+ (apply #'concat
+ (lsdb-substitute-variables
+ (cdr (assq type lsdb-x-face-command-alist))
+ 'scale-factor
+ (number-to-string lsdb-x-face-scale-factor)))
+ "; } 2> /dev/null")))
+ (set-process-filter
+ process
+ `(lambda (process string)
+ (save-excursion
+ (set-buffer ,buffer)
+ (goto-char (point-max))
+ (insert string))))
+ (set-process-sentinel
+ process
+ `(lambda (process string)
+ (unwind-protect
+ (if (equal string "finished\n")
+ (let ((data
+ (with-current-buffer ,buffer
+ (set-buffer-multibyte nil)
+ (buffer-string))))
+ (lsdb-insert-x-face-image data ',type ,marker)
+ (lsdb-puthash ,x-face (list (cons ',type data))
+ lsdb-x-face-cache)))
+ (kill-buffer ,buffer))))
+ (process-send-string process (concat x-face "\n"))
+ (process-send-eof process))))
+
+;;;_. Face Rendering
+(defvar lsdb-face-cache
+ (lsdb-make-hash-table :test 'equal))
+
+(defun lsdb-face-available-image-type ()
+ (static-if (featurep 'xemacs)
+ (if (featurep 'png)
+ 'png
+ (if (featurep 'xpm)
+ 'xpm))
+ (and (>= emacs-major-version 21)
+ (fboundp 'image-type-available-p)
+ (if (image-type-available-p 'png)
+ 'png
+ (if (image-type-available-p 'xpm)
+ 'xpm)))))
+
+(defun lsdb-expose-face ()
+ (let* ((record (get-text-property (point-min) 'lsdb-record))
+ (face (cdr (assq 'face (cdr record))))
+ (delimiter "\r "))
+ (when (and lsdb-insert-face-function
+ face)
+ (goto-char (point-min))
+ (end-of-line)
+ (put-text-property 0 1 'invisible t delimiter) ;hide "\r"
+ (put-text-property
+ (point)
+ (progn
+ (insert delimiter)
+ (while face
+ (funcall lsdb-insert-face-function (pop face)))
+ (point))
+ 'lsdb-record record))))
+
+(defun lsdb-insert-face-image (data type marker)
+ (static-if (featurep 'xemacs)
+ (save-excursion
+ (set-buffer (marker-buffer marker))
+ (goto-char marker)
+ (let* ((inhibit-read-only t)
+ buffer-read-only
+ (glyph (make-glyph (vector type :data data))))
+ (set-extent-begin-glyph
+ (make-extent (point) (point))
+ glyph)))
+ (save-excursion
+ (set-buffer (marker-buffer marker))
+ (goto-char marker)
+ (let* ((inhibit-read-only t)
+ buffer-read-only
+ (image (create-image data type t :ascent 'center))
+ (record (get-text-property (point) 'lsdb-record)))
+ (put-text-property (point) (progn
+ (insert-image image)
+ (point))
+ 'lsdb-record record)))))
+
+(defun lsdb-insert-face-asynchronously (face)
+ (let* ((type (or lsdb-face-image-type
+ (lsdb-face-available-image-type)))
+ (shell-file-name lsdb-shell-file-name)
+ (shell-command-switch lsdb-shell-command-switch)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (process-connection-type nil)
+ (cached (cdr (assq type (lsdb-gethash face lsdb-face-cache))))
+ (marker (point-marker))
+ (buffer (generate-new-buffer " *lsdb work*"))
+ process)
+ (if cached
+ (lsdb-insert-face-image cached type marker)
+ (setq process
+ (start-process-shell-command
+ "lsdb-face-command" buffer
+ (concat "{ "
+ (apply #'concat
+ (lsdb-substitute-variables
+ (cdr (assq type lsdb-face-command-alist))
+ 'scale-factor
+ (number-to-string lsdb-face-scale-factor)))
+ "; } 2> /dev/null")))
+ (set-process-filter
+ process
+ `(lambda (process string)
+ (save-excursion
+ (set-buffer ,buffer)
+ (goto-char (point-max))
+ (insert string))))
+ (set-process-sentinel
+ process
+ `(lambda (process string)
+ (unwind-protect
+ (if (equal string "finished\n")
+ (let ((data
+ (with-current-buffer ,buffer
+ (set-buffer-multibyte nil)
+ (buffer-string))))
+ (lsdb-insert-face-image data ',type ,marker)
+ (lsdb-puthash ,face (list (cons ',type data))
+ lsdb-face-cache)))
+ (kill-buffer ,buffer))))
+ (process-send-string process (base64-decode-string face))
+ (process-send-eof process))))