From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
 skr/jfp.skr | 317 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 317 insertions(+)
 create mode 100644 skr/jfp.skr

(limited to 'skr/jfp.skr')

diff --git a/skr/jfp.skr b/skr/jfp.skr
new file mode 100644
index 0000000..60b40f2
--- /dev/null
+++ b/skr/jfp.skr
@@ -0,0 +1,317 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/skr/jfp.skr                          */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Sep 28 14:40:38 2003                          */
+;*    Last change :  Mon Oct 11 15:44:08 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Skribe style for JFP articles.                               */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    LaTeX global customizations                                      */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+   (engine-custom-set! le 'documentclass "\\documentclass{jfp}")
+   (engine-custom-set! le 'hyperref #f)
+   ;; &latex-author
+   (markup-writer '&latex-author le
+      :action (lambda (n e)
+		 (define (&latex-subauthor)
+		    (let* ((d (ast-document n))
+			   (sa (and (is-markup? d 'document)
+				    (markup-option d :head-author))))
+		       (if sa
+			   (begin
+			      (display "[")
+			      (output sa e)
+			      (display "]")))))
+		 (define (&latex-author-1 n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output n e)
+		    (display "}\n"))
+		 (define (&latex-author-n n)
+		    (display "\\author")
+		    (&latex-subauthor)
+		    (display "{\n")
+		    (output (car n) e)
+		    (for-each (lambda (a)
+				 (display "\\and ")
+				 (output a e))
+			      (cdr n))
+		    (display "}\n"))
+		 (let ((body (markup-body n)))
+		    (cond
+		       ((is-markup? body 'author)
+			(&latex-author-1 body))
+		       ((and (list? body)
+			     (every? (lambda (b) (is-markup? b 'author))
+				     body))
+			(&latex-author-n body))
+		       (else
+			(skribe-error 'author
+				      "Illegal `jfp' author"
+				      body))))))
+   ;; title
+   (markup-writer '&latex-title le
+      :before (lambda (n e)
+		 (let* ((d (ast-document n))
+			(st (and (is-markup? d 'document)
+				 (markup-option d :head-title))))
+		    (if st
+			(begin
+			   (display "\\title[")
+			   (output st e)
+			   (display "]{"))
+			(display "\\title{"))))
+      :after "}\n")
+   ;; author
+   (let ((old-author (markup-writer-get 'author le)))
+      (markup-writer 'author le
+         :options (writer-options old-author)		     
+         :action (lambda (n e)
+		    (let ((name (markup-option n :name))
+			  (aff (markup-option n :affiliation))
+			  (addr (markup-option n :address))
+			  (email (markup-option n :email)))
+		       (if name
+			   (begin
+			      (output name e)
+			      (display "\\\\\n")))
+		       (if aff
+			   (begin
+			      (output aff e)
+			      (display "\\\\\n")))
+		       (if addr
+			   (begin
+			      (if (pair? addr)
+				  (for-each (lambda (a)
+					       (output a e)
+					       (display "\\\\\n"))
+					    addr)
+				  (begin
+				     (output addr e)
+				     (display "\\\\\n")))))
+		       (if email
+			   (begin
+			      (display "\\email{")
+			      (output email e)
+			      (display "}\\\\\n")))))))
+   ;; bib-ref
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :before "("
+      :action (lambda (n e)
+		 (let ((be (handle-ast (markup-body n))))
+		    (if (is-markup? be '&bib-entry)
+			(let ((a (markup-option be 'author))
+			      (y (markup-option be 'year)))
+			   (cond
+			      ((and (is-markup? a '&bib-entry-author)
+				    (is-markup? y '&bib-entry-year))
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)
+					 (display ", ")
+					 (output y e)))))
+			      ((is-markup? y '&bib-entry-year)
+			       (skribe-error 'bib-ref
+					     "Missing `name' entry"
+					     (markup-ident be)))
+			      (else
+			       (let ((ba (markup-body a)))
+				  (if (not (string? ba))
+				      (output ba e)
+				      (let* ((s1 (pregexp-replace* " and "
+								   ba
+								   " \\& "))
+					     (s2 (pregexp-replace* ", [^ ]+"
+								   s1
+								   "")))
+					 (output s2 e)))))))
+			(skribe-error 'bib-ref
+				      "Illegal bib-ref"
+				      (markup-ident be)))))
+      :after ")")
+      ;; bib-ref/text
+   (markup-writer 'bib-ref le
+      :options '(:bib :text :key)
+      :predicate (lambda (n e)
+		    (markup-option n :key))
+      :action (lambda (n e)
+		 (output (markup-option n :key) e)))
+   ;; &the-bibliography
+   (markup-writer '&the-bibliography le
+      :before (lambda (n e)
+		 (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+        \\settowidth\\labelwidth{[]}%
+        \\leftmargin\\labelwidth
+        \\advance\\leftmargin\\labelsep
+        \\advance\\leftmargin\\bibindent
+        \\itemindent -\\bibindent
+        \\listparindent \\itemindent
+    }%\n"))
+      :after (lambda (n e)
+		(display "\n\\end{list}}\n")))
+   ;; bib-entry
+   (markup-writer '&bib-entry le
+      :options '(:title)
+      :action (lambda (n e)
+		 (output n e (markup-writer-get '&bib-entry-body e)))
+      :after "\n")
+   ;; %bib-entry-title
+   (markup-writer '&bib-entry-title le
+      :action (lambda (n e)
+		 (output (markup-body n) e)))
+   ;; %bib-entry-body
+   (markup-writer '&bib-entry-body le
+      :action (lambda (n e)
+		 (define (output-fields descr)
+		    (display "\\item[")
+		    (let loop ((descr descr)
+			       (pending #f)
+			       (armed #f)
+			       (first #t))
+		       (cond
+			  ((null? descr)
+			   'done)
+			  ((pair? (car descr))
+			   (if (eq? (caar descr) 'or)
+			       (let ((o1 (cadr (car descr))))
+				  (if (markup-option n o1)
+				      (loop (cons o1 (cdr descr)) 
+					    pending 
+					    #t
+					    #f)
+				      (let ((o2 (caddr (car descr))))
+					 (loop (cons o2 (cdr descr)) 
+					       pending
+					       armed
+					       #f))))
+			       (let ((o (markup-option n (cadr (car descr)))))
+				  (if o
+				      (begin
+					 (if (and pending armed)
+					     (output pending e))
+					 (output (caar descr) e)
+					 (output o e)
+					 (if (pair? (cddr (car descr)))
+					     (output (caddr (car descr)) e))
+					 (loop (cdr descr) #f #t #f))
+				      (loop (cdr descr) pending armed #f)))))
+			  ((symbol? (car descr))
+			   (let ((o (markup-option n (car descr))))
+			      (if o 
+				  (begin
+				     (if (and armed pending)
+					 (output pending e))
+				     (output o e)
+				     (if first
+					 (display "]"))
+				     (loop (cdr descr) #f #t #f))
+				  (loop (cdr descr) pending armed #f))))
+			  ((null? (cdr descr))
+			   (output (car descr) e))
+			  ((string? (car descr))
+			   (loop (cdr descr) 
+				 (if pending pending (car descr))
+				 armed
+				 #f))
+			  (else
+			   (skribe-error 'output-bib-fields
+					 "Illegal description"
+					 (car descr))))))
+		 (output-fields
+		  (case (markup-option n 'kind)
+		     ((techreport)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       number ", " institution ", "
+			       address ", " month ", "
+			       ("pp. " pages) "."))
+		     ((article)
+		      `(author (" (" year ")") " " (or title url) ". "
+			       journal ", " volume ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((inproceedings)
+		      `(author (" (" year ")") " " (or title url) ". " 
+			       book(or title url) ", " series ", " ("(" number ")") ", "
+			       address ", " month ", " 
+			       ("pp. " pages) "."))
+		     ((book)
+		      '(author (" (" year ")") " " (or title url) ". " 
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))
+		     ((phdthesis)
+		      '(author (" (" year ")") " " (or title url) ". " type ", " 
+			       school ", " address
+			       ", " month "."))
+		     ((misc)
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month "."))
+		     (else
+		      '(author (" (" year ")") " " (or title url) ". "
+			       publisher ", " address
+			       ", " month ", " ("pp. " pages) "."))))))
+   ;; abstract
+   (markup-writer 'jfp-abstract le
+       :options '(postscript)
+       :before "\\begin{abstract}\n"
+       :after "\\end{abstract}\n"))
+
+;*---------------------------------------------------------------------*/
+;*    HTML global customizations                                       */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+   (markup-writer '&html-jfp-abstract he
+      :action (lambda (n e)
+		 (let* ((bg (engine-custom e 'abstract-background))
+                        (exp (p (if bg
+				    (center (color :bg bg :width 90. 
+					       (it (markup-body n))))
+				    (it (markup-body n))))))
+                    (skribe-eval exp e)))))
+		 
+;*---------------------------------------------------------------------*/
+;*    abstract ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (abstract #!rest opt #!key postscript)
+   (if (engine-format? "latex")
+       (new markup
+	  (markup 'jfp-abstract)
+	  (body (p (the-body opt))))
+       (let ((a (new markup
+		   (markup '&html-jfp-abstract)
+		   (body (the-body opt)))))
+	  (list (if postscript
+		    (section :number #f :toc #f :title "Postscript download"
+                             postscript))
+		(section :number #f :toc #f :title "Abstract" a)
+		(section :number #f :toc #f :title "Table of contents"
+                         (toc :subsection #t))))))
+
+;*---------------------------------------------------------------------*/
+;*    references ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (references)
+   (list "\n\n"
+	 (section :title "References" :class "references"
+	    :number (not (engine-format? "latex"))
+	    (font :size -1 (the-bibliography)))))
+
-- 
cgit v1.2.3