woff.el

;;; woff.el --- Show information about Web Open Font Format files

;; Copyright (C) 2015  David Maus

;; Author: David Maus <[email protected]>
;; Keywords: files, hypermedia, multimedia

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; 

;;; Code:

(defun woff--read-byte ()
  (prog1 (char-after (point))
    (forward-char)))

(defun woff--read-bytes (width)
  (let ((value 0))
    (dotimes (count width value)
      (setq value (+ (ash value 8)
                     (or (woff--read-byte)
                         (error "Premature end of file")))))))

(defun woff--read-uint16 ()
  (woff--read-bytes 2))

(defun woff--read-uint32 ()
  (woff--read-bytes 4))

(defun woff--as-keyword (symbol)
  (intern (concat ":" (symbol-name symbol))))

(defun woff--slot->readspec (slot)
  `(,(woff--as-keyword (first slot)) (,(intern (concat "woff--read-" (symbol-name (second slot)))))))

(defmacro woff-defstruct (name slots)
  `(progn
     (cl-defstruct (,name (:constructor ,(intern (concat "woff--make-" (symbol-name name)))))
       ,@(mapcar #'car slots))

     (defun woff-header-create (&optional buffer)
       (with-current-buffer (or buffer (current-buffer))
         (,(intern (concat "woff--make-" (symbol-name name)))
          ,@(mapcan #'woff--slot->readspec slots))
         )
       )
     
     ))

(woff-defstruct woff-header ((signature      uint32)
                             (flavor         uint32)
                             (length         uint32)
                             (numTables      uint16)
                             (reserved       uint16)
                             (totalSfntSize  uint32)
                             (majorVersion   uint16)
                             (minorVersion   uint16)
                             (metaOffset     uint32)
                             (metaLength     uint32)
                             (metaOrigLength uint32)
                             (privOffset     uint32)
                             (privLength     uint32)))

(defun woff-info ()
  (interactive)
  (when (not (string= "wOFF" (buffer-substring 1 5)))
    (error "WOFF 1.0 file signature missing"))
  (let ((header (woff-header-create)))
    (message "Flavor 0x%08X // Version %d.%d // %s"
             (woff-header-flavor header)
             (woff-header-majorVersion header)
             (woff-header-minorVersion header)
             (if (> (woff-header-metaOffset header) 0)
                 (format "Metadata at offset %8X" (woff-header-metaOffset header))
               "No Metadata"))))

(provide 'woff)

;;; woff.el ends here