diff --git a/Makefile b/Makefile index 048134578..b5a4958fd 100644 --- a/Makefile +++ b/Makefile @@ -136,15 +136,19 @@ haskell-mode.info: doc/haskell-mode.texi doc/haskell-mode.html: doc/haskell-mode.texi doc/haskell-mode.css LANG=en_US.UTF-8 $(MAKEINFO) $(MAKEINFO_FLAGS) --html --css-include=doc/haskell-mode.css --no-split -o $@ $< + $(BATCH) -l doc/haskell-manual-fixups.el -f haskell-manual-fixups-batch-and-exit $@ doc/html/index.html : doc/haskell-mode.texi if [ -e doc/html ]; then rm -r doc/html; fi + mkdir doc/html + cp -r doc/anim doc/html/anim LANG=en_US.UTF-8 $(MAKEINFO) $(MAKEINFO_FLAGS) --html \ --css-ref=haskell-mode.css \ -c AFTER_BODY_OPEN='
' \ -c EXTRA_HEAD='' \ -c SHOW_TITLE=0 \ -o doc/html $< + $(BATCH) -l doc/haskell-manual-fixups.el -f haskell-manual-fixups-batch-and-exit doc/html/*.html doc/html/haskell-mode.css : doc/haskell-mode.css doc/html/index.html cp $< $@ @@ -155,16 +159,10 @@ doc/html/haskell-mode.svg : images/haskell-mode.svg doc/html/index.html doc/html/haskell-mode-32x32.png : images/haskell-mode-32x32.png doc/html/index.html cp $< $@ -doc/html/anim : doc/anim doc/html/index.html - if [ -e $@ ]; then rm -r $@; fi - cp -r $< $@ - doc/html : doc/html/index.html \ doc/html/haskell-mode.css \ doc/html/haskell-mode.svg \ - doc/html/haskell-mode-32x32.png \ - doc/html/anim - + doc/html/haskell-mode-32x32.png deploy-manual : doc/html cd doc && ./deploy-manual.sh diff --git a/doc/anim/company-mode-import-statement.gif b/doc/anim/company-mode-import-statement.gif index beb58c466..975b4589f 100644 Binary files a/doc/anim/company-mode-import-statement.gif and b/doc/anim/company-mode-import-statement.gif differ diff --git a/doc/anim/company-mode-language-pragma.gif b/doc/anim/company-mode-language-pragma.gif index e842f740f..52eb10b48 100644 Binary files a/doc/anim/company-mode-language-pragma.gif and b/doc/anim/company-mode-language-pragma.gif differ diff --git a/doc/anim/font-lock.gif b/doc/anim/font-lock.gif index 23e603c34..e4db7171c 100644 Binary files a/doc/anim/font-lock.gif and b/doc/anim/font-lock.gif differ diff --git a/doc/anim/string-escape-highlight.gif b/doc/anim/string-escape-highlight.gif index e9668766f..023946448 100644 Binary files a/doc/anim/string-escape-highlight.gif and b/doc/anim/string-escape-highlight.gif differ diff --git a/doc/haskell-manual-fixups.el b/doc/haskell-manual-fixups.el new file mode 100644 index 000000000..c824018b6 --- /dev/null +++ b/doc/haskell-manual-fixups.el @@ -0,0 +1,77 @@ + + +(defun get-gif-dimensions (filename) + "Get GIF dimensions, return a cons of (w,h). + +Get GIF dimensions directly from binary. Does not need external +tools. + + +GIF Header + +Offset Length Contents + 0 3 bytes \"GIF\" + 3 3 bytes \"87a\" or \"89a\" + 6 2 bytes + 8 2 bytes + 10 1 byte bit 0: Global Color Table Flag (GCTF) + bit 1..3: Color Resolution + bit 4: Sort Flag to Global Color Table + bit 5..7: Size of Global Color Table: 2^(1+n) + 11 1 byte + 12 1 byte + 13 ? bytes + ? bytes + 1 bytes (0x3b)" + (interactive "fFile name:") + (with-current-buffer (get-buffer-create "*GIF*") + (set-buffer-multibyte nil) + (insert-file-contents-literally filename nil 0 10 t) + (when (not (looking-at-p "GIF8[79]a")) + (error "File '%s' is not a GIF" filename)) + (let ((result + (cons (+ (char-after 7) (* 256 (char-after 8))) + (+ (char-after 9) (* 256 (char-after 10)))))) + (if (called-interactively-p) + (message "Dimensions: %dx%d" (car result) (cdr result))) + result))) + +(defun haskell-manual-fixup-buffer (&optional buffer) + "Fix contents of HTML from makeinfo in a BUFFER. + +Currently it looks for image references and adds an explicit +width and height. GIFs are generate on Retina so their resolution +is double of what it should be. Here we halve it to compensate +dimensions and to keep it crisp when viewed on Retina again." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\"\\(.*\\)\"" nil t) + (let* ((filename (match-string-no-properties 1)) + (alttext (match-string-no-properties 2)) + (default-directory (file-name-directory (buffer-file-name))) + (dim (get-gif-dimensions filename)) + (img (format "\"%s\"" + (/ (car dim) 2) (/ (cdr dim) 2) filename alttext))) + (delete-region (match-beginning 0) (match-end 0)) + (insert img)))))) + +(defun haskell-manual-fixup-file (filename) + "Run `haskell-manual-fixup-buffer' on a file." + (interactive "fFile name:") + (with-temp-buffer + (insert-file-contents filename t) + (haskell-manual-fixup-buffer) + (when (buffer-modified-p) + (basic-save-buffer)))) + +(defun haskell-manual-fixups-batch-and-exit () + "Run `haskell-manual-fixup-buffer' on files given as arguments. + +Should be invoked as: + + emacs -l haskell-manual-fixups.el -f haskell-manual-fixups-batch-and-exit doc/html/*.html" + (dolist (filename command-line-args-left) + (haskell-manual-fixup-file filename)) + (kill-emacs 0))