-(defun lsdb-call-process-on-string
- (program string &optional buffer &rest args)
- (if (eq buffer t)
- (setq buffer (current-buffer)))
- (let ((process (apply #'start-process program buffer program args))
- status exit-status)
- (unwind-protect
- (progn
- (set-process-sentinel process #'ignore) ;don't insert exit status
- (process-send-string process string)
- (process-send-eof process)
- (while (eq 'run (process-status process))
- (accept-process-output process 5))
- (setq status (process-status process)
- exit-status (process-exit-status process))
- (if (memq status '(stop signal))
- (error "%s exited abnormally: '%s'" program exit-status))
- (if (= 127 exit-status)
- (error "%s could not be found" program))
- (delete-process process))
- (if (and process (eq 'run (process-status process)))
- (interrupt-process process)))))
-
-(eval-and-compile
- (defun lsdb-mirror-bits (bits nbits)
- (if (= nbits 1)
- bits
- (logior (lsh (lsdb-mirror-bits (logand bits (1- (lsh 1 (/ nbits 2))))
- (/ nbits 2))
- (/ nbits 2))
- (lsdb-mirror-bits (lsh bits (- (/ nbits 2)))
- (/ nbits 2))))))
-(defconst lsdb-mirror-bytes
- (eval-when-compile
- (let ((table (make-vector 256 0))
- (i 0))
- (while (< i 256)
- (aset table i (logxor (lsdb-mirror-bits i 8) 255))
- (setq i (1+ i)))
- table)))
-
-(defun lsdb-convert-x-face-to-xbm (x-face &optional bit-reverse)
- (with-temp-buffer
- (lsdb-call-process-on-string
- lsdb-uncompface-program (concat x-face "\n") t)
- (set-buffer-multibyte nil)
- (let* ((result (make-string 288 ?\0))
- (index 0))
- (goto-char (point-min))
- (while (re-search-forward
- "0x\\([0-9A-F][0-9A-F]\\)\\([0-9A-F][0-9A-F]\\),\n?" nil
- t)
- (aset result
- (prog1 index
- (setq index (1+ index)))
- (car (read-from-string
- (concat "?\\x" (match-string 1)))))
- (aset result
- (prog1 index
- (setq index (1+ index)))
- (car (read-from-string
- (concat "?\\x" (match-string 2))))))
- (when bit-reverse
- (setq index 0)
- (while (< index 288)
- (aset result index
- (aref lsdb-mirror-bytes (aref result index)))
- (setq index (1+ index))))
- (list 48 48 result))))
-
-(autoload 'xbm-make-thumbnail "xbm-thumb")
-
-(defun lsdb-insert-x-face (x-face)
- (let ((data
- (if lsdb-display-small-x-face
- (xbm-make-thumbnail (lsdb-convert-x-face-to-xbm x-face t))
- (lsdb-convert-x-face-to-xbm x-face t))))
- (static-if (featurep 'xemacs)
- (let ((glyph (make-glyph (vector 'xbm :data data))))
- (if glyph
- (set-extent-end-glyph
- (make-extent (point) (point))
- glyph)))
- (insert-image
- (create-image
- (nth 2 data) 'xbm t :width (car data) :height (nth 1 data))))))
+(defun lsdb-insert-x-face-image (data marker)
+ (static-if (featurep 'xemacs)
+ (save-excursion
+ (set-buffer (marker-buffer marker))
+ (goto-char marker)
+ (let* ((inhibit-read-only t)
+ buffer-read-only
+ (type (lsdb-x-face-available-image-type))
+ (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
+ (type (lsdb-x-face-available-image-type))
+ (image (create-image data type t :ascent 'center))
+ (record (get-text-property (point) 'lsdb-record)))
+ (add-text-properties
+ (point)
+ (progn
+ (insert " ")
+ (point))
+ (list 'display image
+ 'rear-nonsticky (list 'display)
+ 'lsdb-record record))))))
+
+(defun lsdb-insert-x-face-asynchronously (x-face)
+ (let* ((buffer
+ (generate-new-buffer " *lsdb work*"))
+ (type (lsdb-x-face-available-image-type))
+ (shell-file-name lsdb-shell-file-name)
+ (shell-command-switch lsdb-shell-command-switch)
+ (process-connection-type nil)
+ (process (start-process-shell-command
+ "lsdb-x-face-command" buffer
+ (concat "{ "
+ (nth 1 (assq type lsdb-x-face-command-alist))
+ "; } 2> /dev/null")))
+ (marker (point-marker)))
+ (process-send-string process (concat x-face "\n"))
+ (process-send-eof process)
+ (set-process-sentinel
+ process
+ `(lambda (process string)
+ (when (equal string "finished\n")
+ (lsdb-insert-x-face-image
+ (with-current-buffer ,buffer
+ (set-buffer-multibyte nil)
+ (buffer-string))
+ ,marker))
+ (kill-buffer ,buffer)))))