Merge from mainline.

44 files changed, 4921 insertions, 748 deletions

diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index a33d666e143..d725f8a559a 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -1,22 +1,22 @@
 ;;; bzrmerge.el --- 
 
-;; Copyright (C) 2010  Stefan Monnier
+;; Copyright (C) 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: 
 
-;; This program is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 3 of the License, or
 ;; (at your option) any later version.
 
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -202,7 +202,7 @@ Does not make other difference."
                   "merge" "-r" (format "%s" endrevno) from)
     (call-process "bzr" nil t nil "revert" ".")
     (call-process "bzr" nil t nil "unshelve")))
-  
+
 (defvar bzrmerge-already-done nil)
 
 (defun bzrmerge-apply (missing from)
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 7307d7fab4f..6a51b3f506b 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,7 @@
+2011-01-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * loading.texi (Hooks for Loading): Adjust doc of eval-after-load.
+
 2011-01-02  Eli Zaretskii  <eliz@gnu.org>
 
         * modes.texi (Emulating Mode Line): Fix last change.
@@ -8884,7 +8888,7 @@
 ;; End:
 
   Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-    2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+    2007, 2008, 2009, 2010, 2011  Free Software Foundation, Inc.
 
   This file is part of GNU Emacs.
 
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 2b539f00975..850cfd98220 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1919,7 +1919,7 @@ The variable @code{directory-abbrev-alist} contains an alist of
 abbreviations to use for file directories.  Each element has the form
 @code{(@var{from} . @var{to})}, and says to replace @var{from} with
 @var{to} when it appears in a directory name.  The @var{from} string is
-actually a regular expression; it should always start with @samp{\`}.
+actually a regular expression; it ought to always start with @samp{\`}.
 The @var{to} string should be an ordinary absolute directory name.  Do
 not use @samp{~} to stand for a home directory in that string.  The
 function @code{abbreviate-file-name} performs these substitutions.
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 05d836140c7..11bd48f8a01 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -962,7 +962,8 @@ example, @file{my_inst.elc} or @file{my_inst.elc.gz} in some directory
 @end example
 
 @var{library} can also be a feature (i.e.@: a symbol), in which case
-@var{form} is evaluated when @code{(provide @var{library})} is called.
+@var{form} is evaluated at the end of any file where
+@code{(provide @var{library})} is called.
 
 An error in @var{form} does not undo the load, but does prevent
 execution of the rest of @var{form}.
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 1acf8b0bbda..ca43b7e06df 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
+
+        * dbus.texi (Receiving Method Calls): New function
+        dbus-register-service.  Rearrange node.
+
 2011-01-07  Paul Eggert  <eggert@cs.ucla.edu>
 
         * texinfo.tex: Update to version 2010-12-23.17 from gnulib,
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 39f6221e2f2..fe7918038e2 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -1244,9 +1244,73 @@ message has been arrived, and @var{handler} is called.  Example:
 @cindex method calls, returning
 @cindex returning method calls
 
-Emacs can also offer own methods, which can be called by other
-applications.  These methods could be an implementation of an
-interface of a well known service, like @samp{org.freedesktop.TextEditor}.
+In order to register methods on the D-Bus, Emacs has to request a well
+known name on the D-Bus under which it will be available for other
+clients.  Names on the D-Bus can be registered and unregistered using
+the following functions:
+
+@defun dbus-register-service bus service &rest flags
+Register the known name @var{service} on D-Bus @var{bus}.
+
+@var{bus} is either the symbol @code{:system} or the symbol
+@code{:session}.
+
+@var{service} is the service name to be registered on the D-Bus.  It
+must be a known name.
+
+@var{flags} is a subset of the following keywords:
+
+@itemize
+@item @code{:allow-replacement}: Allow another service to become the primary
+owner if requested.
+
+@item @code{:replace-existing}: Request to replace the current primary owner.
+
+@item @code{:do-not-queue}: If we can not become the primary owner do not
+place us in the queue.
+@end itemize
+
+One of the following keywords is returned:
+
+@itemize
+
+@item @code{:primary-owner}: We have become the primary owner of the name
+@var{service}.
+
+@item @code{:in-queue}: We could not become the primary owner and
+have been placed in the queue.
+
+@item @code{:exists}: We already are in the queue.
+
+@item @code{:already-owner}: We already are the primary
+owner.
+@end itemize
+@end defun
+
+@defun dbus-unregister-service bus service
+Unregister all objects from D-Bus @var{bus}, registered by Emacs for
+@var{service}.
+
+@var{bus} is either the symbol @code{:system} or the symbol
+@code{:session}.
+
+@var{service} is the D-Bus service name of the D-Bus.  It must be a
+known name.  Emacs releases its association to @var{service} from
+D-Bus.
+
+One of the following keywords is returned:
+
+@itemize
+@item @code{:released}: We successfully released the name @var{service}.
+@item @code{:non-existent}: The name @var{service} does not exist on the bus.
+@item @code{:not-owner}: We are not an owner of the name @var{service}.
+@end itemize
+@end defun
+
+When a name has been chosen, Emacs can offer own methods, which can be
+called by other applications.  These methods could be an
+implementation of an interface of a well known service, like
+@samp{org.freedesktop.TextEditor}.
 
 It could be also an implementation of an own interface.  In this case,
 the service name must be @samp{org.gnu.Emacs}.  The object path shall
@@ -1300,7 +1364,7 @@ When @var{dont-register-service} is non-@code{nil}, the known name
 @var{service} is not registered.  This means that other D-Bus clients
 have no way of noticing the newly registered method.  When interfaces
 are constructed incrementally by adding single methods or properties
-at a time, @var{dont-register-service} can be use to prevent other
+at a time, @var{dont-register-service} can be used to prevent other
 clients from discovering the still incomplete interface.
 
 The default D-Bus timeout when waiting for a message reply is 25
@@ -1414,7 +1478,7 @@ When @var{dont-register-service} is non-@code{nil}, the known name
 @var{service} is not registered.  This means that other D-Bus clients
 have no way of noticing the newly registered method.  When interfaces
 are constructed incrementally by adding single methods or properties
-at a time, @var{dont-register-service} can be use to prevent other
+at a time, @var{dont-register-service} can be used to prevent other
 clients from discovering the still incomplete interface.
 
 @noindent Example:
@@ -1491,18 +1555,6 @@ registered for the respective service, Emacs releases its association
 to the service from D-Bus.
 @end defun
 
-@defun dbus-unregister-service bus service
-Unregister all objects from D-Bus @var{bus}, registered by Emacs for
-@var{service}.
-
-@var{bus} is either the symbol @code{:system} or the symbol
-@code{:session}.
-
-@var{service} is the D-Bus service name of the D-Bus.  It must be a
-known name.  Emacs releases its association to @var{service} from
-D-Bus.
-@end defun
-
 
 @node Signals
 @chapter Sending and receiving signals.
diff --git a/etc/ChangeLog b/etc/ChangeLog
index 9d8a3b8aafd..d690c963fba 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,14 @@
+2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
+
+        * NEWS: Add new function dbus-register-service.
+
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * themes/tango-theme.el, themes/tango-dark-theme.el: Let-bind
+        tango palette colors.  Only define faces for color displays.
+        Customize the ansi-color-names-vector variable.  Add Ediff,
+        Flyspell, and Semantic faces as suggested by Jan Moringen.
+
 2011-01-08  Andreas Schwab  <schwab@linux-m68k.org>
 
         * compilation.txt: Add column to gcc-include sample.
diff --git a/etc/NEWS b/etc/NEWS
index 0fd74252601..92d96fd1806 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -219,9 +219,10 @@ Emacs no longer looks for custom themes in `load-path'.  The default
 is to search in `custom-theme-directory', followed by a built-in theme
 directory named "themes/" in `data-directory'.
 
-*** New option `custom-safe-theme-files' lists known-safe theme files.
-If a theme is not in this list, Emacs queries before loading it.
-The default value treats all themes included in Emacs as safe.
+*** New option `custom-safe-themes' records known-safe theme files.
+If a theme is not in this list, Emacs queries before loading it, and
+offers to save the theme to `custom-safe-themes' automatically.  By
+default, all themes included in Emacs are treated as safe.
 
 ** The user option `remote-file-name-inhibit-cache' controls whether
 the remote file-name cache is used for read access.
@@ -322,6 +323,10 @@ prompts for a number to count from and for a format string.
 
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
+** Prolog mode has been completely revamped, with lots of additional
+functionality such as more intelligent indentation, electricty, support for
+more variants, including Mercury, and a lot more.
+
 ** shell-mode can track your cwd by reading it from your prompt.
 Just set shell-dir-cookie-re to an appropriate regexp.
 
@@ -564,7 +569,12 @@ threads simultaneously.
 *** It is possible now, to access alternative buses than the default
 system or session bus.
 
-*** dbus-register-{method,property} do not necessarily register names anymore.
+*** dbus-register-{service,method,property}
+The -method and -property functions do not automatically register
+names anymore.
+
+The new function dbus-register-service registers a service known name
+on a D-Bus without simultaneously registering a property or a method.
 
 ** Tramp
 
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index f63440b4ea7..06f209a03db 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -1,6 +1,9 @@
 ;;; tango-dark-theme.el --- Tango-based custom theme for faces
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+
+;; Authors: Chong Yidong <cyd@stupidchicken>
+;;          Jan Moringen <jan.moringen@uni-bielefeld.de>
 
 ;; This file is part of GNU Emacs.
 
@@ -25,63 +28,124 @@
 ;;; Code:
 
 (deftheme tango-dark
-  "Theme for faces, based on the Tango palette on a dark background.
-Basic, Font Lock, Isearch, Gnus, and Message faces are included.")
-
-(custom-theme-set-faces
- 'tango-dark
- '(default ((t (:foreground "#eeeeec" :background "#2e3436"))))
- '(cursor ((t (:foreground "#2e3436" :background "#fce94f"))))
- '(highlight ((t (:foreground "#2e3436" :background "#edd400"))))
- '(region ((t (:background "#555753"))))
- '(font-lock-builtin-face ((t (:foreground "#ad7fa8"))))
- '(font-lock-comment-face ((t (:foreground "#73d216"))))
- '(font-lock-constant-face ((t (:foreground "#e6a8df"))))
- '(font-lock-function-name-face ((t (:foreground "#fce94f"))))
- '(font-lock-keyword-face ((t (:foreground "#8cc4ff"))))
- '(font-lock-string-face ((t (:foreground "#e9b96e"))))
- '(font-lock-type-face ((t (:foreground "#a5ff4d"))))
- '(font-lock-variable-name-face ((t (:foreground "#fcaf3e"))))
- '(font-lock-warning-face ((t (:foreground "#ef2929"))))
- '(button ((t (:underline t :foreground "#729fcf"))))
- '(link ((t (:underline t :foreground "#729fcf"))))
- '(link-visited ((t (:underline t :foreground "#3465a4"))))
- '(mode-line ((t (:box (:line-width -1 :style released-button)
-                       :background "#d3d7cf" :foreground "black"))))
- '(mode-line-inactive ((t (:box (:line-width -1 :style released-button)
-                                :background "#555753" :foreground "white"))))
- '(isearch ((t (:foreground "#ffffff" :background "#ce5c00"))))
- '(lazy-highlight ((t (:background "#8f5902"))))
- '(gnus-group-news-1 ((t (:foreground "#ad7fa8"))))
- '(gnus-group-news-1-low ((t (:foreground "#75507b"))))
- '(gnus-group-news-2 ((t (:foreground "#729fcf"))))
- '(gnus-group-news-2-low ((t (:foreground "#3465a4"))))
- '(gnus-group-news-3 ((t (:foreground "#8ae234"))))
- '(gnus-group-news-3-low ((t (:foreground "#73d216"))))
- '(gnus-group-news-4 ((t (:foreground "#e9b9e6"))))
- '(gnus-group-news-4-low ((t (:foreground "#c17d11"))))
- '(gnus-group-news-5 ((t (:foreground "#fcaf3e"))))
- '(gnus-group-news-5-low ((t (:foreground "#f57900"))))
- '(gnus-group-news-low ((t (:foreground "#edd400"))))
- '(gnus-group-mail-1 ((t (:foreground "#ad7fa8"))))
- '(gnus-group-mail-1-low ((t (:foreground "#75507b"))))
- '(gnus-group-mail-2 ((t (:foreground "#729fcf"))))
- '(gnus-group-mail-2-low ((t (:foreground "#3465a4"))))
- '(gnus-group-mail-3 ((t (:foreground "#8ae234"))))
- '(gnus-group-mail-3-low ((t (:foreground "#73d216"))))
- '(gnus-group-mail-low ((t (:foreground "#edd400"))))
- '(gnus-header-content ((t (:weight normal :foreground "#c4a000"))))
- '(gnus-header-from ((t (:foreground "#edd400"))))
- '(gnus-header-subject ((t (:foreground "#8ae234"))))
- '(gnus-header-name ((t (:foreground "#729fcf"))))
- '(gnus-header-newsgroups ((t (:foreground "#c17d11"))))
- '(message-header-name ((t (:foreground "#729fcf"))))
- '(message-header-cc ((t (:foreground "#c4a000"))))
- '(message-header-other ((t (:foreground "#c17d11"))))
- '(message-header-subject ((t (:foreground "#8ae234"))))
- '(message-header-to ((t (:foreground "#edd400"))))
- '(message-cited-text ((t (:foreground "#8ae234"))))
- '(message-separator ((t (:foreground "#ad7fa8")))))
+  "Theme for faces, based on the Tango palette with a dark background.
+Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
+Semantic, and Ansi-Color faces are included.")
+
+(let ((class '((class color) (min-colors 89)))
+      ;; Tango palette colors.
+      (butter-1 "#fce94f") (butter-2 "#edd400") (butter-3 "#c4a000")
+      (orange-1 "#fcaf3e") (orange-2 "#f57900") (orange-3 "#ce5c00")
+      (choc-1 "#e9b96e") (choc-2 "#c17d11") (choc-3 "#8f5902")
+      (cham-1 "#8ae234") (cham-2 "#73d216") (cham-3 "#4e9a06")
+      (blue-1 "#729fcf") (blue-2 "#3465a4") (blue-3 "#204a87")
+      (plum-1 "#ad7fa8") (plum-2 "#75507b") (plum-3 "#5c3566")
+      (red-1 "#ef2929")  (red-2 "#cc0000")  (red-3 "#a40000")
+      (alum-1 "#eeeeec") (alum-2 "#d3d7cf") (alum-3 "#babdb6")
+      (alum-4 "#888a85") (alum-5 "#555753") (alum-6 "#2e3436")
+      ;; Not in Tango palette; used for better contrast.
+      (cham-0 "#b4fa70") (blue-0 "#8cc4ff") (plum-0 "#e6a8df")
+      (red-0 "#ff4b4b")  (alum-5.5 "#41423f") (alum-7 "#212526"))
+
+  (custom-theme-set-faces
+   'tango-dark
+   `(default ((,class (:foreground ,alum-1 :background ,alum-6))))
+   `(cursor ((,class (:foreground ,alum-6 :background ,butter-1))))
+   ;; Highlighting faces
+   `(fringe ((,class (:background ,alum-7))))
+   `(highlight ((,class (:foreground ,alum-6 :background ,butter-2))))
+   `(region ((,class (:background ,alum-5))))
+   `(secondary-selection ((,class (:background ,blue-3))))
+   `(isearch ((,class (:foreground ,alum-1 :background ,orange-3))))
+   `(lazy-highlight ((,class (:background ,choc-3))))
+   `(trailing-whitespace ((,class (:background ,red-3))))
+   ;; Mode line faces
+   `(mode-line ((,class
+                 (:box (:line-width -1 :style released-button)
+                  :background ,alum-2 :foreground ,alum-6))))
+   `(mode-line-inactive ((,class
+                          (:box (:line-width -1 :style released-button)
+                           :background ,alum-5 :foreground ,alum-1))))
+   ;; Escape and prompt faces
+   `(minibuffer-prompt ((,class (:foreground ,cham-0))))
+   `(escape-glyph ((,class (:foreground ,butter-3))))
+   ;; Font lock faces
+   `(font-lock-builtin-face ((,class (:foreground ,plum-1))))
+   `(font-lock-comment-face ((,class (:foreground ,cham-2))))
+   `(font-lock-constant-face ((,class (:foreground ,plum-0))))
+   `(font-lock-function-name-face ((,class (:foreground ,butter-1))))
+   `(font-lock-keyword-face ((,class (:foreground ,cham-0))))
+   `(font-lock-string-face ((,class (:foreground ,choc-1))))
+   `(font-lock-type-face ((,class (:foreground ,blue-0))))
+   `(font-lock-variable-name-face ((,class (:foreground ,orange-1))))
+   `(font-lock-warning-face ((,class (:foreground ,red-0))))
+   ;; Button and link faces
+   `(button ((,class (:underline t :foreground ,blue-1))))
+   `(link ((,class (:underline t :foreground ,blue-1))))
+   `(link-visited ((,class (:underline t :foreground ,blue-2))))
+   ;; Gnus faces
+   `(gnus-group-news-1 ((,class (:foreground ,plum-1))))
+   `(gnus-group-news-1-low ((,class (:foreground ,plum-2))))
+   `(gnus-group-news-2 ((,class (:foreground ,blue-1))))
+   `(gnus-group-news-2-low ((,class (:foreground ,blue-2))))
+   `(gnus-group-news-3 ((,class (:foreground ,cham-1))))
+   `(gnus-group-news-3-low ((,class (:foreground ,cham-2))))
+   `(gnus-group-news-4 ((,class (:foreground ,plum-0))))
+   `(gnus-group-news-4-low ((,class (:foreground ,choc-2))))
+   `(gnus-group-news-5 ((,class (:foreground ,orange-1))))
+   `(gnus-group-news-5-low ((,class (:foreground ,orange-2))))
+   `(gnus-group-news-low ((,class (:foreground ,butter-2))))
+   `(gnus-group-mail-1 ((,class (:foreground ,plum-1))))
+   `(gnus-group-mail-1-low ((,class (:foreground ,plum-2))))
+   `(gnus-group-mail-2 ((,class (:foreground ,blue-1))))
+   `(gnus-group-mail-2-low ((,class (:foreground ,blue-2))))
+   `(gnus-group-mail-3 ((,class (:foreground ,cham-1))))
+   `(gnus-group-mail-3-low ((,class (:foreground ,cham-2))))
+   `(gnus-group-mail-low ((,class (:foreground ,butter-2))))
+   `(gnus-header-content ((,class (:weight normal :foreground ,butter-3))))
+   `(gnus-header-from ((,class (:foreground ,butter-2))))
+   `(gnus-header-subject ((,class (:foreground ,cham-1))))
+   `(gnus-header-name ((,class (:foreground ,blue-1))))
+   `(gnus-header-newsgroups ((,class (:foreground ,choc-2))))
+   ;; Message faces
+   `(message-header-name ((,class (:foreground ,blue-1))))
+   `(message-header-cc ((,class (:foreground ,butter-3))))
+   `(message-header-other ((,class (:foreground ,choc-2))))
+   `(message-header-subject ((,class (:foreground ,cham-1))))
+   `(message-header-to ((,class (:foreground ,butter-2))))
+   `(message-cited-text ((,class (:foreground ,cham-1))))
+   `(message-separator ((,class (:foreground ,plum-1))))
+   ;; SMerge faces
+   `(smerge-refined-change ((,class (:background ,blue-3))))
+   ;; Ediff faces
+   `(ediff-current-diff-A ((,class (:background ,alum-5))))
+   `(ediff-fine-diff-A ((,class (:background ,blue-3))))
+   `(ediff-even-diff-A ((,class (:background ,alum-5.5))))
+   `(ediff-odd-diff-A ((,class (:background ,alum-5.5))))
+   `(ediff-current-diff-B ((,class (:background ,alum-5))))
+   `(ediff-fine-diff-B ((,class (:background ,choc-3))))
+   `(ediff-even-diff-B ((,class (:background ,alum-5.5))))
+   `(ediff-odd-diff-B ((,class (:background ,alum-5.5))))
+   ;; Flyspell faces
+   `(flyspell-duplicate ((,class (:underline ,orange-1))))
+   `(flyspell-incorrect ((,class (:underline ,red-1))))
+   ;; Semantic faces
+   `(semantic-decoration-on-includes ((,class (:underline ,alum-4))))
+   `(semantic-decoration-on-private-members-face
+     ((,class (:background ,plum-3))))
+   `(semantic-decoration-on-protected-members-face
+     ((,class (:background ,choc-3))))
+   `(semantic-decoration-on-unknown-includes
+     ((,class (:background ,red-3))))
+   `(semantic-decoration-on-unparsed-includes
+     ((,class (:background ,alum-5.5))))
+   `(semantic-tag-boundary-face ((,class (:overline ,blue-1))))
+   `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))))
+
+  (custom-theme-set-variables
+   'tango-dark
+   `(ansi-color-names-vector [,alum-7 ,red-0 ,cham-0 ,butter-1
+                              ,blue-1 ,plum-1 ,blue-0 ,alum-1])))
 
 (provide-theme 'tango-dark)
 
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index f0492c048af..29fc6a6b4d5 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -1,6 +1,9 @@
 ;;; tango-theme.el --- Tango-based custom theme for faces
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+
+;; Authors: Chong Yidong <cyd@stupidchicken>
+;;          Jan Moringen <jan.moringen@uni-bielefeld.de>
 
 ;; This file is part of GNU Emacs.
 
@@ -25,63 +28,117 @@
 ;;; Code:
 
 (deftheme tango
-  "Theme for faces, based on the Tango palette on a light background.
-Basic, Font Lock, Isearch, Gnus, and Message faces are included.")
-
-(custom-theme-set-faces
- 'tango
- '(default ((t (:foreground "#16191a" :background "#eeeeec"))))
- '(cursor ((t (:foreground "#eeeeec" :background "#204a87"))))
- '(highlight ((t (:background "#babdb6"))))
- '(region ((t (:background "#babdb6"))))
- '(font-lock-builtin-face ((t (:weight bold :foreground "#204a87"))))
- '(font-lock-comment-face ((t (:foreground "#204a87"))))
- '(font-lock-constant-face ((t (:weight bold :foreground "#5c3566"))))
- '(font-lock-function-name-face ((t (:weight bold :foreground "#ce5c00"))))
- '(font-lock-keyword-face ((t (:foreground "#a40000"))))
- '(font-lock-string-face ((t (:foreground "#5c3566"))))
- '(font-lock-type-face ((t (:weight bold :foreground "#4e9a06"))))
- '(font-lock-variable-name-face ((t (:weight bold :foreground "#c17d11"))))
- '(font-lock-warning-face ((t (:foreground "#cc0000"))))
- '(button ((t (:underline t :foreground "#204a87"))))
- '(link ((t (:underline t :foreground "#204a87"))))
- '(link-visited ((t (:underline t :foreground "#3465a4"))))
- '(mode-line ((t (:box (:line-width -1 :style released-button)
-                       :background "#d3d7cf" :foreground "black"))))
- '(mode-line-inactive ((t (:box (:line-width -1 :style released-button)
-                                :background "#babdb6" :foreground "black"))))
- '(isearch ((t (:foreground "#ffffff" :background "#ce5c00"))))
- '(lazy-highlight ((t (:background "#e9b96e"))))
- '(gnus-group-news-1 ((t (:weight bold :foreground "#5c3566"))))
- '(gnus-group-news-1-low ((t (:foreground "#5c3566"))))
- '(gnus-group-news-2 ((t (:weight bold :foreground "#204a87"))))
- '(gnus-group-news-2-low ((t (:foreground "#204a87"))))
- '(gnus-group-news-3 ((t (:weight bold :foreground "#4e0a06"))))
- '(gnus-group-news-3-low ((t (:foreground "#4e0a06"))))
- '(gnus-group-news-4 ((t (:weight bold :foreground "#7a4c02"))))
- '(gnus-group-news-4-low ((t (:foreground "#7a4c02"))))
- '(gnus-group-news-5 ((t (:weight bold :foreground "#ce5c00"))))
- '(gnus-group-news-5-low ((t (:foreground "#ce5c00"))))
- '(gnus-group-news-low ((t (:foreground "#888a85"))))
- '(gnus-group-mail-1 ((t (:weight bold :foreground "#5c3566"))))
- '(gnus-group-mail-1-low ((t (:foreground "#5c3566"))))
- '(gnus-group-mail-2 ((t (:weight bold :foreground "#204a87"))))
- '(gnus-group-mail-2-low ((t (:foreground "#204a87"))))
- '(gnus-group-mail-3 ((t (:weight bold :foreground "#4e0a06"))))
- '(gnus-group-mail-3-low ((t (:foreground "#4e0a06"))))
- '(gnus-group-mail-low ((t (:foreground "#888a85"))))
- '(gnus-header-content ((t (:foreground "#4e9a06"))))
- '(gnus-header-from ((t (:weight bold :foreground "#c4a000"))))
- '(gnus-header-subject ((t (:foreground "#4e0a06"))))
- '(gnus-header-name ((t (:foreground "#204a87"))))
- '(gnus-header-newsgroups ((t (:foreground "#888a85"))))
- '(message-header-name ((t (:foreground "#204a87"))))
- '(message-header-cc ((t (:foreground "#c4a000"))))
- '(message-header-other ((t (:foreground "#c17d11"))))
- '(message-header-subject ((t (:foreground "#4e0a06"))))
- '(message-header-to ((t (:weight bold :foreground "#c4a000"))))
- '(message-cited-text ((t (:foreground "#888a85"))))
- '(message-separator ((t (:weight bold :foreground "#4e9a06")))))
+  "Theme for faces, based on the Tango palette with a light background.
+Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
+Semantic, and Ansi-Color faces are included.")
+
+(let ((class '((class color) (min-colors 89)))
+      ;; Tango palette colors.
+      (butter-1 "#fce94f") (butter-2 "#edd400") (butter-3 "#c4a000")
+      (orange-1 "#fcaf3e") (orange-2 "#f57900") (orange-3 "#ce5c00")
+      (choc-1 "#e9b96e") (choc-2 "#c17d11") (choc-3 "#8f5902")
+      (cham-1 "#8ae234") (cham-2 "#73d216") (cham-3 "#4e9a06")
+      (blue-1 "#729fcf") (blue-2 "#3465a4") (blue-3 "#204a87")
+      (plum-1 "#ad7fa8") (plum-2 "#75507b") (plum-3 "#5c3566")
+      (red-1 "#ef2929")  (red-2 "#cc0000")  (red-3 "#a40000")
+      (alum-1 "#eeeeec") (alum-2 "#d3d7cf") (alum-3 "#babdb6")
+      (alum-4 "#888a85") (alum-5 "#555753") (alum-6 "#2e3436")
+      ;; Not in Tango palette; used for better contrast.
+      (cham-4 "#346604") (blue-0 "#8cc4ff"))
+
+  (custom-theme-set-faces
+   'tango
+   `(default ((,class (:foreground ,"#16191a" :background ,alum-1))))
+   `(cursor ((,class (:foreground ,alum-1 :background ,blue-3))))
+   ;; Highlighting faces
+   `(fringe ((,class (:background ,alum-2))))
+   `(highlight ((,class (:background ,alum-3))))
+   `(region ((,class (:background ,alum-3))))
+   `(secondary-selection ((,class (:background ,blue-0))))
+   `(isearch ((,class (:foreground ,"#ffffff" :background ,orange-3))))
+   `(lazy-highlight ((,class (:background ,choc-1))))
+   `(trailing-whitespace ((,class (:background ,red-1))))
+   ;; Mode line faces
+   `(mode-line ((,class (:box (:line-width -1 :style released-button)
+                         :background ,alum-2 :foreground ,alum-6))))
+   `(mode-line-inactive ((,class (:box (:line-width -1 :style released-button)
+                                  :background ,alum-4 :foreground ,alum-6))))
+   ;; Escape and prompt faces
+   `(minibuffer-prompt ((,class (:weight bold :foreground ,blue-3))))
+   `(escape-glyph ((,class (:foreground ,red-3))))
+   ;; Font lock faces
+   `(font-lock-builtin-face ((,class (:weight bold :foreground ,plum-3))))
+   `(font-lock-comment-face ((,class (:foreground ,cham-4))))
+   `(font-lock-constant-face ((,class (:weight bold :foreground ,blue-3))))
+   `(font-lock-function-name-face ((,class (:foreground ,red-3))))
+   `(font-lock-keyword-face ((,class (:weight bold :foreground ,choc-2))))
+   `(font-lock-string-face ((,class (:foreground ,plum-3))))
+   `(font-lock-type-face ((,class (:foreground ,blue-3))))
+   `(font-lock-variable-name-face ((,class (:weight bold :foreground ,orange-3))))
+   `(font-lock-warning-face ((,class (:foreground ,red-2))))
+   ;; Button and link faces
+   `(button ((,class (:underline t :foreground ,blue-3))))
+   `(link ((,class (:underline t :foreground ,blue-3))))
+   `(link-visited ((,class (:underline t :foreground ,blue-2))))
+   ;; Gnus faces
+   `(gnus-group-news-1 ((,class (:weight bold :foreground ,plum-3))))
+   `(gnus-group-news-1-low ((,class (:foreground ,plum-3))))
+   `(gnus-group-news-2 ((,class (:weight bold :foreground ,blue-3))))
+   `(gnus-group-news-2-low ((,class (:foreground ,blue-3))))
+   `(gnus-group-news-3 ((,class (:weight bold :foreground ,"#4e0a06"))))
+   `(gnus-group-news-3-low ((,class (:foreground ,"#4e0a06"))))
+   `(gnus-group-news-4 ((,class (:weight bold :foreground ,"#7a4c02"))))
+   `(gnus-group-news-4-low ((,class (:foreground ,"#7a4c02"))))
+   `(gnus-group-news-5 ((,class (:weight bold :foreground ,orange-3))))
+   `(gnus-group-news-5-low ((,class (:foreground ,orange-3))))
+   `(gnus-group-news-low ((,class (:foreground ,"#888a85"))))
+   `(gnus-group-mail-1 ((,class (:weight bold :foreground ,plum-3))))
+   `(gnus-group-mail-1-low ((,class (:foreground ,plum-3))))
+   `(gnus-group-mail-2 ((,class (:weight bold :foreground ,blue-3))))
+   `(gnus-group-mail-2-low ((,class (:foreground ,blue-3))))
+   `(gnus-group-mail-3 ((,class (:weight bold :foreground ,"#4e0a06"))))
+   `(gnus-group-mail-3-low ((,class (:foreground ,"#4e0a06"))))
+   `(gnus-group-mail-low ((,class (:foreground ,"#888a85"))))
+   `(gnus-header-content ((,class (:foreground ,cham-3))))
+   `(gnus-header-from ((,class (:weight bold :foreground ,butter-3))))
+   `(gnus-header-subject ((,class (:foreground ,"#4e0a06"))))
+   `(gnus-header-name ((,class (:foreground ,blue-3))))
+   `(gnus-header-newsgroups ((,class (:foreground ,"#888a85"))))
+   ;; Message faces
+   `(message-header-name ((,class (:foreground ,blue-3))))
+   `(message-header-cc ((,class (:foreground ,butter-3))))
+   `(message-header-other ((,class (:foreground ,choc-2))))
+   `(message-header-subject ((,class (:foreground ,"#4e0a06"))))
+   `(message-header-to ((,class (:weight bold :foreground ,butter-3))))
+   `(message-cited-text ((,class (:foreground ,"#888a85"))))
+   `(message-separator ((,class (:weight bold :foreground ,cham-3))))
+   ;; SMerge
+   `(smerge-refined-change ((,class (:background ,plum-1))))
+   ;; Ediff
+   `(ediff-current-diff-A ((,class (:background ,blue-1))))
+   `(ediff-fine-diff-A ((,class (:background ,plum-1))))
+   `(ediff-current-diff-B ((,class (:background ,butter-1))))
+   `(ediff-fine-diff-B ((,class (:background ,orange-1))))
+   ;; Flyspell
+   `(flyspell-duplicate ((,class (:underline ,orange-1))))
+   `(flyspell-incorrect ((,class (:underline ,red-1))))
+   ;; Semantic faces
+   `(semantic-decoration-on-includes ((,class (:underline  ,cham-4))))
+   `(semantic-decoration-on-private-members-face
+     ((,class (:background ,alum-2))))
+   `(semantic-decoration-on-protected-members-face
+     ((,class (:background ,alum-2))))
+   `(semantic-decoration-on-unknown-includes
+     ((,class (:background ,choc-3))))
+   `(semantic-decoration-on-unparsed-includes
+     ((,class (:underline  ,orange-3))))
+   `(semantic-tag-boundary-face ((,class (:overline   ,blue-1))))
+   `(semantic-unmatched-syntax-face ((,class (:underline  ,red-1)))))
+
+  (custom-theme-set-variables
+   'tango
+   `(ansi-color-names-vector [,alum-6 ,red-3 ,cham-3 ,butter-3
+                                      ,blue-3 ,plum-3 ,blue-1 ,alum-1])))
 
 (provide-theme 'tango)
 
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index f7761d0489e..4fe86987d87 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -31,6 +31,7 @@
  '(diff-indicator-changed ((t (:weight bold))))
  '(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
  '(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
+ '(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
  '(hl-line ((t (:background "grey28"))))
  '(message-header-subject ((t (:foreground "SkyBlue"))))
  '(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index b66acccaa83..5fb6ba84d70 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -31,6 +31,7 @@
  '(diff-indicator-changed ((t (:weight bold))))
  '(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
  '(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
+ '(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
  '(hl-line ((t (:background "grey95"))))
  '(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
  '(mode-line ((t (:box (:line-width -1 :color "red" :style released-button) :family "DejaVu Sans"))))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 86f9e8fa0b9..0c3f09e157b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,128 @@
+2011-01-11  Johan Bockgård  <bojohan@gnu.org>
+
+        * emacs-lisp/unsafep.el (unsafep): Handle backquoted forms.
+
+2011-01-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * progmodes/prolog.el: Fix up coding convention and such.
+        (prolog-indent-width): Use the same default as in
+        previous prolog.el rather than tab-width which depends on which buffer
+        is current when the file is loaded.
+        (prolog-electric-newline-flag): Only enable if electric-indent-mode
+        is not available.
+        (prolog-emacs): Remove.  Use (featurep 'xemacs) instead.
+        (prolog-known-systems): Remove.
+        (prolog-mode-syntax-table, prolog-inferior-mode-map):
+        Move initialization into declaration.
+        (prolog-mode-map): Move initialization into declaration.
+        Remove system-specific mode-map vars, since they referred to the same
+        keymap anyway.
+        (prolog-mode-variables): Obey the user's preference w.r.t
+        adaptive-fill-mode.  Prefer symbol-value to `eval'.
+        (prolog-mode-keybindings-edit): Add compatibility bindings.
+        (prolog-mode): Use define-derived-mode.  Don't handle mercury here.
+        (mercury-mode-map): New var.
+        (mercury-mode, prolog-inferior-mode): Use define-derived-mode.
+        (prolog-ensure-process, prolog-process-insert-string)
+        (prolog-consult-compile): Use with-current-buffer.
+        (prolog-guess-fill-prefix): Simplify data flow.
+        (prolog-replace-in-string): New function to use instead of
+        replace-in-string.
+        (prolog-enable-sicstus-sd): Don't abuse `eval'.
+        (prolog-uncomment-region): Use `uncomment-region' when available.
+        (prolog-electric-colon, prolog-electric-dash): Use `eolp'.
+        (prolog-int-to-char, prolog-char-to-int): New functions to use instead
+        of int-to-char and char-to-int.
+        (prolog-mode-hook, prolog-inferior-mode-hook): Don't force font-lock.
+
+2011-01-11  Stefan Bruda  <stefan@bruda.ca>
+
+        * progmodes/prolog.el: Replace by a whole new file.
+
+2011-01-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * subr.el (eval-after-load): Fix timing for features (bug#7769).
+        (declare-function, undefined, insert-for-yank)
+        (replace-regexp-in-string): Follow checkdoc's recommendations.
+
+2011-01-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * calendar/diary-lib.el (diary-mode): Refresh *Calendar* after
+        refreshing the diary buffer.
+
+2011-01-10  Ken Manheimer  <ken.manheimer@gmail.com>
+
+        * allout.el: Add 2011 to the file copyright.
+        (allout-encrypt-string): Prevent encryption from adding an extra
+        newline at the end of the topic body.
+        (allout-version): Increment to 2.3.
+
+2011-01-10  Michael Albinus  <michael.albinus@gmx.de>
+
+        * net/dbus.el (dbus-unregister-service): Complete doc.
+        Fix call of dbus-error signal.
+        (dbus-register-property): Use `dont-register' keyword.
+
+2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
+
+        * net/dbus.el (dbus-unregister-service): Translate returned
+        integer into a symbol.
+        (dbus-register-property): Use `dbus-register-service' to do the
+        name registration.
+
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * progmodes/idlw-help.el (idlwave-help-link): Inherit from link face.
+        Suggested by Joakim Verona.
+
+        * comint.el (comint-highlight-prompt): Inherit minibuffer-prompt.
+
+        * wid-edit.el (visibility): Replace :on-image and :off-image
+        widget properties with :on-glyph and :off-glyph, for consistency
+        with the `visibility' widget.
+        (widget-toggle-value-create, widget-visibility-value-create):
+        Merge into a single function `widget-toggle-value-create'.
+
+        * cus-edit.el (custom-variable-value-create, custom-visibility)
+        (custom-face-edit-value-create, custom-face-value-create):
+        Replace :on-image and :off-image widget properties with :on-glyph and
+        :off-glyph, for consistency with the `visibility' widget.
+
+2011-01-09  Andreas Schwab  <schwab@linux-m68k.org>
+
+        * net/ldap.el (ldap-search-internal): Don't use eval.
+
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * subr.el (read-char-choice): Use read-key.
+
+        * custom.el (custom-safe-themes): Rename from
+        custom-safe-theme-files.  Add :risky tag.
+        (load-theme, custom-theme-load-confirm): Save sha1 hashes to
+        custom-safe-themes, not filenames.  Suggested by Stefan Monnier.
+
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * tool-bar.el (tool-bar-setup): Remove Help button.  Remove label
+        from Search and add a label to Undo.
+
+        * vc/vc-dir.el (vc-dir-tool-bar-map): Rearrange, removing
+        inappropriate buttons and adding :vert-only tags.
+
+        * progmodes/compile.el (compilation-mode-tool-bar-map): Adjust to
+        removal of Help tool-bar button.  Remove Undo button for space.
+
+        * info.el (info-tool-bar-map): Add :vert-only tags.
+
+2011-01-08  Tassilo Horn  <tassilo@member.fsf.org>
+
+        * doc-view.el (doc-view-mode-p): Check for png or imagemagick
+        image backend support.  Either of them is fine.
+
 2011-01-08  Chong Yidong  <cyd@stupidchicken.com>
 
+        * subr.el (y-or-n-p): Doc fix.
+
         * custom.el (custom-safe-theme-files): New defcustom.
         (custom-theme-load-confirm): New function.
         (load-theme): Load theme using `load', confirming with
@@ -97,7 +220,7 @@
 
 2011-01-04  Jan Moringen  <jan.moringen@uni-bielefeld.de>
 
-        * net/dbus.el (dbus-register-property): Added optional parameter
+        * net/dbus.el (dbus-register-property): Add optional parameter
         dont-register-service.  Updated docstring accordingly.
 
 2011-01-04  Andreas Schwab  <schwab@linux-m68k.org>
@@ -266,8 +389,8 @@
 
 2010-12-30  Tassilo Horn  <tassilo@member.fsf.org>
 
-        * doc-view.el (doc-view-mode, doc-view-toggle-display): Use
-        normal-mode without doc-view-mode bindings in auto-mode-alist as
+        * doc-view.el (doc-view-mode, doc-view-toggle-display):
+        Use normal-mode without doc-view-mode bindings in auto-mode-alist as
         fallback instead of hard coding fundamental mode.
 
 2010-12-30  Tassilo Horn  <tassilo@member.fsf.org>
@@ -462,8 +585,8 @@
 
 2010-12-16  Leo  <sdl.web@gmail.com>
 
-        * eshell/eshell.el (eshell-directory-name): Use
-        locate-user-emacs-file (Bug#7578).
+        * eshell/eshell.el (eshell-directory-name):
+        Use locate-user-emacs-file (Bug#7578).
 
 2010-12-15  Glenn Morris  <rgm@gnu.org>
 
@@ -488,8 +611,8 @@
         (tramp-handle-insert-file-contents): Do not set permanent-local
         property.
 
-        * net/tramp-cache.el (tramp-persistency-file-name): Use
-        `locate-user-emacs-file' if fboundp.
+        * net/tramp-cache.el (tramp-persistency-file-name):
+        Use `locate-user-emacs-file' if fboundp.
 
         * net/tramp-sh.el (tramp-methods): Add "ksu".
         (tramp-default-user-alist): Add "ksu".  Use `regexp-opt' for
diff --git a/lisp/allout.el b/lisp/allout.el
index 0df2d2bb153..63af7457d93 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,12 +1,12 @@
 ;;; allout.el --- extensive outline mode for use alone and with other modes
 
 ;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;;   2007, 2008, 2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
 ;; Created: Dec 1991 -- first release to usenet
-;; Version: 2.2.2
+;; Version: 2.3
 ;; Keywords: outlines wp languages
 ;; Website: http://myriadicity.net/Sundry/EmacsAllout
 
@@ -569,7 +569,7 @@ themselves:
  `!' - exclamation point/bang -- emphatic
  `[' - open square bracket -- meta-note, about item instead of item's subject
  `\"' - double quote -- a quotation or other citation
- `=' - equal sign -- an assignement, equating a name with some connotation
+ `=' - equal sign -- an assignment, some kind of definition
  `^' - carat -- relates to something above
 
 Some are more elusive, but their rationale may be recognizable:
@@ -891,7 +891,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring."
 ;;;_ #1 Internal Outline Formatting and Configuration
 ;;;_  : Version
 ;;;_   = allout-version
-(defvar allout-version "2.2.2"
+(defvar allout-version "2.3"
   "Version of currently loaded outline package.  (allout.el)")
 ;;;_   > allout-version
 (defun allout-version (&optional here)
@@ -6226,10 +6226,11 @@ signal."
               (epg-decrypt-string epg-context
                                   (encode-coding-string massaged-text
                                                         (or encoding 'utf-8)))
-            (epg-encrypt-string epg-context
-                                (encode-coding-string massaged-text
-                                                      (or encoding 'utf-8))
-                                recipients)))
+            (replace-regexp-in-string "\n$" ""
+             (epg-encrypt-string epg-context
+                                 (encode-coding-string massaged-text
+                                                       (or encoding 'utf-8))
+                                 recipients))))
 
     ;; validate result -- non-empty
     (if (not result-text)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 869d69fd8b7..ee4de475079 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,7 +1,7 @@
 ;;; diary-lib.el --- diary functions
 
 ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -2346,6 +2346,9 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
        '(diary-font-lock-keywords t))
   (add-to-invisibility-spec '(diary . nil))
   (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
+  ;; In case the file was modified externally, refresh the calendar
+  ;; after refreshing the diary buffer.
+  (add-hook 'after-revert-hook 'diary-redraw-calendar nil t)
   (if diary-header-line-flag
       (setq header-line-format diary-header-line-format)))
 
diff --git a/lisp/comint.el b/lisp/comint.el
index bd563ee4592..bfee8e35c9c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -227,9 +227,7 @@ This variable is buffer-local."
   :group 'comint)
 
 (defface comint-highlight-prompt
-  '((((min-colors 88) (background dark)) (:foreground "cyan1"))
-    (((background dark)) (:foreground "cyan"))
-    (t (:foreground "dark blue")))
+  '((t :inherit minibuffer-prompt))
   "Face to use to highlight prompts."
   :group 'comint)
 
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index edb299f86ed..8d42e497450 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -2551,9 +2551,9 @@ try matching its doc string against `custom-guess-doc-alist'."
            (push (widget-create-child-and-convert
                   widget 'custom-visibility
                   :help-echo "Show the value of this option."
-                  :on-image "down"
+                  :on-glyph "down"
                   :on "Hide"
-                  :off-image "right"
+                  :off-glyph "right"
                   :off "Show Value"
                   :action 'custom-toggle-hide-variable
                   nil)
@@ -2573,8 +2573,8 @@ try matching its doc string against `custom-guess-doc-alist'."
                   :help-echo "Hide the value of this option."
                   :on "Hide"
                   :off "Show"
-                  :on-image "down"
-                  :off-image "right"
+                  :on-glyph "down"
+                  :off-glyph "right"
                   :action 'custom-toggle-hide-variable
                   t)
                  buttons)
@@ -2603,8 +2603,8 @@ try matching its doc string against `custom-guess-doc-alist'."
                   :help-echo "Hide or show this option."
                   :on "Hide"
                   :off "Show"
-                  :on-image "down"
-                  :off-image "right"
+                  :on-glyph "down"
+                  :off-glyph "right"
                   :action 'custom-toggle-hide-variable
                   t)
                  buttons)
@@ -3056,8 +3056,8 @@ to switch between two values."
   :pressed-face 'custom-visibility
   :mouse-face 'highlight
   :pressed-face 'highlight
-  :on-image nil
-  :off-image nil)
+  :on-glyph nil
+  :off-glyph nil)
 
 (defface custom-visibility
   '((t :height 0.8 :inherit link))
@@ -3120,7 +3120,7 @@ face attributes (as specified by a `default' defface entry)."
            :pressed-face 'custom-visibility
            :mouse-face 'highlight
            :on "Hide Unused Attributes"    :off "Show All Attributes"
-           :on-image nil :off-image nil
+           :on-glyph nil :off-glyph nil
            :always-active t
            :action 'custom-face-edit-value-visibility-action
            show-all)
@@ -3475,7 +3475,7 @@ the present value is saved to its :shown-value property instead."
                widget 'custom-visibility
                :help-echo "Hide or show this face."
                :on "Hide" :off "Show"
-               :on-image "down" :off-image "right"
+               :on-glyph "down" :off-glyph "right"
                :action 'custom-toggle-hide-face
                (not hiddenp))
               buttons)
diff --git a/lisp/custom.el b/lisp/custom.el
index f984d132dd1..6a0beae749e 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1105,14 +1105,16 @@ property `theme-feature' (which is usually a symbol created by
     (let ((custom-enabling-themes t))
       (enable-theme 'user))))
 
-(defcustom custom-safe-theme-files '(default)
-  "List of theme files that are considered safe to load.
-Each list element should be either an absolute file name, or the
-symbol `default', which stands for the built-in Emacs theme
-directory (a directory named \"themes\" in `data-directory'."
+(defcustom custom-safe-themes '(default)
+  "List of themes that are considered safe to load.
+Each list element should be the `sha1' hash of a theme file, or
+the symbol `default', which stands for any theme in the built-in
+Emacs theme directory (a directory named \"themes\" in
+`data-directory')."
   :type '(repeat
-          (choice file (const :tag "Built-in theme directory" default)))
+          (choice string (const :tag "Built-in themes" default)))
   :group 'customize
+  :risky t
   :version "24.1")
 
 (defvar safe-functions) ; From unsafep.el
@@ -1140,74 +1142,74 @@ in one of the directories specified by `custom-theme-load-path'."
     (put theme 'theme-documentation nil))
   (let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
                          (custom-theme--load-path)
-                         '("" "c"))))
+                         '("" "c")))
+        hash)
     (unless fn
       (error "Unable to find theme file for `%s'." theme))
-    ;; Check file safety.
-    (when (or (and (memq 'default custom-safe-theme-files)
-                   (equal (file-name-directory fn)
-                          (expand-file-name "themes/" data-directory)))
-              (member fn custom-safe-theme-files)
-              ;; If the file is not in the builtin theme directory or
-              ;; in `custom-safe-theme-files', check it with unsafep.
-              (with-temp-buffer
-                (require 'unsafep)
-                (insert-file-contents fn)
-                (let ((safe-functions (append '(provide-theme deftheme
-                                                custom-theme-set-variables
-                                                custom-theme-set-faces)
-                                              safe-functions))
-                      unsafep form)
-                  (while (and (setq form (condition-case nil
-                                             (let ((read-circle nil))
-                                               (read (current-buffer)))
-                                           (end-of-file nil)))
-                              (null (setq unsafep (unsafep form)))))
-                  (or (null unsafep)
-                      (custom-theme-load-confirm fn)))))
-      (let ((custom--inhibit-theme-enable no-enable))
-        (load fn)))))
-
-(defun custom-theme-load-confirm (filename)
+    (with-temp-buffer
+      (insert-file-contents fn)
+      (setq hash (sha1 (current-buffer)))
+      ;; Check file safety.
+      (when (or (and (memq 'default custom-safe-themes)
+                     (equal (file-name-directory fn)
+                            (expand-file-name "themes/" data-directory)))
+                (member hash custom-safe-themes)
+                ;; If the theme is not in `custom-safe-themes', check
+                ;; it with unsafep.
+                (progn
+                  (require 'unsafep)
+                  (let ((safe-functions
+                         (append '(provide-theme deftheme
+                                   custom-theme-set-variables
+                                   custom-theme-set-faces)
+                                 safe-functions))
+                        unsafep form)
+                    (while (and (setq form (condition-case nil
+                                               (let ((read-circle nil))
+                                                 (read (current-buffer)))
+                                             (end-of-file nil)))
+                                (null (setq unsafep (unsafep form)))))
+                    (or (null unsafep)
+                        (custom-theme-load-confirm hash)))))
+        (let ((custom--inhibit-theme-enable no-enable))
+          (eval-buffer))))))
+
+(defun custom-theme-load-confirm (hash)
+  "Query the user about loading a Custom theme that may not be safe.
+The theme should be in the current buffer.  If the user agrees,
+query also about adding HASH to `custom-safe-themes'."
   (if noninteractive
       nil
-    (let ((existing-buffer (find-buffer-visiting filename))
-          (exit-chars '(?y ?n ?\s ?\C-g))
+    (let ((exit-chars '(?y ?n ?\s))
           prompt char)
       (save-window-excursion
-        (if existing-buffer
-            (pop-to-buffer existing-buffer)
-          (find-file filename))
-        (unwind-protect
-            (progn
-              (setq prompt
-                    (format "This theme is not guaranteed to be safe.  Really load? %s"
-                            (if (< (line-number-at-pos (point-max))
-                                   (window-body-height))
-                                "(y or n) "
-                              (push ?\C-v exit-chars)
-                              "Type y or n, or C-v to scroll: ")))
-              (goto-char (point-min))
-              (while (null char)
-                (setq char (read-char-choice prompt exit-chars t))
-                (when (eq char ?\C-v)
-                  (condition-case nil
-                      (scroll-up)
-                    (error (goto-char (point-min))))
-                  (setq char nil)))
-              (when (memq char '(?\s ?y))
-                (push filename custom-safe-theme-files)
-                ;; Offer to save to `custom-safe-theme-files'.
-                (and (or custom-file user-init-file)
-                     (y-or-n-p "Treat %s as safe for future loads? "
-                               (file-name-nondirectory filename))
-                     (let ((coding-system-for-read nil))
-                       (customize-save-variable
-                        'custom-safe-theme-files
-                        custom-safe-theme-files)))
-                t))
-          ;; Unwind form.
-          (unless existing-buffer (kill-buffer)))))))
+        (rename-buffer "*Custom Theme*" t)
+        (emacs-lisp-mode)
+        (display-buffer (current-buffer))
+        (setq prompt
+              (format "This theme is not guaranteed to be safe.  Really load? %s"
+                      (if (< (line-number-at-pos (point-max))
+                             (window-body-height))
+                          "(y or n) "
+                        (push ?\C-v exit-chars)
+                        "Type y or n, or C-v to scroll: ")))
+        (goto-char (point-min))
+        (while (null char)
+          (setq char (read-char-choice prompt exit-chars))
+          (when (eq char ?\C-v)
+            (condition-case nil
+                (scroll-up)
+              (error (goto-char (point-min))))
+            (setq char nil)))
+        (when (memq char '(?\s ?y))
+          (push hash custom-safe-themes)
+          ;; Offer to save to `custom-safe-themes'.
+          (and (or custom-file user-init-file)
+               (y-or-n-p "Treat this theme as safe for future loads? ")
+               (let ((coding-system-for-read nil))
+                 (customize-save-variable 'custom-safe-themes
+                                          custom-safe-themes)))
+          t)))))
 
 (defun custom-theme-name-valid-p (name)
   "Return t if NAME is a valid name for a Custom theme, nil otherwise.
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index fce3597409c..636f78031fa 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -621,7 +621,8 @@ It's a subdirectory of `doc-view-cache-directory'."
 Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
 OpenDocument format)."
   (and (display-graphic-p)
-       (image-type-available-p 'png)
+       (or (image-type-available-p 'imagemagick)
+           (image-type-available-p 'png))
        (cond
         ((eq type 'dvi)
          (and (doc-view-mode-p 'pdf)
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index a62f8de4010..6484969541f 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -202,6 +202,9 @@ UNSAFEP-VARS is a list of symbols with local bindings."
               (dolist (x (nthcdr 3 form))
                 (setq reason (unsafep-progn (cdr x)))
                 (if reason (throw 'unsafep reason))))))
+       ((eq fun '\`)
+        ;; Backquoted form - safe if its expansion is.
+        (unsafep (cdr (backquote-process (cadr form)))))
        (t
         ;;First unsafep-function call above wasn't nil, no special case applies
         reason)))))
diff --git a/lisp/files.el b/lisp/files.el
index 6ff8af98dc1..1e03ba1920f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -57,7 +57,7 @@ when it has unsaved changes."
 A list of elements of the form (FROM . TO), each meaning to replace
 FROM with TO when it appears in a directory name.  This replacement is
 done when setting up the default directory of a newly visited file.
-*Every* FROM string should start with \"\\\\`\".
+*Every* FROM string ought to start with \"\\\\`\".
 
 FROM and TO should be equivalent names, which refer to the
 same directory.  Do not use `~' in the TO strings;
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index abbddcc49cc..c0c6533d531 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,22 @@
+2011-01-11  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * nnimap.el (nnimap-convert-partial-article): Protect against
+        zero-length body parts.
+
+        * mm-decode.el (mm-preferred-alternative-precedence): Discourage
+        showing empty parts.
+
+        * gnus-int.el (gnus-request-accept-article): Don't try to update marks
+        and stuff if the backend didn't return the article number.  This fixes
+        an Exchange-related nnimap bug.
+
+        * gnus-sum.el (gnus-summary-next-article): Remove hack to reselect
+        group window, because it does the wrong thing when a separate frame
+        displays the group buffer.
+
+        * proto-stream.el (open-protocol-stream): Protect against the low-level
+        transport functions returning nil.
+
 2011-01-07  Daiki Ueno  <ueno@unixuser.org>
 
         * mml2015.el (epg-sub-key-fingerprint): Autoload.
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 71a9aa9e618..b805167149f 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,7 +1,7 @@
 ;;; gnus-int.el --- backend interface functions for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -711,7 +711,9 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
           (if (stringp group) (gnus-group-real-name group) group)
           (cadr gnus-command-method)
           last)))
-    (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
+    (when (and gnus-agent
+               (gnus-agent-method-p gnus-command-method)
+               (cdr result))
       (gnus-agent-regenerate-group group (list (cdr result))))
     result))
 
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9a21a9c7f68..20a1141cc25 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7687,9 +7687,6 @@ If BACKWARD, the previous article is selected instead of the next."
            (if (eq gnus-keep-same-level 'best)
                (gnus-summary-best-group gnus-newsgroup-name)
              (gnus-summary-search-group backward gnus-keep-same-level))))
-      ;; For some reason, the group window gets selected.  We change
-      ;; it back.
-      (select-window (get-buffer-window (current-buffer)))
       ;; Select next unread newsgroup automagically.
       (cond
        ((or (not gnus-auto-select-next)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 216ed6624d9..62755347142 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,7 +1,7 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;;   2007, 2008, 2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -1367,13 +1367,18 @@ Use CMD as the process."
 
 (defun mm-preferred-alternative-precedence (handles)
   "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
-  (let ((seq (nreverse (mapcar #'mm-handle-media-type
-                               handles))))
-    (dolist (disc (reverse mm-discouraged-alternatives))
-      (dolist (elem (copy-sequence seq))
-        (when (string-match disc elem)
-          (setq seq (nconc (delete elem seq) (list elem))))))
-    seq))
+  (setq handles (reverse handles))
+  (dolist (disc (reverse mm-discouraged-alternatives))
+    (dolist (handle (copy-sequence handles))
+      (when (string-match disc (mm-handle-media-type handle))
+        (setq handles (nconc (delete handle handles) (list handle))))))
+  ;; Remove empty parts.
+  (dolist (handle (copy-sequence handles))
+    (unless (with-current-buffer (mm-handle-buffer handle)
+              (goto-char (point-min))
+              (re-search-forward "[^ \t\n]" nil t))
+      (setq handles (nconc (delete handle handles) (list handle)))))
+  (mapcar #'mm-handle-media-type handles))
 
 (defun mm-get-content-id (id)
   "Return the handle(s) referred to by ID."
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 51fa532a371..0c711701e96 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -582,7 +582,7 @@ textual parts.")
     ;; Collect all the body parts.
     (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]")
       (setq id (match-string 1)
-            bytes (nnimap-get-length))
+            bytes (or (nnimap-get-length) 0))
       (beginning-of-line)
       (delete-region (point) (progn (forward-line 1) (point)))
       (push (list id (buffer-substring (point) (+ (point) bytes)))
diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el
index d1266cb5461..546461a67b3 100644
--- a/lisp/gnus/proto-stream.el
+++ b/lisp/gnus/proto-stream.el
@@ -1,6 +1,6 @@
 ;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -101,14 +101,17 @@ command to switch on STARTTLS otherwise."
       (setq type 'network))
      ((eq type 'ssl)
       (setq type 'tls)))
-    (destructuring-bind (stream greeting capabilities)
-        (funcall (intern (format "proto-stream-open-%s" type) obarray)
-                 name buffer host service parameters)
-      (list (and stream
-                 (memq (process-status stream)
-                       '(open run))
-                 stream)
-            greeting capabilities))))
+    (let ((open-result
+           (funcall (intern (format "proto-stream-open-%s" type) obarray)
+                    name buffer host service parameters)))
+      (if (null open-result)
+          (list nil nil nil)
+        (destructuring-bind (stream greeting capabilities) open-result
+          (list (and stream
+                     (memq (process-status stream)
+                           '(open run))
+                     stream)
+                greeting capabilities))))))
 
 (defun proto-stream-open-network-only (name buffer host service parameters)
   (let ((start (with-current-buffer buffer (point)))
diff --git a/lisp/info.el b/lisp/info.el
index ad92914a54d..7391dfad39e 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3777,13 +3777,16 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
     (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map
                                    :vert-only t)
     (define-key-after map [separator-2] menu-bar-separator)
-    (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map)
+    (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map
+                                   :vert-only t)
     (tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map)
     (define-key-after map [separator-3] menu-bar-separator)
     (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map
-                                   :label "Index Search")
-    (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map)
-    (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map)
+                                   :label "Index")
+    (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
+                                   :vert-only t)
+    (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
+                                   :vert-only t)
     map))
 
 (defvar Info-menu-last-node nil)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 7903644029e..ca1a1743231 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -183,7 +183,18 @@ association to the service from D-Bus."
 (defun dbus-unregister-service (bus service)
   "Unregister all objects related to SERVICE from D-Bus BUS.
 BUS is either a Lisp symbol, `:system' or `:session', or a string
-denoting the bus address.  SERVICE must be a known service name."
+denoting the bus address.  SERVICE must be a known service name.
+
+The function returns a keyword, indicating the result of the
+operation.  One of the following keywords is returned:
+
+`:released': Service has become the primary owner of the name.
+
+`:non-existent': Service name does not exist on this bus.
+
+`:not-owner': We are neither the primary owner nor waiting in the
+queue of this service."
+
   (maphash
    (lambda (key value)
      (dolist (elt value)
@@ -193,9 +204,14 @@ denoting the bus address.  SERVICE must be a known service name."
                (puthash key (delete elt value) dbus-registered-objects-table)
              (remhash key dbus-registered-objects-table))))))
    dbus-registered-objects-table)
-  (dbus-call-method
-   bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
-   "ReleaseName" service))
+  (let ((reply (dbus-call-method
+                bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+                "ReleaseName" service)))
+    (case reply
+      (1 :released)
+      (2 :non-existent)
+      (3 :not-owner)
+      (t (signal 'dbus-error (list "Could not unregister service" service))))))
 
 (defun dbus-call-method-non-blocking-handler (&rest args)
   "Handler for reply messages of asynchronous D-Bus message calls.
@@ -914,17 +930,20 @@ clients from discovering the still incomplete interface."
      bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
      "RequestName" service 0))
 
-  ;; Add the handler.  We use `dbus-service-emacs' as service name, in
-  ;; order to let unregister SERVICE despite of this default handler.
+  ;; Add handlers for the three property-related methods.
   (dbus-register-method
-   bus service path dbus-interface-properties "Get" 'dbus-property-handler
-   dont-register-service)
+   bus service path dbus-interface-properties "Get"
+   'dbus-property-handler 'dont-register)
   (dbus-register-method
-   bus service path dbus-interface-properties "GetAll" 'dbus-property-handler
-   dont-register-service)
+   bus service path dbus-interface-properties "GetAll"
+   'dbus-property-handler 'dont-register)
   (dbus-register-method
-   bus service path dbus-interface-properties "Set" 'dbus-property-handler
-   dont-register-service)
+   bus service path dbus-interface-properties "Set"
+   'dbus-property-handler 'dont-register)
+
+  ;; Register the name SERVICE with BUS.
+  (unless dont-register-service
+    (dbus-register-service bus service))
 
   ;; Send the PropertiesChanged signal.
   (when emits-signal
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 066dbd8bea0..88284af06f0 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,7 +1,7 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;;   2007, 2008, 2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
 ;; Maintainer: FSF
@@ -556,13 +556,9 @@ an alist of attribute/value pairs."
       (if (and sizelimit
                (not (equal "" sizelimit)))
           (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
-      (eval `(call-process ldap-ldapsearch-prog
-                           nil
-                           buf
-                           nil
-                           ,@arglist
-                           ,@ldap-ldapsearch-args
-                           ,@filter))
+      (apply #'call-process ldap-ldapsearch-prog
+             nil buf nil
+             (append arglist ldap-ldapsearch-args filter))
       (insert "\n")
       (goto-char (point-min))
 
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 9bf07deeffe..e8531be05f8 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * org-faces.el (org-link): Inherit from link face.
+        Suggested by Joakim Verona.
+
 2010-12-11  Tassilo Horn  <tassilo@member.fsf.org>
 
         * org-footnote.el (org-footnote-create-definition): Place
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 3f8245758f7..d4f458232ce 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -1,6 +1,6 @@
 ;;; org-faces.el --- Face definitions for Org-mode.
 
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -247,9 +247,7 @@ column view defines special faces for each outline level.  See the file
   :group 'org-faces)
 
 (defface org-link
-  '((((class color) (background light)) (:foreground "Purple" :underline t))
-    (((class color) (background dark)) (:foreground "Cyan" :underline t))
-    (t (:underline t)))
+  '((t :inherit link))
   "Face for links."
   :group 'org-faces)
 
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 710b5d0858b..f86dd7e1bec 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1569,9 +1569,11 @@ Returns the compilation buffer created."
 (defvar compilation-mode-tool-bar-map
   ;; When bootstrapping, tool-bar-map is not properly initialized yet,
   ;; so don't do anything.
-  (when (keymapp (butlast tool-bar-map))
-    (let ((map (butlast (copy-keymap tool-bar-map)))
-          (help (last tool-bar-map))) ;; Keep Help last in tool bar
+  (when (keymapp tool-bar-map)
+    (let ((map (copy-keymap tool-bar-map)))
+      (define-key map [undo] nil)
+      (define-key map [separator-2] nil)
+      (define-key-after map [separator-compile] menu-bar-separator)
       (tool-bar-local-item
        "left-arrow" 'previous-error-no-select 'previous-error-no-select map
        :rtl "right-arrow"
@@ -1588,7 +1590,7 @@ Returns the compilation buffer created."
       (tool-bar-local-item
        "refresh" 'recompile 'recompile map
        :help "Restart compilation")
-      (append map help))))
+      map)))
 
 (put 'compilation-mode 'mode-class 'special)
 
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 0674ccf730a..f8121beb231 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1,7 +1,7 @@
 ;;; idlw-help.el --- HTML Help code for IDLWAVE
 
 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2009, 2010  Free Software Foundation, Inc.
+;;   2009, 2010, 2011  Free Software Foundation, Inc.
 ;;
 ;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
 ;;          Carsten Dominik <dominik@science.uva.nl>
@@ -195,8 +195,7 @@ support."
   :type 'string)
 
 (defface idlwave-help-link
-  '((((class color)) (:foreground "Blue"))
-    (t (:weight bold)))
+  '((t :inherit link))
   "Face for highlighting links into IDLWAVE online help."
   :group 'idlwave-online-help)
 
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 822e6d9b6f8..16450ee3b69 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1,10 +1,15 @@
-;;; prolog.el --- major mode for editing and running Prolog under Emacs
+;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code
 
-;; Copyright (C) 1986, 1987, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;;   2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1987, 1997, 1998, 1999, 2002, 2003, 2011 Free Software Foundation, Inc.
 
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: languages
+;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com>
+;;          Milan Zamazal <pdm(at)freesoft(dot)cz>
+;;          Stefan Bruda <stefan(at)bruda(dot)ca>  (current maintainer)
+;;          * See below for more details
+;; Keywords: prolog major mode sicstus swi mercury
+
+(defvar prolog-mode-version "1.22"
+  "Prolog mode version number.")
 
 ;; This file is part of GNU Emacs.
 
@@ -21,409 +26,4020 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
+;; Original author: Masanobu UMEDA <umerin(at)mse(dot)kyutech(dot)ac(dot)jp>
+;; Parts of this file was taken from a modified version of the original
+;; by Johan Andersson, Peter Olin, Mats Carlsson, Johan Bevemyr, Stefan
+;; Andersson, and Per Danielsson (all SICS people), and Henrik Båkman
+;; at Uppsala University, Sweden.
+;;
+;; Some ideas and also a few lines of code have been borrowed (not stolen ;-)
+;; from Oz.el, the Emacs major mode for the Oz programming language,
+;; Copyright (C) 1993 DFKI GmbH, Germany, with permission.
+;; Authors: Ralf Scheidhauer and Michael Mehl ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de)
+;;
+;; More ideas and code have been taken from the SICStus debugger mode
+;; (http://www.csd.uu.se/~perm/source_debug/index.shtml -- broken link
+;; as of Mon May 5 08:23:48 EDT 2003) by Per Mildner.
+;;
+;; Additions for ECLiPSe and other helpful suggestions: Stephan Heuel
+;; <heuel(at)ipb(dot)uni-bonn(dot)de>
+
 ;;; Commentary:
+;;
+;; This package provides a major mode for editing Prolog code, with
+;; all the bells and whistles one would expect, including syntax
+;; highlighting and auto indentation.  It can also send regions to an
+;; inferior Prolog process.
+;;
+;; The code requires the comint, easymenu, info, imenu, and font-lock
+;; libraries.  These are normally distributed with GNU Emacs and
+;; XEmacs.
+
+;;; Installation:
+;;
+;; Insert the following lines in your init file--typically ~/.emacs
+;; (GNU Emacs and XEmacs <21.4), or ~/.xemacs/init.el (XEmacs
+;; 21.4)--to use this mode when editing Prolog files under Emacs:
+;;
+;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path))
+;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t)
+;; (autoload 'prolog-mode "prolog" "Major mode for editing Prolog programs." t)
+;; (autoload 'mercury-mode "prolog" "Major mode for editing Mercury programs." t)
+;; (setq prolog-system 'swi)  ; optional, the system you are using;
+;;                            ; see `prolog-system' below for possible values
+;; (setq auto-mode-alist (append '(("\\.pl$" . prolog-mode)
+;;                                 ("\\.m$" . mercury-mode))
+;;                                auto-mode-alist))
+;;
+;; where the path in the first line is the file system path to this file.
+;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp". 
+;; Note: In XEmacs, either `/usr/lib/xemacs/site-lisp' (RPM default in
+;; Red Hat-based distributions) or `/usr/local/lib/xemacs/site-lisp'
+;; (default when compiling from sources) are automatically added to
+;; `load-path', so the first line is not necessary provided that you
+;; put this file in the appropriate place.
+;;
+;; The last s-expression above makes sure that files ending with .pl
+;; are assumed to be Prolog files and not Perl, which is the default
+;; Emacs setting.  If this is not wanted, remove this line.  It is then
+;; necessary to either
+;;
+;;  o  insert in your Prolog files the following comment as the first line:
+;;
+;;       % -*- Mode: Prolog -*-
+;;
+;;     and then the file will be open in Prolog mode no matter its 
+;;     extension, or
+;;
+;;  o  manually switch to prolog mode after opening a Prolog file, by typing 
+;;     M-x prolog-mode.
+;;
+;; If the command to start the prolog process ('sicstus', 'pl' or
+;; 'swipl' for SWI prolog, etc.) is not available in the default path,
+;; then it is necessary to set the value of the environment variable
+;; EPROLOG to a shell command to invoke the prolog process.  In XEmacs
+;; and Emacs 20+ you can also customize the variable
+;; `prolog-program-name' (in the group `prolog-inferior') and provide
+;; a full path for your Prolog system (swi, scitus, etc.).
+;;
+;; Note: I (Stefan, the current maintainer) work under XEmacs.  Future
+;;   developments will thus be biased towards XEmacs (OK, I admit it,
+;;   I am biased towards XEmacs in general), though I will do my best
+;;   to keep the GNU Emacs compatibility.  So if you work under Emacs
+;;   and see something that does not work do drop me a line, as I have
+;;   a smaller chance to notice this kind of bugs otherwise.
+
+;; Changelog:
 
-;; This package provides a major mode for editing Prolog.  It knows
-;; about Prolog syntax and comments, and can send regions to an inferior
-;; Prolog interpreter process.  Font locking is tuned towards GNU Prolog.
+;; Version 1.22:
+;;  o  Allowed both 'swipl' and 'pl' as names for the SWI Prolog
+;;     interpreter.
+;;  o  Atoms that start a line are not blindly coloured as
+;;     predicates.  Instead we check that they are followed by ( or
+;;     :- first.  Patch suggested by Guy Wiener.
+;; Version 1.21:
+;;  o  Cleaned up the code that defines faces.  The missing face
+;;     warnings on some Emacsen should disappear.
+;; Version 1.20:
+;;  o  Improved the handling of clause start detection and multi-line
+;;     comments: `prolog-clause-start' no longer finds non-predicate
+;;     (e.g., capitalized strings) beginning of clauses.
+;;     `prolog-tokenize' recognizes when the end point is within a
+;;     multi-line comment.
+;; Version 1.19:
+;;  o  Minimal changes for Aquamacs inclusion and in general for
+;;     better coping with finding the Prolog executable.  Patch
+;;     provided by David Reitter 
+;; Version 1.18:
+;;  o  Fixed syntax highlighting for clause heads that do not begin at
+;;     the beginning of the line.
+;;  o  Fixed compilation warnings under Emacs.
+;;  o  Updated the email address of the current maintainer.
+;; Version 1.17:
+;;  o  Minor indentation fix (patch by Markus Triska)
+;;  o  `prolog-underscore-wordchar-flag' defaults now to nil (more
+;;     consistent to other Emacs modes)
+;; Version 1.16:
+;;  o  Eliminated a possible compilation warning.
+;; Version 1.15:
+;;  o  Introduced three new customizable variables: electric colon
+;;     (`prolog-electric-colon-flag', default nil), electric dash
+;;     (`prolog-electric-dash-flag', default nil), and a possibility
+;;     to prevent the predicate template insertion from adding commata
+;;     (`prolog-electric-dot-full-predicate-template', defaults to t
+;;     since it seems quicker to me to just type those commata).  A
+;;     trivial adaptation of a patch by Markus Triska.
+;;  o  Improved the behaviour of electric if-then-else to only skip
+;;     forward if the parenthesis/semicolon is preceded by
+;;     whitespace.  Once more a trivial adaptation of a patch by
+;;     Markus Triska.
+;; Version 1.14:
+;;  o  Cleaned up align code.  `prolog-align-flag' is eliminated (since
+;;     on a second thought it does not do anything useful).  Added key
+;;     binding (C-c C-a) and menu entry for alignment.
+;;  o  Condensed regular expressions for lower and upper case
+;;     characters (GNU Emacs seems to go over the regexp length limit
+;;     with the original form).  My code on the matter was improved
+;;     considerably by Markus Triska.
+;;  o  Fixed `prolog-insert-spaces-after-paren' (which used an
+;;     unitialized variable).
+;;  o  Minor changes to clean up the code and avoid some implicit
+;;     package requirements.
+;; Version 1.13:
+;;  o  Removed the use of `map-char-table' in `prolog-build-case-strings'
+;;     which appears to cause prblems in (at least) Emacs 23.0.0.1.
+;;  o  Added if-then-else indentation + corresponding electric
+;;     characters.  New customization: `prolog-electric-if-then-else-flag'
+;;  o  Align support (requires `align').  New customization:
+;;     `prolog-align-flag'.
+;;  o  Temporary consult files have now the same name throughout the
+;;     session.  This prevents issues with reconsulting a buffer
+;;     (this event is no longer passed to Prolog as a request to
+;;     consult a new file).
+;;  o  Adaptive fill mode is now turned on.  Comment indentation is
+;;     still worse than it could be though, I am working on it.
+;;  o  Improved filling and auto-filling capabilities.  Now block
+;;     comments should be [auto-]filled correctly most of the time;
+;;     the following pattern in particular is worth noting as being
+;;     filled correctly:
+;;         <some code here> % some comment here that goes beyond the
+;;                          % rightmost column, possibly combined with
+;;                          % subsequent comment lines
+;;  o  `prolog-char-quote-workaround' now defaults to nil.
+;;  o  Note: Many of the above improvements have been suggested by
+;;     Markus Triska, who also provided useful patches on the matter
+;;     when he realized that I was slow in responding.  Many thanks.
+;; Version 1.11 / 1.12
+;;  o  GNU Emacs compatibility fix for paragraph filling (fixed
+;;     incorrectly in 1.11, fix fixed in 1.12).
+;; Version 1.10
+;;  o  Added paragraph filling in comment blocks and also correct auto
+;;     filling for comments.
+;;  o  Fixed the possible "Regular expression too big" error in
+;;     `prolog-electric-dot'.
+;; Version 1.9
+;;  o  Parenthesis expressions are now indented by default so that
+;;     components go one underneath the other, just as for compound
+;;     terms.  You can use the old style (the second and subsequent
+;;     lines being indented to the right in a parenthesis expression)
+;;     by setting the customizable variable `prolog-paren-indent-p'
+;;     (group "Prolog Indentation") to t.
+;;  o  (Somehow awkward) handling of the 0' character escape
+;;     sequence.  I am looking into a better way of doing it but
+;;     prospects look bleak.  If this breaks things for you please let
+;;     me know and also set the `prolog-char-quote-workaround' (group
+;;     "Prolog Other") to nil.
+;; Version 1.8
+;;  o  Key binding fix.
+;; Version 1.7
+;;  o  Fixed a number of issues with the syntax of single quotes,
+;;     including Debian bug #324520.
+;; Version 1.6
+;;  o  Fixed mercury mode menu initialization (Debian bug #226121).
+;;  o  Fixed (i.e., eliminated) Delete remapping (Debian bug #229636).
+;;  o  Corrected indentation for clauses defining quoted atoms.
+;; Version 1.5:
+;;  o  Keywords fontifying should work in console mode so this is
+;;     enabled everywhere.
+;; Version 1.4:
+;;  o  Now supports GNU Prolog--minor adaptation of a patch by Stefan
+;;     Moeding.
+;; Version 1.3:
+;;  o  Info-follow-nearest-node now called correctly under Emacs too
+;;     (thanks to Nicolas Pelletier).  Should be implemented more
+;;     elegantly (i.e., without compilation warnings) in the future.
+;; Version 1.2:
+;;  o  Another prompt fix, still in SWI mode (people seem to have
+;;     changed the prompt of SWI Prolog).
+;; Version 1.1:
+;;  o  Fixed dots in the end of line comments causing indentation
+;;     problems.  The following code is now correctly indented (note
+;;     the dot terminating the comment):
+;;        a(X) :- b(X),                   
+;;            c(X).                  % comment here.
+;;        a(X).
+;;     and so is this (and variants):
+;;        a(X) :- b(X),                   
+;;            c(X).                  /* comment here.  */
+;;        a(X).
+;; Version 1.0:
+;;  o  Revamped the menu system.
+;;  o  Yet another prompt recognition fix (SWI mode).
+;;  o  This is more of a renumbering than a new edition.  I promoted
+;;     the mode to version 1.0 to emphasize the fact that it is now
+;;     mature and stable enough to be considered production (in my
+;;     opinion anyway).
+;; Version 0.1.41:
+;;  o  GNU Emacs compatibility fixes.
+;; Version 0.1.40:
+;;  o  prolog-get-predspec is now suitable to be called as
+;;     imenu-extract-index-name-function.  The predicate index works.
+;;  o  Since imenu works now as advertised, prolog-imenu-flag is t
+;;     by default.
+;;  o  Eliminated prolog-create-predicate-index since the imenu
+;;     utilities now work well.  Actually, this function is also
+;;     buggy, and I see no reason to fix it since we do not need it
+;;     anyway.
+;;  o  Fixed prolog-pred-start, prolog-clause-start, prolog-clause-info.
+;;  o  Fix for prolog-build-case-strings; now prolog-upper-case-string
+;;     and prolog-lower-case-string are correctly initialized, 
+;;  o  Various font-lock changes; most importantly, block comments (/*
+;;     ... */) are now correctly fontified in XEmacs even when they
+;;     extend on multiple lines.
+;; Version 0.1.36: 
+;;  o  The debug prompt of SWI Prolog is now correctly recognized.
+;; Version 0.1.35: 
+;;  o  Minor font-lock bug fixes.
 
+
 ;;; Code:
 
-(defvar comint-prompt-regexp)
-(defvar comint-process-echoes)
-(require 'smie)
+(eval-when-compile
+  (require 'compile)
+  (require 'font-lock)
+  ;; We need imenu everywhere because of the predicate index!
+  (require 'imenu)
+  ;)
+  (require 'info)
+  (require 'shell)
+  )
+
+(require 'comint)
+(require 'easymenu)
+(require 'align)
+
 
 (defgroup prolog nil
-  "Major mode for editing and running Prolog under Emacs."
-  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
+  "Major modes for editing and running Prolog and Mercury files."
   :group 'languages)
 
+(defgroup prolog-faces nil
+  "Prolog mode specific faces."
+  :group 'font-lock)
 
-(defcustom prolog-program-name
-  (let ((names '("prolog" "gprolog" "swipl")))
-    (while (and names
-                (not (executable-find (car names))))
-      (setq names (cdr names)))
-    (or (car names) "prolog"))
-  "Program name for invoking an inferior Prolog with `run-prolog'."
-  :type 'string
+(defgroup prolog-indentation nil
+  "Prolog mode indentation configuration."
   :group 'prolog)
 
-(defcustom prolog-consult-string "reconsult(user).\n"
-  "(Re)Consult mode (for C-Prolog and Quintus Prolog). "
-  :type 'string
+(defgroup prolog-font-lock nil
+  "Prolog mode font locking patterns."
   :group 'prolog)
 
-(defcustom prolog-compile-string "compile(user).\n"
-  "Compile mode (for Quintus Prolog)."
-  :type 'string
+(defgroup prolog-keyboard nil
+  "Prolog mode keyboard flags."
   :group 'prolog)
 
-(defcustom prolog-eof-string "end_of_file.\n"
-  "String that represents end of file for Prolog.
-When nil, send actual operating system end of file."
-  :type 'string
+(defgroup prolog-inferior nil
+  "Inferior Prolog mode options."
   :group 'prolog)
 
-(defcustom prolog-indent-width 4
-  "Level of indentation in Prolog buffers."
-  :type 'integer
+(defgroup prolog-other nil
+  "Other Prolog mode options."
+  :group 'prolog)
+
+
+;;-------------------------------------------------------------------
+;; User configurable variables
+;;-------------------------------------------------------------------
+
+;; General configuration
+
+(defcustom prolog-system nil
+  "*Prolog interpreter/compiler used.
+The value of this variable is nil or a symbol.
+If it is a symbol, it determines default values of other configuration
+variables with respect to properties of the specified Prolog
+interpreter/compiler.
+
+Currently recognized symbol values are:
+eclipse - Eclipse Prolog
+mercury - Mercury
+sicstus - SICStus Prolog
+swi     - SWI Prolog
+gnu     - GNU Prolog"
+  :group 'prolog
+  :type '(choice (const :tag "SICStus" :value sicstus)
+                 (const :tag "SWI Prolog" :value swi)
+                 (const :tag "Default" :value nil)))
+(make-variable-buffer-local 'prolog-system)
+
+;; NB: This alist can not be processed in prolog-mode-variables to
+;; create a prolog-system-version-i variable since it is needed
+;; prior to the call to prolog-mode-variables.
+(defcustom prolog-system-version
+  '((sicstus  (3 . 6))
+    (swi      (0 . 0))
+    (mercury  (0 . 0))
+    (eclipse  (3 . 7))
+    (gnu      (0 . 0)))
+  "*Alist of Prolog system versions.
+The version numbers are of the format (Major . Minor)."
   :group 'prolog)
 
-(defvar prolog-font-lock-keywords
-  '(("\\(#[<=]=>\\|:-\\)\\|\\(#=\\)\\|\\(#[#<>\\/][=\\/]*\\|!\\)"
-     0 font-lock-keyword-face)
-    ("\\<\\(is\\|write\\|nl\\|read_\\sw+\\)\\>"
-     1 font-lock-keyword-face)
-    ("^\\(\\sw+\\)\\s-*\\((\\(.+\\))\\)*"
-     (1 font-lock-function-name-face)
-     (3 font-lock-variable-name-face)))
-  "Font-lock keywords for Prolog mode.")
+;; Indentation
+
+(defcustom prolog-indent-width 4
+  "*The indentation width used by the editing buffer."
+  :group 'prolog-indentation
+  :type 'integer)  
+
+(defcustom prolog-align-comments-flag t
+  "*Non-nil means automatically align comments when indenting."
+  :group 'prolog-indentation
+  :type 'boolean)
+
+(defcustom prolog-indent-mline-comments-flag t
+  "*Non-nil means indent contents of /* */ comments.
+Otherwise leave such lines as they are."
+  :group 'prolog-indentation
+  :type 'boolean)
+
+(defcustom prolog-object-end-to-0-flag t
+  "*Non-nil means indent closing '}' in SICStus object definitions to level 0.
+Otherwise indent to `prolog-indent-width'."
+  :group 'prolog-indentation
+  :type 'boolean)
+
+(defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)"
+  "*Regexp for character sequences after which next line is indented.
+Next line after such a regexp is indented to the opening paranthesis level."
+  :group 'prolog-indentation
+  :type 'regexp)
+
+(defcustom prolog-paren-indent-p nil
+  "*If non-nil, increase indentation for parenthesis expressions.
+The second and subsequent line in a parenthesis expression other than
+a compound term can either be indented `prolog-paren-indent' to the
+right (if this variable is non-nil) or in the same way as for compound
+terms (if this variable is nil, default)."
+  :group 'prolog-indentation
+  :type 'boolean)
+
+(defcustom prolog-paren-indent 4
+  "*The indentation increase for parenthesis expressions.
+Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+  :group 'prolog-indentation
+  :type 'integer)
+
+(defcustom prolog-parse-mode 'beg-of-clause
+  "*The parse mode used (decides from which point parsing is done).
+Legal values:
+'beg-of-line   - starts parsing at the beginning of a line, unless the
+                 previous line ends with a backslash.  Fast, but has
+                 problems detecting multiline /* */ comments.
+'beg-of-clause - starts parsing at the beginning of the current clause.
+                 Slow, but copes better with /* */ comments."
+  :group 'prolog-indentation
+  :type '(choice (const :value beg-of-line)
+                 (const :value beg-of-clause)))
+
+;; Font locking
+
+(defcustom prolog-keywords
+  '((eclipse
+     ("use_module" "begin_module" "module_interface" "dynamic"
+      "external" "export" "dbgcomp" "nodbgcomp" "compile"))
+    (mercury
+     ("all" "else" "end_module" "equality" "external" "fail" "func" "if"
+      "implementation" "import_module" "include_module" "inst" "instance"
+      "interface" "mode" "module" "not" "pragma" "pred" "some" "then" "true"
+      "type" "typeclass" "use_module" "where"))
+    (sicstus
+     ("block" "dynamic" "mode" "module" "multifile" "meta_predicate"
+      "parallel" "public" "sequential" "volatile"))
+    (swi
+     ("discontiguous" "dynamic" "ensure_loaded" "export" "export_list" "import"
+      "meta_predicate" "module" "module_transparent" "multifile" "require"
+      "use_module" "volatile"))
+    (gnu
+     ("built_in" "char_conversion" "discontiguous" "dynamic" "ensure_linked"
+      "ensure_loaded" "foreign" "include" "initialization" "multifile" "op"
+      "public" "set_prolog_flag"))
+    (t
+     ("dynamic" "module")))
+  "*Alist of Prolog keywords which is used for font locking of directives."
+  :group 'prolog-font-lock
+  :type 'sexp)
+
+(defcustom prolog-types
+  '((mercury
+     ("char" "float" "int" "io__state" "string" "univ"))
+    (t nil))
+  "*Alist of Prolog types used by font locking."
+  :group 'prolog-font-lock
+  :type 'sexp)
+
+(defcustom prolog-mode-specificators
+  '((mercury
+     ("bound" "di" "free" "ground" "in" "mdi" "mui" "muo" "out" "ui" "uo"))
+    (t nil))
+  "*Alist of Prolog mode specificators used by font locking."
+  :group 'prolog-font-lock
+  :type 'sexp)
+
+(defcustom prolog-determinism-specificators
+  '((mercury
+     ("cc_multi" "cc_nondet" "det" "erroneous" "failure" "multi" "nondet"
+      "semidet"))
+    (t nil))
+  "*Alist of Prolog determinism specificators used by font locking."
+  :group 'prolog-font-lock
+  :type 'sexp)
+
+(defcustom prolog-directives
+  '((mercury
+     ("^#[0-9]+"))
+    (t nil))
+  "*Alist of Prolog source code directives used by font locking."
+  :group 'prolog-font-lock
+  :type 'sexp)
+
+
+;; Keyboard
+
+(defcustom prolog-electric-newline-flag (not (fboundp 'electric-indent-mode))
+  "*Non-nil means automatically indent the next line when the user types RET."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-hungry-delete-key-flag nil
+  "*Non-nil means delete key consumes all preceding spaces."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-dot-flag nil
+  "*Non-nil means make dot key electric.
+Electric dot appends newline or inserts head of a new clause.
+If dot is pressed at the end of a line where at least one white space
+precedes the point, it inserts a recursive call to the current predicate.
+If dot is pressed at the beginning of an empty line, it inserts the head
+of a new clause for the current predicate.  It does not apply in strings
+and comments. 
+It does not apply in strings and comments."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-dot-full-predicate-template nil
+  "*If nil, electric dot inserts only the current predicate's name and `(' 
+for recursive calls or new clause heads.  Non-nil means to also 
+insert enough commata to cover the predicate's arity and `)', 
+and dot and newline for recursive calls."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-underscore-flag nil
+  "*Non-nil means make underscore key electric.
+Electric underscore replaces the current variable with underscore.
+If underscore is pressed not on a variable then it behaves as usual."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-tab-flag nil
+  "*Non-nil means make TAB key electric.
+Electric TAB inserts spaces after parentheses, ->, and ;
+in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-if-then-else-flag nil
+  "*Non-nil makes `(', `>' and `;' electric
+to automatically indent if-then-else constructs."
+  :group 'prolog-keyboard
+  :type 'boolean)
+ 
+(defcustom prolog-electric-colon-flag nil
+  "*Makes `:' electric (inserts `:-' on a new line).
+If non-nil, pressing `:' at the end of a line that starts in 
+the first column (i.e., clause heads) inserts ` :-' and newline."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-electric-dash-flag nil
+  "*Makes `-' electric (inserts a `-->' on a new line).
+If non-nil, pressing `-' at the end of a line that starts in
+the first column (i.e., DCG heads) inserts ` -->' and newline."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+(defcustom prolog-old-sicstus-keys-flag nil
+  "*Non-nil means old SICStus Prolog mode keybindings are used."
+  :group 'prolog-keyboard
+  :type 'boolean)
+
+;; Inferior mode
+
+(defcustom prolog-program-name
+  `(((getenv "EPROLOG") (eval (getenv "EPROLOG")))
+    (eclipse "eclipse")
+    (mercury nil)
+    (sicstus "sicstus")
+    (swi ,(if (not (executable-find "swipl")) "pl" "swipl"))
+    (gnu "gprolog")
+    (t ,(let ((names '("prolog" "gprolog" "swipl" "pl")))
+          (while (and names
+                      (not (executable-find (car names))))
+            (setq names (cdr names)))
+          (or (car names) "prolog"))))
+  "*Alist of program names for invoking an inferior Prolog with `run-prolog'."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-program-switches
+  '((sicstus ("-i"))
+    (t nil))
+  "*Alist of switches given to inferior Prolog run with `run-prolog'."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-consult-string
+  '((eclipse "[%f].")
+    (mercury nil)
+    (sicstus (eval (if (prolog-atleast-version '(3 . 7))
+                       "prolog:zap_file(%m,%b,consult,%l)."
+                     "prolog:zap_file(%m,%b,consult).")))
+    (swi "[%f].")
+    (gnu     "[%f].")
+    (t "reconsult(%f)."))
+  "*Alist of strings defining predicate for reconsulting.
+
+Some parts of the string are replaced:
+`%f' by the name of the consulted file (can be a temporary file)
+`%b' by the file name of the buffer to consult
+`%m' by the module name and name of the consulted file separated by colon
+`%l' by the line offset into the file.  This is 0 unless consulting a
+     region of a buffer, in which case it is the number of lines before
+     the region."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-compile-string
+  '((eclipse "[%f].")
+    (mercury "mmake ")
+    (sicstus (eval (if (prolog-atleast-version '(3 . 7))
+                       "prolog:zap_file(%m,%b,compile,%l)."
+                     "prolog:zap_file(%m,%b,compile).")))
+    (swi "[%f].")
+    (t "compile(%f)."))
+  "*Alist of strings and lists defining predicate for recompilation.
+
+Some parts of the string are replaced:
+`%f' by the name of the compiled file (can be a temporary file)
+`%b' by the file name of the buffer to compile
+`%m' by the module name and name of the compiled file separated by colon
+`%l' by the line offset into the file.  This is 0 unless compiling a
+     region of a buffer, in which case it is the number of lines before
+     the region.
+
+If `prolog-program-name' is non-nil, it is a string sent to a Prolog process.
+If `prolog-program-name' is nil, it is an argument to the `compile' function."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-eof-string "end_of_file.\n"
+  "*Alist of strings that represent end of file for prolog.
+nil means send actual operating system end of file."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-prompt-regexp
+  '((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:")
+    (sicstus "| [ ?][- ] *")
+    (swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
+    (t "^ *\\?-"))
+  "*Alist of prompts of the prolog system command line."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-continued-prompt-regexp
+  '((sicstus "^\\(| +\\|     +\\)")
+    (t "^|: +"))
+  "*Alist of regexps matching the prompt when consulting `user'."
+  :group 'prolog-inferior
+  :type 'sexp)
+
+(defcustom prolog-debug-on-string "debug.\n"
+  "*Predicate for enabling debug mode."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-debug-off-string "nodebug.\n"
+  "*Predicate for disabling debug mode."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-trace-on-string "trace.\n"
+  "*Predicate for enabling tracing."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-trace-off-string "notrace.\n"
+  "*Predicate for disabling tracing."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-zip-on-string "zip.\n"
+  "*Predicate for enabling zip mode for SICStus."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-zip-off-string "nozip.\n"
+  "*Predicate for disabling zip mode for SICStus."
+  :group 'prolog-inferior
+  :type 'string)
+
+(defcustom prolog-use-standard-consult-compile-method-flag t
+  "*Non-nil means use the standard compilation method.
+Otherwise the new compilation method will be used.  This
+utilises a special compilation buffer with the associated
+features such as parsing of error messages and automatically
+jumping to the source code responsible for the error.
+
+Warning: the new method is so far only experimental and
+does contain bugs.  The recommended setting for the novice user
+is non-nil for this variable."
+  :group 'prolog-inferior
+  :type 'boolean)
+
+
+;; Miscellaneous
+
+(defcustom prolog-use-prolog-tokenizer-flag t
+  "*Non-nil means use the internal prolog tokenizer for indentation etc.
+Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect."
+  :group 'prolog-other
+  :type 'boolean)
+
+(defcustom prolog-imenu-flag t
+  "*Non-nil means add a clause index menu for all prolog files."
+  :group 'prolog-other
+  :type 'boolean)
+
+(defcustom prolog-imenu-max-lines 3000
+  "*The maximum number of lines of the file for imenu to be enabled.
+Relevant only when `prolog-imenu-flag' is non-nil."
+  :group 'prolog-other
+  :type 'integer)
+
+(defcustom prolog-info-predicate-index
+  "(sicstus)Predicate Index"
+  "*The info node for the SICStus predicate index."
+  :group 'prolog-other
+  :type 'string)
+
+(defcustom prolog-underscore-wordchar-flag nil
+  "*Non-nil means underscore (_) is a word-constituent character."
+  :group 'prolog-other
+  :type 'boolean)
+
+(defcustom prolog-use-sicstus-sd nil
+  "*If non-nil, use the source level debugger of SICStus 3#7 and later."
+  :group 'prolog-other
+  :type 'boolean)
+
+(defcustom prolog-char-quote-workaround nil
+  ;; FIXME: Use syntax-propertize-function to fix it right.
+  "*If non-nil, declare 0 as a quote character so that 0'<char> does not break syntax highlighting.
+This is really kludgy but I have not found any better way of handling it."
+  :group 'prolog-other
+  :type 'boolean)
+
+
+;;-------------------------------------------------------------------
+;; Internal variables
+;;-------------------------------------------------------------------
+
+;;(defvar prolog-temp-filename "")   ; Later set by `prolog-temporary-file'
 
 (defvar prolog-mode-syntax-table
   (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?_ "w" table)
-    (modify-syntax-entry ?\\ "\\" table)
-    (modify-syntax-entry ?/ ". 14" table)
-    (modify-syntax-entry ?* ". 23" table)
+    (if prolog-underscore-wordchar-flag
+        (modify-syntax-entry ?_ "w" table)
+      (modify-syntax-entry ?_ "_" table))
+
     (modify-syntax-entry ?+ "." table)
     (modify-syntax-entry ?- "." table)
     (modify-syntax-entry ?= "." table)
-    (modify-syntax-entry ?% "<" table)
-    (modify-syntax-entry ?\n ">" table)
     (modify-syntax-entry ?< "." table)
     (modify-syntax-entry ?> "." table)
+    (modify-syntax-entry ?| "." table)
     (modify-syntax-entry ?\' "\"" table)
-    table))
 
+    ;; Any better way to handle the 0'<char> construct?!?
+    (when prolog-char-quote-workaround
+      (modify-syntax-entry ?0 "\\" table))
+
+    (modify-syntax-entry ?% "<" table)
+    (modify-syntax-entry ?\n ">" table)
+    (if (featurep 'xemacs)
+        (progn
+          (modify-syntax-entry ?* ". 67" table)
+          (modify-syntax-entry ?/ ". 58" table)
+          )
+      ;; Emacs wants to see this it seems:
+      (modify-syntax-entry ?* ". 23b" table)
+      (modify-syntax-entry ?/ ". 14" table)
+      )
+    table))
 (defvar prolog-mode-abbrev-table nil)
+(defvar prolog-upper-case-string ""
+  "A string containing all upper case characters.
+Set by prolog-build-case-strings.")
+(defvar prolog-lower-case-string ""
+  "A string containing all lower case characters.
+Set by prolog-build-case-strings.")
+  
+(defvar prolog-atom-char-regexp ""
+  "Set by prolog-set-atom-regexps.")
+;; "Regexp specifying characters which constitute atoms without quoting.")
+(defvar prolog-atom-regexp ""
+  "Set by prolog-set-atom-regexps.")
+
+(defconst prolog-left-paren "[[({]" 
+  "The characters used as left parentheses for the indentation code.")
+(defconst prolog-right-paren "[])}]"
+  "The characters used as right parentheses for the indentation code.")
+
+(defconst prolog-quoted-atom-regexp
+  "\\(^\\|[^0-9]\\)\\('\\([^\n']\\|\\\\'\\)*'\\)"
+  "Regexp matching a quoted atom.")
+(defconst prolog-string-regexp
+  "\\(\"\\([^\n\"]\\|\\\\\"\\)*\"\\)"
+  "Regexp matching a string.")
+(defconst prolog-head-delimiter "\\(:-\\|\\+:\\|-:\\|\\+\\?\\|-\\?\\|-->\\)"
+  "A regexp for matching on the end delimiter of a head (e.g. \":-\").")
+
+(defvar prolog-compilation-buffer "*prolog-compilation*"
+  "Name of the output buffer for Prolog compilation/consulting.")
+
+(defvar prolog-temporary-file-name nil)
+(defvar prolog-keywords-i nil)
+(defvar prolog-types-i nil)
+(defvar prolog-mode-specificators-i nil)
+(defvar prolog-determinism-specificators-i nil)
+(defvar prolog-directives-i nil)
+(defvar prolog-program-name-i nil)
+(defvar prolog-program-switches-i nil)
+(defvar prolog-consult-string-i nil)
+(defvar prolog-compile-string-i nil)
+(defvar prolog-eof-string-i nil)
+(defvar prolog-prompt-regexp-i nil)
+(defvar prolog-continued-prompt-regexp-i nil)
+(defvar prolog-help-function-i nil)
+
+(defvar prolog-align-rules
+  (eval-when-compile
+    (mapcar
+     (lambda (x)
+       (let ((name (car x))
+             (sym  (cdr x)))
+         `(,(intern (format "prolog-%s" name))
+           (regexp . ,(format "\\(\\s-*\\)%s\\(\\s-*\\)" sym))
+           (tab-stop . nil)
+           (modes . '(prolog-mode))
+           (group . (1 2)))))
+     '(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>")
+       ("propagation" . "==>")))))
+
+
+
+;;-------------------------------------------------------------------
+;; Prolog mode
+;;-------------------------------------------------------------------
+
+;; Example: (prolog-atleast-version '(3 . 6))
+(defun prolog-atleast-version (version)
+  "Return t if the version of the current prolog system is VERSION or later.
+VERSION is of the format (Major . Minor)"
+  ;; Version.major < major or
+  ;; Version.major = major and Version.minor <= minor
+  (let* ((thisversion (prolog-find-value-by-system prolog-system-version))
+         (thismajor (car thisversion))
+         (thisminor (cdr thisversion)))
+    (or (< (car version) thismajor)
+        (and (= (car version) thismajor)
+             (<= (cdr version) thisminor)))
+    ))
+
 (define-abbrev-table 'prolog-mode-abbrev-table ())
 
-(defun prolog-smie-forward-token ()
-  (forward-comment (point-max))
-  (buffer-substring-no-properties
-   (point)
-   (progn (cond
-           ((looking-at "[!;]") (forward-char 1))
-           ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
-           ((not (zerop (skip-syntax-forward "w_'"))))
-           ;; In case of non-ASCII punctuation.
-           ((not (zerop (skip-syntax-forward ".")))))
-          (point))))
-
-(defun prolog-smie-backward-token ()
-  (forward-comment (- (point-max)))
-  (buffer-substring-no-properties
-   (point)
-   (progn (cond
-           ((memq (char-before) '(?! ?\;)) (forward-char -1))
-           ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
-           ((not (zerop (skip-syntax-backward "w_'"))))
-           ;; In case of non-ASCII punctuation.
-           ((not (zerop (skip-syntax-backward ".")))))
-          (point))))
-
-(defconst prolog-smie-grammar
-  ;; Rather than construct the operator levels table from the BNF,
-  ;; we directly provide the operator precedences from GNU Prolog's
-  ;; manual (7.14.10 op/3).  The only problem is that GNU Prolog's
-  ;; manual uses precedence levels in the opposite sense (higher
-  ;; numbers bind less tightly) than SMIE, so we use negative numbers.
-  '(("." -10000 -10000)
-    (":-" -1200 -1200)
-    ("-->" -1200 -1200)
-    (";" -1100 -1100)
-    ("->" -1050 -1050)
-    ("," -1000 -1000)
-    ("\\+" -900 -900)
-    ("=" -700 -700)
-    ("\\=" -700 -700)
-    ("=.." -700 -700)
-    ("==" -700 -700)
-    ("\\==" -700 -700)
-    ("@<" -700 -700)
-    ("@=<" -700 -700)
-    ("@>" -700 -700)
-    ("@>=" -700 -700)
-    ("is" -700 -700)
-    ("=:=" -700 -700)
-    ("=\\=" -700 -700)
-    ("<" -700 -700)
-    ("=<" -700 -700)
-    (">" -700 -700)
-    (">=" -700 -700)
-    (":" -600 -600)
-    ("+" -500 -500)
-    ("-" -500 -500)
-    ("/\\" -500 -500)
-    ("\\/" -500 -500)
-    ("*" -400 -400)
-    ("/" -400 -400)
-    ("//" -400 -400)
-    ("rem" -400 -400)
-    ("mod" -400 -400)
-    ("<<" -400 -400)
-    (">>" -400 -400)
-    ("**" -200 -200)
-    ("^" -200 -200)
-    ;; Prefix
-    ;; ("+" 200 200)
-    ;; ("-" 200 200)
-    ;; ("\\" 200 200)
-    )
-  "Precedence levels of infix operators.")
-
-(defun prolog-smie-rules (kind token)
-  (pcase (cons kind token)
-    (`(:elem . basic) prolog-indent-width)
-    (`(:after . ".") 0) ;; To work around smie-closer-alist.
-    (`(:after . ,(or `":-" `"->")) prolog-indent-width)))
+(defun prolog-find-value-by-system (alist)
+  "Get value from ALIST according to `prolog-system'."
+  (if (listp alist)
+      (let (result
+            id)
+        (while alist
+          (setq id (car (car alist)))
+          (if (or (eq id prolog-system)
+                  (eq id t)
+                  (and (listp id)
+                       (eval id)))
+              (progn
+                (setq result (car (cdr (car alist))))
+                (if (and (listp result)
+                         (eq (car result) 'eval))
+                    (setq result (eval (car (cdr result)))))
+                (setq alist nil))
+            (setq alist (cdr alist))))
+        result)
+    alist))
 
 (defun prolog-mode-variables ()
-  (set (make-local-variable 'paragraph-separate) (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
-  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
-  (set (make-local-variable 'imenu-generic-expression) '((nil "^\\sw+" 0)))
-
-  ;; Setup SMIE.
-  (smie-setup prolog-smie-grammar #'prolog-smie-rules
-              :forward-token #'prolog-smie-forward-token
-              :backward-token #'prolog-smie-backward-token)
-  (set (make-local-variable 'smie-blink-matching-triggers) '(?.))
-  (set (make-local-variable 'smie-closer-alist) '((t . ".")))
-  (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
-  ;; There's no real closer in Prolog anyway.
-  (set (make-local-variable 'smie-blink-matching-inners) t)
-
-  (set (make-local-variable 'comment-start) "%")
-  (set (make-local-variable 'comment-start-skip) "\\(?:%+\\|/\\*+\\)[ \t]*")
-  (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\n\\|\\*+/\\)")
-  (set (make-local-variable 'comment-column) 48))
+  "Set some common variables to Prolog code specific values."
+  (setq local-abbrev-table prolog-mode-abbrev-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+  (make-local-variable 'normal-auto-fill-function)
+  (setq normal-auto-fill-function 'prolog-do-auto-fill)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'prolog-indent-line)
+  (make-local-variable 'comment-start)
+  (setq comment-start "%")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-start-skip)
+  ;; This complex regexp makes sure that comments cannot start
+  ;; inside quoted atoms or strings
+  (setq comment-start-skip 
+        (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" 
+                prolog-quoted-atom-regexp prolog-string-regexp))
+  (make-local-variable 'comment-column)
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'prolog-comment-indent)
+  (make-local-variable 'parens-require-spaces)
+  (setq parens-require-spaces nil)
+  ;; Initialize Prolog system specific variables
+  (let ((vars '(prolog-keywords prolog-types prolog-mode-specificators
+                prolog-determinism-specificators prolog-directives
+                prolog-program-name prolog-program-switches
+                prolog-consult-string prolog-compile-string prolog-eof-string
+                prolog-prompt-regexp prolog-continued-prompt-regexp
+                prolog-help-function)))
+    (while vars
+      (set (intern (concat (symbol-name (car vars)) "-i"))
+           (prolog-find-value-by-system (symbol-value (car vars))))
+      (setq vars (cdr vars))))
+  (when (null prolog-program-name-i)
+        (make-local-variable 'compile-command)
+        (setq compile-command prolog-compile-string-i))
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults
+        '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
+)
+
+(defun prolog-mode-keybindings-common (map)
+  "Define keybindings common to both Prolog modes in MAP."
+  (define-key map "\C-c?" 'prolog-help-on-predicate)
+  (define-key map "\C-c/" 'prolog-help-apropos)
+  (define-key map "\C-c\C-d" 'prolog-debug-on)
+  (define-key map "\C-c\C-t" 'prolog-trace-on)
+  (if (and (eq prolog-system 'sicstus)
+           (prolog-atleast-version '(3 . 7)))
+      (define-key map "\C-c\C-z" 'prolog-zip-on))
+  (define-key map "\C-c\r" 'run-prolog))
+
+(defun prolog-mode-keybindings-edit (map)
+  "Define keybindings for Prolog mode in MAP."
+  (define-key map "\M-a" 'prolog-beginning-of-clause)
+  (define-key map "\M-e" 'prolog-end-of-clause)
+  (define-key map "\M-q" 'prolog-fill-paragraph)
+  (define-key map "\C-c\C-a" 'align)
+  (define-key map "\C-\M-a" 'prolog-beginning-of-predicate)
+  (define-key map "\C-\M-e" 'prolog-end-of-predicate)
+  (define-key map "\M-\C-c" 'prolog-mark-clause)
+  (define-key map "\M-\C-h" 'prolog-mark-predicate)
+  (define-key map "\M-\C-n" 'prolog-forward-list)
+  (define-key map "\M-\C-p" 'prolog-backward-list)
+  (define-key map "\C-c\C-n" 'prolog-insert-predicate-template)
+  (define-key map "\C-c\C-s" 'prolog-insert-predspec)
+  (define-key map "\M-\r" 'prolog-insert-next-clause)
+  (define-key map "\C-c\C-va" 'prolog-variables-to-anonymous)
+  (define-key map "\C-c\C-v\C-s" 'prolog-view-predspec)
+
+  (define-key map [Backspace] 'prolog-electric-delete)
+  (define-key map "." 'prolog-electric-dot)
+  (define-key map "_" 'prolog-electric-underscore)
+  (define-key map "(" 'prolog-electric-if-then-else)
+  (define-key map ";" 'prolog-electric-if-then-else)
+  (define-key map ">" 'prolog-electric-if-then-else)
+  (define-key map ":" 'prolog-electric-colon)
+  (define-key map "-" 'prolog-electric-dash)
+  (if prolog-electric-newline-flag 
+      (define-key map "\r" 'newline-and-indent))
+
+  ;; If we're running SICStus, then map C-c C-c e/d to enabling
+  ;; and disabling of the source-level debugging facilities.
+  ;(if (and (eq prolog-system 'sicstus)
+  ;         (prolog-atleast-version '(3 . 7)))
+  ;    (progn
+  ;      (define-key map "\C-c\C-ce" 'prolog-enable-sicstus-sd)
+  ;      (define-key map "\C-c\C-cd" 'prolog-disable-sicstus-sd)
+  ;      ))
+
+  (if prolog-old-sicstus-keys-flag
+      (progn
+        (define-key map "\C-c\C-c" 'prolog-consult-predicate)
+        (define-key map "\C-cc" 'prolog-consult-region)
+        (define-key map "\C-cC" 'prolog-consult-buffer)
+        (define-key map "\C-c\C-k" 'prolog-compile-predicate)
+        (define-key map "\C-ck" 'prolog-compile-region)
+        (define-key map "\C-cK" 'prolog-compile-buffer))
+    (define-key map "\C-c\C-p" 'prolog-consult-predicate)
+    (define-key map "\C-c\C-r" 'prolog-consult-region)
+    (define-key map "\C-c\C-b" 'prolog-consult-buffer)
+    (define-key map "\C-c\C-f" 'prolog-consult-file)
+    (define-key map "\C-c\C-cp" 'prolog-compile-predicate)
+    (define-key map "\C-c\C-cr" 'prolog-compile-region)
+    (define-key map "\C-c\C-cb" 'prolog-compile-buffer)
+    (define-key map "\C-c\C-cf" 'prolog-compile-file))
+  
+  ;; Inherited from the old prolog.el.
+  (define-key map "\e\C-x" 'prolog-consult-region)
+  (define-key map "\C-c\C-l" 'prolog-consult-file)
+  (define-key map "\C-c\C-z" 'switch-to-prolog))
+
+(defun prolog-mode-keybindings-inferior (map)
+  "Define keybindings for inferior Prolog mode in MAP."
+  ;; No inferior mode specific keybindings now.
+  )
 
 (defvar prolog-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map "\e\C-x" 'prolog-consult-region)
-    (define-key map "\C-c\C-l" 'inferior-prolog-load-file)
-    (define-key map "\C-c\C-z" 'switch-to-prolog)
+    (prolog-mode-keybindings-common map)
+    (prolog-mode-keybindings-edit map)
     map))
+  
 
-(easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode."
-  ;; Mostly copied from scheme-mode's menu.
-  ;; Not tremendously useful, but it's a start.
-  '("Prolog"
-    ["Indent line" indent-according-to-mode t]
-    ["Indent region" indent-region t]
-    ["Comment region" comment-region t]
-    ["Uncomment region" uncomment-region t]
-    "--"
-    ["Run interactive Prolog session" run-prolog t]
-    ))
+(defvar prolog-mode-hook nil
+  "List of functions to call after the prolog mode has initialised.")
 
+(unless (fboundp 'prog-mode)
+  (defalias 'prog-mode 'fundamental-mode))
 ;;;###autoload
 (define-derived-mode prolog-mode prog-mode "Prolog"
-  "Major mode for editing Prolog code for Prologs.
-Blank lines and `%%...' separate paragraphs.  `%'s start comments.
+  "Major mode for editing Prolog code.
+
+Blank lines and `%%...' separate paragraphs.  `%'s starts a comment
+line and comments can also be enclosed in /* ... */.
+
+If an optional argument SYSTEM is non-nil, set up mode for the given system.
+
+To find out what version of Prolog mode you are running, enter
+`\\[prolog-mode-version]'.
+
 Commands:
 \\{prolog-mode-map}
 Entry to this mode calls the value of `prolog-mode-hook'
 if that value is non-nil."
+  (setq mode-name (concat "Prolog"
+                          (cond
+                           ((eq prolog-system 'eclipse) "[ECLiPSe]")
+                           ((eq prolog-system 'sicstus) "[SICStus]")
+                           ((eq prolog-system 'swi) "[SWI]")
+                           ((eq prolog-system 'gnu) "[GNU]")
+                           (t ""))))
   (prolog-mode-variables)
-  (set (make-local-variable 'comment-add) 1)
-  (setq font-lock-defaults '(prolog-font-lock-keywords
-                             nil nil nil
-                             beginning-of-line)))
-
-(defun end-of-prolog-clause ()
-  "Go to end of clause in this line."
-  (beginning-of-line 1)
-  (let* ((eolpos (line-end-position)))
-    (if (re-search-forward comment-start-skip eolpos 'move)
-        (goto-char (match-beginning 0)))
-    (skip-chars-backward " \t")))
-
-;;;
-;;; Inferior prolog mode
-;;;
-(defvar inferior-prolog-mode-map
+  (prolog-build-case-strings)
+  (prolog-set-atom-regexps)
+  (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
+
+  ;; imenu entry moved to the appropriate hook for consistency
+  
+  ;; Load SICStus debugger if suitable
+  (if (and (eq prolog-system 'sicstus)
+           (prolog-atleast-version '(3 . 7))
+           prolog-use-sicstus-sd)
+      (prolog-enable-sicstus-sd)))
+
+(defvar mercury-mode-map
   (let ((map (make-sparse-keymap)))
-    ;; This map will inherit from `comint-mode-map' when entering
-    ;; inferior-prolog-mode.
-    (define-key map [remap self-insert-command]
-      'inferior-prolog-self-insert-command)
+    (set-keymap-parent map prolog-mode-map)
     map))
 
-(defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table)
-(defvar inferior-prolog-mode-abbrev-table prolog-mode-abbrev-table)
+;;;###autoload
+(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
+  "Major mode for editing Mercury programs.
+Actually this is just customized `prolog-mode'."
+  (set (make-local-variable 'prolog-system) 'mercury))
 
-(defvar inferior-prolog-error-regexp-alist
-  ;; GNU Prolog used to not follow the GNU standard format.
-  '(("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
-    gnu))
+
+;;-------------------------------------------------------------------
+;; Inferior prolog mode
+;;-------------------------------------------------------------------
 
-(declare-function comint-mode "comint")
-(declare-function comint-send-string "comint" (process string))
-(declare-function comint-send-region "comint" (process start end))
-(declare-function comint-send-eof "comint" ())
-(defvar compilation-error-regexp-alist)
+(defvar prolog-inferior-mode-map
+  (let ((map (make-sparse-keymap)))
+    (prolog-mode-keybindings-common map)
+    (prolog-mode-keybindings-inferior map)
+    map))
+  
+(defvar prolog-inferior-mode-hook nil
+  "List of functions to call after the inferior prolog mode has initialised.")
 
-(define-derived-mode inferior-prolog-mode comint-mode "Inferior Prolog"
+(define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog"
   "Major mode for interacting with an inferior Prolog process.
 
 The following commands are available:
-\\{inferior-prolog-mode-map}
+\\{prolog-inferior-mode-map}
 
 Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
 if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
 `prolog-mode-hook' is called after `comint-mode-hook'.
 
-You can send text to the inferior Prolog from other buffers using the commands
-`process-send-region', `process-send-string' and \\[prolog-consult-region].
+You can send text to the inferior Prolog from other buffers
+using the commands `send-region', `send-string' and \\[prolog-consult-region].
 
 Commands:
 Tab indents for Prolog; with argument, shifts rest
  of expression rigidly with the current line.
-Paragraphs are separated only by blank lines and '%%'.
-'%'s start comments.
+Paragraphs are separated only by blank lines and '%%'. '%'s start comments.
 
 Return at end of buffer sends line as input.
 Return not at end copies rest of line to end and sends it.
-\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
+\\[comint-delchar-or-maybe-eof] sends end-of-file as input.
+\\[comint-kill-input] and \\[backward-kill-word] are kill commands,
+imitating normal Unix input editing.
 \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
-\\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
-  (setq comint-prompt-regexp "^| [ ?][- ] *")
-  (set (make-local-variable 'compilation-error-regexp-alist)
-       inferior-prolog-error-regexp-alist)
-  (compilation-shell-minor-mode)
-  (prolog-mode-variables))
-
-(defvar inferior-prolog-buffer nil)
-
-(defvar inferior-prolog-flavor 'unknown
-  "Either a symbol or a buffer position offset by one.
-If a buffer position, the flavor has not been determined yet and
-it is expected that the process's output has been or will
-be inserted at that position plus one.")
-
-(defun inferior-prolog-run (&optional name)
-  (with-current-buffer (make-comint "prolog" (or name prolog-program-name))
-    (inferior-prolog-mode)
-    (setq-default inferior-prolog-buffer (current-buffer))
-    (make-local-variable 'inferior-prolog-buffer)
-    (when (and name (not (equal name prolog-program-name)))
-      (set (make-local-variable 'prolog-program-name) name))
-    (set (make-local-variable 'inferior-prolog-flavor)
-         ;; Force re-detection.
-         (let* ((proc (get-buffer-process (current-buffer)))
-                (pmark (and proc (marker-position (process-mark proc)))))
-           (cond
-            ((null pmark) (1- (point-min)))
-            ;; The use of insert-before-markers in comint.el together with
-            ;; the potential use of comint-truncate-buffer in the output
-            ;; filter, means that it's difficult to reliably keep track of
-            ;; the buffer position where the process's output started.
-            ;; If possible we use a marker at "start - 1", so that
-            ;; insert-before-marker at `start' won't shift it.  And if not,
-            ;; we fall back on using a plain integer.
-            ((> pmark (point-min)) (copy-marker (1- pmark)))
-            (t (1- pmark)))))
-    (add-hook 'comint-output-filter-functions
-              'inferior-prolog-guess-flavor nil t)))
-
-(defun inferior-prolog-process (&optional dontstart)
-  (or (and (buffer-live-p inferior-prolog-buffer)
-           (get-buffer-process inferior-prolog-buffer))
-      (unless dontstart
-        (inferior-prolog-run)
-        ;; Try again.
-        (inferior-prolog-process))))
-
-(defun inferior-prolog-guess-flavor (&optional ignored)
-  (save-excursion
-    (goto-char (1+ inferior-prolog-flavor))
-    (setq inferior-prolog-flavor
-          (cond
-           ((looking-at "GNU Prolog") 'gnu)
-           ((looking-at "Welcome to SWI-Prolog") 'swi)
-           ((looking-at ".*\n") 'unknown) ;There's at least one line.
-           (t inferior-prolog-flavor))))
-  (when (symbolp inferior-prolog-flavor)
-    (remove-hook 'comint-output-filter-functions
-                 'inferior-prolog-guess-flavor t)
-    (if (eq inferior-prolog-flavor 'gnu)
-        (set (make-local-variable 'comint-process-echoes) t))))
+\\[comint-stop-subjob] stops, likewise.
+\\[comint-quit-subjob] sends quit signal, likewise.
+
+To find out what version of Prolog mode you are running, enter
+`\\[prolog-mode-version]'."
+  (setq comint-input-filter 'prolog-input-filter)
+  (setq mode-line-process '(": %s"))
+  (prolog-mode-variables)
+  (setq comint-prompt-regexp prolog-prompt-regexp-i)
+  (set (make-local-variable 'shell-dirstack-query) "pwd."))
+
+(defun prolog-input-filter (str)
+  (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
+        ((not (eq major-mode 'prolog-inferior-mode)) t)
+        ((= (length str) 1) nil)        ;one character
+        ((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
+        (t t)))
 
 ;;;###autoload
-(defalias 'run-prolog 'switch-to-prolog)
-;;;###autoload
-(defun switch-to-prolog (&optional name)
+(defun run-prolog (arg)
   "Run an inferior Prolog process, input and output via buffer *prolog*.
-With prefix argument \\[universal-prefix], prompt for the program to use."
-  (interactive
-   (list (when current-prefix-arg
-           (let ((proc (inferior-prolog-process 'dontstart)))
-             (if proc
-                 (if (yes-or-no-p "Kill current process before starting new one? ")
-                     (kill-process proc)
-                   (error "Abort")))
-             (read-string "Run Prolog: " prolog-program-name)))))
-  (unless (inferior-prolog-process 'dontstart)
-    (inferior-prolog-run name))
-  (pop-to-buffer inferior-prolog-buffer))
-
-(defun inferior-prolog-self-insert-command ()
-  "Insert the char in the buffer or pass it directly to the process."
-  (interactive)
-  (let* ((proc (get-buffer-process (current-buffer)))
-         (pmark (and proc (marker-position (process-mark proc)))))
-    (if (and (eq inferior-prolog-flavor 'gnu)
-             pmark
-             (null current-prefix-arg)
-             (eobp)
-             (eq (point) pmark)
+With prefix argument ARG, restart the Prolog process if running before."
+  (interactive "P")
+  (if (and arg (get-process "prolog"))
+      (progn
+        (process-send-string "prolog" "halt.\n")
+        (while (get-process "prolog") (sit-for 0.1))))
+  (let ((buff (buffer-name)))
+    (if (not (string= buff "*prolog*"))
+        (prolog-goto-prolog-process-buffer))
+    ;; Load SICStus debugger if suitable
+    (if (and (eq prolog-system 'sicstus)
+             (prolog-atleast-version '(3 . 7))
+             prolog-use-sicstus-sd)
+        (prolog-enable-sicstus-sd))
+    (prolog-mode-variables)
+    (prolog-ensure-process)
+    ))
+
+(defun prolog-ensure-process (&optional wait)
+  "If Prolog process is not running, run it.
+If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
+the variable `prolog-prompt-regexp'."
+  (if (null prolog-program-name-i)
+      (error "This Prolog system has defined no interpreter."))
+  (if (comint-check-proc "*prolog*")
+      ()
+    (apply 'make-comint "prolog" prolog-program-name-i nil
+           prolog-program-switches-i)
+    (with-current-buffer "*prolog*"
+      (prolog-inferior-mode)
+      (if wait
+          (progn
+            (goto-char (point-max))
+            (while
+                (save-excursion
+                  (not
+                   (re-search-backward
+                    (concat "\\(" prolog-prompt-regexp-i "\\)" "\\=")
+                    nil t)))
+              (sit-for 0.1)))))))
+
+(defun prolog-process-insert-string (process string)
+  "Insert STRING into inferior Prolog buffer running PROCESS."
+  ;; Copied from elisp manual, greek to me
+  (with-current-buffer (process-buffer process)
+    ;; FIXME: Use window-point-insertion-type instead.
+    (let ((moving (= (point) (process-mark process))))
+      (save-excursion
+        ;; Insert the text, moving the process-marker.
+        (goto-char (process-mark process))
+        (insert string)
+        (set-marker (process-mark process) (point)))
+      (if moving (goto-char (process-mark process))))))
+
+;;------------------------------------------------------------
+;; Old consulting and compiling functions
+;;------------------------------------------------------------
+
+(defun prolog-old-process-region (compilep start end)
+  "Process the region limited by START and END positions.
+If COMPILEP is non-nil then use compilation, otherwise consulting."
+   (prolog-ensure-process)
+   ;(let ((tmpfile prolog-temp-filename)
+   (let ((tmpfile (prolog-bsts (prolog-temporary-file)))
+         ;(process (get-process "prolog"))
+         (first-line (1+ (count-lines 
+                          (point-min) 
+                          (save-excursion
+                            (goto-char start)
+                            (point))))))
+     (write-region start end tmpfile)
+     (process-send-string
+      "prolog" (prolog-build-prolog-command
+                compilep tmpfile (prolog-bsts buffer-file-name)
+                first-line))
+     (prolog-goto-prolog-process-buffer)))
+
+(defun prolog-old-process-predicate (compilep)
+  "Process the predicate around point.
+If COMPILEP is non-nil then use compilation, otherwise consulting."
+  (prolog-old-process-region
+   compilep (prolog-pred-start) (prolog-pred-end)))
+
+(defun prolog-old-process-buffer (compilep)
+  "Process the entire buffer.
+If COMPILEP is non-nil then use compilation, otherwise consulting."
+  (prolog-old-process-region compilep (point-min) (point-max)))
+
+(defun prolog-old-process-file (compilep)
+  "Process the file of the current buffer.
+If COMPILEP is non-nil then use compilation, otherwise consulting."
+  (save-some-buffers)
+  (prolog-ensure-process)
+  (let ((filename (prolog-bsts buffer-file-name)))
+    (process-send-string
+     "prolog" (prolog-build-prolog-command 
+               compilep filename filename))
+    (prolog-goto-prolog-process-buffer)))
+
+
+;;------------------------------------------------------------
+;; Consulting and compiling
+;;------------------------------------------------------------
+
+;;; Interactive interface functions, used by both the standard
+;;; and the experimental consultation and compilation functions
+(defun prolog-consult-file ()
+  "Consult file of current buffer."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-file nil)
+    (prolog-consult-compile-file nil)))
+
+(defun prolog-consult-buffer ()
+  "Consult buffer."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-buffer nil)
+    (prolog-consult-compile-buffer nil)))
+
+(defun prolog-consult-region (beg end)
+  "Consult region between BEG and END."
+  (interactive "r")
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-region nil beg end)
+    (prolog-consult-compile-region nil beg end)))
+
+(defun prolog-consult-predicate ()
+  "Consult the predicate around current point."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-predicate nil)
+    (prolog-consult-compile-predicate nil)))
+
+(defun prolog-compile-file ()
+  "Compile file of current buffer."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-file t)
+    (prolog-consult-compile-file t)))
+
+(defun prolog-compile-buffer ()
+  "Compile buffer."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-buffer t)
+    (prolog-consult-compile-buffer t)))
+
+(defun prolog-compile-region (beg end)
+  "Compile region between BEG and END."
+  (interactive "r")
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-region t beg end)
+    (prolog-consult-compile-region t beg end)))
+
+(defun prolog-compile-predicate ()
+  "Compile the predicate around current point."
+  (interactive)
+  (if prolog-use-standard-consult-compile-method-flag
+      (prolog-old-process-predicate t)
+    (prolog-consult-compile-predicate t)))
+
+(defun prolog-buffer-module ()
+  "Select Prolog module name appropriate for current buffer.
+Bases decision on buffer contents (-*- line)."
+  ;; Look for -*- ... module: MODULENAME; ... -*-
+  (let (beg end)
+    (save-excursion
+      (goto-char (point-min))
+      (skip-chars-forward " \t")
+      (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t)
+           (progn
+             (skip-chars-forward " \t")
+             (setq beg (point))
+             (search-forward "-*-" (save-excursion (end-of-line) (point)) t))
+           (progn
+             (forward-char -3)
+             (skip-chars-backward " \t")
+             (setq end (point))
+             (goto-char beg)
+             (and (let ((case-fold-search t))
+                    (search-forward "module:" end t))
+                  (progn
+                    (skip-chars-forward " \t")
+                    (setq beg (point))
+                    (if (search-forward ";" end t)
+                        (forward-char -1)
+                      (goto-char end))
+                    (skip-chars-backward " \t")
+                    (buffer-substring beg (point)))))))))
+
+(defun prolog-build-prolog-command (compilep file buffername 
+                                    &optional first-line)
+  "Make Prolog command for FILE compilation/consulting.
+If COMPILEP is non-nil, consider compilation, otherwise consulting."
+  (let* ((compile-string
+          (if compilep prolog-compile-string-i prolog-consult-string-i))
+         (module (prolog-buffer-module))
+         (file-name (concat "'" file "'"))
+         (module-name (if module (concat "'" module "'")))
+         (module-file (if module
+                          (concat module-name ":" file-name)
+                        file-name))
+         strbeg strend
+         (lineoffset (if first-line
+                         (- first-line 1)
+                       0)))
+
+    ;; Assure that there is a buffer name
+    (if (not buffername)
+        (error "The buffer is not saved"))
+
+    (if (not (string-match "^'.*'$" buffername)) ; Add quotes
+        (setq buffername (concat "'" buffername "'")))
+    (while (string-match "%m" compile-string)
+      (setq strbeg (substring compile-string 0 (match-beginning 0)))
+      (setq strend (substring compile-string (match-end 0)))
+      (setq compile-string (concat strbeg module-file strend)))
+    (while (string-match "%f" compile-string)
+      (setq strbeg (substring compile-string 0 (match-beginning 0)))
+      (setq strend (substring compile-string (match-end 0)))
+      (setq compile-string (concat strbeg file-name strend)))
+    (while (string-match "%b" compile-string)
+      (setq strbeg (substring compile-string 0 (match-beginning 0)))
+      (setq strend (substring compile-string (match-end 0)))
+      (setq compile-string (concat strbeg buffername strend)))
+    (while (string-match "%l" compile-string)
+      (setq strbeg (substring compile-string 0 (match-beginning 0)))
+      (setq strend (substring compile-string (match-end 0)))
+      (setq compile-string (concat strbeg (format "%d" lineoffset) strend)))
+    (concat compile-string "\n")))
+
+;;; The rest of this page is experimental code!
+
+;; Global variables for process filter function
+(defvar prolog-process-flag nil
+  "Non-nil means that a prolog task (i.e. a consultation or compilation job) 
+is running.")
+(defvar prolog-consult-compile-output ""
+  "Hold the unprocessed output from the current prolog task.")
+(defvar prolog-consult-compile-first-line 1
+  "The number of the first line of the file to consult/compile.
+Used for temporary files.")
+(defvar prolog-consult-compile-file nil
+  "The file to compile/consult (can be a temporary file).")
+(defvar prolog-consult-compile-real-file nil
+  "The file name of the buffer to compile/consult.")
+
+(defun prolog-consult-compile (compilep file &optional first-line)
+  "Consult/compile FILE.
+If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING.
+COMMAND is a string described by the variables `prolog-consult-string'
+and `prolog-compile-string'.
+Optional argument FIRST-LINE is the number of the first line in the compiled
+region.
+
+This function must be called from the source code buffer."
+  (if prolog-process-flag
+      (error "Another Prolog task is running."))
+  (prolog-ensure-process t)
+  (let* ((buffer (get-buffer-create prolog-compilation-buffer))
+         (real-file buffer-file-name)
+         (command-string (prolog-build-prolog-command compilep file 
+                                                      real-file first-line))
+         (process (get-process "prolog"))
+         (old-filter (process-filter process)))
+    (with-current-buffer buffer
+      (delete-region (point-min) (point-max))
+      (compilation-mode)
+      ;; Setting up font-locking for this buffer
+      (make-local-variable 'font-lock-defaults)
+      (setq font-lock-defaults 
+            '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
+      (if (eq prolog-system 'sicstus)
+          (progn
+            (make-local-variable 'compilation-parse-errors-function)
+            (setq compilation-parse-errors-function
+                  'prolog-parse-sicstus-compilation-errors)))
+      (toggle-read-only 0)
+      (insert command-string "\n"))
+    (save-selected-window
+      (pop-to-buffer buffer))
+    (setq prolog-process-flag t
+          prolog-consult-compile-output ""
+          prolog-consult-compile-first-line (if first-line (1- first-line) 0)
+          prolog-consult-compile-file file
+          prolog-consult-compile-real-file (if (string= 
+                                                file buffer-file-name)
+                                               nil
+                                             real-file))
+    (with-current-buffer buffer
+      (goto-char (point-max))
+      (set-process-filter process 'prolog-consult-compile-filter)
+      (process-send-string "prolog" command-string)
+      ;; (prolog-build-prolog-command compilep file real-file first-line))
+      (while (and prolog-process-flag
+                  (accept-process-output process 10)) ; 10 secs is ok?
+        (sit-for 0.1)
+        (unless (get-process "prolog")
+            (setq prolog-process-flag nil)))
+      (insert (if compilep
+                  "\nCompilation finished.\n"
+                "\nConsulted.\n"))
+      (set-process-filter process old-filter))))
+
+(defun prolog-parse-sicstus-compilation-errors (limit)
+  "Parse the prolog compilation buffer for errors.
+Argument LIMIT is a buffer position limiting searching.
+For use with the `compilation-parse-errors-function' variable."
+  (setq compilation-error-list nil)
+  (message "Parsing SICStus error messages...")
+  (let (filepath dir file errorline)
+    (while 
+        (re-search-backward
+         "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)"
+         limit t)
+      (setq errorline (string-to-number (match-string 2)))
+      (save-excursion
+        (re-search-backward
+         "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}"
+         limit t)
+        (setq filepath (match-string 2)))
+
+      ;; ###### Does this work with SICStus under Windows (i.e. backslahes and stuff?)
+      (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
+          (progn
+            (setq dir (match-string 1 filepath))
+            (setq file (match-string 2 filepath))))
+
+      (setq compilation-error-list
+            (cons
+             (cons (save-excursion
+                     (beginning-of-line)
+                     (point-marker))
+                   (list (list file dir) errorline))
+             compilation-error-list)
+            ))
+    ))
+
+(defun prolog-consult-compile-filter (process output)
+  "Filter function for Prolog compilation PROCESS.
+Argument OUTPUT is a name of the output file."
+  ;;(message "start")
+  (setq prolog-consult-compile-output
+        (concat prolog-consult-compile-output output))
+  ;;(message "pccf1: %s" prolog-consult-compile-output)
+  ;; Iterate through the lines of prolog-consult-compile-output
+  (let (outputtype)
+    (while (and prolog-process-flag
+                (or
+                 ;; Trace question
+                 (progn 
+                   (setq outputtype 'trace)
+                   (and (eq prolog-system 'sicstus)
+                        (string-match
+                         "^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? "
+                         prolog-consult-compile-output)))
+                 
+                 ;; Match anything
+                 (progn 
+                   (setq outputtype 'normal)
+                   (string-match "^.*\n" prolog-consult-compile-output))
+                   ))
+      ;;(message "outputtype: %s" outputtype)
+
+      (setq output (match-string 0 prolog-consult-compile-output))
+      ;; remove the text in output from prolog-consult-compile-output
+      (setq prolog-consult-compile-output
+            (substring prolog-consult-compile-output (length output)))
+      ;;(message "pccf2: %s" prolog-consult-compile-output)
+      
+      ;; If temporary files were used, then we change the error
+      ;; messages to point to the original source file.
+      (cond
+
+       ;; If the prolog process was in trace mode then it requires
+       ;; user input
+       ((and (eq prolog-system 'sicstus) 
+             (eq outputtype 'trace))
+        (let (input)
+          (setq input (concat (read-string output) "\n"))
+          (process-send-string process input)
+          (setq output (concat output input))))
+
+       ((eq prolog-system 'sicstus)
+        (if (and prolog-consult-compile-real-file
+                 (string-match
+                  "\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output))
+            (setq output (replace-match
+                          ;; Adds a {processing ...} line so that 
+                          ;; `prolog-parse-sicstus-compilation-errors'
+                          ;; finds the real file instead of the temporary one.
+                          ;; Also fixes the line numbers.
+                          (format "Added by Emacs: {processing %s...}\n%s%d-%d"
+                                  prolog-consult-compile-real-file
+                                  (match-string 1 output)
+                                  (+ prolog-consult-compile-first-line
+                                     (string-to-number
+                                      (match-string 2 output)))
+                                  (+ prolog-consult-compile-first-line
+                                     (string-to-number
+                                      (match-string 3 output))))
+                          t t output)))
+        )
+       
+       ((eq prolog-system 'swi)
+        (if (and prolog-consult-compile-real-file
+                 (string-match (format
+                                "%s\\([ \t]*:[ \t]*\\)\\([0-9]+\\)"
+                                prolog-consult-compile-file)
+                               output))
+            (setq output (replace-match
+                          ;; Real filename + text + fixed linenum
+                          (format "%s%s%d"
+                                  prolog-consult-compile-real-file
+                                  (match-string 1 output)
+                                  (+ prolog-consult-compile-first-line
+                                     (string-to-number
+                                      (match-string 2 output))))
+                          t t output)))
+        )
+       
+       (t ())
+       )
+      ;; Write the output in the *prolog-compilation* buffer
+      (insert output)))
+
+  ;; If the prompt is visible, then the task is finished
+  (if (string-match prolog-prompt-regexp-i prolog-consult-compile-output)
+      (setq prolog-process-flag nil)))
+
+(defun prolog-consult-compile-file (compilep)
+  "Consult/compile file of current buffer.
+If COMPILEP is non-nil, compile, otherwise consult."
+  (let ((file buffer-file-name))
+    (if file
+        (progn
+          (save-some-buffers)
+          (prolog-consult-compile compilep file))
+      (prolog-consult-compile-region compilep (point-min) (point-max)))))
+
+(defun prolog-consult-compile-buffer (compilep)
+  "Consult/compile current buffer.
+If COMPILEP is non-nil, compile, otherwise consult."
+  (prolog-consult-compile-region compilep (point-min) (point-max)))
+
+(defun prolog-consult-compile-region (compilep beg end)
+  "Consult/compile region between BEG and END.
+If COMPILEP is non-nil, compile, otherwise consult."
+  ;(let ((file prolog-temp-filename)
+  (let ((file (prolog-bsts (prolog-temporary-file)))
+        (lines (count-lines 1 beg)))
+    (write-region beg end file nil 'no-message)
+    (write-region "\n" nil file t 'no-message)
+    (prolog-consult-compile compilep file
+                            (if (looking-at "^") (1+ lines) lines))
+    (delete-file file)))
+
+(defun prolog-consult-compile-predicate (compilep)
+  "Consult/compile the predicate around current point.
+If COMPILEP is non-nil, compile, otherwise consult."
+  (prolog-consult-compile-region
+   compilep (prolog-pred-start) (prolog-pred-end)))
+
+
+;;-------------------------------------------------------------------
+;; Font-lock stuff
+;;-------------------------------------------------------------------
+
+;; Auxilliary functions
+(defun prolog-make-keywords-regexp (keywords &optional protect)
+  "Create regexp from the list of strings KEYWORDS.
+If PROTECT is non-nil, surround the result regexp by word breaks."
+  (let ((regexp
+         (if (fboundp 'regexp-opt)
+             ;; Emacs 20
+             ;; Avoid compile warnings under earlier versions by using eval
+             (eval '(regexp-opt keywords))
+           ;; Older Emacsen
+           (concat (mapconcat 'regexp-quote keywords "\\|")))
+         ))
+    (if protect
+        (concat "\\<\\(" regexp "\\)\\>")
+      regexp)))
+
+(defun prolog-font-lock-object-matcher (bound)
+  "Find SICStus objects method name for font lock.
+Argument BOUND is a buffer position limiting searching."
+  (let (point
+         (case-fold-search nil))
+    (while (and (not point)
+                (re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*"
+                                   bound t))
+      (while (or (re-search-forward "\\=\n[ \t]*" bound t)
+                  (re-search-forward "\\=%.*" bound t)
+                  (and (re-search-forward "\\=/\\*" bound t)
+                       (re-search-forward "\\*/[ \t]*" bound t))))
+      (setq point (re-search-forward
+                   (format "\\=\\(%s\\)" prolog-atom-regexp)
+                   bound t)))
+    point))
+
+(defsubst prolog-face-name-p (facename)
+  ;; Return t if FACENAME is the name of a face.  This method is
+  ;; necessary since facep in XEmacs only returns t for the actual
+  ;; face objects (while it's only their names that are used just
+  ;; about anywhere else) without providing a predicate that tests
+  ;; face names.  This function (including the above commentary) is
+  ;; borrowed from cc-mode.
+  (memq facename (face-list)))
+
+;; Set everything up
+(defun prolog-font-lock-keywords ()
+  "Set up font lock keywords for the current Prolog system."
+  ;(when window-system
+    (require 'font-lock)
+    
+    ;; Define Prolog faces
+    (defface prolog-redo-face
+      '((((class grayscale)) (:italic t))
+        (((class color)) (:foreground "darkorchid"))
+        (t (:italic t)))
+      "Prolog mode face for highlighting redo trace lines."
+      :group 'prolog-faces)
+    (defface prolog-exit-face
+      '((((class grayscale)) (:underline t))
+        (((class color) (background dark)) (:foreground "green"))
+        (((class color) (background light)) (:foreground "ForestGreen"))
+        (t (:underline t)))
+      "Prolog mode face for highlighting exit trace lines."
+      :group 'prolog-faces)
+    (defface prolog-exception-face
+      '((((class grayscale)) (:bold t :italic t :underline t))
+        (((class color)) (:bold t :foreground "black" :background "Khaki"))
+        (t (:bold t :italic t :underline t)))
+      "Prolog mode face for highlighting exception trace lines."
+      :group 'prolog-faces)
+    (defface prolog-warning-face
+      '((((class grayscale)) (:underline t))
+        (((class color) (background dark)) (:foreground "blue"))
+        (((class color) (background light)) (:foreground "MidnightBlue"))
+        (t (:underline t)))
+      "Face name to use for compiler warnings."
+      :group 'prolog-faces)
+    (defface prolog-builtin-face
+      '((((class color) (background light)) (:foreground "Purple"))
+        (((class color) (background dark)) (:foreground "Cyan"))
+        (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+        (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+        (t (:bold t)))
+      "Face name to use for compiler warnings."
+      :group 'prolog-faces)
+    (defvar prolog-warning-face 
+      (if (prolog-face-name-p 'font-lock-warning-face)
+          'font-lock-warning-face
+        'prolog-warning-face)
+      "Face name to use for built in predicates.")
+    (defvar prolog-builtin-face 
+      (if (prolog-face-name-p 'font-lock-builtin-face)
+          'font-lock-builtin-face
+        'prolog-builtin-face)
+      "Face name to use for built in predicates.")
+    (defvar prolog-redo-face 'prolog-redo-face
+      "Face name to use for redo trace lines.")
+    (defvar prolog-exit-face 'prolog-exit-face
+      "Face name to use for exit trace lines.")
+    (defvar prolog-exception-face 'prolog-exception-face
+      "Face name to use for exception trace lines.")
+    
+    ;; Font Lock Patterns
+    (let (
+          ;; "Native" Prolog patterns
+          (head-predicates
+           (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp)
+                 1 font-lock-function-name-face))
+           ;(list (format "^%s" prolog-atom-regexp)
+           ;      0 font-lock-function-name-face))
+          (head-predicates-1
+           (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp)
+                 1 font-lock-function-name-face) )
+          (variables
+           '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)"
+             1 font-lock-variable-name-face))
+          (important-elements
+           (list (if (eq prolog-system 'mercury)
+                     "[][}{;|]\\|\\\\[+=]\\|<?=>?"
+                   "[][}{!;|]\\|\\*->")
+                 0 'font-lock-keyword-face))
+          (important-elements-1
+           '("[^-*]\\(->\\)" 1 font-lock-keyword-face))
+          (predspecs                        ; module:predicate/cardinality
+           (list (format "\\<\\(%s:\\|\\)%s/[0-9]+"
+                         prolog-atom-regexp prolog-atom-regexp)
+                 0 font-lock-function-name-face 'prepend))
+          (keywords                        ; directives (queries)
+           (list
+            (if (eq prolog-system 'mercury)
+                (concat
+                 "\\<\\("
+                 (prolog-make-keywords-regexp prolog-keywords-i)
+                 "\\|"
+                 (prolog-make-keywords-regexp
+                  prolog-determinism-specificators-i)
+                 "\\)\\>")
+              (concat
+               "^[?:]- *\\("
+               (prolog-make-keywords-regexp prolog-keywords-i)
+               "\\)\\>"))
+              1 prolog-builtin-face))
+          (quoted_atom (list prolog-quoted-atom-regexp
+                             2 'font-lock-string-face 'append))
+          (string (list prolog-string-regexp
+                        1 'font-lock-string-face 'append))
+          ;; SICStus specific patterns
+          (sicstus-object-methods
+           (if (eq prolog-system 'sicstus)
+               '(prolog-font-lock-object-matcher
+                 1 font-lock-function-name-face)))
+          ;; Mercury specific patterns
+          (types
+           (if (eq prolog-system 'mercury)
+               (list
+                (prolog-make-keywords-regexp prolog-types-i t)
+                0 'font-lock-type-face)))
+          (modes
+           (if (eq prolog-system 'mercury)
+               (list
+                (prolog-make-keywords-regexp prolog-mode-specificators-i t)
+                0 'font-lock-reference-face)))
+          (directives
+           (if (eq prolog-system 'mercury)
+               (list
+                (prolog-make-keywords-regexp prolog-directives-i t)
+                0 'prolog-warning-face)))
+          ;; Inferior mode specific patterns
+          (prompt
+           (list prolog-prompt-regexp-i 0 'font-lock-keyword-face))
+          (trace-exit
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
+               1 prolog-exit-face))
+            ((eq prolog-system 'swi)
+             '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
+            (t nil)))
+          (trace-fail
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
+               1 prolog-warning-face))
+            ((eq prolog-system 'swi)
+             '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
+            (t nil)))
+          (trace-redo
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
+               1 prolog-redo-face))
+            ((eq prolog-system 'swi)
+             '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
+            (t nil)))
+          (trace-call
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
+               1 font-lock-function-name-face))
+            ((eq prolog-system 'swi)
+             '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)"
+               1 font-lock-function-name-face))
+            (t nil)))
+          (trace-exception
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
+               1 prolog-exception-face))
+            ((eq prolog-system 'swi)
+             '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)"
+               1 prolog-exception-face))
+            (t nil)))
+          (error-message-identifier
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
+            ((eq prolog-system 'swi)
+             '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
+            (t nil)))
+          (error-whole-messages
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
+               1 font-lock-comment-face append))
+            ((eq prolog-system 'swi)
+             '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
+            (t nil)))
+          (error-warning-messages
+           ;; Mostly errors that SICStus asks the user about how to solve,
+           ;; such as "NAME CLASH:" for example.
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
+            (t nil)))
+          (warning-messages
+           (cond
+            ((eq prolog-system 'sicstus)
+             '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" 
+               2 prolog-warning-face prepend))
+            (t nil))))
+
+      ;; Make font lock list
+      (delq
+       nil
+       (cond
+        ((eq major-mode 'prolog-mode)
+         (list
+          head-predicates
+          head-predicates-1
+          quoted_atom
+          string
+          variables
+          important-elements
+          important-elements-1
+          predspecs
+          keywords
+          sicstus-object-methods
+          types
+          modes
+          directives))
+        ((eq major-mode 'prolog-inferior-mode)
+         (list
+         prompt
+         error-message-identifier
+         error-whole-messages
+         error-warning-messages
+         warning-messages
+         predspecs
+         trace-exit
+         trace-fail
+         trace-redo
+         trace-call
+         trace-exception))
+        ((eq major-mode 'compilation-mode)
+         (list
+         error-message-identifier
+         error-whole-messages
+         error-warning-messages
+         warning-messages
+         predspecs))))
+      ))
+
+
+;;-------------------------------------------------------------------
+;; Indentation stuff
+;;-------------------------------------------------------------------
+
+;; NB: This function *MUST* have this optional argument since XEmacs
+;; assumes it. This does not mean we have to use it...
+(defun prolog-indent-line (&optional whole-exp)
+  "Indent current line as Prolog code.
+With argument, indent any additional lines of the same clause
+rigidly along with this one (not yet)."
+  (interactive "p")
+  (let ((indent (prolog-indent-level))
+        (pos (- (point-max) (point))) beg)
+    (beginning-of-line)
+    (setq beg (point))
+    (skip-chars-forward " \t")
+    (if (zerop (- indent (current-column)))
+        nil
+      (delete-region beg (point))
+      (indent-to indent))
+    (if (> (- (point-max) pos) (point))
+        (goto-char (- (point-max) pos)))
+    
+    ;; Align comments
+    (if prolog-align-comments-flag
+        (save-excursion
+          (prolog-goto-comment-column t)))
+
+    ;; Insert spaces if needed
+    (if (or prolog-electric-tab-flag prolog-electric-if-then-else-flag)
+        (prolog-insert-spaces-after-paren))
+    ))
+
+(defun prolog-comment-indent ()
+  "Compute prolog comment indentation."
+  (cond ((looking-at "%%%") (prolog-indentation-level-of-line))
+        ((looking-at "%%") (prolog-indent-level))
+        (t
+         (save-excursion
+           (skip-chars-backward " \t")
+           ;; Insert one space at least, except at left margin.
+           (max (+ (current-column) (if (bolp) 0 1))
+                comment-column)))
+        ))
+
+(defun prolog-indent-level ()
+  "Compute prolog indentation level."
+  (save-excursion
+    (beginning-of-line)
+    (let ((totbal (prolog-region-paren-balance
+                   (prolog-clause-start t) (point)))
+          (oldpoint (point)))
+      (skip-chars-forward " \t")
+      (cond
+       ((looking-at "%%%") (prolog-indentation-level-of-line))
+                                        ;Large comment starts
+       ((looking-at "%[^%]") comment-column) ;Small comment starts
+       ((bobp) 0)                        ;Beginning of buffer
+
+       ;; If we found '}' then we must check if it's the
+       ;; end of an object declaration or something else.
+       ((and (looking-at "}") 
              (save-excursion
-               (goto-char (- pmark 3))
-               (looking-at " \\? ")))
-        ;; This is GNU prolog waiting to know whether you want more answers
-        ;; or not (or abort, etc...).  The answer is a single char, not
-        ;; a line, so pass this char directly rather than wait for RET to
-        ;; send a whole line.
-        (comint-send-string proc (string last-command-event))
-      (call-interactively 'self-insert-command))))
-
-(defun prolog-consult-region (compile beg end)
-  "Send the region to the Prolog process made by \"M-x run-prolog\".
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (let ((proc (inferior-prolog-process)))
-    (comint-send-string proc
-                        (if compile prolog-compile-string
-                          prolog-consult-string))
-    (comint-send-region proc beg end)
-    (comint-send-string proc "\n")              ;May be unnecessary
-    (if prolog-eof-string
-        (comint-send-string proc prolog-eof-string)
-      (with-current-buffer (process-buffer proc)
-        (comint-send-eof))))) ;Send eof to prolog process.
-
-(defun prolog-consult-region-and-go (compile beg end)
-  "Send the region to the inferior Prolog, and switch to *prolog* buffer.
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (prolog-consult-region compile beg end)
-  (pop-to-buffer inferior-prolog-buffer))
-
-;; inferior-prolog-mode uses the autoloaded compilation-shell-minor-mode.
-(declare-function compilation-forget-errors "compile" ())
-
-(defun inferior-prolog-load-file ()
-  "Pass the current buffer's file to the inferior prolog process."
-  (interactive)
-  (save-buffer)
-  (let ((file buffer-file-name)
-        (proc (inferior-prolog-process)))
-    (with-current-buffer (process-buffer proc)
-      (compilation-forget-errors)
-      (comint-send-string proc (concat "['" (file-relative-name file) "'].\n"))
-      (pop-to-buffer (current-buffer)))))
+               (forward-char 1)
+               ;; Goto to matching {
+               (if prolog-use-prolog-tokenizer-flag
+                   (prolog-backward-list)
+                 (backward-list))
+               (skip-chars-backward " \t")
+               (backward-char 2)
+               (looking-at "::")))
+        ;; It was an object
+        (if prolog-object-end-to-0-flag
+            0
+          prolog-indent-width)) 
+
+       ;;End of /* */ comment
+       ((looking-at "\\*/")                  
+        (save-excursion
+          (prolog-find-start-of-mline-comment)
+          (skip-chars-backward " \t")
+          (- (current-column) 2)))
+
+       ;; Here we check if the current line is within a /* */ pair
+       ((and (looking-at "[^%/]")
+             (eq (prolog-in-string-or-comment) 'cmt)) 
+        (if prolog-indent-mline-comments-flag
+            (prolog-find-start-of-mline-comment)
+          ;; Same as before
+          (prolog-indentation-level-of-line)))
+
+       (t
+        (let ((empty t) ind linebal)
+          ;; See previous indentation
+          (while empty
+            (forward-line -1)
+            (beginning-of-line)
+            (if (= (point) (point-min))
+                (setq empty nil)
+              (skip-chars-forward " \t")
+              (if (not (or (not (member (prolog-in-string-or-comment) '(nil txt)))
+                           (looking-at "%") 
+                           (looking-at "\n")))
+                  (setq empty nil))))
+
+          ;; Store this line's indentation
+          (if (= (point) (point-min))
+              (setq ind 0)                ;Beginning of buffer
+            (setq ind (current-column))) ;Beginning of clause
+
+          ;; Compute the balance of the line
+          (setq linebal (prolog-paren-balance))
+          ;;(message "bal of previous line %d totbal %d" linebal totbal)
+          (if (< linebal 0)
+              (progn
+                ;; Add 'indent-level' mode to find-unmatched-paren instead?
+                (end-of-line)
+                (setq ind (prolog-find-indent-of-matching-paren))))
+
+          ;;(message "ind %d" ind)
+          (beginning-of-line)
+
+          ;; Check if the line ends with ":-", ".", ":: {", "}" (might be
+          ;; unnecessary), "&" or ")" (The last four concerns SICStus objects)
+          (cond
+           ;; If the last char of the line is a '&' then set the indent level
+           ;; to prolog-indent-width (used in SICStus objects)
+           ((and (eq prolog-system 'sicstus) 
+                 (looking-at ".+&[ \t]*\\(%.*\\|\\)$"))
+            (setq ind prolog-indent-width))
+
+           ;; Increase indentation if the previous line was the head of a rule
+           ;; and does not contain a '.'
+           ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$" 
+                                     prolog-head-delimiter))
+                 ;; We must check that the match is at a paren balance of 0.
+                 (save-excursion
+                   (let ((p (point)))
+                     (re-search-forward prolog-head-delimiter)
+                     (>= 0 (prolog-region-paren-balance p (point))))))
+            (let (headindent)
+              (if (< (prolog-paren-balance) 0)
+                  (save-excursion
+                    (end-of-line)
+                    (setq headindent (prolog-find-indent-of-matching-paren)))
+                (setq headindent (prolog-indentation-level-of-line)))
+              (setq ind (+ headindent prolog-indent-width))))
+
+           ;; The previous line was the head of an object
+           ((looking-at ".+ *::.*{[ \t]*$")
+            (setq ind prolog-indent-width))
+
+           ;; If a '.' is found at the end of the previous line, then
+           ;; decrease the indentation. (The \\(%.*\\|\\) part of the
+           ;; regexp is for comments at the end of the line)
+           ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$") 
+                 ;; Make sure that the '.' found is not in a comment or string
+                 (save-excursion
+                   (end-of-line)
+                   (re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min))
+                   ;; Guard against the real '.' being followed by a
+                   ;; commented '.'.
+                   (if (eq (prolog-in-string-or-comment) 'cmt)  ;; commented out '.'
+                       (let ((here (save-excursion
+                                     (beginning-of-line)
+                                     (point))))
+                         (end-of-line)
+                         (re-search-backward "\\.[ \t]*%.*$" here t))
+                     (not (prolog-in-string-or-comment))
+                     )
+                   ))
+            (setq ind 0))
+
+           ;; If a '.' is found at the end of the previous line, then
+           ;; decrease the indentation. (The /\\*.*\\*/ part of the
+           ;; regexp is for C-like comments at the end of the
+           ;; line--can we merge with the case above?).
+           ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$") 
+                 ;; Make sure that the '.' found is not in a comment or string
+                 (save-excursion
+                   (end-of-line)
+                   (re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min))
+                   ;; Guard against the real '.' being followed by a
+                   ;; commented '.'.
+                   (if (eq (prolog-in-string-or-comment) 'cmt)  ;; commented out '.'
+                       (let ((here (save-excursion
+                                     (beginning-of-line)
+                                     (point))))
+                         (end-of-line)
+                         (re-search-backward "\\.[ \t]*/\\*.*$" here t))
+                     (not (prolog-in-string-or-comment))
+                     )
+                   ))
+            (setq ind 0))
+
+           )
+
+          ;; If the last non comment char is a ',' or left paren or a left-
+          ;; indent-regexp then indent to open parenthesis level
+          (if (and
+               (> totbal 0)
+               ;; SICStus objects have special syntax rules if point is
+               ;; not inside additional parens (objects are defined
+               ;; within {...})
+               (not (and (eq prolog-system 'sicstus)
+                         (= totbal 1)
+                         (prolog-in-object))))
+              (if (looking-at
+                   (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$" 
+                           prolog-quoted-atom-regexp prolog-string-regexp
+                           prolog-left-paren prolog-left-indent-regexp))
+                  (progn
+                    (goto-char oldpoint)
+                    (setq ind (prolog-find-unmatched-paren (if prolog-paren-indent-p 
+                                                               'termdependent 
+                                                             'skipwhite)))
+                    ;;(setq ind (prolog-find-unmatched-paren 'termdependent))
+                    )
+                (goto-char oldpoint)
+                (setq ind (prolog-find-unmatched-paren nil))
+                ))
+          
+
+          ;; Return the indentation level
+          ind
+          ))))))
+
+(defun prolog-find-indent-of-matching-paren ()
+  "Find the indentation level based on the matching parenthesis.
+Indentation level is set to the one the point is after when the function is
+called."
+  (save-excursion
+    ;; Go to the matching paren
+    (if prolog-use-prolog-tokenizer-flag
+        (prolog-backward-list)
+      (backward-list))
+
+    ;; If this was the first paren on the line then return this line's
+    ;; indentation level
+    (if (prolog-paren-is-the-first-on-line-p)
+        (prolog-indentation-level-of-line)
+      ;; It was not the first one
+      (progn
+         ;; Find the next paren
+         (prolog-goto-next-paren 0)
+
+         ;; If this paren is a left one then use its column as indent level,
+         ;; if not then recurse this function
+         (if (looking-at prolog-left-paren)
+             (+ (current-column) 1)
+           (progn
+              (forward-char 1)
+              (prolog-find-indent-of-matching-paren)))
+         ))
+    ))
+
+(defun prolog-indentation-level-of-line ()
+  "Return the indentation level of the current line."
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward " \t")
+    (current-column)))
+
+(defun prolog-first-pos-on-line ()
+  "Return the first position on the current line."
+  (save-excursion
+    (beginning-of-line)
+    (point)))
+
+(defun prolog-paren-is-the-first-on-line-p ()
+  "Return t if the parenthesis under the point is the first one on the line.
+Return nil otherwise.
+Note: does not check if the point is actually at a parenthesis!"
+  (save-excursion
+    (let ((begofline (prolog-first-pos-on-line)))
+      (if (= begofline (point))
+          t
+        (if (prolog-goto-next-paren begofline)
+            nil
+          t)))))
+
+(defun prolog-find-unmatched-paren (&optional mode)
+  "Return the column of the last unmatched left parenthesis.
+If MODE is `skipwhite' then any white space after the parenthesis is added to
+the answer.
+If MODE is `plusone' then the parenthesis' column +1 is returned.
+If MODE is `termdependent' then if the unmatched parenthesis is part of
+a compound term the function will work as `skipwhite', otherwise
+it will return the column paren plus the value of `prolog-paren-indent'.
+If MODE is nil or not set then the parenthesis' exact column is returned."
+  (save-excursion
+    ;; If the next paren we find is a left one we're finished, if it's
+    ;; a right one then we go back one step and recurse
+    (prolog-goto-next-paren 0)
+
+    (let ((roundparen (looking-at "(")))
+      (if (looking-at prolog-left-paren)
+          (let ((not-part-of-term 
+                 (save-excursion
+                   (backward-char 1)
+                   (looking-at "[ \t]"))))
+            (if (eq mode nil)
+                (current-column)
+              (if (and roundparen
+                       (eq mode 'termdependent) 
+                       not-part-of-term)
+                  (+ (current-column)
+                     (if prolog-electric-tab-flag
+                         ;; Electric TAB
+                         prolog-paren-indent
+                       ;; Not electric TAB
+                       (if (looking-at ".[ \t]*$")
+                           2
+                         prolog-paren-indent))
+                     )
+
+                (forward-char 1)
+                (if (or (eq mode 'skipwhite) (eq mode 'termdependent) )
+                    (skip-chars-forward " \t"))
+                (current-column))))
+        ;; Not looking at left paren
+        (progn
+          (forward-char 1)
+          ;; Go to the matching paren. When we get there we have a total
+          ;; balance of 0.
+          (if prolog-use-prolog-tokenizer-flag
+              (prolog-backward-list)
+            (backward-list))
+          (prolog-find-unmatched-paren mode)))
+      )))
+
+
+(defun prolog-paren-balance ()
+  "Return the parenthesis balance of the current line.
+A return value of n means n more left parentheses than right ones."
+  (save-excursion
+    (end-of-line)
+    (prolog-region-paren-balance (prolog-first-pos-on-line) (point))))
+
+(defun prolog-region-paren-balance (beg end)
+  "Return the summed parenthesis balance in the region.
+The region is limited by BEG and END positions."
+  (save-excursion
+    (let ((state (if prolog-use-prolog-tokenizer-flag
+                     (prolog-tokenize beg end)
+                   (parse-partial-sexp beg end))))
+      (nth 0 state))))
+
+(defun prolog-goto-next-paren (limit-pos)
+  "Move the point to the next parenthesis earlier in the buffer.
+Return t if a match was found before LIMIT-POS.  Return nil otherwise."
+  (let (retval)
+    (setq retval (re-search-backward
+                  (concat prolog-left-paren "\\|" prolog-right-paren)
+                  limit-pos t))
+
+    ;; If a match was found but it was in a string or comment, then recurse
+    (if (and retval (prolog-in-string-or-comment))
+        (prolog-goto-next-paren limit-pos)
+      retval)
+    ))
+
+(defun prolog-in-string-or-comment ()
+  "Check whether string, atom, or comment is under current point.
+Return:
+ `txt' if the point is in a string, atom, or character code expression
+ `cmt' if the point is in a comment
+ nil otherwise."
+  (save-excursion
+    (let* ((start
+            (if (eq prolog-parse-mode 'beg-of-line)
+                ;; 'beg-of-line
+                (save-excursion
+                  (let (safepoint)
+                    (beginning-of-line)
+                    (setq safepoint (point))
+                    (while (and (> (point) (point-min))
+                                (progn
+                                  (forward-line -1)
+                                  (end-of-line)
+                                  (if (not (bobp))
+                                      (backward-char 1))
+                                  (looking-at "\\\\"))
+                                )
+                      (beginning-of-line)
+                      (setq safepoint (point)))
+                    safepoint))
+              ;; 'beg-of-clause
+              (prolog-clause-start)))
+           (end (point))
+           (state (if prolog-use-prolog-tokenizer-flag
+                      (prolog-tokenize start end)
+                    (parse-partial-sexp start end))))
+      (cond
+       ((nth 3 state) 'txt) ; String
+       ((nth 4 state) 'cmt) ; Comment
+       (t
+        (cond
+         ((looking-at "%") 'cmt) ; Start of a comment
+         ((looking-at "/\\*") 'cmt) ; Start of a comment
+         ((looking-at "\'") 'txt) ; Start of an atom
+         ((looking-at "\"") 'txt) ; Start of a string
+         (t nil)
+         ))))
+    ))
+
+(defun prolog-find-start-of-mline-comment ()
+  "Return the start column of a /* */ comment.
+This assumes that the point is inside a comment."
+  (re-search-backward "/\\*" (point-min) t)
+  (forward-char 2)
+  (skip-chars-forward " \t")
+  (current-column))
+
+(defun prolog-insert-spaces-after-paren ()
+  "Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches.
+Spaces are inserted if all preceding objects on the line are
+whitespace characters, parentheses, or then/else branches."
+  (save-excursion
+    (let ((regexp (concat "(\\|" prolog-left-indent-regexp))
+          level)
+      (beginning-of-line)
+      (skip-chars-forward " \t")
+      (when (looking-at regexp)
+        ;; Treat "( If -> " lines specially.
+        ;;(if (looking-at "(.*->")
+        ;;    (setq incr 2)
+        ;;  (setq incr prolog-paren-indent))
+
+        ;; work on all subsequent "->", "(", ";"
+        (while (looking-at regexp)
+          (goto-char (match-end 0))
+          (setq level (+ (prolog-find-unmatched-paren) prolog-paren-indent))
+
+          ;; Remove old white space
+          (let ((start (point)))
+            (skip-chars-forward " \t")
+            (delete-region start (point)))
+          (indent-to level)
+          (skip-chars-forward " \t"))
+        )))
+  (when (save-excursion
+          (backward-char 2)
+          (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)"))
+    (skip-chars-forward " \t"))
+  )
+
+;;;; Comment filling
+
+(defun prolog-comment-limits ()
+  "Return the current comment limits plus the comment type (block or line).
+The comment limits are the range of a block comment or the range that
+contains all adjacent line comments (i.e. all comments that starts in
+the same column with no empty lines or non-whitespace characters
+between them)."
+  (let ((here (point))
+        lit-limits-b lit-limits-e lit-type beg end
+        )
+    (save-restriction
+      ;; Widen to catch comment limits correctly.
+      (widen)
+      (setq end (save-excursion (end-of-line) (point))
+            beg (save-excursion (beginning-of-line) (point)))
+      (save-excursion
+        (beginning-of-line)
+        (setq lit-type (if (search-forward-regexp "%" end t) 'line 'block))
+                        ;    (setq lit-type 'line)
+                        ;(if (search-forward-regexp "^[ \t]*%" end t)
+                        ;    (setq lit-type 'line)
+                        ;  (if (not (search-forward-regexp "%" end t))
+                        ;      (setq lit-type 'block)
+                        ;    (if (not (= (forward-line 1) 0))
+                        ;        (setq lit-type 'block)
+                        ;      (setq done t
+                        ;            ret (prolog-comment-limits)))
+                        ;    ))
+        (if (eq lit-type 'block)
+            (progn
+              (goto-char here)
+              (when (looking-at "/\\*") (forward-char 2))
+              (when (and (looking-at "\\*") (> (point) (point-min)) 
+                         (forward-char -1) (looking-at "/"))
+                (forward-char 1))
+              (when (save-excursion (search-backward "/*" nil t))
+                (list (save-excursion (search-backward "/*") (point))
+                      (or (search-forward "*/" nil t) (point-max)) lit-type)))
+          ;; line comment
+          (setq lit-limits-b (- (point) 1) 
+                lit-limits-e end)
+          (condition-case nil
+              (if (progn (goto-char lit-limits-b)
+                         (looking-at "%"))
+                  (let ((col (current-column)) done)
+                    (setq beg (point)
+                          end lit-limits-e)
+                    ;; Always at the beginning of the comment
+                    ;; Go backward now
+                    (beginning-of-line)
+                    (while (and (zerop (setq done (forward-line -1)))
+                                (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t)
+                                (= (+ 1 col) (current-column)))
+                      (setq beg (- (point) 1)))
+                    (when (= done 0)
+                      (forward-line 1))
+                    ;; We may have a line with code above...
+                    (when (and (zerop (setq done (forward-line -1)))
+                               (search-forward "%" (save-excursion (end-of-line) (point)) t)
+                               (= (+ 1 col) (current-column)))
+                      (setq beg (- (point) 1)))
+                    (when (= done 0)
+                      (forward-line 1))
+                    ;; Go forward
+                    (goto-char lit-limits-b)
+                    (beginning-of-line)
+                    (while (and (zerop (forward-line 1))
+                                (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t)
+                                (= (+ 1 col) (current-column)))
+                      (setq end (save-excursion (end-of-line) (point))))
+                    (list beg end lit-type))
+                (list lit-limits-b lit-limits-e lit-type)
+                )
+            (error (list lit-limits-b lit-limits-e lit-type))))
+        ))))
+
+(defun prolog-guess-fill-prefix ()
+  ;; fill 'txt entities?
+  (when (save-excursion
+          (end-of-line)
+          (equal (prolog-in-string-or-comment) 'cmt))
+    (let* ((bounds (prolog-comment-limits))
+           (cbeg (car bounds))
+           (type (nth 2 bounds))
+           beg end)
+      (save-excursion
+        (end-of-line)
+        (setq end (point))
+        (beginning-of-line)
+        (setq beg (point))
+        (if (and (eq type 'line)
+                 (> cbeg beg)
+                 (save-excursion (not (search-forward-regexp "^[ \t]*%"
+                                                             cbeg t))))
+            (progn
+              (goto-char cbeg)
+              (search-forward-regexp "%+[ \t]*" end t)
+              (prolog-replace-in-string (buffer-substring beg (point))
+                                        "[^ \t%]" " "))
+          ;(goto-char beg)
+          (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
+                                     end t)
+              (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
+            (beginning-of-line)
+            (when (search-forward-regexp "^[ \t]+" end t)
+              (buffer-substring beg (point)))))))))
+
+(defun prolog-fill-paragraph ()
+  "Fill paragraph comment at or after point."
+  (interactive)
+  (let* ((bounds (prolog-comment-limits))
+         (type (nth 2 bounds)))
+    (if (eq type 'line)
+        (let ((fill-prefix (prolog-guess-fill-prefix)))
+          (fill-paragraph nil))
+      (save-excursion
+        (save-restriction
+          ;; exclude surrounding lines that delimit a multiline comment
+          ;; and don't contain alphabetic characters, like "/*******",
+          ;; "- - - */" etc.
+          (save-excursion
+            (backward-paragraph)
+            (unless (bobp) (forward-line))
+            (if (string-match "^/\\*[^a-zA-Z]*$" (thing-at-point 'line))
+                (narrow-to-region (point-at-eol) (point-max))))
+          (save-excursion
+            (forward-paragraph)
+            (forward-line -1)
+            (if (string-match "^[^a-zA-Z]*\\*/$" (thing-at-point 'line))
+                (narrow-to-region (point-min) (point-at-bol))))
+          (let ((fill-prefix (prolog-guess-fill-prefix)))
+            (fill-paragraph nil))))
+      )))
+
+(defun prolog-do-auto-fill ()
+  "Carry out Auto Fill for Prolog mode.
+In effect it sets the `fill-prefix' when inside comments and then calls
+`do-auto-fill'."
+  (let ((fill-prefix (prolog-guess-fill-prefix)))
+    (do-auto-fill)
+    ))
+
+(defalias 'prolog-replace-in-string
+  (if (fboundp 'replace-in-string)
+      #'replace-in-string
+    (lambda (str regexp newtext &optional literal)
+      (replace-regexp-in-string regexp newtext str nil literal))))
+
+;;-------------------------------------------------------------------
+;; The tokenizer
+;;-------------------------------------------------------------------
+
+(defconst prolog-tokenize-searchkey
+  (concat "[0-9]+'"
+          "\\|"
+          "['\"]"
+          "\\|"
+          prolog-left-paren
+          "\\|"
+          prolog-right-paren
+          "\\|"
+          "%"
+          "\\|"
+          "/\\*"
+          ))
+
+(defun prolog-tokenize (beg end &optional stopcond)
+  "Tokenize a region of prolog code between BEG and END.
+STOPCOND decides the stop condition of the parsing.  Valid values
+are 'zerodepth which stops the parsing at the first right parenthesis
+where the parenthesis depth is zero, 'skipover which skips over
+the current entity (e.g. a list, a string, etc.) and nil.
+
+The function returns a list with the following information:
+ 0. parenthesis depth 
+ 3. 'atm if END is inside an atom
+    'str if END is inside a string
+    'chr if END is in a character code expression (0'x)
+    nil otherwise
+ 4. non-nil if END is inside a comment
+ 5. end position (always equal to END if STOPCOND is nil)
+The rest of the elements are undefined."
+  (save-excursion
+    (let* ((end2 (1+ end))
+           oldp
+           (depth 0)
+           (quoted nil)
+           inside_cmt
+           (endpos end2)
+           skiptype ; The type of entity we'll skip over
+           )
+      (goto-char beg)
+
+      (if (and (eq stopcond 'skipover)
+               (looking-at "[^[({'\"]"))
+          (setq endpos (point))                ; Stay where we are
+        (while (and
+                (re-search-forward prolog-tokenize-searchkey end2 t)
+                (< (point) end2))
+          (progn
+            (setq oldp (point))
+            (goto-char (match-beginning 0))
+            (cond
+             ;; Atoms and strings
+             ((looking-at "'")
+              ;; Find end of atom
+              (if (re-search-forward "[^\\]'" end2 'limit)
+                  ;; Found end of atom
+                  (progn
+                    (setq oldp end2)
+                    (if (and (eq stopcond 'skipover)
+                             (not skiptype))
+                        (setq endpos (point))
+                      (setq oldp (point)))) ; Continue tokenizing
+                (setq quoted 'atm)))
+           
+             ((looking-at "\"")
+              ;; Find end of string
+              (if (re-search-forward "[^\\]\"" end2 'limit)
+                  ;; Found end of string
+                  (progn
+                    (setq oldp end2)
+                    (if (and (eq stopcond 'skipover)
+                             (not skiptype))
+                        (setq endpos (point))
+                      (setq oldp (point)))) ; Continue tokenizing
+                (setq quoted 'str)))
+
+             ;; Paren stuff
+             ((looking-at prolog-left-paren)
+              (setq depth (1+ depth))
+              (setq skiptype 'paren))
+
+             ((looking-at prolog-right-paren)
+              (setq depth (1- depth))
+              (if (and
+                   (or (eq stopcond 'zerodepth)
+                       (and (eq stopcond 'skipover) 
+                            (eq skiptype 'paren)))
+                   (= depth 0))
+                  (progn
+                    (setq endpos (1+ (point)))
+                    (setq oldp end2))))
+
+             ;; Comment stuff
+             ((looking-at comment-start)
+              (end-of-line)
+              ;; (if (>= (point) end2)
+              (if (>= (point) end)
+                  (progn
+                    (setq inside_cmt t)
+                    (setq oldp end2))
+                (setq oldp (point))))
+
+             ((looking-at "/\\*")
+              (if (re-search-forward "\\*/" end2 'limit)
+                  (setq oldp (point))
+                (setq inside_cmt t)
+                (setq oldp end2)))
+
+             ;; 0'char
+             ((looking-at "0'")
+              (setq oldp (1+ (match-end 0)))
+              (if (> oldp end) 
+                  (setq quoted 'chr)))
+           
+             ;; base'number
+             ((looking-at "[0-9]+'")
+              (goto-char (match-end 0))
+              (skip-chars-forward "0-9a-zA-Z")
+              (setq oldp (point)))
+
+             
+             )
+            (goto-char oldp)
+            ))                                ; End of while
+        )
+
+      ;; Deal with multi-line comments
+      (and (prolog-inside-mline-comment end)
+           (setq inside_cmt t))
+
+      ;; Create return list
+      (list depth nil nil quoted inside_cmt endpos)
+      )))
+
+(defun prolog-inside-mline-comment (here)
+  (save-excursion
+    (goto-char here)
+    (let* ((next-close (save-excursion (search-forward "*/" nil t)))
+           (next-open  (save-excursion (search-forward "/*" nil t)))
+           (prev-open  (save-excursion (search-backward "/*" nil t)))
+           (prev-close (save-excursion (search-backward "*/" nil t)))
+           (unmatched-next-close (and next-close 
+                                      (or (not next-open)
+                                          (> next-open next-close))))
+           (unmatched-prev-open  (and prev-open
+                                      (or (not prev-close)
+                                          (> prev-open prev-close))))
+           )
+      (or unmatched-next-close unmatched-prev-open)
+      )))
+
+
+;;-------------------------------------------------------------------
+;; Online help
+;;-------------------------------------------------------------------
+
+(defvar prolog-help-function
+  '((mercury nil)
+    (eclipse prolog-help-online)
+    ;; (sicstus prolog-help-info)
+    (sicstus prolog-find-documentation)
+    (swi prolog-help-online)
+    (t prolog-help-online))
+  "Alist for the name of the function for finding help on a predicate.")
+
+(defun prolog-help-on-predicate ()
+  "Invoke online help on the atom under cursor."
+  (interactive)
+
+  (cond
+   ;; Redirect help for SICStus to `prolog-find-documentation'.
+   ((eq prolog-help-function-i 'prolog-find-documentation)
+    (prolog-find-documentation))
+
+   ;; Otherwise, ask for the predicate name and then call the function
+   ;; in prolog-help-function-i
+   (t
+    (let* (word
+           predicate
+           ;point
+           )
+      (setq word (prolog-atom-under-point))
+      (setq predicate (read-from-minibuffer
+                       (format "Help on predicate%s: "
+                               (if word
+                                   (concat " (default " word ")")
+                                 ""))))
+      (if (string= predicate "")
+          (setq predicate word))
+      (if prolog-help-function-i
+          (funcall prolog-help-function-i predicate)
+        (error "Sorry, no help method defined for this Prolog system."))))
+   ))
+
+(defun prolog-help-info (predicate)
+  (let ((buffer (current-buffer))
+        oldp
+        (str (concat "^\\* " (regexp-quote predicate) " */")))
+    (require 'info)
+    (pop-to-buffer nil)
+    (Info-goto-node prolog-info-predicate-index)
+    (if (not (re-search-forward str nil t))
+        (error (format "Help on predicate `%s' not found." predicate)))
+
+    (setq oldp (point))
+    (if (re-search-forward str nil t)
+        ;; Multiple matches, ask user
+        (let ((max 2)
+              n)
+          ;; Count matches
+          (while (re-search-forward str nil t)
+            (setq max (1+ max)))
+
+          (goto-char oldp)
+          (re-search-backward "[^ /]" nil t)
+          (recenter 0)
+          (setq n (read-string  ;; was read-input, which is obsolete
+                   (format "Several matches, choose (1-%d): " max) "1"))
+          (forward-line (- (string-to-number n) 1)))
+      ;; Single match
+      (re-search-backward "[^ /]" nil t))
+
+    ;; (Info-follow-nearest-node (point))
+    (prolog-Info-follow-nearest-node)
+    (re-search-forward (concat "^`" (regexp-quote predicate)) nil t)
+    (beginning-of-line)
+    (recenter 0)
+    (pop-to-buffer buffer)))
+
+(defun prolog-Info-follow-nearest-node ()
+  (if (featurep 'xemacs)
+      (Info-follow-nearest-node (point))
+    (Info-follow-nearest-node)))
+
+(defun prolog-help-online (predicate)
+  (prolog-ensure-process)
+  (process-send-string "prolog" (concat "help(" predicate ").\n"))
+  (display-buffer "*prolog*"))
+
+(defun prolog-help-apropos (string)
+  "Find Prolog apropos on given STRING.
+This function is only available when `prolog-system' is set to `swi'."
+  (interactive "sApropos: ")
+  (cond
+   ((eq prolog-system 'swi)
+    (prolog-ensure-process)
+    (process-send-string "prolog" (concat "apropos(" string ").\n"))
+    (display-buffer "*prolog*"))
+   (t
+    (error "Sorry, no Prolog apropos available for this Prolog system."))))
+
+(defun prolog-atom-under-point ()
+  "Return the atom under or left to the point."
+  (save-excursion
+    (let ((nonatom_chars "[](){},\. \t\n")
+          start)
+      (skip-chars-forward (concat "^" nonatom_chars))
+      (skip-chars-backward nonatom_chars)
+      (skip-chars-backward (concat "^" nonatom_chars))
+      (setq start (point))
+      (skip-chars-forward (concat "^" nonatom_chars))
+      (buffer-substring-no-properties start (point))
+      )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Help function with completion
+;; Stolen from Per Mildner's SICStus debugger mode and modified
+
+(defun prolog-find-documentation ()
+  "Go to the Info node for a predicate in the SICStus Info manual."
+  (interactive)
+  (let ((pred (prolog-read-predicate)))
+    (prolog-goto-predicate-info pred)))
+
+(defvar prolog-info-alist nil 
+  "Alist with all builtin predicates.
+Only for internal use by `prolog-find-documentation'")
+
+;; Very similar to prolog-help-info except that that function cannot
+;; cope with arity and that it asks the user if there are several
+;; functors with different arity. This function also uses
+;; prolog-info-alist for finding the info node, rather than parsing
+;; the predicate index.
+(defun prolog-goto-predicate-info (predicate)
+  "Go to the info page for PREDICATE, which is a PredSpec."
+  (interactive)
+  (require 'info)
+  (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate)
+  (let ((buffer (current-buffer))
+        (name (match-string 1 predicate))
+        (arity (match-string 2 predicate))
+        ;oldp
+        ;(str (regexp-quote predicate))
+        )
+    (setq arity (string-to-number arity))
+    (pop-to-buffer nil)
+
+    (Info-goto-node 
+     prolog-info-predicate-index) ;; We must be in the SICStus pages
+    (Info-goto-node (car (cdr (assoc predicate prolog-info-alist))))
+
+    (prolog-find-term (regexp-quote name) arity "^`")
+
+    (recenter 0)
+    (pop-to-buffer buffer))
+)
+
+(defun prolog-read-predicate ()
+  "Read a PredSpec from the user.
+Returned value is a string \"FUNCTOR/ARITY\".
+Interaction supports completion."
+  (let ((initial (prolog-atom-under-point))
+        answer)
+    ;; If the predicate index is not yet built, do it now 
+    (if (not prolog-info-alist) 
+        (prolog-build-info-alist))
+    ;; Test if the initial string could be the base for completion.
+    ;; Discard it if not.
+    (if (eq (try-completion initial prolog-info-alist) nil)
+        (setq initial ""))
+    ;; Read the PredSpec from the user
+    (setq answer (completing-read 
+                  "Help on predicate: "
+                  prolog-info-alist nil t initial))
+    (if (equal answer "")
+        initial
+      answer)))
+
+(defun prolog-build-info-alist (&optional verbose)
+  "Build an alist of all builtins and library predicates. 
+Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)).
+Typically there is just one Info node associated with each name
+If an optional argument VERBOSE is non-nil, print messages at the beginning
+and end of list building."
+  (if verbose
+      (message "Building info alist..."))
+  (setq prolog-info-alist
+        (let ((l ())
+              (last-entry (cons "" ())))
+          (save-excursion
+            (save-window-excursion
+              ;; select any window but the minibuffer (as we cannot switch
+              ;; buffers in minibuffer window.
+              ;; I am not sure this is the right/best way
+              (if (active-minibuffer-window)  ; nil if none active
+                  (select-window (next-window)))
+              ;; Do this after going away from minibuffer window
+              (save-window-excursion
+                (info))
+              (Info-goto-node prolog-info-predicate-index)
+              (goto-char (point-min))
+              (while (re-search-forward
+                      "^\\* \\(.+\\)/\\([0-9]+\\)\\([^\n:*]*\\):" nil t)
+                (let* ((name (match-string 1))
+                       (arity (string-to-number (match-string 2)))
+                       (comment (match-string 3))
+                       (fa (format "%s/%d%s" name arity comment))
+                       info-node)
+                  (beginning-of-line)
+                  ;; Extract the info node name
+                  (setq info-node (progn 
+                                    (re-search-forward ":[ \t]*\\([^:]+\\).$")
+                                    (match-string 1)
+                                   ))
+                  ;; ###### Easier? (from Milan version 0.1.28)
+                  ;; (setq info-node (Info-extract-menu-node-name))
+                  (if (equal fa (car last-entry))
+                      (setcdr last-entry (cons info-node (cdr last-entry)))
+                    (setq last-entry (cons fa (list info-node))
+                          l (cons last-entry l)))))
+              (nreverse l)
+              ))))
+  (if verbose
+      (message "Building info alist... done.")))
+
+
+;;-------------------------------------------------------------------
+;; Miscellaneous functions
+;;-------------------------------------------------------------------
+
+;; For Windows. Change backslash to slash. SICStus handles either
+;; path separator but backslash must be doubled, therefore use slash.
+(defun prolog-bsts (string)
+  "Change backslashes to slashes in STRING."
+  (let ((str1 (copy-sequence string))
+        (len (length string))
+        (i 0))
+    (while (< i len)
+      (if (char-equal (aref str1 i) ?\\)
+          (aset str1 i ?/))
+      (setq i (1+ i)))
+    str1))
+
+;(defun prolog-temporary-file ()
+;  "Make temporary file name for compilation."
+;  (make-temp-name 
+;   (concat 
+;    (or
+;     (getenv "TMPDIR")
+;     (getenv "TEMP") 
+;     (getenv "TMP")
+;     (getenv "SYSTEMP")
+;     "/tmp")
+;    "/prolcomp")))
+;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file)))
+
+(defun prolog-temporary-file ()
+  "Make temporary file name for compilation."
+  (if prolog-temporary-file-name
+      ;; We already have a file, erase content and continue
+      (progn
+        (write-region "" nil prolog-temporary-file-name nil 'silent)
+        prolog-temporary-file-name)
+    ;; Actually create the file and set `prolog-temporary-file-name' accordingly
+    (let* ((umask  (default-file-modes))
+           (temporary-file-directory (or
+                                      (getenv "TMPDIR")
+                                      (getenv "TEMP") 
+                                      (getenv "TMP")
+                                      (getenv "SYSTEMP")
+                                      "/tmp"))
+           (prefix (expand-file-name "prolcomp" temporary-file-directory))
+           (suffix ".pl")
+           file)
+      (unwind-protect
+          (progn
+            ;; Create temp files with strict access rights.
+            (set-default-file-modes #o700)
+            (while (condition-case ()
+                       (progn
+                         (setq file (concat (make-temp-name prefix) suffix))
+                         ;; (concat (make-temp-name "/tmp/prolcomp") ".pl")
+                         (unless (file-exists-p file)
+                           (write-region "" nil file nil 'silent))
+                         nil)
+                     (file-already-exists t))
+              ;; the file was somehow created by someone else between
+              ;; `make-temp-name' and `write-region', let's try again.
+              nil)
+            (setq prolog-temporary-file-name file))
+        ;; Reset the umask.
+        (set-default-file-modes umask)))    
+    ))
+
+(defun prolog-goto-prolog-process-buffer ()
+  "Switch to the prolog process buffer and go to its end."
+  (switch-to-buffer-other-window "*prolog*")
+  (goto-char (point-max))
+)
+
+(defun prolog-enable-sicstus-sd ()
+  "Enable the source level debugging facilities of SICStus 3.7 and later."
+  (interactive)
+  (require 'pltrace)  ; Load the SICStus debugger code
+  ;; Turn on the source level debugging by default
+  (add-hook 'prolog-inferior-mode-hook 'pltrace-on)
+  (if (not prolog-use-sicstus-sd)
+      (progn
+        ;; If there is a *prolog* buffer, then call pltrace-on
+        (if (get-buffer "*prolog*")
+            ;; Avoid compilation warnings by using eval
+            (eval '(pltrace-on)))
+        (setq prolog-use-sicstus-sd t)
+        )))
+
+(defun prolog-disable-sicstus-sd ()
+  "Disable the source level debugging facilities of SICStus 3.7 and later."
+  (interactive)
+  (setq prolog-use-sicstus-sd nil)
+  ;; Remove the hook
+  (remove-hook 'prolog-inferior-mode-hook 'pltrace-on)
+  ;; If there is a *prolog* buffer, then call pltrace-off
+  (if (get-buffer "*prolog*")
+      ;; Avoid compile warnings by using eval
+      (eval '(pltrace-off))))
+
+(defun prolog-debug-on (&optional arg)
+  "Enable debugging.
+When called with prefix argument ARG, disable debugging instead."
+  (interactive "P")
+  (if arg
+      (prolog-debug-off)
+    (prolog-process-insert-string (get-process "prolog")
+                                  prolog-debug-on-string)
+    (process-send-string "prolog" prolog-debug-on-string)))
+
+(defun prolog-debug-off ()
+  "Disable debugging."
+  (interactive)
+  (prolog-process-insert-string (get-process "prolog")
+                                prolog-debug-off-string)
+  (process-send-string "prolog" prolog-debug-off-string))
+
+(defun prolog-trace-on (&optional arg)
+  "Enable tracing.
+When called with prefix argument ARG, disable tracing instead."
+  (interactive "P")
+  (if arg
+      (prolog-trace-off)
+    (prolog-process-insert-string (get-process "prolog")
+                                  prolog-trace-on-string)
+    (process-send-string "prolog" prolog-trace-on-string)))
+
+(defun prolog-trace-off ()
+  "Disable tracing."
+  (interactive)
+  (prolog-process-insert-string (get-process "prolog")
+                                prolog-trace-off-string)
+  (process-send-string "prolog" prolog-trace-off-string))
+
+(defun prolog-zip-on (&optional arg)
+  "Enable zipping (for SICStus 3.7 and later).
+When called with prefix argument ARG, disable zipping instead."
+  (interactive "P")
+  (if arg
+      (prolog-zip-off)
+    (prolog-process-insert-string (get-process "prolog")
+                                  prolog-zip-on-string)
+    (process-send-string "prolog" prolog-zip-on-string)))
+
+(defun prolog-zip-off ()
+  "Disable zipping (for SICStus 3.7 and later)."
+  (interactive)
+  (prolog-process-insert-string (get-process "prolog")
+                                prolog-zip-off-string)
+  (process-send-string "prolog" prolog-zip-off-string))
+
+;; (defun prolog-create-predicate-index ()
+;;   "Create an index for all predicates in the buffer."
+;;   (let ((predlist '())
+;;         clauseinfo 
+;;         object
+;;         pos
+;;         )
+;;     (goto-char (point-min))
+;;     ;; Replace with prolog-clause-start!
+;;     (while (re-search-forward "^.+:-" nil t)
+;;       (setq pos (match-beginning 0))
+;;       (setq clauseinfo (prolog-clause-info))
+;;       (setq object (prolog-in-object))
+;;       (setq predlist (append
+;;                       predlist
+;;                       (list (cons 
+;;                              (if (and (eq prolog-system 'sicstus)
+;;                                       (prolog-in-object))
+;;                                  (format "%s::%s/%d" 
+;;                                          object
+;;                                          (nth 0 clauseinfo) 
+;;                                          (nth 1 clauseinfo))
+;;                                (format "%s/%d"
+;;                                        (nth 0 clauseinfo) 
+;;                                        (nth 1 clauseinfo)))
+;;                              pos
+;;                              ))))
+;;       (prolog-end-of-predicate))
+;;     predlist))
+
+(defun prolog-get-predspec ()
+  (save-excursion
+    (let ((state (prolog-clause-info))
+          (object (prolog-in-object)))
+      (if (or (equal (nth 0 state) "") (equal (prolog-in-string-or-comment) 'cmt))
+          nil
+        (if (and (eq prolog-system 'sicstus)
+                 object)
+            (format "%s::%s/%d" 
+                    object
+                    (nth 0 state) 
+                    (nth 1 state))
+          (format "%s/%d"
+                  (nth 0 state) 
+                  (nth 1 state)))
+        ))))
+
+;; For backward compatibility. Stolen from custom.el.
+(or (fboundp 'match-string)
+    ;; Introduced in Emacs 19.29.
+    (defun match-string (num &optional string)
+  "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+  (if (match-beginning num)
+      (if string
+          (substring string (match-beginning num) (match-end num))
+        (buffer-substring (match-beginning num) (match-end num))))))
+
+(defun prolog-pred-start ()
+  "Return the starting point of the first clause of the current predicate."
+  (save-excursion
+    (goto-char (prolog-clause-start))
+    ;; Find first clause, unless it was a directive
+    (if (and (not (looking-at "[:?]-"))
+             (not (looking-at "[ \t]*[%/]"))  ; Comment
+             
+             )
+        (let* ((pinfo (prolog-clause-info))
+               (predname (nth 0 pinfo))
+               (arity (nth 1 pinfo))
+               (op (point)))
+          (while (and (re-search-backward
+                       (format "^%s\\([(\\.]\\| *%s\\)" 
+                               predname prolog-head-delimiter) nil t)
+                      (= arity (nth 1 (prolog-clause-info)))
+                      )
+            (setq op (point)))
+          (if (eq prolog-system 'mercury)
+              ;; Skip to the beginning of declarations of the predicate
+              (progn
+                (goto-char (prolog-beginning-of-clause))
+                (while (and (not (eq (point) op))
+                            (looking-at
+                             (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+%s"
+                                     predname)))
+                  (setq op (point))
+                  (goto-char (prolog-beginning-of-clause)))))
+          op)
+      (point))))
+
+(defun prolog-pred-end ()
+  "Return the position at the end of the last clause of the current predicate."
+  (save-excursion
+    (goto-char (prolog-clause-end))        ; if we are before the first predicate
+    (goto-char (prolog-clause-start))
+    (let* ((pinfo (prolog-clause-info))
+          (predname (nth 0 pinfo))
+          (arity (nth 1 pinfo))
+          oldp
+          (notdone t)
+          (op (point)))
+      (if (looking-at "[:?]-")
+          ;; This was a directive
+          (progn
+            (if (and (eq prolog-system 'mercury)
+                     (looking-at
+                      (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+\\(%s+\\)"
+                              prolog-atom-regexp)))
+                ;; Skip predicate declarations
+                (progn
+                  (setq predname (buffer-substring-no-properties
+                                  (match-beginning 2) (match-end 2)))
+                  (while (re-search-forward
+                          (format
+                           "\n*\\(:-[ \t]*\\(pred\\|mode\\)[ \t]+\\)?%s[( \t]"
+                           predname)
+                          nil t))))
+            (goto-char (prolog-clause-end))
+            (setq op (point)))
+        ;; It was not a directive, find the last clause
+        (while (and notdone
+                    (re-search-forward
+                     (format "^%s\\([(\\.]\\| *%s\\)" 
+                             predname prolog-head-delimiter) nil t)
+                    (= arity (nth 1 (prolog-clause-info))))
+          (setq oldp (point))
+          (setq op (prolog-clause-end))
+          (if (>= oldp op)
+              ;; End of clause not found.
+              (setq notdone nil)
+            ;; Continue while loop
+            (goto-char op))))
+      op)))
+
+(defun prolog-clause-start (&optional not-allow-methods)
+  "Return the position at the start of the head of the current clause.
+If NOTALLOWMETHODS is non-nil then do not match on methods in
+objects (relevent only if 'prolog-system' is set to 'sicstus)."
+  (save-excursion
+    (let ((notdone t)
+          (retval (point-min)))
+      (end-of-line)
+      
+      ;; SICStus object?
+      (if (and (not not-allow-methods)
+               (eq prolog-system 'sicstus)
+               (prolog-in-object))
+          (while (and 
+                  notdone 
+                  ;; Search for a head or a fact
+                  (re-search-backward
+                   ;; If in object, then find method start.
+                   ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)" 
+                   "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes
+                                        ; problems since we cannot assume
+                                        ; that the line starts at column 0,
+                                        ; thus we don't know if the line
+                                        ; is a head or a subgoal
+                   (point-min) t))
+            (if (>= (prolog-paren-balance) 0) ; To no match on "   a) :-"
+                ;; Start of method found
+                (progn
+                  (setq retval (point))
+                  (setq notdone nil)))
+            )                                ; End of while
+
+        ;; Not in object
+        (while (and 
+                notdone 
+                ;; Search for a text at beginning of a line
+                ;; ######
+                ;; (re-search-backward "^[a-z$']" nil t))
+                (let ((case-fold-search nil))
+                  (re-search-backward
+                   ;; (format "^[%s$']" prolog-lower-case-string)
+                   ;; FIXME: Use [:lower:]
+                   (format "^\\([%s$']\\|[:?]-\\)" prolog-lower-case-string)
+                   nil t)))
+          (let ((bal (prolog-paren-balance)))
+            (cond
+             ((> bal 0)
+              ;; Start of clause found
+              (progn
+                (setq retval (point))
+                (setq notdone nil)))
+             ((and (= bal 0)
+                   (looking-at
+                    (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$" 
+                            prolog-head-delimiter)))
+              ;; Start of clause found if the line ends with a '.' or
+              ;; a prolog-head-delimiter
+              (progn
+                (setq retval (point))
+                (setq notdone nil))
+              )
+             (t nil) ; Do nothing
+             ))))
+                
+        retval)))
+
+(defun prolog-clause-end (&optional not-allow-methods)
+  "Return the position at the end of the current clause.
+If NOTALLOWMETHODS is non-nil then do not match on methods in
+objects (relevent only if 'prolog-system' is set to 'sicstus)."
+  (save-excursion
+    (beginning-of-line)                ; Necessary since we use "^...." for the search
+    (if (re-search-forward 
+         (if (and (not not-allow-methods)
+                  (eq prolog-system 'sicstus)
+                  (prolog-in-object))
+             (format
+              "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}"
+              prolog-quoted-atom-regexp prolog-string-regexp)
+           (format
+            "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$"
+            prolog-quoted-atom-regexp prolog-string-regexp))
+         nil t)
+        (if (and (prolog-in-string-or-comment)
+                 (not (eobp)))
+            (progn
+              (forward-char)
+              (prolog-clause-end))
+          (point))
+      (point))))
+
+(defun prolog-clause-info ()
+  "Return a (name arity) list for the current clause."
+  (let (predname (arity 0))
+    (save-excursion
+      (goto-char (prolog-clause-start))
+      (let ((op (point)))
+        (if (looking-at prolog-atom-char-regexp)
+            (progn
+              (skip-chars-forward "^ (\\.")
+              (setq predname (buffer-substring op (point))))
+          (setq predname ""))
+        ;; Retrieve the arity
+        (if (looking-at prolog-left-paren)
+            (let ((endp (save-excursion
+                          (prolog-forward-list) (point))))
+              (setq arity 1)
+              (forward-char 1)                ; Skip the opening paren
+              (while (progn
+                       (skip-chars-forward "^[({,'\"")
+                       (< (point) endp))
+                (if (looking-at ",")
+                    (progn
+                      (setq arity (1+ arity))
+                      (forward-char 1)        ; Skip the comma
+                      )
+                  ;; We found a string, list or something else we want
+                  ;; to skip over. Always use prolog-tokenize,
+                  ;; parse-partial-sexp does not have a 'skipover mode.
+                  (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover))))
+                )))
+        (list predname arity)
+        ))))
+
+(defun prolog-in-object ()
+  "Return object name if the point is inside a SICStus object definition."
+  ;; Return object name if the last line that starts with a character
+  ;; that is neither white space nor a comment start
+  (save-excursion
+    (if (save-excursion 
+          (beginning-of-line)
+          (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
+        ;; We were in the head of the object
+        (match-string 1)
+      ;; We were not in the head
+      (if (and (re-search-backward "^[a-z$'}]" nil t)
+               (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
+          (match-string 1)
+        nil))))
+
+(defun prolog-forward-list ()
+  "Move the point to the matching right parenthesis."
+  (interactive)
+  (if prolog-use-prolog-tokenizer-flag
+      (let ((state (prolog-tokenize (point) (point-max) 'zerodepth)))
+        (goto-char (nth 5 state)))
+    (forward-list)))
+
+;; NB: This could be done more efficiently!
+(defun prolog-backward-list ()
+  "Move the point to the matching left parenthesis."
+  (interactive)
+  (if prolog-use-prolog-tokenizer-flag
+      (let ((bal 0)
+            (paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren))
+            (notdone t))
+        (while (and notdone (re-search-backward paren-regexp nil t))
+          (cond
+           ((looking-at prolog-left-paren)
+            (if (not (prolog-in-string-or-comment))
+                (setq bal (1+ bal)))
+            (if (= bal 0)
+                (setq notdone nil)))
+           ((looking-at prolog-right-paren)
+            (if (not (prolog-in-string-or-comment))
+                (setq bal (1- bal))))
+           )))
+    (backward-list)))
+
+(defun prolog-beginning-of-clause ()
+  "Move to the beginning of current clause.
+If already at the beginning of clause, move to previous clause."
+  (interactive)
+  (let ((point (point))
+        (new-point (prolog-clause-start)))
+    (if (and (>= new-point point)
+             (> point 1))
+        (progn
+          (goto-char (1- point))
+          (goto-char (prolog-clause-start)))
+      (goto-char new-point)
+      (skip-chars-forward " \t"))))
+
+;; (defun prolog-previous-clause ()
+;;   "Move to the beginning of the previous clause."
+;;   (interactive)
+;;   (forward-char -1)
+;;   (prolog-beginning-of-clause))
+
+(defun prolog-end-of-clause ()
+  "Move to the end of clause.
+If already at the end of clause, move to next clause."
+  (interactive)
+  (let ((point (point))
+        (new-point (prolog-clause-end)))
+    (if (and (<= new-point point)
+             (not (eq new-point (point-max))))
+        (progn
+          (goto-char (1+ point))
+          (goto-char (prolog-clause-end)))
+      (goto-char new-point))))
+
+;; (defun prolog-next-clause ()
+;;   "Move to the beginning of the next clause."
+;;   (interactive)
+;;   (prolog-end-of-clause)
+;;   (forward-char)
+;;   (prolog-end-of-clause)
+;;   (prolog-beginning-of-clause))
+
+(defun prolog-beginning-of-predicate ()
+  "Go to the nearest beginning of predicate before current point.
+Return the final point or nil if no such a beginning was found."
+  (interactive)
+  (let ((op (point))
+        (pos (prolog-pred-start)))
+    (if pos
+        (if (= op pos)
+            (if (not (bobp))
+                (progn
+                  (goto-char pos)
+                  (backward-char 1)
+                  (setq pos (prolog-pred-start))
+                  (if pos
+                      (progn
+                        (goto-char pos)
+                        (point)))))
+          (goto-char pos)
+          (point)))))
+
+(defun prolog-end-of-predicate ()
+  "Go to the end of the current predicate."
+  (interactive)
+  (let ((op (point)))
+    (goto-char (prolog-pred-end))
+    (if (= op (point))
+        (progn
+          (forward-line 1)
+          (prolog-end-of-predicate)))))
+
+(defun prolog-insert-predspec ()
+  "Insert the predspec for the current predicate."
+  (interactive)
+  (let* ((pinfo (prolog-clause-info))
+         (predname (nth 0 pinfo))
+         (arity (nth 1 pinfo)))
+    (insert (format "%s/%d" predname arity))))
+
+(defun prolog-view-predspec ()
+  "Insert the predspec for the current predicate."
+  (interactive)
+  (let* ((pinfo (prolog-clause-info))
+         (predname (nth 0 pinfo))
+         (arity (nth 1 pinfo)))
+    (message (format "%s/%d" predname arity))))
+
+(defun prolog-insert-predicate-template ()
+  "Insert the template for the current clause."
+  (interactive)
+  (let* ((n 1)
+         oldp
+         (pinfo (prolog-clause-info))
+         (predname (nth 0 pinfo))
+         (arity (nth 1 pinfo)))
+    (insert predname)
+    (if (> arity 0)
+        (progn
+          (insert "(")
+          (when prolog-electric-dot-full-predicate-template
+            (setq oldp (point))
+            (while (< n arity)
+              (insert ",")
+              (setq n (1+ n)))
+            (insert ")")
+            (goto-char oldp))
+          ))
+  ))
+
+(defun prolog-insert-next-clause ()
+  "Insert newline and the name of the current clause."
+  (interactive)
+  (insert "\n")
+  (prolog-insert-predicate-template))
+
+(defun prolog-insert-module-modeline ()
+  "Insert a modeline for module specification.
+This line should be first in the buffer.
+The module name should be written manually just before the semi-colon."
+  (interactive)
+  (insert "%%% -*- Module: ; -*-\n")
+  (backward-char 6))
+
+(defalias 'prolog-uncomment-region
+  (if (fboundp 'uncomment-region) #'uncomment-region
+    (lambda (beg end)
+      "Uncomment the region between BEG and END."
+      (interactive "r")
+      (comment-region beg end -1))))
+
+(defun prolog-goto-comment-column (&optional nocreate)
+  "Move comments on the current line to the correct position.
+If NOCREATE is nil (or omitted) and there is no comment on the line, then
+a new comment is created."
+  (interactive)
+  (beginning-of-line)
+  (if (or (not nocreate)
+          (and
+           (re-search-forward 
+            (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *" 
+                    prolog-quoted-atom-regexp prolog-string-regexp)
+            (save-excursion (end-of-line) (point)) 'limit)
+           (progn
+             (goto-char (match-beginning 0))
+             (not (eq (prolog-in-string-or-comment) 'txt)))))
+      (indent-for-comment)))
+
+(defun prolog-indent-predicate ()
+  "*Indent the current predicate."
+  (interactive)
+  (indent-region (prolog-pred-start) (prolog-pred-end) nil))
+
+(defun prolog-indent-buffer ()
+  "*Indent the entire buffer."
+  (interactive)
+  (indent-region (point-min) (point-max) nil))
+
+(defun prolog-mark-clause ()
+  "Put mark at the end of this clause and move point to the beginning."
+  (interactive)
+  (let ((pos (point)))
+    (goto-char (prolog-clause-end))
+    (forward-line 1)
+    (beginning-of-line)
+    (set-mark (point))
+    (goto-char pos)
+    (goto-char (prolog-clause-start))))
+
+(defun prolog-mark-predicate ()
+  "Put mark at the end of this predicate and move point to the beginning."
+  (interactive)
+  (let (pos)
+    (goto-char (prolog-pred-end))
+    (setq pos (point))
+    (forward-line 1)
+    (beginning-of-line)
+    (set-mark (point))
+    (goto-char pos)
+    (goto-char (prolog-pred-start))))
+
+;; Stolen from `cc-mode.el':
+(defun prolog-electric-delete (arg)
+  "Delete preceding character or whitespace.
+If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
+consumed.  If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
+nil, or point is inside a literal then the function in the variable
+`backward-delete-char' is called."
+  (interactive "P")
+  (if (or (not prolog-hungry-delete-key-flag)
+          arg
+          (prolog-in-string-or-comment))
+      (funcall 'backward-delete-char (prefix-numeric-value arg))
+    (let ((here (point)))
+      (skip-chars-backward " \t\n")
+      (if (/= (point) here)
+          (delete-region (point) here)
+        (funcall 'backward-delete-char 1)
+        ))))
+
+;; For XEmacs compatibility (suggested by Per Mildner)
+(put 'prolog-electric-delete 'pending-delete 'supersede)
+
+(defun prolog-electric-if-then-else (arg)
+  "If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
+Bound to the >, ; and ( keys."
+  (interactive "P")
+  (self-insert-command (prefix-numeric-value arg))
+  (if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
+
+(defun prolog-electric-colon (arg)
+  "If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct.
+That is, insert space (if appropriate), `:-' and newline if colon is pressed
+at the end of a line that starts in the first column (i.e., clause
+heads)."
+  (interactive "P")
+  (if (and prolog-electric-colon-flag
+           (null arg)
+           (eolp)
+           ;(not (string-match "^\\s " (thing-at-point 'line))))
+           (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
+      (progn
+        (unless (save-excursion (backward-char 1) (looking-at "\\s "))
+          (insert " "))
+        (insert ":-\n")
+        (prolog-indent-line))
+    (self-insert-command (prefix-numeric-value arg))))
+
+(defun prolog-electric-dash (arg)
+  "If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct.
+that is, insert space (if appropriate), `-->' and newline if dash is pressed
+at the end of a line that starts in the first column (i.e., DCG
+heads)."
+  (interactive "P")
+  (if (and prolog-electric-dash-flag
+           (null arg)
+           (eolp)
+           ;(not (string-match "^\\s " (thing-at-point 'line))))
+           (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
+      (progn
+        (unless (save-excursion (backward-char 1) (looking-at "\\s "))
+          (insert " "))
+        (insert "-->\n")
+        (prolog-indent-line))
+    (self-insert-command (prefix-numeric-value arg))))
+
+(defun prolog-electric-dot (arg)
+  "Insert dot and newline or a head of a new clause.
+
+If `prolog-electric-dot-flag' is nil, then simply insert dot.
+Otherwise::
+When invoked at the end of nonempty line, insert dot and newline.
+When invoked at the end of an empty line, insert a recursive call to
+the current predicate.
+When invoked at the beginning of line, insert a head of a new clause
+of the current predicate.
+
+When called with prefix argument ARG, insert just dot."
+  (interactive "P")
+  ;; Check for situations when the electricity should not be active
+  (if (or (not prolog-electric-dot-flag)
+          arg
+          (prolog-in-string-or-comment)
+          ;; Do not be electric in a floating point number or an operator
+          (not 
+           (or
+            ;; (re-search-backward
+            ;; ######
+            ;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t)))
+            (save-excursion 
+              (re-search-backward
+               ;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t)))
+               "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" 
+               nil t))
+            (save-excursion 
+              (re-search-backward
+               ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
+               (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" 
+                       prolog-lower-case-string) ;FIXME: [:lower:]
+               nil t))
+              (save-excursion 
+              (re-search-backward
+               ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
+               (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" 
+                       prolog-upper-case-string) ;FIXME: [:upper:]
+               nil t))
+             )
+            )
+          ;; Do not be electric if inside a parenthesis pair.
+          (not (= (prolog-region-paren-balance (prolog-clause-start) (point))
+                  0))
+          )
+      (funcall 'self-insert-command (prefix-numeric-value arg))
+    (cond
+     ;; Beginning of line
+     ((bolp)
+      (prolog-insert-predicate-template))
+     ;; At an empty line with at least one whitespace
+     ((save-excursion
+        (beginning-of-line)
+        (looking-at "[ \t]+$"))
+      (prolog-insert-predicate-template)
+      (when prolog-electric-dot-full-predicate-template
+        (save-excursion 
+          (end-of-line)
+          (insert ".\n"))))      
+     ;; Default
+     (t
+      (insert ".\n"))
+     )))
+
+(defun prolog-electric-underscore ()
+  "Replace variable with an underscore.
+If `prolog-electric-underscore-flag' is non-nil and the point is
+on a variable then replace the variable with underscore and skip
+the following comma and whitespace, if any.
+If the point is not on a variable then insert underscore."
+  (interactive)
+  (if prolog-electric-underscore-flag
+      (let (;start
+            (oldcase case-fold-search)
+            (oldp (point)))
+        (setq case-fold-search nil)
+        ;; ######
+        ;;(skip-chars-backward "a-zA-Z_")
+        (skip-chars-backward
+         (format "%s%s_"
+                 ;; FIXME: Why not "a-zA-Z"?
+                 prolog-lower-case-string 
+                 prolog-upper-case-string))
+
+        ;(setq start (point))
+        (if (and (not (prolog-in-string-or-comment))
+                 ;; ######
+                 ;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>"))
+                 (looking-at (format "\\<[_%s][%s%s_0-9]*\\>" 
+                                     ;; FIXME: Use [:upper:] and friends.
+                                     prolog-upper-case-string
+                                     prolog-lower-case-string
+                                     prolog-upper-case-string)))
+            (progn
+              (replace-match "_")
+              (skip-chars-forward ", \t\n"))
+          (goto-char oldp)
+          (self-insert-command 1))
+        (setq case-fold-search oldcase)
+        )
+    (self-insert-command 1))
+  )
+
+
+(defun prolog-find-term (functor arity &optional prefix)
+  "Go to the position at the start of the next occurance of a term.
+The term is specified with FUNCTOR and ARITY.  The optional argument
+PREFIX is the prefix of the search regexp."
+  (let* (;; If prefix is not set then use the default "\\<"
+         (prefix (if (not prefix)
+                     "\\<"
+                   prefix))
+         (regexp (concat prefix functor))
+         (i 1))
+      
+    ;; Build regexp for the search if the arity is > 0
+    (if (= arity 0)
+        ;; Add that the functor must be at the end of a word. This
+        ;; does not work if the arity is > 0 since the closing )
+        ;; is not a word constituent.
+        (setq regexp (concat regexp "\\>"))
+      ;; Arity is > 0, add parens and commas
+      (setq regexp (concat regexp "("))
+      (while (< i arity)
+        (setq regexp (concat regexp ".+,"))
+        (setq i (1+ i)))
+      (setq regexp (concat regexp ".+)")))
+      
+    ;; Search, and return position
+    (if (re-search-forward regexp nil t)
+        (goto-char (match-beginning 0))
+      (error "Term not found"))
+    ))
+
+(defun prolog-variables-to-anonymous (beg end)
+  "Replace all variables within a region BEG to END by anonymous variables."
+  (interactive "r")
+  (save-excursion
+    (let ((oldcase case-fold-search))
+      (setq case-fold-search nil)
+      (goto-char end)
+      (while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t)
+        (progn
+          (replace-match "_")
+          (backward-char)))
+      (setq case-fold-search oldcase)
+      )))
+
+
+(defun prolog-set-atom-regexps ()
+  "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
+Must be called after `prolog-build-case-strings'."
+  (setq prolog-atom-char-regexp
+        (format "[%s%s0-9_$]" 
+                ;; FIXME: why not a-zA-Z?
+                prolog-lower-case-string 
+                prolog-upper-case-string))
+  (setq prolog-atom-regexp
+        (format "[%s$]%s*" 
+                prolog-lower-case-string 
+                prolog-atom-char-regexp))
+  )
+
+(defun prolog-build-case-strings ()
+  "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
+Uses the current case-table for extracting the relevant information."
+  (let ((up_string "")
+        (low_string ""))
+    ;; Use `map-char-table' if it is defined. Otherwise enumerate all
+    ;; numbers between 0 and 255. `map-char-table' is probably safer.
+    ;;
+    ;; `map-char-table' causes problems under Emacs 23.0.0.1, the 
+    ;; while loop seems to do its job well (Ryszard Szopa)
+    ;; 
+    ;;(if (and (not (featurep 'xemacs))
+    ;;          (fboundp 'map-char-table))
+    ;;    (map-char-table
+    ;;     (lambda (key value)
+    ;;       (cond 
+    ;;        ((and 
+    ;;          (eq (prolog-int-to-char key) (downcase key))
+    ;;          (eq (prolog-int-to-char key) (upcase key)))
+    ;;         ;; Do nothing if upper and lower case are the same
+    ;;         )
+    ;;        ((eq (prolog-int-to-char key) (downcase key))
+    ;;         ;; The char is lower case
+    ;;         (setq low_string (format "%s%c" low_string key)))
+    ;;        ((eq (prolog-int-to-char key) (upcase key))
+    ;;         ;; The char is upper case
+    ;;         (setq up_string (format "%s%c" up_string key)))
+    ;;        ))
+    ;;     (current-case-table))
+      ;; `map-char-table' was undefined.
+      (let ((key 0))
+        (while (< key 256)
+          (cond 
+           ((and 
+             (eq (prolog-int-to-char key) (downcase key))
+             (eq (prolog-int-to-char key) (upcase key)))
+            ;; Do nothing if upper and lower case are the same
+            )
+           ((eq (prolog-int-to-char key) (downcase key))
+            ;; The char is lower case
+            (setq low_string (format "%s%c" low_string key)))
+           ((eq (prolog-int-to-char key) (upcase key))
+            ;; The char is upper case
+            (setq up_string (format "%s%c" up_string key)))
+           )
+          (setq key (1+ key))))
+      ;; )
+      ;; The strings are single-byte strings
+      (setq prolog-upper-case-string (prolog-dash-letters up_string))
+      (setq prolog-lower-case-string (prolog-dash-letters low_string))
+      ))
+
+;(defun prolog-regexp-dash-continuous-chars (chars)
+;  (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
+;        (beg 0)
+;        (end 0))
+;    (if (null ints)
+;        chars
+;      (while (and (< (+ beg 1) (length chars))
+;                  (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
+;                           (= (nth beg ints) (nth (+ beg 1) ints)))))
+;        (setq beg (+ beg 1)))
+;      (setq beg (+ beg 1)
+;            end beg)
+;      (while (and (< (+ end 1) (length chars))
+;                  (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
+;                      (= (nth end ints) (nth (+ end 1) ints))))
+;        (setq end (+ end 1)))
+;      (if (equal (substring chars end) "")
+;          (substring chars 0 beg)
+;        (concat (substring chars 0 beg) "-" 
+;                (prolog-regexp-dash-continuous-chars (substring chars end))))
+;    )))
+
+(defun prolog-ints-intervals (ints)
+  "Return a list of intervals (from . to) covering INTS."
+  (when ints
+    (setq ints (sort ints '<))
+    (let ((prev (car ints))
+          (interval-start (car ints))
+          intervals)
+      (while ints
+        (let ((next (car ints)))
+          (when (> next (1+ prev))      ; start of new interval
+              (setq intervals (cons (cons interval-start prev) intervals))
+              (setq interval-start next))
+          (setq prev next)
+          (setq ints (cdr ints))))
+      (setq intervals (cons (cons interval-start prev) intervals))
+      (reverse intervals))))
+
+(defun prolog-dash-letters (string)
+  "Return a condensed regexp covering all letters in STRING."
+  (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
+                                                 (string-to-list string))))
+        codes)
+    (while intervals
+      (let* ((i (car intervals))
+             (from (car i))
+             (to (cdr i))
+             (c (cond ((= from to) `(,from))
+                      ((= (1+ from) to) `(,from ,to))
+                      (t `(,from ?- ,to)))))
+        (setq codes (cons c codes)))
+      (setq intervals (cdr intervals)))
+    (apply 'concat (reverse codes))))
+
+;(defun prolog-condense-character-sets (regexp)
+;  "Condense adjacent characters in character sets of REGEXP."
+;  (let ((next -1))
+;    (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
+;      (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
+;                                 t t regexp 1))))
+;  regexp)
+
+;; GNU Emacs compatibility: GNU Emacs does not differentiate between
+;; ints and chars, or at least these two are interchangeable.
+(defalias 'prolog-int-to-char
+  (if (fboundp 'int-to-char) #'int-to-char #'identity))
+
+(defalias 'prolog-char-to-int
+  (if (fboundp 'char-to-int) #'char-to-int #'identity))
+
+;;-------------------------------------------------------------------
+;; Menu stuff (both for the editing buffer and for the inferior
+;; prolog buffer)
+;;-------------------------------------------------------------------
+
+(unless (fboundp 'region-exists-p)
+  (defun region-exists-p ()
+    "Non-nil iff the mark is set.  Lobotomized version for Emacsen that do not provide their own."
+    (mark)))
+
+(defun prolog-menu ()
+  "Create the menus for the Prolog editing buffers.
+These menus are dynamically created because one may change systems
+during the life of an Emacs session, and because GNU Emacs wants them
+so by ignoring `easy-menu-add'."
+
+  ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus
+  ;; are defined _is_ important!
+
+  (easy-menu-define 
+   prolog-edit-menu-help (current-local-map)
+   "Help menu for the Prolog mode."
+   (append
+    (if (featurep 'xemacs) '("Help") '("Prolog-help"))
+    (cond
+     ((eq prolog-system 'sicstus)
+      '(["On predicate" prolog-help-on-predicate t]
+        "---"))
+     ((eq prolog-system 'swi)
+      '(["On predicate" prolog-help-on-predicate t]
+        ["Apropos" prolog-help-apropos t]
+        "---")))
+    '(["Describe mode" describe-mode t])))
+
+  (easy-menu-define 
+   prolog-edit-menu-runtime (current-local-map) 
+   "Runtime Prolog commands available from the editing buffer"
+   (append 
+    ;; runtime menu name
+    (list (cond ((eq prolog-system 'eclipse) 
+                 "ECLiPSe")
+                ((eq prolog-system 'mercury) 
+                 "Mercury")
+                (t
+                 "Prolog")))
+    ;; consult items, NIL for mercury
+    (unless (eq prolog-system 'mercury)
+      '("---"
+        ["Consult file" prolog-consult-file t]
+        ["Consult buffer" prolog-consult-buffer t]
+        ["Consult region" prolog-consult-region (region-exists-p)]
+        ["Consult predicate" prolog-consult-predicate t]
+        ))
+    ;; compile items, NIL for everything but SICSTUS
+    (when (eq prolog-system 'sicstus)
+      '("---"
+        ["Compile file" prolog-compile-file t]
+        ["Compile buffer" prolog-compile-buffer t]
+        ["Compile region" prolog-compile-region (region-exists-p)]
+        ["Compile predicate" prolog-compile-predicate t]
+        ))
+    ;; debug items, NIL for mercury
+    (cond 
+     ((eq prolog-system 'sicstus) 
+      ;; In SICStus, these are pairwise disjunctive,
+      ;; so it's enough with one "off"-command
+      (if (prolog-atleast-version '(3 . 7))
+          (list "---"
+                ["Debug" prolog-debug-on t]
+                ["Trace" prolog-trace-on t]
+                ["Zip" prolog-zip-on t]
+                ["All debug off" prolog-debug-off t]
+                '("Source level debugging"
+                  ["Enable" prolog-enable-sicstus-sd t]
+                  ["Disable" prolog-disable-sicstus-sd t]))
+        (list "---"
+              ["Debug" prolog-debug-on t]
+              ["Trace" prolog-trace-on t]
+              ["All debug off" prolog-debug-off t])))
+     ((not (eq prolog-system 'mercury))
+      '("---"
+        ["Debug" prolog-debug-on t]
+        ["Debug off" prolog-debug-off t]
+        ["Trace" prolog-trace-on t]
+        ["Trace off" prolog-trace-off t]))
+     ;; default (mercury) nil
+     )
+    (list "---"
+          (if (featurep 'xemacs)
+              [(concat "Run " (cond ((eq prolog-system 'eclipse) "ECLiPSe")
+                                    ((eq prolog-system 'mercury) "Mercury")
+                                    (t "Prolog")))
+               run-prolog t]
+            ["Run Prolog" run-prolog t]))))
+
+  (easy-menu-define 
+    prolog-edit-menu-insert-move (current-local-map) 
+    "Commands for Prolog code manipulation."
+    (append
+     (list "Code"
+           ["Comment region" comment-region (region-exists-p)]
+           ["Uncomment region" prolog-uncomment-region (region-exists-p)]
+           ["Add comment/move to comment" indent-for-comment t])
+     (unless (eq prolog-system 'mercury)
+       (list ["Convert variables in region to '_'" prolog-variables-to-anonymous (region-exists-p)]))
+     (list "---"
+           ["Insert predicate template" prolog-insert-predicate-template t]
+           ["Insert next clause head" prolog-insert-next-clause t]
+           ["Insert predicate spec" prolog-insert-predspec t]
+           ["Insert module modeline" prolog-insert-module-modeline t]
+           "---"
+           ["Beginning of clause" prolog-beginning-of-clause t]
+           ["End of clause" prolog-end-of-clause t]
+           ["Beginning of predicate" prolog-beginning-of-predicate t]
+           ["End of predicate" prolog-end-of-predicate t]
+           "---"
+           ["Indent line" prolog-indent-line t]
+           ["Indent region" indent-region (region-exists-p)]
+           ["Indent predicate" prolog-indent-predicate t]
+           ["Indent buffer" prolog-indent-buffer t]
+           ["Align region" align (region-exists-p)]
+           "---"
+           ["Mark clause" prolog-mark-clause t]
+           ["Mark predicate" prolog-mark-predicate t]
+           ["Mark paragraph" mark-paragraph t]
+           ;"---"
+           ;["Fontify buffer" font-lock-fontify-buffer t]
+           )))
+
+  (easy-menu-add prolog-edit-menu-insert-move)
+  (easy-menu-add prolog-edit-menu-runtime)
+
+  ;; Add predicate index menu
+  ;(make-variable-buffer-local 'imenu-create-index-function)
+  (make-local-variable 'imenu-create-index-function)
+  (setq imenu-create-index-function 'imenu-default-create-index-function)
+  ;;Milan (this has problems with object methods...)  ###### Does it? (Stefan)
+  (setq imenu-prev-index-position-function 'prolog-beginning-of-predicate)
+  (setq imenu-extract-index-name-function 'prolog-get-predspec)
+  
+  (if (and prolog-imenu-flag
+           (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
+      (imenu-add-to-menubar "Predicates"))
+  
+  (easy-menu-add prolog-edit-menu-help))
+
+(defun prolog-inferior-menu ()
+  "Create the menus for the Prolog inferior buffer.
+This menu is dynamically created because one may change systems during
+the life of an Emacs session."
+
+  (easy-menu-define 
+   prolog-inferior-menu-help (current-local-map)
+   "Help menu for the Prolog inferior mode."
+   (append
+    (if (featurep 'xemacs) '("Help") '("Prolog-help"))
+    (cond
+     ((eq prolog-system 'sicstus)
+      '(["On predicate" prolog-help-on-predicate t]
+        "---"))
+     ((eq prolog-system 'swi)
+      '(["On predicate" prolog-help-on-predicate t]
+        ["Apropos" prolog-help-apropos t]
+        "---")))
+    '(["Describe mode" describe-mode t])))
+
+  (easy-menu-define
+   prolog-inferior-menu-all (current-local-map)
+   "Menu for the inferior Prolog buffer."
+   (append
+    ;; menu name
+    (list (cond ((eq prolog-system 'eclipse) 
+                 "ECLiPSe")
+                ((eq prolog-system 'mercury) 
+                 "Mercury")
+                (t
+                 "Prolog")))
+    ;; debug items, NIL for mercury
+    (cond 
+     ((eq prolog-system 'sicstus) 
+      ;; In SICStus, these are pairwise disjunctive,
+      ;; so it's enough with one "off"-command
+      (if (prolog-atleast-version '(3 . 7))
+          (list "---"
+                ["Debug" prolog-debug-on t]
+                ["Trace" prolog-trace-on t]
+                ["Zip" prolog-zip-on t]
+                ["All debug off" prolog-debug-off t]
+                '("Source level debugging"
+                  ["Enable" prolog-enable-sicstus-sd t]
+                  ["Disable" prolog-disable-sicstus-sd t]))
+        (list "---"
+              ["Debug" prolog-debug-on t]
+              ["Trace" prolog-trace-on t]
+              ["All debug off" prolog-debug-off t])))
+     ((not (eq prolog-system 'mercury))
+      '("---"
+        ["Debug" prolog-debug-on t]
+        ["Debug off" prolog-debug-off t]
+        ["Trace" prolog-trace-on t]
+        ["Trace off" prolog-trace-off t]))
+     ;; default (mercury) nil
+     )
+    ;; runtime
+    '("---"
+      ["Interrupt Prolog" comint-interrupt-subjob t]
+      ["Quit Prolog" comint-quit-subjob t]
+      ["Kill Prolog" comint-kill-subjob t])
+    ))
+
+  (easy-menu-add prolog-inferior-menu-all)
+  (easy-menu-add prolog-inferior-menu-help))
+
+(add-hook 'prolog-mode-hook 'prolog-menu) ;FIXME.
+(add-hook 'prolog-inferior-mode-hook 'prolog-inferior-menu) ;FIXME.
+
+(defun prolog-mode-version ()
+  "Echo the current version of Prolog mode in the minibuffer."
+  (interactive)
+  (message "Using Prolog mode version %s" prolog-mode-version))
 
 (provide 'prolog)
 
diff --git a/lisp/subr.el b/lisp/subr.el
index 0f65fb7fbb0..293d71b8915 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,7 +1,7 @@
 ;;; subr.el --- basic lisp subroutines for Emacs
 
 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -60,7 +60,7 @@ function-definitions that `check-declare' does not recognize, e.g.
 `defstruct'.
 
 To specify a value for FILEONLY without passing an argument list,
-set ARGLIST to `t'.  This is necessary because `nil' means an
+set ARGLIST to t.  This is necessary because nil means an
 empty argument list, rather than an unspecified one.
 
 Note that for the purposes of `check-declare', this statement
@@ -483,6 +483,7 @@ saving keyboard macros (see `edmacro-mode')."
   (read-kbd-macro keys))
 
 (defun undefined ()
+  "Beep to tell the user this binding is undefined."
   (interactive)
   (ding))
 
@@ -1599,11 +1600,7 @@ extension for a compressed format \(e.g. \".gz\") on FILE will not affect
 this name matching.
 
 Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
-is evaluated whenever that feature is `provide'd.  Note that although
-provide statements are usually at the end of files, this is not always
-the case (e.g., sometimes they are at the start to avoid a recursive
-load error).  If your FORM should not be evaluated until the code in
-FILE has been, do not use the symbol form for FILE in such cases.
+is evaluated at the end of any file that `provide's this feature.
 
 Usually FILE is just a library name like \"font-lock\" or a feature name
 like 'font-lock.
@@ -1612,11 +1609,27 @@ This function makes or adds to an entry on `after-load-alist'."
   ;; Add this FORM into after-load-alist (regardless of whether we'll be
   ;; evaluating it now).
   (let* ((regexp-or-feature
-          (if (stringp file) (setq file (purecopy (load-history-regexp file))) file))
+          (if (stringp file)
+              (setq file (purecopy (load-history-regexp file)))
+            file))
          (elt (assoc regexp-or-feature after-load-alist)))
     (unless elt
       (setq elt (list regexp-or-feature))
       (push elt after-load-alist))
+    (when (symbolp regexp-or-feature)
+      ;; For features, the after-load-alist elements get run when `provide' is
+      ;; called rather than at the end of the file.  So add an indirection to
+      ;; make sure that `form' is really run "after-load" in case the provide
+      ;; call happens early.
+      (setq form
+            `(when load-file-name
+               (let ((fun (make-symbol "eval-after-load-helper")))
+                 (fset fun `(lambda (file)
+                              (if (not (equal file ',load-file-name))
+                                  nil
+                                (remove-hook 'after-load-functions ',fun)
+                                ,',form)))
+                 (add-hook 'after-load-functions fun)))))
     ;; Add FORM to the element unless it's already there.
     (unless (member form (cdr elt))
       (nconc elt (purecopy (list form))))
@@ -1872,7 +1885,7 @@ This function echoes `.' for each character that the user types.
 The user ends with RET, LFD, or ESC.  DEL or C-h rubs out.
 C-y yanks the current kill.  C-u kills line.
 C-g quits; if `inhibit-quit' was non-nil around this function,
-then it returns nil if the user types C-g, but quit-flag remains set.
+then it returns nil if the user types C-g, but `quit-flag' remains set.
 
 Once the caller uses the password, it can erase the password
 by doing (clear-string STRING)."
@@ -1985,7 +1998,7 @@ keyboard-quit events while waiting for a valid input."
       (unless (get-text-property 0 'face prompt)
         (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
       (setq char (let ((inhibit-quit inhibit-keyboard-quit))
-                   (read-event prompt)))
+                   (read-key prompt)))
       (cond
        ((not (numberp char)))
        ((memq char chars)
@@ -2043,8 +2056,11 @@ floating point support."
 
 (defun y-or-n-p (prompt &rest args)
   "Ask user a \"y or n\" question.  Return t if answer is \"y\".
-The argument PROMPT is the string to display to ask the question.
-It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
+The string to display to ask the question is obtained by
+formatting the string PROMPT with arguments ARGS (see `format').
+The result should end in a space; `y-or-n-p' adds \"(y or n) \"
+to it.
+
 No confirmation of the answer is requested; a single character is enough.
 Also accepts Space to mean yes, or Delete to mean no.  \(Actually, it uses
 the bindings in `query-replace-map'; see the documentation of that variable
@@ -2493,7 +2509,7 @@ Replaces `category' properties with their defined properties."
 (defvar yank-undo-function)
 
 (defun insert-for-yank (string)
-  "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
+  "Call `insert-for-yank-1' repetitively for each `yank-handler' segment.
 
 See `insert-for-yank-1' for more details."
   (let (to)
@@ -3177,7 +3193,7 @@ is non-nil, start replacements at that index in STRING.
 REP is either a string used as the NEWTEXT arg of `replace-match' or a
 function.  If it is a function, it is called with the actual text of each
 match, and its value is used as the replacement text.  When REP is called,
-the match-data are the result of matching REGEXP against a substring
+the match data are the result of matching REGEXP against a substring
 of STRING.
 
 To replace only the first match (if any), make REGEXP match up to \\'
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index fa16381bf29..51d13fe3920 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -254,7 +254,7 @@ holds a keymap."
   (tool-bar-add-item-from-menu 'save-buffer "save" nil
                                :label "Save")
   (define-key-after (default-value 'tool-bar-map) [separator-1] menu-bar-separator)
-  (tool-bar-add-item-from-menu 'undo "undo" nil :vert-only t)
+  (tool-bar-add-item-from-menu 'undo "undo" nil)
   (define-key-after (default-value 'tool-bar-map) [separator-2] menu-bar-separator)
   (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut])
                                "cut" nil :vert-only t)
@@ -263,25 +263,22 @@ holds a keymap."
   (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
                                "paste" nil :vert-only t)
   (define-key-after (default-value 'tool-bar-map) [separator-3] menu-bar-separator)
-  (tool-bar-add-item-from-menu 'nonincremental-search-forward "search"
-                               nil :label "Search")
+  (tool-bar-add-item-from-menu 'isearch-forward "search"
+                               nil :label "Search" :vert-only t)
   ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
 
   ;; There's no icon appropriate for News and we need a command rather
   ;; than a lambda for Read Mail.
   ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose")
 
-
-  ;; tool-bar-add-item-from-menu itself operates on
-  ;; (default-value 'tool-bar-map), but when we don't use that function,
-  ;; we must explicitly operate on the default value.
-
-  (let ((tool-bar-map (default-value 'tool-bar-map)))
-    (tool-bar-add-item "help" (lambda ()
-                                (interactive)
-                                (popup-menu menu-bar-help-menu))
-                       'help
-                       :help "Pop up the Help menu")))
+  ;; Help button on a tool bar is rather non-standard...
+  ;; (let ((tool-bar-map (default-value 'tool-bar-map)))
+  ;;   (tool-bar-add-item "help" (lambda ()
+  ;;                            (interactive)
+  ;;                            (popup-menu menu-bar-help-menu))
+  ;;                   'help
+  ;;                   :help "Pop up the Help menu"))
+)
 
 (if (featurep 'move-toolbar)
     (defcustom tool-bar-position 'top
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index cd40468199f..0335614a6ac 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -196,7 +196,7 @@ See `run-hooks'."
       '(menu-item "Show Incoming Log" vc-log-incoming
                   :help "Show a log of changes that will be received with a pull operation"))
     (define-key map [log]
-      '(menu-item "Show history" vc-print-log
+      '(menu-item "Show History" vc-print-log
                   :help "List the change log of the current file set in a window"))
     (define-key map [rlog]
       '(menu-item "Show Top of the Tree History " vc-print-root-log
@@ -307,33 +307,36 @@ If BODY uses EVENT, it should be a variable,
 
 (defvar vc-dir-tool-bar-map
   (let ((map (make-sparse-keymap)))
-    (tool-bar-local-item-from-menu 'vc-dir-find-file "open"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item "bookmark_add"
-                         'vc-dir-toggle-mark 'vc-dir-toggle-mark map
-                         :help "Toggle mark on current item"
-                         :label "Toggle Mark")
-    (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
-                                   map vc-dir-mode-map
-                                   :rtl "right-arrow")
-    (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
-                                   map vc-dir-mode-map
-                                   :rtl "left-arrow")
+    (tool-bar-local-item-from-menu 'find-file "new" map nil
+                                   :label "New File" :vert-only t)
+    (tool-bar-local-item-from-menu 'menu-find-file-existing "open" map nil
+                                   :label "Open" :vert-only t)
+    (tool-bar-local-item-from-menu 'dired "diropen" map nil
+                                   :vert-only t)
+    (tool-bar-local-item-from-menu 'quit-window "close" map vc-dir-mode-map
+                                   :vert-only t)
+    (tool-bar-local-item-from-menu 'vc-next-action "saveas" map
+                                   vc-dir-mode-map :label "Commit")
     (tool-bar-local-item-from-menu 'vc-print-log "info"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item-from-menu 'revert-buffer "refresh"
-                                   map vc-dir-mode-map)
-    (tool-bar-local-item-from-menu 'nonincremental-search-forward
-                                   "search" map nil
-                                   :label "Search")
-    (tool-bar-local-item-from-menu 'vc-dir-query-replace-regexp
-                                   "search-replace" map vc-dir-mode-map
-                                   :label "Replace")
+                                   map vc-dir-mode-map
+                                   :label "Log")
+    (define-key-after map [separator-1] menu-bar-separator)
     (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
                                    map vc-dir-mode-map
-                                   :label "Cancel")
-    (tool-bar-local-item-from-menu 'quit-window "exit"
-                                   map vc-dir-mode-map)
+                                   :label "Stop" :vert-only t)
+    (tool-bar-local-item-from-menu 'revert-buffer "refresh"
+                                   map vc-dir-mode-map :vert-only t)
+    (define-key-after map [separator-2] menu-bar-separator)
+    (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [cut])
+                                   "cut" map nil :vert-only t)
+    (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [copy])
+                                   "copy" map nil :vert-only t)
+    (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [paste])
+                                   "paste" map nil :vert-only t)
+    (define-key-after map [separator-3] menu-bar-separator)
+    (tool-bar-local-item-from-menu 'isearch-forward
+                                   "search" map nil
+                                   :label "Search" :vert-only t)
     map))
 
 (defun vc-dir-node-directory (node)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 5b6bc97db2c..f82039585b2 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -2162,21 +2162,13 @@ when he invoked the menu."
 
 (defun widget-toggle-value-create (widget)
   "Insert text representing the `on' and `off' states."
-  (if (widget-value widget)
-      (let ((image (widget-get widget :on-glyph)))
-        (and (display-graphic-p)
-             (listp image)
-             (not (eq (car image) 'image))
-             (widget-put widget :on-glyph (setq image (eval image))))
-        (widget-image-insert widget
-                             (widget-get widget :on)
-                             image))
-    (let ((image (widget-get widget :off-glyph)))
-      (and (display-graphic-p)
-           (listp image)
-           (not (eq (car image) 'image))
-           (widget-put widget :off-glyph (setq image (eval image))))
-      (widget-image-insert widget (widget-get widget :off) image))))
+  (let* ((val (widget-value widget))
+         (text (widget-get widget (if val :on :off)))
+         (img (widget-image-find
+               (widget-get widget (if val :on-glyph :off-glyph)))))
+    (widget-image-insert widget (or text "")
+                         (if img
+                             (append img '(:ascent center))))))
 
 (defun widget-toggle-action (widget &optional event)
   ;; Toggle value.
@@ -2816,34 +2808,22 @@ Return an alist of (TYPE MATCH)."
   "An indicator and manipulator for hidden items.
 
 The following properties have special meanings for this widget:
-:on-image  Image filename or spec to display when the item is visible.
+:on-glyph  Image filename or spec to display when the item is visible.
 :on        Text shown if the \"on\" image is nil or cannot be displayed.
-:off-image Image filename or spec to display when the item is hidden.
+:off-glyph Image filename or spec to display when the item is hidden.
 :off       Text shown if the \"off\" image is nil cannot be displayed."
   :format "%[%v%]"
   :button-prefix ""
   :button-suffix ""
-  :on-image "down"
+  :on-glyph "down"
   :on "Hide"
-  :off-image "right"
+  :off-glyph "right"
   :off "Show"
   :value-create 'widget-visibility-value-create
   :action 'widget-toggle-action
   :match (lambda (widget value) t))
 
-(defun widget-visibility-value-create (widget)
-  ;; Insert text representing the `on' and `off' states.
-  (let* ((val (widget-value widget))
-         (text (widget-get widget (if val :on :off)))
-         (img (widget-image-find
-               (widget-get widget (if val :on-image :off-image)))))
-    (widget-image-insert widget
-                         (if text
-                             (concat widget-push-button-prefix text
-                                     widget-push-button-suffix)
-                           "")
-                         (if img
-                             (append img '(:ascent center))))))
+(defalias 'widget-visibility-value-create 'widget-toggle-value-create)
 
 ;;; The `documentation-link' Widget.
 ;;
diff --git a/src/ChangeLog b/src/ChangeLog
index 353f9c2d64a..b68c375b4a6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,4 +1,4 @@
-2011-01-09  Paul Eggert  <eggert@cs.ucla.edu>
+2011-01-11  Paul Eggert  <eggert@cs.ucla.edu>
 
         Give a name FLOAT_TO_STRING_BUFSIZE to the constant 350.
         * lisp.h (FLOAT_TO_STRING_BUFSIZE): New macro.
@@ -27,14 +27,50 @@
         (float_to_string): Use dtoastr rather than rolling our own code,
         which had an off-by-one bug on non-IEEE hosts.
 
-2011-01-08  Paul Eggert  <eggert@cs.ucla.edu>
-
         Automate syncing from gnulib.
         * Makefile.in (lib): New macro.
         (ALL_CFLAGS): Add -I$(lib) -I$(srcdir)/../lib.
         ($(lib)/libgnu.a): New rule.
         (temacs$(EXEEXT)): Also link $(lib)/libgnu.a.
 
+2011-01-11  Tassilo Horn  <tassilo@member.fsf.org>
+
+        * image.c (imagemagick_load_image, Finit_image_library): Free
+        intermediate image after creating a MagickWand from it.  Terminate
+        MagickWand environment after image loading.
+
+2011-01-10  Michael Albinus  <michael.albinus@gmx.de>
+
+        * dbusbind.c (Fdbus_register_service): Raise an error in case of
+        unexpected return values.
+        (Fdbus_register_method): Remove connection initialization.
+
+2011-01-10  Jan Moringen  <jan.moringen@uni-bielefeld.de>
+
+        * dbusbind.c (QCdbus_request_name_allow_replacement): New symbol;
+        used by Fdbus_register_service.
+        (QCdbus_request_name_replace_existing): Likewise.
+        (QCdbus_request_name_do_not_queue): Likewise.
+        (QCdbus_request_name_reply_primary_owner): Likewise.
+        (QCdbus_request_name_reply_in_queue): Likewise.
+        (QCdbus_request_name_reply_exists): Likewise.
+        (QCdbus_request_name_reply_already_owner): Likewise.
+        (Fdbus_register_service): New function.
+        (Fdbus_register_method): Use Fdbus_register_service to do the name
+        registration.
+        (syms_of_dbusbind): Add symbols dbus-register-service,
+        :allow-replacement, :replace-existing, :do-not-queue,
+        :primary-owner, :existing, :in-queue and :already-owner.
+
+2011-01-09  Chong Yidong  <cyd@stupidchicken.com>
+
+        * gtkutil.c (update_frame_tool_bar): Don't advance tool-bar index
+        when removing extra buttons.
+
+2011-01-08  Chong Yidong  <cyd@stupidchicken.com>
+
+        * fns.c (Fyes_or_no_p): Doc fix.
+
 2011-01-08  Andreas Schwab  <schwab@linux-m68k.org>
 
         * fns.c (Fyes_or_no_p): Add usage.
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 4ef962d1507..0c59c08f5b7 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -38,6 +38,7 @@ Lisp_Object Qdbus_call_method_asynchronously;
 Lisp_Object Qdbus_method_return_internal;
 Lisp_Object Qdbus_method_error_internal;
 Lisp_Object Qdbus_send_signal;
+Lisp_Object Qdbus_register_service;
 Lisp_Object Qdbus_register_signal;
 Lisp_Object Qdbus_register_method;
 
@@ -50,6 +51,17 @@ Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
 /* Lisp symbol for method call timeout.  */
 Lisp_Object QCdbus_timeout;
 
+/* Lisp symbols for name request flags.  */
+Lisp_Object QCdbus_request_name_allow_replacement;
+Lisp_Object QCdbus_request_name_replace_existing;
+Lisp_Object QCdbus_request_name_do_not_queue;
+
+/* Lisp symbols for name request replies.  */
+Lisp_Object QCdbus_request_name_reply_primary_owner;
+Lisp_Object QCdbus_request_name_reply_in_queue;
+Lisp_Object QCdbus_request_name_reply_exists;
+Lisp_Object QCdbus_request_name_reply_already_owner;
+
 /* Lisp symbols of D-Bus types.  */
 Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
 Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@@ -1835,6 +1847,114 @@ xd_read_queued_messages (int fd, void *data, int for_read)
   xd_in_read_queued_messages = 0;
 }
 
+DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
+       2, MANY, 0,
+       doc: /* Register known name SERVICE on the D-Bus BUS.
+
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
+
+SERVICE is the D-Bus service name that should be registered.  It must
+be a known name.
+
+FLAGS are keywords, which control how the service name is registered.
+The following keywords are recognized:
+
+`:allow-replacement': Allow another service to become the primary
+owner if requested.
+
+`:replace-existing': Request to replace the current primary owner.
+
+`:do-not-queue': If we can not become the primary owner do not place
+us in the queue.
+
+The function returns a keyword, indicating the result of the
+operation.  One of the following keywords is returned:
+
+`:primary-owner': Service has become the primary owner of the
+requested name.
+
+`:in-queue': Service could not become the primary owner and has been
+placed in the queue.
+
+`:exists': Service is already in the queue.
+
+`:already-owner': Service is already the primary owner.
+
+Example:
+
+\(dbus-register-service :session dbus-service-emacs)
+
+  => :primary-owner.
+
+\(dbus-register-service
+  :session "org.freedesktop.TextEditor"
+  dbus-service-allow-replacement dbus-service-replace-existing)
+
+  => :already-owner.
+
+usage: (dbus-register-service BUS SERVICE &rest FLAGS)  */)
+  (int nargs, register Lisp_Object *args)
+{
+  Lisp_Object bus, service;
+  struct gcpro gcpro1, gcpro2;
+  DBusConnection *connection;
+  unsigned int i;
+  unsigned int value;
+  unsigned int flags = 0;
+  int result;
+  DBusError derror;
+
+  bus = args[0];
+  service = args[1];
+
+  /* Check parameters.  */
+  CHECK_STRING (service);
+
+  /* Process flags.  */
+  for (i = 2; i < nargs; ++i) {
+    value = ((EQ (args[i], QCdbus_request_name_replace_existing))
+             ? DBUS_NAME_FLAG_REPLACE_EXISTING
+             : (EQ (args[i], QCdbus_request_name_allow_replacement))
+             ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
+             : (EQ (args[i], QCdbus_request_name_do_not_queue))
+             ? DBUS_NAME_FLAG_DO_NOT_QUEUE
+             : -1);
+    if (value == -1)
+      XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
+    flags |= value;
+  }
+
+  /* Open a connection to the bus.  */
+  connection = xd_initialize (bus, TRUE);
+
+  /* Request the known name from the bus.  */
+  dbus_error_init (&derror);
+  result = dbus_bus_request_name (connection, SDATA (service), flags,
+                                  &derror);
+  if (dbus_error_is_set (&derror))
+    XD_ERROR (derror);
+
+  /* Cleanup.  */
+  dbus_error_free (&derror);
+
+  /* Return object.  */
+  switch (result)
+    {
+    case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
+      return QCdbus_request_name_reply_primary_owner;
+    case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
+      return QCdbus_request_name_reply_in_queue;
+    case DBUS_REQUEST_NAME_REPLY_EXISTS:
+      return QCdbus_request_name_reply_exists;
+    case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
+      return QCdbus_request_name_reply_already_owner;
+    default:
+      /* This should not happen.  */
+      XD_SIGNAL2 (build_string ("Could not register service"), service);
+    }
+}
+
 DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
        6, MANY, 0,
        doc: /* Register for signal SIGNAL on the D-Bus BUS.
@@ -2011,9 +2131,8 @@ discovering the still incomplete interface.*/)
    Lisp_Object dont_register_service)
 {
   Lisp_Object key, key1, value;
-  DBusConnection *connection;
-  int result;
   DBusError derror;
+  Lisp_Object args[2] = { bus, service };
 
   /* Check parameters.  */
   CHECK_STRING (service);
@@ -2025,21 +2144,9 @@ discovering the still incomplete interface.*/)
   /* TODO: We must check for a valid service name, otherwise there is
      a segmentation fault.  */
 
-  /* Open a connection to the bus.  */
-  connection = xd_initialize (bus, TRUE);
-
-  /* Request the known name from the bus.  We can ignore the result,
-     it is set to -1 if there is an error - kind of redundancy.  */
+  /* Request the name.  */
   if (NILP (dont_register_service))
-    {
-      dbus_error_init (&derror);
-      result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
-      if (dbus_error_is_set (&derror))
-        XD_ERROR (derror);
-
-      /* Cleanup.  */
-      dbus_error_free (&derror);
-    }
+    Fdbus_register_service (2, args);
 
   /* Create a hash table entry.  We use nil for the unique name,
      because the method might be called from anybody.  */
@@ -2091,6 +2198,10 @@ syms_of_dbusbind (void)
   staticpro (&Qdbus_send_signal);
   defsubr (&Sdbus_send_signal);
 
+  Qdbus_register_service = intern_c_string ("dbus-register-service");
+  staticpro (&Qdbus_register_service);
+  defsubr (&Sdbus_register_service);
+
   Qdbus_register_signal = intern_c_string ("dbus-register-signal");
   staticpro (&Qdbus_register_signal);
   defsubr (&Sdbus_register_signal);
@@ -2112,6 +2223,27 @@ syms_of_dbusbind (void)
   QCdbus_session_bus = intern_c_string (":session");
   staticpro (&QCdbus_session_bus);
 
+  QCdbus_request_name_allow_replacement = intern_c_string (":allow-replacement");
+  staticpro (&QCdbus_request_name_allow_replacement);
+
+  QCdbus_request_name_replace_existing = intern_c_string (":replace-existing");
+  staticpro (&QCdbus_request_name_replace_existing);
+
+  QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue");
+  staticpro (&QCdbus_request_name_do_not_queue);
+
+  QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner");
+  staticpro (&QCdbus_request_name_reply_primary_owner);
+
+  QCdbus_request_name_reply_exists = intern_c_string (":exists");
+  staticpro (&QCdbus_request_name_reply_exists);
+
+  QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue");
+  staticpro (&QCdbus_request_name_reply_in_queue);
+
+  QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner");
+  staticpro (&QCdbus_request_name_reply_already_owner);
+
   QCdbus_timeout = intern_c_string (":timeout");
   staticpro (&QCdbus_timeout);
 
diff --git a/src/fns.c b/src/fns.c
index 8fd5c7d291a..cd95f6c27fd 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2460,10 +2460,13 @@ do_yes_or_no_p (Lisp_Object prompt)
 
 DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, MANY, 0,
        doc: /* Ask user a yes-or-no question.  Return t if answer is yes.
-Takes one argument, which is the string to display to ask the question.
-It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
-The user must confirm the answer with RET,
-and can edit it until it has been confirmed.
+The string to display to ask the question is obtained by
+formatting the string PROMPT with arguments ARGS (see `format').
+The result should end in a space; `yes-or-no-p' adds
+\"(yes or no) \" to it.
+
+The user must confirm the answer with RET, and can edit it until it
+has been confirmed.
 
 Under a windowing system a dialog box will be used if `last-nonmenu-event'
 is nil, and `use-dialog-box' is non-nil.
diff --git a/src/gtkutil.c b/src/gtkutil.c
index fb003749493..905bbb1561d 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -4439,7 +4439,7 @@ update_frame_tool_bar (FRAME_PTR f)
   /* Remove buttons not longer needed.  */
   do
     {
-      ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), j++);
+      ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), j);
       if (ti)
         gtk_container_remove (GTK_CONTAINER (wtoolbar), GTK_WIDGET (ti));
     } while (ti != NULL);
diff --git a/src/image.c b/src/image.c
index bff56b5f961..1125309a9f7 100644
--- a/src/image.c
+++ b/src/image.c
@@ -7518,6 +7518,9 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
      image.  Interface :index is same as for GIF.  First we "ping" the
      image to see how many sub-images it contains. Pinging is faster
      than loading the image to find out things about it.  */
+
+  /* MagickWandGenesis() initializes the imagemagick library.  */
+  MagickWandGenesis ();
   image = image_spec_value (img->spec, QCindex, NULL);
   ino = INTEGERP (image) ? XFASTINT (image) : 0;
   ping_wand = NewMagickWand ();
@@ -7546,6 +7549,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
                     img->data.lisp_val));
 
   DestroyMagickWand (ping_wand);
+
   /* Now, after pinging, we know how many images are inside the
      file. If its not a bundle, just one.  */
 
@@ -7563,6 +7567,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
       if (im_image != NULL)
         {
           image_wand = NewMagickWandFromImage (im_image);
+          DestroyImage(im_image);
           status = MagickTrue;
         }
       else
@@ -7573,7 +7578,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
       image_wand = NewMagickWand ();
       status = MagickReadImageBlob (image_wand, contents, size);
     }
-  image_error ("im read failed", Qnil, Qnil);
+
   if (status == MagickFalse) goto imagemagick_error;
 
   /* If width and/or height is set in the display spec assume we want
@@ -7802,11 +7807,13 @@ imagemagick_load_image (/* Pointer to emacs frame structure.  */
 
   /* Final cleanup. image_wand should be the only resource left. */
   DestroyMagickWand (image_wand);
+  MagickWandTerminus ();
 
   return 1;
 
  imagemagick_error:
   DestroyMagickWand (image_wand);
+  MagickWandTerminus ();
   /* TODO more cleanup.  */
   image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
   return 0;
@@ -8678,8 +8685,6 @@ of `dynamic-library-alist', which see).  */)
 #if defined (HAVE_IMAGEMAGICK)
   if (EQ (type, Qimagemagick))
     {
-      /* MagickWandGenesis() initializes the imagemagick library.  */
-      MagickWandGenesis ();
       return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
                                   libraries);
     }