2006-05-05 Marcus Brinkmann <marcus@g10code.de>

	* configure.ac (AC_CONFIG_FILES): Add lang/Makefile and
	lang/cl/Makefile.
	* Makefile.am (SUBDIRS): Add lang.
	* lang: New directory.
	* lang/README, lang/Makefile.am: New files.
	* lang/cl: New directory.
	* lang/cl/Makefile.am, lang/cl/README, lang/cl/gpg-error.asd,
	lang/cl/gpg-error-package.lisp, lang/cl/gpg-error.lisp,
	lang/cl/mkerrcodes.awk: New files.

8 files changed, 549 insertions, 0 deletions

diff --git a/lang/Makefile.am b/lang/Makefile.am
new file mode 100644
index 0000000..3e380d5
--- /dev/null
+++ b/lang/Makefile.am
@@ -0,0 +1,22 @@
+# Makefile.am for libgpg-error.
+# Copyright (C) 2003, 2006 g10 Code GmbH
+# 
+# This file is part of libgpg-error.
+# 
+# libgpg-error is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 2.1 of the
+# License, or (at your option) any later version.
+# 
+# libgpg-error 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 Lesser General Public License for more details.
+# 
+# You should have received a copy of the GNU Lesser 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
+
+SUBDIRS = cl
+
+EXTRA_DIST = README
diff --git a/lang/README b/lang/README
new file mode 100644
index 0000000..2d13e21
--- /dev/null
+++ b/lang/README
@@ -0,0 +1,8 @@
+Language Support for libgpg-error
+---------------------------------
+
+This directory contains support for other languages than C.
+
+Directory	Language
+
+cl		Common Lisp
diff --git a/lang/cl/Makefile.am b/lang/cl/Makefile.am
new file mode 100644
index 0000000..4563bc6
--- /dev/null
+++ b/lang/cl/Makefile.am
@@ -0,0 +1,41 @@
+# Makefile.am for libgpg-error.
+# Copyright (C) 2003, 2006 g10 Code GmbH
+# 
+# This file is part of libgpg-error.
+# 
+# libgpg-error is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as
+# published by the Free Software Foundation; either version 2.1 of the
+# License, or (at your option) any later version.
+# 
+# libgpg-error 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 Lesser General Public License for more details.
+# 
+# You should have received a copy of the GNU Lesser 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
+
+distributed_clfiles = gpg-error.asd \
+	gpg-error-package.lisp \
+	gpg-error.lisp
+
+generated_clfiles = gpg-error-codes.lisp
+
+clfiles = $(distributed_clfiles) $(generated_clfiles)
+
+# FIXME: Should be configurable.
+clfilesdir = $(prefix)/common-lisp/source/libgpg-error
+dist_clfiles_DATA = $(distributed_clfiles)
+nodist_clfiles_DATA = $(generated_clfiles)
+
+EXTRA_DIST = README mkerrcodes.awk
+CLEANFILES = gpg-error-codes.lisp
+
+codes_file := $(top_srcdir)/src/err-codes.h.in
+errno_file := $(top_srcdir)/src/errnos.in
+
+gpg-error-codes.lisp: Makefile mkerrcodes.awk $(codes_file) $(errno_file)
+	echo '@errnos@' | cat $(codes_file) - $(errno_file) \
+	| $(AWK) -f $(srcdir)/mkerrcodes.awk >$@
diff --git a/lang/cl/README b/lang/cl/README
new file mode 100644
index 0000000..468a194
--- /dev/null
+++ b/lang/cl/README
@@ -0,0 +1,8 @@
+Common Lisp Support for libgpg-error
+------------------------------------
+
+Requirements:
+
+ASDF	Packaging Support
+CFFI	Foreign Function Interface
+
diff --git a/lang/cl/gpg-error-package.lisp b/lang/cl/gpg-error-package.lisp
new file mode 100644
index 0000000..589324d
--- /dev/null
+++ b/lang/cl/gpg-error-package.lisp
@@ -0,0 +1,65 @@
+;;;; libgpg-error-package.lisp
+
+;;; Copyright (C) 2006 g10 Code GmbH
+;;;
+;;; This file is part of libgpg-error.
+;;;
+;;; libgpg-error is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; libgpg-error 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with libgpg-error; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
+
+;;; Conventions
+;;;
+;;; Error sources and codes are represented as keywords like
+;;; :gpg-err-source-gpg and :gpg-err-unknown-packet.
+;;;
+;;; Errors are represented as lists '(SOURCE CODE).  Other
+;;; representations are also accepted in some places.
+;;;
+;;; TODO: Lispy convenience functions as need arises, for example for
+;;; output.
+;;;
+;;; The following functions are defined which are not defined in the C API:
+;;; gpg-err-source-as-key, gpg-err-source-as-value
+;;; gpg-err-code-as-key, gpg-err-code-as-value
+;;; gpg-err-canonicalize, gpg-err-as-value
+;;; Conversion between keywords and values for error sources and codes.
+;;; 
+;;; The following functions from the C API are omitted:
+;;; gpg-strerror-r
+;;;
+;;; The following features work slightly differently:
+;;; *gpg-err-source-default* is a dynamic variable that can be set to
+;;; change the default for gpg-error.
+
+(defpackage #:org.gnupg.libgpg-error
+  (:use #:common-lisp #:cffi)
+
+  (:export :gpg-err-code-as-key
+	   :gpg-err-code-as-value
+	   :gpg-err-source-as-key
+	   :gpg-err-source-as-value
+	   :gpg-err-canonicalize
+	   :gpg-err-as-value
+	   :gpg-err-make
+	   :*gpg-err-source-default*
+	   :gpg-error
+	   :gpg-err-code
+	   :gpg-err-source
+	   :gpg-strerror
+	   :gpg-strsource
+	   :gpg-err-code-from-errno
+	   :gpg-err-code-to-errno
+	   :gpg-err-make-from-errno
+	   :gpg-error-from-errno))
diff --git a/lang/cl/gpg-error.asd b/lang/cl/gpg-error.asd
new file mode 100644
index 0000000..afde126
--- /dev/null
+++ b/lang/cl/gpg-error.asd
@@ -0,0 +1,31 @@
+;;; -*- Mode: lisp -*-
+
+;;; Copyright (C) 2006 g10 Code GmbH
+;;;
+;;; This file is part of libgpg-error.
+;;;
+;;; libgpg-error is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; libgpg-error 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with libgpg-error; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
+
+(defpackage #:org.gnupg.libgpg-error.system
+  (:use #:common-lisp #:asdf))
+
+(in-package #:org.gnupg.libgpg-error.system)
+
+(defsystem org.gnupg.libgpg-error
+    :components ((:file "libgpg-error-package")
+		 (:file "libgpg-error-codes"
+			:depends-on ("libgpg-error-package"))
+		 (:file "libgpg-error" :depends-on ("error-codes"))))
diff --git a/lang/cl/gpg-error.lisp b/lang/cl/gpg-error.lisp
new file mode 100644
index 0000000..3d63d8c
--- /dev/null
+++ b/lang/cl/gpg-error.lisp
@@ -0,0 +1,220 @@
+;;;; libgpg-error.lisp
+
+;;; Copyright (C) 2006 g10 Code GmbH
+;;;
+;;; This file is part of libgpg-error.
+;;;
+;;; libgpg-error is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 2.1 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; libgpg-error 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with libgpg-error; if not, write to the Free
+;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
+
+;;; Set up the library.
+
+(in-package :org.gnupg.libgpg-error)
+
+(define-foreign-library libgpg-error
+  (:unix "libgpg-error.so")
+  (t (:default "libgpg-error")))
+   
+(use-foreign-library libgpg-error)
+
+;;; System dependencies.
+
+(defctype size-t :unsigned-int
+  :documentation "The system size_t type.")
+
+;;; Error sources.
+
+(defcenum gpg-err-source-t
+  "The GPG error source type."
+  (:gpg-err-source-unknown 0)
+  (:gpg-err-source-gcrypt 1)
+  (:gpg-err-source-gpg 2)
+  (:gpg-err-source-gpgsm 3)
+  (:gpg-err-source-gpgagent 4)
+  (:gpg-err-source-pinentry 5)
+  (:gpg-err-source-scd 6)
+  (:gpg-err-source-gpgme 7)
+  (:gpg-err-source-keybox 8)
+  (:gpg-err-source-ksba 9)
+  (:gpg-err-source-dirmngr 10)
+  (:gpg-err-source-gsti 11)
+  (:gpg-err-source-user-1 32)
+  (:gpg-err-source-user-2 33)
+  (:gpg-err-source-user-3 34)
+  (:gpg-err-source-user-4 35))
+
+(defconstant +gpg-err-source-dim+ 256)
+
+;;; The error code type gpg-err-code-t.
+
+;;; libgpg-error-codes.lisp is loaded by ASDF.
+
+(defctype gpg-error-t :unsigned-int
+  :documentation "The GPG error code type.")
+
+;;; Bit mask manipulation constants.
+
+(defconstant +gpg-err-code-mask+ (- +gpg-err-code-dim+ 1))
+
+(defconstant +gpg-err-source-mask+ (- +gpg-err-source-dim+ 1))
+(defconstant +gpg-err-source-shift+ 24)
+
+;;; Constructor and accessor functions.
+
+;;; If we had in-library versions of our static inlines, we wouldn't
+;;; need to replicate them here.  Oh well.
+
+(defun c-gpg-err-make (source code)
+  "Construct an error value from an error code and source.
+   Within a subsystem, use gpg-error instead."
+  (logior
+   (ash (logand source +gpg-err-source-mask+)
+	+gpg-err-source-shift+)
+   (logand code +gpg-err-code-mask+)))
+
+(defun c-gpg-err-code (err)
+  "retrieve the error code from an error value." 
+  (logand err +gpg-err-code-mask+))
+
+(defun c-gpg-err-source (err)
+  "retrieve the error source from an error value." 
+  (logand (ash err (- +gpg-err-source-shift+))
+	  +gpg-err-source-mask+))
+
+;;; String functions.
+
+(defcfun ("gpg_strerror" c-gpg-strerror) :string
+  (err gpg-error-t))
+
+(defcfun ("gpg_strsource" c-gpg-strsource) :string
+  (err gpg-error-t))
+
+;;; Mapping of system errors (errno).
+
+(defcfun ("gpg_err_code_from_errno" c-gpg-err-code-from-errno) gpg-err-code-t
+  (err :int))
+
+(defcfun ("gpg_err_code_to_errno" c-gpg-err-code-to-errno) :int
+  (code gpg-err-code-t))
+
+;;; Self-documenting convenience functions.
+
+;;; See below.
+
+;;;
+;;;
+;;; Lispy interface.
+;;;
+;;;
+
+;;; Low-level support functions.
+
+(defun gpg-err-code-as-value (code-key)
+  (foreign-enum-value 'gpg-err-code-t code-key))
+
+(defun gpg-err-code-as-key (code)
+  (foreign-enum-keyword 'gpg-err-code-t code))
+
+(defun gpg-err-source-as-value (source-key)
+  (foreign-enum-value 'gpg-err-source-t source-key))
+
+(defun gpg-err-source-as-key (source)
+  (foreign-enum-keyword 'gpg-err-source-t source))
+
+(defun gpg-err-canonicalize (err)
+  "Canonicalize the error value err."
+  (gpg-err-make (gpg-err-source err) (gpg-err-code err)))
+
+(defun gpg-err-as-value (err)
+  "Get the integer representation of the error value ERR."
+  (let ((error (gpg-err-canonicalize err)))
+    (c-gpg-err-make (gpg-err-source-as-value (gpg-err-source error))
+		    (gpg-err-code-as-value (gpg-err-code error)))))
+
+;;; Constructor and accessor functions.
+
+(defun gpg-err-make (source code)
+  "Construct an error value from an error code and source.
+   Within a subsystem, use gpg-error instead."
+  ;; As an exception to the rule, the function gpg-err-make will use
+  ;; the error source value as is when provided as integer, instead of
+  ;; parsing it as an error value.
+  (list (if (integerp source)
+	    (gpg-err-source-as-key source)
+	    (gpg-err-source source))
+	(gpg-err-code code)))
+
+(defvar *gpg-err-source-default* :gpg-err-source-unknown
+  "define this to specify a default source for gpg-error.")
+
+(defun gpg-error (code)
+  "Construct an error value from an error code, using the default source."
+  (gpg-err-make *gpg-err-source-default* code))
+
+(defun gpg-err-code (err)
+    "Retrieve an error code from the error value ERR."
+    (cond ((listp err) (second err))
+	  ((keywordp err) err) ; FIXME
+	  (t (gpg-err-code-as-key (c-gpg-err-code err)))))
+
+(defun gpg-err-source (err)
+    "Retrieve an error source from the error value ERR."
+    (cond ((listp err) (first err))
+	  ((keywordp err) err) ; FIXME
+	  (t (gpg-err-source-as-key (c-gpg-err-source err)))))
+
+;;; String functions.
+
+(defun gpg-strerror (err)
+  "Return a string containig a description of the error code."
+  (c-gpg-strerror (gpg-err-as-value err)))
+
+;;; FIXME: maybe we should use this as the actual implementation for
+;;; gpg-strerror.
+
+;; (defcfun ("gpg_strerror_r" c-gpg-strerror-r) :int
+;;   (err gpg-error-t)
+;;   (buf :string)
+;;   (buflen size-t))
+
+;; (defun gpg-strerror-r (err)
+;;   "Return a string containig a description of the error code."
+;;   (with-foreign-pointer-as-string (errmsg 256 errmsg-size)
+;;     (c-gpg-strerror-r (gpg-err-code-as-value (gpg-err-code err))
+;; 		      errmsg errmsg-size)))
+
+(defun gpg-strsource (err)
+  "Return a string containig a description of the error source."
+  (c-gpg-strsource (gpg-err-as-value err)))
+
+;;; Mapping of system errors (errno).
+
+(defun gpg-err-code-from-errno (err)
+  "Retrieve the error code for the system error.  If the system error
+   is not mapped, :gpg-err-unknown-errno is returned."
+  (gpg-err-code-as-key (c-gpg-err-code-from-errno err)))
+
+(defun gpg-err-code-to-errno (code)
+  "Retrieve the system error for the error code.  If this is not a
+   system error, 0 is returned."
+  (c-gpg-err-code-to-errno (gpg-err-code code)))
+
+;;; Self-documenting convenience functions.
+
+(defun gpg-err-make-from-errno (source err)
+  (gpg-err-make source (gpg-err-code-from-errno err)))
+
+(defun gpg-error-from-errno (err)
+  (gpg-error (gpg-err-code-from-errno err)))
diff --git a/lang/cl/mkerrcodes.awk b/lang/cl/mkerrcodes.awk
new file mode 100644
index 0000000..d7f4950
--- /dev/null
+++ b/lang/cl/mkerrcodes.awk
@@ -0,0 +1,154 @@
+# mkerrcodes.awk
+# Copyright (C) 2004, 2005, 2006 g10 Code GmbH
+# 
+# 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.
+#
+# As a special exception, g10 Code GmbH gives unlimited permission to
+# copy, distribute and modify the lisp source files that are the output
+# of mkerrcodes.awk.  You need not follow the terms of the GNU General
+# Public License when using or distributing such scripts, even though
+# portions of the text of mkerrcodes.awk appear in them.  The GNU
+# General Public License (GPL) does govern all other use of the material
+# that constitutes the mkerrcodes.awk program.
+#
+# Certain portions of the mkerrcodes.awk source text are designed to be
+# copied (in certain cases, depending on the input) into the output of
+# mkerrcodes.awk.  We call these the "data" portions.  The rest of the
+# mkerrcodes.awk source text consists of comments plus executable code
+# that decides which of the data portions to output in any given case.
+# We call these comments and executable code the "non-data" portions.
+# mkerrcodes.awk never copies any of the non-data portions into its output.
+#
+# This special exception to the GPL applies to versions of mkerrcodes.awk
+# released by g10 Code GmbH.  When you make and distribute a modified version
+# of mkerrcodes.awk, you may extend this special exception to the GPL to
+# apply to your modified version as well, *unless* your modified version
+# has the potential to copy into its output some of the text that was the
+# non-data portion of the version that you started with.  (In other words,
+# unless your change moves or copies text from the non-data portions to the
+# data portions.)  If your modification has such potential, you must delete
+# any notice of this special exception to the GPL from your modified version.
+
+# The input file is in the following format:
+# [CODE SYMBOL...]
+# @errnos@
+# [CODE SYMBOL...]
+#
+# The difference between the sections is how symbol is transformed.
+# The second section gets GPG_ERR_ prepended before processing.
+#
+# Comments (starting with # and ending at the end of the line) are removed,
+# as is trailing whitespace.
+
+BEGIN {
+  FS="[ \t]+";
+  print ";;;; Output of mkerrcodes.awk.  DO NOT EDIT.";
+  print "";
+  print ";;; Copyright (C) 2006 g10 Code GmbH";
+  print ";;;";
+  print ";;; This file is part of libgpg-error.";
+  print ";;;";
+  print ";;; libgpg-error is free software; you can redistribute it and/or";
+  print ";;; modify it under the terms of the GNU Lesser General Public License";
+  print ";;; as published by the Free Software Foundation; either version 2.1 of";
+  print ";;; the License, or (at your option) any later version.";
+  print ";;;";
+  print ";;; libgpg-error is distributed in the hope that it will be useful, but";
+  print ";;; WITHOUT ANY WARRANTY; without even the implied warranty of";
+  print ";;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU";
+  print ";;; Lesser General Public License for more details.";
+  print ";;;";
+  print ";;; You should have received a copy of the GNU Lesser General Public";
+  print ";;; License along with libgpg-error; if not, write to the Free";
+  print ";;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA";
+  print ";;; 02111-1307, USA.";
+  print "";
+
+  header = 1;
+  errnos = 0;
+}
+
+/^#/ { next; }
+
+header {
+  if (errnos)
+    {
+      if ($1 ~ /^[0123456789]+$/)
+	{
+	  header = 0;
+
+	  print "";
+	  print "  ;; The following error codes map system errors.";
+	}
+    }
+  else
+    {
+      if ($1 ~ /^[0123456789]+$/)
+	{
+	  header = 0;
+	  
+	  print "(in-package :org.gnupg.libgpg-error)";
+	  print "";
+	  print ";;; The error code type gpg-err-code-t.";
+	  print "";
+	  print ";;; This is used for system error codes.";
+	  print "(defconstant +gpg-err-system-error+ (ash 1 15))";
+	  print "";
+	  print ";;; This is one more than the largest allowed entry.";
+	  print "(defconstant +gpg-err-code-dim+ 65536)";
+	  print "";
+	  print ";;; A helper macro to have the keyword values evaluated.";
+	  print "(defmacro defcenum-eval (type doc &rest vals)";
+	  print "  `(defcenum ,type ,doc";
+	  print "    ,@(loop for v in vals";
+	  print "            collect `(,(first v) ,(eval (second v))))))";
+	  print "";
+	  print "(defcenum-eval gpg-err-code-t";
+	  print "    \"The GPG error code type.\"";
+	}
+    }
+}
+
+!header {
+  sub (/\#.+/, "");
+  sub (/[ 	]+$/, ""); # Strip trailing space and tab characters.
+
+  if (/^$/)
+    next;
+
+  # The following can happen for GPG_ERR_CODE_DIM.
+  if ($1 == "")
+    next;
+
+  if (/^@errnos@$/)
+    {
+      header = 1;
+      errnos = 1;
+      next;
+    }
+
+  $2 = tolower($2);
+  gsub ("_", "-", $2);
+
+  if (errnos)
+    print "  (:gpg-err-" $2 " (logior +gpg-err-system-error+ " $1 "))";
+  else
+    print "  (:" $2 " " $1 ")";
+}
+
+END {
+  # I am very sorry to break lisp coding style here.
+  print ")";
+}