Mercurial > emacs
changeset 110363:c98f769d9fcf
Merge from mainline.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Sun, 12 Sep 2010 22:46:48 +0000 |
| parents | 44bf19a4d54b (current diff) 5988195cbf4c (diff) |
| children | 6358797a47cd |
| files | etc/emacs.bash etc/emacs.csh etc/ms-kermit |
| diffstat | 64 files changed, 2225 insertions(+), 1361 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,7 @@ +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in: Check for libxml2. + 2010-09-09 Glenn Morris <rgm@gnu.org> * make-dist: No more TODO files under lisp/.
--- a/configure Fri Sep 10 05:38:52 2010 +0000 +++ b/configure Sun Sep 12 22:46:48 2010 +0000 @@ -660,6 +660,8 @@ LIBS_MAIL liblockfile ALLOCA +LIBXML2_LIBS +LIBXML2_CFLAGS LIBXSM LIBGPM LIBGIF @@ -807,6 +809,7 @@ with_gif with_png with_rsvg +with_xml2 with_imagemagick with_xft with_libotf @@ -1514,6 +1517,7 @@ --without-gif don't compile with GIF image support --without-png don't compile with PNG image support --without-rsvg don't compile with SVG image support + --without-xml2 don't compile with XML parsing support --with-imagemagick compile with ImageMagick image support --without-xft don't use XFT for anti aliased fonts --without-libotf don't use libotf for OpenType font support @@ -2732,6 +2736,14 @@ fi +# Check whether --with-xml2 was given. +if test "${with_xml2+set}" = set; then : + withval=$with_xml2; +else + with_xml2=yes +fi + + # Check whether --with-imagemagick was given. if test "${with_imagemagick+set}" = set; then : withval=$with_imagemagick; @@ -11070,6 +11082,112 @@ fi +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + HAVE_LIBXML2=no + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.2.0" >&5 +$as_echo_n "checking for libxml-2.0 > 2.2.0... " >&6; } + + if $PKG_CONFIG --exists "libxml-2.0 > 2.2.0" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5 +$as_echo_n "checking LIBXML2_CFLAGS... " >&6; } + LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5 +$as_echo "$LIBXML2_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5 +$as_echo_n "checking LIBXML2_LIBS... " >&6; } + LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5 +$as_echo "$LIBXML2_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + LIBXML2_CFLAGS="" + LIBXML2_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.2.0"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_LIBXML2=yes + else + HAVE_LIBXML2=no + fi + + if test "${HAVE_LIBXML2}" = "yes"; then + +$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h + + fi +fi + + + # If netdb.h doesn't declare h_errno, we must declare it by hand. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 $as_echo_n "checking whether netdb declares h_errno... " >&6; }
--- a/configure.in Fri Sep 10 05:38:52 2010 +0000 +++ b/configure.in Sun Sep 12 22:46:48 2010 +0000 @@ -155,6 +155,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) @@ -2535,6 +2536,17 @@ fi AC_SUBST(LIBXSM) +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.2.0, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + if test "${HAVE_LIBXML2}" = "yes"; then + AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).]) + fi +fi +AC_SUBST(LIBXML2_LIBS) +AC_SUBST(LIBXML2_CFLAGS) + # If netdb.h doesn't declare h_errno, we must declare it by hand. AC_CACHE_CHECK(whether netdb declares h_errno, emacs_cv_netdb_declares_h_errno,
--- a/doc/lispref/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/doc/lispref/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,7 @@ +2010-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.texi (Syntax Flags): Document new `c' flag. + 2010-09-09 Glenn Morris <rgm@gnu.org> * display.texi (ImageMagick Images): General cleanup.
--- a/doc/lispref/syntax.texi Fri Sep 10 05:38:52 2010 +0000 +++ b/doc/lispref/syntax.texi Sun Sep 12 22:46:48 2010 +0000 @@ -292,19 +292,21 @@ @cindex syntax flags In addition to the classes, entries for characters in a syntax table -can specify flags. There are seven possible flags, represented by the -characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{n}, -and @samp{p}. +can specify flags. There are eight possible flags, represented by the +characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{c}, +@samp{n}, and @samp{p}. - All the flags except @samp{n} and @samp{p} are used to describe -multi-character comment delimiters. The digit flags indicate that a -character can @emph{also} be part of a comment sequence, in addition to -the syntactic properties associated with its character class. The flags -are independent of the class and each other for the sake of characters -such as @samp{*} in C mode, which is a punctuation character, @emph{and} -the second character of a start-of-comment sequence (@samp{/*}), -@emph{and} the first character of an end-of-comment sequence -(@samp{*/}). + All the flags except @samp{p} are used to describe comment +delimiters. The digit flags are used for comment delimiters made up +of 2 characters. They indicate that a character can @emph{also} be +part of a comment sequence, in addition to the syntactic properties +associated with its character class. The flags are independent of the +class and each other for the sake of characters such as @samp{*} in +C mode, which is a punctuation character, @emph{and} the second +character of a start-of-comment sequence (@samp{/*}), @emph{and} the +first character of an end-of-comment sequence (@samp{*/}). The flags +@samp{b}, @samp{c}, and @samp{n} are used to qualify the corresponding +comment delimiter. Here is a table of the possible flags for a character @var{c}, and what they mean: @@ -325,63 +327,62 @@ @samp{4} means @var{c} is the second character of such a sequence. @item -@c Emacs 19 feature @samp{b} means that @var{c} as a comment delimiter belongs to the -alternative ``b'' comment style. +alternative ``b'' comment style. For a two-character comment starter, +this flag is only significant on the second char, and for a 2-character +comment ender it is only significant on the first char. + +@item +@samp{c} means that @var{c} as a comment delimiter belongs to the +alternative ``c'' comment style. For a two-character comment +delimiter, @samp{c} on either character makes it of style ``c''. -Emacs supports two comment styles simultaneously in any one syntax -table. This is for the sake of C++. Each style of comment syntax has -its own comment-start sequence and its own comment-end sequence. Each -comment must stick to one style or the other; thus, if it starts with -the comment-start sequence of style ``b,'' it must also end with the -comment-end sequence of style ``b.'' +@item +@samp{n} on a comment delimiter character specifies +that this kind of comment can be nested. For a two-character +comment delimiter, @samp{n} on either character makes it +nestable. -The two comment-start sequences must begin with the same character; only -the second character may differ. Mark the second character of the -``b''-style comment-start sequence with the @samp{b} flag. +Emacs supports several comment styles simultaneously in any one syntax +table. A comment style is a set of flags @samp{b}, @samp{c}, and +@samp{n}, so there can be up to 8 different comment styles. +Each comment delimiter has a style and only matches comment delimiters +of the same style. Thus if a comment starts with the comment-start +sequence of style ``bn'', it will extend until the next matching +comment-end sequence of style ``bn''. -A comment-end sequence (one or two characters) applies to the ``b'' -style if its first character has the @samp{b} flag set; otherwise, it -applies to the ``a'' style. - -The appropriate comment syntax settings for C++ are as follows: +The appropriate comment syntax settings for C++ can be as follows: @table @asis @item @samp{/} -@samp{124b} +@samp{124} @item @samp{*} -@samp{23} +@samp{23b} @item newline -@samp{>b} +@samp{>} @end table This defines four comment-delimiting sequences: @table @asis @item @samp{/*} -This is a comment-start sequence for ``a'' style because the -second character, @samp{*}, does not have the @samp{b} flag. +This is a comment-start sequence for ``b'' style because the +second character, @samp{*}, has the @samp{b} flag. @item @samp{//} -This is a comment-start sequence for ``b'' style because the second -character, @samp{/}, does have the @samp{b} flag. +This is a comment-start sequence for ``a'' style because the second +character, @samp{/}, does not have the @samp{b} flag. @item @samp{*/} -This is a comment-end sequence for ``a'' style because the first -character, @samp{*}, does not have the @samp{b} flag. +This is a comment-end sequence for ``b'' style because the first +character, @samp{*}, does have the @samp{b} flag. @item newline -This is a comment-end sequence for ``b'' style, because the newline -character has the @samp{b} flag. +This is a comment-end sequence for ``a'' style, because the newline +character does not have the @samp{b} flag. @end table @item -@samp{n} on a comment delimiter character specifies -that this kind of comment can be nested. For a two-character -comment delimiter, @samp{n} on either character makes it -nestable. - -@item @c Emacs 19 feature @samp{p} identifies an additional ``prefix character'' for Lisp syntax. These characters are treated as whitespace when they appear between
--- a/doc/lispref/text.texi Fri Sep 10 05:38:52 2010 +0000 +++ b/doc/lispref/text.texi Sun Sep 12 22:46:48 2010 +0000 @@ -59,6 +59,7 @@ position stored in a register. * Base 64:: Conversion to or from base 64 encoding. * MD5 Checksum:: Compute the MD5 "message digest"/"checksum". +* Parsing HTML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes "atomically". * Change Hooks:: Supplying functions to be run when text is changed. @end menu @@ -4106,6 +4107,49 @@ coding instead. @end defun +@node Parsing HTML +@section Parsing HTML +@cindex parsing html +@cindex parsing xml + +Emacs provides an interface to the @code{libxml2} library via two +functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The +HTML function will parse ``real world'' HTML and try to return a +sensible parse tree, while the XML function is somewhat stricter about +syntax. + +They both take a two optional parameter. The first is a buffer, and +the second is a base URL to be used to expand relative URLs in the +document, if any. + +Here's an example demonstrating the structure of the parsed data you +get out. Given this HTML document: + +@example +<html><hEad></head><body width=101><div class=thing>Foo<div>Yes +@end example + +You get this parse tree: + +@example +(html + (head) + (body + (:width . "101") + (div + (:class . "thing") + (text . "Foo") + (div + (text . "Yes\n"))))) +@end example + +It's a simple tree structure, where the @code{car} for each node is +the name of the node, and the @code{cdr} is the value, or the list of +values. + +Attributes are coded the same way as child nodes, but with @samp{:} as +the first character. + @node Atomic Changes @section Atomic Change Groups @cindex atomic changes
--- a/etc/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/etc/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,12 @@ +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs.bash, emacs.csh, ms-kermit: Remove obsolete files (use + emacsclient -a instead of the first two). + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * NEWS: Mention the new libxml2 functions. + 2010-08-25 Kenichi Handa <handa@m17n.org> * HELLO: Change designation sequences for Arabic text.
--- a/etc/NEWS Fri Sep 10 05:38:52 2010 +0000 +++ b/etc/NEWS Sun Sep 12 22:46:48 2010 +0000 @@ -317,10 +317,24 @@ variables `sql-product', `sql-user', `sql-server', `sql-database' and `sql-port' can now be safely used as local variables. +*** `sql-dialect' is a synonym for `sql-product'. + *** Added ability to login with a port on MySQL. The custom variable `sql-port' can be specified for connection to MySQL servers. +*** Dynamic selection of product in an SQL interactive session. +If you use `sql-product-interactive' to start an SQL interactive +session it uses the current value of `sql-product'. Preceding the +invocation with C-u will force it to ask for the product before +creating the session. + +*** Renaming a SQL interactive buffer when it is created. +Prefixing the SQL interactive commands (`sql-sqlite', `sql-postgres', +`sql-mysql', etc.) with C-u will force a new interactive session to be +started and will prompt for the new name. This will reduce the need +for `sql-rename-buffer' is most common use cases. + *** Command continuation prompts in SQL interactive mode are suppressed. Multiple line commands in SQL interactive mode, generate command continuation prompts which needlessly confuse the output. These @@ -466,8 +480,19 @@ * Lisp changes in Emacs 24.1 +** New variable syntax-propertize-function to set syntax-table properties. +Replaces font-lock-syntactic-keywords which are now obsolete. +This allows syntax-table properties to be set independently from font-lock: +just call syntax-propertize to make sure the text is propertized. +Together with this new variable come a new hook +syntax-propertize-extend-region-functions, as well as two helper functions: +syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords +as-is; and syntax-propertize-rules which provides a new way to specify +syntactic rules. + ** New hook post-self-insert-hook run at the end of self-insert-command. ++++ ** Syntax tables support a new "comment style c" additionally to style b. ** frame-local variables cannot be let-bound any more. ** prog-mode is a new major-mode meant to be the parent of programming mode. @@ -493,6 +518,14 @@ *** `image-extension-data' is renamed to `image-metadata'. +** XML and HTML parsing + +*** If Emacs is compiled with libxml2 support (which is the default), +two new Emacs Lisp-level functions are defined: `html-parse-string' +(which will parse "real world" HTML) and `xml-parse-string' (which +parses XML). Both return an Emacs Lisp parse tree. See the Emacs +Lisp Reference Manual for details. + ** Isearch *** New hook `isearch-update-post-hook' that runs in `isearch-update'.
--- a/etc/emacs.bash Fri Sep 10 05:38:52 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -### emacs.bash --- contact/resume an existing Emacs, or start a new one - -## Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -## Free Software Foundation, Inc. - -## Author: Noah Friedman - -## 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 3 of the License, or -## (at your option) any later version. - -## 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. If not, see <http://www.gnu.org/licenses/>. - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a bash command named `edit' which contacts/resumes an -## existing emacs or starts a new one if none exists. - -## One way or another, any arguments are passed to emacs to specify files -## (provided you have loaded `resume.el'). - -## This function assumes the emacs program is named `emacs' and is somewhere -## in your load path. If either of these is not true, the most portable -## (and convenient) thing to do is to make an alias called emacs which -## refers to the real program, e.g. -## -## alias emacs=/usr/local/bin/gemacs - -function edit () -{ - local windowsys="${WINDOW_PARENT+sun}" - - windowsys="${windowsys:-${DISPLAY+x}}" - - if [ -n "${windowsys:+set}" ]; then - # Do not just test if these files are sockets. On some systems - # ordinary files or fifos are used instead. Just see if they exist. - if [ -e "${HOME}/.emacs_server" -o -e "/tmp/emacs${UID}/server" ]; then - emacsclient "$@" - return $? - else - echo "edit: starting emacs in background..." 1>&2 - fi - - case "${windowsys}" in - x ) (emacs "$@" &) ;; - sun ) echo "unsupported window system"; return 1 ;; - esac - else - if jobs %emacs 2> /dev/null ; then - echo "$(pwd)" "$@" >| ${HOME}/.emacs_args && fg %emacs - else - emacs "$@" - fi - fi -} - - -# arch-tag: 1e1b74b9-bf2c-4b23-870f-9eebff7515cb -### emacs.bash ends here
--- a/etc/emacs.csh Fri Sep 10 05:38:52 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -### emacs.csh - -## Add legal notice if non-trivial amounts of code are added. - -## Author: Michael DeCorte - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a csh command named `edit' which resumes an -## existing Emacs or starts a new one if none exists. -## One way or another, any arguments are passed to Emacs to specify files -## (provided you have loaded `resume.el'). - -## These are the possible values of $whichjob -## 1 = new ordinary emacs (the -nw is so that it doesn't try to do X) -## 2 = resume emacs -## 3 = new emacs under X (-i is so that you get a reasonable icon) -## 4 = resume emacs under X -set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS" - -alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\ - "emacsclient \!* &") ; \ - jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \ - @ isjob = ! $status; \ - @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \ - test -S ~/.emacs_server && emacsclient \!* \ - || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]' - -# arch-tag: 433d58df-15b9-446f-ad37-f0393e3a23d4
--- a/etc/ms-kermit Fri Sep 10 05:38:52 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -;;; The code here is forced by the interface, and is not subject to -;;; copyright, constituting the only possible expression of the algorithm -;;; in this format. - -;;; This file is designed for an 8-bit connection. -;;; Use the file ms-7bkermit if you have a 7-bit connection. - -;; Meta key mappings for EMACS -;; By Robert Earl (rearl@watnxt3.ucr.edu) -;; May 13, 1990 -;; -;; WARNING: -;; requires an 8-bit path to host. many dialups and lans won't pass the -;; eighth bit by default and may require a special command to turn this -;; off. `screen' is known to mask the eighth bit of input as well. - -set term controls 8-bit -set translation key off - -;; control keys -set key \3449 \128 ;; m-c-@ -set key \3358 \129 ;; m-c-a -set key \3376 \130 ;; m-c-b -set key \3374 \131 ;; m-c-c -set key \3360 \132 ;; m-c-d -set key \3346 \133 ;; m-c-e -set key \3361 \134 ;; m-c-f -set key \3362 \135 ;; m-c-g -set key \3342 \136 ;; m-bs -set key \3363 \136 ;; m-c-h (sends same code as above) -set key \2469 \137 ;; m-tab -set key \3351 \137 ;; m-c-i (same as above) -set key \3364 \138 ;; m-c-j -set key \3365 \139 ;; m-c-k -set key \3366 \140 ;; m-c-l -;set key \3378 \141 ;; m-c-m -set key \2332 \141 ;; m-ret (sends same code as above) -set key \3377 \142 ;; m-c-n -set key \3352 \143 ;; m-c-o -set key \3353 \144 ;; m-c-p -set key \3344 \145 ;; m-c-q -set key \3347 \146 ;; m-c-r -set key \3359 \147 ;; m-c-s -set key \3348 \148 ;; m-c-t -set key \3350 \149 ;; m-c-u -set key \3375 \150 ;; m-c-v -set key \3345 \151 ;; m-c-w -set key \3373 \152 ;; m-c-x -set key \3349 \153 ;; m-c-y -set key \3372 \154 ;; m-c-z - -;; misc keys -;set key \3354 \155 ;; m-c-[ -set key \2305 \155 ;; m-esc (sends same as above) -set key \3371 \156 ;; m-c-\ -set key \3355 \157 ;; m-c-] -set key \3453 \158 ;; m-c-^ -set key \3458 \159 ;; m-c-_ - -;; \160 is conspicuously missing here-- -;; alt-spc doesn't generate a distinct scan code... -;; neither do shift-spc and ctrl-spc. -;; no idea why. - -set key \2936 \161 ;; m-! -set key \2856 \162 ;; m-" -set key \2938 \163 ;; m-# -set key \2939 \164 ;; m-$ -set key \2940 \165 ;; m-% -set key \2942 \166 ;; m-& -set key \2344 \167 ;; m-' -set key \2944 \168 ;; m-( -set key \2945 \169 ;; m-) -set key \2943 \170 ;; m-* -set key \2947 \171 ;; m-+ -set key \2355 \172 ;; m-, -set key \2434 \173 ;; m-- -set key \2356 \174 ;; m-. -set key \2357 \175 ;; m-/ - -;; number keys -set key \2433 \176 ;; m-0 -set key \2424 \177 ;; m-1 -set key \2425 \178 -set key \2426 \179 -set key \2427 \180 -set key \2428 \181 -set key \2429 \182 -set key \2430 \183 -set key \2431 \184 -set key \2432 \185 ;; m-9 - -set key \2855 \186 ;; m-: -set key \2343 \187 ;; m-; -set key \2867 \188 ;; m-< -set key \2435 \189 ;; m-= -set key \2868 \190 ;; m-> -set key \2869 \191 ;; m-? -set key \2937 \192 ;; m-@ - -;; shifted A-Z -set key \2846 \193 ;; m-A -set key \2864 \194 -set key \2862 \195 -set key \2848 \196 -set key \2834 \197 -set key \2849 \198 -set key \2850 \199 -set key \2851 \200 -set key \2839 \201 -set key \2852 \202 -set key \2853 \203 -set key \2854 \204 -set key \2866 \205 -set key \2865 \206 -set key \2840 \207 -set key \2841 \208 -set key \2832 \209 -set key \2835 \210 -set key \2847 \211 -set key \2836 \212 -set key \2838 \213 -set key \2863 \214 -set key \2833 \215 -set key \2861 \216 -set key \2837 \217 -set key \2860 \218 ;; m-Z - -set key \2330 \219 ;; m-[ -set key \2347 \220 ;; m-\ -set key \2331 \221 ;; m-] -set key \2941 \222 ;; m-^ -set key \2946 \223 ;; m-_ -set key \2345 \224 ;; m-` - -;; lowercase a-z -set key \2334 \225 ;; m-a -set key \2352 \226 -set key \2350 \227 -set key \2336 \228 -set key \2322 \229 -set key \2337 \230 -set key \2338 \231 -set key \2339 \232 -set key \2327 \233 -set key \2340 \234 -set key \2341 \235 -set key \2342 \236 -set key \2354 \237 -set key \2353 \238 -set key \2328 \239 -set key \2329 \240 -set key \2320 \241 -set key \2323 \242 -set key \2335 \243 -set key \2324 \244 -set key \2326 \245 -set key \2351 \246 -set key \2321 \247 -set key \2349 \248 -set key \2325 \249 -set key \2348 \250 ;; m-z - -;; more shifted misc. keys -set key \2842 \251 ;; m-{ -set key \2859 \252 ;; m-| -set key \2843 \253 ;; m-} -set key \2857 \254 ;; m-~ -set key \2318 \255 ;; m-del - - -;;; arch-tag: 93cefb0a-2b07-4d09-ae78-4d807b15645d
--- a/lisp/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,7 +1,203 @@ +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key. + +2010-09-12 Leo <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-server-commands, rcirc-client-commands) + (rcirc-completion-start): New variables. + (rcirc-nick-completions): Rename to rcirc-completions. + (rcirc-nick-completion-start-offset): Delete. + (rcirc-completion-at-point): New function for constructing + completion data for both nicks and irc commands. Add to + completion-at-point-functions in rcirc mode. + (rcirc-complete): Rename from rcirc-nick-complete; use + rcirc-completion-at-point. + (defun-rcirc-command): Update rcirc-client-commands. + +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files + atomically, to avoid parallel build errors. (Bug#4196) + +2010-09-11 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.6 + (sql-dialect): Synonym for "sql-product". + (sql-find-sqli-buffer, sql-set-sqli-buffer-generally) + (sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode): + Set "sql-buffer" to buffer name not buffer object so multiple sql + interactive buffers work properly. Reverts misguided changes in + earlier work. + (sql-comint): Make sure different buffer name is used if "*SQL*" + buffer is for a different product. + (sql-make-alternate-buffer-name): Fix bug with "sql-database" + login param. + (sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql) + (sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase) + (sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer): + Accept new buffer name or prompt for one. + (sql-port): Default to zero. + (sql-comint-mysql): Handle "sql-port" as a numeric. + (sql-port-history): Delete unused variable. + (sql-get-login): Default "sql-port" to a number. + (sql-product-alist): Correct Postgres prompt and terminator + regexp. + (sql-sqlite-program): Dynamically detect presence of "sqlite" or + "sqlite3" executables. + (sql-sqlite-login-params): Add "*.sqlite[23]?" database name + pattern. + (sql-buffer-live-p): New function. + (sql-mode-menu, sql-send-string): Use it. + (sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK + syntax pattern. + (sql-mode-postgres-font-lock-keywords): Support Postgres V9. + (sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands. + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/netrc.el (netrc-credentials): New conveniency function. + +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun + to replace texinfo-font-lock-syntactic-keywords. + (texinfo-mode): Use it. + + * textmodes/tex-mode.el (tex-common-initialization, doctex-mode): + Use syntax-propertize-function. + + * textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to + replace sgml-font-lock-syntactic-keywords. + (sgml-mode): Use it. + + * textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare + since we don't use it. + + * textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function. + + * progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function + if available. + (vhdl-fontify-buffer): Adjust. + + * progmodes/tcl.el (tcl-syntax-propertize-function): New var to + replace tcl-font-lock-syntactic-keywords. + (tcl-mode): Use it. + + * progmodes/simula.el (simula-syntax-propertize-function): New var to + replace simula-font-lock-syntactic-keywords. + (simula-mode): Use it. + + * progmodes/sh-script.el (sh-st-symbol): Remove. + (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg. + (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove. + (sh-font-lock-quoted-subshell): Assume we've already matched $(. + (sh-font-lock-paren): Set syntax-multiline. + (sh-font-lock-syntactic-keywords): Remove. + (sh-syntax-propertize-function): New function to replace it. + (sh-mode): Use it. + + * progmodes/ruby-mode.el (ruby-here-doc-beg-re): + Define while compiling. + (ruby-here-doc-end-re, ruby-here-doc-beg-match) + (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax) + (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p) + (ruby-here-doc-find-end, ruby-here-doc-beg-syntax) + (ruby-here-doc-end-syntax): Only define when + syntax-propertize is not available. + (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc): + New functions. + (ruby-in-ppss-context-p): Update to new syntax of heredocs. + (electric-indent-chars): Silence bytecompiler. + (ruby-mode): Use prog-mode, syntax-propertize-function, and + electric-indent-chars. + + * progmodes/python.el (python-syntax-propertize-function): New var to + replace python-font-lock-syntactic-keywords. + (python-mode): Use it. + (python-quote-syntax): Simplify and adjust to new use. + + * progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to + replace perl-font-lock-syntactic-keywords. + (perl-syntax-propertize-special-constructs): New fun to replace + perl-font-lock-special-syntactic-constructs. + (perl-font-lock-syntactic-face-function): New fun. + (perl-mode): Use it. + + * progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function + to replace octave-font-lock-close-quotes. + (octave-syntax-propertize-function): New function to replace + octave-font-lock-syntactic-keywords. + (octave-mode): Use it. + + * progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var; + replaces mixal-font-lock-syntactic-keywords. + (mixal-mode): Use it. + + * progmodes/make-mode.el (makefile-syntax-propertize-function): + New var; replaces makefile-font-lock-syntactic-keywords. + (makefile-mode): Use it. + (makefile-imake-mode): Adjust. + + * progmodes/js.el (js--regexp-literal): Define while compiling. + (js-syntax-propertize-function): New var; replaces + js-font-lock-syntactic-keywords. + (js-mode): Use it. + + * progmodes/gud.el (gdb-script-syntax-propertize-function): New var; + replaces gdb-script-font-lock-syntactic-keywords. + (gdb-script-mode): Use it. + + * progmodes/fortran.el (fortran-mode): Use syntax-propertize-function. + (fortran--font-lock-syntactic-keywords): New var. + (fortran-line-length): Update syntax-propertize-function and + fortran--font-lock-syntactic-keywords. + + * progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function. + + * progmodes/cfengine.el (cfengine-mode): + Use syntax-propertize-function. + (cfengine-font-lock-syntactic-keywords): Remove. + + * progmodes/autoconf.el (autoconf-mode): + Use syntax-propertize-function. + (autoconf-font-lock-syntactic-keywords): Remove. + + * progmodes/ada-mode.el (ada-set-syntax-table-properties) + (ada-after-change-function, ada-initialize-syntax-table-properties) + (ada-handle-syntax-table-properties): Only define when + syntax-propertize is not available. + (ada-mode): Use syntax-propertize-function. + + * font-lock.el (font-lock-syntactic-keywords): Make obsolete. + (font-lock-fontify-syntactic-keywords-region): Move handling of + font-lock-syntactically-fontified to... + (font-lock-default-fontify-region): ...here. + Let syntax-propertize-function take precedence. + (font-lock-fontify-syntactically-region): Cal syntax-propertize. + + * emacs-lisp/syntax.el (syntax-propertize-function) + (syntax-propertize-chunk-size, syntax-propertize--done) + (syntax-propertize-extend-region-functions): New vars. + (syntax-propertize-wholelines, syntax-propertize-multiline) + (syntax-propertize--shift-groups, syntax-propertize-via-font-lock) + (syntax-propertize): New functions. + (syntax-propertize-rules): New macro. + (syntax-ppss-flush-cache): Set syntax-propertize--done. + (syntax-ppss): Call syntax-propertize. + + * emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups. + +2010-09-10 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process): Improve comments. + XEmacs compatibility changes regarding (add-hook) 'local option + and (set-process-query-on-exit-flag). + 2010-09-09 Michael Albinus <michael.albinus@gmx.de> - * net/tramp-cache.el (tramp-parse-connection-properties): Set - tramp-autoload cookie. + * net/tramp-cache.el (tramp-parse-connection-properties): + Set tramp-autoload cookie. 2010-09-09 Glenn Morris <rgm@gnu.org>
--- a/lisp/ansi-color.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/ansi-color.el Sun Sep 12 22:46:48 2010 +0000 @@ -244,9 +244,9 @@ (when (boundp 'font-lock-syntactic-keywords) (remove-text-properties beg end '(syntax-table nil))) ;; instead of just using (remove-text-properties beg end '(face - ;; nil)), we find regions with a non-nil face test-property, skip + ;; nil)), we find regions with a non-nil face text-property, skip ;; positions with the ansi-color property set, and remove the - ;; remaining face test-properties. + ;; remaining face text-properties. (while (setq beg (text-property-not-all beg end 'face nil)) (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) (when (get-text-property beg 'face)
--- a/lisp/emacs-lisp/bytecomp.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Sun Sep 12 22:46:48 2010 +0000 @@ -1698,17 +1698,25 @@ (insert "\n") ; aaah, unix. (if (file-writable-p target-file) ;; We must disable any code conversion here. - (let ((coding-system-for-write 'no-conversion)) + (let ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile (make-temp-name target-file))) (if (memq system-type '(ms-dos 'windows-nt)) (setq buffer-file-type t)) - (when (file-exists-p target-file) - ;; Remove the target before writing it, so that any - ;; hard-links continue to point to the old file (this makes - ;; it possible for installed files to share disk space with - ;; the build tree, without causing problems when emacs-lisp - ;; files in the build tree are recompiled). - (delete-file target-file)) - (write-region (point-min) (point-max) target-file)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t) + (message "Wrote %s" target-file)) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file"
--- a/lisp/emacs-lisp/regexp-opt.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/emacs-lisp/regexp-opt.el Sun Sep 12 22:46:48 2010 +0000 @@ -120,7 +120,7 @@ (string-match regexp "") ;; Count the number of open parentheses in REGEXP. (let ((count 0) start last) - (while (string-match "\\\\(\\(\\?:\\)?" regexp start) + (while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start) (setq start (match-end 0)) ; Start of next search. (when (and (not (match-beginning 1)) (subregexp-context-p regexp (match-beginning 0) last))
--- a/lisp/emacs-lisp/syntax.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/emacs-lisp/syntax.el Sun Sep 12 22:46:48 2010 +0000 @@ -34,7 +34,6 @@ ;; - do something about the case where the syntax-table is changed. ;; This typically happens with tex-mode and its `$' operator. -;; - move font-lock-syntactic-keywords in here. Then again, maybe not. ;; - new functions `syntax-state', ... to replace uses of parse-partial-state ;; with something higher-level (similar to syntax-ppss-context). ;; - interaction with mmm-mode. @@ -47,6 +46,249 @@ (defvar font-lock-beginning-of-syntax-function) +;;; Applying syntax-table properties where needed. + +(defvar syntax-propertize-function nil + ;; Rather than a -functions hook, this is a -function because it's easier + ;; to do a single scan than several scans: with multiple scans, one cannot + ;; assume that the text before point has been propertized, so syntax-ppss + ;; gives unreliable results (and stores them in its cache to boot, so we'd + ;; have to flush that cache between each function, and we couldn't use + ;; syntax-ppss-flush-cache since that would not only flush the cache but also + ;; reset syntax-propertize--done which should not be done in this case). + "Mode-specific function to apply the syntax-table properties. +Called with 2 arguments: START and END.") + +(defvar syntax-propertize-chunk-size 500) + +(defvar syntax-propertize-extend-region-functions + '(syntax-propertize-wholelines) + "Special hook run just before proceeding to propertize a region. +This is used to allow major modes to help `syntax-propertize' find safe buffer +positions as beginning and end of the propertized region. Its most common use +is to solve the problem of /identification/ of multiline elements by providing +a function that tries to find such elements and move the boundaries such that +they do not fall in the middle of one. +Each function is called with two arguments (START and END) and it should return +either a cons (NEW-START . NEW-END) or nil if no adjustment should be made. +These functions are run in turn repeatedly until they all return nil. +Put first the functions more likely to cause a change and cheaper to compute.") +;; Mark it as a special hook which doesn't use any global setting +;; (i.e. doesn't obey the element t in the buffer-local value). +(make-variable-buffer-local 'syntax-propertize-extend-region-functions) + +(defun syntax-propertize-wholelines (start end) + (goto-char start) + (cons (line-beginning-position) + (progn (goto-char end) + (if (bolp) (point) (line-beginning-position 2))))) + +(defun syntax-propertize-multiline (beg end) + "Let `syntax-propertize' pay attention to the syntax-multiline property." + (when (and (> beg (point-min)) + (get-text-property (1- beg) 'syntax-multiline)) + (setq beg (or (previous-single-property-change beg 'syntax-multiline) + (point-min)))) + ;; + (when (get-text-property end 'font-lock-multiline) + (setq end (or (text-property-any end (point-max) + 'syntax-multiline nil) + (point-max)))) + (cons beg end)) + +(defvar syntax-propertize--done -1 + "Position upto which syntax-table properties have been set.") +(make-variable-buffer-local 'syntax-propertize--done) + +(defun syntax-propertize--shift-groups (re n) + (replace-regexp-in-string + "\\\\(\\?\\([0-9]+\\):" + (lambda (s) + (replace-match + (number-to-string (+ n (string-to-number (match-string 1 s)))) + t t s 1)) + re t t)) + +(defmacro syntax-propertize-rules (&rest rules) + "Make a function that applies RULES for use in `syntax-propertize-function'. +The function will scan the buffer, applying the rules where they match. +The buffer is scanned a single time, like \"lex\" would, rather than once +per rule. + +Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP +is an expression (evaluated at time of macro-expansion) that returns a regexp, +and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to +apply the property SYNTAX to the chars matched by the subgroup NUMBER +of the regular expression, if NUMBER did match. +SYNTAX is an expression that returns a value to apply as `syntax-table' +property. Some expressions are handled specially: +- if SYNTAX is a string, then it is converted with `string-to-syntax'; +- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP + will be applied to the buffer before running EXPS and if EXP is a string it + is also converted with `string-to-syntax'. +The SYNTAX expression is responsible to save the `match-data' if needed +for subsequent HIGHLIGHTs. +Also SYNTAX is free to move point, in which case RULES may not be applied to +some parts of the text or may be applied several times to other parts. + +Note: back-references in REGEXPs do not work." + (declare (debug (&rest (form &rest + (numberp + [&or stringp + ("prog1" [&or stringp def-form] def-body) + def-form]))))) + (let* ((offset 0) + (branches '()) + ;; We'd like to use a real DFA-based lexer, usually, but since Emacs + ;; doesn't have one yet, we fallback on building one large regexp + ;; and use groups to determine which branch of the regexp matched. + (re + (mapconcat + (lambda (rule) + (let ((re (eval (car rule)))) + (when (and (assq 0 rule) (cdr rules)) + ;; If there's more than 1 rule, and the rule want to apply + ;; highlight to match 0, create an extra group to be able to + ;; tell when *this* match 0 has succeeded. + (incf offset) + (setq re (concat "\\(" re "\\)"))) + (setq re (syntax-propertize--shift-groups re offset)) + (let ((code '()) + (condition + (cond + ((assq 0 rule) (if (zerop offset) t + `(match-beginning ,offset))) + ((null (cddr rule)) + `(match-beginning ,(+ offset (car (cadr rule))))) + (t + `(or ,@(mapcar + (lambda (case) + `(match-beginning ,(+ offset (car case)))) + (cdr rule)))))) + (nocode t) + (offset offset)) + ;; If some of the subgroup rules include Elisp code, then we + ;; need to set the match-data so it's consistent with what the + ;; code expects. If not, then we can simply use shifted + ;; offset in our own code. + (unless (zerop offset) + (dolist (case (cdr rule)) + (unless (stringp (cadr case)) + (setq nocode nil))) + (unless nocode + (push `(let ((md (match-data 'ints))) + ;; Keep match 0 as is, but shift everything else. + (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md)) + (set-match-data md)) + code) + (setq offset 0))) + ;; Now construct the code for each subgroup rules. + (dolist (case (cdr rule)) + (assert (null (cddr case))) + (let* ((gn (+ offset (car case))) + (action (nth 1 case)) + (thiscode + (cond + ((stringp action) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax action)))) + ((eq (car-safe action) 'ignore) + (cdr action)) + ((eq (car-safe action) 'prog1) + (if (stringp (nth 1 action)) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax (nth 1 action))) + ,@(nthcdr 2 action)) + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,(nth 1 action))) + (if syntax + (put-text-property + mb me 'syntax-table syntax)) + ,@(nthcdr 2 action))))) + (t + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,action)) + (if syntax + (put-text-property + mb me 'syntax-table syntax)))))))) + + (if (or (not (cddr rule)) (zerop gn)) + (setq code (nconc (nreverse thiscode) code)) + (push `(if (match-beginning ,gn) + ;; Try and generate clean code with no + ;; extraneous progn. + ,(if (null (cdr thiscode)) + (car thiscode) + `(progn ,@thiscode))) + code)))) + (push (cons condition (nreverse code)) + branches)) + (incf offset (regexp-opt-depth re)) + re)) + rules + "\\|"))) + `(lambda (start end) + (goto-char start) + (while (and (< (point) end) + (re-search-forward ,re end t)) + (cond ,@(nreverse branches)))))) + +(defun syntax-propertize-via-font-lock (keywords) + "Propertize for syntax in START..END using font-lock syntax. +KEYWORDS obeys the format used in `font-lock-syntactic-keywords'. +The return value is a function suitable for `syntax-propertize-function'." + (lexical-let ((keywords keywords)) + (lambda (start end) + (with-no-warnings + (let ((font-lock-syntactic-keywords keywords)) + (font-lock-fontify-syntactic-keywords-region start end) + ;; In case it was eval'd/compiled. + (setq keywords font-lock-syntactic-keywords)))))) + +(defun syntax-propertize (pos) + "Ensure that syntax-table properties are set upto POS." + (when (and syntax-propertize-function + (< syntax-propertize--done pos)) + ;; (message "Needs to syntax-propertize from %s to %s" + ;; syntax-propertize--done pos) + (set (make-local-variable 'parse-sexp-lookup-properties) t) + (save-excursion + (with-silent-modifications + (let* ((start (max syntax-propertize--done (point-min))) + (end (max pos + (min (point-max) + (+ start syntax-propertize-chunk-size)))) + (funs syntax-propertize-extend-region-functions)) + (while funs + (let ((new (funcall (pop funs) start end))) + (if (or (null new) + (and (>= (car new) start) (<= (cdr new) end))) + nil + (setq start (car new)) + (setq end (cdr new)) + ;; If there's been a change, we should go through the + ;; list again since this new position may + ;; warrant a different answer from one of the funs we've + ;; already seen. + (unless (eq funs + (cdr syntax-propertize-extend-region-functions)) + (setq funs syntax-propertize-extend-region-functions))))) + ;; Move the limit before calling the function, so the function + ;; can use syntax-ppss. + (setq syntax-propertize--done end) + ;; (message "syntax-propertizing from %s to %s" start end) + (remove-text-properties start end + '(syntax-table nil syntax-multiline nil)) + (funcall syntax-propertize-function start end)))))) + +;;; Incrementally compute and memoize parser state. + (defsubst syntax-ppss-depth (ppss) (nth 0 ppss)) @@ -92,6 +334,8 @@ (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) (defun syntax-ppss-flush-cache (beg &rest ignored) "Flush the cache of `syntax-ppss' starting at position BEG." + ;; Set syntax-propertize to refontify anything past beg. + (setq syntax-propertize--done (min beg syntax-propertize--done)) ;; Flush invalid cache entries. (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) (setq syntax-ppss-cache (cdr syntax-ppss-cache))) @@ -128,6 +372,7 @@ Point is at POS when this function returns." ;; Default values. (unless pos (setq pos (point))) + (syntax-propertize pos) ;; (let ((old-ppss (cdr syntax-ppss-last)) (old-pos (car syntax-ppss-last))
--- a/lisp/font-lock.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/font-lock.el Sun Sep 12 22:46:48 2010 +0000 @@ -544,6 +544,8 @@ contexts will not be affected. This is normally set via `font-lock-defaults'.") +(make-obsolete-variable 'font-lock-syntactic-keywords + 'syntax-propertize-function "24.1") (defvar font-lock-syntax-table nil "Non-nil means use this syntax table for fontifying. @@ -1133,8 +1135,14 @@ (setq beg font-lock-beg end font-lock-end)) ;; Now do the fontification. (font-lock-unfontify-region beg end) - (when font-lock-syntactic-keywords - (font-lock-fontify-syntactic-keywords-region beg end)) + (when (and font-lock-syntactic-keywords + (null syntax-propertize-function)) + ;; Ensure the beginning of the file is properly syntactic-fontified. + (let ((start beg)) + (when (< font-lock-syntactically-fontified start) + (setq start (max font-lock-syntactically-fontified (point-min))) + (setq font-lock-syntactically-fontified end)) + (font-lock-fontify-syntactic-keywords-region start end))) (unless font-lock-keywords-only (font-lock-fontify-syntactically-region beg end loudly)) (font-lock-fontify-keywords-region beg end loudly))))) @@ -1437,11 +1445,6 @@ ;; We wouldn't go through so much trouble if we didn't intend to use those ;; properties, would we? (set (make-local-variable 'parse-sexp-lookup-properties) t)) - ;; Ensure the beginning of the file is properly syntactic-fontified. - (when (and font-lock-syntactically-fontified - (< font-lock-syntactically-fontified start)) - (setq start (max font-lock-syntactically-fontified (point-min))) - (setq font-lock-syntactically-fontified end)) ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords. (when (symbolp font-lock-syntactic-keywords) (setq font-lock-syntactic-keywords (font-lock-eval-keywords @@ -1487,6 +1490,7 @@ (defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." + (syntax-propertize end) ; Apply any needed syntax-table properties. (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote
--- a/lisp/gnus/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/gnus/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,14 @@ +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set, + then do request scans from the backends. + + * gnus-sum.el (gnus-summary-update-hook): Change default to nil, to + avoid running a hook per line, since this takes a lot of time, + profiling shows. + (gnus-summary-prepare-threads): Call `gnus-summary-highlight-line' + directly if gnus-visual-p is true. + 2010-09-10 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-start.el (gnus-read-active-for-groups): Check only subscribed
--- a/lisp/gnus/gnus-start.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/gnus/gnus-start.el Sun Sep 12 22:46:48 2010 +0000 @@ -2048,8 +2048,9 @@ (gnus-message 5 mesg) (when (gnus-check-server method) ;; Request that the backend scan its incoming messages. - (when (and gnus-agent - (gnus-online method) + (when (and (or (and gnus-agent + (gnus-online method)) + (not gnus-agent)) (gnus-check-backend-function 'request-scan (car method))) (if infos (dolist (info infos)
--- a/lisp/gnus/gnus-sum.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Sep 12 22:46:48 2010 +0000 @@ -985,8 +985,7 @@ :group 'gnus-various :type 'hook) -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) +(defcustom gnus-summary-update-hook nil "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. @@ -3753,6 +3752,7 @@ (error (gnus-message 5 "Error updating the summary line"))) (when (gnus-visual-p 'summary-highlight 'highlight) (forward-line -1) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)))) @@ -3785,6 +3785,7 @@ 'score)) ;; Do visual highlighting. (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook))))) (defvar gnus-tmp-new-adopts nil) @@ -5363,7 +5364,9 @@ 'gnus-number number) (when gnus-visual-p (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) + (gnus-summary-highlight-line) + (when gnus-summary-update-hook + (gnus-run-hooks 'gnus-summary-update-hook)) (forward-line 1)) (setq gnus-tmp-prev-subject simp-subject))) @@ -10734,6 +10737,7 @@ (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook)) t)
--- a/lisp/net/netrc.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/net/netrc.el Sun Sep 12 22:46:48 2010 +0000 @@ -54,12 +54,19 @@ "Netrc configuration." :group 'comm) +(defcustom netrc-file "~/.authinfo" + "File where user credentials are stored." + :type 'file + :group 'netrc) + (defvar netrc-services-file "/etc/services" "The name of the services file.") -(defun netrc-parse (file) +(defun netrc-parse (&optional file) (interactive "fFile to Parse: ") "Parse FILE and return a list of all entries in the file." + (unless file + (setq file netrc-file)) (if (listp file) file (when (file-exists-p file) @@ -221,6 +228,19 @@ (eq type (car (cddr service))))))) (cadr service))) +(defun netrc-credentials (machine &rest ports) + "Return a user name/password pair. +Port specifications will be prioritised in the order they are +listed in the PORTS list." + (let ((list (netrc-parse)) + found) + (while (and ports + (not found)) + (setq found (netrc-machine list machine (pop ports)))) + (when found + (list (cdr (assoc "login" found)) + (cdr (assoc "password" found)))))) + (provide 'netrc) ;;; netrc.el ends here
--- a/lisp/net/rcirc.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/net/rcirc.el Sun Sep 12 22:46:48 2010 +0000 @@ -774,42 +774,64 @@ (setq rcirc-input-ring-index (1- rcirc-input-ring-index)) (insert (rcirc-prev-input-string -1)))) -(defvar rcirc-nick-completions nil) -(defvar rcirc-nick-completion-start-offset nil) +(defvar rcirc-server-commands + '("/admin" "/away" "/connect" "/die" "/error" "/info" + "/invite" "/ison" "/join" "/kick" "/kill" "/links" + "/list" "/lusers" "/mode" "/motd" "/names" "/nick" + "/notice" "/oper" "/part" "/pass" "/ping" "/pong" + "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist" + "/server" "/squery" "/squit" "/stats" "/summon" "/time" + "/topic" "/trace" "/user" "/userhost" "/users" "/version" + "/wallops" "/who" "/whois" "/whowas") + "A list of user commands by IRC server. +The value defaults to RFCs 1459 and 2812.") + +;; /me and /ctcp are not defined by `defun-rcirc-command'. +(defvar rcirc-client-commands '("/me" "/ctcp") + "A list of user commands defined by IRC client rcirc. +The list is updated automatically by `defun-rcirc-command'.") -(defun rcirc-complete-nick () - "Cycle through nick completions from list of nicks in channel." +(defun rcirc-completion-at-point () + "Function used for `completion-at-point-functions' in `rcirc-mode'." + (let* ((beg (save-excursion + (if (re-search-backward " " rcirc-prompt-end-marker t) + (1+ (point)) + rcirc-prompt-end-marker))) + (table (if (and (= beg rcirc-prompt-end-marker) + (eq (char-after beg) ?/)) + (delete-dups + (nconc + (sort (copy-sequence rcirc-client-commands) 'string-lessp) + (sort (copy-sequence rcirc-server-commands) 'string-lessp))) + (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))) + (list beg (point) table))) + +(defvar rcirc-completions nil) +(defvar rcirc-completion-start nil) + +(defun rcirc-complete () + "Cycle through completions from list of nicks in channel or IRC commands. +IRC command completion is performed only if '/' is the first input char." (interactive) (if (eq last-command this-command) - (setq rcirc-nick-completions - (append (cdr rcirc-nick-completions) - (list (car rcirc-nick-completions)))) - (setq rcirc-nick-completion-start-offset - (- (save-excursion - (if (re-search-backward " " rcirc-prompt-end-marker t) - (1+ (point)) - rcirc-prompt-end-marker)) - rcirc-prompt-end-marker)) - (setq rcirc-nick-completions - (let ((completion-ignore-case t)) - (all-completions - (buffer-substring - (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (mapcar (lambda (x) (cons x nil)) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)))))) - (let ((completion (car rcirc-nick-completions))) + (setq rcirc-completions + (append (cdr rcirc-completions) (list (car rcirc-completions)))) + (let ((completion-ignore-case t) + (table (rcirc-completion-at-point))) + (setq rcirc-completion-start (car table)) + (setq rcirc-completions + (all-completions (buffer-substring rcirc-completion-start + (cadr table)) + (nth 2 table))))) + (let ((completion (car rcirc-completions))) (when completion - (delete-region (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (insert (concat completion - (if (= (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - rcirc-prompt-end-marker) - ": ")))))) + (delete-region rcirc-completion-start (point)) + (insert + (concat completion + (cond + ((= (aref completion 0) ?/) " ") + ((= rcirc-completion-start rcirc-prompt-end-marker) ": ") + (t ""))))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." @@ -827,7 +849,7 @@ (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) -(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick) +(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete) (define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) (define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) @@ -948,6 +970,9 @@ rcirc-buffer-alist)))) (rcirc-update-short-buffer-names)) + (add-hook 'completion-at-point-functions + 'rcirc-completion-at-point nil 'local) + (run-hooks 'rcirc-mode-hook)) (defun rcirc-update-prompt (&optional all) @@ -2004,16 +2029,18 @@ ;; containing the text following the /cmd. (defmacro defun-rcirc-command (command argument docstring interactive-form - &rest body) + &rest body) "Define a command." - `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) - (,@argument &optional process target) - ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - ,interactive-form - (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) - ,@body))) + `(progn + (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) + (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) + (,@argument &optional process target) + ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + ,interactive-form + (let ((process (or process (rcirc-buffer-process))) + (target (or target rcirc-target))) + ,@body)))) (defun-rcirc-command msg (message) "Send private MESSAGE to TARGET."
--- a/lisp/progmodes/ada-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/ada-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -834,10 +834,7 @@ ;; ;; On Emacs, this is done through the `syntax-table' text property. The ;; corresponding action is applied automatically each time the buffer -;; changes. If `font-lock-mode' is enabled (the default) the action is -;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it -;; manually in `ada-after-change-function'. The proper method is -;; installed by `ada-handle-syntax-table-properties'. +;; changes via syntax-propertize-function. ;; ;; on XEmacs, the `syntax-table' property does not exist and we have to use a ;; slow advice to `parse-partial-sexp' to do the same thing. @@ -937,6 +934,12 @@ (insert (caddar change)) (setq change (cdr change))))))) +(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table + ;; properties, and in some cases we even had to do it manually (in + ;; `ada-after-change-function'). `ada-handle-syntax-table-properties' + ;; decides which method to use. + (defun ada-set-syntax-table-properties () "Assign `syntax-table' properties in accessible part of buffer. In particular, character constants are said to be strings, #...# @@ -991,6 +994,8 @@ ;; Take care of `syntax-table' properties manually. (ada-initialize-syntax-table-properties))) +) ;;(not (fboundp 'syntax-propertize)) + ;;------------------------------------------------------------------ ;; Testing the grammatical context ;;------------------------------------------------------------------ @@ -1187,8 +1192,13 @@ '(ada-font-lock-keywords nil t ((?\_ . "w") (?# . ".")) - beginning-of-line - (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) + beginning-of-line)) + + (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords)) + (set (make-local-variable 'font-lock-syntactic-keywords) + ada-font-lock-syntactic-keywords)) ;; Set up support for find-file.el. (set (make-local-variable 'ff-other-file-alist) @@ -1331,7 +1341,8 @@ ;; Run this after the hook to give the users a chance to activate ;; font-lock-mode - (unless (featurep 'xemacs) + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) (ada-initialize-syntax-table-properties) (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
--- a/lisp/progmodes/autoconf.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/autoconf.el Sun Sep 12 22:46:48 2010 +0000 @@ -43,9 +43,6 @@ (defvar autoconf-mode-hook nil "Hook run by `autoconf-mode'.") -(defconst autoconf-font-lock-syntactic-keywords - '(("\\<dnl\\>" 0 '(11)))) - (defconst autoconf-definition-regexp "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*") @@ -94,8 +91,8 @@ "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") (set (make-local-variable 'comment-start) "dnl ") (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +") - (set (make-local-variable 'font-lock-syntactic-keywords) - autoconf-font-lock-syntactic-keywords) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) (set (make-local-variable 'font-lock-defaults) `(autoconf-font-lock-keywords nil nil (("_" . "w")))) (set (make-local-variable 'imenu-generic-expression)
--- a/lisp/progmodes/cfengine.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/cfengine.el Sun Sep 12 22:46:48 2010 +0000 @@ -83,12 +83,6 @@ ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) -(defconst cfengine-font-lock-syntactic-keywords - ;; In the main syntax-table, backslash is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to recognize - ;; the cases where backslash is used as an escape inside strings. - '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\"))) - (defvar cfengine-imenu-expression `((nil ,(concat "^[ \t]*" (eval-when-compile (regexp-opt cfengine-actions t)) @@ -237,13 +231,15 @@ (set (make-local-variable 'fill-paragraph-function) #'cfengine-fill-paragraph) (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs) - ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of - ;; functions in evaluated classes to string syntax, and then obey - ;; syntax properties. (setq font-lock-defaults - '(cfengine-font-lock-keywords nil nil nil beginning-of-line - (font-lock-syntactic-keywords - . cfengine-font-lock-syntactic-keywords))) + '(cfengine-font-lock-keywords nil nil nil beginning-of-line)) + ;; Fixme: set the args of functions in evaluated classes to string + ;; syntax, and then obey syntax properties. + (set (make-local-variable 'syntax-propertize-function) + ;; In the main syntax-table, \ is marked as a punctuation, because + ;; of its use in DOS-style directory separators. Here we try to + ;; recognize the cases where \ is used as an escape inside strings. + (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) (setq imenu-generic-expression cfengine-imenu-expression) (set (make-local-variable 'beginning-of-defun-function) #'cfengine-beginning-of-defun)
--- a/lisp/progmodes/cperl-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/cperl-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -1840,7 +1840,13 @@ (make-local-variable 'cperl-syntax-state) (setq cperl-syntax-state nil) ; reset syntaxification cache (if cperl-use-syntax-table-text-property - (progn + (if (boundp 'syntax-propertize-function) + (progn + ;; Reset syntaxification cache. + (set (make-local-variable 'cperl-syntax-done-to) nil) + (set (make-local-variable 'syntax-propertize-function) + (lambda (start end) + (goto-char start) (cperl-fontify-syntaxically end)))) (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t)
--- a/lisp/progmodes/fortran.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/fortran.el Sun Sep 12 22:46:48 2010 +0000 @@ -483,6 +483,7 @@ "Maximum highlighting for Fortran mode. Consists of level 3 plus all other intrinsics not already highlighted.") +(defvar fortran--font-lock-syntactic-keywords) ;; Comments are real pain in Fortran because there is no way to ;; represent the standard comment syntax in an Emacs syntax table. ;; (We can do so for F90-style). Therefore an unmatched quote in a @@ -887,9 +888,11 @@ fortran-font-lock-keywords-3 fortran-font-lock-keywords-4) nil t ((?/ . "$/") ("_$" . "w")) - fortran-beginning-of-subprogram - (font-lock-syntactic-keywords - . fortran-font-lock-syntactic-keywords))) + fortran-beginning-of-subprogram)) + (set (make-local-variable 'fortran--font-lock-syntactic-keywords) + (fortran-make-syntax-propertize-function)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords)) (set (make-local-variable 'imenu-case-fold-search) t) (set (make-local-variable 'imenu-generic-expression) fortran-imenu-generic-expression) @@ -917,10 +920,13 @@ (when (eq major-mode 'fortran-mode) (setq fortran-line-length nchars fill-column fortran-line-length - new (fortran-font-lock-syntactic-keywords)) + new (fortran-make-syntax-propertize-function)) ;; Refontify only if necessary. - (unless (equal new font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords new) + (unless (equal new fortran--font-lock-syntactic-keywords) + (setq fortran--font-lock-syntactic-keywords new) + (setq syntax-propertize-function + (syntax-propertize-via-font-lock new)) + (syntax-ppss-flush-cache (point-min)) (if font-lock-mode (font-lock-mode 1)))))) (if global (buffer-list)
--- a/lisp/progmodes/gud.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/gud.el Sun Sep 12 22:46:48 2010 +0000 @@ -3123,10 +3123,12 @@ ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) -(defvar gdb-script-font-lock-syntactic-keywords - '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ("^end\\>" - (0 (unless (eq (match-beginning 0) (point-min)) +(defconst gdb-script-syntax-propertize-function + (syntax-propertize-rules + ("^document\\s-.*\\(\n\\)" (1 "< b")) + ("^end\\(\\>\\)" + (1 (ignore + (unless (eq (match-beginning 0) (point-min)) ;; We change the \n in front, which is more difficult, but results ;; in better highlighting. If the doc is empty, the single \n is ;; both the beginning and the end of the docstring, which can't be @@ -3138,10 +3140,9 @@ 'syntax-table (eval-when-compile (string-to-syntax "> b"))) ;; Make sure that rehighlighting the previous line won't erase our - ;; syntax-table property. + ;; syntax-table property and that modifying `end' will. (put-text-property (1- (match-beginning 0)) (match-end 0) - 'font-lock-multiline t) - nil))))) + 'syntax-multiline t))))))) (defun gdb-script-font-lock-syntactic-face (state) (cond @@ -3239,10 +3240,13 @@ #'gdb-script-end-of-defun) (set (make-local-variable 'font-lock-defaults) '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-keywords - . gdb-script-font-lock-syntactic-keywords) (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face)))) + . gdb-script-font-lock-syntactic-face))) + ;; Recognize docstrings. + (set (make-local-variable 'syntax-propertize-function) + gdb-script-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local)) ;;; tooltips for GUD
--- a/lisp/progmodes/js.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/js.el Sun Sep 12 22:46:48 2010 +0000 @@ -1660,18 +1660,19 @@ ;; XXX: Javascript can continue a regexp literal across lines so long ;; as the newline is escaped with \. Account for that in the regexp ;; below. -(defconst js--regexp-literal +(eval-and-compile + (defconst js--regexp-literal "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)" "Regexp matching a JavaScript regular expression literal. Match groups 1 and 2 are the characters forming the beginning and -end of the literal.") - -;; we want to match regular expressions only at the beginning of -;; expressions -(defconst js-font-lock-syntactic-keywords - `((,js--regexp-literal (1 "|") (2 "|"))) - "Syntactic font lock keywords matching regexps in JavaScript. -See `font-lock-keywords'.") +end of the literal.")) + + +(defconst js-syntax-propertize-function + (syntax-propertize-rules + ;; We want to match regular expressions only at the beginning of + ;; expressions. + (js--regexp-literal (1 "\"") (2 "\"")))) ;;; Indentation @@ -3303,10 +3304,9 @@ (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) (set (make-local-variable 'font-lock-defaults) - (list js--font-lock-keywords - nil nil nil nil - '(font-lock-syntactic-keywords - . js-font-lock-syntactic-keywords))) + '(js--font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + js-syntax-propertize-function) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'parse-sexp-lookup-properties) t)
--- a/lisp/progmodes/make-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/make-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -505,15 +505,16 @@ cpp-font-lock-keywords)) -(defconst makefile-font-lock-syntactic-keywords - ;; From sh-script.el. - ;; A `#' begins a comment in sh when it is unquoted and at the beginning - ;; of a word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec of the - ;; shell command language (under `quoting') but with `$' removed. - '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_") - ;; Change the syntax of a quoted newline so that it does not end a comment. - ("\\\\\n" 0 "."))) +(defconst makefile-syntax-propertize-function + (syntax-propertize-rules + ;; From sh-script.el. + ;; A `#' begins a comment in sh when it is unquoted and at the beginning + ;; of a word. In the shell, words are separated by metacharacters. + ;; The list of special chars is taken from the single-unix spec of the + ;; shell command language (under `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; Change the syntax of a quoted newline so that it does not end a comment. + ("\\\\\n" (0 ".")))) (defvar makefile-imenu-generic-expression `(("Dependencies" makefile-previous-dependency 1) @@ -872,9 +873,9 @@ '(makefile-font-lock-keywords nil nil ((?$ . ".")) - backward-paragraph - (font-lock-syntactic-keywords - . makefile-font-lock-syntactic-keywords))) + backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + makefile-syntax-propertize-function) ;; Add-log. (set (make-local-variable 'add-log-current-defun-function) @@ -943,15 +944,9 @@ (define-derived-mode makefile-imake-mode makefile-mode "Imakefile" "An adapted `makefile-mode' that knows about imake." :syntax-table makefile-imake-mode-syntax-table - (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))) - new) - ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults. - (mapc (lambda (elt) - (unless (and (consp elt) - (eq (car elt) 'font-lock-syntactic-keywords)) - (setq new (cons elt new)))) - base) - (setq font-lock-defaults (nreverse new)))) + (set (make-local-variable 'syntax-propertize-function) nil) + (setq font-lock-defaults + `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
--- a/lisp/progmodes/mixal-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/mixal-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -89,7 +89,7 @@ (defvar mixal-mode-syntax-table (let ((st (make-syntax-table))) ;; We need to do a bit more to make fontlocking for comments work. - ;; See mixal-font-lock-syntactic-keywords. + ;; See use of syntax-propertize-function. ;; (modify-syntax-entry ?* "<" st) (modify-syntax-entry ?\n ">" st) st) @@ -1028,13 +1028,14 @@ ;;; Font-locking: -(defvar mixal-font-lock-syntactic-keywords - ;; Normal comments start with a * in column 0 and end at end of line. - '(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11) - ;; Every line can end with a comment which is placed after the operand. - ;; I assume here that mnemonics without operands can not have a comment. - ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" - (1 '(11))))) +(defconst mixal-syntax-propertize-function + (syntax-propertize-rules + ;; Normal comments start with a * in column 0 and end at end of line. + ("^\\*" (0 "<")) + ;; Every line can end with a comment which is placed after the operand. + ;; I assume here that mnemonics without operands can not have a comment. + ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" + (1 "<")))) (defvar mixal-font-lock-keywords `(("^\\([A-Z0-9a-z]+\\)" @@ -1110,9 +1111,9 @@ (set (make-local-variable 'comment-start) "*") (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") (set (make-local-variable 'font-lock-defaults) - `(mixal-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + `(mixal-font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + mixal-syntax-propertize-function) ;; might add an indent function in the future ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) (set (make-local-variable 'compile-command) (concat "mixasm "
--- a/lisp/progmodes/octave-mod.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/octave-mod.el Sun Sep 12 22:46:48 2010 +0000 @@ -179,38 +179,28 @@ '(3 font-lock-function-name-face nil t))) "Additional Octave expressions to highlight.") -(defvar octave-font-lock-syntactic-keywords +(defun octave-syntax-propertize-function (start end) + (goto-char start) + (octave-syntax-propertize-sqs end) + (funcall (syntax-propertize-rules ;; Try to distinguish the string-quotes from the transpose-quotes. - '(("[[({,; ]\\('\\)" (1 "\"'")) - (octave-font-lock-close-quotes))) + ("[[({,; ]\\('\\)" + (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) + (point) end)) -(defun octave-font-lock-close-quotes (limit) - "Fix the syntax-table of the closing quotes of single-quote strings." - ;; Freely inspired from perl-font-lock-special-syntactic-constructs. - (let ((state (syntax-ppss))) - (while (< (point) limit) - (cond - ((eq (nth 3 state) ?\') +(defun octave-syntax-propertize-sqs (end) + "Propertize the content/end of single-quote strings." + (when (eq (nth 3 (syntax-ppss)) ?\') ;; A '..' string. - (save-excursion - (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']" - nil t) - (goto-char (1- (point))) - ;; Remove any syntax-table property we may have applied to - ;; some of the (doubled) single quotes within the string. - ;; Since these are the only chars on which we place properties, - ;; we take a shortcut and just remove all properties. - (remove-text-properties (1+ (nth 8 state)) (match-beginning 1) - '(syntax-table nil)) + (when (re-search-forward + "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) + (goto-char (match-beginning 2)) (when (eq (char-before (match-beginning 1)) ?\\) ;; Backslash cannot escape a single quote. (put-text-property (1- (match-beginning 1)) (match-beginning 1) 'syntax-table (string-to-syntax "."))) (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "\"'")))))) - - (setq state (parse-partial-sexp (point) limit nil nil state - 'syntax-table))))) + 'syntax-table (string-to-syntax "\"'"))))) (defcustom inferior-octave-buffer "*Inferior Octave*" "Name of buffer for running an inferior Octave process." @@ -684,9 +674,10 @@ (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) (set (make-local-variable 'font-lock-defaults) - '(octave-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords . octave-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + '(octave-font-lock-keywords)) + + (set (make-local-variable 'syntax-propertize-function) + #'octave-syntax-propertize-function) (set (make-local-variable 'imenu-generic-expression) octave-mode-imenu-generic-expression)
--- a/lisp/progmodes/perl-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/perl-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -250,59 +250,76 @@ ;; y /.../.../ ;; ;; <file*glob> -(defvar perl-font-lock-syntactic-keywords - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") - `(;; Turn POD into b-style comments - ("^\\(=\\)\\sw" (1 "< b")) - ("^=cut[ \t]*\\(\n\\)" (1 "> b")) - ;; Catch ${ so that ${var} doesn't screw up indentation. - ;; This also catches $' to handle 'foo$', although it should really - ;; check that it occurs inside a '..' string. - ("\\(\\$\\)[{']" (1 ". p")) - ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) - ;; format statements - ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) - ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. - ;; Be careful not to match "sub { (...) ... }". - ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" - 1 '(1)) - ;; Regexp and funny quotes. Distinguishing a / that starts a regexp - ;; match from the division operator is ...interesting. - ;; Basically, / is a regexp match if it's preceded by an infix operator - ;; (or some similar separator), or by one of the special keywords - ;; corresponding to builtin functions that can take their first arg - ;; without parentheses. Of course, that presume we're looking at the - ;; *opening* slash. We can afford to mis-match the closing ones - ;; here, because they will be re-treated separately later in - ;; perl-font-lock-special-syntactic-constructs. - (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" - (regexp-opt '("split" "if" "unless" "until" "while" "split" - "grep" "map" "not" "or" "and")) - "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") - (2 (if (and (match-end 1) - (save-excursion - (goto-char (match-end 1)) - ;; Not 100% correct since we haven't finished setting up - ;; the syntax-table before point, but better than nothing. - (forward-comment (- (point-max))) - (put-text-property (point) (match-end 2) - 'jit-lock-defer-multiline t) - (not (memq (char-before) - '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) - nil ;; A division sign instead of a regexp-match. - '(7)))) - ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" - ;; Nasty cases: - ;; /foo/m $a->m $#m $m @m %m - ;; \s (appears often in regexps). - ;; -s file - (3 (if (assoc (char-after (match-beginning 3)) - perl-quote-like-pairs) - '(15) '(7)))) - ;; Find and mark the end of funny quotes and format statements. - (perl-font-lock-special-syntactic-constructs) - )) +(defun perl-syntax-propertize-function (start end) + (let ((case-fold-search nil)) + (goto-char start) + (perl-syntax-propertize-special-constructs end) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + (funcall + (syntax-propertize-rules + ;; Turn POD into b-style comments. Place the cut rule first since it's + ;; more specific. + ("^=cut\\>.*\\(\n\\)" (1 "> b")) + ("^\\(=\\)\\sw" (1 "< b")) + ;; Catch ${ so that ${var} doesn't screw up indentation. + ;; This also catches $' to handle 'foo$', although it should really + ;; check that it occurs inside a '..' string. + ("\\(\\$\\)[{']" (1 ". p")) + ;; Handle funny names like $DB'stop. + ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ;; format statements + ("^[ \t]*format.*=[ \t]*\\(\n\\)" + (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) + ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. + ;; Be careful not to match "sub { (...) ... }". + ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" + (1 ".")) + ;; Regexp and funny quotes. Distinguishing a / that starts a regexp + ;; match from the division operator is ...interesting. + ;; Basically, / is a regexp match if it's preceded by an infix operator + ;; (or some similar separator), or by one of the special keywords + ;; corresponding to builtin functions that can take their first arg + ;; without parentheses. Of course, that presume we're looking at the + ;; *opening* slash. We can afford to mis-match the closing ones + ;; here, because they will be re-treated separately later in + ;; perl-font-lock-special-syntactic-constructs. + ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" + (regexp-opt '("split" "if" "unless" "until" "while" "split" + "grep" "map" "not" "or" "and")) + "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") + (2 (ignore + (if (and (match-end 1) ; / at BOL. + (save-excursion + (goto-char (match-end 1)) + (forward-comment (- (point-max))) + (put-text-property (point) (match-end 2) + 'syntax-multiline t) + (not (memq (char-before) + '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) + nil ;; A division sign instead of a regexp-match. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "\"")) + (perl-syntax-propertize-special-constructs end))))) + ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" + ;; Nasty cases: + ;; /foo/m $a->m $#m $m @m %m + ;; \s (appears often in regexps). + ;; -s file + ;; sub tr {...} + (3 (ignore + (if (save-excursion (goto-char (match-beginning 0)) + (forward-word -1) + (looking-at-p "sub[ \t\n]")) + ;; This is defining a function. + nil + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table + (if (assoc (char-after (match-beginning 3)) + perl-quote-like-pairs) + (string-to-syntax "|") + (string-to-syntax "\""))) + (perl-syntax-propertize-special-constructs end)))))) + (point) end))) (defvar perl-empty-syntax-table (let ((st (copy-syntax-table))) @@ -321,95 +338,123 @@ (modify-syntax-entry close ")" st)) st)) -(defun perl-font-lock-special-syntactic-constructs (limit) - ;; We used to do all this in a font-lock-syntactic-face-function, which - ;; did not work correctly because sometimes some parts of the buffer are - ;; treated with font-lock-syntactic-keywords but not with - ;; font-lock-syntactic-face-function (mostly because of - ;; font-lock-syntactically-fontified). That meant that some syntax-table - ;; properties were missing. So now we do the parse-partial-sexp loop - ;; ourselves directly from font-lock-syntactic-keywords, so we're sure - ;; it's done when necessary. +(defun perl-syntax-propertize-special-constructs (limit) + "Propertize special constructs like regexps and formats." (let ((state (syntax-ppss)) char) - (while (< (point) limit) - (cond - ((or (null (setq char (nth 3 state))) - (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) - ;; Normal text, or comment, or docstring, or normal string. - nil) - ((eq (nth 3 state) ?\n) - ;; A `format' command. - (save-excursion - (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) - (not (eobp))) - (put-text-property (point) (1+ (point)) 'syntax-table '(7))))) - (t - ;; This is regexp like quote thingy. - (setq char (char-after (nth 8 state))) - (save-excursion - (let ((twoargs (save-excursion - (goto-char (nth 8 state)) - (skip-syntax-backward " ") - (skip-syntax-backward "w") - (member (buffer-substring - (point) (progn (forward-word 1) (point))) - '("tr" "s" "y")))) - (close (cdr (assq char perl-quote-like-pairs))) - (pos (point)) - (st (perl-quote-syntax-table char))) - (if (not close) - ;; The closing char is the same as the opening char. - (with-syntax-table st - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table) - (when twoargs - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table))) - ;; The open/close chars are matched like () [] {} and <>. - (let ((parse-sexp-lookup-properties nil)) - (condition-case err - (progn - (with-syntax-table st - (goto-char (nth 8 state)) (forward-sexp 1)) - (when twoargs - (save-excursion - ;; Skip whitespace and make sure that font-lock will - ;; refontify the second part in the proper context. - (put-text-property - (point) (progn (forward-comment (point-max)) (point)) - 'font-lock-multiline t) - ;; - (unless - (or (eobp) - (save-excursion - (with-syntax-table - (perl-quote-syntax-table (char-after)) - (forward-sexp 1)) - (put-text-property pos (line-end-position) - 'jit-lock-defer-multiline t) - (looking-at "\\s-*\\sw*e"))) - (put-text-property (point) (1+ (point)) - 'syntax-table - (if (assoc (char-after) - perl-quote-like-pairs) - '(15) '(7))))))) - ;; The arg(s) is not terminated, so it extends until EOB. - (scan-error (goto-char (point-max)))))) - ;; Point is now right after the arg(s). - ;; Erase any syntactic marks within the quoted text. - (put-text-property pos (1- (point)) 'syntax-table nil) - (when (eq (char-before (1- (point))) ?$) - (put-text-property (- (point) 2) (1- (point)) - 'syntax-table '(1))) - (put-text-property (1- (point)) (point) - 'syntax-table (if close '(15) '(7))))))) + (cond + ((or (null (setq char (nth 3 state))) + (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) + ;; Normal text, or comment, or docstring, or normal string. + nil) + ((eq (nth 3 state) ?\n) + ;; A `format' command. + (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + (t + ;; This is regexp like quote thingy. + (setq char (char-after (nth 8 state))) + (let ((twoargs (save-excursion + (goto-char (nth 8 state)) + (skip-syntax-backward " ") + (skip-syntax-backward "w") + (member (buffer-substring + (point) (progn (forward-word 1) (point))) + '("tr" "s" "y")))) + (close (cdr (assq char perl-quote-like-pairs))) + (st (perl-quote-syntax-table char))) + (when (with-syntax-table st + (if close + ;; For paired delimiters, Perl allows nesting them, but + ;; since we treat them as strings, Emacs does not count + ;; those delimiters in `state', so we don't know how deep + ;; we are: we have to go back to the beginning of this + ;; "string" and count from there. + (condition-case nil + (progn + ;; Start after the first char since it doesn't have + ;; paren-syntax (an alternative would be to let-bind + ;; parse-sexp-lookup-properties). + (goto-char (1+ (nth 8 state))) + (up-list 1) + t) + (scan-error nil)) + (not (or (nth 8 (parse-partial-sexp + (point) limit nil nil state 'syntax-table)) + ;; If we have a self-paired opener and a twoargs + ;; command, the form is s/../../ so we have to skip + ;; a second time. + ;; In the case of s{...}{...}, we only handle the + ;; first part here and the next below. + (when (and twoargs (not close)) + (nth 8 (parse-partial-sexp + (point) limit + nil nil state 'syntax-table))))))) + ;; Point is now right after the arg(s). + (when (eq (char-before (1- (point))) ?$) + (put-text-property (- (point) 2) (1- (point)) + 'syntax-table '(1))) + (put-text-property (1- (point)) (point) + 'syntax-table + (if close + (string-to-syntax "|") + (string-to-syntax "\""))) + ;; If we have two args with a non-self-paired starter (e.g. + ;; s{...}{...}) we're right after the first arg, so we still have to + ;; handle the second part. + (when (and twoargs close) + ;; Skip whitespace and make sure that font-lock will + ;; refontify the second part in the proper context. + (put-text-property + (point) (progn (forward-comment (point-max)) (point)) + 'syntax-multiline t) + ;; + (when (< (point) limit) + (put-text-property (point) (1+ (point)) + 'syntax-table + (if (assoc (char-after) + perl-quote-like-pairs) + ;; Put an `e' in the cdr to mark this + ;; char as "second arg starter". + (string-to-syntax "|e") + (string-to-syntax "\"e"))) + (forward-char 1) + ;; Re-use perl-syntax-propertize-special-constructs to handle the + ;; second part (the first delimiter of second part can't be + ;; preceded by "s" or "tr" or "y", so it will not be considered + ;; as twoarg). + (perl-syntax-propertize-special-constructs limit))))))))) - (setq state (parse-partial-sexp (point) limit nil nil state - 'syntax-table)))) - ;; Tell font-lock that this needs not further processing. - nil) - +(defun perl-font-lock-syntactic-face-function (state) + (cond + ((and (nth 3 state) + (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) + ;; This is a second-arg of s{..}{...} form; let's check if this second + ;; arg is executable code rather than a string. For that, we need to + ;; look for an "e" after this second arg, so we have to hunt for the + ;; end of the arg. Depending on whether the whole arg has already + ;; been syntax-propertized or not, the end-char will have different + ;; syntaxes, so let's ignore syntax-properties temporarily so we can + ;; pretend it has not been syntax-propertized yet. + (let* ((parse-sexp-lookup-properties nil) + (char (char-after (nth 8 state))) + (paired (assq char perl-quote-like-pairs))) + (with-syntax-table (perl-quote-syntax-table char) + (save-excursion + (if (not paired) + (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table) + (condition-case nil + (progn + (goto-char (1+ (nth 8 state))) + (up-list 1)) + (scan-error (goto-char (point-max))))) + (put-text-property (nth 8 state) (point) + 'jit-lock-defer-multiline t) + (looking-at "[ \t]*\\sw*e"))))) + nil) + (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) (defcustom perl-indent-level 4 "*Indentation of Perl statements with respect to containing block." @@ -574,9 +619,12 @@ perl-font-lock-keywords-1 perl-font-lock-keywords-2) nil nil ((?\_ . "w")) nil - (font-lock-syntactic-keywords - . perl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + (font-lock-syntactic-face-function + . perl-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'perl-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) ;; Tell imenu how to handle Perl. (set (make-local-variable 'imenu-generic-expression) perl-imenu-generic-expression)
--- a/lisp/progmodes/python.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/python.el Sun Sep 12 22:46:48 2010 +0000 @@ -166,29 +166,32 @@ symbol-end) . font-lock-builtin-face))) -(defconst python-font-lock-syntactic-keywords +(defconst python-syntax-propertize-function ;; Make outer chars of matching triple-quote sequences into generic ;; string delimiters. Fixme: Is there a better way? ;; First avoid a sequence preceded by an odd number of backslashes. - `((,(rx (not (any ?\\)) - ?\\ (* (and ?\\ ?\\)) - (group (syntax string-quote)) - (backref 1) - (group (backref 1))) - (2 ,(string-to-syntax "\""))) ; dummy - (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property - (optional (any "rR")) ; possible second prefix - (group (syntax string-quote)) ; maybe gets property - (backref 2) ; per first quote - (group (backref 2))) ; maybe gets property - (1 (python-quote-syntax 1)) - (2 (python-quote-syntax 2)) - (3 (python-quote-syntax 3))) - ;; This doesn't really help. -;;; (,(rx (and ?\\ (group ?\n))) (1 " ")) - )) + (syntax-propertize-rules + (;; (rx (not (any ?\\)) + ;; ?\\ (* (and ?\\ ?\\)) + ;; (group (syntax string-quote)) + ;; (backref 1) + ;; (group (backref 1))) + ;; ¡Backrefs don't work in syntax-propertize-rules! + "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)" + (2 "\"")) ; dummy + (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property + ;; (optional (any "rR")) ; possible second prefix + ;; (group (syntax string-quote)) ; maybe gets property + ;; (backref 2) ; per first quote + ;; (group (backref 2))) ; maybe gets property + ;; ¡Backrefs don't work in syntax-propertize-rules! + "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)" + (3 (ignore (python-quote-syntax)))) + ;; This doesn't really help. + ;;((rx (and ?\\ (group ?\n))) (1 " ")) + )) -(defun python-quote-syntax (n) +(defun python-quote-syntax () "Put `syntax-table' property correctly on triple quote. Used for syntactic keywords. N is the match number (1, 2 or 3)." ;; Given a triple quote, we have to check the context to know @@ -206,28 +209,25 @@ ;; x '"""' x """ \"""" x (save-excursion (goto-char (match-beginning 0)) - (cond - ;; Consider property for the last char if in a fenced string. - ((= n 3) - (let* ((font-lock-syntactic-keywords nil) - (syntax (syntax-ppss))) - (when (eq t (nth 3 syntax)) ; after unclosed fence - (goto-char (nth 8 syntax)) ; fence position - (skip-chars-forward "uUrR") ; skip any prefix - ;; Is it a matching sequence? - (if (eq (char-after) (char-after (match-beginning 2))) - (eval-when-compile (string-to-syntax "|")))))) - ;; Consider property for initial char, accounting for prefixes. - ((or (and (= n 2) ; leading quote (not prefix) - (= (match-beginning 1) (match-end 1))) ; prefix is null - (and (= n 1) ; prefix - (/= (match-beginning 1) (match-end 1)))) ; non-empty - (let ((font-lock-syntactic-keywords nil)) - (unless (eq 'string (syntax-ppss-context (syntax-ppss))) - (eval-when-compile (string-to-syntax "|"))))) - ;; Otherwise (we're in a non-matching string) the property is - ;; nil, which is OK. - ))) + (let ((syntax (save-match-data (syntax-ppss)))) + (cond + ((eq t (nth 3 syntax)) ; after unclosed fence + ;; Consider property for the last char if in a fenced string. + (goto-char (nth 8 syntax)) ; fence position + (skip-chars-forward "uUrR") ; skip any prefix + ;; Is it a matching sequence? + (if (eq (char-after) (char-after (match-beginning 2))) + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table (string-to-syntax "|")))) + ((match-end 1) + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|"))) + (t + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "|")))) + ))) ;; This isn't currently in `font-lock-defaults' as probably not worth ;; it -- we basically only mess with a few normally-symbol characters. @@ -2495,12 +2495,12 @@ :group 'python (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords - . python-font-lock-syntactic-keywords) - ;; This probably isn't worth it. - ;; (font-lock-syntactic-face-function - ;; . python-font-lock-syntactic-face-function) - )) + ;; This probably isn't worth it. + ;; (font-lock-syntactic-face-function + ;; . python-font-lock-syntactic-face-function) + )) + (set (make-local-variable 'syntax-propertize-function) + python-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start) "# ")
--- a/lisp/progmodes/ruby-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/ruby-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -100,17 +100,10 @@ (defconst ruby-block-end-re "\\<end\\>") -(defconst ruby-here-doc-beg-re +(eval-and-compile + (defconst ruby-here-doc-beg-re "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" - "Regexp to match the beginning of a heredoc.") - -(defconst ruby-here-doc-end-re - "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$" - "Regexp to match the end of heredocs. - -This will actually match any line with one or more characters. -It's useful in that it divides up the match string so that -`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + "Regexp to match the beginning of a heredoc.")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -123,18 +116,6 @@ (match-string 5) (match-string 6))))) -(defun ruby-here-doc-beg-match () - "Return a regexp to find the beginning of a heredoc. - -This should only be called after matching against `ruby-here-doc-end-re'." - (let ((contents (regexp-quote (concat (match-string 2) (match-string 3))))) - (concat "<<" - (let ((match (match-string 1))) - (if (and match (> (length match) 0)) - (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)" - contents "\\b\\(\\1\\|\\2\\)") - (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) - (defconst ruby-delimiter (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" ruby-block-beg-re @@ -362,7 +343,7 @@ (back-to-indentation) (current-column))) -(defun ruby-indent-line (&optional flag) +(defun ruby-indent-line (&optional ignored) "Correct the indentation of the current Ruby line." (interactive) (ruby-indent-to (ruby-calculate-indent))) @@ -405,8 +386,7 @@ "TODO: document." (save-excursion (store-match-data nil) - (let ((space (skip-chars-backward " \t")) - (start (point))) + (let ((space (skip-chars-backward " \t"))) (cond ((bolp) t) ((progn @@ -700,7 +680,7 @@ (beginning-of-line) (let ((ruby-indent-point (point)) (case-fold-search nil) - state bol eol begin op-end + state eol begin op-end (paren (progn (skip-syntax-forward " ") (and (char-after) (matching-paren (char-after))))) (indent 0)) @@ -780,7 +760,6 @@ (if (re-search-forward "^\\s *#" end t) (beginning-of-line) (setq done t)))) - (setq bol (point)) (end-of-line) ;; skip the comment at the end (skip-chars-backward " \t") @@ -1037,10 +1016,8 @@ (ruby-beginning-of-defun) (re-search-backward "^\n" (- (point) 1) t)) -(defun ruby-indent-exp (&optional shutup-p) - "Indent each line in the balanced expression following the point. -If a prefix arg is given or SHUTUP-P is non-nil, no errors -are signalled if a balanced expression isn't found." +(defun ruby-indent-exp (&optional ignored) + "Indent each line in the balanced expression following the point." (interactive "*P") (let ((here (point-marker)) start top column (nest t)) (set-marker-insertion-type here t) @@ -1133,58 +1110,208 @@ (if mlist (concat mlist mname) mname) mlist))))) -(defconst ruby-font-lock-syntactic-keywords - `(;; #{ }, #$hoge, #@foo are not comments - ("\\(#\\)[{$@]" 1 (1 . nil)) - ;; the last $', $", $` in the respective string is not variable - ;; the last ?', ?", ?` in the respective string is not ascii code - ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" - (2 (7 . nil)) - (4 (7 . nil))) - ;; $' $" $` .... are variables - ;; ?' ?" ?` are ascii codes - ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) - ;; regexps - ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" - (4 (7 . ?/)) - (6 (7 . ?/))) - ("^=en\\(d\\)\\_>" 1 "!") - ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) - ;; Currently, the following case is highlighted incorrectly: - ;; - ;; <<FOO - ;; FOO - ;; <<BAR - ;; <<BAZ - ;; BAZ - ;; BAR - ;; - ;; This is because all here-doc beginnings are highlighted before any endings, - ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ - ;; it thinks <<BAR is part of a string so it's marked as well. - ;; - ;; This may be fixable by modifying ruby-in-here-doc-p to use - ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, - ;; but I don't want to try that until we've got unit tests set up - ;; to make sure I don't break anything else. - (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") - ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) - (ruby-here-doc-beg-syntax)) - (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) - "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") +(if (eval-when-compile (fboundp #'syntax-propertize-rules)) + ;; New code that works independently from font-lock. + (progn + (defun ruby-syntax-propertize-function (start end) + "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." + (goto-char start) + (ruby-syntax-propertize-heredoc end) + (funcall + (syntax-propertize-rules + ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" (1 ".")) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 "\"") + (4 "\"")) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 ".")) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 "\"/") + (6 "\"/")) + ("^=en\\(d\\)\\_>" (1 "!")) + ("^\\(=\\)begin\\_>" (1 "!")) + ;; Handle here documents. + ((concat ruby-here-doc-beg-re ".*\\(\n\\)") + (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end))))) + (point) end)) + + (defun ruby-syntax-propertize-heredoc (limit) + (let ((ppss (syntax-ppss)) + (res '())) + (when (eq ?\n (nth 3 ppss)) + (save-excursion + (goto-char (nth 8 ppss)) + (beginning-of-line) + (while (re-search-forward ruby-here-doc-beg-re + (line-end-position) t) + (push (concat (ruby-here-doc-end-match) "\n") res))) + (let ((start (point))) + ;; With multiple openers on the same line, we don't know in which + ;; part `start' is, so we have to go back to the beginning. + (when (cdr res) + (goto-char (nth 8 ppss)) + (setq res (nreverse res))) + (while (and res (re-search-forward (pop res) limit 'move)) + (if (null res) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + ;; Make extra sure we don't move back, lest we could fall into an + ;; inf-loop. + (if (< (point) start) (goto-char start)))))) + ) + + ;; For Emacsen where syntax-propertize-rules is not (yet) available, + ;; fallback on the old font-lock-syntactic-keywords stuff. -(defun ruby-comment-beg-syntax () - "Return the syntax cell for a the first character of a =begin. + (defconst ruby-here-doc-end-re + "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)" + "Regexp to match the end of heredocs. + +This will actually match any line with one or more characters. +It's useful in that it divides up the match string so that +`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + + (defun ruby-here-doc-beg-match () + "Return a regexp to find the beginning of a heredoc. + +This should only be called after matching against `ruby-here-doc-end-re'." + (let ((contents (regexp-quote (match-string 2)))) + (concat "<<" + (let ((match (match-string 1))) + (if (and match (> (length match) 0)) + (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)" + contents "\\b\\(\\1\\|\\2\\)") + (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) + + (defconst ruby-font-lock-syntactic-keywords + `( ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" 1 (1 . nil)) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 (7 . nil)) + (4 (7 . nil))) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 (7 . ?/)) + (6 (7 . ?/))) + ("^=en\\(d\\)\\_>" 1 "!") + ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) + ;; Currently, the following case is highlighted incorrectly: + ;; + ;; <<FOO + ;; FOO + ;; <<BAR + ;; <<BAZ + ;; BAZ + ;; BAR + ;; + ;; This is because all here-doc beginnings are highlighted before any endings, + ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ + ;; it thinks <<BAR is part of a string so it's marked as well. + ;; + ;; This may be fixable by modifying ruby-in-here-doc-p to use + ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, + ;; but I don't want to try that until we've got unit tests set up + ;; to make sure I don't break anything else. + (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") + ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) + (ruby-here-doc-beg-syntax)) + (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) + "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") + + (defun ruby-comment-beg-syntax () + "Return the syntax cell for a the first character of a =begin. See the definition of `ruby-font-lock-syntactic-keywords'. This returns a comment-delimiter cell as long as the =begin isn't in a string or another comment." - (when (not (nth 3 (syntax-ppss))) - (string-to-syntax "!"))) + (when (not (nth 3 (syntax-ppss))) + (string-to-syntax "!"))) + + (defun ruby-in-here-doc-p () + "Return whether or not the point is in a heredoc." + (save-excursion + (let ((old-point (point)) (case-fold-search nil)) + (beginning-of-line) + (catch 'found-beg + (while (re-search-backward ruby-here-doc-beg-re nil t) + (if (not (or (ruby-in-ppss-context-p 'anything) + (ruby-here-doc-find-end old-point))) + (throw 'found-beg t))))))) + + (defun ruby-here-doc-find-end (&optional limit) + "Expects the point to be on a line with one or more heredoc openers. +Returns the buffer position at which all heredocs on the line +are terminated, or nil if they aren't terminated before the +buffer position `limit' or the end of the buffer." + (save-excursion + (beginning-of-line) + (catch 'done + (let ((eol (save-excursion (end-of-line) (point))) + (case-fold-search nil) + ;; Fake match data such that (match-end 0) is at eol + (end-match-data (progn (looking-at ".*$") (match-data))) + beg-match-data end-re) + (while (re-search-forward ruby-here-doc-beg-re eol t) + (setq beg-match-data (match-data)) + (setq end-re (ruby-here-doc-end-match)) + + (set-match-data end-match-data) + (goto-char (match-end 0)) + (unless (re-search-forward end-re limit t) (throw 'done nil)) + (setq end-match-data (match-data)) -(unless (functionp 'syntax-ppss) - (defun syntax-ppss (&optional pos) - (parse-partial-sexp (point-min) (or pos (point))))) + (set-match-data beg-match-data) + (goto-char (match-end 0))) + (set-match-data end-match-data) + (goto-char (match-end 0)) + (point))))) + + (defun ruby-here-doc-beg-syntax () + "Return the syntax cell for a line that may begin a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'. + +This sets the syntax cell for the newline ending the line +containing the heredoc beginning so that cases where multiple +heredocs are started on one line are handled correctly." + (save-excursion + (goto-char (match-beginning 0)) + (unless (or (ruby-in-ppss-context-p 'non-heredoc) + (ruby-in-here-doc-p)) + (string-to-syntax "\"")))) + + (defun ruby-here-doc-end-syntax () + "Return the syntax cell for a line that may end a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'." + (let ((pss (syntax-ppss)) (case-fold-search nil)) + ;; If we aren't in a string, we definitely aren't ending a heredoc, + ;; so we can just give up. + ;; This means we aren't doing a full-document search + ;; every time we enter a character. + (when (ruby-in-ppss-context-p 'heredoc pss) + (save-excursion + (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. + (let ((eol (point))) + (beginning-of-line) + (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... + (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... + (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... + (not (re-search-forward ruby-here-doc-beg-re eol t)))) + (string-to-syntax "\""))))))) + + (unless (functionp 'syntax-ppss) + (defun syntax-ppss (&optional pos) + (parse-partial-sexp (point-min) (or pos (point))))) + ) (defun ruby-in-ppss-context-p (context &optional ppss) (let ((ppss (or ppss (syntax-ppss (point))))) @@ -1195,10 +1322,7 @@ ((eq context 'string) (nth 3 ppss)) ((eq context 'heredoc) - (and (nth 3 ppss) - ;; If it's generic string, it's a heredoc and we don't care - ;; See `parse-partial-sexp' - (not (numberp (nth 3 ppss))))) + (eq ?\n (nth 3 ppss))) ((eq context 'non-heredoc) (and (ruby-in-ppss-context-p 'anything) (not (ruby-in-ppss-context-p 'heredoc)))) @@ -1210,77 +1334,6 @@ "context name `" (symbol-name context) "' is unknown")))) t))) -(defun ruby-in-here-doc-p () - "Return whether or not the point is in a heredoc." - (save-excursion - (let ((old-point (point)) (case-fold-search nil)) - (beginning-of-line) - (catch 'found-beg - (while (re-search-backward ruby-here-doc-beg-re nil t) - (if (not (or (ruby-in-ppss-context-p 'anything) - (ruby-here-doc-find-end old-point))) - (throw 'found-beg t))))))) - -(defun ruby-here-doc-find-end (&optional limit) - "Expects the point to be on a line with one or more heredoc openers. -Returns the buffer position at which all heredocs on the line -are terminated, or nil if they aren't terminated before the -buffer position `limit' or the end of the buffer." - (save-excursion - (beginning-of-line) - (catch 'done - (let ((eol (save-excursion (end-of-line) (point))) - (case-fold-search nil) - ;; Fake match data such that (match-end 0) is at eol - (end-match-data (progn (looking-at ".*$") (match-data))) - beg-match-data end-re) - (while (re-search-forward ruby-here-doc-beg-re eol t) - (setq beg-match-data (match-data)) - (setq end-re (ruby-here-doc-end-match)) - - (set-match-data end-match-data) - (goto-char (match-end 0)) - (unless (re-search-forward end-re limit t) (throw 'done nil)) - (setq end-match-data (match-data)) - - (set-match-data beg-match-data) - (goto-char (match-end 0))) - (set-match-data end-match-data) - (goto-char (match-end 0)) - (point))))) - -(defun ruby-here-doc-beg-syntax () - "Return the syntax cell for a line that may begin a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'. - -This sets the syntax cell for the newline ending the line -containing the heredoc beginning so that cases where multiple -heredocs are started on one line are handled correctly." - (save-excursion - (goto-char (match-beginning 0)) - (unless (or (ruby-in-ppss-context-p 'non-heredoc) - (ruby-in-here-doc-p)) - (string-to-syntax "|")))) - -(defun ruby-here-doc-end-syntax () - "Return the syntax cell for a line that may end a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'." - (let ((pss (syntax-ppss)) (case-fold-search nil)) - ;; If we aren't in a string, we definitely aren't ending a heredoc, - ;; so we can just give up. - ;; This means we aren't doing a full-document search - ;; every time we enter a character. - (when (ruby-in-ppss-context-p 'heredoc pss) - (save-excursion - (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. - (let ((eol (point))) - (beginning-of-line) - (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... - (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... - (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... - (not (re-search-forward ruby-here-doc-beg-re eol t)))) - (string-to-syntax "|"))))))) - (if (featurep 'xemacs) (put 'ruby-mode 'font-lock-defaults '((ruby-font-lock-keywords) @@ -1377,8 +1430,10 @@ ) "Additional expressions to highlight in Ruby mode.") +(defvar electric-indent-chars) + ;;;###autoload -(defun ruby-mode () +(define-derived-mode ruby-mode prog-mode "Ruby" "Major mode for editing Ruby scripts. \\[ruby-indent-line] properly indents subexpressions of multi-line class, module, def, if, while, for, do, and case statements, taking @@ -1387,27 +1442,22 @@ The variable `ruby-indent-level' controls the amount of indentation. \\{ruby-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map ruby-mode-map) - (setq mode-name "Ruby") - (setq major-mode 'ruby-mode) (ruby-mode-variables) - (set (make-local-variable 'indent-line-function) - 'ruby-indent-line) (set (make-local-variable 'imenu-create-index-function) 'ruby-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) 'ruby-add-log-current-method) (add-hook - (cond ((boundp 'before-save-hook) - (make-local-variable 'before-save-hook) - 'before-save-hook) + (cond ((boundp 'before-save-hook) 'before-save-hook) ((boundp 'write-contents-functions) 'write-contents-functions) ((boundp 'write-contents-hooks) 'write-contents-hooks)) - 'ruby-mode-set-encoding) + 'ruby-mode-set-encoding nil 'local) + + (set (make-local-variable 'electric-indent-chars) + (append '(?\{ ?\}) (if (boundp 'electric-indent-chars) + (default-value 'electric-indent-chars)))) (set (make-local-variable 'font-lock-defaults) '((ruby-font-lock-keywords) nil nil)) @@ -1415,12 +1465,12 @@ ruby-font-lock-keywords) (set (make-local-variable 'font-lock-syntax-table) ruby-font-lock-syntax-table) - (set (make-local-variable 'font-lock-syntactic-keywords) - ruby-font-lock-syntactic-keywords) - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'ruby-mode-hook) - (run-hooks 'ruby-mode-hook))) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + #'ruby-syntax-propertize-function) + (set (make-local-variable 'font-lock-syntactic-keywords) + ruby-font-lock-syntactic-keywords))) ;;; Invoke ruby-mode when appropriate
--- a/lisp/progmodes/sh-script.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/sh-script.el Sun Sep 12 22:46:48 2010 +0000 @@ -939,7 +939,6 @@ ;; These are used for the syntax table stuff (derived from cperl-mode). ;; Note: parse-sexp-lookup-properties must be set to t for it to work. (defconst sh-st-punc (string-to-syntax ".")) -(defconst sh-st-symbol (string-to-syntax "_")) (defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string (defconst sh-escaped-line-re @@ -957,7 +956,7 @@ (defvar sh-here-doc-re sh-here-doc-open-re) (make-variable-buffer-local 'sh-here-doc-re) -(defun sh-font-lock-close-heredoc (bol eof indented) +(defun sh-font-lock-close-heredoc (bol eof indented eol) "Determine the syntax of the \\n after an EOF. If non-nil INDENTED indicates that the EOF was indented." (let* ((eof-re (if eof (regexp-quote eof) "")) @@ -971,6 +970,8 @@ (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) (start (save-excursion (goto-char bol) + ;; FIXME: will incorrectly find a <<EOF embedded inside + ;; the heredoc. (re-search-backward (concat sre "\\|" ere) nil t)))) ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first ;; found a close-heredoc which makes the current close-heredoc inoperant. @@ -990,7 +991,7 @@ (sh-in-comment-or-string (point))))) ;; No <<EOF2 found after our <<. (= (point) start))) - sh-here-doc-syntax) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)) ((not (or start (save-excursion (re-search-forward sre nil t)))) ;; There's no <<EOF either before or after us, ;; so we should remove ourselves from font-lock's keywords. @@ -1000,7 +1001,7 @@ (regexp-opt sh-here-doc-markers t) "\\(\n\\)")) nil)))) -(defun sh-font-lock-open-heredoc (start string) +(defun sh-font-lock-open-heredoc (start string eol) "Determine the syntax of the \\n after a <<EOF. START is the position of <<. STRING is the actual word used as delimiter (e.g. \"EOF\"). @@ -1030,13 +1031,8 @@ ;; Don't bother fixing it now, but place a multiline property so ;; that when jit-lock-context-* refontifies the rest of the ;; buffer, it also refontifies the current line with it. - (put-text-property start (point) 'font-lock-multiline t))) - sh-here-doc-syntax)) - -(defun sh-font-lock-here-doc (limit) - "Search for a heredoc marker." - ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. - (re-search-forward sh-here-doc-re limit t)) + (put-text-property start (point) 'syntax-multiline t))) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))) (defun sh-font-lock-quoted-subshell (limit) "Search for a subshell embedded in a string. @@ -1045,9 +1041,7 @@ ;; FIXME: This can (and often does) match multiple lines, yet it makes no ;; effort to handle multiline cases correctly, so it ends up being ;; rather flakey. - (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) - ;; Make sure the " we matched is an opening quote. - (eq ?\" (nth 3 (syntax-ppss)))) + (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) ;; `state' can be: double-quote, backquote, code. @@ -1082,8 +1076,7 @@ (double-quote nil) (t (setq state (pop states))))) (t (error "Internal error in sh-font-lock-quoted-subshell"))) - (forward-char 1))) - t)) + (forward-char 1))))) (defun sh-is-quoted-p (pos) @@ -1122,7 +1115,7 @@ (when (progn (backward-char 2) (if (> start (line-end-position)) (put-text-property (point) (1+ start) - 'font-lock-multiline t)) + 'syntax-multiline t)) ;; FIXME: The `in' may just be a random argument to ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the @@ -1136,40 +1129,44 @@ sh-st-punc nil)) -(defun sh-font-lock-flush-syntax-ppss-cache (limit) - ;; This should probably be a standard function provided by font-lock.el - ;; (or syntax.el). - (syntax-ppss-flush-cache (point)) - (goto-char limit) - nil) - -(defconst sh-font-lock-syntactic-keywords - ;; A `#' begins a comment when it is unquoted and at the beginning of a - ;; word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec - ;; of the shell command language (under `quoting') but with `$' removed. - `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) - ;; In a '...' the backslash is not escaping. - ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) - ;; The previous rule uses syntax-ppss, but the subsequent rules may - ;; change the syntax, so we have to tell syntax-ppss that the states it - ;; has just computed will need to be recomputed. - (sh-font-lock-flush-syntax-ppss-cache) - ;; Make sure $@ and $? are correctly recognized as sexps. - ("\\$\\([?@]\\)" 1 ,sh-st-symbol) - ;; Find HEREDOC starters and add a corresponding rule for the ender. - (sh-font-lock-here-doc - (2 (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1)) nil t) - (5 (sh-font-lock-close-heredoc - (match-beginning 0) (match-string 4) - (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) - nil t)) - ;; Distinguish the special close-paren in `case'. - (")" 0 (sh-font-lock-paren (match-beginning 0))) - ;; highlight (possibly nested) subshells inside "" quoted regions correctly. - ;; This should be at the very end because it uses syntax-ppss. - (sh-font-lock-quoted-subshell))) +(defun sh-syntax-propertize-function (start end) + (goto-char start) + (while (prog1 + (re-search-forward sh-here-doc-re end 'move) + (save-excursion + (save-match-data + (funcall + (syntax-propertize-rules + ;; A `#' begins a comment when it is unquoted and at the + ;; beginning of a word. In the shell, words are separated by + ;; metacharacters. The list of special chars is taken from + ;; the single-unix spec of the shell command language (under + ;; `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; In a '...' the backslash is not escaping. + ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) + ;; Make sure $@ and $? are correctly recognized as sexps. + ("\\$\\([?@]\\)" (1 "_")) + ;; Distinguish the special close-paren in `case'. + (")" (0 (sh-font-lock-paren (match-beginning 0)))) + ;; Highlight (possibly nested) subshells inside "" quoted + ;; regions correctly. + ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" + (1 (ignore + ;; Save excursion because we want to also apply other + ;; syntax-propertize rules within the affected region. + (save-excursion + (sh-font-lock-quoted-subshell end)))))) + (prog1 start (setq start (point))) (point))))) + (if (match-beginning 2) + ;; FIXME: actually, once we see an heredoc opener, we should just + ;; search for its ender without propertizing anything in it. + (sh-font-lock-open-heredoc + (match-beginning 0) (match-string 1) (match-beginning 2)) + (sh-font-lock-close-heredoc + (match-beginning 0) (match-string 4) + (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))) + (match-beginning 5))))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1553,9 +1550,12 @@ sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil - (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords) (font-lock-syntactic-face-function . sh-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'sh-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`))) (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p) (set (make-local-variable 'skeleton-further-elements)
--- a/lisp/progmodes/simula.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/simula.el Sun Sep 12 22:46:48 2010 +0000 @@ -163,17 +163,18 @@ (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.") -(defconst simula-font-lock-syntactic-keywords - `(;; `comment' directive. - ("\\<\\(c\\)omment\\>" 1 "<") - ;; end comments - (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" - (regexp-opt '("end" "else" "when" "otherwise")) - "\\)\\)") - (1 "< b") - (3 "> b" nil t)) - ;; non-quoted single-quote char. - ("'\\('\\)'" 1 "."))) +(defconst simula-syntax-propertize-function + (syntax-propertize-rules + ;; `comment' directive. + ("\\<\\(c\\)omment\\>" (1 "<")) + ;; end comments + ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" + (regexp-opt '("end" "else" "when" "otherwise")) + "\\)\\)") + (1 "< b") + (3 "> b")) + ;; non-quoted single-quote char. + ("'\\('\\)'" (1 ".")))) ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>. (defconst simula-font-lock-keywords-1 @@ -396,8 +397,9 @@ (setq font-lock-defaults '((simula-font-lock-keywords simula-font-lock-keywords-1 simula-font-lock-keywords-2 simula-font-lock-keywords-3) - nil t ((?_ . "w")) nil - (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords))) + nil t ((?_ . "w")))) + (set (make-local-variable 'syntax-propertize-function) + simula-syntax-propertize-function) (abbrev-mode 1)) (defun simula-indent-exp ()
--- a/lisp/progmodes/sql.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/sql.el Sun Sep 12 22:46:48 2010 +0000 @@ -5,7 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.5 +;; Version: 2.6 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode @@ -187,10 +187,10 @@ ;; 6) Define a convienence function to invoke the SQL interpreter. -;; (defun my-sql-xyz () +;; (defun my-sql-xyz (&optional buffer) ;; "Run ixyz by XyzDB as an inferior process." -;; (interactive) -;; (sql-product-interactive 'xyz)) +;; (interactive "P") +;; (sql-product-interactive 'xyz buffer)) ;;; To Do: @@ -275,8 +275,8 @@ :group 'SQL :safe 'stringp) -(defcustom sql-port nil - "Default server or host." +(defcustom sql-port 0 + "Default port." :version "24.1" :type 'number :group 'SQL @@ -430,9 +430,9 @@ :sqli-comint-func sql-comint-postgres :prompt-regexp "^.*=[#>] " :prompt-length 5 - :prompt-cont-regexp "^.*-[#>] " + :prompt-cont-regexp "^.*[-(][#>] " :input-filter sql-remove-tabs-filter - :terminator ("\\(^[\\]g\\|;\\)" . ";")) + :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";")) (solid :name "Solid" @@ -551,7 +551,6 @@ (defvar sql-indirect-features '(:font-lock :sqli-program :sqli-options :sqli-login)) -;;;###autoload (defcustom sql-connection-alist nil "An alist of connection parameters for interacting with a SQL product. @@ -600,7 +599,6 @@ :version "24.1" :group 'SQL) -;;;###autoload (defcustom sql-product 'ansi "Select the SQL database product used so that buffers can be highlighted properly when you open them." @@ -613,6 +611,7 @@ sql-product-alist)) :group 'SQL :safe 'symbolp) +(defvaralias 'sql-dialect 'sql-product) ;; misc customization of sql.el behaviour @@ -788,7 +787,9 @@ ;; Customization for SQLite -(defcustom sql-sqlite-program "sqlite3" +(defcustom sql-sqlite-program (or (executable-find "sqlite3") + (executable-find "sqlite") + "sqlite") "Command to start SQLite. Starts `sql-interactive-mode' after doing some setup." @@ -801,7 +802,7 @@ :version "20.8" :group 'SQL) -(defcustom sql-sqlite-login-params '((database :file ".*\\.db")) +(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)")) "List of login parameters needed to connect to SQLite." :type 'sql-login-params :version "24.1" @@ -1022,9 +1023,6 @@ (defvar sql-server-history nil "History of servers used.") -(defvar sql-port-history nil - "History of ports used.") - ;; Passwords are not kept in a history. (defvar sql-buffer nil @@ -1054,6 +1052,12 @@ Used by `sql-rename-buffer'.") +(defun sql-buffer-live-p (buffer) + "Returns non-nil if the process associated with buffer is live." + (and buffer + (buffer-live-p (get-buffer buffer)) + (get-buffer-process buffer))) + ;; Keymap for sql-interactive-mode. (defvar sql-interactive-mode-map @@ -1091,15 +1095,11 @@ sql-mode-menu sql-mode-map "Menu for `sql-mode'." `("SQL" - ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)] ["Send Region" sql-send-region (and mark-active - (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send String" sql-send-string (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + (sql-buffer-live-p sql-buffer))] + ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)] + ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)] "--" ["Start SQLi session" sql-product-interactive :visible (not sql-connection-alist) @@ -1364,7 +1364,7 @@ ;; Oracle SQL*Plus Commands (cons (concat - "^\\(?:\\(?:" (regexp-opt '( + "^\\s-*\\(?:\\(?:" (regexp-opt '( "@" "@@" "accept" "append" "archive" "attribute" "break" "btitle" "change" "clear" "column" "connect" "copy" "define" "del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" @@ -1403,7 +1403,7 @@ "\\)\\b.*" ) 'font-lock-doc-face) - '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face) + '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil @@ -1585,81 +1585,153 @@ (defvar sql-mode-postgres-font-lock-keywords (eval-when-compile (list - ;; Postgres Functions + ;; Postgres psql commands + '("^\\s-*\\\\.*$" . font-lock-doc-face) + + ;; Postgres unreserved words but may have meaning + (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a" +"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg" +"asensitive" "atomic" "attribute" "attributes" "avg" "base64" +"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c" +"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length" +"character_length" "character_set_catalog" "character_set_name" +"character_set_schema" "characters" "checked" "class_origin" "clob" +"cobol" "collation" "collation_catalog" "collation_name" +"collation_schema" "collect" "column_name" "columns" +"command_function" "command_function_code" "completion" "condition" +"condition_number" "connect" "connection_name" "constraint_catalog" +"constraint_name" "constraint_schema" "constructor" "contains" +"control" "convert" "corr" "corresponding" "count" "covar_pop" +"covar_samp" "cube" "cume_dist" "current_default_transform_group" +"current_path" "current_transform_group_for_type" "cursor_name" +"datalink" "datetime_interval_code" "datetime_interval_precision" "db" +"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe" +"descriptor" "destroy" "destructor" "deterministic" "diagnostics" +"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete" +"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly" +"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic" +"dynamic_function" "dynamic_function_code" "element" "empty" +"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file" +"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free" +"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping" +"hex" "hierarchy" "host" "id" "ignore" "implementation" "import" +"indent" "indicator" "infix" "initialize" "instance" "instantiable" +"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag" +"last_value" "lateral" "lead" "length" "less" "library" "like_regex" +"link" "ln" "locator" "lower" "m" "map" "matched" "max" +"max_cardinality" "member" "merge" "message_length" +"message_octet_length" "message_text" "method" "min" "mod" "modifies" +"modify" "module" "more" "multiset" "mumps" "namespace" "nclob" +"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize" +"normalized" "nth_value" "ntile" "nullable" "number" +"occurrences_regex" "octet_length" "octets" "old" "open" "operation" +"ordering" "ordinality" "others" "output" "overriding" "p" "pad" +"parameter" "parameter_mode" "parameter_name" +"parameter_ordinal_position" "parameter_specific_catalog" +"parameter_specific_name" "parameter_specific_schema" "parameters" +"pascal" "passing" "passthrough" "percent_rank" "percentile_cont" +"percentile_disc" "permission" "pli" "position_regex" "postfix" +"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref" +"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept" +"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring" +"respect" "restore" "result" "return" "returned_cardinality" +"returned_length" "returned_octet_length" "returned_sqlstate" "rollup" +"routine" "routine_catalog" "routine_name" "routine_schema" +"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog" +"scope_name" "scope_schema" "section" "selective" "self" "sensitive" +"server_name" "sets" "size" "source" "space" "specific" +"specific_name" "specifictype" "sql" "sqlcode" "sqlerror" +"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static" +"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin" +"sublist" "submultiset" "substring_regex" "sum" "system_user" "t" +"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour" +"timezone_minute" "token" "top_level_count" "transaction_active" +"transactions_committed" "transactions_rolled_back" "transform" +"transforms" "translate" "translate_regex" "translation" +"trigger_catalog" "trigger_name" "trigger_schema" "trim_array" +"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri" +"usage" "user_defined_type_catalog" "user_defined_type_code" +"user_defined_type_name" "user_defined_type_schema" "var_pop" +"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within" +"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration" +"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery" +"xmlschema" "xmltable" "xmltext" "xmlvalidate" +) + + ;; Postgres non-reserved words (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan" -"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil" -"center" "char_length" "chr" "coalesce" "col_description" "convert" -"cos" "cot" "count" "current_database" "current_date" "current_schema" -"current_schemas" "current_setting" "current_time" "current_timestamp" -"current_user" "currval" "date_part" "date_trunc" "decode" "degrees" -"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte" -"has_database_privilege" "has_function_privilege" -"has_language_privilege" "has_schema_privilege" "has_table_privilege" -"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading" -"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad" -"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval" -"now" "npoints" "nullif" "obj_description" "octet_length" "overlay" -"pclose" "pg_client_encoding" "pg_function_is_visible" -"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef" -"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible" -"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible" -"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians" -"radius" "random" "repeat" "replace" "round" "rpad" "rtrim" -"session_user" "set_bit" "set_byte" "set_config" "set_masklen" -"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr" -"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date" -"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim" -"trunc" "upper" "variance" "version" "width" +"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate" +"also" "alter" "always" "assertion" "assignment" "at" "backward" +"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded" +"catalog" "chain" "characteristics" "checkpoint" "class" "close" +"cluster" "coalesce" "comment" "comments" "commit" "committed" +"configuration" "connection" "constraints" "content" "continue" +"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv" +"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec" +"declare" "defaults" "deferred" "definer" "delete" "delimiter" +"delimiters" "dictionary" "disable" "discard" "document" "domain" +"drop" "each" "enable" "encoding" "encrypted" "enum" "escape" +"exclude" "excluding" "exclusive" "execute" "exists" "explain" +"external" "extract" "family" "first" "float" "following" "force" +"forward" "function" "functions" "global" "granted" "greatest" +"handler" "header" "hold" "hour" "identity" "if" "immediate" +"immutable" "implicit" "including" "increment" "index" "indexes" +"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert" +"instead" "invoker" "isolation" "key" "language" "large" "last" +"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local" +"location" "lock" "login" "mapping" "match" "maxvalue" "minute" +"minvalue" "mode" "month" "move" "name" "names" "national" "nchar" +"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit" +"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif" +"nulls" "object" "of" "oids" "operator" "option" "options" "out" +"overlay" "owned" "owner" "parser" "partial" "partition" "password" +"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior" +"privileges" "procedural" "procedure" "quote" "range" "read" +"reassign" "recheck" "recursive" "reindex" "relative" "release" +"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict" +"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint" +"schema" "scroll" "search" "second" "security" "sequence" "sequences" +"serializable" "server" "session" "set" "setof" "share" "show" +"simple" "stable" "standalone" "start" "statement" "statistics" +"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser" +"sysid" "system" "tables" "tablespace" "temp" "template" "temporary" +"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type" +"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until" +"update" "vacuum" "valid" "validator" "value" "values" "version" +"view" "volatile" "whitespace" "work" "wrapper" "write" +"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse" +"xmlpi" "xmlroot" "xmlserialize" "year" "yes" ) + ;; Postgres Reserved (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter" -"analyze" "and" "any" "as" "asc" "assignment" "authorization" -"backward" "basetype" "before" "begin" "between" "binary" "by" "cache" -"called" "cascade" "case" "cast" "characteristics" "check" -"checkpoint" "class" "close" "cluster" "column" "comment" "commit" -"committed" "commutator" "constraint" "constraints" "conversion" -"copy" "create" "createdb" "createuser" "cursor" "cycle" "database" -"deallocate" "declare" "default" "deferrable" "deferred" "definer" -"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each" -"element" "else" "encoding" "encrypted" "end" "escape" "except" -"exclusive" "execute" "exists" "explain" "extended" "external" "false" -"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from" -"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having" -"immediate" "immutable" "implicit" "in" "increment" "index" "inherits" -"initcond" "initially" "input" "insensitive" "insert" "instead" -"internallength" "intersect" "into" "invoker" "is" "isnull" -"isolation" "join" "key" "language" "leftarg" "level" "like" "limit" -"listen" "load" "local" "location" "lock" "ltcmp" "main" "match" -"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator" -"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify" -"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or" -"order" "output" "owner" "partial" "passedbyvalue" "password" "plain" -"prepare" "primary" "prior" "privileges" "procedural" "procedure" -"public" "read" "recheck" "references" "reindex" "relative" "rename" -"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row" -"rule" "schema" "scroll" "security" "select" "sequence" "serializable" -"session" "set" "sfunc" "share" "show" "similar" "some" "sort1" -"sort2" "stable" "start" "statement" "statistics" "storage" "strict" -"stype" "sysid" "table" "temp" "template" "temporary" "then" "to" -"transaction" "trigger" "true" "truncate" "trusted" "type" -"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update" -"usage" "user" "using" "vacuum" "valid" "validator" "values" -"variable" "verbose" "view" "volatile" "when" "where" "with" "without" -"work" +"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric" +"authorization" "binary" "both" "case" "cast" "check" "collate" +"column" "concurrently" "constraint" "create" "cross" +"current_catalog" "current_date" "current_role" "current_schema" +"current_time" "current_timestamp" "current_user" "default" +"deferrable" "desc" "distinct" "do" "else" "end" "except" "false" +"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group" +"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull" +"is" "join" "leading" "left" "like" "limit" "localtime" +"localtimestamp" "natural" "notnull" "not" "null" "off" "offset" +"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary" +"references" "returning" "right" "select" "session_user" "similar" +"some" "symmetric" "table" "then" "to" "trailing" "true" "union" +"unique" "user" "using" "variadic" "verbose" "when" "where" "window" +"with" ) ;; Postgres Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char" -"character" "cidr" "circle" "cstring" "date" "decimal" "double" -"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal" -"interval" "language_handler" "line" "lseg" "macaddr" "money" -"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real" -"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure" -"regtype" "serial" "serial4" "serial8" "smallint" "text" "time" -"timestamp" "varchar" "varying" "void" "zone" +"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char" +"character" "cidr" "circle" "date" "decimal" "double" "float4" +"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line" +"lseg" "macaddr" "money" "numeric" "path" "point" "polygon" +"precision" "real" "serial" "serial4" "serial8" "smallint" "text" +"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector" +"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without" +"xml" "zone" ))) "Postgres SQL keywords used by font-lock. @@ -1979,6 +2051,9 @@ (defvar sql-mode-sqlite-font-lock-keywords (eval-when-compile (list + ;; SQLite commands + '("^[.].*$" . font-lock-doc-face) + ;; SQLite Keyword (sql-font-lock-keywords-builder 'font-lock-keyword-face nil "abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" @@ -2493,16 +2568,18 @@ ((eq token 'port) ; port (setq sql-port - (read-number "Port: " sql-port)))))) - what)) + (read-number "Port: " (if (numberp sql-port) + sql-port + 0))))))) + what)) (defun sql-find-sqli-buffer () - "Returns the current default SQLi buffer or nil. -In order to qualify, the SQLi buffer must be alive, -be in `sql-interactive-mode' and have a process." - (let ((default-buffer (default-value 'sql-buffer))) - (if (and (buffer-live-p default-buffer) - (get-buffer-process default-buffer)) + "Returns the name of the current default SQLi buffer or nil. +In order to qualify, the SQLi buffer must be alive, be in +`sql-interactive-mode' and have a process." + (let ((default-buffer (default-value 'sql-buffer)) + (current-product sql-product)) + (if (sql-buffer-live-p default-buffer) default-buffer (save-current-buffer (let ((buflist (buffer-list)) @@ -2511,9 +2588,10 @@ found)) (let ((candidate (car buflist))) (set-buffer candidate) - (if (and (derived-mode-p 'sql-interactive-mode) - (get-buffer-process candidate)) - (setq found candidate)) + (if (and (sql-buffer-live-p candidate) + (derived-mode-p 'sql-interactive-mode) + (eq sql-product current-product)) + (setq found (buffer-name candidate))) (setq buflist (cdr buflist)))) found))))) @@ -2527,15 +2605,15 @@ (interactive) (save-excursion (let ((buflist (buffer-list)) - (default-sqli-buffer (sql-find-sqli-buffer))) - (setq-default sql-buffer default-sqli-buffer) + (default-buffer (sql-find-sqli-buffer))) + (setq-default sql-buffer default-buffer) (while (not (null buflist)) (let ((candidate (car buflist))) (set-buffer candidate) (if (and (derived-mode-p 'sql-mode) (not (buffer-live-p sql-buffer))) (progn - (setq sql-buffer default-sqli-buffer) + (setq sql-buffer default-buffer) (run-hooks 'sql-set-sqli-hook)))) (setq buflist (cdr buflist)))))) @@ -2561,11 +2639,11 @@ (if (null (get-buffer-process new-buffer)) (error "Buffer %s has no process" (buffer-name new-buffer))) (if (null (with-current-buffer new-buffer - (equal major-mode 'sql-interactive-mode))) + (derived-mode-p 'sql-interactive-mode))) (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer))) (if new-buffer (progn - (setq sql-buffer new-buffer) + (setq sql-buffer (buffer-name new-buffer)) (run-hooks 'sql-set-sqli-hook)))))) (defun sql-show-sqli-buffer () @@ -2574,11 +2652,11 @@ This is the buffer SQL strings are sent to. It is stored in the variable `sql-buffer'. See `sql-help' on how to create such a buffer." (interactive) - (if (null (buffer-live-p sql-buffer)) + (if (null (buffer-live-p (get-buffer sql-buffer))) (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) (if (null (get-buffer-process sql-buffer)) - (message "Buffer %s has no process." (buffer-name sql-buffer)) - (message "Current SQLi buffer is %s." (buffer-name sql-buffer))))) + (message "Buffer %s has no process." sql-buffer) + (message "Current SQLi buffer is %s." sql-buffer)))) (defun sql-make-alternate-buffer-name () "Return a string that can be used to rename a SQLi buffer. @@ -2610,8 +2688,9 @@ (unless (string= "" sql-user) (list "/" sql-user))) ((eq token 'port) - (unless (= 0 sql-port) - (list ":" sql-port))) + (unless (or (not (numberp sql-port)) + (= 0 sql-port)) + (list ":" (number-to-string sql-port)))) ((eq token 'server) (unless (string= "" sql-server) (list "." @@ -2619,7 +2698,7 @@ (file-name-nondirectory sql-server) sql-server)))) ((eq token 'database) - (when (string= "" sql-database) + (unless (string= "" sql-database) (list "@" (if (eq type :file) (file-name-nondirectory sql-database) @@ -2649,10 +2728,32 @@ ;; Use the name we've got name)))) -(defun sql-rename-buffer () - "Rename a SQLi buffer." - (interactive) - (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t)) +(defun sql-rename-buffer (&optional new-name) + "Rename a SQL interactive buffer. + +Prompts for the new name if command is preceeded by +\\[universal-argument]. If no buffer name is provided, then the +`sql-alternate-buffer-name' is used. + +The actual buffer name set will be \"*SQL: NEW-NAME*\". If +NEW-NAME is empty, then the buffer name will be \"*SQL*\"." + (interactive "P") + + (if (not (derived-mode-p 'sql-interactive-mode)) + (message "Current buffer is not a SQL interactive buffer") + + (cond + ((stringp new-name) + (setq sql-alternate-buffer-name new-name)) + ((listp new-name) + (setq sql-alternate-buffer-name + (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " + sql-alternate-buffer-name)))) + + (rename-buffer (if (string= "" sql-alternate-buffer-name) + "*SQL*" + (format "*SQL: %s*" sql-alternate-buffer-name)) + t))) (defun sql-copy-column () "Copy current column to the end of buffer. @@ -2801,7 +2902,7 @@ (let ((comint-input-sender-no-newline nil) (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str))) - (if (buffer-live-p sql-buffer) + (if (sql-buffer-live-p sql-buffer) (progn ;; Ignore the hoping around... (save-excursion @@ -2814,7 +2915,7 @@ (if sql-send-terminator (sql-send-magic-terminator sql-buffer s sql-send-terminator)) - (message "Sent string to buffer %s." (buffer-name sql-buffer)))) + (message "Sent string to buffer %s." sql-buffer))) ;; Display the sql buffer (if sql-pop-to-buffer-after-send-region @@ -3063,7 +3164,7 @@ (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. - (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop) + (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) ;; Save the connection name (make-local-variable 'sql-connection) ;; Create a usefull name for renaming this buffer later. @@ -3248,49 +3349,60 @@ ;;; Entry functions for different SQL interpreters. ;;;###autoload -(defun sql-product-interactive (&optional product) +(defun sql-product-interactive (&optional product new-name) "Run PRODUCT interpreter as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. If buffer exists and a process is running, just switch to buffer `*SQL*'. +To specify the SQL product, prefix the call with +\\[universal-argument]. To set the buffer name as well, prefix +the call to \\[sql-product-interactive] with +\\[universal-argument] \\[universal-argument]. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" (interactive "P") + ;; Handle universal arguments if specified + (when (not (or executing-kbd-macro noninteractive)) + (when (and (listp product) + (not (cdr product)) + (numberp (car product))) + (when (>= (car product) 16) + (when (not new-name) + (setq new-name '(4))) + (setq product '(4))))) + + ;; Get the value of product that we need (setq product (cond - ((equal product '(4)) ; Universal arg, prompt for product + ((equal product '(4)) ; C-u, prompt for product (intern (completing-read "SQL product: " (mapcar (lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match - (or (and sql-product (symbol-name sql-product)) "ansi")))) + (or (and sql-product + (symbol-name sql-product)) + "ansi")))) ((and product ; Product specified (symbolp product)) product) (t sql-product))) ; Default to sql-product + ;; If we have a product and it has a interactive mode (if product (when (sql-get-product-feature product :sqli-comint-func) - (if (and sql-buffer - (buffer-live-p sql-buffer) - (comint-check-proc sql-buffer)) + ;; If no new name specified, fall back on sql-buffer if its for + ;; the same product + (if (and (not new-name) + sql-buffer + (sql-buffer-live-p sql-buffer) + (comint-check-proc sql-buffer) + (eq product (with-current-buffer sql-buffer sql-product))) (pop-to-buffer sql-buffer) - ;; Is the current buffer in sql-mode and - ;; there is a buffer local setting of sql-buffer - (let* ((start-buffer - (and (derived-mode-p 'sql-mode) - (current-buffer))) - (start-sql-buffer - (and start-buffer - (let (found) - (dolist (var (buffer-local-variables)) - (and (consp var) - (eq (car var) 'sql-buffer) - (buffer-live-p (cdr var)) - (get-buffer-process (cdr var)) - (setq found (cdr var)))) - found))) + ;; We have a new name or sql-buffer doesn't exist or match + ;; Start by remembering where we start + (let* ((start-buffer (current-buffer)) new-sqli-buffer) ;; Get credentials. @@ -3303,15 +3415,18 @@ (sql-get-product-feature product :sqli-options)) ;; Set SQLi mode. - (setq sql-interactive-product product - new-sqli-buffer (current-buffer) - sql-buffer new-sqli-buffer) - (sql-interactive-mode) + (setq new-sqli-buffer (current-buffer)) + (let ((sql-interactive-product product)) + (sql-interactive-mode)) + + ;; Set the new buffer name + (when new-name + (sql-rename-buffer new-name)) ;; Set `sql-buffer' in the start buffer - (when (and start-buffer (not start-sql-buffer)) - (with-current-buffer start-buffer - (setq sql-buffer new-sqli-buffer))) + (setq sql-buffer (buffer-name new-sqli-buffer)) + (with-current-buffer start-buffer + (setq sql-buffer (buffer-name new-sqli-buffer))) ;; All done. (message "Login...done") @@ -3323,12 +3438,22 @@ PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments." - (let ((program (sql-get-product-feature product :sqli-program))) + (let ((program (sql-get-product-feature product :sqli-program)) + (buf-name "SQL")) + ;; Make sure buffer name is unique + (when (get-buffer (format "*%s*" buf-name)) + (setq buf-name (format "SQL-%s" product)) + (when (get-buffer (format "*%s*" buf-name)) + (let ((i 1)) + (while (get-buffer (format "*%s*" + (setq buf-name + (format "SQL-%s%d" product i)))) + (setq i (1+ i)))))) (set-buffer - (apply 'make-comint "SQL" program nil params)))) + (apply 'make-comint buf-name program nil params)))) ;;;###autoload -(defun sql-oracle () +(defun sql-oracle (&optional buffer) "Run sqlplus by Oracle as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3343,6 +3468,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-oracle]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3351,8 +3481,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'oracle)) + (interactive "P") + (sql-product-interactive 'oracle buffer)) (defun sql-comint-oracle (product options) "Create comint buffer and connect to Oracle." @@ -3375,7 +3505,7 @@ ;;;###autoload -(defun sql-sybase () +(defun sql-sybase (&optional buffer) "Run isql by Sybase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3390,6 +3520,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sybase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3398,8 +3533,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sybase)) + (interactive "P") + (sql-product-interactive 'sybase buffer)) (defun sql-comint-sybase (product options) "Create comint buffer and connect to Sybase." @@ -3419,7 +3554,7 @@ ;;;###autoload -(defun sql-informix () +(defun sql-informix (&optional buffer) "Run dbaccess by Informix as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3432,6 +3567,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-informix]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3440,8 +3580,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'informix)) + (interactive "P") + (sql-product-interactive 'informix buffer)) (defun sql-comint-informix (product options) "Create comint buffer and connect to Informix." @@ -3456,7 +3596,7 @@ ;;;###autoload -(defun sql-sqlite () +(defun sql-sqlite (&optional buffer) "Run sqlite as an inferior process. SQLite is free software. @@ -3473,6 +3613,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sqlite]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3481,8 +3626,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sqlite)) + (interactive "P") + (sql-product-interactive 'sqlite buffer)) (defun sql-comint-sqlite (product options) "Create comint buffer and connect to SQLite." @@ -3498,7 +3643,7 @@ ;;;###autoload -(defun sql-mysql () +(defun sql-mysql (&optional buffer) "Run mysql by TcX as an inferior process. Mysql versions 3.23 and up are free software. @@ -3515,6 +3660,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mysql]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3523,8 +3673,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'mysql)) + (interactive "P") + (sql-product-interactive 'mysql buffer)) (defun sql-comint-mysql (product options) "Create comint buffer and connect to MySQL." @@ -3535,7 +3685,7 @@ (setq params (append (list sql-database) params))) (if (not (string= "" sql-server)) (setq params (append (list (concat "--host=" sql-server)) params))) - (if (and sql-port (numberp sql-port)) + (if (not (= 0 sql-port)) (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) (if (not (string= "" sql-password)) (setq params (append (list (concat "--password=" sql-password)) params))) @@ -3547,7 +3697,7 @@ ;;;###autoload -(defun sql-solid () +(defun sql-solid (&optional buffer) "Run solsql by Solid as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3561,6 +3711,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-solid]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3569,8 +3724,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'solid)) + (interactive "P") + (sql-product-interactive 'solid buffer)) (defun sql-comint-solid (product options) "Create comint buffer and connect to Solid." @@ -3588,7 +3743,7 @@ ;;;###autoload -(defun sql-ingres () +(defun sql-ingres (&optional buffer) "Run sql by Ingres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3601,6 +3756,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ingres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3609,8 +3769,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ingres)) + (interactive "P") + (sql-product-interactive 'ingres buffer)) (defun sql-comint-ingres (product options) "Create comint buffer and connect to Ingres." @@ -3624,7 +3784,7 @@ ;;;###autoload -(defun sql-ms () +(defun sql-ms (&optional buffer) "Run osql by Microsoft as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3639,6 +3799,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ms]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3647,8 +3812,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ms)) + (interactive "P") + (sql-product-interactive 'ms buffer)) (defun sql-comint-ms (product options) "Create comint buffer and connect to Microsoft SQL Server." @@ -3675,7 +3840,7 @@ ;;;###autoload -(defun sql-postgres () +(defun sql-postgres (&optional buffer) "Run psql by Postgres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3690,6 +3855,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-postgres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3703,8 +3873,8 @@ '(comint-strip-ctrl-m))) \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'postgres)) + (interactive "P") + (sql-product-interactive 'postgres buffer)) (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." @@ -3725,7 +3895,7 @@ ;;;###autoload -(defun sql-interbase () +(defun sql-interbase (&optional buffer) "Run isql by Interbase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3739,6 +3909,11 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-interbase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3747,8 +3922,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'interbase)) + (interactive "P") + (sql-product-interactive 'interbase buffer)) (defun sql-comint-interbase (product options) "Create comint buffer and connect to Interbase." @@ -3766,7 +3941,7 @@ ;;;###autoload -(defun sql-db2 () +(defun sql-db2 (&optional buffer) "Run db2 by IBM as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3784,6 +3959,11 @@ `comint-input-sender' back to `comint-simple-send' by writing an after advice. See the elisp manual for more information. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-db2]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3792,8 +3972,8 @@ `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'db2)) + (interactive "P") + (sql-product-interactive 'db2 buffer)) (defun sql-comint-db2 (product options) "Create comint buffer and connect to DB2." @@ -3801,11 +3981,9 @@ ;; make-comint. (sql-comint product options) ) -;; ;; Properly escape newlines when DB2 is interactive. -;; (setq comint-input-sender 'sql-escape-newlines-and-send)) ;;;###autoload -(defun sql-linter () +(defun sql-linter (&optional buffer) "Run inl by RELEX as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3827,9 +4005,14 @@ The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-linter]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'linter)) + (interactive "P") + (sql-product-interactive 'linter buffer)) (defun sql-comint-linter (product options) "Create comint buffer and connect to Linter."
--- a/lisp/progmodes/tcl.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/tcl.el Sun Sep 12 22:46:48 2010 +0000 @@ -411,9 +411,10 @@ `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") -(defvar tcl-font-lock-syntactic-keywords - ;; Mark the few `#' that are not comment-markers. - '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) +(defconst tcl-syntax-propertize-function + (syntax-propertize-rules + ;; Mark the few `#' that are not comment-markers. + ("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) "Syntactic keywords for `tcl-mode'.") ;; FIXME need some way to recognize variables because array refs look @@ -593,9 +594,9 @@ (set (make-local-variable 'outline-level) 'tcl-outline-level) (set (make-local-variable 'font-lock-defaults) - '(tcl-font-lock-keywords nil nil nil beginning-of-defun - (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + '(tcl-font-lock-keywords nil nil nil beginning-of-defun)) + (set (make-local-variable 'syntax-propertize-function) + tcl-syntax-propertize-function) (set (make-local-variable 'imenu-generic-expression) tcl-imenu-generic-expression)
--- a/lisp/progmodes/vhdl-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/progmodes/vhdl-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -4693,8 +4693,15 @@ (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules + ;; Mark single quotes as having string quote syntax in + ;; 'c' instances. + ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'")))) + (set (make-local-variable 'font-lock-syntactic-keywords) + vhdl-font-lock-syntactic-keywords)) (unless vhdl-emacs-21 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) @@ -12914,10 +12921,9 @@ "Re-initialize fontification and fontify buffer." (interactive) (setq font-lock-defaults - (list - 'vhdl-font-lock-keywords nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + `(vhdl-font-lock-keywords + nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) + beginning-of-line)) (when (fboundp 'font-lock-unset-defaults) (font-lock-unset-defaults)) ; not implemented in XEmacs (font-lock-set-defaults)
--- a/lisp/subr.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/subr.el Sun Sep 12 22:46:48 2010 +0000 @@ -3358,6 +3358,52 @@ (overlay-put ol2 'evaporate t) (overlay-put ol2 'text-clones dups))) +;;;; Misc functions moved over from the C side. + +(defun y-or-n-p (prompt) + "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. +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 +for more information. In this case, the useful bindings are `act', `skip', +`recenter', and `quit'.\) + +Under a windowing system a dialog box will be used if `last-nonmenu-event' +is nil and `use-dialog-box' is non-nil." + ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state + ;; where all the keys were unbound (i.e. it somehow got triggered + ;; within read-key, apparently). I had to kill it. + (let ((answer 'none) + (xprompt prompt)) + (if (and (display-popup-menus-p) + (listp last-nonmenu-event) + use-dialog-box) + (setq answer + (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip)))) + (while + (let* ((key + (let ((cursor-in-echo-area t)) + (when minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (read-key (propertize xprompt 'face 'minibuffer-prompt))))) + (setq answer (lookup-key query-replace-map (vector key) t)) + (cond + ((memq answer '(skip act)) nil) + ((eq answer 'recenter) (recenter) t) + ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) + (t t))) + (ding) + (discard-input) + (setq xprompt + (if (eq answer 'recenter) prompt + (concat "Please answer y or n. " prompt))))) + (let ((ret (eq answer 'act))) + (unless noninteractive + (message "%s %s" prompt (if ret "y" "n"))) + ret))) + ;;;; Mail user agents. ;; Here we include just enough for other packages to be able
--- a/lisp/textmodes/bibtex.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/bibtex.el Sun Sep 12 22:46:48 2010 +0000 @@ -3027,12 +3027,14 @@ ;; brace-delimited ones ) nil - (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) (font-lock-extra-managed-props . (category)) (font-lock-mark-block-function . (lambda () (set-mark (bibtex-end-of-entry)) (bibtex-beginning-of-entry))))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock + bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t)
--- a/lisp/textmodes/ispell.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/ispell.el Sun Sep 12 22:46:48 2010 +0000 @@ -2674,24 +2674,27 @@ ispell-filter-continue nil ispell-process-directory default-directory) - ;; Kill ispell process when killing its associated buffer if using Ispell - ;; per-directory personal dictionaries. (unless (equal ispell-process-directory (expand-file-name "~/")) - (with-current-buffer - (if (and (window-minibuffer-p) - (fboundp 'minibuffer-selected-window)) ;; E.g. XEmacs. - ;; When spellchecking minibuffer contents, assign ispell - ;; process to parent buffer if known (not known for XEmacs). - ;; Use (buffer-name) otherwise. + ;; At this point, `ispell-process-directory' will be "~/" unless using + ;; Ispell with directory-specific dicts and not in XEmacs minibuffer. + ;; If not, kill ispell process when killing buffer. It may be in a + ;; removable device that would otherwise become un-mountable. + (with-current-buffer + (if (and (window-minibuffer-p) ;; In minibuffer + (fboundp 'minibuffer-selected-window)) ;; Not XEmacs. + ;; In this case kill ispell only when parent buffer is killed + ;; to avoid over and over ispell kill. (window-buffer (minibuffer-selected-window)) - (current-buffer)) - (add-hook 'kill-buffer-hook (lambda () (ispell-kill-ispell t)) - nil 'local))) + (current-buffer)) + ;; 'local does not automatically make hook buffer-local in XEmacs. + (if (featurep 'xemacs) + (make-local-hook 'kill-buffer-hook)) + (add-hook 'kill-buffer-hook + (lambda () (ispell-kill-ispell t)) nil 'local))) (if ispell-async-processp (set-process-filter ispell-process 'ispell-filter)) - ;; protect against bogus binding of `enable-multibyte-characters' in - ;; XEmacs. + ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'. (if (and (or (featurep 'xemacs) (and (boundp 'enable-multibyte-characters) enable-multibyte-characters)) @@ -2727,7 +2730,9 @@ (if extended-char-mode ; ~ extended character mode (ispell-send-string (concat extended-char-mode "\n")))) (if ispell-async-processp - (set-process-query-on-exit-flag ispell-process nil))))) + (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs + (set-process-query-on-exit-flag ispell-process nil) + (process-kill-without-query ispell-process)))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error)
--- a/lisp/textmodes/reftex.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/reftex.el Sun Sep 12 22:46:48 2010 +0000 @@ -599,7 +599,6 @@ (defvar font-lock-mode) (defvar font-lock-keywords) (defvar font-lock-fontify-region-function) -(defvar font-lock-syntactic-keywords) ;;; ========================================================================= ;;;
--- a/lisp/textmodes/sgml-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/sgml-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -293,11 +293,12 @@ (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") -(defvar sgml-font-lock-syntactic-keywords +(defconst sgml-syntax-propertize-function + (syntax-propertize-rules ;; Use the `b' style of comments to avoid interference with the -- ... -- ;; comments recognized when `sgml-specials' includes ?-. ;; FIXME: beware of <!--> blabla <!--> !! - '(("\\(<\\)!--" (1 "< b")) + ("\\(<\\)!--" (1 "< b")) ("--[ \t\n]*\\(>\\)" (1 "> b")) ;; Double quotes outside of tags should not introduce strings. ;; Be careful to call `syntax-ppss' on a position before the one we're @@ -477,9 +478,9 @@ '((sgml-font-lock-keywords sgml-font-lock-keywords-1 sgml-font-lock-keywords-2) - nil t nil nil - (font-lock-syntactic-keywords - . sgml-font-lock-syntactic-keywords))) + nil t)) + (set (make-local-variable 'syntax-propertize-function) + sgml-syntax-propertize-function) (set (make-local-variable 'facemenu-add-face-function) 'sgml-mode-facemenu-add-face-function) (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
--- a/lisp/textmodes/tex-mode.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/tex-mode.el Sun Sep 12 22:46:48 2010 +0000 @@ -488,7 +488,7 @@ ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) (list - ;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be + ;; tex-font-lock-syntactic-keywords causes the \ of \end{verbatim} to be ;; highlighted as tex-verbatim face. Let's undo that. ;; This is ugly and brittle :-( --Stef '("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t)) @@ -655,6 +655,7 @@ ;; line is re-font-locked on its own. ;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim ;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef + ;; FIXME: See gud.el for an example of a solution to a similar problem. (eval . `(,(concat "^\\(\\\\\\)end *{" (regexp-opt tex-verbatim-environments t) "}\\(.?\\)") (1 "|") (3 "<"))) @@ -1163,10 +1164,9 @@ (font-lock-syntactic-face-function . tex-font-lock-syntactic-face-function) (font-lock-unfontify-region-function - . tex-font-lock-unfontify-region) - (font-lock-syntactic-keywords - . tex-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + . tex-font-lock-unfontify-region))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock tex-font-lock-syntactic-keywords)) ;; TABs in verbatim environments don't do what you think. (set (make-local-variable 'indent-tabs-mode) nil) ;; Other vars that should be buffer-local. @@ -2850,12 +2850,12 @@ (mapcar (lambda (x) (case (car-safe x) - (font-lock-syntactic-keywords - (cons (car x) 'doctex-font-lock-syntactic-keywords)) (font-lock-syntactic-face-function (cons (car x) 'doctex-font-lock-syntactic-face-function)) (t x))) - (cdr font-lock-defaults))))) + (cdr font-lock-defaults)))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock doctex-font-lock-syntactic-keywords))) (run-hooks 'tex-mode-load-hook)
--- a/lisp/textmodes/texinfo.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/textmodes/texinfo.el Sun Sep 12 22:46:48 2010 +0000 @@ -310,10 +310,11 @@ ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.") -(defvar texinfo-font-lock-syntactic-keywords - '(("\\(@\\)c\\(omment\\)?\\>" (1 "<")) - ("^\\(@\\)ignore\\>" (1 "< b")) - ("^@end ignore\\(\n\\)" (1 "> b"))) +(defconst texinfo-syntax-propertize-function + (syntax-propertize-rules + ("\\(@\\)c\\(omment\\)?\\>" (1 "<")) + ("^\\(@\\)ignore\\>" (1 "< b")) + ("^@end ignore\\(\n\\)" (1 "> b"))) "Syntactic keywords to catch comment delimiters in `texinfo-mode'.") (defconst texinfo-environments @@ -600,9 +601,9 @@ (setq imenu-case-fold-search nil) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults - '(texinfo-font-lock-keywords nil nil nil backward-paragraph - (font-lock-syntactic-keywords - . texinfo-font-lock-syntactic-keywords))) + '(texinfo-font-lock-keywords nil nil nil backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + texinfo-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) ;; Outline settings.
--- a/lisp/url/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,8 @@ +2010-09-11 Glenn Morris <rgm@gnu.org> + + * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el: + * url-vars.el: Remove leading `*' from defcustom docs. + 2010-07-27 Michael Albinus <michael.albinus@gmx.de> * url-http (url-http-parse-headers): Disable file name handlers at
--- a/lisp/url/url-cache.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-cache.el Sun Sep 12 22:46:48 2010 +0000 @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -28,7 +28,7 @@ (defcustom url-cache-directory (expand-file-name "cache" url-configuration-directory) - "*The directory where cache files should be stored." + "The directory where cache files should be stored." :type 'directory :group 'url-file) @@ -165,7 +165,7 @@ url-cache-directory)))))) (defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 - "*What function to use to create a cached filename." + "What function to use to create a cached filename." :type '(choice (const :tag "MD5 of filename (low collision rate)" :value url-cache-create-filename-using-md5) (const :tag "Human readable filenames (higher collision rate)"
--- a/lisp/url/url-gw.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-gw.el Sun Sep 12 22:46:48 2010 +0000 @@ -37,50 +37,50 @@ :group 'url) (defcustom url-gateway-local-host-regexp nil - "*A regular expression specifying local hostnames/machines." + "A regular expression specifying local hostnames/machines." :type '(choice (const nil) regexp) :group 'url-gateway) (defcustom url-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" - "*A regular expression matching a shell prompt." + "A regular expression matching a shell prompt." :type 'regexp :group 'url-gateway) (defcustom url-gateway-rlogin-host nil - "*What hostname to actually rlog into before doing a telnet." + "What hostname to actually rlog into before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-user-name nil - "*Username to log into the remote machine with when using rlogin." + "Username to log into the remote machine with when using rlogin." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-parameters '("telnet" "-8") - "*Parameters to `url-open-rlogin'. + "Parameters to `url-open-rlogin'. This list will be used as the parameter list given to rsh." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-host nil - "*What hostname to actually login to before doing a telnet." + "What hostname to actually login to before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") - "*Parameters to `url-open-telnet'. + "Parameters to `url-open-telnet'. This list will be executed as a command after logging in via telnet." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-login-prompt "^\r*.?login:" - "*Prompt that tells us we should send our username when loggin in w/telnet." + "Prompt that tells us we should send our username when loggin in w/telnet." :type 'regexp :group 'url-gateway) (defcustom url-gateway-telnet-password-prompt "^\r*.?password:" - "*Prompt that tells us we should send our password when loggin in w/telnet." + "Prompt that tells us we should send our password when loggin in w/telnet." :type 'regexp :group 'url-gateway) @@ -95,7 +95,7 @@ :group 'url-gateway) (defcustom url-gateway-broken-resolution nil - "*Whether to use nslookup to resolve hostnames. + "Whether to use nslookup to resolve hostnames. This should be used when your version of Emacs cannot correctly use DNS, but your machine can. This usually happens if you are running a statically linked Emacs under SunOS 4.x." @@ -103,7 +103,7 @@ :group 'url-gateway) (defcustom url-gateway-nslookup-program "nslookup" - "*If non-nil then a string naming nslookup program." + "If non-nil then a string naming nslookup program." :type '(choice (const :tag "None" :value nil) string) :group 'url-gateway)
--- a/lisp/url/url-history.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-history.el Sun Sep 12 22:46:48 2010 +0000 @@ -1,7 +1,7 @@ ;;; url-history.el --- Global history tracking for URL package -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -35,7 +35,7 @@ :group 'url) (defcustom url-history-track nil - "*Controls whether to keep a list of all the URLs being visited. + "Controls whether to keep a list of all the URLs being visited. If non-nil, the URL package will keep track of all the URLs visited. If set to t, then the list is saved to disk at the end of each Emacs session." @@ -49,14 +49,14 @@ :group 'url-history) (defcustom url-history-file nil - "*The global history file for the URL package. + "The global history file for the URL package. This file contains a list of all the URLs you have visited. This file is parsed at startup and used to provide URL completion." :type '(choice (const :tag "Default" :value nil) file) :group 'url-history) (defcustom url-history-save-interval 3600 - "*The number of seconds between automatic saves of the history list. + "The number of seconds between automatic saves of the history list. Default is 1 hour. Note that if you change this variable outside of the `customize' interface after `url-do-setup' has been run, you need to run the `url-history-setup-save-timer' function manually."
--- a/lisp/url/url-irc.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-irc.el Sun Sep 12 22:46:48 2010 +0000 @@ -1,7 +1,7 @@ ;;; url-irc.el --- IRC URL interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -22,7 +22,8 @@ ;;; Commentary: -;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt +;; IRC URLs are defined in +;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt ;;; Code: @@ -32,7 +33,7 @@ (defconst url-irc-default-port 6667 "Default port for IRC connections.") (defcustom url-irc-function 'url-irc-rcirc - "*Function to actually open an IRC connection. + "Function to actually open an IRC connection. The function should take the following arguments: HOST - the hostname of the IRC server to contact PORT - the port number of the IRC server to contact
--- a/lisp/url/url-util.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-util.el Sun Sep 12 22:46:48 2010 +0000 @@ -43,7 +43,7 @@ ;;;###autoload (defcustom url-debug nil - "*What types of debug messages from the URL library to show. + "What types of debug messages from the URL library to show. Debug messages are logged to the *URL-DEBUG* buffer. If t, all messages will be logged.
--- a/lisp/url/url-vars.el Fri Sep 10 05:38:52 2010 +0000 +++ b/lisp/url/url-vars.el Sun Sep 12 22:46:48 2010 +0000 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -68,7 +68,7 @@ )) (defcustom url-honor-refresh-requests t - "*Whether to do automatic page reloads. + "Whether to do automatic page reloads. These are done at the request of the document author or the server via the `Refresh' header in an HTTP response. If nil, no refresh requests will be honored. If t, all refresh requests will be honored. @@ -79,14 +79,14 @@ :group 'url-hairy) (defcustom url-automatic-caching nil - "*If non-nil, all documents will be automatically cached to the local disk." + "If non-nil, all documents will be automatically cached to the local disk." :type 'boolean :group 'url-cache) ;; Fixme: sanitize this. (defcustom url-cache-expired (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)) - "*A function determining if a cached item has expired. + "A function determining if a cached item has expired. It takes two times (numbers) as its arguments, and returns non-nil if the second time is 'too old' when compared to the first time." :type 'function @@ -96,14 +96,14 @@ "Where to send bug reports.") (defcustom url-personal-mail-address nil - "*Your full email address. + "Your full email address. This is what is sent to HTTP servers as the FROM field in an HTTP request." :type '(choice (const :tag "Unspecified" nil) string) :group 'url) (defcustom url-directory-index-file "index.html" - "*The filename to look for when indexing a directory. + "The filename to look for when indexing a directory. If this file exists, and is readable, then it will be viewed instead of using `dired' to view the directory." :type 'string @@ -166,14 +166,14 @@ (".hqx" . "x-hqx") (".Z" . "x-compress") (".bz2" . "x-bzip2")) - "*An alist of file extensions and appropriate content-transfer-encodings." + "An alist of file extensions and appropriate content-transfer-encodings." :type '(repeat (cons :format "%v" (string :tag "Extension") (string :tag "Encoding"))) :group 'url-mime) (defcustom url-mail-command 'compose-mail - "*This function will be called whenever URL needs to send mail. + "This function will be called whenever URL needs to send mail. It should enter a mail-mode-like buffer in the current window. The commands `mail-to' and `mail-subject' should still work in this buffer, and it should use `mail-header-separator' if possible." @@ -181,7 +181,7 @@ :group 'url) (defcustom url-proxy-services nil - "*An alist of schemes and proxy servers that gateway them. + "An alist of schemes and proxy servers that gateway them. Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up from the ACCESS_proxy environment variables." :type '(repeat (cons :format "%v" @@ -190,7 +190,7 @@ :group 'url) (defcustom url-standalone-mode nil - "*Rely solely on the cache?" + "Rely solely on the cache?" :type 'boolean :group 'url-cache) @@ -202,7 +202,7 @@ (defcustom url-bad-port-list '("25" "119" "19") - "*List of ports to warn the user about connecting to. + "List of ports to warn the user about connecting to. Defaults to just the mail, chargen, and NNTP ports so you cannot be tricked into sending fake mail or forging messages by a malicious HTML document." @@ -255,7 +255,7 @@ ;; Fixme: set from the locale. (defcustom url-mime-language-string nil - "*String to send in the Accept-language: field in HTTP requests. + "String to send in the Accept-language: field in HTTP requests. Specifies the preferred language when servers can serve documents in several languages. Use RFC 1766 abbreviations, e.g.: `en' for @@ -284,20 +284,20 @@ "What OS we are on.") (defcustom url-max-password-attempts 5 - "*Maximum number of times a password will be prompted for. + "Maximum number of times a password will be prompted for. Applies when a protected document is denied by the server." :type 'integer :group 'url) (defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go." + "Where temporary files go." :type 'directory :group 'url-file) (make-obsolete-variable 'url-temporary-directory 'temporary-file-directory "23.1") (defcustom url-show-status t - "*Whether to show a running total of bytes transferred. + "Whether to show a running total of bytes transferred. Can cause a large hit if using a remote X display over a slow link, or a terminal with a slow modem." :type 'boolean @@ -308,7 +308,7 @@ http://www.example.com/") (defcustom url-news-server nil - "*The default news server from which to get newsgroups/articles. + "The default news server from which to get newsgroups/articles. Applies if no server is specified in the URL. Defaults to the environment variable NNTPSERVER or \"news\" if NNTPSERVER is undefined." @@ -320,13 +320,13 @@ "A regular expression that will match an absolute URL.") (defcustom url-max-redirections 30 - "*The maximum number of redirection requests to honor in a HTTP connection. + "The maximum number of redirection requests to honor in a HTTP connection. A negative number means to honor an unlimited number of redirection requests." :type 'integer :group 'url) (defcustom url-confirmation-func 'y-or-n-p - "*What function to use for asking yes or no functions. + "What function to use for asking yes or no functions. Possible values are `yes-or-no-p' or `y-or-n-p', or any function that takes a single argument (the prompt), and returns t only if a positive answer is given." @@ -336,7 +336,7 @@ :group 'url-hairy) (defcustom url-gateway-method 'native - "*The type of gateway support to use. + "The type of gateway support to use. Should be a symbol specifying how to get a connection from the local machine. Currently supported methods:
--- a/src/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/src/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,24 @@ +2010-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fhtml_parse_string, Fxml_parse_string): Mention BASE-URL. + +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (Fy_or_n_p): Move to lisp/subr.el. + (syms_of_fns): Don't defsubr Sy_or_n_p. + * lisp.h: Don't declare Fy_or_n_p. + * fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p. + +2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fxml_parse_buffer): New function to parse XML files. + +2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c: New file. + (Fhtml_parse_buffer): New function to interface to the libxml2 + html parsing function. + 2010-09-05 Juanma Barranquero <lekktu@gmail.com> * biditype.h: Regenerate. @@ -60,8 +81,8 @@ characters. * term.c (encode_terminal_code): Fix the previous change. - (produce_glyphs): Don't set it->char_to_display here. Don't - handle unibyte-display-via-language-environment here. + (produce_glyphs): Don't set it->char_to_display here. + Don't handle unibyte-display-via-language-environment here. (produce_special_glyphs): Set temp_it.char_to_display before calling produce_glyphs. @@ -104,7 +125,7 @@ 2010-08-29 Kenichi Handa <handa@m17n.org> * term.c (encode_terminal_code): Encode byte chars to the - correspnding bytes. + corresponding bytes. 2010-08-29 Jan Djärv <jan.h.d@swipnet.se>
--- a/src/Makefile.in Fri Sep 10 05:38:52 2010 +0000 +++ b/src/Makefile.in Sun Sep 12 22:46:48 2010 +0000 @@ -226,6 +226,8 @@ IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ +LIBXML2_LIBS = @LIBXML2_LIBS@ +LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ @@ -320,7 +322,8 @@ ## FIXME? MYCPPFLAGS only referenced in etc/DEBUG. ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \ ${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \ - ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} \ + ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} \ + ${LIBXML2_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ ${C_WARNINGS_SWITCH} ${CFLAGS} @@ -349,7 +352,7 @@ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ + doprnt.o strftime.o intervals.o textprop.o composite.o md5.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) ## Object files used on some machine or other. @@ -595,7 +598,8 @@ ## duplicated symbols. If the standard libraries were compiled ## with GCC, we might need LIB_GCC again after them. LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ + $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) \ + ${LIBXML2_LIBS} $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
--- a/src/config.in Fri Sep 10 05:38:52 2010 +0000 +++ b/src/config.in Sun Sep 12 22:46:48 2010 +0000 @@ -813,6 +813,9 @@ /* Define to 1 if you have the SM library (-lSM). */ #undef HAVE_X_SM +/* Define to 1 if you have the libxml2 library (-lxml2). */ +#undef HAVE_LIBXML2 + /* Define to 1 if you want to use the X window system. */ #undef HAVE_X_WINDOWS
--- a/src/emacs.c Fri Sep 10 05:38:52 2010 +0000 +++ b/src/emacs.c Sun Sep 12 22:46:48 2010 +0000 @@ -1544,6 +1544,10 @@ #endif #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_LIBXML2 + syms_of_xml (); +#endif + syms_of_menu (); #ifdef HAVE_NTGUI
--- a/src/fileio.c Fri Sep 10 05:38:52 2010 +0000 +++ b/src/fileio.c Sun Sep 12 22:46:48 2010 +0000 @@ -1842,7 +1842,7 @@ tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); if (quick) - tem = Fy_or_n_p (tem); + tem = call1 (intern ("y-or-n-p"), tem); else tem = do_yes_or_no_p (tem); UNGCPRO;
--- a/src/fns.c Fri Sep 10 05:38:52 2010 +0000 +++ b/src/fns.c Sun Sep 12 22:46:48 2010 +0000 @@ -2444,146 +2444,6 @@ return sequence; } -/* Anything that calls this function must protect from GC! */ - -DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, - doc: /* Ask user a "y or n" question. Return t if answer is "y". -Takes one argument, which 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. -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 -for more information. In this case, the useful bindings are `act', `skip', -`recenter', and `quit'.\) - -Under a windowing system a dialog box will be used if `last-nonmenu-event' -is nil and `use-dialog-box' is non-nil. */) - (Lisp_Object prompt) -{ - register Lisp_Object obj, key, def, map; - register int answer; - Lisp_Object xprompt; - Lisp_Object args[2]; - struct gcpro gcpro1, gcpro2; - int count = SPECPDL_INDEX (); - - specbind (Qcursor_in_echo_area, Qt); - - map = Fsymbol_value (intern ("query-replace-map")); - - CHECK_STRING (prompt); - xprompt = prompt; - GCPRO2 (prompt, xprompt); - -#ifdef HAVE_WINDOW_SYSTEM - if (display_hourglass_p) - cancel_hourglass (); -#endif - - while (1) - { - -#ifdef HAVE_MENUS - if (FRAME_WINDOW_P (SELECTED_FRAME ()) - && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && have_menus_p ()) - { - Lisp_Object pane, menu; - redisplay_preserve_echo_area (3); - pane = Fcons (Fcons (build_string ("Yes"), Qt), - Fcons (Fcons (build_string ("No"), Qnil), - Qnil)); - menu = Fcons (prompt, pane); - obj = Fx_popup_dialog (Qt, menu, Qnil); - answer = !NILP (obj); - break; - } -#endif /* HAVE_MENUS */ - cursor_in_echo_area = 1; - choose_minibuf_frame (); - - { - Lisp_Object pargs[3]; - - /* Colorize prompt according to `minibuffer-prompt' face. */ - pargs[0] = build_string ("%s(y or n) "); - pargs[1] = intern ("face"); - pargs[2] = intern ("minibuffer-prompt"); - args[0] = Fpropertize (3, pargs); - args[1] = xprompt; - Fmessage (2, args); - } - - if (minibuffer_auto_raise) - { - Lisp_Object mini_frame; - - mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); - - Fraise_frame (mini_frame); - } - - temporarily_switch_to_single_kboard (SELECTED_FRAME ()); - obj = read_filtered_event (1, 0, 0, 0, Qnil); - cursor_in_echo_area = 0; - /* If we need to quit, quit with cursor_in_echo_area = 0. */ - QUIT; - - key = Fmake_vector (make_number (1), obj); - def = Flookup_key (map, key, Qt); - - if (EQ (def, intern ("skip"))) - { - answer = 0; - break; - } - else if (EQ (def, intern ("act"))) - { - answer = 1; - break; - } - else if (EQ (def, intern ("recenter"))) - { - Frecenter (Qnil); - xprompt = prompt; - continue; - } - else if (EQ (def, intern ("quit"))) - Vquit_flag = Qt; - /* We want to exit this command for exit-prefix, - and this is the only way to do it. */ - else if (EQ (def, intern ("exit-prefix"))) - Vquit_flag = Qt; - - QUIT; - - /* If we don't clear this, then the next call to read_char will - return quit_char again, and we'll enter an infinite loop. */ - Vquit_flag = Qnil; - - Fding (Qnil); - Fdiscard_input (); - if (EQ (xprompt, prompt)) - { - args[0] = build_string ("Please answer y or n. "); - args[1] = prompt; - xprompt = Fconcat (2, args); - } - } - UNGCPRO; - - if (! noninteractive) - { - cursor_in_echo_area = -1; - message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n", - xprompt, 0); - } - - unbind_to (count, Qnil); - return answer ? Qt : Qnil; -} - /* This is how C code calls `yes-or-no-p' and allows the user to redefined it. @@ -5058,7 +4918,6 @@ defsubr (&Smapcar); defsubr (&Smapc); defsubr (&Smapconcat); - defsubr (&Sy_or_n_p); defsubr (&Syes_or_no_p); defsubr (&Sload_average); defsubr (&Sfeaturep);
--- a/src/lisp.h Fri Sep 10 05:38:52 2010 +0000 +++ b/src/lisp.h Sun Sep 12 22:46:48 2010 +0000 @@ -2516,7 +2516,6 @@ EXFUN (Fnconc, MANY); EXFUN (Fmapcar, 2); EXFUN (Fmapconcat, 3); -EXFUN (Fy_or_n_p, 1); extern Lisp_Object do_yes_or_no_p (Lisp_Object); EXFUN (Frequire, 3); EXFUN (Fprovide, 2); @@ -3577,6 +3576,11 @@ EXFUN (Fmsdos_downcase_filename, 1); #endif +#ifdef HAVE_LIBXML2 +/* Defined in xml.c */ +extern void syms_of_xml (void); +#endif + #ifdef HAVE_MENUS /* Defined in (x|w32)fns.c, nsfns.m... */ extern int have_menus_p (void);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/xml.c Sun Sep 12 22:46:48 2010 +0000 @@ -0,0 +1,141 @@ +/* Interface to libxml2. + Copyright (C) 2010 Free Software Foundation, Inc. + +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 3 of the License, or +(at your option) any later version. + +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. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +#ifdef HAVE_LIBXML2 + +#include <setjmp.h> +#include <libxml/tree.h> +#include <libxml/parser.h> +#include <libxml/HTMLparser.h> + +#include "lisp.h" +#include "buffer.h" + +Lisp_Object make_dom (xmlNode *node) +{ + if (node->type == XML_ELEMENT_NODE) { + Lisp_Object result = Fcons (intern (node->name), Qnil); + xmlNode *child; + xmlAttr *property; + + /* First add the attributes. */ + property = node->properties; + while (property != NULL) { + if (property->children && + property->children->content) { + char *pname = xmalloc (strlen (property->name) + 2); + *pname = ':'; + strcpy(pname + 1, property->name); + result = Fcons (Fcons (intern (pname), + build_string(property->children->content)), + result); + xfree (pname); + } + property = property->next; + } + /* Then add the children of the node. */ + child = node->children; + while (child != NULL) { + result = Fcons (make_dom (child), result); + child = child->next; + } + return Fnreverse (result); + } else if (node->type == XML_TEXT_NODE) { + Lisp_Object content = Qnil; + + if (node->content) + content = build_string (node->content); + + return Fcons (intern (node->name), content); + } else + return Qnil; +} + +static Lisp_Object +parse_buffer (Lisp_Object string, Lisp_Object base_url, int htmlp) +{ + xmlDoc *doc; + xmlNode *node; + Lisp_Object result; + int ibeg, iend; + char *burl = ""; + + LIBXML_TEST_VERSION; + + CHECK_STRING (string); + + if (! NILP (base_url)) { + CHECK_STRING (base_url); + burl = SDATA (base_url); + } + + if (htmlp) + doc = htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + HTML_PARSE_RECOVER|HTML_PARSE_NONET| + HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR); + else + doc = xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + XML_PARSE_NONET|XML_PARSE_NOWARNING| + XML_PARSE_NOERROR); + + if (doc != NULL) { + node = xmlDocGetRootElement (doc); + if (node != NULL) + result = make_dom (node); + + xmlFreeDoc (doc); + xmlCleanupParser (); + } + + return result; +} + +DEFUN ("html-parse-string", Fhtml_parse_string, Shtml_parse_string, + 0, 2, 0, + doc: /* Parse the string as an HTML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the HTML document.*/) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_buffer (string, base_url, 1); +} + +DEFUN ("xml-parse-string", Fxml_parse_string, Sxml_parse_string, + 0, 2, 0, + doc: /* Parse the string as an XML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the XML document.*/) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_buffer (string, base_url, 0); +} + + +/*********************************************************************** + Initialization + ***********************************************************************/ +void +syms_of_xml (void) +{ + defsubr (&Shtml_parse_string); + defsubr (&Sxml_parse_string); +} + +#endif /* HAVE_LIBXML2 */
--- a/test/ChangeLog Fri Sep 10 05:38:52 2010 +0000 +++ b/test/ChangeLog Sun Sep 12 22:46:48 2010 +0000 @@ -1,3 +1,7 @@ +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * indent/octave.m: Remove some `fixindent' not needed any more. + 2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> * indent/octave.m: New file.
--- a/test/indent/octave.m Fri Sep 10 05:38:52 2010 +0000 +++ b/test/indent/octave.m Sun Sep 12 22:46:48 2010 +0000 @@ -1415,7 +1415,7 @@ endfor # fixindent ## Search all C++ source files for PKG commands. - lst = dir (fullfile (packdir, "src", "*.cc")); # fixindent + lst = dir (fullfile (packdir, "src", "*.cc")); for i = 1:length (lst) nam = fullfile (packdir, "src", lst(i).name); fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); @@ -1451,10 +1451,10 @@ unlink (archpkg); endif endif - endif # fixindent -endfunction # fixindent + endif +endfunction -function copy_files (desc, packdir, global_install) # fixindent +function copy_files (desc, packdir, global_install) ## Create the installation directory. if (! exist (desc.dir, "dir")) [status, output] = mkdir (desc.dir);