--- /dev/null
+/* Generate a unique dump-id for use with the portable dumper.
+ Copyright (C) 2000 Olivier Galibert, Martin Buchholz
+
+This file is part of XEmacs.
+
+XEmacs 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, or (at your option) any
+later version.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+#include <config.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include "../src/systime.h"
+
+/* Generates an (extremely) pseudo random number for the dump-id */
+static unsigned int
+generate_dump_id (void)
+{
+ EMACS_TIME thyme;
+ EMACS_GET_TIME (thyme);
+
+ return (unsigned int) (EMACS_SECS (thyme) ^ EMACS_USECS (thyme));
+}
+
+int
+main (int argc, char *argv[])
+{
+ FILE *f;
+
+ if ((f = fopen ("dump-id.c", "w")) == NULL)
+ {
+ perror ("open dump-id.c");
+ return EXIT_FAILURE;
+ }
+
+ fprintf (f,
+ "#include <dump-id.h>\n"
+ "unsigned int dump_id = %uU;\n",
+ generate_dump_id ());
+
+ if ((fclose (f)) != 0)
+ {
+ perror ("close dump-id.c");
+ return EXIT_FAILURE;
+ }
+
+ return EXIT_SUCCESS;
+}
--- /dev/null
+@c -*-texinfo-*-
+@c This is part of the XEmacs Lisp Reference Manual.
+@c Copyright (C) 1994, 1995 Ben Wing.
+@c Copyright (C) 1999 Andy Piper.
+@c Copyright (C) 1999 Stephen J. Turnbull.
+@c See the file lispref.texi for copying conditions.
+@setfilename ../../info/gutter.info
+@node Gutter, Scrollbars, Toolbar, top
+@chapter Gutter
+@cindex gutter
+
+ A gutter is a rectangle displayed along one edge of a frame. It
+can contain arbitrary text or graphics.
+
+@menu
+* Gutter Intro:: An introduction.
+* Gutter Descriptor Format:: How to create a gutter.
+* Specifying a Gutter:: Setting a gutter's contents.
+* Other Gutter Variables:: Controlling the size of gutters.
+* Common Gutter Widgets:: Things to put in gutters.
+@end menu
+
+@node Gutter Intro, Gutter Descriptor Format, , Gutter
+@section Gutter Intro
+
+ A @dfn{gutter} is a rectangle displayed along one edge of a frame. It
+can contain arbitrary text or graphics. It could be considered a
+generalization of a toolbar, although toolbars are not currently
+implemented using gutters.
+
+ In XEmacs, a gutter can be displayed along any of the four edges
+of the frame, and two or more different edges can be displaying
+gutters simultaneously. The contents, thickness, and visibility of
+the gutters can be controlled separately, and the values can
+be per-buffer, per-frame, etc., using specifiers (@pxref{Specifiers}).
+
+ Normally, there is one gutter displayed in a frame. Usually, this is
+the default gutter, containing buffer tabs, but modes cab override this
+and substitute their own gutter. This default gutter is usually
+positioned along the top of the frame, but this can be changed using
+@code{set-default-gutter-position}.
+
+ Note that, for each of the gutter properties (contents, thickness,
+and visibility), there is a separate specifier for each of the four
+gutter positions (top, bottom, left, and right), and an additional
+specifier for the ``default'' gutter, i.e. the gutter whose
+position is controlled by @code{set-default-gutter-position}. The
+way this works is that @code{set-default-gutter-position} arranges
+things so that the appropriate position-specific specifiers for the
+default position inherit from the corresponding default specifiers.
+That way, if the position-specific specifier does not give a value
+(which it usually doesn't), then the value from the default
+specifier applies. If you want to control the default gutter, you
+just change the default specifiers, and everything works. A package
+such as VM that wants to put its own gutter in a different location
+from the default just sets the position-specific specifiers, and if
+the user sets the default gutter to the same position, it will just
+not be visible.
+
+@node Gutter Descriptor Format, Specifying a Gutter, Gutter Intro, Gutter
+@section Gutter Descriptor Format
+
+ The contents of a gutter are specified using a @dfn{gutter descriptor}.
+The format of a gutter descriptor is a list of @dfn{gutter button
+descriptors}. Each gutter button descriptor is a vector in one of the
+following formats:
+
+@itemize @bullet
+@item
+@code{[@var{glyph-list} @var{function} @var{enabled-p} @var{help}]}
+@item
+@code{[:style @var{2d-or-3d}]}
+@item
+@code{[:style @var{2d-or-3d} :size @var{width-or-height}]}
+@item
+@code{[:size @var{width-or-height} :style @var{2d-or-3d}]}
+@end itemize
+
+ Optionally, one of the gutter button descriptors may be @code{nil}
+instead of a vector; this signifies the division between the gutter
+buttons that are to be displayed flush-left, and the buttons to be
+displayed flush-right.
+
+ The first vector format above specifies a normal gutter button;
+the others specify blank areas in the gutter.
+
+ For the first vector format:
+
+@itemize @bullet
+@item
+@var{glyph-list} should be a list of one to six glyphs (as created by
+@code{make-glyph}) or a symbol whose value is such a list. The first
+glyph, which must be provided, is the glyph used to display the gutter
+button when it is in the ``up'' (not pressed) state. The optional
+second glyph is for displaying the button when it is in the ``down''
+(pressed) state. The optional third glyph is for when the button is
+disabled. The last three glyphs are for displaying the button in the
+``up'', ``down'', and ``disabled'' states, respectively, but are used
+when the user has called for captioned gutter buttons (using
+@code{gutter-buttons-captioned-p}). The function
+@code{gutter-make-button-list} is useful in creating these glyph lists.
+
+@item
+Even if you do not provide separate down-state and disabled-state
+glyphs, the user will still get visual feedback to indicate which
+state the button is in. Buttons in the up-state are displayed
+with a shadowed border that gives a raised appearance to the
+button. Buttons in the down-state are displayed with shadows that
+give a recessed appearance. Buttons in the disabled state are
+displayed with no shadows, giving a 2-d effect.
+
+@item
+If some of the gutter glyphs are not provided, they inherit as follows:
+
+@example
+ UP: up
+ DOWN: down -> up
+ DISABLED: disabled -> up
+ CAP-UP: cap-up -> up
+ CAP-DOWN: cap-down -> cap-up -> down -> up
+ CAP-DISABLED: cap-disabled -> cap-up -> disabled -> up
+@end example
+
+@item
+The second element @var{function} is a function to be called when the
+gutter button is activated (i.e. when the mouse is released over the
+gutter button, if the press occurred in the gutter). It can be any
+form accepted by @code{call-interactively}, since this is how it is
+invoked.
+
+@item
+The third element @var{enabled-p} specifies whether the gutter button
+is enabled (disabled buttons do nothing when they are activated, and are
+displayed differently; see above). It should be either a boolean or a
+form that evaluates to a boolean.
+
+@item
+The fourth element @var{help}, if non-@code{nil}, should be a string.
+This string is displayed in the echo area when the mouse passes over the
+gutter button.
+@end itemize
+
+ For the other vector formats (specifying blank areas of the gutter):
+
+@itemize @bullet
+@item
+@var{2d-or-3d} should be one of the symbols @code{2d} or @code{3d},
+indicating whether the area is displayed with shadows (giving it a
+raised, 3-d appearance) or without shadows (giving it a flat
+appearance).
+
+@item
+@var{width-or-height} specifies the length, in pixels, of the blank
+area. If omitted, it defaults to a device-specific value (8 pixels for
+X devices).
+@end itemize
+
+@defun gutter-make-button-list up &optional down disabled cap-up cap-down cap-disabled
+This function calls @code{make-glyph} on each arg and returns a list of
+the results. This is useful for setting the first argument of a gutter
+button descriptor (typically, the result of this function is assigned
+to a symbol, which is specified as the first argument of the gutter
+button descriptor).
+@end defun
+
+@defun check-gutter-button-syntax button &optional noerror
+Verify the syntax of entry @var{button} in a gutter description list.
+If you want to verify the syntax of a gutter description list as a
+whole, use @code{check-valid-instantiator} with a specifier type of
+@code{gutter}.
+@end defun
+
+@node Specifying a Gutter, Other Gutter Variables, Gutter Descriptor Format, Gutter
+@section Specifying a Gutter
+
+ In order to specify the contents of a gutter, set one of the specifier
+variables @code{default-gutter}, @code{top-gutter},
+@code{bottom-gutter}, @code{left-gutter}, or @code{right-gutter}.
+These are specifiers, which means you set them with @code{set-specifier}
+and query them with @code{specifier-specs} or @code{specifier-instance}.
+You will get an error if you try to set them using @code{setq}. The
+valid instantiators for these specifiers are gutter descriptors, as
+described above. @xref{Specifiers}, for more information.
+
+ Most of the time, you will set @code{default-gutter}, which allows
+the user to choose where the gutter should go.
+
+@defvr Specifier default-gutter
+The position of this gutter is specified in the function
+@code{default-gutter-position}. If the corresponding
+position-specific gutter (e.g. @code{top-gutter} if
+@code{default-gutter-position} is @code{top}) does not specify a
+gutter in a particular domain, then the value of @code{default-gutter}
+in that domain, of any, will be used instead.
+@end defvr
+
+ Note that the gutter at any particular position will not be displayed
+unless its thickness (width or height, depending on orientation) is
+non-zero and its visibility status is true. The thickness is controlled
+by the specifiers @code{top-gutter-height},
+@code{bottom-gutter-height}, @code{left-gutter-width}, and
+@code{right-gutter-width}, and the visibility status is controlled by
+the specifiers @code{top-gutter-visible-p},
+@code{bottom-gutter-visible-p}, @code{left-gutter-visible-p}, and
+@code{right-gutter-visible-p} (@pxref{Other Gutter Variables}).
+
+@defun set-default-gutter-position position
+This function sets the position that the @code{default-gutter} will be
+displayed at. Valid positions are the symbols @code{top},
+@code{bottom}, @code{left} and @code{right}. What this actually does is
+set the fallback specifier for the position-specific specifier
+corresponding to the given position to @code{default-gutter}, and set
+the fallbacks for the other position-specific specifiers to @code{nil}.
+It also does the same thing for the position-specific thickness and
+visibility specifiers, which inherit from one of
+@code{default-gutter-height} or @code{default-gutter-width}, and from
+@code{default-gutter-visible-p}, respectively (@pxref{Other Gutter
+Variables}).
+@end defun
+
+@defun default-gutter-position
+This function returns the position that the @code{default-gutter} will
+be displayed at.
+@end defun
+
+ You can also explicitly set a gutter at a particular position. When
+redisplay determines what to display at a particular position in a
+particular domain (i.e. window), it first consults the position-specific
+gutter. If that does not yield a gutter descriptor, the
+@code{default-gutter} is consulted if @code{default-gutter-position}
+indicates this position.
+
+@defvr Specifier top-gutter
+Specifier for the gutter at the top of the frame.
+@end defvr
+
+@defvr Specifier bottom-gutter
+Specifier for the gutter at the bottom of the frame.
+@end defvr
+
+@defvr Specifier left-gutter
+Specifier for the gutter at the left edge of the frame.
+@end defvr
+
+@defvr Specifier right-gutter
+Specifier for the gutter at the right edge of the frame.
+@end defvr
+
+@defun gutter-specifier-p object
+This function returns non-nil if @var{object} is a gutter specifier.
+Gutter specifiers are the actual objects contained in the gutter
+variables described above, and their valid instantiators are
+gutter descriptors (@pxref{Gutter Descriptor Format}).
+@end defun
+
+@node Other Gutter Variables, Common Gutter Widgets, Specifying a Gutter, Gutter
+@section Other Gutter Variables
+
+ The variables to control the gutter thickness, visibility status, and
+captioned status are all specifiers. @xref{Specifiers}.
+
+@defvr Specifier default-gutter-height
+This specifies the height of the default gutter, if it's oriented
+horizontally. The position of the default gutter is specified by the
+function @code{set-default-gutter-position}. If the corresponding
+position-specific gutter thickness specifier
+(e.g. @code{top-gutter-height} if @code{default-gutter-position} is
+@code{top}) does not specify a thickness in a particular domain (a
+window or a frame), then the value of @code{default-gutter-height} or
+@code{default-gutter-width} (depending on the gutter orientation) in
+that domain, if any, will be used instead.
+@end defvr
+
+@defvr Specifier default-gutter-width
+This specifies the width of the default gutter, if it's oriented
+vertically. This behaves like @code{default-gutter-height}.
+@end defvr
+
+ Note that @code{default-gutter-height} is only used when
+@code{default-gutter-position} is @code{top} or @code{bottom}, and
+@code{default-gutter-width} is only used when
+@code{default-gutter-position} is @code{left} or @code{right}.
+
+@defvr Specifier top-gutter-height
+This specifies the height of the top gutter.
+@end defvr
+
+@defvr Specifier bottom-gutter-height
+This specifies the height of the bottom gutter.
+@end defvr
+
+@defvr Specifier left-gutter-width
+This specifies the width of the left gutter.
+@end defvr
+
+@defvr Specifier right-gutter-width
+This specifies the width of the right gutter.
+@end defvr
+
+ Note that all of the position-specific gutter thickness specifiers
+have a fallback value of zero when they do not correspond to the
+default gutter. Therefore, you will have to set a non-zero thickness
+value if you want a position-specific gutter to be displayed.
+
+@defvr Specifier default-gutter-visible-p
+This specifies whether the default gutter is visible. The position of
+the default gutter is specified by the function
+@code{set-default-gutter-position}. If the corresponding position-specific
+gutter visibility specifier (e.g. @code{top-gutter-visible-p} if
+@code{default-gutter-position} is @code{top}) does not specify a
+visible-p value in a particular domain (a window or a frame), then the
+value of @code{default-gutter-visible-p} in that domain, if any, will
+be used instead.
+@end defvr
+
+@defvr Specifier top-gutter-visible-p
+This specifies whether the top gutter is visible.
+@end defvr
+
+@defvr Specifier bottom-gutter-visible-p
+This specifies whether the bottom gutter is visible.
+@end defvr
+
+@defvr Specifier left-gutter-visible-p
+This specifies whether the left gutter is visible.
+@end defvr
+
+@defvr Specifier right-gutter-visible-p
+This specifies whether the right gutter is visible.
+@end defvr
+
+@code{default-gutter-visible-p} and all of the position-specific
+gutter visibility specifiers have a fallback value of true.
+
+ Internally, gutter thickness and visibility specifiers are instantiated
+in both window and frame domains, for different purposes. The value in
+the domain of a frame's selected window specifies the actual gutter
+thickness or visibility that you will see in that frame. The value in
+the domain of a frame itself specifies the gutter thickness or
+visibility that is used in frame geometry calculations.
+
+ Thus, for example, if you set the frame width to 80 characters and the
+left gutter width for that frame to 68 pixels, then the frame will be
+sized to fit 80 characters plus a 68-pixel left gutter. If you then
+set the left gutter width to 0 for a particular buffer (or if that
+buffer does not specify a left gutter or has a nil value specified for
+@code{left-gutter-visible-p}), you will find that, when that buffer is
+displayed in the selected window, the window will have a width of 86 or
+87 characters -- the frame is sized for a 68-pixel left gutter but the
+selected window specifies that the left gutter is not visible, so it is
+expanded to take up the slack.
+
+@defvr Specifier gutter-buttons-captioned-p
+Whether gutter buttons are captioned. This affects which glyphs from a
+gutter button descriptor are chosen. @xref{Gutter Descriptor Format}.
+@end defvr
+
+ You can also reset the gutter to what it was when XEmacs started up.
+
+@defvr Constant initial-gutter-spec
+The gutter descriptor used to initialize @code{default-gutter} at
+startup.
+@end defvr
+
+@node Common Gutter Widgets, , Other Gutter Variables, Gutter
+@section Common Gutter Widgets
+
+ A gutter can contain arbitrary text. So, for example, in an Info
+buffer you could put the title of the current node in the top gutter,
+and it would not scroll out of view in a long node. (This is an
+artificial example, since usually the node name is sufficiently
+descriptive, and Info puts that in the mode line.)
+
+ A more common use for the gutter is to hold some kind of active
+widget. The buffer-tab facility, available in all XEmacs frames,
+creates an array of file-folder-like tabs, which the user can click with
+the mouse to switch buffers. W3 uses a progress-bar widget in the
+bottom gutter to give a visual indication of the progress of
+time-consuming operations like downloading.
+
+@menu
+* Buffer Tabs:: Tabbed divider index metaphor for switching buffers.
+* Progress Bars:: Visual indication of operation progress.
+@end menu
+
+@node Buffer Tabs, Progress Bars, , Common Gutter Widgets
+@section Buffer Tabs
+
+ Not documented yet.
+
+@node Progress Bars, , Buffer Tabs, Common Gutter Widgets
+@section Progress Bars
+
+ Not documented yet.
+
--- /dev/null
+@c -*-texinfo-*-
+@c This is part of the XEmacs Lisp Reference Manual.
+@c Copyright (C) 2000 Electrotechnical Laboratory, JAPAN
+@c Licensed to the Free Software Foundation
+@c See the file lispref.texi for copying conditions.
+@c Thank you Oscar Figueiredo! This file was shamelessly cloned from
+@c ldap.texi.
+@setfilename ../../info/postgresql.info
+@node PostgreSQL Support, Internationalization, LDAP Support, top
+@chapter PostgreSQL Support
+@cindex PostgreSQL
+
+XEmacs can be linked with PostgreSQL libpq run-time support to provide
+relational database access from Emacs Lisp code.
+
+@menu
+* Building XEmacs with PostgreSQL support::
+* XEmacs PostgreSQL libpq API::
+* XEmacs PostgreSQL libpq Examples::
+@end menu
+
+@node Building XEmacs with PostgreSQL support, XEmacs PostgreSQL libpq API, ,PostgreSQL Support
+@comment node-name, next, previous, up
+@section Building XEmacs with PostgreSQL support
+
+XEmacs PostgreSQL support requires linking to the PostgreSQL libpq.so
+library. Describing how to build and install PostgreSQL is beyond the
+scope of this document, see the PostgreSQL manual for details.
+
+If you have installed XEmacs from one of the binary kits on
+(@url{ftp://ftp.xemacs.org/}), or are using an XEmacs binary from a CD
+ROM, you should have XEmacs PostgreSQL support by default. If you are
+building XEmacs from source on a Linux system with PostgreSQL installed
+into the default location, it should be autodetected when you run
+configure. If you have installed PostgreSQL into its non-Linux default
+location, @file{/usr/local/pgsql}, you must specify
+@code{--site-prefixes=/usr/local/pgsql} when you run configure. If
+you installed PostgreSQL into another location, use that instead of
+@file{/usr/local/pgsql} when specifying @code{--site-prefixes}.
+
+As of XEmacs 21.2, PostgreSQL versions 6.5.3 and 7.0 are supported.
+XEmacs Lisp support for V7.0 is somewhat more extensive than support for
+V6.5. In particular, asynchronous queries are supported.
+
+@node XEmacs PostgreSQL libpq API, XEmacs PostgreSQL libpq Examples, Building XEmacs with PostgreSQL support, PostgreSQL Support
+@comment node-name, next, previous, up
+@section XEmacs PostgreSQL libpq API
+
+XEmacs PostgreSQL API is intended to be a policy-free, low-level binding
+to libpq. The intent is to provide all the basic functionality and then
+let high level Lisp code decide its own policies.
+
+This documentation assumes that the reader has knowledge of SQL, but
+requires no prior knowledge of libpq.
+
+There are many examples in this manual and some setup will be required.
+In order to run most of the following examples, the following code needs
+to be executed. In addition to the data is in this table, nearly all of
+the examples will assume that the free variable @code{P} refers to this
+database connection. The examples in the original edition of this
+manual were run against Postgres 7.0beta1.
+
+@example
+(progn
+ (setq P (pq-connectdb ""))
+ ;; id is the primary key, shikona is a Japanese word that
+ ;; means `the professional name of a Sumo wrestler', and
+ ;; rank is the Sumo rank name.
+ (pq-exec P (concat "CREATE TABLE xemacs_test"
+ " (id int, shikona text, rank text);"))
+ (pq-exec P "COPY xemacs_test FROM stdin;")
+ (pq-put-line P "1\tMusashimaru\tYokuzuna\n")
+ (pq-put-line P "2\tDejima\tOozeki\n")
+ (pq-put-line P "3\tMusoyama\tSekiwake\n")
+ (pq-put-line P "4\tMiyabiyama\tSekiwake\n")
+ (pq-put-line P "5\tWakanoyama\tMaegashira\n")
+ (pq-put-line P "\\.\n")
+ (pq-end-copy P))
+ @result{} nil
+@end example
+
+@menu
+* libpq Lisp Variables::
+* libpq Lisp Symbols and DataTypes::
+* Synchronous Interface Functions::
+* Asynchronous Interface Functions::
+* Large Object Support::
+* Other libpq Functions::
+* Unimplemented libpq Functions::
+@end menu
+
+@node libpq Lisp Variables, libpq Lisp Symbols and DataTypes, XEmacs PostgreSQL libpq API, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection libpq Lisp Variables
+
+Various Unix environment variables are used by libpq to provide defaults
+to the many different parameters. In the XEmacs Lisp API, these
+environment variables are bound to Lisp variables to provide more
+convenient access to Lisp Code. These variables are passed to the
+backend database server during the establishment of a database
+connection and when the @code{pq-setenv} call is made.
+
+@defvar pg:host
+Initialized from the @var{PGHOST} environment variable. The default
+host to connect to.
+@end defvar
+
+@defvar pg:user
+Initialized from the @var{PGUSER} environment variable. The default
+database user name.
+@end defvar
+
+@defvar pg:options
+Initialized from the @var{PGOPTIONS} environment variable. Default
+additional server options.
+@end defvar
+
+@defvar pg:port
+Initialized from the @var{PGPORT} environment variable. The default TCP
+port to connect to.
+@end defvar
+
+@defvar pg:tty
+Initialized from the @var{PGTTY} environment variable. The default
+debugging TTY.
+
+Compatibility note: Debugging TTYs are turned off in the XEmacs Lisp
+binding.
+@end defvar
+
+@defvar pg:database
+Initialized from the @var{PGDATABASE} environment variable. The default
+database to connect to.
+@end defvar
+
+@defvar pg:realm
+Initialized from the @var{PGREALM} environment variable. The default
+Kerberos realm.
+@end defvar
+
+@defvar pg:client-encoding
+Initialized from the @var{PGCLIENTENCODING} environment variable. The
+default client encoding.
+
+Compatibility note: This variable is not present in non-Mule XEmacsen.
+This variable is not present in versions of libpq prior to 7.0.
+In the current implementation, client encoding is equivalent to the
+@code{file-name-coding-system} format.
+@end defvar
+
+@c unused
+@defvar pg:authtype
+Initialized from the @var{PGAUTHTYPE} environment variable. The default
+authentication scheme used.
+
+Compatibility note: This variable is unused in versions of libpq after
+6.5. It is not implemented at all in the XEmacs Lisp binding.
+@end defvar
+
+@defvar pg:geqo
+Initialized from the @var{PGGEQO} environment variable. Genetic
+optimizer options.
+@end defvar
+
+@defvar pg:cost-index
+Initialized from the @var{PGCOSTINDEX} environment variable. Cost index
+options.
+@end defvar
+
+@defvar pg:cost-heap
+Initialized from the @var{PGCOSTHEAP} environment variable. Cost heap
+options.
+@end defvar
+
+@defvar pg:tz
+Initialized from the @var{PGTZ} environment variable. Default
+timezone.
+@end defvar
+
+@defvar pg:date-style
+Initialized from the @var{PGDATESTYLE} environment variable. Default
+date style in returned date objects.
+@end defvar
+
+@defvar pg-coding-system
+This is a variable controlling which coding system is used to encode
+non-ASCII strings sent to the database.
+
+Compatibility Note: This variable is not present in InfoDock.
+@end defvar
+
+@node libpq Lisp Symbols and DataTypes, Synchronous Interface Functions, libpq Lisp Variables, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection libpq Lisp Symbols and Datatypes
+
+The following set of symbols are used to represent the intermediate
+states involved in the asynchronous interface.
+
+@defvr {Symbol} pgres::polling-failed
+Undocumented. A fatal error has occurred during processing of an
+asynchronous operation.
+@end defvr
+
+@defvr {Symbol} pgres::polling-reading
+An intermediate status return during an asynchronous operation. It
+indicates that one may use @code{select} before polling again.
+@end defvr
+
+@defvr {Symbol} pgres::polling-writing
+An intermediate status return during an asynchronous operation. It
+indicates that one may use @code{select} before polling again.
+@end defvr
+
+@defvr {Symbol} pgres::polling-ok
+An asynchronous operation has successfully completed.
+@end defvr
+
+@defvr {Symbol} pgres::polling-active
+An intermediate status return during an asynchronous operation. One can
+call the poll function again immediately.
+@end defvr
+
+@defun pq-pgconn conn field
+@var{conn} A database connection object.
+@var{field} A symbol indicating which field of PGconn to fetch. Possible
+values are shown in the following table.
+@table @code
+@item pq::db
+Database name
+@item pq::user
+Database user name
+@item pq::pass
+Database user's password
+@item pq::host
+Hostname database server is running on
+@item pq::port
+TCP port number used in the connection
+@item pq::tty
+Debugging TTY
+
+Compatibility note: Debugging TTYs are not used in the XEmacs Lisp API.
+@item pq::options
+Additional server options
+@item pq::status
+Connection status. Possible return values are shown in the following
+table.
+@table @code
+@item pg::connection-ok
+The normal, connected status.
+@item pg::connection-bad
+The connection is not open and the PGconn object needs to be deleted by
+@code{pq-finish}.
+@item pg::connection-started
+An asynchronous connection has been started, but is not yet complete.
+@item pg::connection-made
+An asynchronous connect has been made, and there is data waiting to be sent.
+@item pg::connection-awaiting-response
+Awaiting data from the backend during an asynchronous connection.
+@item pg::connection-auth-ok
+Received authentication, waiting for the backend to start up.
+@item pg::connection-setenv
+Negotiating environment during an asynchronous connection.
+@end table
+@item pq::error-message
+The last error message that was delivered to this connection.
+@item pq::backend-pid
+The process ID of the backend database server.
+@end table
+@end defun
+
+The @code{PGresult} object is used by libpq to encapsulate the results
+of queries. The printed representation takes on four forms. When the
+PGresult object contains tuples from an SQL @code{SELECT} it will look
+like:
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+@end example
+
+The number in brackets indicates how many rows of data are available.
+When the PGresult object is the result of a command query that doesn't
+return anything, it will look like:
+
+@example
+(pq-exec P "CREATE TABLE a_new_table (i int);")
+ @result{} #<PGresult PGRES_COMMAND_OK - CREATE>
+@end example
+
+When either the query is a command-type query that can affect a number
+of different rows, but doesn't return any of them it will look like:
+
+@example
+(progn
+ (pq-exec P "INSERT INTO a_new_table VALUES (1);")
+ (pq-exec P "INSERT INTO a_new_table VALUES (2);")
+ (pq-exec P "INSERT INTO a_new_table VALUES (3);")
+ (setq R (pq-exec P "DELETE FROM a_new_table;")))
+ @result{} #<PGresult PGRES_COMMAND_OK[3] - DELETE 3>
+@end example
+
+Lastly, when the underlying PGresult object has been deallocated
+directly by @code{pq-clear} the printed representation will look like:
+
+@example
+(progn
+ (setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ (pq-clear R)
+ R)
+ @result{} #<PGresult DEAD>
+@end example
+
+The following set of functions are accessors to various data in the PGresult
+object.
+
+@defun pq-result-status result
+Return status of a query result.
+@var{result} is a PGresult object. The return value is one of the
+symbols in the following table.
+@table @code
+@item pgres::empty-query
+A query contained no text. This is usually the result of a recoverable
+error, or a minor programming error.
+@item pgres::command-ok
+A query command that doesn't return anything was executed properly by
+the backend.
+@item pgres::tuples-ok
+A query command that returns tuples was executed properly by the
+backend.
+@item pgres::copy-out
+Copy Out data transfer is in progress.
+@item pgres::copy-in
+Copy In data transfer is in progress.
+@item pgres::bad-response
+An unexpected response was received from the backend.
+@item pgres::nonfatal-error
+Undocumented. This value is returned when the libpq function
+@code{PQresultStatus} is called with a @var{NULL} pointer.
+@item pgres::fatal-error
+Undocumented. An error has occurred in processing the query and the
+operation was not completed.
+@end table
+@end defun
+
+@defun pq-res-status result
+Return the query result status as a string, not a symbol.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-res-status R)
+ @result{} "PGRES_TUPLES_OK"
+@end example
+@end defun
+
+@defun pq-result-error-message result
+Return an error message generated by the query, if any.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs-test;"))
+ @result{} <A fatal error is signaled in the echo area>
+(pq-result-error-message R)
+ @result{} "ERROR: parser: parse error at or near \"-\"
+"
+@end example
+@end defun
+
+@defun pq-ntuples result
+Return the number of tuples in the query result.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-ntuples R)
+ @result{} 5
+@end example
+@end defun
+
+@defun pq-nfields result
+Return the number of fields in each tuple of the query result.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-nfields R)
+ @result{} 3
+@end example
+@end defun
+
+@defun pq-binary-tuples result
+Returns t if binary tuples are present in the results, nil otherwise.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-binary-tuples R)
+ @result{} nil
+@end example
+@end defun
+
+@defun pq-fname result field-index
+Returns the name of a specific field.
+@var{result} is a PGresult object.
+@var{field-index} is the number of the column to select from. The first
+column is number zero.
+
+@example
+(let (i l)
+ (setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ (setq i (pq-nfields R))
+ (while (>= (decf i) 0)
+ (push (pq-fname R i) l))
+ l)
+ @result{} ("id" "shikona" "rank")
+@end example
+@end defun
+
+@defun pq-fnumber result field-name
+Return the field number corresponding to the given field name.
+-1 is returned on a bad field name.
+@var{result} is a PGresult object.
+@var{field-name} is a string representing the field name to find.
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-fnumber R "id")
+ @result{} 0
+(pq-fnumber R "Not a field")
+ @result{} -1
+@end example
+@end defun
+
+@defun pq-ftype result field-num
+Return an integer code representing the data type of the specified column.
+@var{result} is a PGresult object.
+@var{field-num} is the field number.
+
+The return value of this function is the Object ID (Oid) in the database
+of the type. Further queries need to be made to various system tables
+in order to convert this value into something useful.
+@end defun
+
+@defun pq-fmod result field-num
+Return the type modifier code associated with a field. Field numbers
+start at zero.
+@var{result} is a PGresult object.
+@var{field-index} selects which field to use.
+@end defun
+
+@defun pq-fsize result field-index
+Return size of the given field.
+@var{result} is a PGresult object.
+@var{field-index} selects which field to use.
+
+@example
+(let (i l)
+ (setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ (setq i (pq-nfields R))
+ (while (>= (decf i) 0)
+ (push (list (pq-ftype R i) (pq-fsize R i)) l))
+ l)
+ @result{} ((23 23) (25 25) (25 25))
+@end example
+@end defun
+
+@defun pq-get-value result tup-num field-num
+Retrieve a return value.
+@var{result} is a PGresult object.
+@var{tup-num} selects which tuple to fetch from.
+@var{field-num} selects which field to fetch from.
+
+Both tuples and fields are numbered from zero.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-get-value R 0 1)
+ @result{} "Musashimaru"
+(pq-get-value R 1 1)
+ @result{} "Dejima"
+(pq-get-value R 2 1)
+ @result{} "Musoyama"
+@end example
+@end defun
+
+@defun pq-get-length result tup-num field-num
+Return the length of a specific value.
+@var{result} is a PGresult object.
+@var{tup-num} selects which tuple to fetch from.
+@var{field-num} selects which field to fetch from.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[5] - SELECT>
+(pq-get-length R 0 1)
+ @result{} 11
+(pq-get-length R 1 1)
+ @result{} 6
+(pq-get-length R 2 1)
+ @result{} 8
+@end example
+@end defun
+
+@defun pq-get-is-null result tup-num field-num
+Return t if the specific value is the SQL @var{NULL}.
+@var{result} is a PGresult object.
+@var{tup-num} selects which tuple to fetch from.
+@var{field-num} selects which field to fetch from.
+@end defun
+
+@defun pq-cmd-status result
+Return a summary string from the query.
+@var{result} is a PGresult object.
+@example
+@comment This example was written on day 3 of the 2000 Haru Basho.
+(pq-exec P "INSERT INTO xemacs_test
+ VALUES (6, 'Wakanohana', 'Yokozuna');")
+ @result{} #<PGresult PGRES_COMMAND_OK[1] - INSERT 542086 1>
+(pq-cmd-status R)
+ @result{} "INSERT 542086 1"
+(setq R (pq-exec P "UPDATE xemacs_test SET rank='retired'
+ WHERE shikona='Wakanohana';"))
+ @result{} #<PGresult PGRES_COMMAND_OK[1] - UPDATE 1>
+(pq-cmd-status R)
+ @result{} "UPDATE 1"
+@end example
+
+Note that the first number returned from an insertion, like in the
+example, is an object ID number and will almost certainly vary from
+system to system since object ID numbers in Postgres must be unique
+across all databases.
+@end defun
+
+@defun pq-cmd-tuples result
+Return the number of tuples if the last command was an INSERT/UPDATE/DELETE.
+If the last command was something else, the empty string is returned.
+@var{result} is a PGresult object.
+
+@example
+(setq R (pq-exec P "INSERT INTO xemacs_test VALUES
+ (7, 'Takanohana', 'Yokuzuna');"))
+ @result{} #<PGresult PGRES_COMMAND_OK[1] - INSERT 38688 1>
+(pq-cmd-tuples R)
+ @result{} "1"
+(setq R (pq-exec P "SELECT * from xemacs_test;"))
+ @result{} #<PGresult PGRES_TUPLES_OK[7] - SELECT>
+(pq-cmd-tuples R)
+ @result{} ""
+(setq R (pq-exec P "DELETE FROM xemacs_test
+ WHERE shikona LIKE '%hana';"))
+ @result{} #<PGresult PGRES_COMMAND_OK[2] - DELETE 2>
+(pq-cmd-tuples R)
+ @result{} "2"
+@end example
+@end defun
+
+@defun pq-oid-value result
+Return the object id of the insertion if the last command was an INSERT.
+0 is returned if the last command was not an insertion.
+@var{result} is a PGresult object.
+
+In the first example, the numbers you will see on your local system will
+almost certainly be different, however the second number from the right
+in the unprintable PGresult object and the number returned by
+@code{pq-oid-value} should match.
+@example
+(setq R (pq-exec P "INSERT INTO xemacs_test VALUES
+ (8, 'Terao', 'Maegashira');"))
+ @result{} #<PGresult PGRES_COMMAND_OK[1] - INSERT 542089 1>
+(pq-oid-value R)
+ @result{} 542089
+(setq R (pq-exec P "SELECT shikona FROM xemacs_test
+ WHERE rank='Maegashira';"))
+ @result{} #<PGresult PGRES_TUPLES_OK[2] - SELECT>
+(pq-oid-value R)
+ @result{} 0
+@end example
+@end defun
+
+@defun pq-make-empty-pgresult conn status
+Create an empty pgresult with the given status.
+@var{conn} a database connection object
+@var{status} a value that can be returned by @code{pq-result-status}.
+
+The caller is responsible for making sure the return value gets properly
+freed.
+@end defun
+
+@node Synchronous Interface Functions, Asynchronous Interface Functions, libpq Lisp Symbols and DataTypes, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection Synchronous Interface Functions
+
+@defun pq-connectdb conninfo
+Establish a (synchronous) database connection.
+@var{conninfo} A string of blank separated options. Options are of the
+form ``@var{option} = @var{value}''. If @var{value} contains blanks, it
+must be single quoted. Blanks around the equal sign are optional.
+Multiple option assignments are blank separated.
+@example
+(pq-connectdb "dbname=japanese port = 25432")
+ @result{} #<PGconn localhost:25432 steve/japanese>
+@end example
+The printed representation of a database connection object has four
+fields. The first field is the hostname where the database server is
+running (in this case localhost), the second field is the port number,
+the third field is the database user name, and the fourth field is the
+name of the database.
+
+Database connection objects which have been disconnected and will
+generate an immediate error if they are used look like:
+@example
+ #<PGconn BAD>
+@end example
+Bad connections can be reestablished with @code{pq-reset}, or deleted
+entirely with @code{pq-finish}.
+
+A database connection object that has been deleted looks like:
+@example
+(let ((P1 (pq-connectdb "")))
+ (pq-finish P1)
+ P1)
+ @result{} #<PGconn DEAD>
+@end example
+
+Note that database connection objects are the most heavy weight objects
+in XEmacs Lisp at this writing, usually representing as much as several
+megabytes of virtual memory on the machine the database server is
+running on. It is wisest to explicitly delete them when you are
+finished with them, rather than letting garbage collection do it. An
+example idiom is:
+
+@example
+(let ((P (pq-connectiondb "")))
+ (unwind-protect
+ (progn
+ (...)) ; access database here
+ (pq-finish P)))
+@end example
+
+The following options are available in the options string:
+@table @code
+@item authtype
+Authentication type. Same as @var{PGAUTHTYPE}. This is no longer used.
+@item user
+Database user name. Same as @var{PGUSER}.
+@item password
+Database password.
+@item dbname
+Database name. Same as @var{PGDATABASE}
+@item host
+Symbolic hostname. Same as @var{PGHOST}.
+@item hostaddr
+Host address as four octets (eg. like 192.168.1.1).
+@item port
+TCP port to connect to. Same as @var{PGPORT}.
+@item tty
+Debugging TTY. Same as @var{PGTTY}. This value is suppressed in the
+XEmacs Lisp API.
+@item options
+Extra backend database options. Same as @var{PGOPTIONS}.
+@end table
+A database connection object is returned regardless of whether a
+connection was established or not.
+@end defun
+
+@defun pq-reset conn
+Reestablish database connection.
+@var{conn} A database connection object.
+
+This function reestablishes a database connection using the original
+connection parameters. This is useful if something has happened to the
+TCP link and it has become broken.
+@end defun
+
+@defun pq-exec conn query
+Make a synchronous database query.
+@var{conn} A database connection object.
+@var{query} A string containing an SQL query.
+A PGresult object is returned, which in turn may be queried by its many
+accessor functions to retrieve state out of it. If the query string
+contains multiple SQL commands, only results from the final command are
+returned.
+
+@example
+(setq R (pq-exec P "SELECT * FROM xemacs_test;
+DELETE FROM xemacs_test WHERE id=8;"))
+ @result{} #<PGresult PGRES_COMMAND_OK[1] - DELETE 1>
+@end example
+@end defun
+
+@defun pq-notifies conn
+Return the latest async notification that has not yet been handled.
+@var{conn} A database connection object.
+If there has been a notification, then a list of two elements will be returned.
+The first element contains the relation name being notified, the second
+element contains the backend process ID number. nil is returned if there
+aren't any notifications to process.
+@end defun
+
+@defun PQsetenv conn
+Synchronous transfer of environment variables to a backend
+@var{conn} A database connection object.
+
+Environment variable transfer is done as a normal part of database
+connection.
+
+Compatibility note: This function was present but not documented in versions
+of libpq prior to 7.0.
+@end defun
+
+@node Asynchronous Interface Functions, Large Object Support, Synchronous Interface Functions, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection Asynchronous Interface Functions
+
+Making command by command examples is too complex with the asynchronous
+interface functions. See the examples section for complete calling
+sequences.
+
+@defun pq-connect-start conninfo
+Begin establishing an asynchronous database connection.
+@var{conninfo} A string containing the connection options. See the
+documentation of @code{pq-connectdb} for a listing of all the available
+flags.
+@end defun
+
+@defun pq-connect-poll conn
+An intermediate function to be called during an asynchronous database
+connection.
+@var{conn} A database connection object.
+The result codes are documented in a previous section.
+@end defun
+
+@defun pq-is-busy conn
+Returns t if @code{pq-get-result} would block waiting for input.
+@var{conn} A database connection object.
+@end defun
+
+@defun pq-consume-input conn
+Consume any available input from the backend.
+@var{conn} A database connection object.
+
+Nil is returned if anything bad happens.
+@end defun
+
+@defun pq-reset-start conn
+Reset connection to the backend asynchronously.
+@var{conn} A database connection object.
+@end defun
+
+@defun pq-reset-poll conn
+Poll an asynchronous reset for completion
+@var{conn} A database connection object.
+@end defun
+
+@defun pq-reset-cancel conn
+Attempt to request cancellation of the current operation.
+@var{conn} A database connection object.
+
+The return value is t if the cancel request was successfully
+dispatched, nil if not (in which case conn->errorMessage is set).
+Note: successful dispatch is no guarantee that there will be any effect at
+the backend. The application must read the operation result as usual.
+@end defun
+
+@defun pq-send-query conn query
+Submit a query to Postgres and don't wait for the result.
+@var{conn} A database connection object.
+Returns: t if successfully submitted
+ nil if error (conn->errorMessage is set)
+@end defun
+
+@defun pq-get-result conn
+Retrieve an asynchronous result from a query.
+@var{conn} A database connection object.
+
+NIL is returned when no more query work remains.
+@end defun
+
+@defun pq-set-nonblocking conn arg
+Sets the PGconn's database connection non-blocking if the arg is TRUE
+or makes it non-blocking if the arg is FALSE, this will not protect
+you from PQexec(), you'll only be safe when using the non-blocking API.
+@var{conn} A database connection object.
+@end defun
+
+@defun pq-is-nonblocking conn
+Return the blocking status of the database connection
+@var{conn} A database connection object.
+@end defun
+
+@defun pq-flush conn
+Force the write buffer to be written (or at least try)
+@var{conn} A database connection object.
+@end defun
+
+@defun PQsetenvStart conn
+Start asynchronously passing environment variables to a backend.
+@var{conn} A database connection object.
+
+Compatibility note: this function is only available with libpq-7.0.
+@end defun
+
+@defun PQsetenvPoll conn
+Check an asynchronous enviroment variables transfer for completion.
+@var{conn} A database connection object.
+
+Compatibility note: this function is only available with libpq-7.0.
+@end defun
+
+@defun PQsetenvAbort conn
+Attempt to terminate an asynchronous environment variables transfer.
+@var{conn} A database connection object.
+
+Compatibility note: this function is only available with libpq-7.0.
+@end defun
+
+@node Large Object Support, Other libpq Functions, Asynchronous Interface Functions, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection Large Object Support
+
+@defun pq-lo-import conn filename
+Import a file as a large object into the database.
+@var{conn} a database connection object
+@var{filename} filename to import
+
+On success, the object id is returned.
+@end defun
+
+@defun pq-lo-export conn oid filename
+Copy a large object in the database into a file.
+@var{conn} a database connection object.
+@var{oid} object id number of a large object.
+@var{filename} filename to export to.
+@end defun
+
+@node Other libpq Functions, Unimplemented libpq Functions, Large Object Support, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection Other libpq Functions
+
+@defun pq-finish conn
+Destroy a database connection object by calling free on it.
+@var{conn} a database connection object
+
+It is possible to not call this routine because the usual XEmacs garbage
+collection mechanism will call the underlying libpq routine whenever it
+is releasing stale @code{PGconn} objects. However, this routine is
+useful in @code{unwind-protect} clauses to make connections go away
+quickly when unrecoverable errors have occurred.
+
+After calling this routine, the printed representation of the XEmacs
+wrapper object will contain the string ``DEAD''.
+@end defun
+
+@defun pq-client-encoding conn
+Return the client encoding as an integer code.
+@var{conn} a database connection object
+
+@example
+(pq-client-encoding P)
+ @result{} 1
+@end example
+
+Compatibility note: This function did not exist prior to libpq-7.0 and
+does not exist in a non-Mule XEmacs.
+@end defun
+
+@defun pq-set-client-encoding conn encoding
+Set client coding system.
+@var{conn} a database connection object
+@var{encoding} a string representing the desired coding system
+
+@example
+(pq-set-client-encoding P "EUC_JP")
+ @result{} 0
+@end example
+
+The current idiom for ensuring proper coding system conversion is the
+following (illustrated for EUC Japanese encoding):
+@example
+(setq P (pq-connectdb "..."))
+(let ((file-name-coding-system 'euc-jp)
+ (pg-coding-system 'euc-jp))
+ (pq-set-client-encoding "EUC_JP")
+ ...)
+(pq-finish P)
+@end example
+Compatibility note: This function did not exist prior to libpq-7.0 and
+does not exist in a non-Mule XEmacs.
+@end defun
+
+@defun pq-env-2-encoding
+Return the integer code representing the coding system in @var{PGCLIENTENCODING}.
+
+@example
+(pq-env-2-encoding)
+ @result{} 0
+@end example
+Compatibility note: This function did not exist prior to libpq-7.0 and
+does not exist in a non-Mule XEmacs.
+@end defun
+
+@defun pq-clear res
+Destroy a query result object by calling free() on it.
+@var{res} a query result object
+
+Note: The memory allocation systems of libpq and XEmacs are different.
+The XEmacs representation of a query result object will have both the
+XEmacs version and the libpq version freed at the next garbage collection
+when the object is no longer being referenced. Calling this function does
+not release the XEmacs object, it is still subject to the usual rules for
+Lisp objects. The printed representation of the XEmacs object will contain
+the string ``DEAD'' after this routine is called indicating that it is no
+longer useful for anything.
+@end defun
+
+@defun pq-conn-defaults
+Return a data structure that represents the connection defaults.
+The data is returned as a list of lists, where each sublist contains
+info regarding a single option.
+@end defun
+
+@node Unimplemented libpq Functions, , Other libpq Functions, XEmacs PostgreSQL libpq API
+@comment node-name, next, previous, up
+@subsection Unimplemented libpq Functions
+
+@deftypefn {Unimplemented Function} PGconn *PQsetdbLogin (char *pghost, char *pgport, char *pgoptions, char *pgtty, char *dbName, char *login, char *pwd)
+Synchronous database connection.
+@var{pghost} is the hostname of the PostgreSQL backend to connect to.
+@var{pgport} is the TCP port number to use.
+@var{pgoptions} specifies other backend options.
+@var{pgtty} specifies the debugging tty to use.
+@var{dbName} specifies the database name to use.
+@var{login} specifies the database user name.
+@var{pwd} specifies the database user's password.
+
+This routine is deprecated as of libpq-7.0, and its functionality can be
+replaced by external Lisp code if needed.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} PGconn *PQsetdb (char *pghost, char *pgport, char *pgoptions, char *pgtty, char *dbName)
+Synchronous database connection.
+@var{pghost} is the hostname of the PostgreSQL backend to connect to.
+@var{pgport} is the TCP port number to use.
+@var{pgoptions} specifies other backend options.
+@var{pgtty} specifies the debugging tty to use.
+@var{dbName} specifies the database name to use.
+
+This routine was deprecated in libpq-6.5.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int PQsocket (PGconn *conn)
+Return socket file descriptor to a backend database process.
+@var{conn} database connection object.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} void PQprint (FILE *fout, PGresult *res, PGprintOpt *ps)
+Print out the results of a query to a designated C stream.
+@var{fout} C stream to print to
+@var{res} the query result object to print
+@var{ps} the print options structure.
+
+This routine is deprecated as of libpq-7.0 and cannot be sensibly exported
+to XEmacs Lisp.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} void PQdisplayTuples (PGresult *res, FILE *fp, int fillAlign, char *fieldSep, int printHeader, int quiet)
+@var{res} query result object to print
+@var{fp} C stream to print to
+@var{fillAlign} pad the fields with spaces
+@var{fieldSep} field separator
+@var{printHeader} display headers?
+@var{quiet}
+
+This routine was deprecated in libpq-6.5.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} void PQprintTuples (PGresult *res, FILE *fout, int printAttName, int terseOutput, int width)
+@var{res} query result object to print
+@var{fout} C stream to print to
+@var{printAttName} print attribute names
+@var{terseOutput} delimiter bars
+@var{width} width of column, if 0, use variable width
+
+This routine was deprecated in libpq-6.5.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int PQmblen (char *s, int encoding)
+Determine length of a multibyte encoded char at @code{*s}.
+@var{s} encoded string
+@var{encoding} type of encoding
+
+Compatibility note: This function was introduced in libpq-7.0.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} void PQtrace (PGconn *conn, FILE *debug_port)
+Enable tracing on @code{debug_port}.
+@var{conn} database connection object.
+@var{debug_port} C output stream to use.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} void PQuntrace (PGconn *conn)
+Disable tracing.
+@var{conn} database connection object.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} char *PQoidStatus (PGconn *conn)
+Return the object id as a string of the last tuple inserted.
+@var{conn} database connection object.
+
+Compatibility note: This function is deprecated in libpq-7.0, however it
+is used internally by the XEmacs binding code when linked against versions
+prior to 7.0.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} PGresult *PQfn (PGconn *conn, int fnid, int *result_buf, int *result_len, int result_is_int, PQArgBlock *args, int nargs)
+``Fast path'' interface --- not really recommended for application use
+@var{conn} A database connection object.
+@var{fnid}
+@var{result_buf}
+@var{result_len}
+@var{result_is_int}
+@var{args}
+@var{nargs}
+@end deftypefn
+
+The following set of very low level large object functions aren't
+appropriate to be exported to Lisp.
+
+@deftypefn {Unimplemented Function} int pq-lo-open (PGconn *conn, int lobjid, int mode)
+@var{conn} a database connection object.
+@var{lobjid} a large object ID.
+@var{mode} opening modes.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-close (PGconn *conn, int fd)
+@var{conn} a database connection object.
+@var{fd} a large object file descriptor
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-read (PGconn *conn, int fd, char *buf, int len)
+@var{conn} a database connection object.
+@var{fd} a large object file descriptor.
+@var{buf} buffer to read into.
+@var{len} size of buffer.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-write (PGconn *conn, int fd, char *buf, size_t len)
+@var{conn} a database connection object.
+@var{fd} a large object file descriptor.
+@var{buf} buffer to write from.
+@var{len} size of buffer.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-lseek (PGconn *conn, int fd, int offset, int whence)
+@var{conn} a database connection object.
+@var{fd} a large object file descriptor.
+@var{offset}
+@var{whence}
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-creat (PGconn *conn, int mode)
+@var{conn} a database connection object.
+@var{mode} opening modes.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-tell (PGconn *conn, int fd)
+@var{conn} a database connection object.
+@var{fd} a large object file descriptor.
+@end deftypefn
+
+@deftypefn {Unimplemented Function} int pq-lo-unlink (PGconn *conn, int lobjid)
+@var{conn} a database connection object.
+@var{lbojid} a large object ID.
+@end deftypefn
+
+@node XEmacs PostgreSQL libpq Examples, , XEmacs PostgreSQL libpq API, PostgreSQL Support
+@comment node-name, next, previous, up
+@section XEmacs PostgreSQL libpq Examples
+
+This is an example of one method of establishing an asynchronous
+connection.
+
+@example
+(defun database-poller (P)
+ (message "%S before poll" (pq-pgconn P 'pq::status))
+ (pq-connect-poll P)
+ (message "%S after poll" (pq-pgconn P 'pq::status))
+ (if (eq (pq-pgconn P 'pq::status) 'pg::connection-ok)
+ (message "Done!")
+ (add-timeout .1 'database-poller P)))
+ @result{} database-poller
+(progn
+ (setq P (pq-connect-start ""))
+ (add-timeout .1 'database-poller P))
+ @result{} pg::connection-started before poll
+ @result{} pg::connection-made after poll
+ @result{} pg::connection-made before poll
+ @result{} pg::connection-awaiting-response after poll
+ @result{} pg::connection-awaiting-response before poll
+ @result{} pg::connection-auth-ok after poll
+ @result{} pg::connection-auth-ok before poll
+ @result{} pg::connection-setenv after poll
+ @result{} pg::connection-setenv before poll
+ @result{} pg::connection-ok after poll
+ @result{} Done!
+P
+ @result{} #<PGconn localhost:25432 steve/steve>
+@end example
+
+Here is an example of one method of doing an asynchronous reset.
+
+@example
+(defun database-poller (P)
+ (let (PS)
+ (message "%S before poll" (pq-pgconn P 'pq::status))
+ (setq PS (pq-reset-poll P))
+ (message "%S after poll [%S]" (pq-pgconn P 'pq::status) PS)
+ (if (eq (pq-pgconn P 'pq::status) 'pg::connection-ok)
+ (message "Done!")
+ (add-timeout .1 'database-poller P))))
+ @result{} database-poller
+(progn
+ (pq-reset-start P)
+ (add-timeout .1 'database-poller P))
+ @result{} pg::connection-started before poll
+ @result{} pg::connection-made after poll [pgres::polling-writing]
+ @result{} pg::connection-made before poll
+ @result{} pg::connection-awaiting-response after poll [pgres::polling-reading]
+ @result{} pg::connection-awaiting-response before poll
+ @result{} pg::connection-setenv after poll [pgres::polling-reading]
+ @result{} pg::connection-setenv before poll
+ @result{} pg::connection-ok after poll [pgres::polling-ok]
+ @result{} Done!
+P
+ @result{} #<PGconn localhost:25432 steve/steve>
+@end example
+
+And finally, an asynchronous query.
+
+@example
+(defun database-poller (P)
+ (let (R)
+ (pq-consume-input P)
+ (if (pq-is-busy P)
+ (add-timeout .1 'database-poller P)
+ (setq R (pq-get-result P))
+ (if R
+ (progn
+ (push R result-list)
+ (add-timeout .1 'database-poller P))))))
+ @result{} database-poller
+(when (pq-send-query P "SELECT * FROM xemacs_test;")
+ (setq result-list nil)
+ (add-timeout .1 'database-poller P))
+ @result{} 885
+;; wait a moment
+result-list
+ @result{} (#<PGresult PGRES_TUPLES_OK - SELECT>)
+@end example
+
+Here is an example showing how multiple SQL statements in a single query
+can have all their results collected.
+@example
+;; Using the same @code{database-poller} function from the previous example
+(when (pq-send-query P "SELECT * FROM xemacs_test;
+SELECT * FROM pg_database;
+SELECT * FROM pg_user;")
+ (setq result-list nil)
+ (add-timeout .1 'database-poller P))
+ @result{} 1782
+;; wait a moment
+result-list
+ @result{} (#<PGresult PGRES_TUPLES_OK - SELECT> #<PGresult PGRES_TUPLES_OK - SELECT> #<PGresult PGRES_TUPLES_OK - SELECT>)
+@end example
+
+Here is an example which illustrates collecting all data from a query,
+including the field names.
+
+@example
+(defun pg-util-query-results (results)
+ "Retrieve results of last SQL query into a list structure."
+ (let ((i (1- (pq-ntuples R)))
+ j l1 l2)
+ (while (>= i 0)
+ (setq j (1- (pq-nfields R)))
+ (setq l2 nil)
+ (while (>= j 0)
+ (push (pq-get-value R i j) l2)
+ (decf j))
+ (push l2 l1)
+ (decf i))
+ (setq j (1- (pq-nfields R)))
+ (setq l2 nil)
+ (while (>= j 0)
+ (push (pq-fname R j) l2)
+ (decf j))
+ (push l2 l1)
+ l1))
+ @result{} pg-util-query-results
+(setq R (pq-exec P "SELECT * FROM xemacs_test ORDER BY field2 DESC;"))
+ @result{} #<PGresult PGRES_TUPLES_OK - SELECT>
+(pg-util-query-results R)
+ @result{} (("f1" "field2") ("a" "97") ("b" "97") ("stuff" "42") ("a string" "12") ("foo" "10") ("string" "2") ("text" "1"))
+@end example
+
+Here is an example of a query that uses a database cursor.
+
+@example
+(let (data R)
+ (setq R (pq-exec P "BEGIN;"))
+ (setq R (pq-exec P "DECLARE k_cursor CURSOR FOR SELECT * FROM xemacs_test ORDER BY f1 DESC;"))
+
+ (setq R (pq-exec P "FETCH k_cursor;"))
+ (while (eq (pq-ntuples R) 1)
+ (push (list (pq-get-value R 0 0) (pq-get-value R 0 1)) data)
+ (setq R (pq-exec P "FETCH k_cursor;")))
+ (setq R (pq-exec P "END;"))
+ data)
+ @result{} (("a" "97") ("a string" "12") ("b" "97") ("foo" "10") ("string" "2") ("stuff" "42") ("text" "1"))
+@end example
+
+Here's another example of cursors, this time with a Lisp macro to
+implement a mapping function over a table.
+
+@example
+(defmacro map-db (P table condition callout)
+ `(let (R)
+ (pq-exec ,P "BEGIN;")
+ (pq-exec ,P (concat "DECLARE k_cursor CURSOR FOR SELECT * FROM "
+ ,table
+ " "
+ ,condition
+ " ORDER BY f1 DESC;"))
+ (setq R (pq-exec P "FETCH k_cursor;"))
+ (while (eq (pq-ntuples R) 1)
+ (,callout (pq-get-value R 0 0) (pq-get-value R 0 1))
+ (setq R (pq-exec P "FETCH k_cursor;")))
+ (pq-exec P "END;")))
+ @result{} map-db
+(defun callback (arg1 arg2)
+ (message "arg1 = %s, arg2 = %s" arg1 arg2))
+ @result{} callback
+(map-db P "xemacs_test" "WHERE field2 > 10" callback)
+ @result{} arg1 = stuff, arg2 = 42
+ @result{} arg1 = b, arg2 = 97
+ @result{} arg1 = a string, arg2 = 12
+ @result{} arg1 = a, arg2 = 97
+ @result{} #<PGresult PGRES_COMMAND_OK - COMMIT>
+@end example
--- /dev/null
+# -*- mode: makefile -*-
+
+############################################################################
+
+INSTALL_DIR=c:\Program Files\XEmacs\XEmacs-$(XEMACS_VERSION_STRING)
+
+PACKAGE_PREFIX=c:\Program Files\XEmacs
+
+############################################################################
+
+# Multilingual support (not currently working).
+HAVE_MULE=0
+
+# Native MS Windows support.
+HAVE_MSW=1
+
+# X Windows support.
+HAVE_X=0
+X11_DIR=
+
+############################################################################
+
+# Set this to enable XPM support (virtually mandatory), and specify
+# the directory containing xpm.
+HAVE_XPM=1
+XPM_DIR=f:\src\xpm-3.4k
+
+# Set this to enable GIF support.
+HAVE_GIF=1
+
+# Set this to enable PNG support (virtually mandatory), and specify
+# the directories containing png and zlib.
+HAVE_PNG=1
+PNG_DIR=f:\src\libpng-1.0.3
+ZLIB_DIR=f:\src\zlib
+
+# Set this to enable TIFF support, and specify the directory containing tiff.
+HAVE_TIFF=0
+TIFF_DIR=
+
+# Set this to enable JPEG support, and specify the directory containing jpeg.
+HAVE_JPEG=0
+JPEG_DIR=
+
+# Set this to enable XFace support, and specify the directory containing
+# compface.
+HAVE_XFACE=0
+COMPFACE_DIR=
+
+############################################################################
+
+# Set this to specify the location of makeinfo. (If not set, XEmacs will
+# attempt to use its built-in texinfo support when building info files.)
+MAKEINFO=f:\src\texinfo-4.0\makeinfo\makeinfo.exe
+
+############################################################################
+
+# Set this to enable some debug code that doesn't slow things down.
+DEBUG_XEMACS=1
+
+# Set this to see exactly which compilation commands are being run (not
+# generally recommended).
+VERBOSECC=0
+
+############################################################################
+
+# Some technical options.
+
+USE_MINIMAL_TAGBITS=0
+USE_INDEXED_LRECORD_IMPLEMENTATION=0
+USE_PORTABLE_DUMPER=0
+GUNG_HO=0
--- /dev/null
+# Microsoft Developer Studio Project File - Name="xemacs" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 5.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) External Target" 0x0106
+
+CFG=xemacs - Win32 Debug
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE
+!MESSAGE NMAKE /f "xemacs.mak".
+!MESSAGE
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE
+!MESSAGE NMAKE /f "xemacs.mak" CFG="xemacs - Win32 Debug"
+!MESSAGE
+!MESSAGE Possible choices for configuration are:
+!MESSAGE
+!MESSAGE "xemacs - Win32 Release" (based on "Win32 (x86) External Target")
+!MESSAGE "xemacs - Win32 Debug" (based on "Win32 (x86) External Target")
+!MESSAGE
+
+# Begin Project
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+
+!IF "$(CFG)" == "xemacs - Win32 Release"
+
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "Release"
+# PROP BASE Intermediate_Dir "Release"
+# PROP BASE Cmd_Line "NMAKE /f xemacs.mak"
+# PROP BASE Rebuild_Opt "/a"
+# PROP BASE Target_File "xemacs.exe"
+# PROP BASE Bsc_Name "xemacs.bsc"
+# PROP BASE Target_Dir ""
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "Release"
+# PROP Intermediate_Dir "Release"
+# PROP Cmd_Line "NMAKE /f xemacs.mak"
+# PROP Rebuild_Opt "/a"
+# PROP Target_File "xemacs.exe"
+# PROP Bsc_Name "xemacs.bsc"
+# PROP Target_Dir ""
+
+!ELSEIF "$(CFG)" == "xemacs - Win32 Debug"
+
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir "Debug"
+# PROP BASE Intermediate_Dir "Debug"
+# PROP BASE Cmd_Line "NMAKE /f xemacs.mak"
+# PROP BASE Rebuild_Opt "/a"
+# PROP BASE Target_File "xemacs.exe"
+# PROP BASE Bsc_Name "xemacs.bsc"
+# PROP BASE Target_Dir ""
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir "Debug"
+# PROP Intermediate_Dir "Debug"
+# PROP Cmd_Line "NMAKE /f xemacs.mak"
+# PROP Rebuild_Opt "/a"
+# PROP Target_File "..\src\xemacs.exe"
+# PROP Bsc_Name "..\src\temacs.bsc"
+# PROP Target_Dir ""
+
+!ENDIF
+
+# Begin Target
+
+# Name "xemacs - Win32 Release"
+# Name "xemacs - Win32 Debug"
+
+!IF "$(CFG)" == "xemacs - Win32 Release"
+
+!ELSEIF "$(CFG)" == "xemacs - Win32 Debug"
+
+!ENDIF
+
+# Begin Source File
+
+SOURCE=..\src\abbrev.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\alloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\alloca.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\backtrace.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\balloon-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\balloon_help.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\balloon_help.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\bitmaps.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\blocktype.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\blocktype.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\broken-sun.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\buffer.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\buffer.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\bufslots.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\bytecode.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\bytecode.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\callint.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\callproc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\casefiddle.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\casetab.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\chartab.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\chartab.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\cm.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\cm.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\cmdloop.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\cmds.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\commands.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\config.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\conslots.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-msw.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-stream.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-stream.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-tty.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\console-x.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\console.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\console.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\data.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\database.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\database.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\debug.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\debug.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\device-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\device-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\device-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\device.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\device.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dgif_lib.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\dialog-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\dialog-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dialog.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\dired-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dired.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\doc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\doprnt.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dragdrop.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dragdrop.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\dynarr.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ecrt0.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\editfns.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\eldap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\eldap.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\elhash.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\elhash.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\Emacs.ad.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\emacs.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsFrame.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsFrame.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsFrameP.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsManager.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsManager.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsManagerP.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\EmacsShell-sub.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsShell.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsShell.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\EmacsShellP.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\emodules.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\emodules.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\esd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\eval.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\event-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\event-stream.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\event-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\event-unixoid.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\event-Xt.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\events-mod.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\events.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\events.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\extents.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\extents.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\ExternalClient-Xlib.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalClient.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalClient.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalClientP.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalShell.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalShell.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ExternalShellP.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\extw-Xlib.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\extw-Xlib.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\extw-Xt.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\extw-Xt.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\faces.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\faces.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\file-coding.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\file-coding.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\fileio.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\filelock.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\filemode.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\floatfns.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\fns.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\font-lock.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\frame-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\frame-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\frame-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\frame.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\frame.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\frameslots.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\free-hook.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\general.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\getloadavg.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\getpagesize.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gif_io.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gifrlib.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-eimage.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-msw.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-widget.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\glyphs-x.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\glyphs.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\glyphs.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gmalloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gpmevent.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gpmevent.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\gui-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\gui-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\gui-x.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gui.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gui.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gutter.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\gutter.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\hash.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\hash.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\hftctl.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\hpplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\imgproc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\imgproc.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\indent.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\inline.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\input-method-motif.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\input-method-xfs.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\input-method-xlib.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\insdel.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\insdel.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\intl.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\iso-wide.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\keymap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\keymap.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lastfile.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\libsst.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\libsst.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\libst.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\line-number.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\line-number.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\linuxplay.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\lisp-disunion.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\lisp-union.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lisp.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lread.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lrecord.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lstream.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\lstream.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\macros.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\macros.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\malloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\marker.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\md5.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mem-limits.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\menubar-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\menubar-msw.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\menubar-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\menubar.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\menubar.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\minibuf.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\miscplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\miscplay.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-canna.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-ccl.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-ccl.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-charset.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-charset.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-mcpath.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-mcpath.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\mule-wnnfns.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\mule.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\nas.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ndir.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\nt.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\nt.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ntheap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ntheap.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ntplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ntproc.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-msw.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-tty.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\objects-x.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\objects.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\objects.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\offix-cursors.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\offix-types.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\offix.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\offix.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\opaque.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\opaque.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\paths.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\pre-crt0.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\print.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\process-nt.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\process-unix.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\process.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\process.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\procimpl.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\profile.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\ralloc.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\rangetab.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\rangetab.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\realpath.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\redisplay-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\redisplay-output.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\redisplay-tty.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\redisplay-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\redisplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\redisplay.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\regex.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\regex.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\scrollbar-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\scrollbar-msw.h"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\scrollbar-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\scrollbar-x.h"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\scrollbar.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\scrollbar.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\search.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\select-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\select-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\select.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\select.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sgiplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sheap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\signal.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sound.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\specifier.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\specifier.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\strcat.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\strcmp.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\strcpy.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\strftime.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\sunOS-fix.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sunplay.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sunpro.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\symbols.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\symeval.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\symsinit.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\syntax.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\syntax.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysdep.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysdep.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysdir.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysdll.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysdll.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysfile.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysfloat.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\sysproc.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\syspwd.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\syssignal.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\systime.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\systty.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\syswait.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\termcap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\terminfo.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\toolbar-msw.c"
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\toolbar-x.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\toolbar.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\toolbar.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\tooltalk.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\tooltalk.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\tparam.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\undo.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexaix.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexalpha.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexapollo.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexconvex.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexcw.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexec.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexelf.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexelfsgi.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexencap.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexenix.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexfreebsd.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexfx2800.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexhp9k3.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexhp9k800.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexmips.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexnext.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexnt.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexsni.c
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\unexsol2-6.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexsol2.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\unexsunos4.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\universe.h
+# End Source File
+# Begin Source File
+
+SOURCE="..\src\vm-limit.c"
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\widget.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\window.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\window.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\winslots.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\xemacs.mak
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xgccache.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xgccache.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xintrinsic.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xintrinsicp.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xmmanagerp.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xmprimitivep.h
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xmu.c
+# End Source File
+# Begin Source File
+
+SOURCE=..\src\xmu.h
+# End Source File
+# End Target
+# End Project
--- /dev/null
+Microsoft Developer Studio Workspace File, Format Version 5.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "xemacs"=".\xemacs.dsp" - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{
+}}}
+
+Package=<3>
+{{{
+}}}
+
+###############################################################################
+
--- /dev/null
+/* Portable data dumper for XEmacs.
+ Copyright (C) 1999-2000 Olivier Galibert
+
+This file is part of XEmacs.
+
+XEmacs 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, or (at your option) any
+later version.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in FSF. */
+
+#include <config.h>
+#include "lisp.h"
+#include "dump-id.h"
+#include "specifier.h"
+#include "alloc.h"
+#include "elhash.h"
+#include "sysfile.h"
+#include "console-stream.h"
+#include "dumper.h"
+
+#ifdef HAVE_MMAP
+#include <sys/mman.h>
+#endif
+
+#ifndef SEPCHAR
+#define SEPCHAR ':'
+#endif
+
+typedef struct
+{
+ const struct lrecord_description *desc;
+ int count;
+} pdump_reloc_table;
+
+static char *pdump_rt_list = 0;
+
+void
+pdump_objects_unmark (void)
+{
+ int i;
+ char *p = pdump_rt_list;
+ if (p)
+ for (;;)
+ {
+ pdump_reloc_table *rt = (pdump_reloc_table *)p;
+ p += sizeof (pdump_reloc_table);
+ if (rt->desc)
+ {
+ for (i=0; i<rt->count; i++)
+ {
+ struct lrecord_header *lh = * (struct lrecord_header **) p;
+ if (! C_READONLY_RECORD_HEADER_P (lh))
+ UNMARK_RECORD_HEADER (lh);
+ p += sizeof (EMACS_INT);
+ }
+ } else
+ break;
+ }
+}
+
+
+/* The structure of the file
+ *
+ * 0 - header
+ * 256 - dumped objects
+ * stab_offset - nb_staticpro*(Lisp_Object *) from staticvec
+ * - nb_staticpro*(relocated Lisp_Object) pointed to by staticpro
+ * - nb_structdmp*pair(void *, adr) for pointers to structures
+ * - lrecord_implementations_table[]
+ * - relocation table
+ * - wired variable address/value couples with the count preceding the list
+ */
+
+
+#define DUMP_SIGNATURE "XEmacsDP"
+#define DUMP_SIGNATURE_LEN (sizeof (DUMP_SIGNATURE) - 1)
+
+typedef struct
+{
+ char signature[DUMP_SIGNATURE_LEN];
+ unsigned int id;
+ EMACS_UINT stab_offset;
+ EMACS_UINT reloc_address;
+ int nb_staticpro;
+ int nb_structdmp;
+ int nb_opaquedmp;
+} dump_header;
+
+char *pdump_start, *pdump_end;
+static size_t pdump_length;
+void (*pdump_free) (void);
+
+static const unsigned char align_table[256] =
+{
+ 8, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 7, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 6, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 5, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0,
+ 4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
+};
+
+typedef struct pdump_entry_list_elmt
+{
+ struct pdump_entry_list_elmt *next;
+ const void *obj;
+ size_t size;
+ int count;
+ int is_lrecord;
+ EMACS_INT save_offset;
+} pdump_entry_list_elmt;
+
+typedef struct
+{
+ pdump_entry_list_elmt *first;
+ int align;
+ int count;
+} pdump_entry_list;
+
+typedef struct pdump_struct_list_elmt
+{
+ pdump_entry_list list;
+ const struct struct_description *sdesc;
+} pdump_struct_list_elmt;
+
+typedef struct
+{
+ pdump_struct_list_elmt *list;
+ int count;
+ int size;
+} pdump_struct_list;
+
+static pdump_entry_list pdump_object_table[256];
+static pdump_entry_list pdump_opaque_data_list;
+static pdump_struct_list pdump_struct_table;
+static pdump_entry_list_elmt *pdump_qnil;
+
+static int pdump_alert_undump_object[256];
+
+static unsigned long cur_offset;
+static size_t max_size;
+static int pdump_fd;
+static void *pdump_buf;
+
+#define PDUMP_HASHSIZE 200001
+
+static pdump_entry_list_elmt **pdump_hash;
+
+/* Since most pointers are eight bytes aligned, the >>3 allows for a better hash */
+static int
+pdump_make_hash (const void *obj)
+{
+ return ((unsigned long)(obj)>>3) % PDUMP_HASHSIZE;
+}
+
+static pdump_entry_list_elmt *
+pdump_get_entry (const void *obj)
+{
+ int pos = pdump_make_hash (obj);
+ pdump_entry_list_elmt *e;
+
+ assert (obj != 0);
+
+ while ((e = pdump_hash[pos]) != 0)
+ {
+ if (e->obj == obj)
+ return e;
+
+ pos++;
+ if (pos == PDUMP_HASHSIZE)
+ pos = 0;
+ }
+ return 0;
+}
+
+static void
+pdump_add_entry (pdump_entry_list *list, const void *obj, size_t size, int count, int is_lrecord)
+{
+ pdump_entry_list_elmt *e;
+ int align;
+ int pos = pdump_make_hash (obj);
+
+ while ((e = pdump_hash[pos]) != 0)
+ {
+ if (e->obj == obj)
+ return;
+
+ pos++;
+ if (pos == PDUMP_HASHSIZE)
+ pos = 0;
+ }
+
+ e = xnew (pdump_entry_list_elmt);
+
+ e->next = list->first;
+ e->obj = obj;
+ e->size = size;
+ e->count = count;
+ e->is_lrecord = is_lrecord;
+ list->first = e;
+
+ list->count += count;
+ pdump_hash[pos] = e;
+
+ align = align_table[size & 255];
+ if (align < 2 && is_lrecord)
+ align = 2;
+
+ if (align < list->align)
+ list->align = align;
+}
+
+static pdump_entry_list *
+pdump_get_entry_list (const struct struct_description *sdesc)
+{
+ int i;
+ for (i=0; i<pdump_struct_table.count; i++)
+ if (pdump_struct_table.list[i].sdesc == sdesc)
+ return &pdump_struct_table.list[i].list;
+
+ if (pdump_struct_table.size <= pdump_struct_table.count)
+ {
+ if (pdump_struct_table.size == -1)
+ pdump_struct_table.size = 10;
+ else
+ pdump_struct_table.size = pdump_struct_table.size * 2;
+ pdump_struct_table.list = (pdump_struct_list_elmt *)
+ xrealloc (pdump_struct_table.list,
+ pdump_struct_table.size * sizeof (pdump_struct_list_elmt));
+ }
+ pdump_struct_table.list[pdump_struct_table.count].list.first = 0;
+ pdump_struct_table.list[pdump_struct_table.count].list.align = 8;
+ pdump_struct_table.list[pdump_struct_table.count].list.count = 0;
+ pdump_struct_table.list[pdump_struct_table.count].sdesc = sdesc;
+
+ return &pdump_struct_table.list[pdump_struct_table.count++].list;
+}
+
+static struct
+{
+ struct lrecord_header *obj;
+ int position;
+ int offset;
+} backtrace[65536];
+
+static int depth;
+
+static void pdump_backtrace (void)
+{
+ int i;
+ stderr_out ("pdump backtrace :\n");
+ for (i=0;i<depth;i++)
+ {
+ if (!backtrace[i].obj)
+ stderr_out (" - ind. (%d, %d)\n", backtrace[i].position, backtrace[i].offset);
+ else
+ {
+ stderr_out (" - %s (%d, %d)\n",
+ LHEADER_IMPLEMENTATION (backtrace[i].obj)->name,
+ backtrace[i].position,
+ backtrace[i].offset);
+ }
+ }
+}
+
+static void pdump_register_object (Lisp_Object obj);
+static void pdump_register_struct (const void *data, const struct struct_description *sdesc, int count);
+
+static EMACS_INT
+pdump_get_indirect_count (EMACS_INT code, const struct lrecord_description *idesc, const void *idata)
+{
+ EMACS_INT count;
+ const void *irdata;
+
+ int line = XD_INDIRECT_VAL (code);
+ int delta = XD_INDIRECT_DELTA (code);
+
+ irdata = ((char *)idata) + idesc[line].offset;
+ switch (idesc[line].type)
+ {
+ case XD_SIZE_T:
+ count = *(size_t *)irdata;
+ break;
+ case XD_INT:
+ count = *(int *)irdata;
+ break;
+ case XD_LONG:
+ count = *(long *)irdata;
+ break;
+ case XD_BYTECOUNT:
+ count = *(Bytecount *)irdata;
+ break;
+ default:
+ stderr_out ("Unsupported count type : %d (line = %d, code=%ld)\n", idesc[line].type, line, (long)code);
+ pdump_backtrace ();
+ abort ();
+ }
+ count += delta;
+ return count;
+}
+
+static void
+pdump_register_sub (const void *data, const struct lrecord_description *desc, int me)
+{
+ int pos;
+
+ restart:
+ for (pos = 0; desc[pos].type != XD_END; pos++)
+ {
+ const void *rdata = (const char *)data + desc[pos].offset;
+
+ backtrace[me].position = pos;
+ backtrace[me].offset = desc[pos].offset;
+
+ switch (desc[pos].type)
+ {
+ case XD_SPECIFIER_END:
+ pos = 0;
+ desc = ((const Lisp_Specifier *)data)->methods->extra_description;
+ goto restart;
+ case XD_SIZE_T:
+ case XD_INT:
+ case XD_LONG:
+ case XD_BYTECOUNT:
+ case XD_LO_RESET_NIL:
+ case XD_INT_RESET:
+ case XD_LO_LINK:
+ break;
+ case XD_OPAQUE_DATA_PTR:
+ {
+ EMACS_INT count = desc[pos].data1;
+ if (XD_IS_INDIRECT (count))
+ count = pdump_get_indirect_count (count, desc, data);
+
+ pdump_add_entry (&pdump_opaque_data_list,
+ *(void **)rdata,
+ count,
+ 1,
+ 0);
+ break;
+ }
+ case XD_C_STRING:
+ {
+ const char *str = *(const char **)rdata;
+ if (str)
+ pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
+ break;
+ }
+ case XD_DOC_STRING:
+ {
+ const char *str = *(const char **)rdata;
+ if ((EMACS_INT)str > 0)
+ pdump_add_entry (&pdump_opaque_data_list, str, strlen (str)+1, 1, 0);
+ break;
+ }
+ case XD_LISP_OBJECT:
+ {
+ const Lisp_Object *pobj = (const Lisp_Object *)rdata;
+
+ assert (desc[pos].data1 == 0);
+
+ backtrace[me].offset = (const char *)pobj - (const char *)data;
+ pdump_register_object (*pobj);
+ break;
+ }
+ case XD_LISP_OBJECT_ARRAY:
+ {
+ int i;
+ EMACS_INT count = desc[pos].data1;
+ if (XD_IS_INDIRECT (count))
+ count = pdump_get_indirect_count (count, desc, data);
+
+ for (i = 0; i < count; i++)
+ {
+ const Lisp_Object *pobj = ((const Lisp_Object *)rdata) + i;
+ Lisp_Object dobj = *pobj;
+
+ backtrace[me].offset = (const char *)pobj - (const char *)data;
+ pdump_register_object (dobj);
+ }
+ break;
+ }
+ case XD_STRUCT_PTR:
+ {
+ EMACS_INT count = desc[pos].data1;
+ const struct struct_description *sdesc = desc[pos].data2;
+ const char *dobj = *(const char **)rdata;
+ if (dobj)
+ {
+ if (XD_IS_INDIRECT (count))
+ count = pdump_get_indirect_count (count, desc, data);
+
+ pdump_register_struct (dobj, sdesc, count);
+ }
+ break;
+ }
+ default:
+ stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
+ pdump_backtrace ();
+ abort ();
+ };
+ }
+}
+
+static void
+pdump_register_object (Lisp_Object obj)
+{
+ struct lrecord_header *objh;
+
+ if (!POINTER_TYPE_P (XTYPE (obj)))
+ return;
+
+ objh = XRECORD_LHEADER (obj);
+ if (!objh)
+ return;
+
+ if (pdump_get_entry (objh))
+ return;
+
+ if (LHEADER_IMPLEMENTATION (objh)->description)
+ {
+ int me = depth++;
+ if (me>65536)
+ {
+ stderr_out ("Backtrace overflow, loop ?\n");
+ abort ();
+ }
+ backtrace[me].obj = objh;
+ backtrace[me].position = 0;
+ backtrace[me].offset = 0;
+
+ pdump_add_entry (pdump_object_table + objh->type,
+ objh,
+ LHEADER_IMPLEMENTATION (objh)->static_size ?
+ LHEADER_IMPLEMENTATION (objh)->static_size :
+ LHEADER_IMPLEMENTATION (objh)->size_in_bytes_method (objh),
+ 1,
+ 1);
+ pdump_register_sub (objh,
+ LHEADER_IMPLEMENTATION (objh)->description,
+ me);
+ --depth;
+ }
+ else
+ {
+ pdump_alert_undump_object[objh->type]++;
+ stderr_out ("Undumpable object type : %s\n", LHEADER_IMPLEMENTATION (objh)->name);
+ pdump_backtrace ();
+ }
+}
+
+static void
+pdump_register_struct (const void *data, const struct struct_description *sdesc, int count)
+{
+ if (data && !pdump_get_entry (data))
+ {
+ int me = depth++;
+ int i;
+ if (me>65536)
+ {
+ stderr_out ("Backtrace overflow, loop ?\n");
+ abort ();
+ }
+ backtrace[me].obj = 0;
+ backtrace[me].position = 0;
+ backtrace[me].offset = 0;
+
+ pdump_add_entry (pdump_get_entry_list (sdesc),
+ data,
+ sdesc->size,
+ count,
+ 0);
+ for (i=0; i<count; i++)
+ {
+ pdump_register_sub (((char *)data) + sdesc->size*i,
+ sdesc->description,
+ me);
+ }
+ --depth;
+ }
+}
+
+static void
+pdump_dump_data (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
+{
+ size_t size = elmt->size;
+ int count = elmt->count;
+ if (desc)
+ {
+ int pos, i;
+ memcpy (pdump_buf, elmt->obj, size*count);
+
+ for (i=0; i<count; i++)
+ {
+ char *cur = ((char *)pdump_buf) + i*size;
+ restart:
+ for (pos = 0; desc[pos].type != XD_END; pos++)
+ {
+ void *rdata = cur + desc[pos].offset;
+ switch (desc[pos].type)
+ {
+ case XD_SPECIFIER_END:
+ desc = ((const Lisp_Specifier *)(elmt->obj))->methods->extra_description;
+ goto restart;
+ case XD_SIZE_T:
+ case XD_INT:
+ case XD_LONG:
+ case XD_BYTECOUNT:
+ break;
+ case XD_LO_RESET_NIL:
+ {
+ EMACS_INT num = desc[pos].data1;
+ int j;
+ if (XD_IS_INDIRECT (num))
+ num = pdump_get_indirect_count (num, desc, elmt->obj);
+ for (j=0; j<num; j++)
+ ((EMACS_INT *)rdata)[j] = pdump_qnil->save_offset;
+ break;
+ }
+ case XD_INT_RESET:
+ {
+ EMACS_INT val = desc[pos].data1;
+ if (XD_IS_INDIRECT (val))
+ val = pdump_get_indirect_count (val, desc, elmt->obj);
+ *(int *)rdata = val;
+ break;
+ }
+ case XD_OPAQUE_DATA_PTR:
+ case XD_C_STRING:
+ case XD_STRUCT_PTR:
+ {
+ void *ptr = *(void **)rdata;
+ if (ptr)
+ *(EMACS_INT *)rdata = pdump_get_entry (ptr)->save_offset;
+ break;
+ }
+ case XD_LO_LINK:
+ {
+ Lisp_Object obj = *(Lisp_Object *)rdata;
+ pdump_entry_list_elmt *elmt1;
+ for (;;)
+ {
+ elmt1 = pdump_get_entry (XRECORD_LHEADER (obj));
+ if (elmt1)
+ break;
+ obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
+ }
+ *(EMACS_INT *)rdata = elmt1->save_offset;
+ break;
+ }
+ case XD_LISP_OBJECT:
+ {
+ Lisp_Object *pobj = (Lisp_Object *) rdata;
+
+ assert (desc[pos].data1 == 0);
+
+ if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
+ *(EMACS_INT *)pobj =
+ pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
+ break;
+ }
+ case XD_LISP_OBJECT_ARRAY:
+ {
+ EMACS_INT num = desc[pos].data1;
+ int j;
+ if (XD_IS_INDIRECT (num))
+ num = pdump_get_indirect_count (num, desc, elmt->obj);
+
+ for (j=0; j<num; j++)
+ {
+ Lisp_Object *pobj = ((Lisp_Object *)rdata) + j;
+ if (POINTER_TYPE_P (XTYPE (*pobj)) && XRECORD_LHEADER (*pobj))
+ *(EMACS_INT *)pobj =
+ pdump_get_entry (XRECORD_LHEADER (*pobj))->save_offset;
+ }
+ break;
+ }
+ case XD_DOC_STRING:
+ {
+ EMACS_INT str = *(EMACS_INT *)rdata;
+ if (str > 0)
+ *(EMACS_INT *)rdata = pdump_get_entry ((void *)str)->save_offset;
+ break;
+ }
+ default:
+ stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
+ abort ();
+ };
+ }
+ }
+ }
+ write (pdump_fd, desc ? pdump_buf : elmt->obj, size*count);
+ if (elmt->is_lrecord && ((size*count) & 3))
+ write (pdump_fd, "\0\0\0", 4-((size*count) & 3));
+}
+
+static void
+pdump_reloc_one (void *data, EMACS_INT delta, const struct lrecord_description *desc)
+{
+ int pos;
+
+ restart:
+ for (pos = 0; desc[pos].type != XD_END; pos++)
+ {
+ void *rdata = (char *)data + desc[pos].offset;
+ switch (desc[pos].type)
+ {
+ case XD_SPECIFIER_END:
+ pos = 0;
+ desc = ((const Lisp_Specifier *)data)->methods->extra_description;
+ goto restart;
+ case XD_SIZE_T:
+ case XD_INT:
+ case XD_LONG:
+ case XD_BYTECOUNT:
+ case XD_INT_RESET:
+ break;
+ case XD_OPAQUE_DATA_PTR:
+ case XD_C_STRING:
+ case XD_STRUCT_PTR:
+ case XD_LO_LINK:
+ {
+ EMACS_INT ptr = *(EMACS_INT *)rdata;
+ if (ptr)
+ *(EMACS_INT *)rdata = ptr+delta;
+ break;
+ }
+ case XD_LISP_OBJECT:
+ {
+ Lisp_Object *pobj = (Lisp_Object *) rdata;
+
+ assert (desc[pos].data1 == 0);
+
+ if (POINTER_TYPE_P (XTYPE (*pobj))
+ && ! EQ (*pobj, Qnull_pointer))
+ XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
+
+ break;
+ }
+ case XD_LISP_OBJECT_ARRAY:
+ case XD_LO_RESET_NIL:
+ {
+ EMACS_INT num = desc[pos].data1;
+ int j;
+ if (XD_IS_INDIRECT (num))
+ num = pdump_get_indirect_count (num, desc, data);
+
+ for (j=0; j<num; j++)
+ {
+ Lisp_Object *pobj = (Lisp_Object *) rdata + j;
+
+ if (POINTER_TYPE_P (XTYPE (*pobj))
+ && ! EQ (*pobj, Qnull_pointer))
+ XSETOBJ (*pobj, XTYPE (*pobj), (char *) XPNTR (*pobj) + delta);
+ }
+ break;
+ }
+ case XD_DOC_STRING:
+ {
+ EMACS_INT str = *(EMACS_INT *)rdata;
+ if (str > 0)
+ *(EMACS_INT *)rdata = str + delta;
+ break;
+ }
+ default:
+ stderr_out ("Unsupported dump type : %d\n", desc[pos].type);
+ abort ();
+ };
+ }
+}
+
+static void
+pdump_allocate_offset (pdump_entry_list_elmt *elmt, const struct lrecord_description *desc)
+{
+ size_t size = (elmt->is_lrecord ? (elmt->size + 3) & ~3 : elmt->size)*elmt->count;
+ elmt->save_offset = cur_offset;
+ if (size>max_size)
+ max_size = size;
+ cur_offset += size;
+}
+
+static void
+pdump_scan_by_alignment (void (*f)(pdump_entry_list_elmt *, const struct lrecord_description *))
+{
+ int align, i;
+ const struct lrecord_description *idesc;
+ pdump_entry_list_elmt *elmt;
+ for (align=8; align>=0; align--)
+ {
+ for (i=0; i<lrecord_type_count; i++)
+ if (pdump_object_table[i].align == align)
+ {
+ elmt = pdump_object_table[i].first;
+ if (!elmt)
+ continue;
+ idesc = lrecord_implementations_table[i]->description;
+ while (elmt)
+ {
+ f (elmt, idesc);
+ elmt = elmt->next;
+ }
+ }
+
+ for (i=0; i<pdump_struct_table.count; i++)
+ if (pdump_struct_table.list[i].list.align == align)
+ {
+ elmt = pdump_struct_table.list[i].list.first;
+ idesc = pdump_struct_table.list[i].sdesc->description;
+ while (elmt)
+ {
+ f (elmt, idesc);
+ elmt = elmt->next;
+ }
+ }
+
+ elmt = pdump_opaque_data_list.first;
+ while (elmt)
+ {
+ if (align_table[elmt->size & 255] == align)
+ f (elmt, 0);
+ elmt = elmt->next;
+ }
+ }
+}
+
+static void
+pdump_dump_staticvec (void)
+{
+ EMACS_INT *reloc = xnew_array (EMACS_INT, staticidx);
+ int i;
+ write (pdump_fd, staticvec, staticidx*sizeof (Lisp_Object *));
+
+ for (i=0; i<staticidx; i++)
+ {
+ Lisp_Object obj = *staticvec[i];
+ if (POINTER_TYPE_P (XTYPE (obj)))
+ reloc[i] = pdump_get_entry (XRECORD_LHEADER (obj))->save_offset;
+ else
+ reloc[i] = *(EMACS_INT *)(staticvec[i]);
+ }
+ write (pdump_fd, reloc, staticidx*sizeof (Lisp_Object));
+ free (reloc);
+}
+
+static void
+pdump_dump_structvec (void)
+{
+ int i;
+ for (i=0; i<dumpstructidx; i++)
+ {
+ EMACS_INT adr;
+ write (pdump_fd, &(dumpstructvec[i].data), sizeof (void *));
+ adr = pdump_get_entry (*(void **)(dumpstructvec[i].data))->save_offset;
+ write (pdump_fd, &adr, sizeof (adr));
+ }
+}
+
+static void
+pdump_dump_opaquevec (void)
+{
+ int i;
+ for (i=0; i<dumpopaqueidx; i++)
+ {
+ write (pdump_fd, &(dumpopaquevec[i]), sizeof (dumpopaquevec[i]));
+ write (pdump_fd, dumpopaquevec[i].data, dumpopaquevec[i].size);
+ }
+}
+
+static void
+pdump_dump_itable (void)
+{
+ write (pdump_fd, lrecord_implementations_table, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
+}
+
+static void
+pdump_dump_rtables (void)
+{
+ int i, j;
+ pdump_entry_list_elmt *elmt;
+ pdump_reloc_table rt;
+
+ for (i=0; i<lrecord_type_count; i++)
+ {
+ elmt = pdump_object_table[i].first;
+ if (!elmt)
+ continue;
+ rt.desc = lrecord_implementations_table[i]->description;
+ rt.count = pdump_object_table[i].count;
+ write (pdump_fd, &rt, sizeof (rt));
+ while (elmt)
+ {
+ EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
+ write (pdump_fd, &rdata, sizeof (rdata));
+ elmt = elmt->next;
+ }
+ }
+
+ rt.desc = 0;
+ rt.count = 0;
+ write (pdump_fd, &rt, sizeof (rt));
+
+ for (i=0; i<pdump_struct_table.count; i++)
+ {
+ elmt = pdump_struct_table.list[i].list.first;
+ rt.desc = pdump_struct_table.list[i].sdesc->description;
+ rt.count = pdump_struct_table.list[i].list.count;
+ write (pdump_fd, &rt, sizeof (rt));
+ while (elmt)
+ {
+ EMACS_INT rdata = pdump_get_entry (elmt->obj)->save_offset;
+ for (j=0; j<elmt->count; j++)
+ {
+ write (pdump_fd, &rdata, sizeof (rdata));
+ rdata += elmt->size;
+ }
+ elmt = elmt->next;
+ }
+ }
+ rt.desc = 0;
+ rt.count = 0;
+ write (pdump_fd, &rt, sizeof (rt));
+}
+
+static void
+pdump_dump_wired (void)
+{
+ EMACS_INT count = pdump_wireidx + pdump_wireidx_list;
+ int i;
+
+ write (pdump_fd, &count, sizeof (count));
+
+ for (i=0; i<pdump_wireidx; i++)
+ {
+ EMACS_INT obj = pdump_get_entry (XRECORD_LHEADER (*(pdump_wirevec[i])))->save_offset;
+ write (pdump_fd, &pdump_wirevec[i], sizeof (pdump_wirevec[i]));
+ write (pdump_fd, &obj, sizeof (obj));
+ }
+
+ for (i=0; i<pdump_wireidx_list; i++)
+ {
+ Lisp_Object obj = *(pdump_wirevec_list[i]);
+ pdump_entry_list_elmt *elmt;
+ EMACS_INT res;
+
+ for (;;)
+ {
+ const struct lrecord_description *desc;
+ int pos;
+ elmt = pdump_get_entry (XRECORD_LHEADER (obj));
+ if (elmt)
+ break;
+ desc = XRECORD_LHEADER_IMPLEMENTATION (obj)->description;
+ for (pos = 0; desc[pos].type != XD_LO_LINK; pos++)
+ assert (desc[pos].type != XD_END);
+
+ obj = *(Lisp_Object *)(desc[pos].offset + (char *)(XRECORD_LHEADER (obj)));
+ }
+ res = elmt->save_offset;
+
+ write (pdump_fd, &pdump_wirevec_list[i], sizeof (pdump_wirevec_list[i]));
+ write (pdump_fd, &res, sizeof (res));
+ }
+}
+
+void
+pdump (void)
+{
+ int i;
+ Lisp_Object t_console, t_device, t_frame;
+ int none;
+ dump_header hd;
+
+ /* These appear in a DEFVAR_LISP, which does a staticpro() */
+ t_console = Vterminal_console;
+ t_frame = Vterminal_frame;
+ t_device = Vterminal_device;
+
+ Vterminal_console = Qnil;
+ Vterminal_frame = Qnil;
+ Vterminal_device = Qnil;
+
+ pdump_hash = xnew_array_and_zero (pdump_entry_list_elmt *, PDUMP_HASHSIZE);
+
+ for (i=0; i<lrecord_type_count; i++)
+ {
+ pdump_object_table[i].first = 0;
+ pdump_object_table[i].align = 8;
+ pdump_object_table[i].count = 0;
+ pdump_alert_undump_object[i] = 0;
+ }
+ pdump_struct_table.count = 0;
+ pdump_struct_table.size = -1;
+
+ pdump_opaque_data_list.first = 0;
+ pdump_opaque_data_list.align = 8;
+ pdump_opaque_data_list.count = 0;
+ depth = 0;
+
+ for (i=0; i<staticidx; i++)
+ pdump_register_object (*staticvec[i]);
+ for (i=0; i<pdump_wireidx; i++)
+ pdump_register_object (*pdump_wirevec[i]);
+
+ none = 1;
+ for (i=0; i<lrecord_type_count; i++)
+ if (pdump_alert_undump_object[i])
+ {
+ if (none)
+ printf ("Undumpable types list :\n");
+ none = 0;
+ printf (" - %s (%d)\n", lrecord_implementations_table[i]->name, pdump_alert_undump_object[i]);
+ }
+ if (!none)
+ return;
+
+ for (i=0; i<dumpstructidx; i++)
+ pdump_register_struct (*(void **)(dumpstructvec[i].data), dumpstructvec[i].desc, 1);
+
+ memcpy (hd.signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN);
+ hd.id = dump_id;
+ hd.reloc_address = 0;
+ hd.nb_staticpro = staticidx;
+ hd.nb_structdmp = dumpstructidx;
+ hd.nb_opaquedmp = dumpopaqueidx;
+
+ cur_offset = 256;
+ max_size = 0;
+
+ pdump_scan_by_alignment (pdump_allocate_offset);
+ pdump_qnil = pdump_get_entry (XRECORD_LHEADER (Qnil));
+
+ pdump_buf = xmalloc (max_size);
+ /* Avoid use of the `open' macro. We want the real function. */
+#undef open
+ pdump_fd = open (EMACS_PROGNAME ".dmp",
+ O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, 0666);
+ hd.stab_offset = (cur_offset + 3) & ~3;
+
+ write (pdump_fd, &hd, sizeof (hd));
+ lseek (pdump_fd, 256, SEEK_SET);
+
+ pdump_scan_by_alignment (pdump_dump_data);
+
+ lseek (pdump_fd, hd.stab_offset, SEEK_SET);
+
+ pdump_dump_staticvec ();
+ pdump_dump_structvec ();
+ pdump_dump_opaquevec ();
+ pdump_dump_itable ();
+ pdump_dump_rtables ();
+ pdump_dump_wired ();
+
+ close (pdump_fd);
+ free (pdump_buf);
+
+ free (pdump_hash);
+
+ Vterminal_console = t_console;
+ Vterminal_frame = t_frame;
+ Vterminal_device = t_device;
+}
+
+static int pdump_load_check (void)
+{
+ return (!memcmp (((dump_header *)pdump_start)->signature, DUMP_SIGNATURE, DUMP_SIGNATURE_LEN)
+ && ((dump_header *)pdump_start)->id == dump_id);
+}
+
+static int pdump_load_finish (void)
+{
+ int i;
+ char *p;
+ EMACS_INT delta;
+ EMACS_INT count;
+
+ pdump_end = pdump_start + pdump_length;
+
+#define PDUMP_READ(p, type) (p = (char*) (((type *) p) + 1), *((type *) p - 1))
+
+ staticidx = ((dump_header *)(pdump_start))->nb_staticpro;
+ delta = ((EMACS_INT)pdump_start) - ((dump_header *)pdump_start)->reloc_address;
+ p = pdump_start + ((dump_header *)pdump_start)->stab_offset;
+
+ /* Put back the staticvec in place */
+ memcpy (staticvec, p, staticidx*sizeof (Lisp_Object *));
+ p += staticidx*sizeof (Lisp_Object *);
+ for (i=0; i<staticidx; i++)
+ {
+ Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
+ if (POINTER_TYPE_P (XTYPE (obj)))
+ XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
+ *staticvec[i] = obj;
+ }
+
+ /* Put back the dumpstructs */
+ for (i=0; i<((dump_header *)pdump_start)->nb_structdmp; i++)
+ {
+ void **adr = PDUMP_READ (p, void **);
+ *adr = (void *) (PDUMP_READ (p, char *) + delta);
+ }
+
+ /* Put back the opaques */
+ for (i=0; i<((dump_header *)pdump_start)->nb_opaquedmp; i++)
+ {
+ struct pdump_dumpopaqueinfo di = PDUMP_READ (p, struct pdump_dumpopaqueinfo);
+ memcpy (di.data, p, di.size);
+ p += di.size;
+ }
+
+ /* Put back the lrecord_implementations_table */
+ /* The (void *) cast is there to make Ben happy. */
+ memcpy ((void *) lrecord_implementations_table, p, lrecord_type_count*sizeof (lrecord_implementations_table[0]));
+ p += lrecord_type_count*sizeof (lrecord_implementations_table[0]);
+
+ /* Reinitialize lrecord_markers from lrecord_implementations_table */
+ for (i=0; i < lrecord_type_count; i++)
+ if (lrecord_implementations_table[i])
+ lrecord_markers[i] = lrecord_implementations_table[i]->marker;
+
+ /* Do the relocations */
+ pdump_rt_list = p;
+ count = 2;
+ for (;;)
+ {
+ pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
+ if (rt.desc)
+ {
+ for (i=0; i < rt.count; i++)
+ {
+ char *adr = delta + *(char **)p;
+ *(char **)p = adr;
+ pdump_reloc_one (adr, delta, rt.desc);
+ p += sizeof (char *);
+ }
+ } else
+ if (!(--count))
+ break;
+ }
+
+ /* Put the pdump_wire variables in place */
+ count = PDUMP_READ (p, EMACS_INT);
+
+ for (i=0; i<count; i++)
+ {
+ Lisp_Object *var = PDUMP_READ (p, Lisp_Object *);
+ Lisp_Object obj = PDUMP_READ (p, Lisp_Object);
+
+ if (POINTER_TYPE_P (XTYPE (obj)))
+ XSETOBJ (obj, XTYPE (obj), (char *) XPNTR (obj) + delta);
+
+ *var = obj;
+ }
+
+ /* Final cleanups */
+ /* reorganize hash tables */
+ p = pdump_rt_list;
+ for (;;)
+ {
+ pdump_reloc_table rt = PDUMP_READ (p, pdump_reloc_table);
+ if (!rt.desc)
+ break;
+ if (rt.desc == hash_table_description)
+ {
+ for (i=0; i < rt.count; i++)
+ pdump_reorganize_hash_table (PDUMP_READ (p, Lisp_Object));
+ break;
+ } else
+ p += sizeof (Lisp_Object) * rt.count;
+ }
+
+ /* Put back noninteractive1 to its real value */
+ noninteractive1 = noninteractive;
+
+ return 1;
+}
+
+#ifdef WINDOWSNT
+static void pdump_file_unmap(void)
+{
+}
+
+static int pdump_file_get(const char *path)
+{
+ HANDLE hFile;
+ HANDLE hMap;
+
+ hFile = CreateFile (path,
+ GENERIC_READ + GENERIC_WRITE, /* Required for copy on write */
+ 0, /* Not shared */
+ NULL, /* Not inheritable */
+ OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL,
+ NULL); /* No template file */
+ if (hFile == INVALID_HANDLE_VALUE)
+ return 0;
+
+ pdump_length = GetFileSize (hFile, NULL);
+ hMap = CreateFileMapping (hFile,
+ NULL, /* No security attributes */
+ PAGE_WRITECOPY, /* Copy on write */
+ 0, /* Max size, high half */
+ 0, /* Max size, low half */
+ NULL); /* Unnamed */
+ if (hMap == INVALID_HANDLE_VALUE)
+ return 0;
+
+ pdump_start = MapViewOfFile (hMap,
+ FILE_MAP_COPY, /* Copy on write */
+ 0, /* Start at zero */
+ 0,
+ 0); /* Map all of it */
+ pdump_free = pdump_file_unmap;
+ return 1;
+}
+
+static void pdump_resource_free (void)
+static int pdump_resource_get (void)
+{
+ HRSRC hRes; /* Handle to dump resource */
+ HRSRC hResLoad; /* Handle to loaded dump resource */
+
+ /* See Q126630 which describes how Windows NT and 95 trap writes to
+ resource sections and duplicate the page to allow the write to proceed.
+ It also describes how to make the resource section read/write (and hence
+ private to each process). Doing this avoids the exceptions and related
+ overhead, but causes the resource section to be private to each process
+ that is running XEmacs. Since the resource section contains little
+ other than the dumped data, which should be private to each process, we
+ make the whole resource section read/write so we don't have to copy it. */
+
+ hRes = FindResource (NULL, MAKEINTRESOURCE(101), "DUMP");
+ if (hRes == NULL)
+ return 0;
+
+ /* Found it, use the data in the resource */
+ hResLoad = LoadResource (NULL, hRes);
+ if (hResLoad == NULL)
+ return 0;
+
+ pdump_start = LockResource (hResLoad);
+ if (pdump_start == NULL)
+ return 0;
+
+ pdump_free = pdump_resource_free;
+ pdump_length = SizeofResource (NULL, hRes);
+ if (pdump_length <= sizeof(dump_header))
+ {
+ pdump_start = 0;
+ return 0;
+ }
+
+ return 1;
+}
+
+#else /* !WINDOWSNT */
+
+static void *pdump_mallocadr;
+
+static void pdump_file_free(void)
+{
+ xfree (pdump_mallocadr);
+}
+
+#ifdef HAVE_MMAP
+static void pdump_file_unmap(void)
+{
+ munmap (pdump_start, pdump_length);
+}
+#endif
+
+static int pdump_file_get(const char *path)
+{
+ int fd = open (path, O_RDONLY | OPEN_BINARY);
+ if (fd<0)
+ return 0;
+
+ pdump_length = lseek (fd, 0, SEEK_END);
+ if (pdump_length < sizeof (dump_header))
+ {
+ close (fd);
+ return 0;
+ }
+
+ lseek (fd, 0, SEEK_SET);
+
+#ifdef HAVE_MMAP
+ pdump_start = (char *) mmap (0, pdump_length, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
+ if (pdump_start != MAP_FAILED)
+ {
+ pdump_free = pdump_file_unmap;
+ close (fd);
+ return 1;
+ }
+#endif
+
+ pdump_mallocadr = xmalloc(pdump_length+255);
+ pdump_free = pdump_file_free;
+ pdump_start = (char *)((255 + (unsigned long)pdump_mallocadr) & ~255);
+ read (pdump_fd, pdump_start, pdump_length);
+
+ close (pdump_fd);
+ return 1;
+}
+#endif /* !WINDOWSNT */
+
+
+static int pdump_file_try(char *exe_path)
+{
+ char *w;
+
+ w = exe_path + strlen(exe_path);
+ do
+ {
+ sprintf (w, "-%s-%08x.dmp", EMACS_VERSION, dump_id);
+ if (pdump_file_get (exe_path))
+ {
+ if (pdump_load_check ())
+ return 1;
+ pdump_free();
+ }
+
+ sprintf (w, "-%08x.dmp", dump_id);
+ if (pdump_file_get (exe_path))
+ {
+ if (pdump_load_check ())
+ return 1;
+ pdump_free();
+ }
+
+ sprintf (w, ".dmp");
+ if (pdump_file_get (exe_path))
+ {
+ if (pdump_load_check ())
+ return 1;
+ pdump_free();
+ }
+
+ do
+ w--;
+ while (w>exe_path && !IS_DIRECTORY_SEP (*w) && (*w != '-') && (*w != '.'));
+ }
+ while (w>exe_path && !IS_DIRECTORY_SEP (*w));
+ return 0;
+}
+
+int pdump_load(const char *argv0)
+{
+ char exe_path[PATH_MAX];
+ char *w;
+#ifdef WINDOWSNT
+ GetModuleFileName (NULL, exe_name, PATH_MAX);
+#else /* !WINDOWSNT */
+ const char *dir, *p;
+
+ dir = argv0;
+ if (dir[0] == '-')
+ {
+ /* XEmacs as a login shell, oh goody! */
+ dir = getenv("SHELL");
+ }
+
+ p = dir + strlen(dir);
+ while (p != dir && !IS_ANY_SEP (p[-1])) p--;
+
+ if (p != dir)
+ {
+ /* invocation-name includes a directory component -- presumably it
+ is relative to cwd, not $PATH */
+ strcpy (exe_path, dir);
+ }
+ else
+ {
+ const char *path = getenv ("PATH");
+ const char *name = p;
+ for (;;)
+ {
+ p = path;
+ while (*p && *p != SEPCHAR)
+ p++;
+ if (p == path)
+ {
+ exe_path[0] = '.';
+ w = exe_path + 1;
+ }
+ else
+ {
+ memcpy (exe_path, path, p - path);
+ w = exe_path + (p - path);
+ }
+ if (!IS_DIRECTORY_SEP (w[-1]))
+ {
+ *w++ = '/';
+ }
+ strcpy(w, name);
+
+ /* ### #$%$#^$^@%$^#%@$ ! */
+#ifdef access
+#undef access
+#endif
+
+ if (!access (exe_path, X_OK))
+ break;
+ if (!*p)
+ {
+ /* Oh well, let's have some kind of default */
+ sprintf (exe_path, "./%s", name);
+ break;
+ }
+ path = p+1;
+ }
+ }
+#endif /* WINDOWSNT */
+
+ if (pdump_file_try (exe_path))
+ {
+ pdump_load_finish ();
+ return 1;
+ }
+
+#ifdef WINDOWSNT
+ if (pdump_resource_get ())
+ {
+ if (pdump_load_check ())
+ {
+ pdump_load_finish ();
+ return 1;
+ }
+ pdump_free ();
+ }
+#endif
+
+ return 0;
+}
--- /dev/null
+/* Portable data dumper for XEmacs.
+ Copyright (C) 1999-2000 Olivier Galibert
+
+This file is part of XEmacs.
+
+XEmacs 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, or (at your option) any
+later version.
+
+XEmacs 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 XEmacs; see the file COPYING. If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
+
+/* Synched up with: Not in FSF. */
+
+#ifndef INCLUDED_dumper_h
+#define INCLUDED_dumper_h
+
+void pdump_objects_unmark (void);
+void pdump (void);
+int pdump_load (const char *argv0);
+
+#endif /* INCLUDED_dumper_h */
--- /dev/null
+/*
+ postgresql.c -- Emacs Lisp binding to libpq.so
+ Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
+ Licensed to the Free Software Foundation.
+
+ Author: SL Baur <steve@beopen.com>
+ Maintainer: SL Baur <steve@beopen.com>
+
+Please send patches to this file to me first before submitting them to
+xemacs-patches.
+
+
+KNOWN PROBLEMS (Last update 15-March-2000)
++ None.
+
+Implementation notes:
+0. Supported PostgreSQL versions
+ This code was developed against libpq-6.5.3 and libpq-7.0-beta1. Earlier
+ versions may work. V7 support is more complete than V6.5 support.
+1. Mule
+ Non-ASCII databases have been tested on both 6.5 and 7.0.
+2. Asynchronous Operation
+ Starting with libpq-7.0, an asynchronous interface is offered. This
+ binding supports the asynchronous calls to a limited extent. Since the
+ XEmacs 21.2 core does not support a sensible interface to add managed but
+ unreadable (by XEmacs) file descriptors to the main select code, polling
+ is required to drive the asynchronous calls. XtAppAddInput would work
+ fine, but we want to be able to use the database when running strictly in
+ tty mode.
+3. Completeness
+ Various calls have been deliberately not exported to Lisp. The
+ unexported calls are either left-over backwards compatibility code that
+ aren't needed, calls that cannot be implemented sensibly, or calls that
+ cannot be implemented safely. A list of all global functions in libpq
+ but not exported to Lisp is below.
+4. Policy
+ This interface tries very hard to not set any policy towards how database
+ code in Emacs Lisp will be written.
+5. Documentation
+ For full lisp programming documentation, see the XEmacs Lisp Reference
+ Manual. For PostgreSQL documentation, see the PostgreSQL distribution.
+
+TODO (in rough order of priority):
+1. Asynchronous notifies need to be implemented to the extent they can be.
+2. The large object interface needs work with Emacs buffers in addition
+ to files. Need two functions buffer->large_object, and large_object->
+ buffer.
+*/
+
+/*
+ Unimplemented functions: [TODO]
+ PQsetNoticeProcessor
+
+ Implemented, but undocumented functions: [TODO]
+ PQgetline (copy in/out)
+ PQputline (copy in/out)
+ PQgetlineAsync (copy in/out Asynch.)
+ PQputnbytes (copy in/out Asynch.)
+ PQendcopy (copy in/out)
+ PQsetenvStart (Asynch. Queries)
+ PQsetenvPoll (Asynch. Queries)
+ PQsetenvHandle (Asynch. Queries)
+
+ Unsupported functions:
+ PQsetdbLogin -- This function is deprecated, has a subset of the
+ functionality of PQconnectdb, and is better done in Lisp.
+ PQsetdb -- Same as for PQsetdbLogin
+ PQsocket -- Abstraction error, file descriptors should not be leaked
+ into Lisp code
+ PQprint -- print to a file descriptor, deprecated, better done in Lisp
+ PQdisplayTuples -- deprecated
+ PQprintTuples -- really, really deprecated
+ PQmblen -- Returns the length in bytes of multibyte character encoded
+ string.
+ PQtrace -- controls debug print tracing to a tty.
+ PQuntrace -- Ditto. I don't see any way to do this sensibly.
+ PQoidStatus -- deprecated and nearly identical to PQoidValue
+ PQfn -- "Fast path" interface
+ lo_open (large object) [*]
+ lo_close (large object) [*]
+ lo_read (large object) [*]
+ lo_write (large object) [*]
+ lo_lseek (large object) [*]
+ lo_creat (large object) [*]
+ lo_tell (large object) [*]
+ lo_unlink (large object) [*]
+*/
+
+#include <config.h>
+
+/* This must be portable with XEmacs 21.1 so long as it is the official
+ released version of XEmacs and provides the basis of InfoDock. The
+ interface to lcrecord handling has changed with 21.2, so unfortunately
+ we will need a few snippets of backwards compatibility code.
+*/
+#if (EMACS_MAJOR_VERSION == 21) && (EMACS_MINOR_VERSION < 2)
+#define RUNNING_XEMACS_21_1 1
+#endif
+
+/* #define POSTGRES_LO_IMPORT_IS_VOID 1 */
+
+#include "lisp.h"
+#include "sysdep.h"
+#include "buffer.h"
+
+#include <libpq-fe.h>
+/* Undefine the following when asynchronous setenvs are fixed in libpq. */
+/* #define LIBPQ_7_0_IS_FIXED */
+#include "postgresql.h"
+
+#ifdef RUNNING_XEMACS_21_1 /* handle interface changes */
+#define I_HATE_CONST CONST
+#define PG_OS_CODING FORMAT_FILENAME
+#define TO_EXTERNAL_FORMAT(a,from,b,to,c) GET_C_STRING_EXT_DATA_ALLOCA(from,FORMAT_FILENAME,to)
+#else
+#define I_HATE_CONST const
+#ifdef MULE
+#define PG_OS_CODING Fget_coding_system(Vpg_coding_system)
+#else
+#define PG_OS_CODING Qnative
+#endif
+Lisp_Object Vpg_coding_system;
+#endif
+
+#define CHECK_LIVE_CONNECTION(P) { \
+ if (!P || (PQstatus (P) != CONNECTION_OK)) { \
+ char *e = "bad value"; \
+ if (P) e = PQerrorMessage (P); \
+ error ("dead connection [%s]", e); \
+ } }
+#define PUKE_IF_NULL(p) { \
+ if (!p) error ("bad value"); \
+ }
+
+static Lisp_Object VXPGHOST;
+static Lisp_Object VXPGUSER;
+static Lisp_Object VXPGOPTIONS;
+static Lisp_Object VXPGPORT;
+static Lisp_Object VXPGTTY; /* This needs to be blanked! */
+static Lisp_Object VXPGDATABASE;
+static Lisp_Object VXPGREALM;
+#ifdef MULE
+static Lisp_Object VXPGCLIENTENCODING;
+#endif /* MULE */
+
+/* Other variables:
+ PGAUTHTYPE -- not used after PostgreSQL 6.5
+ PGGEQO
+ PGCOSTINDEX
+ PGCOSTHEAP
+ PGTZ
+ PGDATESTYLE
+*/
+#ifndef HAVE_POSTGRESQLV7
+static Lisp_Object VXPGAUTHTYPE;
+#endif
+static Lisp_Object VXPGGEQO, VXPGCOSTINDEX, VXPGCOSTHEAP, VXPGTZ, VXPGDATESTYLE;
+
+static Lisp_Object Qpostgresql;
+static Lisp_Object Qpg_connection_ok, Qpg_connection_bad;
+static Lisp_Object Qpg_connection_started, Qpg_connection_made;
+static Lisp_Object Qpg_connection_awaiting_response, Qpg_connection_auth_ok;
+static Lisp_Object Qpg_connection_setenv;
+
+static Lisp_Object Qpqdb, Qpquser, Qpqpass, Qpqhost, Qpqport, Qpqtty;
+static Lisp_Object Qpqoptions, Qpqstatus, Qpqerrormessage, Qpqbackendpid;
+
+static Lisp_Object Qpgres_empty_query, Qpgres_command_ok, Qpgres_tuples_ok;
+static Lisp_Object Qpgres_copy_out, Qpgres_copy_in, Qpgres_bad_response;
+static Lisp_Object Qpgres_nonfatal_error, Qpgres_fatal_error;
+
+static Lisp_Object Qpgres_polling_failed, Qpgres_polling_reading;
+static Lisp_Object Qpgres_polling_writing, Qpgres_polling_ok;
+static Lisp_Object Qpgres_polling_active;
+/****/
+
+/* PGconn is an opaque object and we need to be able to store them in
+ Lisp code because libpq supports multiple connections.
+*/
+Lisp_Object Qpgconnp;
+
+static Lisp_Object
+make_pgconn (Lisp_PGconn *pgconn)
+{
+ Lisp_Object lisp_pgconn;
+ XSETPGCONN (lisp_pgconn, pgconn);
+ return lisp_pgconn;
+}
+
+static Lisp_Object
+#ifdef RUNNING_XEMACS_21_1
+mark_pgconn (Lisp_Object obj, void (*markobj) (Lisp_Object))
+#else
+mark_pgconn (Lisp_Object obj)
+#endif
+{
+ return Qnil;
+}
+
+static void
+print_pgconn (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ char buf[256];
+ PGconn *P;
+ ConnStatusType cst;
+ char *host="", *db="", *user="", *port="";
+
+ P = (XPGCONN (obj))->pgconn;
+
+ if (!P) /* this may happen since we allow PQfinish() to be called */
+ strcpy (buf, "#<PGconn DEAD>"); /* evil! */
+ else if ((cst = PQstatus (P)) == CONNECTION_OK)
+ {
+ if (!(host = PQhost (P)))
+ host = "";
+ port = PQport (P);
+ db = PQdb (P);
+ if (!(user = PQuser (P)))
+ user = "";
+ sprintf (buf, "#<PGconn %s:%s %s/%s>", /* evil! */
+ !strlen (host) ? "localhost" : host,
+ port,
+ user,
+ db);
+ }
+ else if (cst == CONNECTION_BAD)
+ strcpy (buf, "#<PGconn BAD>"); /* evil! */
+ else
+ strcpy (buf, "#<PGconn connecting>"); /* evil! */
+
+ if (print_readably)
+ error ("printing unreadable object %s", buf);
+ else
+ write_c_string (buf, printcharfun);
+}
+
+static Lisp_PGconn *
+allocate_pgconn (void)
+{
+#ifdef RUNNING_XEMACS_21_1
+ Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
+ lrecord_pgconn);
+#else
+ Lisp_PGconn *pgconn = alloc_lcrecord_type (Lisp_PGconn,
+ &lrecord_pgconn);
+#endif
+ pgconn->pgconn = (PGconn *)NULL;
+ return pgconn;
+}
+
+static void
+finalize_pgconn (void *header, int for_disksave)
+{
+ Lisp_PGconn *pgconn = (Lisp_PGconn *)header;
+
+ if (for_disksave)
+ signal_simple_error ("Can't dump an emacs containing PGconn objects",
+ make_pgconn (pgconn));
+
+ if (pgconn->pgconn)
+ {
+ PQfinish (pgconn->pgconn);
+ pgconn->pgconn = (PGconn *)NULL;
+ }
+}
+
+#ifdef RUNNING_XEMACS_21_1
+DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
+ mark_pgconn, print_pgconn, finalize_pgconn,
+ NULL, NULL,
+ Lisp_PGconn);
+#else
+DEFINE_LRECORD_IMPLEMENTATION ("pgconn", pgconn,
+ mark_pgconn, print_pgconn, finalize_pgconn,
+ NULL, NULL,
+ 0,
+ Lisp_PGconn);
+#endif
+/****/
+
+/* PGresult is an opaque object and we need to be able to store them in
+ Lisp code.
+*/
+Lisp_Object Qpgresultp;
+
+static Lisp_Object
+make_pgresult (Lisp_PGresult *pgresult)
+{
+ Lisp_Object lisp_pgresult;
+ XSETPGRESULT (lisp_pgresult, pgresult);
+ return lisp_pgresult;
+}
+
+static Lisp_Object
+#ifdef RUNNING_XEMACS_21_1
+mark_pgresult (Lisp_Object obj, void (*markobj) (Lisp_Object))
+#else
+mark_pgresult (Lisp_Object obj)
+#endif
+{
+ return Qnil;
+}
+
+#define RESULT_TUPLES_FMT "#<PGresult %s[%d] - %s>"
+#define RESULT_CMD_TUPLES_FMT "#<PGresult %s[%s] - %s>"
+#define RESULT_DEFAULT_FMT "#<PGresult %s - %s>"
+static void
+print_pgresult (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ char buf[1024];
+ PGresult *res;
+
+ res = (XPGRESULT (obj))->pgresult;
+
+ if (res)
+ {
+ switch (PQresultStatus (res))
+ {
+ case PGRES_TUPLES_OK:
+ /* Add number of tuples of result to output */
+ sprintf (buf, RESULT_TUPLES_FMT, /* evil! */
+ PQresStatus (PQresultStatus (res)),
+ PQntuples (res),
+ PQcmdStatus (res));
+ break;
+ case PGRES_COMMAND_OK:
+ /* Add number of tuples affected by output-less command */
+ if (!strlen (PQcmdTuples (res))) goto notuples;
+ sprintf (buf, RESULT_CMD_TUPLES_FMT, /* evil! */
+ PQresStatus (PQresultStatus (res)),
+ PQcmdTuples (res),
+ PQcmdStatus (res));
+ break;
+ default:
+notuples:
+ /* No counts to print */
+ sprintf (buf, RESULT_DEFAULT_FMT, /* evil! */
+ PQresStatus (PQresultStatus (res)),
+ PQcmdStatus (res));
+ break;
+ }
+ }
+ else
+ strcpy (buf, "#<PGresult DEAD>"); /* evil! */
+
+ if (print_readably)
+ error ("printing unreadable object %s", buf);
+ else
+ write_c_string (buf, printcharfun);
+}
+
+#undef RESULT_TUPLES_FMT
+#undef RESULT_CMD_TUPLES_FMT
+#undef RESULT_DEFAULT_FMT
+
+static Lisp_PGresult *
+allocate_pgresult (void)
+{
+#ifdef RUNNING_XEMACS_21_1
+ Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
+ lrecord_pgresult);
+#else
+ Lisp_PGresult *pgresult = alloc_lcrecord_type (Lisp_PGresult,
+ &lrecord_pgresult);
+#endif
+ pgresult->pgresult = (PGresult *)NULL;
+ return pgresult;
+}
+
+static void
+finalize_pgresult (void *header, int for_disksave)
+{
+ Lisp_PGresult *pgresult = (Lisp_PGresult *)header;
+
+ if (for_disksave)
+ signal_simple_error ("Can't dump an emacs containing PGresult objects",
+ make_pgresult (pgresult));
+
+ if (pgresult->pgresult)
+ {
+ PQclear (pgresult->pgresult);
+ pgresult->pgresult = (PGresult *)NULL;
+ }
+}
+
+#ifdef RUNNING_XEMACS_21_1
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+ mark_pgresult, print_pgresult, finalize_pgresult,
+ NULL, NULL,
+ Lisp_PGresult);
+#else
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+ mark_pgresult, print_pgresult, finalize_pgresult,
+ NULL, NULL,
+ 0,
+ Lisp_PGresult);
+#endif
+
+/****/
+#ifdef HAVE_POSTGRESQLV7
+/* PGsetenvHandle is an opaque object and we need to be able to store them in
+ Lisp code so we can make asynchronous environmental calls.
+
+ Asynchronous setenv calls were introduced in libpq-7.0.
+*/
+#ifdef LIBPQ_7_0_IS_FIXED
+
+Lisp_Object Qpgsetenvp;
+
+static Lisp_Object
+make_pgsetenv (Lisp_PGsetenvHandle *pgsetenv)
+{
+ Lisp_Object lisp_pgsetenv;
+ XSETPGSETENV (lisp_pgsetenv, pgsetenv);
+ return lisp_pgsetenv;
+}
+
+static Lisp_Object
+#ifdef RUNNING_XEMACS_21_1
+mark_pgsetenv (Lisp_Object obj, void (*markobj) (Lisp_Object))
+#else
+mark_pgsetenv (Lisp_Object obj)
+#endif
+{
+ return Qnil;
+}
+
+static void
+print_pgsetenv (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ char *fmt = "#<PGsetenvHandle %s>";
+ char buf[1024];
+ PGsetenvHandle *h;
+
+ h = (XPGSETENV (obj))->pgsetenv;
+
+ sprintf (buf, fmt, h ? "live" : "DEAD");
+
+ /* There are no accessor functions to retrieve any fields, so we must */
+ /* treat this as being completely opaque. */
+ if (print_readably)
+ error ("printing unreadable object %s", buf);
+ else
+ write_c_string (buf, printcharfun);
+}
+
+static Lisp_PGsetenvHandle *
+allocate_pgresult (void)
+{
+#ifdef RUNNING_XEMACS_21_1
+ Lisp_PGsetenvHandle *pgsetenv =
+ alloc_lcrecord_type (Lisp_PGsetenvHandle, lrecord_pgsetenv);
+#else
+ Lisp_PGsetenvHandle *pgsetenv =
+ alloc_lcrecord_type (Lisp_PGsetenvHandle, &lrecord_pgsetenv);
+#endif
+ pgsetenv->pgsetenv = (PGsetenvState *)NULL;
+ return pgsetenv;
+}
+
+static void
+finalize_pgsetenv (void *header, int for_disksave)
+{
+ Lisp_PGsetenvHandle *pgsetenv = (Lisp_PGsetenvHandle *)header;
+
+ if (for_disksave)
+ signal_simple_error ("Can't dump an emacs containing PGsetenvHandle objects",
+ make_pgsetenv (pgsetenv));
+
+ /* #### PGsetenvHandle's are allocated with malloc(), however in
+ libpq-7.0 the treatment of them is little short of disastrous.
+ We don't dare attempt to free it, because there are many code
+ paths which lead to the handle being freed internally. The
+ connection routines leak setenv handles and so will we until
+ libpq gets cleaned up.
+ Actually, in 7.0b1 asynchronous setenv cannot work outside libpq, so
+ these functions are disabled in this API.
+ */
+ if (pgsetenv->pgsetenv)
+ {
+ free (pgsetenv->pgsetenv);
+ pgsetenv->pgsetenv = (PGsetenvHandle *)NULL;
+ }
+}
+
+#ifdef RUNNING_XEMACS_21_1
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+ mark_pgresult, print_pgresult, finalize_pgresult,
+ NULL, NULL,
+ Lisp_PGresult);
+#else
+DEFINE_LRECORD_IMPLEMENTATION ("pgresult", pgresult,
+ mark_pgresult, print_pgresult, finalize_pgresult,
+ NULL, NULL,
+ 0,
+ Lisp_PGresult);
+#endif /* RUNNING_XEMACS_21_1 */
+
+#endif /* LIBPQ_7_0_IS_FIXED */
+#endif /* HAVE_POSTGRESQLV7 */
+
+/***********************/
+
+/* notices */
+static void
+xemacs_notice_processor (void *arg, I_HATE_CONST char *msg)
+{
+ warn_when_safe (Qpostgresql, Qnotice, "%s", msg);
+}
+
+/* There are four ways (as of PostgreSQL v7) to connect to a database.
+ Two of them, PQsetdb and PQsetdbLogin, are deprecated. Both of those
+ routines take a number of positional parameters and are better done in Lisp.
+ Note that PQconnectStart does not exist prior to v7.
+*/
+
+DEFUN ("pq-conn-defaults", Fpq_conn_defaults, 0, 0, 0, /*
+Return a connection default structure.
+*/
+ ())
+{
+ /* This function can GC */
+ PQconninfoOption *pcio;
+ Lisp_Object temp, temp1;
+ int i;
+
+ pcio = PQconndefaults();
+ if (!pcio) return Qnil; /* can never happen in libpq-7.0 */
+ temp = list1 (Fcons (build_ext_string (pcio[0].keyword, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[0].envvar, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[0].compiled, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[0].val, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[0].label, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[0].dispchar, PG_OS_CODING),
+ Fcons (make_int (pcio[0].dispsize), Qnil))))))));
+
+ for (i = 1; pcio[i].keyword; i++)
+ {
+ temp1 = list1 (Fcons (build_ext_string (pcio[i].keyword, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[i].envvar, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[i].compiled, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[i].val, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[i].label, PG_OS_CODING),
+ Fcons (build_ext_string (pcio[i].dispchar, PG_OS_CODING),
+ Fcons (make_int (pcio[i].dispsize), Qnil))))))));
+ {
+ Lisp_Object args[2];
+ args[0] = temp;
+ args[1] = temp1;
+ /* Fappend GCPROs its arguments */
+ temp = Fappend (2, args);
+ }
+ }
+
+ return temp;
+}
+
+/* PQconnectdb Makes a new connection to a backend.
+PGconn *PQconnectdb(const char *conninfo)
+*/
+
+DEFUN ("pq-connectdb", Fpq_connectdb, 1, 1, 0, /*
+Make a new connection to a PostgreSQL backend.
+*/
+ (conninfo))
+{
+ PGconn *P;
+ Lisp_PGconn *lisp_pgconn;
+ char *error_message = "Out of Memory?";
+ char *c_conninfo;
+
+ CHECK_STRING (conninfo);
+
+ TO_EXTERNAL_FORMAT(LISP_STRING, conninfo,
+ C_STRING_ALLOCA, c_conninfo, Qnative);
+ P = PQconnectdb (c_conninfo);
+ if (P && (PQstatus (P) == CONNECTION_OK))
+ {
+ (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
+ lisp_pgconn = allocate_pgconn();
+ lisp_pgconn->pgconn = P;
+ return make_pgconn (lisp_pgconn);
+ }
+ else
+ {
+ /* Connection failed. Destroy the connection and signal an error. */
+ char buf[BLCKSZ];
+ strcpy (buf, error_message);
+ if (P)
+ {
+ /* storage for the error message gets erased when call PQfinish */
+ /* so we must temporarily stash it somewhere */
+ strncpy (buf, PQerrorMessage (P), sizeof (buf));
+ buf[sizeof (buf) - 1] = '\0';
+ PQfinish (P);
+ }
+ error ("libpq: %s", buf);
+ }
+}
+
+/* PQconnectStart Makes a new asynchronous connection to a backend.
+PGconn *PQconnectStart(const char *conninfo)
+*/
+
+#ifdef HAVE_POSTGRESQLV7
+DEFUN ("pq-connect-start", Fpq_connect_start, 1, 1, 0, /*
+Make a new asynchronous connection to a PostgreSQL backend.
+*/
+ (conninfo))
+{
+ PGconn *P;
+ Lisp_PGconn *lisp_pgconn;
+ char *error_message = "Out of Memory?";
+ char *c_conninfo;
+
+ CHECK_STRING (conninfo);
+ TO_EXTERNAL_FORMAT (LISP_STRING, conninfo,
+ C_STRING_ALLOCA, c_conninfo, Qnative);
+ P = PQconnectStart (c_conninfo);
+
+ if (P && (PQstatus (P) != CONNECTION_BAD))
+ {
+ (void)PQsetNoticeProcessor (P, xemacs_notice_processor, NULL);
+ lisp_pgconn = allocate_pgconn();
+ lisp_pgconn->pgconn = P;
+
+ return make_pgconn (lisp_pgconn);
+ }
+ else
+ {
+ /* capture the error message before destroying the object */
+ char buf[BLCKSZ];
+ strcpy (buf, error_message);
+ if (P)
+ {
+ strncpy (buf, PQerrorMessage (P), sizeof (buf));
+ buf[sizeof (buf) - 1] = '\0';
+ PQfinish (P);
+ }
+ error ("libpq: %s", buf);
+ }
+}
+
+DEFUN ("pq-connect-poll", Fpq_connect_poll, 1, 1, 0, /*
+Poll an asynchronous connection for completion
+*/
+ (conn))
+{
+ PGconn *P;
+ PostgresPollingStatusType PS;
+
+ CHECK_PGCONN (conn);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ PS = PQconnectPoll (P);
+ switch (PS)
+ {
+ case PGRES_POLLING_FAILED:
+ /* Something Bad has happened */
+ {
+ char *e = PQerrorMessage (P);
+ error ("libpq: %s", e);
+ }
+ case PGRES_POLLING_OK:
+ return Qpgres_polling_ok;
+ case PGRES_POLLING_READING:
+ return Qpgres_polling_reading;
+ case PGRES_POLLING_WRITING:
+ return Qpgres_polling_writing;
+ case PGRES_POLLING_ACTIVE:
+ return Qpgres_polling_active;
+ default:
+ /* they've added a new field we don't know about */
+ error ("Help! Unknown status code %08x from backend!", PS);
+ }
+}
+
+#ifdef MULE
+DEFUN ("pq-client-encoding", Fpq_client_encoding, 1, 1, 0, /*
+Return client coding system.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return make_int (PQclientEncoding (P));
+}
+
+DEFUN ("pq-set-client-encoding", Fpq_set_client_encoding, 2, 2, 0, /*
+Set client coding system.
+*/
+ (conn, encoding))
+{
+ PGconn *P;
+ int rc;
+ char *c_encoding;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (encoding);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, encoding,
+ C_STRING_ALLOCA, c_encoding, Qnative);
+
+ if ((rc = PQsetClientEncoding (P, c_encoding)) < 0)
+ error ("bad encoding");
+ else
+ return make_int (rc);
+}
+
+#endif
+#endif /* HAVE_POSTGRESQLV7 */
+
+/* PQfinish Close the connection to the backend. Also frees memory
+ used by the PGconn object.
+void PQfinish(PGconn *conn)
+*/
+DEFUN ("pq-finish", Fpq_finish, 1, 1, 0, /*
+Close the connection to the backend.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ PUKE_IF_NULL (P);
+
+ PQfinish (P);
+ /* #### PQfinish deallocates the PGconn structure, so we now have a
+ dangling pointer. */
+ /* Genocided all @'s ... */
+ (XPGCONN (conn))->pgconn = (PGconn *)NULL; /* You feel DEAD inside */
+ return Qnil;
+}
+
+DEFUN ("pq-clear", Fpq_clear, 1, 1, 0, /*
+Forcibly erase a PGresult object.
+*/
+ (res))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (res);
+ R = (XPGRESULT (res))->pgresult;
+ PUKE_IF_NULL (R);
+
+ PQclear (R);
+ /* Genocided all @'s ... */
+ (XPGRESULT (res))->pgresult = (PGresult *)NULL; /* You feel DEAD inside */
+
+ return Qnil;
+}
+
+DEFUN ("pq-is-busy", Fpq_is_busy, 1, 1, 0, /*
+Return t if PQgetResult would block waiting for input.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQisBusy (P) ? Qt : Qnil;
+}
+
+DEFUN ("pq-consume-input", Fpq_consume_input, 1, 1, 0, /*
+Consume any available input from the backend.
+Returns nil if something bad happened.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQconsumeInput (P) ? Qt : Qnil;
+}
+
+/* PQreset Reset the communication port with the backend.
+void PQreset(PGconn *conn)
+*/
+DEFUN ("pq-reset", Fpq_reset, 1, 1, 0, /*
+Reset the connection to the backend.
+This function will close the connection to the backend and attempt to
+reestablish a new connection to the same postmaster, using all the same
+parameters previously used. This may be useful for error recovery if a
+working connection is lost.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ PUKE_IF_NULL (P);/* we can resurrect a BAD connection, but not a dead one. */
+
+ PQreset (P);
+
+ return Qnil;
+}
+
+#ifdef HAVE_POSTGRESQLV7
+DEFUN ("pq-reset-start", Fpq_reset_start, 1, 1, 0, /*
+Reset connection to the backend asynchronously.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ if (PQresetStart (P)) return Qt;
+ {
+ char *e = PQerrorMessage (P);
+ error ("libpq: %s", e);
+ }
+}
+
+DEFUN ("pq-reset-poll", Fpq_reset_poll, 1, 1, 0, /*
+Poll an asynchronous reset for completion
+*/
+ (conn))
+{
+ PGconn *P;
+ PostgresPollingStatusType PS;
+
+ CHECK_PGCONN (conn);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ PS = PQresetPoll (P);
+ switch (PS)
+ {
+ case PGRES_POLLING_FAILED:
+ /* Something Bad has happened */
+ {
+ char *e = PQerrorMessage (P);
+ error ("libpq: %s", e);
+ }
+ case PGRES_POLLING_OK:
+ return Qpgres_polling_ok;
+ case PGRES_POLLING_READING:
+ return Qpgres_polling_reading;
+ case PGRES_POLLING_WRITING:
+ return Qpgres_polling_writing;
+ case PGRES_POLLING_ACTIVE:
+ return Qpgres_polling_active;
+ default:
+ /* they've added a new field we don't know about */
+ error ("Help! Unknown status code %08x from backend!", PS);
+ }
+}
+#endif
+
+DEFUN ("pq-request-cancel", Fpq_request_cancel, 1, 1, 0, /*
+Attempt to request cancellation of the current operation.
+
+The return value is t if the cancel request was successfully
+dispatched, nil if not (in which case conn->errorMessage is set).
+Note: successful dispatch is no guarantee that there will be any effect at
+the backend. The application must read the operation result as usual.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQrequestCancel (P) ? Qt : Qnil;
+}
+
+/* accessor function for the PGconn object */
+DEFUN ("pq-pgconn", Fpq_pgconn, 2, 2, 0, /*
+Accessor function for the PGconn object.
+Currently recognized symbols for the field:
+pq::db Database name
+pq::user Database user name
+pq::pass Database user's password
+pq::host Hostname of PostgreSQL backend connected to
+pq::port TCP port number of connection
+pq::tty Debugging TTY (not used in Emacs)
+pq::options Additional backend options
+pq::status Connection status (either OK or BAD)
+pq::error-message Last error message from the backend
+pq::backend-pid Process ID of backend process
+*/
+ (conn, field))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ PUKE_IF_NULL (P); /* BAD connections still have state to query */
+
+ if (EQ(field, Qpqdb))
+ /* PQdb Returns the database name of the connection.
+ char *PQdb(PGconn *conn)
+ */
+ return build_ext_string (PQdb(P), PG_OS_CODING);
+ else if (EQ (field, Qpquser))
+ /* PQuser Returns the user name of the connection.
+ char *PQuser(PGconn *conn)
+ */
+ return build_ext_string (PQuser(P), PG_OS_CODING);
+ else if (EQ (field, Qpqpass))
+ /* PQpass Returns the password of the connection.
+ char *PQpass(PGconn *conn)
+ */
+ return build_ext_string (PQpass(P), PG_OS_CODING);
+ else if (EQ (field, Qpqhost))
+ /* PQhost Returns the server host name of the connection.
+ char *PQhost(PGconn *conn)
+ */
+ return build_ext_string (PQhost(P), PG_OS_CODING);
+ else if (EQ (field, Qpqport))
+ {
+ char *p;
+ /* PQport Returns the port of the connection.
+ char *PQport(PGconn *conn)
+ */
+ if ((p = PQport(P)))
+ return make_int(atoi(p));
+ else
+ return make_int(-1);
+ }
+ else if (EQ (field, Qpqtty))
+ /* PQtty Returns the debug tty of the connection.
+ char *PQtty(PGconn *conn)
+ */
+ return build_ext_string (PQtty(P), PG_OS_CODING);
+ else if (EQ (field, Qpqoptions))
+ /* PQoptions Returns the backend options used in the connection.
+ char *PQoptions(PGconn *conn)
+ */
+ return build_ext_string (PQoptions(P), PG_OS_CODING);
+ else if (EQ (field, Qpqstatus))
+ {
+ ExecStatusType est;
+ /* PQstatus Returns the status of the connection. The status can be
+ CONNECTION_OK or CONNECTION_BAD.
+ ConnStatusType PQstatus(PGconn *conn)
+ */
+ switch ((est = PQstatus (P)))
+ {
+ case CONNECTION_OK: return Qpg_connection_ok;
+ case CONNECTION_BAD: return Qpg_connection_bad;
+#ifdef HAVE_POSTGRESQLV7
+ case CONNECTION_STARTED: return Qpg_connection_started;
+ case CONNECTION_MADE: return Qpg_connection_made;
+ case CONNECTION_AWAITING_RESPONSE: return Qpg_connection_awaiting_response;
+ case CONNECTION_AUTH_OK: return Qpg_connection_auth_ok;
+ case CONNECTION_SETENV: return Qpg_connection_setenv;
+#endif /* HAVE_POSTGRESQLV7 */
+ default:
+ /* they've added a new field we don't know about */
+ error ("Help! Unknown exec status code %08x from backend!", est);
+ }
+ }
+ else if (EQ (field, Qpqerrormessage))
+ /* PQerrorMessage Returns the error message most recently generated
+ by an operation on the connection.
+ char *PQerrorMessage(PGconn* conn);
+ */
+ return build_ext_string (PQerrorMessage(P), PG_OS_CODING);
+ else if (EQ (field, Qpqbackendpid))
+ /* PQbackendPID Returns the process ID of the backend server handling
+ this connection.
+ int PQbackendPID(PGconn *conn);
+ */
+ return make_int (PQbackendPID(P));
+ else
+ error ("bad PGconn accessor");
+}
+
+/* Query functions */
+DEFUN ("pq-exec", Fpq_exec, 2, 2, 0, /*
+Submit a query to Postgres and wait for the result.
+*/
+ (conn, query))
+{
+ PGconn *P;
+ Lisp_PGresult *lisp_pgresult;
+ PGresult *R;
+ char *c_query;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (query);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, query,
+ C_STRING_ALLOCA, c_query, Qnative);
+
+ R = PQexec (P, c_query);
+ {
+ char *tag, buf[BLCKSZ];
+
+ if (!R) error ("query: out of memory");
+ else
+ switch (PQresultStatus (R))
+ {
+ case PGRES_BAD_RESPONSE:
+ tag = "bad response [%s]";
+ goto err;
+ case PGRES_NONFATAL_ERROR:
+ tag = "non-fatal error [%s]";
+ goto err;
+ case PGRES_FATAL_ERROR:
+ tag = "fatal error [%s]";
+err:
+ strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
+ buf [sizeof (buf) - 1] = '\0';
+ PQclear (R);
+ error (tag, buf);
+ /*NOTREACHED*/
+ default:
+ break;
+ }
+ }
+
+ lisp_pgresult = allocate_pgresult ();
+ lisp_pgresult->pgresult = R;
+
+ return make_pgresult (lisp_pgresult);
+}
+
+DEFUN ("pq-send-query", Fpq_send_query, 2, 2, 0, /*
+Submit a query to Postgres and don't wait for the result.
+Returns: t if successfully submitted
+ nil if error (conn->errorMessage is set)
+*/
+ (conn, query))
+{
+ PGconn *P;
+ char *c_query;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (query);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, query,
+ C_STRING_ALLOCA, c_query, Qnative);
+
+ if (PQsendQuery (P, c_query)) return Qt;
+ else error ("async query: %s", PQerrorMessage (P));
+}
+
+DEFUN ("pq-get-result", Fpq_get_result, 1, 1, 0, /*
+Retrieve an asynchronous result from a query.
+NIL is returned when no more query work remains.
+*/
+ (conn))
+{
+ PGconn *P;
+ Lisp_PGresult *lisp_pgresult;
+ PGresult *R;
+
+ CHECK_PGCONN (conn);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ R = PQgetResult (P);
+ if (!R) return Qnil; /* not an error, there's no more data to get */
+
+ {
+ char *tag, buf[BLCKSZ];
+
+ switch (PQresultStatus (R))
+ {
+ case PGRES_BAD_RESPONSE:
+ tag = "bad response [%s]";
+ goto err;
+ case PGRES_NONFATAL_ERROR:
+ tag = "non-fatal error [%s]";
+ goto err;
+ case PGRES_FATAL_ERROR:
+ tag = "fatal error [%s]";
+err:
+ strncpy (buf, PQresultErrorMessage (R), sizeof (buf));
+ buf[sizeof (buf) - 1] = '\0';
+ PQclear (R);
+ error (tag, buf);
+ /*NOTREACHED*/
+ default:
+ break;
+ }
+ }
+
+ lisp_pgresult = allocate_pgresult();
+ lisp_pgresult->pgresult = R;
+
+ return make_pgresult (lisp_pgresult);
+}
+
+DEFUN ("pq-result-status", Fpq_result_status, 1, 1, 0, /*
+Return result status of the query.
+*/
+ (result))
+{
+ PGresult *R;
+ ExecStatusType est;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ switch ((est = PQresultStatus (R))) {
+ case PGRES_EMPTY_QUERY: return Qpgres_empty_query;
+ case PGRES_COMMAND_OK: return Qpgres_command_ok;
+ case PGRES_TUPLES_OK: return Qpgres_tuples_ok;
+ case PGRES_COPY_OUT: return Qpgres_copy_out;
+ case PGRES_COPY_IN: return Qpgres_copy_in;
+ case PGRES_BAD_RESPONSE: return Qpgres_bad_response;
+ case PGRES_NONFATAL_ERROR: return Qpgres_nonfatal_error;
+ case PGRES_FATAL_ERROR: return Qpgres_fatal_error;
+ default:
+ /* they've added a new field we don't know about */
+ error ("Help! Unknown exec status code %08x from backend!", est);
+ }
+}
+
+DEFUN ("pq-res-status", Fpq_res_status, 1, 1, 0, /*
+Return stringified result status of the query.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQresStatus (PQresultStatus (R)), PG_OS_CODING);
+}
+
+/* Sundry PGresult accessor functions */
+DEFUN ("pq-result-error-message", Fpq_result_error_message, 1, 1, 0, /*
+Return last message associated with the query.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQresultErrorMessage (R), PG_OS_CODING);
+}
+
+DEFUN ("pq-ntuples", Fpq_ntuples, 1, 1, 0, /*
+Return the number of tuples (instances) in the query result.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQntuples (R));
+}
+
+DEFUN ("pq-nfields", Fpq_nfields, 1, 1, 0, /*
+Return the number of fields (attributes) in each tuple of the query result.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQnfields (R));
+}
+
+DEFUN ("pq-binary-tuples", Fpq_binary_tuples, 1, 1, 0, /*
+Return t if the query result contains binary data, nil otherwise.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return (PQbinaryTuples (R)) ? Qt : Qnil;
+}
+
+DEFUN ("pq-fname", Fpq_fname, 2, 2, 0, /*
+Return the field (attribute) name associated with the given field index.
+Field indices start at 0.
+*/
+ (result, field_index))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (field_index);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQfname (R, XINT (field_index)), PG_OS_CODING);
+}
+
+DEFUN ("pq-fnumber", Fpq_fnumber, 2, 2, 0, /*
+Return the number of fields (attributes) in each tuple of the query result.
+*/
+ (result, field_name))
+{
+ PGresult *R;
+ char *c_field_name;
+
+ CHECK_PGRESULT (result);
+ CHECK_STRING (field_name);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, field_name,
+ C_STRING_ALLOCA, c_field_name, Qnative);
+
+ return make_int (PQfnumber (R, c_field_name));
+}
+
+DEFUN ("pq-ftype", Fpq_ftype, 2, 2, 0, /*
+Return the field type associated with the given field index.
+The integer returned is the internal coding of the type. Field indices
+start at 0.
+*/
+ (result, field_num))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (field_num);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQftype (R, XINT (field_num)));
+}
+
+DEFUN ("pq-fsize", Fpq_fsize, 2, 2, 0, /*
+Return the field size in bytes associated with the given field index.
+Field indices start at 0.
+*/
+ (result, field_index))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (field_index);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQftype (R, XINT (field_index)));
+}
+
+DEFUN ("pq-fmod", Fpq_fmod, 2, 2, 0, /*
+Return the type modifier associated with a field.
+Field indices start at 0.
+*/
+ (result, field_index))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (field_index);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQfmod (R, XINT (field_index)));
+}
+
+DEFUN ("pq-get-value", Fpq_get_value, 3, 3, 0, /*
+Return a single field (attribute) value of one tuple of a PGresult.
+Tuple and field indices start at 0.
+*/
+ (result, tup_num, field_num))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (tup_num);
+ CHECK_INT (field_num);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQgetvalue (R, XINT (tup_num), XINT (field_num)),
+ PG_OS_CODING);
+}
+
+DEFUN ("pq-get-length", Fpq_get_length, 3, 3, 0, /*
+Returns the length of a field value in bytes.
+If result is binary, i.e. a result of a binary portal, then the
+length returned does NOT include the size field of the varlena. (The
+data returned by PQgetvalue doesn't either.)
+*/
+ (result, tup_num, field_num))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (tup_num);
+ CHECK_INT (field_num);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return make_int (PQgetlength (R, XINT (tup_num), XINT (field_num)));
+}
+
+DEFUN ("pq-get-is-null", Fpq_get_is_null, 3, 3, 0, /*
+Returns the null status of a field value.
+*/
+ (result, tup_num, field_num))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ CHECK_INT (tup_num);
+ CHECK_INT (field_num);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return PQgetisnull (R, XINT (tup_num), XINT (field_num)) ? Qt : Qnil;
+}
+
+DEFUN ("pq-cmd-status", Fpq_cmd_status, 1, 1, 0, /*
+Returns the command status string from the SQL command that generated the result.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQcmdStatus (R), PG_OS_CODING);
+}
+
+DEFUN ("pq-cmd-tuples", Fpq_cmd_tuples, 1, 1, 0, /*
+Returns the number of rows affected by the SQL command
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+ return build_ext_string (PQcmdTuples (R), PG_OS_CODING);
+}
+
+DEFUN ("pq-oid-value", Fpq_oid_value, 1, 1, 0, /*
+Returns the object id of the tuple inserted.
+*/
+ (result))
+{
+ PGresult *R;
+
+ CHECK_PGRESULT (result);
+ R = (XPGRESULT (result))->pgresult;
+ PUKE_IF_NULL (R);
+
+#ifdef HAVE_POSTGRESQLV7
+ return make_int (PQoidValue (R));
+#else
+ /* Use the old interface */
+ return make_int (atoi (PQoidStatus (R)));
+#endif
+}
+
+#ifdef HAVE_POSTGRESQLV7
+DEFUN ("pq-set-nonblocking", Fpq_set_nonblocking, 2, 2, 0, /*
+Sets the PGconn's database connection non-blocking if the arg is TRUE
+or makes it non-blocking if the arg is FALSE, this will not protect
+you from PQexec(), you'll only be safe when using the non-blocking API.
+
+Needs to be called only on a connected database connection.
+*/
+ (conn, arg))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return make_int (PQsetnonblocking (P, !NILP (arg)));
+}
+
+DEFUN ("pq-is-nonblocking", Fpq_is_nonblocking, 1, 1, 0, /*
+Return the blocking status of the database connection
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQisnonblocking (P) ? Qt : Qnil;
+}
+
+DEFUN ("pq-flush", Fpq_flush, 1, 1, 0, /*
+Force the write buffer to be written (or at least try)
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return make_int (PQflush (P));
+}
+#endif
+
+DEFUN ("pq-notifies", Fpq_notifies, 1, 1, 0, /*
+Return the latest async notification that has not yet been handled.
+If there has been a notification, then a list of two elements will be returned.
+The first element contains the relation name being notified, the second
+element contains the backend process ID number. nil is returned if there
+aren't any notifications to process.
+*/
+ (conn))
+{
+ /* This function cannot GC */
+ PGconn *P;
+ PGnotify *PGN;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ PGN = PQnotifies (P);
+ if (!PGN)
+ return Qnil;
+ else
+ {
+ Lisp_Object temp;
+
+ temp = list2 (build_ext_string (PGN->relname, PG_OS_CODING), make_int (PGN->be_pid));
+ free ((void *)PGN);
+ return temp;
+ }
+}
+
+#if defined (HAVE_POSTGRESQLV7) && defined(MULE)
+DEFUN ("pq-env-2-encoding", Fpq_env_2_encoding, 0, 0, 0, /*
+Get encoding id from environment variable PGCLIENTENCODING.
+*/
+ ())
+{
+ return make_int (PQenv2encoding ());
+}
+#endif /* MULE */
+
+DEFUN ("pq-lo-import", Fpq_lo_import, 2, 2, 0, /*
+*/
+ (conn, filename))
+{
+ PGconn *P;
+ char *c_filename;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (filename);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, filename,
+ C_STRING_ALLOCA, c_filename,
+ Qfile_name);
+
+ return make_int ((int)lo_import (P, c_filename));
+}
+
+DEFUN ("pq-lo-export", Fpq_lo_export, 3, 3, 0, /*
+*/
+ (conn, oid, filename))
+{
+ PGconn *P;
+ char *c_filename;
+
+ CHECK_PGCONN (conn);
+ CHECK_INT (oid);
+ CHECK_STRING (filename);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ TO_EXTERNAL_FORMAT (LISP_STRING, filename,
+ C_STRING_ALLOCA, c_filename, Qfile_name);
+
+ return make_int ((int)lo_export (P, XINT (oid), c_filename));
+}
+
+DEFUN ("pq-make-empty-pgresult", Fpq_make_empty_pgresult, 2, 2, 0, /*
+Make an empty PGresult object with the given status.
+*/
+ (conn, status))
+{
+ PGconn *P;
+ Lisp_PGresult *lpgr;
+ PGresult *R;
+ ExecStatusType est;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P); /* needed here? */
+
+ if (EQ (status, Qpgres_empty_query)) est = PGRES_EMPTY_QUERY;
+ else if (EQ (status, Qpgres_command_ok)) est = PGRES_COMMAND_OK;
+ else if (EQ (status, Qpgres_tuples_ok)) est = PGRES_TUPLES_OK;
+ else if (EQ (status, Qpgres_copy_out)) est = PGRES_COPY_OUT;
+ else if (EQ (status, Qpgres_copy_in)) est = PGRES_COPY_IN;
+ else if (EQ (status, Qpgres_bad_response)) est = PGRES_BAD_RESPONSE;
+ else if (EQ (status, Qpgres_nonfatal_error)) est = PGRES_NONFATAL_ERROR;
+ else if (EQ (status, Qpgres_fatal_error)) est = PGRES_FATAL_ERROR;
+ else signal_simple_error ("bad status symbol", status);
+
+ R = PQmakeEmptyPGresult (P, est);
+ if (!R) error ("out of memory?");
+
+ lpgr = allocate_pgresult ();
+ lpgr->pgresult = R;
+
+ return make_pgresult (lpgr);
+}
+
+DEFUN ("pq-get-line", Fpq_get_line, 1, 1, 0, /*
+Retrieve a line from server in copy in operation.
+The return value is a dotted pair where the cons cell is an integer code:
+ -1: Copying is complete
+ 0: A record is complete
+ 1: A record is incomplete, it will be continued in the next `pq-get-line'
+ operation.
+and the cdr cell is returned string data.
+
+The copy operation is complete when the value `\.' (backslash dot) is
+returned.
+*/
+ (conn))
+{
+ char buffer[BLCKSZ]; /* size of a Postgres disk block */
+ PGconn *P;
+ int ret;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ ret = PQgetline (P, buffer, sizeof (buffer));
+
+ return Fcons (make_int (ret), build_ext_string (buffer, PG_OS_CODING));
+}
+
+DEFUN ("pq-put-line", Fpq_put_line, 2, 2, 0, /*
+Send a line to the server in copy out operation.
+
+Returns t if the operation succeeded, nil otherwise.
+*/
+ (conn, string))
+{
+ PGconn *P;
+ char *c_string;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (string);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+ TO_EXTERNAL_FORMAT (LISP_STRING, string,
+ C_STRING_ALLOCA, c_string, Qnative);
+
+ return !PQputline (P, c_string) ? Qt : Qnil;
+}
+
+DEFUN ("pq-get-line-async", Fpq_get_line_async, 1, 1, 0, /*
+Get a line from the server in copy in operation asynchronously.
+
+This routine is for applications that want to do "COPY <rel> to stdout"
+asynchronously, that is without blocking. Having issued the COPY command
+and gotten a PGRES_COPY_OUT response, the app should call PQconsumeInput
+and this routine until the end-of-data signal is detected. Unlike
+PQgetline, this routine takes responsibility for detecting end-of-data.
+
+On each call, PQgetlineAsync will return data if a complete newline-
+terminated data line is available in libpq's input buffer, or if the
+incoming data line is too long to fit in the buffer offered by the caller.
+Otherwise, no data is returned until the rest of the line arrives.
+
+If -1 is returned, the end-of-data signal has been recognized (and removed
+from libpq's input buffer). The caller *must* next call PQendcopy and
+then return to normal processing.
+
+RETURNS:
+ -1 if the end-of-copy-data marker has been recognized
+ 0 if no data is available
+ >0 the number of bytes returned.
+The data returned will not extend beyond a newline character. If possible
+a whole line will be returned at one time. But if the buffer offered by
+the caller is too small to hold a line sent by the backend, then a partial
+data line will be returned. This can be detected by testing whether the
+last returned byte is '\n' or not.
+The returned string is *not* null-terminated.
+*/
+ (conn))
+{
+ PGconn *P;
+ char buffer[BLCKSZ];
+ int ret;
+
+ CHECK_PGCONN (conn);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ ret = PQgetlineAsync (P, buffer, sizeof (buffer));
+
+ if (ret == -1) return Qt; /* done! */
+ else if (!ret) return Qnil; /* no data yet */
+ else return Fcons (make_int (ret),
+ make_ext_string (buffer, ret, PG_OS_CODING));
+}
+
+DEFUN ("pq-put-nbytes", Fpq_put_nbytes, 2, 2, 0, /*
+Asynchronous copy out.
+*/
+ (conn, data))
+{
+ /* NULs are not allowed. I don't think this matters at this time. */
+ PGconn *P;
+ char *c_data;
+
+ CHECK_PGCONN (conn);
+ CHECK_STRING (data);
+
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+ TO_EXTERNAL_FORMAT (LISP_STRING, data,
+ C_STRING_ALLOCA, c_data, Qnative);
+
+ return !PQputnbytes (P, c_data, strlen (c_data)) ? Qt : Qnil;
+}
+
+DEFUN ("pq-end-copy", Fpq_end_copy, 1, 1, 0, /*
+End a copying operation.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQendcopy (P) ? Qt : Qnil;
+}
+
+/* The setenv suite of functions. The author of the libpq manual doesn't
+ know a whole lot about them, and neither do I.
+*/
+#if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
+DEFUN ("pq-setenv", Fpq_setenv, 1, 1, 0, /*
+Set environmental parameters on the backend synchronously.
+Returns t if the operation was successful, nil otherwise.
+*/
+ (conn))
+{
+ PGconn *P;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ return PQsetenv (P) ? Qt : Qnil;
+}
+#endif
+
+#ifdef LIBPQ_7_0_IS_FIXED
+
+DEFUN ("pq-setenv-start", Fpq_setenv_start, 1, 1, 0, /*
+Set environmental parameters on the backend asynchronously.
+A PGsetenvHandle is returned on success, nil otherwise.
+*/
+ (conn))
+{
+ PGconn *P;
+ PGsetenvHandle *handle;
+ Lisp_setenvHandle *lseh;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ handle = PQsetenvStart (P);
+ if (!handle) error ("out of memory?");
+
+ lseh = allocate_pgsetenv ();
+ lseh->setenv = handle;
+
+ return make_pgsetenv (lseh);
+}
+
+DEFUN ("pq-setenv-poll", Fpq_setenv_poll, 1, 1, 0, /*
+Poll an asynchronous setenv operation for completion.
+*/
+ (conn))
+{
+ PGconn *P;
+ PostgresPollingStatusType pst;
+
+ CHECK_PGCONN (conn);
+ P = (XPGCONN (conn))->pgconn;
+ CHECK_LIVE_CONNECTION (P);
+
+ pst = PQsetenvPoll (P);
+ switch (pst)
+ {
+ case PGRES_POLLING_FAILED:
+ /* Something Bad has happened */
+ {
+ char *e = PQerrorMessage (P);
+ error ("libpq: %s", e);
+ }
+ case PGRES_POLLING_OK:
+ return Qpgres_polling_ok;
+ case PGRES_POLLING_READING:
+ return Qpgres_polling_reading;
+ case PGRES_POLLING_WRITING:
+ return Qpgres_polling_writing;
+ case PGRES_POLLING_ACTIVE:
+ return Qpgres_polling_active;
+ default:
+ /* they've added a new field we don't know about */
+ error ("Help! Unknown status code %08x from backend!", PS);
+ }
+}
+
+DEFUN ("pq-setenv-abort", Fpq_setenv_abort, 1, 1, 0, /*
+Attempt to abort an in-progress asynchronous setenv operation.
+*/
+ (handle))
+{
+ PGsetenvHandle *h;
+
+ CHECK_PGSETENV (handle);
+ h = (XPGSETENV (handle))->pgsetenv;
+ PUKE_IF_NULL (h);
+
+ PQsetenvAbort (h);
+ /* PQsetenvAbort usually free(3)'s the handle, don't take any chances. */
+ (XSETENV (handle))->pgsetenv = (PGsetenvHandle *)NULL;
+
+ return Qt;
+}
+#endif /* LIBPQ_7_0_IS_FIXED */
+
+void
+syms_of_postgresql(void)
+{
+#ifndef RUNNING_XEMACS_21_1
+ INIT_LRECORD_IMPLEMENTATION (pgconn);
+ INIT_LRECORD_IMPLEMENTATION (pgresult);
+#ifdef LIBPQ_7_0_IS_FIXED
+ INIT_LRECORD_IMPLEMENTATION (pgsetenv);
+#endif
+#endif
+ defsymbol (&Qpostgresql, "postgresql");
+
+ /* opaque exported types */
+ defsymbol (&Qpgconnp, "pgconnp");
+ defsymbol (&Qpgresultp, "pgresultp");
+
+ /* connection status types */
+ defsymbol (&Qpg_connection_ok, "pg::connection-ok");
+ defsymbol (&Qpg_connection_bad, "pg::connection-bad");
+ defsymbol (&Qpg_connection_started, "pg::connection-started");
+ defsymbol (&Qpg_connection_made, "pg::connection-made");
+ defsymbol (&Qpg_connection_awaiting_response, "pg::connection-awaiting-response");
+ defsymbol (&Qpg_connection_auth_ok, "pg::connection-auth-ok");
+ defsymbol (&Qpg_connection_setenv, "pg::connection-setenv");
+
+ /* Fields of PGconn */
+ defsymbol (&Qpqdb, "pq::db");
+ defsymbol (&Qpquser, "pq::user");
+ defsymbol (&Qpqpass, "pq::pass");
+ defsymbol (&Qpqhost, "pq::host");
+ defsymbol (&Qpqport, "pq::port");
+ defsymbol (&Qpqtty, "pq::tty");
+ defsymbol (&Qpqoptions, "pq::options");
+ defsymbol (&Qpqstatus, "pq::status");
+ defsymbol (&Qpqerrormessage, "pq::error-message");
+ defsymbol (&Qpqbackendpid, "pq::backend-pid");
+
+ /* Query status results */
+ defsymbol (&Qpgres_empty_query, "pgres::empty-query");
+ defsymbol (&Qpgres_command_ok, "pgres::command-ok");
+ defsymbol (&Qpgres_tuples_ok, "pgres::tuples-ok");
+ defsymbol (&Qpgres_copy_out, "pgres::copy-out");
+ defsymbol (&Qpgres_copy_in, "pgres::copy-in");
+ defsymbol (&Qpgres_bad_response, "pgres::bad-response");
+ defsymbol (&Qpgres_nonfatal_error, "pgres::nonfatal-error");
+ defsymbol (&Qpgres_fatal_error, "pgres::fatal-error");
+
+ /* Poll status results */
+ defsymbol (&Qpgres_polling_failed, "pgres::polling-failed");
+ defsymbol (&Qpgres_polling_reading, "pgres::polling-reading");
+ defsymbol (&Qpgres_polling_writing, "pgres::polling-writing");
+ defsymbol (&Qpgres_polling_ok, "pgres::polling-ok");
+ defsymbol (&Qpgres_polling_active, "pgres::polling-active");
+
+#ifdef HAVE_POSTGRESQLV7
+ DEFSUBR (Fpq_connect_start);
+ DEFSUBR (Fpq_connect_poll);
+#ifdef MULE
+ DEFSUBR (Fpq_client_encoding);
+ DEFSUBR (Fpq_set_client_encoding);
+#endif /* MULE */
+#endif /* HAVE_POSTGRESQLV7 */
+ DEFSUBR (Fpq_conn_defaults);
+ DEFSUBR (Fpq_connectdb);
+ DEFSUBR (Fpq_finish);
+ DEFSUBR (Fpq_clear);
+ DEFSUBR (Fpq_is_busy);
+ DEFSUBR (Fpq_consume_input);
+
+ DEFSUBR (Fpq_reset);
+#ifdef HAVE_POSTGRESQLV7
+ DEFSUBR (Fpq_reset_start);
+ DEFSUBR (Fpq_reset_poll);
+#endif
+ DEFSUBR (Fpq_request_cancel);
+ DEFSUBR (Fpq_pgconn);
+
+ DEFSUBR (Fpq_exec);
+ DEFSUBR (Fpq_send_query);
+ DEFSUBR (Fpq_get_result);
+ DEFSUBR (Fpq_result_status);
+ DEFSUBR (Fpq_res_status);
+ DEFSUBR (Fpq_result_error_message);
+ DEFSUBR (Fpq_ntuples);
+ DEFSUBR (Fpq_nfields);
+ DEFSUBR (Fpq_binary_tuples);
+ DEFSUBR (Fpq_fname);
+ DEFSUBR (Fpq_fnumber);
+ DEFSUBR (Fpq_ftype);
+ DEFSUBR (Fpq_fsize);
+ DEFSUBR (Fpq_fmod);
+ /***/
+ DEFSUBR (Fpq_get_value);
+ DEFSUBR (Fpq_get_length);
+ DEFSUBR (Fpq_get_is_null);
+ DEFSUBR (Fpq_cmd_status);
+ DEFSUBR (Fpq_cmd_tuples);
+ DEFSUBR (Fpq_oid_value);
+
+#ifdef HAVE_POSTGRESQLV7
+ DEFSUBR (Fpq_set_nonblocking);
+ DEFSUBR (Fpq_is_nonblocking);
+ DEFSUBR (Fpq_flush);
+#endif
+ DEFSUBR (Fpq_notifies);
+
+#if defined (HAVE_POSTGRESQLV7) && defined(MULE)
+ DEFSUBR (Fpq_env_2_encoding);
+#endif
+
+ DEFSUBR (Fpq_lo_import);
+ DEFSUBR (Fpq_lo_export);
+
+ DEFSUBR (Fpq_make_empty_pgresult);
+
+ /* copy in/out functions */
+ DEFSUBR (Fpq_get_line);
+ DEFSUBR (Fpq_put_line);
+ DEFSUBR (Fpq_get_line_async);
+ DEFSUBR (Fpq_put_nbytes);
+ DEFSUBR (Fpq_end_copy);
+
+ /* The value of the setenv functions is questioned in the libpq manual. */
+#if !defined (HAVE_POSTGRESQLV7) || defined (LIBPQ_7_0_IS_FIXED)
+ DEFSUBR (Fpq_setenv);
+#endif
+#ifdef LIBPQ_7_0_IS_FIXED
+ DEFSUBR (Fpq_setenv_start);
+ DEFSUBR (Fpq_setenv_poll);
+ DEFSUBR (Fpq_setenv_abort);
+#endif /* LIBPQ_7_0_IS_FIXED */
+}
+
+void
+vars_of_postgresql(void)
+{
+ char *p;
+
+ Fprovide (Qpostgresql);
+#ifdef HAVE_POSTGRESQLV7
+ Fprovide (intern ("postgresqlv7"));
+#endif
+#ifndef RUNNING_XEMACS_21_1
+ Vpg_coding_system = Qnative;
+ DEFVAR_LISP ("pg-coding-system", &Vpg_coding_system /*
+Default Postgres client coding system.
+*/ );
+#endif
+
+ if ((p = getenv ("PGHOST")))
+ {
+ VXPGHOST = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGHOST = Qnil;
+ }
+ DEFVAR_LISP ("pg:host", &VXPGHOST /*
+Default PostgreSQL server name.
+If not set, the server running on the local host is used. The
+initial value is set from the PGHOST environment variable.
+*/ );
+
+ if ((p = getenv ("PGUSER")))
+ {
+ VXPGUSER = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGUSER = Qnil;
+ }
+ DEFVAR_LISP ("pg:user", &VXPGUSER /*
+Default PostgreSQL user name.
+This value is used when connecting to a database for authentication.
+The initial value is set from the PGUSER environment variable.
+*/ );
+
+ if ((p = getenv ("PGOPTIONS")))
+ {
+ VXPGOPTIONS = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGOPTIONS = Qnil;
+ }
+ DEFVAR_LISP ("pg:options", &VXPGOPTIONS /*
+Default PostgreSQL user name.
+This value is used when connecting to a database for authentication.
+The initial value is set from the PGUSER environment variable.
+*/ );
+
+ if ((p = getenv ("PGPORT")))
+ {
+ VXPGPORT = make_int (atoi (p));
+ }
+ else
+ {
+ VXPGPORT = Qnil;
+ }
+ DEFVAR_LISP ("pg:port", &VXPGPORT /*
+Default port to connect to PostgreSQL backend.
+This value is used when connecting to a database.
+The initial value is set from the PGPORT environment variable.
+*/ );
+
+ if ((p = getenv ("PGTTY")))
+ {
+ VXPGTTY = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGTTY = Qnil;
+ }
+ DEFVAR_LISP ("pg:tty", &VXPGTTY /*
+Default debugging TTY.
+There is no useful setting of this variable in the XEmacs Lisp API.
+The initial value is set from the PGTTY environment variable.
+*/ );
+
+ if ((p = getenv ("PGDATABASE")))
+ {
+ VXPGDATABASE = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGDATABASE = Qnil;
+ }
+ DEFVAR_LISP ("pg:database", &VXPGDATABASE /*
+Default database to connect to.
+The initial value is set from the PGDATABASE environment variable.
+*/ );
+
+ if ((p = getenv ("PGREALM")))
+ {
+ VXPGREALM = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGREALM = Qnil;
+ }
+ DEFVAR_LISP ("pg:realm", &VXPGREALM /*
+Default kerberos realm to use for authentication.
+The initial value is set from the PGREALM environment variable.
+*/ );
+
+#ifdef MULE
+ /* It's not clear whether this is any use. My intent is to
+ autodetect the coding system from the database. */
+ if ((p = getenv ("PGCLIENTENCODING")))
+ {
+ VXPGCLIENTENCODING = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGCLIENTENCODING = Qnil;
+ }
+ DEFVAR_LISP ("pg:client-encoding", &VXPGCLIENTENCODING /*
+Default client encoding to use.
+The initial value is set from the PGCLIENTENCODING environment variable.
+*/ );
+#endif
+
+#if !defined(HAVE_POSTGRESQLV7)
+ if ((p = getenv ("PGAUTHTYPE")))
+ {
+ VXPGAUTHTYPE = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGAUTHTYPE = Qnil;
+ }
+ DEFVAR_LISP ("pg:authtype", &VXPGAUTHTYPE /*
+Default authentication to use.
+The initial value is set from the PGAUTHTYPE environment variable.
+
+WARNING: This variable has gone away in versions of PostgreSQL newer
+than 6.5.
+*/ );
+#endif
+
+ if ((p = getenv ("PGGEQO")))
+ {
+ VXPGGEQO = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGGEQO = Qnil;
+ }
+ DEFVAR_LISP ("pg:geqo", &VXPGGEQO /*
+Genetic Query Optimizer options.
+The initial value is set from the PGGEQO environment variable.
+*/ );
+
+ if ((p = getenv ("PGCOSTINDEX")))
+ {
+ VXPGCOSTINDEX = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGCOSTINDEX = Qnil;
+ }
+ DEFVAR_LISP ("pg:cost-index", &VXPGCOSTINDEX /*
+Default cost index options.
+The initial value is set from the PGCOSTINDEX environment variable.
+*/ );
+
+ if ((p = getenv ("PGCOSTHEAP")))
+ {
+ VXPGCOSTHEAP = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGCOSTHEAP = Qnil;
+ }
+ DEFVAR_LISP ("pg:cost-heap", &VXPGCOSTHEAP /*
+Default cost heap options.
+The initial value is set from the PGCOSTHEAP environment variable.
+*/ );
+
+ if ((p = getenv ("PGTZ")))
+ {
+ VXPGTZ = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGTZ = Qnil;
+ }
+ DEFVAR_LISP ("pg:tz", &VXPGTZ /*
+Default timezone to use.
+The initial value is set from the PGTZ environment variable.
+*/ );
+
+ if ((p = getenv ("PGDATESTYLE")))
+ {
+ VXPGDATESTYLE = build_ext_string (p, PG_OS_CODING);
+ }
+ else
+ {
+ VXPGDATESTYLE = Qnil;
+ }
+ DEFVAR_LISP ("pg:date-style", &VXPGDATESTYLE /*
+Default date style to use.
+The initial value is set from the PGDATESTYLE environment variable.
+*/ );
+}
--- /dev/null
+/*
+ postgresql.h -- Emacs Lisp binding to libpq.so
+ Copyright (C) 2000 Electrotechnical Laboratory, JAPAN.
+ Licensed to the Free Software Foundation.
+
+ Author: SL Baur <steve@beopen.com>
+ Maintainer: SL Baur <steve@beopen.com>
+
+Please send patches to this file to me first before submitting them to
+xemacs-patches.
+*/
+
+#ifndef XEMACS_POSTGRESQL_H__
+#define XEMACS_POSTGRESQL_H__ 1
+
+#define BLCKSZ 8192 /* size of a default Postres disk block */
+/*
+ This file contains the GCC bug workaround code for the private
+ LRECORD types.
+*/
+
+/* PGconn is an opaque object and we need to be able to store them in
+ Lisp code because libpq supports multiple connections.
+*/
+struct Lisp_PGconn
+{
+ struct lcrecord_header header;
+ PGconn *pgconn;
+};
+typedef struct Lisp_PGconn Lisp_PGconn;
+
+DECLARE_LRECORD (pgconn, Lisp_PGconn);
+
+#define XPGCONN(x) XRECORD (x, pgconn, Lisp_PGconn)
+#define XSETPGCONN(x, p) XSETRECORD (x, p, pgconn)
+#define PGCONNP(x) RECORDP (x, pgconn)
+#define CHECK_PGCONN(x) CHECK_RECORD (x, pgconn)
+#define CONCHECK_PGCONN(x) CONCHECK_RECORD (x, pgconn)
+
+/****/
+
+/* PGresult is an opaque object and we need to be able to store them in
+ Lisp code.
+*/
+struct Lisp_PGresult
+{
+ struct lcrecord_header header;
+ PGresult *pgresult;
+};
+typedef struct Lisp_PGresult Lisp_PGresult;
+
+DECLARE_LRECORD (pgresult, Lisp_PGresult);
+
+#define XPGRESULT(x) XRECORD (x, pgresult, Lisp_PGresult)
+#define XSETPGRESULT(x, p) XSETRECORD (x, p, pgresult)
+#define PGRESULTP(x) RECORDP (x, pgresult)
+#define CHECK_PGRESULT(x) CHECK_RECORD (x, pgresult)
+#define CONCHECK_PGRESULT(x) CONCHECK_RECORD (x, pgresult)
+
+/****/
+#ifdef HAVE_POSTGRESQLV7
+
+#ifdef LIBPQ_7_0_IS_FIXED /* this is broken in released 7.0b1 */
+
+/* PGsetenvHandle is an opaque object and we need to be able to store
+ them in Lisp code in order to make asynchronous environment calls.
+*/
+struct Lisp_PGsetenvHandle
+{
+ struct lcrecord_header header;
+ PGsetenvHandle *pgsetenv;
+};
+typedef struct Lisp_PGsetenvHandle Lisp_PGsetenvHandle;
+
+DECLARE_LRECORD (pgsetenv, Lisp_PGsetenvHandle);
+
+#define XPGSETENV(x) XRECORD (x, pgsetenv, Lisp_PGsetenvHandle)
+#define XSETPGSETENV(x, p) XSETRECORD (x, p, pgsetenv)
+#define PGSETENVP(x) RECORDP (x, pgsetenv)
+#define CHECK_PGSETENV(x) CHECK_RECORD (x, pgsetenv)
+#define CONCHECK_PGSETENV(x) CONCHECK_RECORD (x, pgsetenv)
+
+#endif /* LIBPQ_7_0_IS_FIXED */
+
+#endif /* HAVE_POSTGRESQLV7 */
+
+#endif /* XEMACS_POSTGRESQL_H__ */
--- /dev/null
+;; Copyright (C) 2000 Martin Buchholz
+
+;; Author: Martin Buchholz <martin@xemacs.org>
+;; Maintainer: Martin Buchholz <martin@xemacs.org>
+;; Created: 1998
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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, or (at your option)
+;; any later version.
+
+;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;;; Call tests in src/tests.c, which cannot be written using lisp only.
+;;; See test-harness.el for instructions on how to run these tests.
+
+(eval-when-compile
+ (condition-case nil
+ (require 'test-harness)
+ (file-error
+ (push "." load-path)
+ (when (and (boundp 'load-file-name) (stringp load-file-name))
+ (push (file-name-directory load-file-name) load-path))
+ (require 'test-harness))))
+
+(when (boundp 'test-function-list) ; Only if configure --debug
+ (loop for fun in test-function-list do
+ (Assert (eq 'PASS (funcall fun)))))
projects / chise / xemacs-chise.git / commitdiff