;;;; -*- coding:utf-8 -*- ;;;;************************************************************************** ;;;;FILE: cv.lisp ;;;;LANGUAGE: Common-Lisp ;;;;SYSTEM: Common-Lisp ;;;;USER-INTERFACE: NONE ;;;;DESCRIPTION ;;;; ;;;; Generates my CV in HTML. ;;;; ;;;;AUTHORS ;;;; Pascal Bourguignon ;;;;MODIFICATIONS ;;;; 2007-06-27 Extracted the specific CV data to *.cv files. ;;;; 2006-12-04 Added this header. ;;;;BUGS ;;;;LEGAL ;;;; GPL ;;;; ;;;; Copyright Pascal Bourguignon 2006 - 2006 ;;;; ;;;; 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. ;;;; ;;;; You should have received a copy of the GNU General Public ;;;; License along with this program; if not, write to the Free ;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA ;;;;************************************************************************** (unless (find-package :html) (asdf:operate 'asdf:load-op :com.informatimago.common-lisp)) (defpackage "CV" (:use "CL" "COM.INFORMATIMAGO.COMMON-LISP.UTILITY")) (in-package "CV") ;;---------------------------------------------------------------------- ;; GENERATOR ;;---------------------------------------------------------------------- (defclass generator () ()) (defgeneric gen-document (generator genbody &key file-path title)) (defgeneric gen-text (generator text)) (defgeneric gen-section (generator genbody &key name title) (:documentation "The section name is used to generate anchors and links.")) (defgeneric gen-list (generator genbody &key type)) (defgeneric gen-list-item (generator genbody &key name)) (defgeneric gen-definition (generator term genbody &key name)) (defgeneric gen-link (generator genbody &key url)) (defvar *language* :en) (defvar *generator* nil "The current generator") (defvar *section* 0 "Used by gen-section methods to track the section level.") (defmacro document ((&key (generator '*generator*) (file-path "document") (title nil)) &body body) (with-gensyms (vgen) `(let ((,vgen ,generator)) (gen-document ,vgen (lambda () ,@body) :file-path ,file-path :title ,title)))) (defmacro section ((&key (generator '*generator*) (name nil) (title "Section")) &body body) (with-gensyms (vgen) `(let ((,vgen ,generator)) (gen-section ,generator (lambda () ,@body) :name ,name :title ,title)))) (defmacro bullet-list (&body body) `(gen-list *generator* (lambda () ,@body))) (defmacro ordered-list (&body body) `(gen-list *generator* (lambda () ,@body) :type :ordered)) (defmacro definition-list (&body body) `(gen-list *generator* (lambda () ,@body) :type :definition)) (defmacro list-item (&body body) `(gen-list-item *generator* (lambda () ,@body))) ;; (gen-text *generator* (language *language* item))))) (defmacro definition (term &body description) (let ((vterm (gensym))) `(let ((,vterm ,term)) (gen-definition *generator* (if ,vterm (language *language* ,vterm) "") (lambda () ,@description))))) (defun bullet-list-items (items) (bullet-list (mapc (lambda (item) (list-item (generate-items (list item)))) items))) (defmacro link (url text) `(gen-link *generator* (lambda () (gen-text *generator* (language *language* ,text))) :url ,url)) ;;---------------------------------------------------------------------- ;; HTML-GENERATOR ;;---------------------------------------------------------------------- ;; This class genrates HTML documents. ;; (defclass html-generator (generator) ()) (defun rfc-822-date () (multiple-value-bind (se mi ho da mo ye day-of-week) (decode-universal-time (get-universal-time) 0) (format nil "~[Mon~;Tue~;Wed~;Thi~;Fri~;Sat~;Sun~], ~2@A ~ ~[~;Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~ ~4,'0D ~2,'0D:~2,'0D:~2,'0D GMT " day-of-week da mo ye ho mi se))) (defmethod gen-style-header ((generator html-generator)) (html:META (:http-equiv "Expires" :content (rfc-822-date))) (html:META (:http-equiv "Content-Type" :content "text/html; charset=utf-8")) (html:link (:href "/default.css" :rel "stylesheet" :type "text/css")) (html:link (:href "style.css" :rel "stylesheet" :type "text/css"))) (defmethod gen-document ((generator html-generator) genbody &key (file-path #P"document") (title nil)) (let ((path (make-pathname :type "html" :defaults file-path))) (with-open-file (html path :direction :output :if-does-not-exist :create :if-exists :supersede) (html:with-html-output (html) (html:DOCTYPE :TRANSITIONAL (html:html () (html:head () (when title (html:title () (gen-text generator title))) (gen-style-header generator)) (html:body () (funcall genbody)))))) path)) (defmethod gen-text ((generator html-generator) text) (unless text (invoke-debugger (make-instance 'error))) (html:pcdata "~A" text)) (defmethod gen-section ((generator html-generator) genbody &key (name nil) (title "Section")) (let ((*section* (1+ *section*))) (flet ((title () (if name (html:a (:name name) (gen-text generator title)) (gen-text generator title)))) (case *section* ((1) (html:h1 () (title))) ((2) (html:h2 () (title))) ((3) (html:h3 () (title))) ((4) (html:h4 () (title))) ((5) (html:h5 () (title))) (otherwise (html:h6 () (title))))) (funcall genbody))) (defmethod gen-list ((generator html-generator) genbody &key (type :bullet)) (case type ((:ordered) (html:ol () (funcall genbody))) ((:definition) (html:dl () (funcall genbody))) (otherwise (html:ul () (funcall genbody))))) (defmethod gen-list-item ((generator html-generator) genbody &key (name nil)) (if name (html:li (:class name :id name) (funcall genbody)) (html:li () (funcall genbody)))) (defmethod gen-definition ((generator html-generator) term genbody &key name) (if name (progn (html:dt (:class name :id name) (gen-text generator term)) (html:dd (:class name :id name) (funcall genbody))) (progn (html:dt () (gen-text generator term)) (html:dd () (funcall genbody))))) (defmethod gen-link ((generator html-generator) genbody &key url) (html:a (:href url) (funcall genbody))) ;;---------------------------------------------------------------------- (defmacro group (&body body) `(html:dl () ,@body)) (defun flow-items (language items) (loop :initially (html:pcdata (language language (first items))) :for line :in (rest items) :do (progn (html:pcdata ", ") (html:pcdata (language language line))))) (defun field (title value &key strong link) (definition title (labels ((insert-value (value) (assert value) (if (consp value) (loop :initially (gen-text *generator* (first value)) :for line :in (rest value) :do (html:br) (gen-text *generator* line)) (gen-text *generator* value))) (opt-strong (value) (if strong (html:strong () (insert-value value)) (insert-value value)))) (if link (link value value) (opt-strong value))))) (defun link-field (title value) (field title value :link t)) (defun item-kind (item) (cond ((consp item) (if (member (first item) '(:text :list :link :mode :skills :break)) (first item) :sequence)) ((stringp item) :text) (t (error "Invalid item ~S" item)))) (defun generate-items (items) (let ((groups (loop :named :groups :with result = '() :with group-kind = nil :with group = '() :for item :in items :for item-kind = (item-kind item) :do (if (eq group-kind item-kind) (push item group) (progn (when group (push (nreverse group) result)) (unless (and (eq :text group-kind) (eq :list item-kind)) ;;(push '((:break)) result) ) (setf group (list item) group-kind item-kind))) :finally (progn (when group (push (nreverse group) result)) (return-from :groups (nreverse result)))))) (loop :for (group next-group) :on groups :do ;; (print `(group = ,group)) ;; (print `(next-group = ,next-group)) (ecase (item-kind (first group)) (:text (dolist (item group) (html:pcdata "~A " (language *language* item)))) (:list (dolist (item group) (bullet-list-items (rest item)))) (:link (let ((do-break nil)) (dolist (item group) (if do-break (html:br) (setf do-break t)) (link (second item) (or (third item) (second item)))))) (:sequence (dolist (item group) (generate-items item))) (:mode (html:i () (dolist (item group) (generate-items (rest item))))) (:skills (dolist (item group) (html:div (:class "skills") (flow-items *language* (rest item))))) (:tags)) (when (and next-group (not (eq :list (item-kind (first group)))) (not (eq :list (item-kind (first next-group))))) (html:br))))) (defun collect-skills (items) (cond ((atom items) nil) ((atom (first items)) (if (eq :skills (first items)) (rest items) (reduce (function union) (mapcar (function collect-skills) (rest items))))) (t (reduce (function union) (mapcar (function collect-skills) items))))) ;;---------------------------------------------------------------------- ;; GENERATE-CV ;;---------------------------------------------------------------------- (defun pget (l k) (cdr (assoc k (cdr l)))) (declaim (inline pget)) (defun language (language item) (etypecase item (string item) (cons (apply (function concatenate) 'string (if (eq :text (first item)) (cdr (or (assoc language (rest item)) (second item))) item))))) (defun vowelp (ch) (position ch "AEIOUYaeiouyÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÒÓÔÕÖØÙÚÛÜÝàáâãäåæèéêëìíîïòóôõöøùúûüýÿ")) (defvar *cv-base* "cv" "File name Base for CV html files.") (defvar *cv-url-base* "http://pjb.ogamita.org/cv/" "URL Base for CV html resources.") (defvar *cv-rel-url-base* "cv/" "Relative URL Base for CV html resources.") (defun cv-file-path (language full) (format nil "~A-~(~A-~A~)" *cv-base* language (case full ((nil) "short") ((t) "full") (otherwise full)))) (defun tags (item) (when (listp item) (union (pget item :tags) (mapcar (lambda (x) (intern (substitute #\- #\space (string-upcase x)))) (collect-skills (pget item :desc)))))) (defun year (employment) (first (pget employment :date))) (defun order (employment) (first (pget employment :order))) (defun title (employment) (first (pget employment :title))) (defun client (employment) (first (pget employment :client))) (defun make-order-from-tags (tags) (lambda (a b) (block order (dolist (tag tags nil) (if (find tag a) (unless (find tag b) (return-from order t)) (when (find tag b) (return-from order nil))))))) (defun sort-by-tags (sequence tags &key (key (function identity))) " TAGS: A sequence of tags in decreasing order or priority. RETURN: SEQUENCE, sorted. " (stable-sort sequence (make-order-from-tags tags) :key key)) (defgeneric generate-cv (generator cv &key full language toc order-tags)) (defmethod generate-cv ((*generator* generator) cv &key (language *language*) full full-name toc src order-tags) (let ((*language* language) (person (find :person (cdr cv) :key (function first))) (summary (cons :summary (sort-by-tags (cdr (find :summary (cdr cv) :key (function first))) order-tags :key (function tags)))) (skills (cons :skills (mapcar (lambda (cat) (remove :tags cat :key (lambda (x) (if (listp x) (first x) x)))) (sort-by-tags (cdr (find :skills (cdr cv) :key (function first))) order-tags :key (function tags))))) (languages (find :language (cdr cv) :key (function first))) (leisures (find :leisure (cdr cv) :key (function first))) (employments (let ((employments (remove ':emp (cdr cv) :key (function first) :test (complement (function eq))))) (format t "~2%FULL = ~S~%ORDER = ~A~%" full order-tags) (format t "EMPLOYMENTS BEFORE SORT:~%") (dolist (e employments) (format t "~A ~30A ~A~%" (if (eq :current (year e)) "CURR" (year e)) (client e) (title e))) (setf employments (sort-by-tags (sort (if (not (or (numberp full) (null full))) employments (remove-if (multiple-value-bind (s m h d o year) (decode-universal-time (get-universal-time) 0) (declare (ignore s m h d o)) (setf year (- year (if (numberp full) full 10))) (lambda (emp-year) (and (not (eq :current emp-year)) (< emp-year year)))) employments :key (function year))) (if full (lambda (a b) (or (eq (year a) :current) (and (not (eq (year b) :current)) (>= (year a) (year b))))) (lambda (a b) (or (eq (year a) :current) (and (not (eq (year b) :current)) (or (and (order a) (not (order b))) (and (order a) (order b) (or (and (= (order a) (order b)) (>= (year a) (year b))) (< (order a) (order b)))) (>= (year a) (year b)))))))) order-tags :key (function tags))) (format t "EMPLOYMENTS AFTER SORT:~%") (dolist (e employments) (format t "~A ~30A ~A~%" (if (eq :current (year e)) "CURR" (year e)) (client e) (title e))) employments)) (studies (remove :stu (cdr cv) :key (function first) :test (complement (function eq)))) (table (quote ((:document "resume" (:text (:en "Resume") (:fr "Curriculum Vitae") (:es "Curriculum Vitae"))) (:toc "toc" (:text (:en "Contents") (:fr "Table") (:es "Contenido"))) (:skills "skills" (:text (:en "COMPUTER SCIENCE KNOWLEDGE") (:fr "CONNAISSANCES INFORMATIQUE") (:es "CONOCIMIENTOS DE INFORMÁTICA"))) (:emp "employments" (:text (:en "FREE-LANCE DEVELOPMENTS AND MISSIONS") (:fr "MISSIONS ET DÉVELOPPEMENTS") (:es "TRABAJOS"))) (:full "full" (:text (:en "Full Resume") (:fr "CV complet") (:es "CV completo"))) (:stu "studies" (:text (:en "STUDIES") (:fr "ÉTUDES") (:es "ESTUDIOS"))) (:languages "languages" (:text (:en "LANGUAGES") (:fr "LANGUES") (:es "IDIOMAS"))) (:leisures "leisures" (:text (:en "LEISURES") (:fr "LOISIRS") (:es "OCIO"))))))) (flet ((entry-key (entry) (first entry)) (toc-name (key) (language language (second (assoc key table)))) (toc-title (key) (language language (third (assoc key table)))) (employment-item (employment) (let ((date (pget employment :date)) (desc (pget employment :desc))) (definition (second date) (generate-items desc))))) (document (:file-path (cv-file-path language full) :title (let ((name (first (pget person :name)))) (format nil (ecase language (:en "~*~A's Resume") (:fr "Curriculum Vitae d~:[e ~;~]~A") (:es "Curriculum Vitae de ~*~A")) (vowelp (aref name 0)) name))) (section (:name (toc-name :document) :title (toc-title :document)) ;; Name & Address: (group (field nil (first (pget person :name)) :strong t) (field nil (language language (first (pget person :nationality)))) (field nil (pget person :address)) (link-field nil (format nil "mailto:~A" (first (pget person :mail)))) (link-field nil (format nil "http://~A" (first (pget person :web)))) (dolist (phone (remove-if-not (lambda (key) (eq :phone key)) (cdr person) :key (function car))) (field nil (cdr phone)))) ;; Summary: (bullet-list-items (rest summary)) (when toc (section (:name (toc-name :toc) :title (toc-title :toc)) (bullet-list (dolist (item (remove-if (lambda (x) (member x '(:toc :full :document))) table :key (function entry-key))) (gen-list-item *generator* (lambda () (link (format nil "#~A" (second item)) (third item))))))))) (section (:name (toc-name :skills) :title (toc-title :skills)) (group (dolist (cat (rest skills)) (definition-list (definition (second cat) (dolist (dot-point (cddr cat)) (ecase (first dot-point) (:flow (flow-items language (rest dot-point))) (:list (bullet-list-items (rest dot-point))) (:tags)) (html:br))))))) (section (:name (toc-name :emp) :title (toc-title :emp)) (definition-list (mapc (function employment-item) employments)) (unless (eq full t) (link (concatenate 'string *cv-rel-url-base* (or full-name (cv-file-path language t))) (format nil "~A : ~A~A" (toc-title :full) *cv-url-base* (or full-name (cv-file-path language t)))))) (section (:name (toc-name :stu) :title (toc-title :stu)) (definition-list (mapc (function employment-item) studies))) (section (:name (toc-name :languages) :title (toc-title :languages)) (bullet-list-items (rest languages))) (section (:name (toc-name :leisures) :title (toc-title :leisures)) (bullet-list-items (rest leisures))) (html:br) (html:p (html:small (html:pcdata "~A" (language language '(:text (:en "Generated automatically from ") (:fr "Généré automatiquement par ") (:es "Generado automaticamente por ")))) (html:a (:href "cv.lisp") (html:code (html:pcdata "cv.lisp"))) (html:pcdata " from ") (html:a (:href (concatenate 'string *cv-rel-url-base* src)) (html:code (html:pcdata src))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; MAIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (loop :for (src name order-tags) :in '(("pjb.cv" "pjb" ()) ("pjb.cv" "pjb-dev" (development unix)) ("pjb.cv" "pjb-cl" (common-lisp development unix openstep)) ("pjb.cv" "pjb-cpp" (c++ development)) ("pjb.cv" "pjb-adm" (administration unix))) :do (let ((*cv-url-base* "http://pjb.ogamita.org/cv/") (*cv-rel-url-base* "") (*cv-base* (format nil "cv-~A" name)) (cv (with-open-file (in src) (read in)))) (dolist (full '(nil t)) (dolist (lang '(:en :fr :es)) (print (generate-cv (make-instance 'html-generator) cv :full full #- (and) :full-name #- (and) (let ((*cv-base* "cv-full")) (cv-file-path lang t)) :toc t :language lang :src src :order-tags order-tags)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; DEBUG ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #+emacs (defun put-in-text (start end) (interactive "r") (let ((en (buffer-substring start end))) (delete-region start end) (insert "(:text (:en " en ")\n(:fr \"\")\n(:es \"\"))"))) #+emacs (local-set-key (kbd "s-p") (function put-in-text)) #|| (print (generate-cv (make-instance 'html-generator) pascal-bourguignon :full t :toc t)) ||# #- (and) (setf src "pjb.cv" *cv-url-base* "http://pjb.ogamita.org/cv/" *cv-rel-url-base* "/cv/" *cv-base* (format nil "cv-~A" (pathname-name src)) cv (with-open-file (in src) (read in)) language :fr full t *language* language person (find :person (cdr cv) :key (function first)) summary (find :summary (cdr cv) :key (function first)) skills (find :skills (cdr cv) :key (function first)) languages (find :language (cdr cv) :key (function first)) leisures (find :leisure (cdr cv) :key (function first)) employments (let ((employments (remove ':emp (cdr cv) :key (function first) :test (complement (function eq))))) (flet ((year (employment) (first (pget employment :date))) (order (employment) (first (pget employment :order)))) (sort (if (not (or (numberp full) (null full))) employments (remove-if (multiple-value-bind (s m h d o year) (decode-universal-time (get-universal-time) 0) (declare (ignore s m h d o)) (setf year (- year (if (numberp full) full 10))) (lambda (emp-year) (and (not (eq :current emp-year)) (< emp-year year)))) employments :key (function year))) (if full (lambda (a b) (or (eq (year a) :current) (and (not (eq (year b) :current)) (>= (year a) (year b))))) (lambda (a b) (or (eq (year a) :current) (and (not (eq (year b) :current)) (or (and (order a) (not (order b))) (and (order a) (order b) (or (and (= (order a) (order b)) (>= (year a) (year b))) (< (order a) (order b)))) (>= (year a) (year b)))))))))) studies (remove :stu (cdr cv) :key (function first) :test (complement (function eq))) table (quote ((:document "resume" (:text (:en "Resume") (:fr "Curriculum Vitae") (:es "Curriculum Vitae"))) (:toc "toc" (:text (:en "Contents") (:fr "Table") (:es "Contenido"))) (:skills "skills" (:text (:en "COMPUTER SCIENCE KNOWLEDGE") (:fr "CONNAISSANCES INFORMATIQUE") (:es "CONOCIMIENTOS DE INFORMÁTICA"))) (:emp "employments" (:text (:en "FREE-LANCE DEVELOPMENTS AND MISSIONS") (:fr "MISSIONS ET DÉVELOPPEMENTS") (:es "TRABAJOS"))) (:full "full" (:text (:en "Full Resume") (:fr "CV complet") (:es "CV completo"))) (:stu "studies" (:text (:en "STUDIES") (:fr "ÉTUDES") (:es "ESTUDIOS"))) (:languages "languages" (:text (:en "LANGUAGES") (:fr "LANGUES") (:es "IDIOMAS"))) (:leisures "leisures" (:text (:en "LEISURES") (:fr "LOISIRS") (:es "OCIO")))))) #- (and) (progn (dolist (tag (mapcar 'tags (sort-by-tags employments '(administration development common-lisp openstep) :key (function tags))) (values)) (print tag)) (equalp (mapcar (function tags) employments) (mapcar (function tags) (sort-by-tags employments nil :key (function tags))))) ;; Style Model: http://quadium.net/random/resume.html