external/smarkup/src/smarkup.cl

   1 ;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;;
   2 ;;;
   3 ;;; file: smarkup-asdf.cl
   4 ;;; author: cyrus harmon
   5 ;;;
   6
   7 ;;; miscellaneous functions
   8
   9 (in-package #:smarkup)
  10
  11 (defgeneric render-as (type sexp file))
  12
  13 (defun remove-from-plist (plist &rest keys)
  14   (cond ((eql (length keys) 1)
  15          (loop for (x y) on plist by #'cddr
  16             append (unless (eql x (car keys))
  17                      (list x y))))
  18         ((> (length keys) 1)
  19          (reduce (lambda (&optional plist x)
  20                    (when x (remove-from-plist plist x)))
  21                  (cons plist keys)))))
  22
  23 (defun remove-pair-from-list (list key)
  24   (let ((pos (position key list)))
  25     (if pos
  26         (append (subseq list 0 pos)
  27                 (subseq list (+ pos 2))))))
  28
  29 (defun find-file-for-types (default-file types)
  30   (loop for type in types
  31      do (let ((path (merge-pathnames (make-pathname :type type) default-file)))
  32           (when (probe-file path)
  33             (return path)))))
  34
  35 (defparameter *images-per-line* 5)
  36 (defparameter *images-per-page* 30)
  37
  38 (defun multi-line-figure (image-sequence
  39                           caption
  40                           &key
  41                           label
  42                           (start 0)
  43                           (end)
  44                           (images-per-line *images-per-line*)
  45                           (width "1.1in"))
  46   (let* ((image-sequence
  47           (mapcan #'(lambda (x)
  48                       (when x (list x)))
  49                   image-sequence))
  50          (end (or end (1- (length image-sequence)))))
  51     (when (some #'identity image-sequence)
  52       `(:figure
  53         ,@(when label `(:label ,label))
  54         (:centering
  55          ,@(loop for i from start to end by images-per-line
  56               collect
  57               `(:subfigure
  58                 ,@(loop
  59                      for j from i to (min (+ i images-per-line -1) end)
  60                      collect
  61                      (let ((img (elt image-sequence j)))
  62                        `(:image ,(namestring img)
  63                                 :width ,width))))))
  64         ,(when caption `(:caption ,@(if (listp caption) caption (list caption))))))))
  65
  66
  67 (defun multi-multi-line-figure (image-sequence
  68                                 &key
  69                                 caption
  70                                 (first-caption caption)
  71                                 (start 0)
  72                                 (end)
  73                                 (images-per-line *images-per-line*)
  74                                 (images-per-page *images-per-page*)
  75                                 (width "1in"))
  76   (let* ((image-sequence
  77           (mapcan #'(lambda (x)
  78                       (when x (list x)))
  79                   image-sequence))
  80          (end (or end (1- (length image-sequence)))))
  81     `(:span
  82       ,@(loop for i from start to end by images-per-page
  83            collect
  84            (multi-line-figure image-sequence (if (= i start)
  85                                                  first-caption
  86                                                  caption)
  87                               :start i :end (min (+ i images-per-page -1) end)
  88                               :images-per-line images-per-line
  89                               :width width)))))
  90
  91
  92 #+nil
  93 (defun multi-line-subfigure (image-sequence
  94                              &key
  95                              caption
  96                              (start 0)
  97                              (end (1- (length image-sequence)))
  98                              (images-per-line *images-per-line*)
  99                              (width "1in"))
 100   (when (some #'identity image-sequence)
 101     `(:subfigure
 102       ,@(loop for i from start to end by images-per-line
 103            append
 104            (append
 105             (loop
 106                for j from i to (min (+ i images-per-line -1) end)
 107                collect
 108                (let ((img (elt image-sequence j)))
 109                  `(:image ,(namestring img)
 110                           :width ,width)))
 111             `((:p)
 112               (:p))))
 113       ,@(when caption `(:caption ,caption)))))
 114
 115 (defun multi-line-subfigure (image-sequence
 116                              &key
 117                              caption
 118                              (start 0)
 119                              (end (1- (length image-sequence)))
 120                              (images-per-line *images-per-line*)
 121                              increment-counter
 122                              (width "1in"))
 123   (when (some #'identity image-sequence)
 124     (append
 125      (loop for i from start to end by images-per-line
 126         collect
 127           (cons
 128            :subfigure
 129            (append
 130             (loop
 131                for j from i to (min (+ i images-per-line -1) end)
 132                collect
 133                (let ((img (elt image-sequence j)))
 134                  `(:image ,(namestring img)
 135                           :width ,width)))
 136             (if (and caption (> (+ i images-per-line) end))
 137                 `(:caption ,caption)
 138                 (unless increment-counter
 139                   `(:increment-counter nil)))))))))