└── eimp.el /eimp.el: -------------------------------------------------------------------------------- 1 | ;;; eimp.el --- Emacs Image Manipulation Package 2 | 3 | ;;; Copyright (C) 2006, 2007 Matthew P. Hodges 4 | 5 | ;; Author: Matthew P. Hodges 6 | ;; Version: 1.4.0 7 | ;; Maintainer: Nic Ferrier 8 | ;; Created: 26th August 2012 9 | ;; Keywords: files,frames 10 | 11 | ;; eimp.el is free software; you can redistribute it and/or modify it 12 | ;; under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation; either version 2, or (at your option) 14 | ;; any later version. 15 | 16 | ;; eimp.el is distributed in the hope that it will be useful, but 17 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 | ;; General Public License for more details. 20 | 21 | ;;; Commentary: 22 | ;; 23 | ;; This package allows interactive image manipulation from within 24 | ;; Emacs. It uses the mogrify utility from ImageMagick to do the 25 | ;; actual transformations. 26 | ;; 27 | ;; Switch the minor mode on programmatically with: 28 | ;; 29 | ;; (eimp-mode 1) 30 | ;; 31 | ;; or toggle interactively with M-x eimp-mode RET. 32 | ;; 33 | ;; Switch the minor mode on for all image-mode buffers with: 34 | ;; 35 | ;; (autoload 'eimp-mode "eimp" "Emacs Image Manipulation Package." t) 36 | ;; (add-hook 'image-mode-hook 'eimp-mode) 37 | 38 | ;;; Code: 39 | 40 | (defconst eimp-version "1.4.0" 41 | "Version number of this package.") 42 | 43 | ;; Customizable variables 44 | 45 | (defgroup eimp nil 46 | "Emacs Image Manipulation Package." 47 | :group 'tools 48 | :link '(url-link "http://mph-emacs-pkgs.alioth.debian.org/EimpEl.html")) 49 | 50 | (defcustom eimp-mogrify-program "mogrify" 51 | "Name of mogrify program. 52 | Should be in PATH." 53 | :group 'eimp 54 | :type 'string) 55 | 56 | (defcustom eimp-mogrify-arguments 57 | (when (= (call-process eimp-mogrify-program nil nil nil "-monitor") 58 | 0) 59 | '("-monitor")) 60 | "List of arguments for `eimp-mogrify-program'. 61 | Should include -monitor if supported." 62 | :group 'eimp 63 | :type '(repeat string)) 64 | 65 | (defcustom eimp-max-concurrent-processes 1 66 | "Maximum number of concurrent EIMP processes. 67 | This is only relevant if there are multiple images; queued 68 | operations act sequentially on any given image." 69 | :group 'eimp 70 | :type 'integer) 71 | 72 | (defcustom eimp-process-delay 1.0 73 | "Delay between running EIMP processes." 74 | :group 'eimp 75 | :type 'number) 76 | 77 | (defcustom eimp-max-queued-processes 128 78 | "Maximum number of queued EIMP processes." 79 | :group 'eimp 80 | :type 'integer) 81 | 82 | (defcustom eimp-blur-amount 10 83 | "Default argument for blur commands." 84 | :group 'eimp 85 | :type 'integer) 86 | 87 | (defcustom eimp-brightness-amount 10 88 | "Default argument for brightness commands." 89 | :group 'eimp 90 | :type 'integer) 91 | 92 | (defcustom eimp-roll-amount 50 93 | "Default number of pixels to shift for roll commands." 94 | :group 'eimp 95 | :type 'integer) 96 | 97 | (defcustom eimp-rotate-amount 90 98 | "Default argument for rotate commands." 99 | :group 'eimp 100 | :type 'integer) 101 | 102 | (defcustom eimp-resize-amount 150 103 | "Default argument for resize commands." 104 | :group 'eimp 105 | :type 'integer) 106 | 107 | (defcustom eimp-ignore-read-only-modes '(gnus-article-mode 108 | puzzle-mode 109 | tumme-display-image-mode 110 | tumme-thumbnail-mode 111 | w3m-mode) 112 | "Major modes for which we ignore `buffer-read-only'." 113 | :group 'eimp 114 | :type '(repeat symbol)) 115 | 116 | (defcustom eimp-enable-undo nil 117 | "Enable undo for EIMP modifications." 118 | :group 'eimp 119 | :type 'boolean) 120 | 121 | ;; Mode settings 122 | 123 | (defvar eimp-minor-mode-map 124 | (let ((map (make-sparse-keymap))) 125 | (define-key map (kbd "+") 'eimp-increase-image-size) 126 | (define-key map (kbd "-") 'eimp-decrease-image-size) 127 | (define-key map (kbd "<") 'eimp-rotate-image-anticlockwise) 128 | (define-key map (kbd ">") 'eimp-rotate-image-clockwise) 129 | (define-key map (kbd "B +") 'eimp-blur-image) 130 | (define-key map (kbd "B -") 'eimp-sharpen-image) 131 | (define-key map (kbd "B E") 'eimp-emboss-image) 132 | (define-key map (kbd "B G") 'eimp-gaussian-blur-image) 133 | (define-key map (kbd "B R") 'eimp-radial-blur-image) 134 | (define-key map (kbd "C B +") 'eimp-increase-image-brightness) 135 | (define-key map (kbd "C B -") 'eimp-decrease-image-brightness) 136 | (define-key map (kbd "C C +") 'eimp-increase-image-contrast) 137 | (define-key map (kbd "C C -") 'eimp-decrease-image-contrast) 138 | (define-key map (kbd "F ^") 'eimp-flip-image) 139 | (define-key map (kbd "F >") 'eimp-flop-image) 140 | (define-key map (kbd "F <") 'eimp-flop-image) 141 | (define-key map (kbd "N") 'eimp-negate-image) 142 | (define-key map (kbd "S f") 'eimp-fit-image-to-window) 143 | (define-key map (kbd "S h") 'eimp-fit-image-height-to-window) 144 | (define-key map (kbd "S w") 'eimp-fit-image-width-to-window) 145 | (define-key map (kbd "") 'eimp-roll-image-right) 146 | (define-key map (kbd "") 'eimp-roll-image-left) 147 | (define-key map (kbd "") 'eimp-roll-image-up) 148 | (define-key map (kbd "") 'eimp-roll-image-down) 149 | (define-key map (kbd "") 'eimp-mouse-resize-image) 150 | (define-key map (kbd "") 'eimp-mouse-resize-image-preserve-aspect) 151 | (define-key map (kbd "C-c C-k") 'eimp-stop-all) 152 | map) 153 | "Keymap for Eimp mode.") 154 | 155 | ;; Menus 156 | 157 | (defvar eimp-menu nil 158 | "Menu to use for function `eimp-mode'.") 159 | 160 | (when (fboundp 'easy-menu-define) 161 | (easy-menu-define eimp-menu eimp-minor-mode-map "EIMP Menu" 162 | '("EIMP" 163 | ("Transforms" 164 | ["Increase Size" eimp-increase-image-size t] 165 | ["Decrease Size" eimp-decrease-image-size t] 166 | ["Fit to Window (keep aspect ratio)" eimp-fit-image-to-window t] 167 | ["Fit to Window" eimp-fit-image-to-whole-window t] 168 | ["Fit Height to Window" eimp-fit-image-height-to-window t] 169 | ["Fit Width to Window" eimp-fit-image-width-to-window t] 170 | "---" 171 | ["Flip Horizontally" eimp-flop-image t] 172 | ["Flip Vertically" eimp-flip-image t] 173 | "---" 174 | ["Rotate Clockwise" eimp-rotate-image-clockwise t] 175 | ["Rotate Anticlockwise" eimp-rotate-image-anticlockwise t] 176 | "---" 177 | ["Roll Right" eimp-roll-image-right t] 178 | ["Roll Left" eimp-roll-image-left t] 179 | ["Roll Up" eimp-roll-image-up t] 180 | ["Roll Down" eimp-roll-image-down t]) 181 | 182 | ("Colours" 183 | ("Brightness" 184 | ["Increase" eimp-increase-image-brightness t] 185 | ["Decrease" eimp-decrease-image-brightness t]) 186 | ("Contrast" 187 | ["Increase" eimp-increase-image-contrast t] 188 | ["Decrease" eimp-decrease-image-contrast t]) 189 | "---" 190 | ["Invert" eimp-negate-image t]) 191 | 192 | ("Filters" 193 | ("Blur Image" 194 | ["Blur Image" eimp-blur-image t] 195 | ["Blur Image (Gaussian)" eimp-gaussian-blur-image t] 196 | ["Blur Image (Radial)" eimp-radial-blur-image t]) 197 | 198 | ("Enhance Image" 199 | ["Sharpen Image" eimp-sharpen-image t]) 200 | 201 | ("Distort Image" 202 | ["Emboss Image" eimp-emboss-image t])) 203 | 204 | ("Processes" 205 | ["Kill All" eimp-stop-all t])))) 206 | 207 | (defvar eimp-mode-string " EIMP" 208 | "String used to indicate EIMP status in mode line.") 209 | (make-variable-buffer-local 'eimp-mode-string) 210 | 211 | ;;;###autoload 212 | (define-minor-mode eimp-mode 213 | "Toggle Eimp mode." 214 | nil eimp-mode-string eimp-minor-mode-map 215 | (when eimp-mode 216 | (setq eimp-mode-string " EIMP")) 217 | (if (and eimp-mode (eq major-mode 'image-mode)) 218 | (progn 219 | (add-hook 'write-contents-functions 'eimp-update-buffer-contents nil t) 220 | (set (make-local-variable 'require-final-newline) nil)) 221 | (remove-hook 'write-contents-functions 'eimp-update-buffer-contents t)) 222 | (when (and (fboundp 'easy-menu-add) 223 | eimp-menu) 224 | (easy-menu-add eimp-menu))) 225 | 226 | ;; Variables 227 | 228 | (defvar eimp-process-queue nil 229 | "List of pending EIMP processes.") 230 | 231 | (defvar eimp-process-list nil 232 | "List of running EIMP processes.") 233 | 234 | ;; This is really c-save-buffer-state 235 | (defmacro eimp-save-buffer-state (varlist &rest body) 236 | "Bind variables according to VARLIST (in `let*' style) and eval BODY. 237 | Then restore the buffer state under the assumption that no significant 238 | modification has been made in BODY. A change is considered 239 | significant if it affects the buffer text in any way that isn't 240 | completely restored again. Changes in text properties like `face' or 241 | `syntax-table' are considered insignificant. This macro allows text 242 | properties to be changed, even in a read-only buffer. 243 | 244 | This macro should be placed around all calculations which set 245 | \"insignificant\" text properties in a buffer, even when the buffer is 246 | known to be writeable. That way, these text properties remain set 247 | even if the user undoes the command which set them. 248 | 249 | This macro should ALWAYS be placed around \"temporary\" internal buffer 250 | changes \(like adding a newline to calculate a text-property then 251 | deleting it again\), so that the user never sees them on his 252 | `buffer-undo-list'. 253 | 254 | The return value is the value of the last form in BODY." 255 | `(let* ((modified (buffer-modified-p)) (buffer-undo-list t) 256 | (inhibit-read-only t) (inhibit-point-motion-hooks t) 257 | before-change-functions after-change-functions 258 | deactivate-mark 259 | ,@varlist) 260 | (unwind-protect 261 | (progn ,@body) 262 | (and (not modified) 263 | (buffer-modified-p) 264 | (set-buffer-modified-p nil))))) 265 | (put 'eimp-save-buffer-state 'lisp-indent-function 1) 266 | 267 | (defun eimp-get-display-property (&optional posn) 268 | "Get display property at POSN (or point, if POSN is nil). 269 | Return a list, where the car is the type of image, and the cdr is 270 | the image data." 271 | (or posn (setq posn (point))) 272 | (let (display) 273 | (cond 274 | ((setq display (eimp-get-text-property-display-property posn)) 275 | (if (and (listp (car display)) 276 | (eq (caar display) 'slice)) 277 | (list 'text-prop-sliced display) 278 | (list 'text-prop display))) 279 | ((setq display (eimp-get-overlay-display-property posn)) 280 | (list 'overlay display))))) 281 | 282 | (defun eimp-get-text-property-display-property (posn) 283 | "Get display text property at POSN." 284 | (let ((display (get-text-property posn 'display))) 285 | display)) 286 | 287 | (defun eimp-get-overlay-display-property (posn) 288 | "Get display overlay at POSN." 289 | (let ((overlay (car (overlays-in (1+ posn) (1+ posn)))) 290 | before-string display) 291 | (when (and overlay 292 | (setq before-string (overlay-get overlay 'before-string))) 293 | (setq display 294 | (get-text-property 0 'display before-string))) 295 | display)) 296 | 297 | (defun eimp-get-image () 298 | "Get image specification at point." 299 | (let ((display (cadr (eimp-get-display-property)))) 300 | (cond 301 | ((eq 'image (car display)) 302 | display) 303 | ((and (listp (cdr display)) 304 | (eq 'image (car (cadr display)))) 305 | (cadr display))))) 306 | 307 | (defun eimp-get-image-data (&optional posn) 308 | "Get data for image at POSN (or point, if POSN is nil)." 309 | (save-excursion 310 | (goto-char (or posn (point))) 311 | (let ((image-spec (eimp-get-image))) 312 | (or (cadr (member :data image-spec)) 313 | (let ((file (cadr (member :file image-spec)))) 314 | (when (and file (file-readable-p file)) 315 | (with-temp-buffer 316 | (insert-file-contents-literally file) 317 | (string-as-unibyte (buffer-string))))))))) 318 | 319 | (defun eimp-mogrify-image (args) 320 | "Transform image, passing ARGS to mogrify." 321 | (when (eq major-mode 'image-mode) 322 | (goto-char (point-min))) 323 | (let ((image-spec (eimp-get-display-property)) 324 | (id (make-temp-name "eimp-"))) 325 | (when (and (not (memq major-mode eimp-ignore-read-only-modes)) 326 | (memq (car image-spec) '(text-prop text-prop-sliced))) 327 | (barf-if-buffer-read-only)) 328 | (cond 329 | ((null image-spec) 330 | (error "EIMP: No image at point")) 331 | (t 332 | (eimp-queue-process (cons (current-buffer) id)) 333 | (eimp-save-buffer-state nil 334 | (put-text-property (point) (1+ (point)) id 335 | `(image-type ,(car image-spec) 336 | proc-args ,args))) 337 | (eimp-run-queued-processes))))) 338 | 339 | (defun eimp-queue-process (specs) 340 | "Add process identified by SPECS to list. 341 | Car of SPECS is a buffer, and cdr of SPECS is the process ID (a 342 | string)." 343 | (when (>= (length eimp-process-queue) eimp-max-queued-processes) 344 | (error "EIMP: eimp-max-queued-processes exceeded %S" specs)) 345 | (setq eimp-process-queue 346 | (nconc eimp-process-queue (list specs)))) 347 | 348 | (defun eimp-run-queued-processes () 349 | "Run a queued EIMP process." 350 | (eimp-clean-process-queue) 351 | (let ((queue (copy-alist eimp-process-queue))) 352 | (while (and queue (< (length eimp-process-list) eimp-max-concurrent-processes)) 353 | (when (eimp-start-process (car queue)) 354 | (setq eimp-process-queue (delete (car queue) eimp-process-queue))) 355 | (setq queue (cdr queue))))) 356 | 357 | (defun eimp-clean-process-queue () 358 | "Remove unrunnable processes from `eimp-process-queue'." 359 | (setq eimp-process-queue 360 | (delq nil 361 | (mapcar (lambda (spec) 362 | (when (buffer-live-p (car spec)) 363 | spec)) 364 | eimp-process-queue)))) 365 | 366 | (defun eimp-start-process (spec) 367 | "Start an EIMP process according to SPEC. 368 | Car of SPEC is the image buffer, cdr of SPEC is the process ID (a 369 | string). Return the process, if any." 370 | (let ((buffer (car spec)) 371 | (id (cdr spec)) 372 | proc) 373 | (if (not (buffer-live-p buffer)) 374 | (message "Buffer not live") 375 | (with-current-buffer buffer 376 | (let* ((posn (eimp-image-position-by-id id)) 377 | (image-data (and posn (eimp-get-image-data posn)))) 378 | (when posn 379 | (eimp-check-for-zombie posn)) 380 | (cond 381 | ((or (not posn) (not image-data)) 382 | ;; Maybe the image was deleted, or the display property 383 | ;; removed; remove this queued process, and carry on 384 | ;; regardless. 385 | (setq eimp-process-queue (delete spec eimp-process-queue))) 386 | ((get-text-property posn 'eimp-proc) 387 | ;; Process already running for image at point; do nothing. 388 | ) 389 | (t 390 | (save-excursion 391 | (goto-char posn) 392 | (let* ((coding-system-for-write 'no-conversion) 393 | (eimp-data (get-text-property (point) id)) 394 | (temp-file (expand-file-name (make-temp-name "eimp-") 395 | temporary-file-directory)) 396 | (args (cadr (member 'proc-args eimp-data))) 397 | (image-type (cadr (member 'image-type eimp-data)))) 398 | (with-temp-file temp-file 399 | (insert (string-to-multibyte image-data))) 400 | (setq proc 401 | (apply #'start-process id nil eimp-mogrify-program 402 | ;; TODO: haven't understood why things 403 | ;; are so much slower when 404 | ;; eimp-mogrify-arguments is nil 405 | `(,@eimp-mogrify-arguments ,@args ,temp-file))) 406 | (push proc eimp-process-list) 407 | (set-process-buffer proc (current-buffer)) 408 | (set-process-filter proc #'eimp-mogrify-process-filter) 409 | (set-process-sentinel proc #'eimp-mogrify-process-sentinel) 410 | (eimp-save-buffer-state nil 411 | (put-text-property (point) (1+ (point)) 'eimp-proc 412 | `(proc ,proc 413 | image-type ,image-type 414 | temp-file ,temp-file)) 415 | (remove-text-properties (point) (1+ (point)) (list id)))))))))) 416 | proc)) 417 | 418 | (defun eimp-check-for-zombie (posn) 419 | "Check for zombie eimp-proc text property at POSN." 420 | (let ((proc (cadr (member 'proc (get-text-property (point) 'eimp-proc))))) 421 | (when (and proc 422 | (not (member proc eimp-process-list))) 423 | (eimp-save-buffer-state nil 424 | (remove-text-properties (point) (1+ (point)) '(eimp-proc)))))) 425 | 426 | (defun eimp-stop-all (&optional error) 427 | "Stop all running processes; remove queued processes. 428 | If ERROR, signal an error with this string." 429 | (interactive) 430 | (eimp-clear-process-list) 431 | (eimp-clear-process-queue) 432 | (eimp-reset-mode-strings) 433 | (when error 434 | (error error))) 435 | 436 | (defun eimp-clear-process-list () 437 | "Remove running EIMP objects." 438 | (let (buffer posn) 439 | (save-excursion 440 | (dolist (proc eimp-process-list) 441 | (setq buffer (process-buffer proc)) 442 | (when (buffer-live-p buffer) 443 | (setq posn (eimp-image-position-by-proc proc)) 444 | (when posn 445 | (eimp-save-buffer-state nil 446 | (remove-text-properties posn (1+ posn) (list proc)))))))) 447 | (setq eimp-process-list nil)) 448 | 449 | (defun eimp-clear-process-queue () 450 | "Remove queued EIMP objects." 451 | (let (buffer id posn) 452 | (save-excursion 453 | (dolist (spec eimp-process-queue) 454 | (setq buffer (car spec) 455 | id (cdr spec)) 456 | (when (buffer-live-p buffer) 457 | (with-current-buffer buffer 458 | (setq posn (eimp-image-position-by-id id)) 459 | (when posn 460 | (eimp-save-buffer-state nil 461 | (remove-text-properties posn (1+ posn) (list id))))))))) 462 | (setq eimp-process-queue nil)) 463 | 464 | (defun eimp-reset-mode-strings () 465 | "Reset all EIMP mode strings." 466 | (dolist (b (buffer-list)) 467 | (with-current-buffer b 468 | (when eimp-mode 469 | (setq eimp-mode-string " EIMP"))))) 470 | 471 | (defun eimp-mogrify-process-filter (proc msg) 472 | "Process filter for mogrify. 473 | Process PROC with message string MSG." 474 | (eimp-check-image-delete-process proc) 475 | (when (and (buffer-live-p (process-buffer proc)) 476 | (eq (process-status proc) 'run)) 477 | (let ((progress (car (reverse (delete "" (split-string msg "[\n\r]+")))))) 478 | (with-current-buffer (process-buffer proc) 479 | (eimp-message proc progress))))) 480 | 481 | (defun eimp-mogrify-process-sentinel (proc msg) 482 | "Process sentinel for mogrify. 483 | Process PROC with message string MSG." 484 | (let ((buffer (process-buffer proc)) 485 | error-message stopped) 486 | (if (buffer-live-p buffer) 487 | (save-excursion 488 | (with-current-buffer buffer 489 | (let* ((image-posn (eimp-image-position-by-proc proc)) 490 | (display (and image-posn (eimp-get-display-property image-posn))) 491 | ;; Could be nil if no image 492 | (eimp-data (and image-posn (get-text-property image-posn 'eimp-proc))) 493 | (image-type (cadr (member 'image-type eimp-data))) 494 | (temp-file (cadr (member 'temp-file eimp-data)))) 495 | (cond 496 | ((or (not display) (not eimp-data)) 497 | (setq error-message "EIMP image not found")) 498 | ((string-equal msg "finished\n") 499 | (goto-char image-posn) 500 | (if eimp-enable-undo 501 | (eimp-replace-image image-type temp-file) 502 | (eimp-save-buffer-state nil 503 | (eimp-replace-image image-type temp-file)) 504 | (when (eq major-mode 'image-mode) 505 | (set-buffer-modified-p t)))) 506 | ((string-equal msg "stopped (signal)\n") 507 | (setq stopped t)) 508 | (t 509 | (setq error-message (format "EIMP process exited with error: %s (exit status = %S)" msg 510 | (process-exit-status proc))))) 511 | (unless stopped 512 | (when image-posn 513 | (setq eimp-process-list (delq proc eimp-process-list)) 514 | (eimp-save-buffer-state nil 515 | (remove-text-properties 516 | image-posn (1+ image-posn) '(eimp-proc)))) 517 | (when (and temp-file (file-exists-p temp-file)) 518 | (delete-file temp-file)))))) 519 | (setq error-message "EIMP image buffer deleted")) 520 | ;; Run queued processes, if no error and there are any remaining 521 | (if error-message 522 | (progn 523 | (run-at-time 0 nil #'eimp-stop-all error-message)) 524 | (run-at-time eimp-process-delay nil #'eimp-run-queued-processes) 525 | (eimp-message proc)))) 526 | 527 | (defun eimp-message (proc &optional progress) 528 | "Emit EIMP message showing the number of running/queued processes. 529 | Here message is used in a general sense, i.e. the message is 530 | communicated using the mode-line or the *Messages* buffer, 531 | depending on the mode of the buffer associated with the EIMP 532 | process. PROC is the process associated with the message, if 533 | any, and optional argument PROGRESS is appended to the message." 534 | (with-current-buffer (process-buffer proc) 535 | (when (or eimp-mode 536 | (not (minibuffer-window-active-p (selected-window)))) 537 | (let ((buffer-processes (length (delq nil 538 | (mapcar (lambda (p) 539 | (eq (current-buffer) 540 | (process-buffer p))) 541 | eimp-process-list)))) 542 | (buffer-queued (length (delq nil 543 | (mapcar (lambda (q) 544 | (eq (current-buffer) 545 | (car q))) 546 | eimp-process-queue)))) 547 | (message "EIMP") 548 | message-log-max) 549 | (if (or (> buffer-processes 0) (> buffer-queued 0)) 550 | (progn 551 | (setq message (concat message (format ": (r:%d/q:%d)" 552 | buffer-processes buffer-queued))) 553 | (when progress 554 | (setq message (concat message " " progress))) 555 | (if eimp-mode 556 | (progn 557 | (setq eimp-mode-string (concat " " message)) 558 | (force-mode-line-update)) 559 | (message "%s" message))) 560 | (if eimp-mode 561 | (setq eimp-mode-string " EIMP") 562 | (message nil))))))) 563 | 564 | (defun eimp-image-position-by-id (id) 565 | "Return point for image associated with ID." 566 | (cond 567 | ((get-text-property (point) id) 568 | (point)) 569 | (t 570 | (save-excursion 571 | (goto-char (point-min)) 572 | (catch 'found 573 | (while (< (point) (point-max)) 574 | (when (get-text-property (point) id) 575 | (throw 'found (point))) 576 | (goto-char (or (next-single-char-property-change (point) id) (point-max))))))))) 577 | 578 | (defun eimp-image-position-by-proc (proc) 579 | "Return point for image associated with process PROC." 580 | (cond 581 | ((eq (cadr (member 'proc (get-text-property (point) 'eimp-proc))) proc) 582 | (point)) 583 | (t 584 | (save-excursion 585 | (goto-char (point-min)) 586 | (catch 'found 587 | (while (< (point) (point-max)) 588 | (when (eq (cadr (member 'proc (get-text-property (point) 'eimp-proc))) proc) 589 | (throw 'found (point))) 590 | (goto-char (or (next-single-char-property-change (point) 'eimp-proc) (point-max))))))))) 591 | 592 | (defun eimp-check-image-delete-process (proc) 593 | "Check image still exists for process PROC. 594 | Delete process if it doesn't" 595 | (let ((buffer (process-buffer proc))) 596 | (when (or (not (buffer-live-p buffer)) 597 | (with-current-buffer buffer 598 | (let* ((image-posn (eimp-image-position-by-proc proc)) 599 | (display (and image-posn (eimp-get-display-property image-posn)))) 600 | (or (not image-posn) (not display))))) 601 | (eimp-stop-all)))) 602 | 603 | (defun eimp-replace-image (type file) 604 | "Replace image at point of type TYPE from file FILE." 605 | (cond 606 | ((equal type 'text-prop) 607 | (eimp-replace-text-property-image file)) 608 | ((equal type 'text-prop-sliced) 609 | (eimp-replace-text-property-sliced-image file)) 610 | ((equal type 'overlay) 611 | (eimp-replace-overlay-image file)))) 612 | 613 | (defun eimp-replace-text-property-image (file) 614 | "Replace text property image using contents of FILE." 615 | (let ((inhibit-read-only t)) 616 | (put-text-property (point) 617 | (next-single-char-property-change (point) 'display) 618 | 'display 619 | (create-image (with-temp-buffer 620 | (insert-file-contents-literally file) 621 | (string-as-unibyte (buffer-string))) nil t)))) 622 | 623 | (defun eimp-replace-text-property-sliced-image (file) 624 | "Replace text property image slices in region using contents of FILE." 625 | (let ((inhibit-read-only t) 626 | (image (create-image (with-temp-buffer 627 | (insert-file-contents-literally file) 628 | (string-as-unibyte (buffer-string))) nil t)) 629 | (image-prop (cdr (get-text-property (point) 'display)))) 630 | ;; The slices could be anywhere; unfortunately this will replace 631 | ;; all slices for multiple copies of the same image. 632 | (goto-char (point-min)) 633 | (while (not (eobp)) 634 | (when (equal image-prop (cdr (get-text-property (point) 'display))) 635 | (put-text-property (point) 636 | (next-single-char-property-change (point) 'display) 637 | 'display 638 | (list (car (cadr (eimp-get-display-property (point)))) 639 | image))) 640 | (goto-char (next-single-char-property-change (point) 'display))))) 641 | 642 | 643 | (defun eimp-replace-overlay-image (file) 644 | "Replace overlay image using contents of FILE." 645 | (let ((inhibit-read-only t) 646 | (before-string (overlay-get (car (overlays-in (1+ (point)) (1+ (point)))) 'before-string))) 647 | (put-text-property 0 (length before-string) 'display 648 | (create-image (with-temp-buffer 649 | (insert-file-contents-literally file) 650 | (string-as-unibyte (buffer-string))) nil t) 651 | before-string))) 652 | 653 | (defun eimp-update-buffer-contents () 654 | "Update buffer contents with image text property." 655 | (save-excursion 656 | (goto-char (point-min)) 657 | (let ((inhibit-read-only t) 658 | (data (string-as-unibyte (eimp-get-image-data)))) 659 | (if eimp-enable-undo 660 | (progn 661 | (erase-buffer) 662 | (insert data)) 663 | (eimp-save-buffer-state nil 664 | (erase-buffer) 665 | (insert data)))) 666 | (require 'image-mode) 667 | (image-toggle-display) 668 | ;; Return nil 669 | nil)) 670 | 671 | (defun eimp-negate-image () 672 | "Negate image." 673 | (interactive) 674 | (eimp-mogrify-image (list "-negate"))) 675 | 676 | (defun eimp-increase-image-size (arg) 677 | "Increase image size by ARG or default `eimp-resize-amount'." 678 | (interactive "P") 679 | (eimp-mogrify-image (list "-resize" (format "%d%%" (or arg eimp-resize-amount))))) 680 | 681 | (defun eimp-decrease-image-size (arg) 682 | "Decrease image size by ARG or default `eimp-resize-amount'." 683 | (interactive "P") 684 | (eimp-mogrify-image (list "-resize" (format "%d%%" (* 100 (/ 100.0 (or arg eimp-resize-amount))))))) 685 | 686 | (defun eimp-fit-image-to-window (arg) 687 | "Scale image to fit in the current window. 688 | With a prefix arg, ARG, don't preserve the aspect ratio." 689 | (interactive "P") 690 | (let* ((edges (window-inside-pixel-edges)) 691 | (width (- (nth 2 edges) (nth 0 edges))) 692 | (height (- (nth 3 edges) (nth 1 edges)))) 693 | (eimp-mogrify-image `("-resize" ,(concat (format "%dx%d" width height) 694 | (and arg "!")))))) 695 | 696 | (defun eimp-fit-image-to-whole-window () 697 | "Scale image to fit the whole of the current window. 698 | The aspect ratio is not preserved." 699 | (interactive) 700 | (eimp-fit-image-to-window t)) 701 | 702 | (defun eimp-fit-image-height-to-window (arg) 703 | "Scale image height to fit in the current window. 704 | With a prefix arg, ARG, don't preserve the aspect ratio." 705 | (interactive "P") 706 | (let* ((edges (window-inside-pixel-edges)) 707 | (width (- (nth 2 edges) (nth 0 edges))) 708 | (height (- (nth 3 edges) (nth 1 edges))) 709 | (image-size (image-size (eimp-get-image) t)) 710 | (image-width (car image-size)) 711 | (image-height (cdr image-size))) 712 | (eimp-mogrify-image 713 | (if arg 714 | `("-resize" ,(concat (format "%dx%d!" image-width height))) 715 | `("-resize" ,(format "%d%%" (* 100 (/ (float height) image-height)))))))) 716 | 717 | (defun eimp-fit-image-width-to-window (arg) 718 | "Scale image width to fit in the current window. 719 | With a prefix arg, ARG, don't preserve the aspect ratio." 720 | (interactive "P") 721 | (let* ((edges (window-inside-pixel-edges)) 722 | (width (- (nth 2 edges) (nth 0 edges))) 723 | (height (- (nth 3 edges) (nth 1 edges))) 724 | (image-size (image-size (eimp-get-image) t)) 725 | (image-width (car image-size)) 726 | (image-height (cdr image-size))) 727 | (eimp-mogrify-image 728 | (if arg 729 | `("-resize" ,(concat (format "%dx%d!" width image-height))) 730 | `("-resize" ,(format "%d%%" (* 100 (/ (float width) image-width)))))))) 731 | 732 | (defun eimp-mouse-resize-image (event) 733 | "Resize image with mouse. 734 | Argument EVENT is a mouse event." 735 | (interactive "e") 736 | (eimp-mouse-resize-image-1 event nil)) 737 | 738 | (defun eimp-mouse-resize-image-preserve-aspect (event) 739 | "Resize image with mouse, preserving aspect ratio. 740 | Argument EVENT is a mouse event." 741 | (interactive "e") 742 | (eimp-mouse-resize-image-1 event t)) 743 | 744 | (defun eimp-mouse-resize-image-1 (event preserve-aspect) 745 | "Resize image with mouse. 746 | Argument EVENT is a mouse event; with non-nil PRESERVE-ASPECT, 747 | preserve the aspect ratio." 748 | (let* ((window (posn-window (event-start event))) 749 | (event-start (event-start event)) 750 | end 751 | message-log-max 752 | image-size image-width image-height 753 | width-ratio height-ratio ratio 754 | dx dy dx-dy x-y start-x-y) 755 | (mouse-set-point event) 756 | ;; Image at or just before point 757 | (unless (eimp-get-display-property) 758 | (backward-char)) 759 | (cond 760 | ((not (posn-image event-start)) 761 | (message "No image at mouse")) 762 | (t 763 | (setq image-size (image-size (eimp-get-image) t) 764 | image-width (car image-size) 765 | image-height (cdr image-size)) 766 | (setq start-x-y (eimp-frame-relative-coordinates event-start) 767 | dx-dy (posn-object-x-y event-start)) 768 | (setq start-x-y (cons (- (car start-x-y) (car dx-dy)) 769 | (- (cdr start-x-y) (cdr dx-dy)))) 770 | (track-mouse 771 | (while (progn 772 | (setq event (read-event)) 773 | (or (mouse-movement-p event) 774 | (memq (car-safe event) '(switch-frame select-window)))) 775 | 776 | (if (memq (car-safe event) '(switch-frame select-window)) 777 | nil 778 | (setq end (event-end event)) 779 | (if (numberp (posn-point end)) 780 | (progn 781 | (setq x-y (eimp-frame-relative-coordinates end) 782 | dx (- (car x-y) (car start-x-y)) 783 | dy (- (cdr x-y) (cdr start-x-y)))) 784 | (setq dx -1 dy -1)) 785 | (if (or (< dx 0) (< dy 0)) 786 | (message "Not scaling image") 787 | (if preserve-aspect 788 | (progn 789 | (setq width-ratio (/ dx (float image-width)) 790 | height-ratio (/ dy (float image-height)) 791 | ratio (max width-ratio height-ratio)) 792 | (message "Resizing image from %dx%d to %dx%d" 793 | image-width image-height 794 | (* image-width ratio) 795 | (* image-height ratio))) 796 | (message "Resizing image from %dx%d to %dx%d" 797 | image-width image-height dx dy)))))) 798 | (when (and (> dx 0) (> dy 0)) 799 | (if preserve-aspect 800 | (eimp-mogrify-image 801 | `("-resize" ,(format "%d%%" (* 100 ratio)))) 802 | (eimp-mogrify-image 803 | `("-resize" ,(concat (format "%dx%d!" dx dy)))))))))) 804 | 805 | (defun eimp-frame-relative-coordinates (position) 806 | "Return frame-relative coordinates from POSITION." 807 | (let* ((x-y (posn-x-y position)) 808 | (window (posn-window position)) 809 | (edges (window-inside-pixel-edges window))) 810 | (cons (+ (car x-y) (car edges)) 811 | (+ (cdr x-y) (cadr edges))))) 812 | 813 | (defun eimp-blur-image (arg) 814 | "Blur image by ARG or default `eimp-blur-amount'." 815 | (interactive "P") 816 | (eimp-mogrify-image (list "-blur" (format "%d" (or arg eimp-blur-amount))))) 817 | 818 | (defun eimp-sharpen-image (arg) 819 | "Sharpen image by ARG or default `eimp-blur-amount'." 820 | (interactive "P") 821 | (eimp-mogrify-image (list "-sharpen" (format "%d" (or arg eimp-blur-amount))))) 822 | 823 | (defun eimp-emboss-image (arg) 824 | "Emboss image by ARG or default `eimp-blur-amount'." 825 | (interactive "P") 826 | (eimp-mogrify-image (list "-emboss" (format "%d" (or arg eimp-blur-amount))))) 827 | 828 | (defun eimp-gaussian-blur-image (arg) 829 | "Gaussian blur image by ARG or default `eimp-blur-amount'." 830 | (interactive "P") 831 | (eimp-mogrify-image (list "-gaussian" (format "%d" (or arg eimp-blur-amount))))) 832 | 833 | (defun eimp-radial-blur-image (arg) 834 | "Radial blur image by ARG or default `eimp-blur-amount'." 835 | (interactive "P") 836 | (eimp-mogrify-image (list "-radial-blur" (format "%d" (or arg eimp-blur-amount))))) 837 | 838 | (defun eimp-flip-image () 839 | "Flip image vertically." 840 | (interactive) 841 | (eimp-mogrify-image (list "-flip" ))) 842 | 843 | (defun eimp-flop-image () 844 | "Flip image horizontally." 845 | (interactive) 846 | (eimp-mogrify-image (list "-flop"))) 847 | 848 | (defun eimp-rotate-image-clockwise (arg) 849 | "Rotate image clockwise by ARG or default `eimp-rotate-amount'." 850 | (interactive "P") 851 | (eimp-mogrify-image (list "-rotate" (format "%d" (or arg eimp-rotate-amount))))) 852 | 853 | (defun eimp-rotate-image-anticlockwise (arg) 854 | "Rotate image anticlockwise by ARG or default `eimp-rotate-amount'." 855 | (interactive "P") 856 | (eimp-mogrify-image (list "-rotate" (format "-%d" (or arg eimp-rotate-amount))))) 857 | 858 | (defalias 'eimp-rotate-image-counterclockwise 859 | 'eimp-rotate-image-anticlockwise) 860 | (put 'eimp-rotate-image-counterclockwise 'function-documentation "Rotate image counterclockwise.") 861 | 862 | (defun eimp-increase-image-brightness (arg) 863 | "Increase image brightness by ARG or default `eimp-brightness-amount'." 864 | (interactive "P") 865 | (eimp-mogrify-image (list "-modulate" (format "%d" (+ 100 (or arg eimp-brightness-amount)))))) 866 | 867 | (defun eimp-decrease-image-brightness (arg) 868 | "Decrease image brightness by ARG or default `eimp-brightness-amount'." 869 | (interactive "P") 870 | (eimp-mogrify-image (list "-modulate" (format "%d" (- 100 (or arg eimp-brightness-amount)))))) 871 | 872 | (defun eimp-increase-image-contrast () 873 | "Increase image contrast." 874 | (interactive) 875 | (eimp-mogrify-image (list "-contrast"))) 876 | 877 | (defun eimp-decrease-image-contrast () 878 | "Decrease image contrast." 879 | (interactive) 880 | (eimp-mogrify-image (list "+contrast"))) 881 | 882 | (defun eimp-roll-image-right (arg) 883 | "Roll image right by ARG pixels." 884 | (interactive "P") 885 | (eimp-mogrify-image (list "-roll" 886 | (format "+%d-0" (or arg eimp-roll-amount))))) 887 | 888 | (defun eimp-roll-image-left (arg) 889 | "Roll image left by ARG pixels." 890 | (interactive "P") 891 | (eimp-mogrify-image (list "-roll" 892 | (format "-%d-0" (or arg eimp-roll-amount))))) 893 | 894 | (defun eimp-roll-image-up (arg) 895 | "Roll image up by ARG pixels." 896 | (interactive "P") 897 | (eimp-mogrify-image (list "-roll" 898 | (format "+0-%d" (or arg eimp-roll-amount))))) 899 | 900 | (defun eimp-roll-image-down (arg) 901 | "Roll image down by ARG pixels." 902 | (interactive "P") 903 | (eimp-mogrify-image (list "-roll" 904 | (format "+0+%d" (or arg eimp-roll-amount))))) 905 | 906 | (defun eimp-trace-all () 907 | "Trace all `eimp' functions. For debugging." 908 | (require 'trace) 909 | (let ((buffer (get-buffer-create "*EIMP Trace*"))) 910 | (buffer-disable-undo buffer) 911 | (all-completions "eimp" obarray 912 | (lambda (sym) 913 | (and (fboundp sym) 914 | (not (memq (car-safe (symbol-function sym)) 915 | '(autoload macro))) 916 | (trace-function-background sym buffer)))))) 917 | (provide 'eimp) 918 | 919 | ;;; eimp.el ends here 920 | --------------------------------------------------------------------------------