bug#6230: 23.2; Pixmaps kept in X11 after (svg?) images no longer are used

[Anders Waldenborg <anders@0x63.nu>]

[-- Attachment #1: Type: text/plain, Size: 1207 bytes --]

On 05/20/2010 10:32 PM, Chong Yidong wrote:
> Oh, yes, I forgot.  There is image-cache-eviction-delay as well.  If you
> set this to a sufficiently small number, the test frees the pixmaps as
> required.

Yes, that works, thanks.

> Is there a specific reason you are interested in this problem?  It's
> possible that we need to improve the conditions under which the image
> cache is freed, but it's hard to tell unless we have a use-case in mind.
> (Obviously, the current system assumes that the rate at which images are
> created is much lower than the "usual editing speed".)

Well, I'm toying with a little vector graphics API built on top of 
emacs' svg support. And my first real example is a clock. By leaving it 
running for a few minutes easily makes my X server go out of memory. You 
can find the library (vrend.el) and the example implementing a clock 
(vrend-example-clock.el) attached.

Not sure this clock is a real use-case. But I have a few other ideas in 
mind on how to use it, which all have substantially lower requirements 
on refresh rate, but probably large enough to create lots of pixmaps in 
30 minutes (which seems to be default value for image-cache-eviction-delay)

  anders

[-- Attachment #2: vrend.el --]
[-- Type: text/plain, Size: 4640 bytes --]

;;; Beta quality code - use at own risk

;;; Copyright (C) 2010 Anders Waldenborg
;;; I'll add a GPL header or something like that here later...

; We handle the tranformation matrix (but let svg do the actual projection).
; So we need some stuff to handle matrices...

(defconst vrend-2pi (* 8.0 (atan 1.0)))

(defun vrend--mtx-col (mtx col)
  "Get column col in matrix mtx"
  (mapcar '(lambda (v) (aref v col)) mtx))

(defun vrend--mtx-row (mtx row)
  "Get row row in matrix mtx"
  (mapcar 'identity (aref mtx row)))

(defun vrend--mtx-ref (i j)
  (aref (aref vrend--curr-mtx i) j))

(defun vrend--dotprod (l r)
  "dot product of l and r"
  (if (or l r)
      (+ (* (car l) (car r)) (vrend--dotprod (cdr l) (cdr r)))
    0))

(defun vrend--mtx-mul3x3 (l r)
  `[[,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 2))]
    [,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 2))]
    [,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 2))]])

(defun vrend--mtx-translate (dx dy)
  "translationmatrix for dx dy"
  `[[1.0 0.0 ,dx]
    [0.0 1.0 ,dy]
    [0.0 0.0 1.0]])

(defun vrend--mtx-rotate (rot)
  ""
  `[[,(cos rot) ,(- (sin rot)) 0.0]
    [,(sin rot)  ,(cos rot)     0.0]
    [       0.0         0.0    1.0]])

(defun vrend--mtx-scale (sx sy)
  ""
  `[[,sx 0.0 0.0]
    [0.0 ,sy 0.0]
    [0.0 0.0 1.0]])

(defun vrend--mtx-ident ()
  ""
  [[1.0 0.0 0.0]
   [0.0 1.0 0.0]
   [0.0 0.0 1.0]])

(defun vrend-path-start (x y)
  (setq vrend--curr-path nil)
  (vrend-path-moveto x y))

(defun vrend-path-moveto (x y)
  (add-to-list 'vrend--curr-path (list ?M x y)))

(defun vrend-path-lineto (x y)
  (add-to-list 'vrend--curr-path (list ?L x y)))

(defun vrend-path-close ()
  (add-to-list 'vrend--curr-path (list ?Z)))

(defun vrend-rotate (deg)
  (setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-rotate deg))))

(defun vrend-scale (sx sy)
  (setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-scale (float sx) (float sy)))))

(defun vrend-translate (dx dy)
  (setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-translate (float dx) (float dy)))))

(defun vrend--render-path-element (e)
  (format "%c %s" (car e) (mapconcat '(lambda (x) (format "%f" x)) (cdr e) " ")))

(defun vrend--render-path ()
  (insert " d=\"" (mapconcat 'vrend--render-path-element (reverse vrend--curr-path) " ") "\""))

(defun vrend--render-transform ()
  (insert (format " transform=\"matrix(%f %f %f %f %f %f)\"" (vrend--mtx-ref 0 0) (vrend--mtx-ref 1 0) (vrend--mtx-ref 0 1) (vrend--mtx-ref 1 1) (vrend--mtx-ref 0 2) (vrend--mtx-ref 1 2))))

(defun vrend-path-stroke ()
  (insert "  <path")
  (vrend--render-path)
  (vrend--render-transform)
  (insert " fill=\"none\"")
  (insert " stroke=\"" (car vrend--curr-strokestyle) "\"")
  (insert " stroke-width=\"0.04\"")
  (insert " />\n"))

(defmacro vrend-with-saved-matrix (&rest body)
  (declare (indent 0) (debug t))
  `(let ((vrend-with-saved-matrix-saved-matrix vrend--curr-mtx))
     (progn
       ,@body
       (setq vrend--curr-mtx vrend-with-saved-matrix-saved-matrix))))

(defmacro vrend (width height coordinatetype &rest body)
  (declare (indent 3) (debug t))
  (let ((width (eval width))
	(height (eval height)))
  `(with-temp-buffer
      (set (make-local-variable 'vrend--curr-mtx) (vrend--mtx-ident))
      (set (make-local-variable 'vrend--curr-path) nil)
      (set (make-local-variable 'vrend--curr-strokestyle) '("black" :width 1))
      (set (make-local-variable 'vrend--curr-fillstyle) nil)

      (insert "<?xml version=\"1.0\" standalone=\"no\"?>\n"
	      "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n"
	      "  \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n"
	      (format "<svg width=\"%d\" height=\"%d\"\n" ,width ,height)
	      "     xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">\n")


      (when ,coordinatetype
	(vrend-translate ,(/ width 2) ,(/ height 2))

	(when (eq ,coordinatetype '1x1fit)
	  (let ((smalldir ,(min width height)))
	    (vrend-scale (/ smalldir 2.0) (/ smalldir 2.0))))

	(when (eq ,coordinatetype '1x1square)
	  (vrend-scale ,(/ width 2.0) ,(/ height 2.0)))

	(vrend-scale -1.0 -1.0))

      (progn
	,@body)

      (insert "</svg>\n")
      (create-image (buffer-string) nil t)
      )))

(provide 'vrend)

[-- Attachment #3: vrend-example-clock.el --]
[-- Type: text/plain, Size: 2526 bytes --]

;;; Beta quality code - use at own risk

;;; Copyright (C) 2010 Anders Waldenborg
;;; I'll add a GPL header or something like that here later...

;;; Small example on how to use vrend.

;;; Defines the command vrend-clock which creates a new buffer,
;;; Make sure you resize the window/frame and stuff like that.

(require 'cl)
(require 'vrend)

(defun vrend-clock-update-buffer (buf)
  (let ((win (get-buffer-window buf t)))
    (when win
      (let* ((X (window-inside-pixel-edges win))
	     (w (- (car (cddr X)) (car X)))
	     (h (- (cadr (cddr X)) (cadr X))))
	(with-current-buffer buf
	  (erase-buffer)
	  (insert-image (vrend w h '1x1fit

			  ;; Make hour markers...
			  (vrend-path-start 0.0 0.8)
			  (vrend-path-lineto 0.0 0.9)
			  (vrend-path-close)

			  ;; ...12 of them
			  (loop for D from 0 to 11 by 1
				do (vrend-with-saved-matrix
				     (vrend-rotate (* D (/ vrend-2pi 12)))
				     (vrend-path-stroke)))

			  ;; and arrows
			  (let* ((ct (current-time))
				 (T (decode-time ct))
				 (h (nth 2 T))
				 (m (nth 1 T))
				 (s (nth 0 T))
				 (ms (/ (nth 2 ct) 1000))
				 (seconds-since-midnight (+ (* (+ (* h 60) m) 60) s))
				 (seconds-since-hour (+ (* m 60) s))
				 (ms-since-minute (+ ms (* s 1000))))
			    (vrend-with-saved-matrix
			      (vrend-path-start 0.0 0.0)
			      (vrend-path-lineto -0.05 0.4)
			      (vrend-path-lineto 0.0 0.6)
			      (vrend-path-lineto 0.05 0.4)
			      (vrend-path-close)
			      (vrend-rotate (* seconds-since-midnight (/ vrend-2pi (* 60 60 12))))
			      (vrend-path-stroke))
			    (vrend-with-saved-matrix
			      (vrend-path-start 0.0 0.0)
			      (vrend-path-lineto -0.05 0.3)
			      (vrend-path-lineto 0.0 0.90)
			      (vrend-path-lineto 0.05 0.3)
			      (vrend-path-close)
			      (vrend-rotate (* seconds-since-hour (/ vrend-2pi (* 60 60))))
			      (vrend-path-stroke))
			    (vrend-with-saved-matrix
			      (vrend-path-start 0.0 0.0)
			      (vrend-path-lineto 0.0 0.90)
			      (vrend-path-close)
			      (vrend-rotate (* ms-since-minute (/ vrend-2pi 60000.0)))
			      (vrend-path-stroke))))))))))

(defun vrend-kill-buffer-hook ()
  (cancel-timer vrend-clock-timer))

(defun vrend-clock ()
  (interactive)
  (with-current-buffer (generate-new-buffer "*aw-clock*")
    (set-window-buffer nil (current-buffer))
    (make-local-variable 'vrend-clock-timer)
    (add-hook 'kill-buffer-hook 'vrend-kill-buffer-hook nil t)

    (setq vrend-clock-timer (run-at-time nil 0.1 'vrend-clock-update-buffer (current-buffer)))))