Merge pull request #822 from gracjan/pr-anims-in-docs

Add animations to documentation

Makefile

@@ -151,7 +151,16 @@ 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 : doc/html/index.html doc/html/haskell-mode.css doc/html/haskell-mode.svg doc/html/haskell-mode-32x32.png
+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
+
 
 deploy-manual : doc/html
  cd doc && ./deploy-manual.sh

doc/gifcasts/get-window-id.m

@@ -0,0 +1,15 @@
+
+#include <Cocoa/Cocoa.h>
+#include <CoreGraphics/CGWindow.h>
+
+int main(int argc, char **argv)
+{
+ NSArray *windows = (NSArray *)CGWindowListCopyWindowInfo(kCGWindowListExcludeDesktopElements,kCGNullWindowID);
+ for(NSDictionary *window in windows) {
+ if ([[window objectForKey:(NSString *)kCGWindowOwnerPID] isEqual:[NSNumber numberWithLongLong:atoi(argv[1])]]) {
+ if ([[window objectForKey:(NSString *)kCGWindowName] isEqual:[NSString stringWithUTF8String:argv[2]]]) {
+ printf("%d\n", [[window objectForKey:(NSString *)kCGWindowNumber] intValue]);
+ }
+ }
+ }
+}

doc/gifcasts/gifcast.el

