(setq dragbox-image-url "") (setq dragbox-image-width 744) (setq dragbox-image-height 1052) (setq dragbox-x1y1 '(0 . 0)) (setq dragbox-x2y2 '(100 . 100)) (defun dragbox-start (image-file) "start here" (interactive "fimage file:") (get-buffer-create "*dragbox*") (switch-to-buffer "*dragbox*") (setq dragbox-image-url (concat "file://" (expand-file-name image-file))) (dragbox-update-box-from-state)) (defun dragbox-make-svg-data (x y width height image-url) `((svg ((xmlns:dc . "http://purl.org/dc/elements/1.1/") (xmlns:cc . "http://creativecommons.org/ns#") (xmlns:rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#") (xmlns:svg . "http://www.w3.org/2000/svg") (xmlns:xlink . "http://www.w3.org/1999/xlink") (xmlns . "http://www.w3.org/2000/svg") (width . ,(number-to-string dragbox-image-width)) (height . ,(number-to-string dragbox-image-height)) (id . "svg2")) (g ((id . "layer1")) (rect ((style . "fill:#cfcfcf;fill-opacity:1") (width . ,(number-to-string dragbox-image-width)) (height . ,(number-to-string dragbox-image-height)) (x . "0") (y . "0"))) (image ((y . "0") (x . "0") (width . ,(number-to-string dragbox-image-width)) (height . ,(number-to-string dragbox-image-height)) (xlink:href . ,image-url) )) (rect ((style . "color:#000000;fill:#000000;fill-opacity:0.5;fill-rule:nonzero;stroke:#000000;stroke-width:1;marker:none;visibility:visible;display:inline;overflow:visible;enable-background:accumulate;stroke-opacity:0.5") (id . "dragbox") (width . , (number-to-string width) ) (height . ,(number-to-string height)) (x . ,(number-to-string x)) (y . ,(number-to-string y)))) )))) (defun dragbox-lmb-click-handler () (interactive) (setq dragbox-x1y1 (dragbox-extract-event-coords last-input-event)) (dragbox-update-box-from-state) ) (defun dragbox-rmb-click-handler () (interactive) (setq dragbox-x2y2 (dragbox-extract-event-coords last-input-event)) (dragbox-update-box-from-state) ) (defun dragbox-extract-event-coords (event) (caddr(cadr last-input-event)) ) (define-key image-mode-map [down-mouse-1] 'dragbox-lmb-click-handler) (define-key image-mode-map [down-mouse-2] 'dragbox-rmb-click-handler) (defun dragbox-update-box (x y width height) (fundamental-mode) (erase-buffer) (xml-print (dragbox-make-svg-data x y width height dragbox-image-url)) (image-mode) ) (defun dragbox-update-box-from-state () (let* ((x1 (car dragbox-x1y1)) (y1 (cdr dragbox-x1y1)) (x2 (car dragbox-x2y2)) (y2 (cdr dragbox-x2y2)) (w (- x2 x1)) (h (- y2 y1))) (message "(%d %d) (%d %d) w:%d h:%d" x1 y1 x2 y2 w h) (dragbox-update-box x1 y1 w h)))