emacs-framebuffer

Emacs library to show images and documents in console using Linux framebuffer
Log | Files | Refs

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)