emacs-framebuffer

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

emacs-framebuffer.el (35571B)


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