From 6ac2c7cfef2eecd176ed94f398319dbf10d7fdc7 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 20 Jun 2014 19:09:54 -0500
Subject: [PATCH] add abbreviate-given-names
This changes the behavior of make-cite and authors, but it would
probably be better to change the behavior of generate-bibliography
original commit: 74831b41cc2589af94a4e7cc6ffefa1d8809226c
---
.../scriblib/scribblings/autobib.scrbl | 8 +++++
.../scribble-lib/scriblib/autobib.rkt | 36 +++++++++++++++----
2 files changed, 38 insertions(+), 6 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-doc/scriblib/scribblings/autobib.scrbl b/pkgs/scribble-pkgs/scribble-doc/scriblib/scribblings/autobib.scrbl
index 8f4617c1..94a15bb3 100644
--- a/pkgs/scribble-pkgs/scribble-doc/scriblib/scribblings/autobib.scrbl
+++ b/pkgs/scribble-pkgs/scribble-doc/scriblib/scribblings/autobib.scrbl
@@ -222,3 +222,11 @@ one created by @racket[other-authors] renders as ``et al.''}
Takes an author-name element and create one that represents the editor
of a collection. If a @racket[name] is a string, it is parsed in the
same way as by @racket[make-bib].}
+
+@defparam[abbreviate-given-names abbreviate? any/c]{
+ Shortens given names in calls to @racket[author] and @racket[make-bib]
+ to just the first initial when the parameter value is not @racket[#f].
+ Otherwise, does not change the author names.
+
+ Defaults to @racket[#f].
+}
diff --git a/pkgs/scribble-pkgs/scribble-lib/scriblib/autobib.rkt b/pkgs/scribble-pkgs/scribble-lib/scriblib/autobib.rkt
index d26f9d8d..30bbad6e 100644
--- a/pkgs/scribble-pkgs/scribble-lib/scriblib/autobib.rkt
+++ b/pkgs/scribble-pkgs/scribble-lib/scriblib/autobib.rkt
@@ -22,7 +22,10 @@
(contract-out
[authors (->* (content?) #:rest (listof content?) element?)])
other-authors
- editor)
+ editor
+ abbreviate-given-names)
+
+(define abbreviate-given-names (make-parameter #f))
(define autobib-style-extras
(let ([abs (lambda (s)
@@ -443,14 +446,30 @@
[else
(define s (content->string a)) ;; plain text rendering
(define m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s))
+ (define given-names (and m (cadr m)))
+ (define family-name (and m (caddr m)))
(define names
- (cond [m (string-append (caddr m) " " (cadr m))]
+ (cond [m (string-append family-name " " given-names)]
[else s]))
(define cite
(cond [m (caddr m)]
[else s]))
- (make-author-element #f (list a) names cite)]))
+ (define element-content
+ (cond
+ [(and given-names (abbreviate-given-names))
+ (string-append (given-names->initials given-names) family-name)]
+ [else a]))
+ (make-author-element #f (list element-content) names cite)]))
+(define (given-names->initials str)
+ (regexp-replace* #rx"(.)[^ ]*( |$)" str "\\1. "))
+
+(module+ test
+ (require rackunit)
+ (check-equal? (given-names->initials "Matthew") "M. ")
+ (check-equal? (given-names->initials "Matthew R.") "M. R. ")
+ (check-equal? (given-names->initials "Matthew Raymond") "M. R. "))
+
(define (proceedings-location
location
#:pages [pages #f]
@@ -516,9 +535,14 @@
(make-author-element
#f
(list
- (format "~a ~a~a" first last (if suffix
- (format " ~a" suffix)
- "")))
+ (format "~a ~a~a"
+ (if (abbreviate-given-names)
+ (given-names->initials first)
+ first)
+ last
+ (if suffix
+ (format " ~a" suffix)
+ "")))
(format "~a ~a~a" last first (if suffix
(format " ~a" suffix)
""))