Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102824. ------------------------------------------------------------ revno: 102824 committer: Tassilo Horn branch nick: trunk timestamp: Wed 2011-01-12 08:35:04 +0100 message: Minor docfixes in imagemagick_load_image. diff: === modified file 'src/image.c' --- src/image.c 2011-01-11 20:14:13 +0000 +++ src/image.c 2011-01-12 07:35:04 +0000 @@ -7522,7 +7522,7 @@ 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' initializes the imagemagick environment. */ MagickWandGenesis (); image = image_spec_value (img->spec, QCindex, NULL); ino = INTEGERP (image) ? XFASTINT (image) : 0; @@ -7810,6 +7810,7 @@ /* Final cleanup. image_wand should be the only resource left. */ DestroyMagickWand (image_wand); + /* `MagickWandTerminus' terminates the imagemagick environment. */ MagickWandTerminus (); return 1; ------------------------------------------------------------ revno: 102823 committer: Glenn Morris branch nick: trunk timestamp: Tue 2011-01-11 20:28:12 -0800 message: * admin/bzrmerge.el: Standardize copyright and license headers. diff: === modified file 'admin/bzrmerge.el' --- admin/bzrmerge.el 2010-12-27 01:27:08 +0000 +++ admin/bzrmerge.el 2011-01-12 04:28:12 +0000 @@ -1,22 +1,22 @@ ;;; bzrmerge.el --- -;; Copyright (C) 2010 Stefan Monnier +;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -202,7 +202,7 @@ "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) ------------------------------------------------------------ revno: 102822 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Tue 2011-01-11 23:32:50 +0000 message: proto-stream.el (open-protocol-stream): Protect against the low-level transport functions returning nil. 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. 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. mm-decode.el (mm-preferred-alternative-precedence): Discourage showing empty parts. nnimap.el (nnimap-convert-partial-article): Protect against zero-length body parts. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-01-07 09:28:29 +0000 +++ lisp/gnus/ChangeLog 2011-01-11 23:32:50 +0000 @@ -1,3 +1,22 @@ +2011-01-11 Lars Magne Ingebrigtsen + + * 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 * mml2015.el (epg-sub-key-fingerprint): Autoload. === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-12-16 22:22:28 +0000 +++ lisp/gnus/gnus-int.el 2011-01-11 23:32:50 +0000 @@ -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 ;; Keywords: news @@ -711,7 +711,9 @@ (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)) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2011-01-02 11:23:02 +0000 +++ lisp/gnus/gnus-sum.el 2011-01-11 23:32:50 +0000 @@ -7687,9 +7687,6 @@ (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) === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2010-12-07 05:06:56 +0000 +++ lisp/gnus/mm-decode.el 2011-01-11 23:32:50 +0000 @@ -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 ;; MORIOKA Tomohiko @@ -1367,13 +1367,18 @@ (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." === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-01-02 23:17:32 +0000 +++ lisp/gnus/nnimap.el 2011-01-11 23:32:50 +0000 @@ -582,7 +582,7 @@ ;; 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))) === modified file 'lisp/gnus/proto-stream.el' --- lisp/gnus/proto-stream.el 2010-12-13 04:22:39 +0000 +++ lisp/gnus/proto-stream.el 2011-01-11 23:32:50 +0000 @@ -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 ;; Keywords: network @@ -101,14 +101,17 @@ (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))) ------------------------------------------------------------ revno: 102821 committer: Tassilo Horn branch nick: trunk timestamp: Tue 2011-01-11 21:14:13 +0100 message: * image.c (imagemagick_load_image, Finit_image_library): Free intermediate image after creating a MagickWand from it. Terminate MagickWand environment after image loading. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-01-10 11:28:31 +0000 +++ src/ChangeLog 2011-01-11 20:14:13 +0000 @@ -1,3 +1,9 @@ +2011-01-11 Tassilo Horn + + * 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 * dbusbind.c (Fdbus_register_service): Raise an error in case of === modified file 'src/image.c' --- src/image.c 2011-01-07 22:33:32 +0000 +++ src/image.c 2011-01-11 20:14:13 +0000 @@ -7521,6 +7521,9 @@ 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 (); @@ -7549,6 +7552,7 @@ 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. */ @@ -7566,6 +7570,7 @@ if (im_image != NULL) { image_wand = NewMagickWandFromImage (im_image); + DestroyImage(im_image); status = MagickTrue; } else @@ -7576,7 +7581,7 @@ 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 @@ -7805,11 +7810,13 @@ /* 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; @@ -8681,8 +8688,6 @@ #if defined (HAVE_IMAGEMAGICK) if (EQ (type, Qimagemagick)) { - /* MagickWandGenesis() initializes the imagemagick library. */ - MagickWandGenesis (); return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions, libraries); } ------------------------------------------------------------ revno: 102820 committer: Johan BockgÃ¥rd branch nick: trunk timestamp: Tue 2011-01-11 19:42:30 +0100 message: * lisp/emacs-lisp/unsafep.el (unsafep): Handle backquoted forms. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-11 05:07:32 +0000 +++ lisp/ChangeLog 2011-01-11 18:42:30 +0000 @@ -1,3 +1,7 @@ +2011-01-11 Johan BockgÃ¥rd + + * emacs-lisp/unsafep.el (unsafep): Handle backquoted forms. + 2011-01-11 Stefan Monnier * progmodes/prolog.el: Fix up coding convention and such. === modified file 'lisp/emacs-lisp/unsafep.el' --- lisp/emacs-lisp/unsafep.el 2010-10-18 17:28:20 +0000 +++ lisp/emacs-lisp/unsafep.el 2011-01-11 18:42:30 +0000 @@ -202,6 +202,9 @@ (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))))) ------------------------------------------------------------ revno: 102819 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2011-01-11 00:07:32 -0500 message: * lisp/progmodes/prolog.el: Fix up coding conventions 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. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-01-10 09:40:20 +0000 +++ etc/NEWS 2011-01-11 05:07:32 +0000 @@ -323,6 +323,10 @@ * 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. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-01-11 04:34:06 +0000 +++ lisp/ChangeLog 2011-01-11 05:07:32 +0000 @@ -1,3 +1,36 @@ +2011-01-11 Stefan Monnier + + * 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 * progmodes/prolog.el: Replace by a whole new file. === modified file 'lisp/progmodes/prolog.el' --- lisp/progmodes/prolog.el 2011-01-11 04:34:06 +0000 +++ lisp/progmodes/prolog.el 2011-01-11 05:07:32 +0000 @@ -1,6 +1,6 @@ -;; prolog.el --- major mode for editing and running Prolog (and Mercury) code +;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code -;; Copyright (C) 1986, 1987, 1997, 1998, 1999, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1987, 1997, 1998, 1999, 2002, 2003, 2011 Free Software Foundation, Inc. ;; Authors: Emil Åström ;; Milan Zamazal @@ -9,22 +9,22 @@ ;; Keywords: prolog major mode sicstus swi mercury (defvar prolog-mode-version "1.22" - "Prolog mode version number") - -;; This program is free software; you can redistribute it and/or modify + "Prolog mode version number.") + +;; This file is part of GNU Emacs. + +;; 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 2, or (at your option) -;; any later version. +;; 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;; Original author: Masanobu UMEDA ;; Parts of this file was taken from a modified version of the original @@ -52,7 +52,7 @@ ;; inferior Prolog process. ;; ;; The code requires the comint, easymenu, info, imenu, and font-lock -;; libraries. These are normally distributed with GNU Emacs and +;; libraries. These are normally distributed with GNU Emacs and ;; XEmacs. ;;; Installation: @@ -81,7 +81,7 @@ ;; ;; 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 +;; 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: @@ -154,7 +154,7 @@ ;; 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 +;; 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 @@ -205,7 +205,7 @@ ;; 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 +;; 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. @@ -240,7 +240,7 @@ ;; a(X). ;; and so is this (and variants): ;; a(X) :- b(X), -;; c(X). /* comment here. */ +;; c(X). /* comment here. */ ;; a(X). ;; Version 1.0: ;; o Revamped the menu system. @@ -358,7 +358,7 @@ ;; Indentation -(defcustom prolog-indent-width tab-width +(defcustom prolog-indent-width 4 "*The indentation width used by the editing buffer." :group 'prolog-indentation :type 'integer) @@ -405,7 +405,7 @@ "*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 + 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." @@ -477,7 +477,7 @@ ;; Keyboard -(defcustom prolog-electric-newline-flag t +(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) @@ -493,7 +493,7 @@ 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 +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 @@ -501,7 +501,7 @@ (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 +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 @@ -522,7 +522,7 @@ :type 'boolean) (defcustom prolog-electric-if-then-else-flag nil - "*Non-nil makes `(', `>' and `;' electric + "*Non-nil makes `(', `>' and `;' electric to automatically indent if-then-else constructs." :group 'prolog-keyboard :type 'boolean) @@ -586,7 +586,7 @@ `%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 +`%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 @@ -606,7 +606,7 @@ `%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 +`%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. @@ -669,13 +669,13 @@ (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 +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 +does contain bugs. The recommended setting for the novice user is non-nil for this variable." :group 'prolog-inferior :type 'boolean) @@ -717,6 +717,7 @@ :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' does not break syntax highlighting. This is really kludgy but I have not found any better way of handling it." :group 'prolog-other @@ -727,20 +728,39 @@ ;; Internal variables ;;------------------------------------------------------------------- -(defvar prolog-emacs - (if (string-match "XEmacs\\|Lucid" emacs-version) - 'xemacs - 'gnuemacs) - "The variant of Emacs we're running. -Valid values are 'gnuemacs and 'xemacs.") - -(defvar prolog-known-systems '(eclipse mercury sicstus swi gnu)) - -;(defvar prolog-temp-filename "") ; Later set by `prolog-temporary-file' - -(defvar prolog-mode-syntax-table nil) +;;(defvar prolog-temp-filename "") ; Later set by `prolog-temporary-file' + +(defvar prolog-mode-syntax-table + (let ((table (make-syntax-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 ?> "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table) + + ;; Any better way to handle the 0' 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-mode-map nil) (defvar prolog-upper-case-string "" "A string containing all upper case characters. Set by prolog-build-case-strings.") @@ -820,38 +840,6 @@ (<= (cdr version) thisminor))) )) -(if prolog-mode-syntax-table - () - (let ((table (make-syntax-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 ?> "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?\' "\"" table) - - ;; Any better way to handle the 0' construct?!? - (when prolog-char-quote-workaround - (modify-syntax-entry ?0 "\\" table)) - - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?\n ">" table) - (if (eq prolog-emacs '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) - ) - (setq prolog-mode-syntax-table table))) - (define-abbrev-table 'prolog-mode-abbrev-table ()) (defun prolog-find-value-by-system (alist) @@ -884,8 +872,6 @@ (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode t) (make-local-variable 'normal-auto-fill-function) (setq normal-auto-fill-function 'prolog-do-auto-fill) (make-local-variable 'indent-line-function) @@ -903,8 +889,6 @@ (make-local-variable 'comment-column) (make-local-variable 'comment-indent-function) (setq comment-indent-function 'prolog-comment-indent) - (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 @@ -916,7 +900,7 @@ prolog-help-function))) (while vars (set (intern (concat (symbol-name (car vars)) "-i")) - (prolog-find-value-by-system (eval (car vars)))) + (prolog-find-value-by-system (symbol-value (car vars)))) (setq vars (cdr vars)))) (when (null prolog-program-name-i) (make-local-variable 'compile-command) @@ -990,35 +974,32 @@ (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))) + (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. ) -(if prolog-mode-map - () - (setq prolog-mode-map (make-sparse-keymap)) - (prolog-mode-keybindings-common prolog-mode-map) - (prolog-mode-keybindings-edit prolog-mode-map) - ;; System dependent keymaps for system dependent menus - (let ((systems prolog-known-systems)) - (while systems - (set (intern (concat "prolog-mode-map-" - (symbol-name (car systems)))) - ;(cons 'keymap prolog-mode-map) - prolog-mode-map - ) - (setq systems (cdr systems)))) - ) +(defvar prolog-mode-map + (let ((map (make-sparse-keymap))) + (prolog-mode-keybindings-common map) + (prolog-mode-keybindings-edit map) + map)) (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 -(defun prolog-mode (&optional system) +(define-derived-mode prolog-mode prog-mode "Prolog" "Major mode for editing Prolog code. Blank lines and `%%...' separate paragraphs. `%'s starts a comment @@ -1033,27 +1014,13 @@ \\{prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' if that value is non-nil." - (interactive) - (kill-all-local-variables) - (if system (setq prolog-system system)) - (use-local-map - (if prolog-system - ;; ### Looks like it works under XEmacs as well... - ;; (and prolog-system - ;; (not (eq prolog-emacs 'xemacs))) - (eval (intern (concat "prolog-mode-map-" (symbol-name prolog-system)))) - prolog-mode-map) - ) - (setq major-mode 'prolog-mode) (setq mode-name (concat "Prolog" (cond ((eq prolog-system 'eclipse) "[ECLiPSe]") - ((eq prolog-system 'mercury) "[Mercury]") ((eq prolog-system 'sicstus) "[SICStus]") ((eq prolog-system 'swi) "[SWI]") ((eq prolog-system 'gnu) "[GNU]") (t "")))) - (set-syntax-table prolog-mode-syntax-table) (prolog-mode-variables) (prolog-build-case-strings) (prolog-set-atom-regexps) @@ -1065,27 +1032,34 @@ (if (and (eq prolog-system 'sicstus) (prolog-atleast-version '(3 . 7)) prolog-use-sicstus-sd) - (prolog-enable-sicstus-sd)) - - (run-mode-hooks 'prolog-mode-hook)) + (prolog-enable-sicstus-sd))) + +(defvar mercury-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map prolog-mode-map) + map)) ;;;###autoload -(defun mercury-mode () +(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" "Major mode for editing Mercury programs. Actually this is just customized `prolog-mode'." - (interactive) - (prolog-mode 'mercury)) + (set (make-local-variable 'prolog-system) 'mercury)) ;;------------------------------------------------------------------- ;; Inferior prolog mode ;;------------------------------------------------------------------- -(defvar prolog-inferior-mode-map nil) +(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.") -(defun prolog-inferior-mode () +(define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog" "Major mode for interacting with an inferior Prolog process. The following commands are available: @@ -1114,26 +1088,11 @@ To find out what version of Prolog mode you are running, enter `\\[prolog-mode-version]'." - (interactive) - (cond ((not (eq major-mode 'prolog-inferior-mode)) - (kill-all-local-variables) - (comint-mode) - (setq comint-input-filter 'prolog-input-filter) - (setq major-mode 'prolog-inferior-mode) - (setq mode-name "Inferior Prolog") - (setq mode-line-process '(": %s")) - (prolog-mode-variables) - (if prolog-inferior-mode-map - () - (setq prolog-inferior-mode-map (copy-keymap comint-mode-map)) - (prolog-mode-keybindings-common prolog-inferior-mode-map) - (prolog-mode-keybindings-inferior prolog-inferior-mode-map)) - (use-local-map prolog-inferior-mode-map) - (setq comint-prompt-regexp prolog-prompt-regexp-i) - ;(make-variable-buffer-local 'shell-dirstack-query) - (make-local-variable 'shell-dirstack-query) - (setq shell-dirstack-query "pwd.") - (run-hooks 'prolog-inferior-mode-hook)))) + (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 @@ -1173,8 +1132,7 @@ () (apply 'make-comint "prolog" prolog-program-name-i nil prolog-program-switches-i) - (save-excursion - (set-buffer "*prolog*") + (with-current-buffer "*prolog*" (prolog-inferior-mode) (if wait (progn @@ -1190,19 +1148,15 @@ (defun prolog-process-insert-string (process string) "Insert STRING into inferior Prolog buffer running PROCESS." ;; Copied from elisp manual, greek to me - (let ((buf (current-buffer))) - (unwind-protect - (let (moving) - (set-buffer (process-buffer process)) - (setq 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)))) - (set-buffer buf)))) - + (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 @@ -1416,8 +1370,7 @@ real-file first-line)) (process (get-process "prolog")) (old-filter (process-filter process))) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (delete-region (point-min) (point-max)) (compilation-mode) ;; Setting up font-locking for this buffer @@ -1441,8 +1394,7 @@ file buffer-file-name) nil real-file)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char (point-max)) (set-process-filter process 'prolog-consult-compile-filter) (process-send-string "prolog" command-string) @@ -1533,7 +1485,7 @@ (eq outputtype 'trace)) (let (input) (setq input (concat (read-string output) "\n")) - (process-send-string "prolog" input) + (process-send-string process input) (setq output (concat output input)))) ((eq prolog-system 'sicstus) @@ -2352,79 +2304,79 @@ ;;;; Comment filling (defun prolog-comment-limits () - "Returns the current comment limits plus the comment type (block or line). + "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)))) - )))) + (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? @@ -2434,7 +2386,7 @@ (let* ((bounds (prolog-comment-limits)) (cbeg (car bounds)) (type (nth 2 bounds)) - beg end str) + beg end) (save-excursion (end-of-line) (setq end (point)) @@ -2442,20 +2394,20 @@ (setq beg (point)) (if (and (eq type 'line) (> cbeg beg) - (save-excursion (not (search-forward-regexp "^[ \t]*%" cbeg t)))) + (save-excursion (not (search-forward-regexp "^[ \t]*%" + cbeg t)))) (progn (goto-char cbeg) (search-forward-regexp "%+[ \t]*" end t) - (setq str (replace-in-string (buffer-substring beg (point)) "[^ \t%]" " ")) - ) + (prolog-replace-in-string (buffer-substring beg (point)) + "[^ \t%]" " ")) ;(goto-char beg) - (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*" end t) - (setq str (replace-in-string (buffer-substring beg (point)) "/" " ")) + (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) - (setq str (buffer-substring beg (point))))) - )) - str))) + (buffer-substring beg (point))))))))) (defun prolog-fill-paragraph () "Fill paragraph comment at or after point." @@ -2486,45 +2438,17 @@ (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 +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) )) -(unless (fboundp 'replace-in-string) - (defun replace-in-string (str regexp newtext &optional literal) - "Replace all matches in STR for REGEXP with NEWTEXT string, - and returns the new string. -Optional LITERAL non-nil means do a literal replacement. -Otherwise treat `\\' in NEWTEXT as special: - `\\&' in NEWTEXT means substitute original matched text. - `\\N' means substitute what matched the Nth `\\(...\\)'. - If Nth parens didn't match, substitute nothing. - `\\\\' means insert one `\\'. - `\\u' means upcase the next character. - `\\l' means downcase the next character. - `\\U' means begin upcasing all following characters. - `\\L' means begin downcasing all following characters. - `\\E' means terminate the effect of any `\\U' or `\\L'." - (if (> (length str) 50) - (let ((cfs case-fold-search)) - (with-temp-buffer - (setq case-fold-search cfs) - (insert str) - (goto-char 1) - (while (re-search-forward regexp nil t) - (replace-match newtext t literal)) - (buffer-string))) - (let ((start 0) newstr) - (while (string-match regexp str start) - (setq newstr (replace-match newtext t literal str) - start (+ (match-end 0) (- (length newstr) (length str))) - str newstr)) - str))) - ) - - +(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 @@ -2546,7 +2470,7 @@ (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 +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. @@ -2760,10 +2684,9 @@ (pop-to-buffer buffer))) (defun prolog-Info-follow-nearest-node () - (if (eq prolog-emacs 'xemacs) - (Info-follow-nearest-node (point)) - (Info-follow-nearest-node)) -) + (if (featurep 'xemacs) + (Info-follow-nearest-node (point)) + (Info-follow-nearest-node))) (defun prolog-help-online (predicate) (prolog-ensure-process) @@ -2985,7 +2908,7 @@ (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 + (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) @@ -2995,8 +2918,7 @@ ;; 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." @@ -3238,6 +3160,7 @@ (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))) @@ -3488,10 +3411,12 @@ (insert "%%% -*- Module: ; -*-\n") (backward-char 6)) -(defun prolog-uncomment-region (beg end) - "Uncomment the region between BEG and END." - (interactive "r") - (comment-region beg end -1)) +(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. @@ -3573,35 +3498,37 @@ (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, space (if appropriate), `:-' and newline if colon is pressed + "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) - (= (point) (line-end-position)) + (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 " ")) + (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, space (if appropriate), `-->' and newline if dash is pressed + "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) - (= (point) (line-end-position)) + (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 " ")) + (unless (save-excursion (backward-char 1) (looking-at "\\s ")) + (insert " ")) (insert "-->\n") (prolog-indent-line)) (self-insert-command (prefix-numeric-value arg)))) @@ -3638,13 +3565,13 @@ (re-search-backward ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t))) (format "\\(^\\|[])}%s]+\\)[ \t]*\\=" - prolog-lower-case-string) + 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) + prolog-upper-case-string) ;FIXME: [:upper:] nil t)) ) ) @@ -3686,7 +3613,8 @@ ;; ###### ;;(skip-chars-backward "a-zA-Z_") (skip-chars-backward - (format "%s%s_" + (format "%s%s_" + ;; FIXME: Why not "a-zA-Z"? prolog-lower-case-string prolog-upper-case-string)) @@ -3695,6 +3623,7 @@ ;; ###### ;; (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))) @@ -3711,7 +3640,7 @@ (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 +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) @@ -3759,6 +3688,7 @@ 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 @@ -3778,20 +3708,20 @@ ;; `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 (eq prolog-emacs 'xemacs)) + ;;(if (and (not (featurep 'xemacs)) ;; (fboundp 'map-char-table)) ;; (map-char-table ;; (lambda (key value) ;; (cond ;; ((and - ;; (eq (int-to-char key) (downcase key)) - ;; (eq (int-to-char key) (upcase key))) + ;; (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 (int-to-char key) (downcase key)) + ;; ((eq (prolog-int-to-char key) (downcase key)) ;; ;; The char is lower case ;; (setq low_string (format "%s%c" low_string key))) - ;; ((eq (int-to-char key) (upcase key)) + ;; ((eq (prolog-int-to-char key) (upcase key)) ;; ;; The char is upper case ;; (setq up_string (format "%s%c" up_string key))) ;; )) @@ -3801,14 +3731,14 @@ (while (< key 256) (cond ((and - (eq (int-to-char key) (downcase key)) - (eq (int-to-char key) (upcase key))) + (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 (int-to-char key) (downcase key)) + ((eq (prolog-int-to-char key) (downcase key)) ;; The char is lower case (setq low_string (format "%s%c" low_string key))) - ((eq (int-to-char key) (upcase key)) + ((eq (prolog-int-to-char key) (upcase key)) ;; The char is upper case (setq up_string (format "%s%c" up_string key))) ) @@ -3820,7 +3750,7 @@ )) ;(defun prolog-regexp-dash-continuous-chars (chars) -; (let ((ints (mapcar #'char-to-int (string-to-list chars))) +; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars))) ; (beg 0) ; (end 0)) ; (if (null ints) @@ -3860,7 +3790,7 @@ (defun prolog-dash-letters (string) "Return a condensed regexp covering all letters in STRING." - (let ((intervals (prolog-ints-intervals (mapcar #'char-to-int + (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int (string-to-list string)))) codes) (while intervals @@ -3884,16 +3814,11 @@ ;; GNU Emacs compatibility: GNU Emacs does not differentiate between ;; ints and chars, or at least these two are interchangeable. -(or (fboundp 'int-to-char) - ;; Introduced in Emacs 19.29. - (defun int-to-char (num) - num)) - -(or (fboundp 'char-to-int) - ;; Introduced in Emacs 19.29. - (defun char-to-int (num) - num)) - +(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 @@ -3906,7 +3831,7 @@ (mark))) (defun prolog-menu () - "Creates the menus for the Prolog editing buffers. + "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'." @@ -3918,7 +3843,7 @@ prolog-edit-menu-help (current-local-map) "Help menu for the Prolog mode." (append - (if (eq prolog-emacs 'xemacs) '("Help") '("Prolog-help")) + (if (featurep 'xemacs) '("Help") '("Prolog-help")) (cond ((eq prolog-system 'sicstus) '(["On predicate" prolog-help-on-predicate t] @@ -3983,7 +3908,7 @@ ;; default (mercury) nil ) (list "---" - (if (eq prolog-emacs 'xemacs) + (if (featurep 'xemacs) [(concat "Run " (cond ((eq prolog-system 'eclipse) "ECLiPSe") ((eq prolog-system 'mercury) "Mercury") (t "Prolog"))) @@ -4042,7 +3967,7 @@ (easy-menu-add prolog-edit-menu-help)) (defun prolog-inferior-menu () - "Creates the menus for the Prolog inferior buffer. + "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." @@ -4050,7 +3975,7 @@ prolog-inferior-menu-help (current-local-map) "Help menu for the Prolog inferior mode." (append - (if (eq prolog-emacs 'xemacs) '("Help") '("Prolog-help")) + (if (featurep 'xemacs) '("Help") '("Prolog-help")) (cond ((eq prolog-system 'sicstus) '(["On predicate" prolog-help-on-predicate t] @@ -4108,12 +4033,8 @@ (easy-menu-add prolog-inferior-menu-all) (easy-menu-add prolog-inferior-menu-help)) -(add-hook 'prolog-mode-hook 'prolog-menu) -(add-hook 'prolog-inferior-mode-hook 'prolog-inferior-menu) - -(add-hook 'prolog-mode-hook '(lambda () (font-lock-mode 1))) -(add-hook 'prolog-inferior-mode-hook '(lambda () (font-lock-mode 1))) - +(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."