emacs-framebuffer.el (32593B)
1 ;;; emacs-framebuffer.el 2 ;;; 3 ;;; Show images and documents in console using Linux framebuffer. 4 ;;; 5 ;;; Copyright (C) 2020 Tomas Hlavaty <tom at logand dot com> 6 ;;; 7 ;;; License: GPLv3 or later 8 ;;; 9 ;;; Download: git clone https://logand.com/git/emacs-framebuffer.git 10 ;;; 11 ;;; Dependencies: 12 ;;; 13 ;;; - w3mimgdisplay from w3m terminal web browser 14 ;;; 15 ;;; Optional dependencies: 16 ;;; 17 ;;; - sha256sum from coreutils 18 ;;; - pdftocairo and pdfinfo from poppler-utils to display pdf 19 ;;; - abiword to display abw, doc, docx, odt, rtf 20 ;;; - imagemagick to modify images and svg support 21 ;;; 22 ;;; Example configuration: 23 ;;; 24 ;;; (add-to-list 'load-path "~/git/emacs-framebuffer") 25 ;;; (require 'emacs-framebuffer) 26 ;;; (framebuffer-install) 27 28 (require 'cl-lib) 29 30 (defcustom framebuffer-w3mimgdisplay-program nil 31 "Specify the path to w3mimgdisplay program." 32 :type 'string 33 :group 'framebuffer) 34 35 (defcustom framebuffer-width nil 36 "Specify the framebuffer width." 37 :type 'number 38 :group 'framebuffer) 39 40 (defcustom framebuffer-height nil 41 "Specify the framebuffer height." 42 :type 'number 43 :group 'framebuffer) 44 45 (defcustom framebuffer-default-width 1024 46 "Specify the framebuffer default width." 47 :type 'number 48 :group 'framebuffer) 49 50 (defcustom framebuffer-default-height 768 51 "Specify the framebuffer height." 52 :type 'number 53 :group 'framebuffer) 54 55 (defcustom framebuffer-screenshot-directory nil 56 "Specify the directory where to store screenshot files." 57 :type 'string 58 :group 'framebuffer) 59 60 (defcustom framebuffer-draw-delay "1 sec" 61 "Specify the delay after which to draw on the framebuffer." 62 :type 'string 63 :group 'framebuffer) 64 65 (defcustom framebuffer-cache-directory nil 66 "Specify the directory where to store cache files." 67 :type 'string 68 :group 'framebuffer) 69 70 (make-variable-buffer-local 71 (defvar framebuffer-image-mode-image-size)) 72 (make-variable-buffer-local 73 (defvar framebuffer-image-mode-npages)) 74 (make-variable-buffer-local 75 (defvar framebuffer-image-mode-current-page)) 76 (make-variable-buffer-local 77 (defvar framebuffer-image-mode-scale)) 78 (make-variable-buffer-local 79 (defvar framebuffer-image-mode-scroll)) 80 81 (defun framebuffer-file-format (file) 82 (let ((name (file-name-sans-versions file))) 83 (cond 84 ((string-match "\\.\\(abw\\|ABW\\)\\'" name) 'abw) 85 ((string-match "\\.\\(bmp\\|BMP\\)\\'" name) 'bmp) 86 ((string-match "\\.\\(doc\\|DOC\\)\\'" name) 'doc) 87 ((string-match "\\.\\(docx\\|DOCX\\)\\'" name) 'docx) 88 ((string-match "\\.\\(gif\\|GIF\\)\\'" name) 'gif) 89 ((string-match "\\.\\(jpe?g\\|JPE?G\\)\\'" name) 'jpeg) 90 ((string-match "\\.\\(odt\\|ODT\\)\\'" name) 'odt) 91 ((string-match "\\.\\(pbm\\|PBM\\)\\'" name) 'pbm) 92 ((string-match "\\.\\(pdf\\|PDF\\)\\'" name) 'pdf) 93 ((string-match "\\.\\(pgm\\|PGM\\)\\'" name) 'pgm) 94 ((string-match "\\.\\(png\\|PNG\\)\\'" name) 'png) 95 ((string-match "\\.\\(pnm\\|PNM\\)\\'" name) 'pnm) 96 ((string-match "\\.\\(ppm\\|PPM\\)\\'" name) 'ppm) 97 ((string-match "\\.\\(rtf\\|RTF\\)\\'" name) 'rtf) 98 ((string-match "\\.\\(svg\\|SVG\\)\\'" name) 'svg) 99 ((string-match "\\.\\(tiff?\\|TIFF?\\)\\'" name) 'tiff) 100 ((string-match "\\.\\(xbm\\|XBM\\)\\'" name) 'xbm) 101 ((string-match "\\.\\(xpm\\|XPM\\)\\'" name) 'xpm) 102 ))) 103 104 (defun framebuffer-virtual-size () ;; TODO rm unused? 105 (with-temp-buffer 106 ;; TODO which framebuffer if more than one? 107 (insert-file-contents "/sys/class/graphics/fb0/virtual_size") 108 (search-forward-regexp "\\([0-9]+\\),\\([0-9]+\\)") 109 (cons (read (match-string 1)) (read (match-string 2))))) 110 111 (defun framebuffer-bits-per-pixel () 112 (with-temp-buffer 113 ;; TODO which framebuffer if more than one? 114 (insert-file-contents "/sys/class/graphics/fb0/bits_per_pixel") 115 (read (current-buffer)))) 116 117 (defun framebuffer-stride () 118 (with-temp-buffer 119 ;; TODO which framebuffer if more than one? 120 (insert-file-contents "/sys/class/graphics/fb0/stride") 121 (read (current-buffer)))) 122 123 (defvar framebuffer-size nil) 124 (defun framebuffer-size () 125 (if (and framebuffer-width framebuffer-height) 126 (cons framebuffer-width framebuffer-height) 127 (or framebuffer-size 128 (setq framebuffer-size 129 (or 130 (with-temp-buffer 131 ;; TODO which framebuffer if more than one? 132 (insert-file-contents "/sys/class/graphics/fb0/modes") 133 (search-forward-regexp "\\([0-9]+\\)x\\([0-9]+\\)") 134 (cons (read (match-string 1)) (read (match-string 2)))) 135 (cons framebuffer-default-width framebuffer-default-height)))))) 136 137 (defun framebuffer-local-cache-directory () 138 (let ((z (or framebuffer-cache-directory temporary-file-directory))) 139 (if (file-remote-p z) 140 (error "framebuffer-cache-directory is remote %s" z) 141 z))) 142 143 (defun framebuffer-local-cache-file (name extension) 144 (concat (framebuffer-local-cache-directory) "/" name "." extension)) 145 146 (defun framebuffer-file-hash (file) 147 (with-temp-buffer 148 (if (file-remote-p file) 149 (process-file "sha256sum" file t) 150 (call-process "sha256sum" file t)) 151 (buffer-substring (point-min) (+ (point-min) 64)))) 152 153 (defun framebuffer-cache-remote (file) 154 (if (file-remote-p file) 155 (let ((z (framebuffer-local-cache-file (framebuffer-file-hash file) 156 (file-name-extension file)))) 157 (unless (file-readable-p z) 158 (copy-file file z)) 159 z) 160 file)) 161 162 (defun framebuffer-cache-abiword (format ifile ofile) 163 (case format 164 ((abw odt rtf doc docx) 165 (unless (file-readable-p ofile) 166 (call-process "abiword" nil nil nil 167 "-t" (expand-file-name ofile) 168 (expand-file-name ifile))) 169 ofile))) 170 171 (defun framebuffer-cache-to-pdf (format file) 172 (framebuffer-cache-abiword 173 format 174 file 175 (framebuffer-local-cache-file (framebuffer-file-hash file) "pdf"))) 176 177 (defun framebuffer-cache-pdf-to-png (file page) 178 (let* ((page (format "%s" (or page 1))) 179 (output (concat (framebuffer-local-cache-directory) 180 "/" 181 (framebuffer-file-hash file) "-" page)) 182 (ofile (concat output ".png"))) 183 (unless (file-readable-p ofile) 184 (call-process "pdftocairo" nil nil nil "-singlefile" "-f" page "-l" page "-png" (expand-file-name file) output)) 185 ofile)) 186 187 (defun framebuffer-cache-svg-to-png (file) 188 (let ((ofile (framebuffer-local-cache-file (framebuffer-file-hash file) "png"))) 189 (unless (file-readable-p ofile) 190 (call-process "convert" nil nil nil (expand-file-name file) ofile)) 191 ofile)) 192 193 (defun framebuffer-tty-p (filename) 194 (when (string-match "^/dev/tty[0-9]+$" filename) 195 filename)) 196 197 (defvar framebuffer-tty nil) 198 (defun framebuffer-tty () 199 (or framebuffer-tty 200 (setq framebuffer-tty 201 (framebuffer-tty-p 202 (file-chase-links (format "/proc/%d/fd/0" (emacs-pid))))))) 203 204 ;; TODO file-exists-p should return filename, not t 205 (defun framebuffer-file-exists-p (filename) 206 (when (file-exists-p filename) 207 filename)) 208 209 (defun framebuffer-w3mimgdisplay-program () 210 (or framebuffer-w3mimgdisplay-program 211 (framebuffer-file-exists-p "/usr/lib/w3m/w3mimgdisplay") ;; debian10 212 "w3mimgdisplay")) 213 214 (defun framebuffer-draw (x y w h sx sy sw sh file) 215 (setq file (framebuffer-cache-remote file)) 216 (let ((format (framebuffer-file-format file))) 217 (case format 218 (svg 219 (setq file (framebuffer-cache-svg-to-png file))) 220 ((abw odt rtf doc docx) 221 (setq file (framebuffer-cache-to-pdf format file))))) 222 (case (framebuffer-file-format file) 223 (pdf 224 (setq file (framebuffer-cache-pdf-to-png 225 file 226 framebuffer-image-mode-current-page)))) 227 (with-temp-buffer 228 (insert (format "0;1;%d;%d;%d;%d;%s;%s;%s;%s;%s\n" x y w h 229 (or sx "") (or sy "") (or sw "") (or sh "") 230 (expand-file-name file))) 231 (let ((z (call-process-region (point-min) 232 (point-max) 233 (framebuffer-w3mimgdisplay-program)))) 234 (unless (zerop z) 235 (if (getenv "W3M_TTY") 236 (error "w3mimgdisplay failed with code %d" z) 237 (let ((tty (framebuffer-tty))) 238 (cond 239 (tty 240 (setenv "W3M_TTY" tty) 241 (let ((z (call-process-region (point-min) 242 (point-max) 243 (framebuffer-w3mimgdisplay-program)))) 244 (unless (zerop z) 245 (error "w3mimgdisplay failed with code %d, try setting W3M_TTY=$(tty)" z)))) 246 (t 247 (error "w3mimgdisplay failed with code %d, try setting W3M_TTY=$(tty)" z))))))))) 248 249 (defun framebuffer-buffer-brook () 250 (lambda () 251 (let ((z (char-after))) 252 (when z 253 (goto-char (1+ (point))) 254 z)))) 255 256 (defun framebuffer-next-u8 (brook) 257 (let ((z (funcall brook))) 258 (when z 259 (if (<= 0 z 255) 260 z 261 (error "expected octet, got %s" z))))) 262 263 (defun framebuffer-next-u16 (brook) 264 (+ (* 256 (framebuffer-next-u8 brook)) 265 (framebuffer-next-u8 brook))) 266 267 (defun framebuffer-next-u16le (brook) 268 (+ (framebuffer-next-u8 brook) 269 (* 256 (framebuffer-next-u8 brook)))) 270 271 (defun framebuffer-next-u32 (brook) 272 (+ (* 65536 (framebuffer-next-u16 brook)) 273 (framebuffer-next-u16 brook))) 274 275 (defun framebuffer-next-u32le (brook) 276 (+ (framebuffer-next-u16le brook) 277 (* 65536 (framebuffer-next-u16le brook)))) 278 279 (defun framebuffer-pdf-page-size (file) 280 (with-temp-buffer 281 (call-process "pdfinfo" nil t nil (expand-file-name file)) 282 (goto-char (point-min)) 283 (when (search-forward-regexp "^Page size:[ ]*\\([0-9]+[.]?[0-9]*\\) x \\([0-9]+[.]?[0-9]*\\) pts") 284 (cons (read (match-string 1)) (read (match-string 2)))))) 285 286 (defun framebuffer-image-size (file) 287 (setq file (framebuffer-cache-remote file)) 288 (with-temp-buffer 289 (set-buffer-multibyte nil) 290 (insert-file-contents-literally file) 291 (let* ((brook (framebuffer-buffer-brook)) 292 (a (framebuffer-next-u8 brook))) 293 (case a 294 (?% ;; pdf 295 (case (framebuffer-next-u8 brook) 296 (?P 297 (case (framebuffer-next-u8 brook) 298 (?D 299 (case (framebuffer-next-u8 brook) 300 (?F 301 (case (framebuffer-next-u8 brook) 302 (?- 303 (framebuffer-pdf-page-size file)))))))))) 304 (137 ;; png 305 (when (and (= ?P (framebuffer-next-u8 brook)) 306 (= ?N (framebuffer-next-u8 brook)) 307 (= ?G (framebuffer-next-u8 brook)) 308 (= 13 (framebuffer-next-u8 brook)) 309 (= 10 (framebuffer-next-u8 brook)) 310 (= 26 (framebuffer-next-u8 brook)) 311 (= 10 (framebuffer-next-u8 brook)) 312 (<= 12 (framebuffer-next-u32 brook)) 313 (= ?I (framebuffer-next-u8 brook)) 314 (= ?H (framebuffer-next-u8 brook)) 315 (= ?D (framebuffer-next-u8 brook)) 316 (= ?R (framebuffer-next-u8 brook))) 317 (cons (framebuffer-next-u32 brook) 318 (framebuffer-next-u32 brook)))) 319 (#xff ;; jpeg 320 (when (= #xd8 (framebuffer-next-u8 brook)) 321 (let ((n 0) 322 (m 0)) 323 (while (not (member m '(#xc0 #xc1 #xc2 #xc3 #xc5 #xc6 #xc7 #xc8 324 #xc9 #xca #xcb #xcd #xc0e #xcf))) 325 (goto-char (+ (point) n)) 326 (while (= #xff (setq m (framebuffer-next-u8 brook)))) 327 (setq n (- (framebuffer-next-u16 brook) 2)))) 328 (framebuffer-next-u8 brook) 329 (let ((h (framebuffer-next-u16 brook))) 330 (cons (framebuffer-next-u16 brook) 331 h)))) 332 (?B ;; bmp 333 (when (= ?M (framebuffer-next-u8 brook)) 334 (dotimes (i 16) 335 (framebuffer-next-u8 brook)) 336 (cons (framebuffer-next-u32le brook) 337 (framebuffer-next-u32le brook)))) 338 (?G ;; gif 339 (when (and (= ?I (framebuffer-next-u8 brook)) 340 (= ?F (framebuffer-next-u8 brook)) 341 (= ?8 (framebuffer-next-u8 brook)) 342 (member (framebuffer-next-u8 brook) '(?7 ?9)) 343 (= ?a (framebuffer-next-u8 brook))) 344 (cons (framebuffer-next-u16le brook) 345 (framebuffer-next-u16le brook)))) 346 ((?I ?M) ;; tiff 347 (let ((b (framebuffer-next-u8 brook))) 348 (when (= a b) 349 (multiple-value-bind (u16 u32) 350 (ecase a 351 (?I (values 'framebuffer-next-u16le 'framebuffer-next-u32le)) 352 (?M (values 'framebuffer-next-u16 'framebuffer-next-u32))) 353 (when (= #x2a (funcall u16 brook)) 354 (let (w h) 355 (goto-char (1+ (funcall u32 brook))) 356 (dotimes (i (funcall u16 brook)) 357 (let ((tag (funcall u16 brook)) 358 (type (funcall u16 brook)) 359 (n (funcall u32 brook)) 360 (v (funcall u32 brook))) 361 (case tag 362 (#x0100 363 (ecase type 364 (3 (setq w v)))) 365 (#x0101 366 (ecase type 367 (3 (setq h v))))))) 368 (when (and w h) 369 (cons w h)))))))) 370 (?P ;; docx odt pbm pgm pnm ppm 371 (case (framebuffer-next-u8 brook) 372 (?K 373 (case (framebuffer-file-format file) 374 (odt 375 (framebuffer-pdf-page-size 376 (framebuffer-cache-to-pdf 'odt file))) 377 (docx 378 (framebuffer-pdf-page-size 379 (framebuffer-cache-to-pdf 'docx file))))) 380 ((?1 ?2 ?3 ?4 ?5 ?6) 381 (search-forward-regexp "^\\([0-9]+\\) \\([0-9]+\\)$") 382 (cons (read (match-string 1)) (read (match-string 2)))))) 383 (?< ;; abw svg 384 (case (framebuffer-next-u8 brook) 385 (?s 386 (case (framebuffer-next-u8 brook) 387 (?v 388 (case (framebuffer-next-u8 brook) 389 (?g 390 (framebuffer-image-size 391 (framebuffer-cache-svg-to-png file))))))) 392 (?? 393 (case (framebuffer-next-u8 brook) 394 (?x 395 (case (framebuffer-next-u8 brook) 396 (?m 397 (case (framebuffer-next-u8 brook) 398 (?l 399 (case (framebuffer-next-u8 brook) 400 ((? ) 401 (let ((xml (xml-parse-file file))) 402 (ecase (caar xml) 403 (svg 404 (framebuffer-image-size 405 (framebuffer-cache-svg-to-png file))) 406 (abiword 407 (framebuffer-pdf-page-size 408 (framebuffer-cache-to-pdf 'abw file)))))))))))))))) 409 (?{ ;; rtf 410 (case (framebuffer-next-u8 brook) 411 (?\\ 412 (case (framebuffer-next-u8 brook) 413 (?r 414 (case (framebuffer-next-u8 brook) 415 (?t 416 (case (framebuffer-next-u8 brook) 417 (?f 418 (framebuffer-pdf-page-size 419 (framebuffer-cache-to-pdf 'rtf file))))))))))) 420 (t ;; doc xbm xpm 421 (case (framebuffer-file-format file) 422 (doc 423 (framebuffer-pdf-page-size 424 (framebuffer-cache-to-pdf 'doc file))) 425 (xbm 426 (let (w) 427 (search-forward-regexp "_width[ ]+\\([0-9]+\\)") 428 (setq w (read (match-string 1))) 429 (search-forward-regexp "_height[ ]+\\([0-9]+\\)") 430 (cons w (read (match-string 1))))) 431 (xpm 432 (search-forward-regexp "\"[ ]*\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]*") 433 (cons (read (match-string 1)) (read (match-string 2)))))) 434 )))) 435 436 (defun framebuffer-image-file (file) 437 (interactive "fFile: ") 438 (setq file (framebuffer-cache-remote file)) 439 (destructuring-bind (w &rest h) (framebuffer-image-size file) 440 (destructuring-bind (fw &rest fh) (framebuffer-size) 441 (let* ((scale (min (/ fw 1.0 w) (/ fh 1.0 h))) 442 (ww (floor (* scale w))) 443 (hh (floor (* scale h))) 444 (xx (floor (- fw ww) 2)) 445 (yy (floor (- fh hh) 2))) 446 (framebuffer-draw xx yy ww hh nil nil nil nil file))))) 447 448 (defun framebuffer-image-buffer () 449 (interactive) 450 (framebuffer-image-file (buffer-file-name))) 451 452 (defun framebuffer-image-file-dired () 453 (interactive) 454 (framebuffer-image-file (dired-file-name-at-point))) 455 456 (defun framebuffer-dired-image-p () 457 (let ((f (dired-file-name-at-point))) 458 (and f 459 (not (file-directory-p f)) 460 (framebuffer-file-format f)))) 461 462 (defun framebuffer-image-file-dired-next (arg) 463 (interactive "^p") 464 (while (not (progn 465 (dired-next-line (or arg 1)) 466 (framebuffer-dired-image-p)))) 467 (when (framebuffer-dired-image-p) 468 (framebuffer-image-file-dired))) 469 470 (defun framebuffer-image-file-dired-previous (arg) 471 (interactive "^p") 472 (framebuffer-image-file-dired-next (if arg (- arg) -1))) 473 474 (defun framebuffer-image-mode-draw-image (&optional buffer) 475 (interactive) 476 (let ((buffer (or buffer (current-buffer))) 477 (file (buffer-file-name))) 478 (destructuring-bind (w &rest h) framebuffer-image-mode-image-size 479 (destructuring-bind (fbw &rest fbh) (framebuffer-size) 480 (dolist (window (get-buffer-window-list buffer nil 'visible)) 481 (destructuring-bind (x1 y1 x2 y2) (window-edges window t) 482 (let* ((fw (frame-width)) 483 (fh (frame-height)) 484 (cw (floor fbw fw)) 485 (ch (floor fbh fh)) 486 (wx (* x1 cw)) 487 (wy (* y1 ch)) 488 (ww (* (- x2 x1) cw)) 489 (wh (* (- y2 y1) ch)) 490 (scale (ecase framebuffer-image-mode-scale 491 (:fit-page (min (/ ww 1.0 w) (/ wh 1.0 h))) 492 (:fit-width (/ ww 1.0 w)) 493 (:fit-height (/ wh 1.0 h)))) 494 (zw (floor (* scale w))) 495 (zh (floor (* scale h))) 496 (zx (+ wx (max 0 (floor (- ww zw) 2)))) 497 (zy (+ wy (max 0 (floor (- wh zh) 2)))) 498 (sx 0) 499 (sy 0) 500 (sw ww) 501 (sh wh)) 502 (framebuffer-draw zx zy zw zh sx sy sw sh file)))))))) 503 504 (defun framebuffer-image-mode-draw-image-repeatedly (buffer) 505 (when (buffer-live-p buffer) 506 (with-current-buffer buffer 507 (framebuffer-image-mode-draw-image buffer)))) 508 509 (defun framebuffer-pdf-npages (file) 510 (with-temp-buffer 511 (call-process "pdfinfo" nil t nil (expand-file-name file)) 512 (goto-char (point-min)) 513 (when (search-forward-regexp "^Pages:[ ]*\\([0-9]+\\)$" nil t) 514 (let ((z (read (match-string 1)))) 515 (when (plusp z) 516 z))))) 517 518 (defun framebuffer-image-npages (file) 519 (setq file (framebuffer-cache-remote file)) 520 (let ((format (framebuffer-file-format file))) 521 (case format 522 (pdf 523 (framebuffer-pdf-npages file)) 524 ((abw odt rtf doc docx) 525 (framebuffer-pdf-npages (framebuffer-cache-to-pdf format file))) 526 (t 1)))) 527 528 (defvar framebuffer-image-mode-hook nil) 529 530 (define-derived-mode framebuffer-image-mode fundamental-mode "fbi" 531 "Major mode for viewing images in framebuffer." 532 (setq framebuffer-image-mode-image-size 533 (framebuffer-image-size (buffer-file-name))) 534 (setq framebuffer-image-mode-npages 535 (framebuffer-image-npages (buffer-file-name))) 536 (setq framebuffer-image-mode-current-page 1) 537 (setq framebuffer-image-mode-scale :fit-page) 538 (setq framebuffer-image-mode-scroll 0) 539 (setq-local mode-line-position 540 '(" P" 541 (:eval (prin1-to-string framebuffer-image-mode-current-page)) 542 "/" 543 (:eval (prin1-to-string framebuffer-image-mode-npages)))) 544 (with-silent-modifications 545 (erase-buffer) 546 (insert "file: ") 547 (insert (buffer-file-name)) 548 (insert "\npages: ") 549 (insert (format "%s" framebuffer-image-mode-npages)) 550 (insert "\nwidth: ") 551 (insert (format "%s" (car framebuffer-image-mode-image-size))) 552 (insert "\nheight: ") 553 (insert (format "%s" (cdr framebuffer-image-mode-image-size))) 554 (insert "\npress:\n") 555 (insert "- L: turn left (modifies the image)\n") 556 (insert "- R: turn right (modifies the image)\n") 557 (insert "- U: turn upside-down (modifies the image)\n") 558 (insert "- b: beginning (first page)\n") 559 (insert "- d: (re)draw\n") 560 (insert "- e: end (last page)\n") 561 (insert "- f: fit page\n") 562 (insert "- g: go to page\n") 563 (insert "- h: fit height\n") 564 (insert "- k: kill the buffer\n") 565 (insert "- n: next page\n") 566 (insert "- p: previous page\n") 567 (insert "- q: quit\n") 568 (insert "- space: scroll down\n") 569 (insert "- u: scroll up\n") 570 (insert "- w: fit width\n") 571 ) 572 (setq buffer-read-only t) 573 (goto-char (point-min)) 574 (run-hooks 'framebuffer-image-mode-hook) 575 (run-at-time framebuffer-draw-delay 576 nil 577 'framebuffer-image-mode-draw-image-repeatedly 578 (current-buffer))) 579 580 (defun framebuffer-image-mode-scroll-down () 581 (interactive) 582 ) 583 584 (defun framebuffer-image-mode-scroll-up () 585 (interactive) 586 ) 587 588 (defun framebuffer-image-mode-goto-page (&optional n) 589 (interactive "nPage: ") 590 (unless (plusp n) 591 (setq n 1)) 592 (unless (< n framebuffer-image-mode-npages) 593 (setq n framebuffer-image-mode-npages)) 594 (setq framebuffer-image-mode-current-page n) 595 (force-mode-line-update) 596 (framebuffer-image-mode-draw-image (current-buffer))) 597 598 (defun framebuffer-image-mode-next-page () 599 (interactive) 600 (framebuffer-image-mode-goto-page (1+ framebuffer-image-mode-current-page))) 601 602 (defun framebuffer-image-mode-previous-page () 603 (interactive) 604 (framebuffer-image-mode-goto-page (1- framebuffer-image-mode-current-page))) 605 606 (defun framebuffer-image-mode-first-page () 607 (interactive) 608 (framebuffer-image-mode-goto-page 1)) 609 610 (defun framebuffer-image-mode-last-page () 611 (interactive) 612 (framebuffer-image-mode-goto-page framebuffer-image-mode-npages)) 613 614 (defun framebuffer-image-mode-change-scale (scale) 615 (setq framebuffer-image-mode-scale scale) 616 (framebuffer-image-mode-draw-image (current-buffer))) 617 618 (defun framebuffer-image-mode-fit-page () 619 (interactive) 620 (framebuffer-image-mode-change-scale :fit-page)) 621 622 (defun framebuffer-image-mode-fit-width () 623 (interactive) 624 (framebuffer-image-mode-change-scale :fit-width)) 625 626 (defun framebuffer-image-mode-fit-height () 627 (interactive) 628 (framebuffer-image-mode-change-scale :fit-height)) 629 630 (defun framebuffer-image-mode-turn-right () 631 (interactive) 632 (let ((f (buffer-file-name))) 633 (call-process "convert" nil nil nil "-rotate" "90" f f)) 634 (setq framebuffer-image-mode-image-size 635 (cons (cdr framebuffer-image-mode-image-size) 636 (car framebuffer-image-mode-image-size))) 637 (framebuffer-image-mode-draw-image (current-buffer))) 638 639 (defun framebuffer-image-mode-turn-left () 640 (interactive) 641 (let ((f (buffer-file-name))) 642 (call-process "convert" nil nil nil "-rotate" "-90" f f)) 643 (setq framebuffer-image-mode-image-size 644 (cons (cdr framebuffer-image-mode-image-size) 645 (car framebuffer-image-mode-image-size))) 646 (framebuffer-image-mode-draw-image (current-buffer))) 647 648 (defun framebuffer-image-mode-turn-upside-down () 649 (interactive) 650 (let ((f (buffer-file-name))) 651 (call-process "convert" nil nil nil "-rotate" "180" f f)) 652 (framebuffer-image-mode-draw-image (current-buffer))) 653 654 (defun framebuffer-fbpdf (filename) 655 (suspend-emacs 656 (format "fbpdf -w %s; fg" 657 (shell-quote-argument (expand-file-name filename))))) 658 659 (defun framebuffer-hh:mm:ss (sec) 660 (etypecase sec 661 (string sec) 662 (integer 663 (let* ((m (mod sec 3600)) 664 (s (mod m 60))) 665 (format "%d:%02d:%02d" (floor sec 3600) (floor (- m s) 60) s))))) 666 667 (defun framebuffer-fbmpv (filename &optional position) 668 (suspend-emacs 669 (format "mpv --vo=drm --osd-level=3 %s%s %s; fg" 670 (if position "--start=" "") 671 (if position (framebuffer-hh:mm:ss position) "") 672 (shell-quote-argument (expand-file-name filename))))) 673 674 (defun framebuffer-fbview () 675 (interactive) 676 (let* ((filename (dired-file-name-at-point)) 677 (x (file-name-extension filename))) 678 (cond 679 ((member x '("pdf")) (framebuffer-fbpdf filename)) 680 ((member x '("mkv" "mp4" "ogg" "webm")) (framebuffer-fbmpv filename))))) 681 682 (add-hook 683 'framebuffer-image-mode-hook 684 (lambda () 685 (define-key framebuffer-image-mode-map "L" 'framebuffer-image-mode-turn-left) 686 (define-key framebuffer-image-mode-map "R" 'framebuffer-image-mode-turn-right) 687 (define-key framebuffer-image-mode-map "U" 'framebuffer-image-mode-turn-upside-down) 688 (define-key framebuffer-image-mode-map "b" 'framebuffer-image-mode-first-page) 689 (define-key framebuffer-image-mode-map "d" 'framebuffer-image-mode-draw-image) 690 (define-key framebuffer-image-mode-map "e" 'framebuffer-image-mode-last-page) 691 (define-key framebuffer-image-mode-map "f" 'framebuffer-image-mode-fit-page) 692 (define-key framebuffer-image-mode-map "g" 'framebuffer-image-mode-goto-page) 693 (define-key framebuffer-image-mode-map "h" 'framebuffer-image-mode-fit-height) 694 (define-key framebuffer-image-mode-map "k" 'kill-buffer) 695 (define-key framebuffer-image-mode-map "n" 'framebuffer-image-mode-next-page) 696 (define-key framebuffer-image-mode-map "p" 'framebuffer-image-mode-previous-page) 697 (define-key framebuffer-image-mode-map "q" 'quit-window) 698 (define-key framebuffer-image-mode-map "spc" 'framebuffer-image-mode-scroll-down) 699 (define-key framebuffer-image-mode-map "u" 'framebuffer-image-mode-scroll-up) 700 (define-key framebuffer-image-mode-map "w" 'framebuffer-image-mode-fit-width) 701 )) 702 703 (defun framebuffer-install () 704 (interactive) 705 (add-to-list 'auto-mode-alist '("\\.\\(abw\\|ABW\\)\\'" . framebuffer-image-mode)) 706 (add-to-list 'auto-mode-alist '("\\.\\(bmp\\|BMP\\)\\'" . framebuffer-image-mode)) 707 (add-to-list 'auto-mode-alist '("\\.\\(docx?\\|DOCX?\\)\\'" . framebuffer-image-mode)) 708 (add-to-list 'auto-mode-alist '("\\.\\(gif\\|GIF\\)\\'" . framebuffer-image-mode)) 709 (add-to-list 'auto-mode-alist '("\\.\\(jpe?g\\|JPE?G\\)\\'" . framebuffer-image-mode)) 710 (add-to-list 'auto-mode-alist '("\\.\\(odt\\|ODT\\)\\'" . framebuffer-image-mode)) 711 (add-to-list 'auto-mode-alist '("\\.\\(p[bgnp]m\\|P[BGNP]M\\)\\'" . framebuffer-image-mode)) 712 (add-to-list 'auto-mode-alist '("\\.\\(pdf\\|PDF\\)\\'" . framebuffer-image-mode)) 713 (add-to-list 'auto-mode-alist '("\\.\\(png\\|PNG\\)\\'" . framebuffer-image-mode)) 714 (add-to-list 'auto-mode-alist '("\\.\\(rtf\\|RTF\\)\\'" . framebuffer-image-mode)) 715 (add-to-list 'auto-mode-alist '("\\.\\(svg\\|SVG\\)\\'" . framebuffer-image-mode)) 716 (add-to-list 'auto-mode-alist '("\\.\\(tiff?\\|TIFF?\\)\\'" . framebuffer-image-mode)) 717 (add-to-list 'auto-mode-alist '("\\.\\(x[bp]m\\|X[BP]M\\)\\'" . framebuffer-image-mode)) 718 (with-eval-after-load 'dired 719 (define-key dired-mode-map "I" 'framebuffer-image-file-dired) 720 (define-key dired-mode-map "N" 'framebuffer-image-file-dired-next) 721 (define-key dired-mode-map "P" 'framebuffer-image-file-dired-previous) 722 (define-key dired-mode-map "V" 'framebuffer-fbview))) 723 724 (defun framebuffer-draw-test () 725 (interactive) 726 (destructuring-bind (fbw &rest fbh) (framebuffer-size) 727 (destructuring-bind (vw &rest vh) (framebuffer-virtual-size) 728 (destructuring-bind (x1 y1 x2 y2) (window-edges (get-buffer-window) t) 729 (let* ((fw (frame-width)) 730 (fh (frame-height)) 731 (stride (framebuffer-stride)) 732 (cw (floor fbw fw)) 733 (ch (floor fbh fh)) 734 (wx (* x1 cw)) 735 (wy (* y1 ch)) 736 (ww (* (- x2 x1) cw)) 737 (wh (* (- y2 y1) ch))) 738 (with-temp-buffer 739 (set-buffer-multibyte nil) 740 (insert-file-contents-literally "/dev/fb0") 741 (ecase (framebuffer-bits-per-pixel) 742 (32 743 (dotimes (y wh) 744 (goto-char (+ (point-min) (* stride (+ y wy)) (* 4 wx))) 745 (dotimes (x ww) 746 (delete-char 4) 747 (insert (mod x 256)) 748 (insert (mod y 256)) 749 (insert (random 256)) 750 (insert 0))))) 751 (let ((coding-system-for-write 'raw-text-unix)) 752 (write-region (point-min) (point-max) "/dev/fb0")))))))) 753 754 (defun framebuffer-screenshot (file) 755 (interactive 756 (list 757 (read-string "File: " 758 (expand-file-name 759 (format-time-string "screenshot-%Y%m%d-%H%M%S.ppm") 760 (or framebuffer-screenshot-directory 761 (temporary-file-directory)))))) 762 (destructuring-bind (w &rest h) (framebuffer-size) 763 (destructuring-bind (vw &rest vh) (framebuffer-virtual-size) 764 (with-temp-buffer 765 (set-buffer-multibyte nil) 766 (insert-file-contents-literally "/dev/fb0") 767 (let ((bpp (framebuffer-bits-per-pixel)) 768 (stride (framebuffer-stride)) 769 (fb (current-buffer))) 770 (with-temp-buffer 771 (set-buffer-multibyte nil) 772 (ecase (framebuffer-file-format file) 773 (pbm 774 (insert "P4\n") 775 (insert (format "%d %d\n" w h)) 776 (ecase bpp 777 (32 778 (dotimes (y h) 779 (with-current-buffer fb 780 (goto-char (+ (point-min) (* stride y)))) 781 (let ((i 0) 782 (n 0)) 783 (dotimes (x w) 784 (let (r g b a) 785 (with-current-buffer fb 786 (setq b (char-after) 787 g (char-after (goto-char (1+ (point)))) 788 r (char-after (goto-char (1+ (point)))) 789 a (char-after (goto-char (1+ (point))))) 790 (goto-char (1+ (point)))) 791 (setq n (+ (ash n 1) (if (plusp (+ r g b)) 1 0))) 792 (incf i) 793 (unless (< i 8) 794 (insert n) 795 (setq i 0 796 n 0)))) 797 (when (< i 8) 798 (insert n)))))) 799 (let ((coding-system-for-write 'raw-text-unix)) 800 (write-region (point-min) (point-max) file))) 801 (pgm 802 (insert "P5\n") 803 (insert (format "%d %d\n" w h)) 804 (insert "255\n") 805 (ecase bpp 806 (32 807 (dotimes (y h) 808 (with-current-buffer fb 809 (goto-char (+ (point-min) (* stride y)))) 810 (dotimes (x w) 811 (let (r g b a) 812 (with-current-buffer fb 813 (setq b (char-after) 814 g (char-after (goto-char (1+ (point)))) 815 r (char-after (goto-char (1+ (point)))) 816 a (char-after (goto-char (1+ (point))))) 817 (goto-char (1+ (point)))) 818 (insert (floor (+ r g b) 3))))))) 819 (let ((coding-system-for-write 'raw-text-unix)) 820 (write-region (point-min) (point-max) file))) 821 (ppm 822 (insert "P6\n") 823 (insert (format "%d %d\n" w h)) 824 (insert "255\n") 825 (ecase bpp 826 (32 827 (dotimes (y h) 828 (with-current-buffer fb 829 (goto-char (+ (point-min) (* stride y)))) 830 (dotimes (x w) 831 (let (r g b a) 832 (with-current-buffer fb 833 (setq b (char-after) 834 g (char-after (goto-char (1+ (point)))) 835 r (char-after (goto-char (1+ (point)))) 836 a (char-after (goto-char (1+ (point))))) 837 (goto-char (1+ (point)))) 838 (insert r g b)))))) 839 (let ((coding-system-for-write 'raw-text-unix)) 840 (write-region (point-min) (point-max) file))))))))) 841 (find-file file)) 842 843 (provide 'emacs-framebuffer)