File: macros.lisp

package info (click to toggle)
cedilla 0.6-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 812 kB
  • ctags: 308
  • sloc: lisp: 3,716; makefile: 50; sh: 13
file content (56 lines) | stat: -rw-r--r-- 2,093 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
;;; This file is part of Cedilla.
;;; Copyright (C) 2002 by Juliusz Chroboczek.

;;; 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 2 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.

(in-package "CEDILLA")

(defparameter *cedilla-version* "0.6")

(defmacro define-fontset (name spec)
  (let ((symbol (gensym "SYMBOL")))
    `(let ((,symbol (intern (string-upcase (string ,name)) "CEDILLA")))
      (setf (get ,symbol 'fontset) ,spec)
      ,symbol)))

(defmacro define-paper-size (name x y
                                  &key
                                  left-margin
                                  top-margin
                                  right-margin
                                  bot-margin)
  (let ((symbol (gensym "SYMBOL")))
    `(flet ((in (x) (* x 72))
            (cm (x) (/ (* x 72) 2.54)))
      (let ((,symbol (intern (string-upcase (string ,name)) "CEDILLA")))
        (setf (get ,symbol 'paper-size)
              (make-paper-size 
               :x0 0 :y0 0 :x1 ,x :y1 ,y
               :left-margin (or ,left-margin (cm 1.5))
               :top-margin (or ,top-margin (cm 1.5))
               :right-margin (or ,right-margin (cm 1))
               :bot-margin (or ,bot-margin (cm 1.5))))
        ,symbol))))

(defvar *cedilla-verbose* nil)

(defmacro when-verbose (&body body)
  `(when *cedilla-verbose*
    ,@body))

(defmacro with-open-file-or-stream ((var filename &rest args) &body body)
  (let ((b (gensym "BODY")) (f-name (gensym "FILENAME")))
    `(flet ((,b (,var) ,@body))
      (let ((,f-name ,filename))
        (if (streamp ,f-name)
            (,b ,f-name)
            (with-open-file (,var ,filename ,@args)
              (,b ,var)))))))