@@ -0,0 +1,182 @@
+;;; haskell-mode.el --- A Haskell editing mode -*- coding: utf-8 -*-
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc
+;; Copyright (C) 1992, 1997-1998 Simon Marlow, Graeme E Moss, and Tommy Thorn
+
+;; Author: 2015 Gracjan Polak <gracjanpolak@gmail.com>
+;; Keywords: screencast
+;; Version: 0.1
+
+;; This file 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, or (at your option)
+;; any later version.
+
+;; This file 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:
+
+;; Library for Emacs screencasts. Code you execution in lisp, sprinkle
+;; with capture functions, generate upload ready gif animations.
+
+;;; Code:
+
+(defvar gifcast--ns-current-frame-window-id nil
+ "Mac OSX native window id of the current frame.")
+
+(defvar gifcast--animation-frame-index nil
+ "Current animation frame index.")
+
+(defvar gifcast--action-list nil
+ "Actions to run on timer.
+
+List of lambdas or functions.
+
+On next timer tick (car gifcast--action-list) will be run and
+removed from this list.
+
+Note that it is useful both to prepend actions (to be run next)
+and append actions (to be run later, after everything already in the list has run.")
+
+(defun gifcast--run-next-action ()
+ "Run next action in gifcast--action-list.
+
+Will start timer if needed to run follow up actions."
+ (when (consp gifcast--action-list)
+ (let ((c (car gifcast--action-list)))
+ (setq gifcast--action-list (cdr gifcast--action-list))
+ (funcall c)
+ (run-at-time 0.1 nil #'gifcast--run-next-action))))
+
+(defun gifcast-append-action (action)
+ "Schedule ACTION to be run after all already scheduled actions."
+ (when (null gifcast--action-list)
+ (run-at-time 0.1 nil #'gifcast--run-next-action))
+ (setq gifcast--action-list (append gifcast--action-list (list action))))
+
+(defun gifcast-prepend-action (action)
+ "Schedule ACTION to be run before other already scheduled actions."
+ (when (null gifcast--action-list)
+ (run-at-time 0.1 nil #'gifcast--run-next-action))
+ (setq gifcast--action-list (cons action gifcast--action-list)))
+
+(defun gifcast--ns-get-current-frame-window-id ()
+ "Get native Mac OS X window id of the current frame."
+
+ (with-temp-file "get-window-id.m"
+ (insert "
+#include <Cocoa/Cocoa.h>
+#include <CoreGraphics/CGWindow.h>
+
+int main(int argc, char **argv)
+{
+ NSArray *windows = (NSArray *)CGWindowListCopyWindowInfo(kCGWindowListExcludeDesktopElements,kCGNullWindowID);
+ for(NSDictionary *window in windows) {
+ if ([[window objectForKey:(NSString *)kCGWindowOwnerPID] isEqual:[NSNumber numberWithLongLong:atoi(argv[1])]]) {
+ if ([[window objectForKey:(NSString *)kCGWindowName] isEqual:[NSString stringWithUTF8String:argv[2]]]) {
+ printf(\"%d\\n\", [[window objectForKey:(NSString *)kCGWindowNumber] intValue]);
+ }
+ }
+ }
+}
+"))
+ (with-current-buffer "*Messages*"
+ (call-process "clang" nil t nil
+ "get-window-id.m" "-o" "get-window-id" "-framework" "CoreGraphics" "-framework" "Cocoa"))
+ (chmod "get-window-id" #o755)
+ (catch 'return
+ (with-temp-buffer
+ (dolist (x '(1))
+
+ (call-process (concat default-directory "get-window-id") nil t nil (number-to-string (emacs-pid))
+ (cdr (assoc 'name (frame-parameters (window-frame (get-buffer-window))))))
+
+ (goto-char (point-min))
+ (if (looking-at "[0-9]+")
+ (throw 'return (match-string 0))
+ (sit-for 1))))))
+
+(defun gifcast--ns-capture (filename)
+ "Capture sceenshot of current frame and save it to FILENAME.
+
+Image format will be png."
+ (with-current-buffer "*Messages*"
+ (let ((args (list (concat "-l" gifcast--ns-current-frame-window-id) "-o" filename))
+ (buffer-read-only nil))
+
+ (apply #'call-process "screencapture" nil t nil args))))
+
+(defmacro gifcast-animate (&rest body)
+ "Entry point for animation definitions.
+
+Use at top level like this:
+
+(gifcast-animate
+ (set-frame-size (window-frame (get-buffer-window)) 40 10)
+ (when (get-buffer \"main.c\") (kill-buffer \"main.c\"))
+ (switch-to-buffer (get-buffer-create \"main.c\"))
+ (delete-other-windows)
+ (tabbar-mode -1)
+ (tool-bar-mode -1)
+ (blink-cursor-mode -1)
+ (my-mode)
+
+ ...generate animation frames..
+ )
+"
+ `(gifcast-append-action
+ (lambda ()
+ (unless gifcast--ns-current-frame-window-id
+ (setq gifcast--ns-current-frame-window-id (gifcast--ns-get-current-frame-window-id)))
+
+ (setq gifcast--animation-frame-index 1)
+
+ ,@body)))
+
+(defmacro gifcast-keys-async (keys &rest body)
+ "Simulate keystrokes KEYS and continue with BODY.
+
+Append KEYS to `unread-command-events' and let the main loop take
+over. This requires function exit and continuing after a
+timer. BODY is executed after 0.1s has elapsed.
+
+Note that this is async programming so requires proper bookeeping
+with repsect to current buffer, state and local variables.
+"
+ `(progn
+ (setq unread-command-events (append unread-command-events (listify-key-sequence ,keys)))
+ (gifcast-prepend-action (lambda () ,@body))))
+
+(defun gifcast-capture ()
+ "Capture current frame.
+
+Capture file will be named based on internal index variable."
+ (sit-for 0.1)
+ (gifcast--ns-capture (concat "frame-" (number-to-string gifcast--animation-frame-index) ".png"))
+ (setq gifcast--animation-frame-index (1+ gifcast--animation-frame-index)))
+
+(defun gifcast-generate (filename)
+ "Generate animation to FILENAME.
+
+Takes frames collected since last `gifcast-animate' and generate
+a GIF animation. FILENAME will be used as a file name for the
+animation."
+ (with-current-buffer "*Messages*"
+ (let ((idx 1)
+ args
+ (buffer-read-only nil))
+ (while (< idx gifcast--animation-frame-index)
+ (setq args (append args (list (concat "frame-" (number-to-string idx) ".png"))))
+ (setq idx (1+ idx)))
+
+ (apply #'call-process "convert" nil t nil
+ (append (list "-delay" "100") args (list "-layers" "OptimizePlus" "-alpha" "remove" filename))))))
+
+(provide 'gifcast)
+;;; gifcast ends here

doc/gifcasts/gifcasts.el

@@ -0,0 +1,79 @@
+
+(let ((load-path '(".")))
+ (require 'gifcast))
+
+(global-flycheck-mode -1)
+
+(gifcast-animate
+ (set-frame-size (window-frame (get-buffer-window)) 40 10)
+ (when (get-buffer "Main.hs")
+ (kill-buffer "Main.hs"))
+ (switch-to-buffer (get-buffer-create "Main.hs"))
+ (delete-other-windows)
+ (tabbar-mode -1)
+ (tool-bar-mode -1)
+ (linum-mode -1)
+ (message nil)
+
+ (haskell-mode)
+
+ (insert (concat
+ "-- | Program entry point\n"
+ "main :: IO ()\n"
+ "main = do\n"
+ " if flag\n"
+ " then putStrLn \"Flag is True\"\n"
+ " else putStrLn \"Flag is False\"\n"
+ ))
+ (global-font-lock-mode -1)
+ (gifcast-capture)
+ (global-font-lock-mode t)
+ (gifcast-capture)
+ (gifcast-generate "../anim/font-lock.gif")
+ (kill-buffer "Main.hs")
+ nil)
+
+(gifcast-animate
+ (set-frame-size (window-frame (get-buffer-window)) 40 10)
+ (when (get-buffer "Main.hs")
+ (kill-buffer "Main.hs"))
+ (switch-to-buffer (get-buffer-create "Main.hs"))
+ (delete-other-windows)
+ (tabbar-mode -1)
+ (tool-bar-mode -1)
+ (linum-mode -1)
+ (blink-cursor-mode -1)
+ (message nil)
+
+ (haskell-mode)
+ (company-mode)
+ (setq company-idle-delay 0.01)
+ (linum-mode -1)
+
+ (insert (concat
+ "{-# LANGUAGE #-}\n"
+ "main :: IO ()\n"
+ "main = return ()\n"))
+ (goto-char (+ 13 (point-min)))
+ (gifcast-keys-async
+ ""
+ (gifcast-capture)
+ (gifcast-keys-async
+ "F"
+ (gifcast-capture)
+ (gifcast-keys-async
+ "l"
+ (gifcast-capture)
+ (gifcast-keys-async
+ "e"
+ (gifcast-capture)
+ (gifcast-keys-async
+ (kbd "<down>")
+ (gifcast-capture)
+ (gifcast-keys-async
+ "\C-m"
+ (gifcast-capture)
+ (gifcast-generate "../anim/company-mode-language-pragma.gif")
+
+ (kill-buffer "Main.hs")))))))
+ nil)

doc/haskell-mode.texi

@@ -205,6 +205,19 @@ Lock minor mode which should be enabled by default in current
 Emacsen. @xref{Font Lock,,,emacs}, for more information on how to
 control @code{font-lock-mode}.
 
+@ifhtml
+@image{anim/font-lock}
+@end ifhtml
+
+@section Completion support
+
+@code{haskell-mode} can complete symbols, pragma directives and language
+extensions. This is part of @code{haskell-interactive-mode}.
+
+@ifhtml
+@image{anim/company-mode-language-pragma}
+@end ifhtml
+
 @node Unicode support
 @chapter Unicode support