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 "
"
+ (/ (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))