diff options
| author | Karoly Lorentey <lorentey@elte.hu> | 2006-01-03 02:15:28 +0000 |
|---|---|---|
| committer | Karoly Lorentey <lorentey@elte.hu> | 2006-01-03 02:15:28 +0000 |
| commit | b58cb6144c59dfa3a44b9b383cf354bc2c9bebdf (patch) | |
| tree | 87bc562249d9e597e12406e1d9b1c7dfb0f937e5 | |
| parent | b3e6f69c10973ff7b040ced07a3a084960619681 (diff) | |
| parent | 55262b16df717fe533ea4ad23dac3f02398c9055 (diff) | |
| download | emacs-b58cb6144c59dfa3a44b9b383cf354bc2c9bebdf.tar.gz | |
Merged from miles@gnu.org--gnu-2005 (patch 682)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-682
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-490
57 files changed, 2186 insertions, 1467 deletions
diff --git a/ChangeLog b/ChangeLog index 84f25e00117..18676cf7197 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,8 @@ -2005-12-25 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) +2005-12-29 Andreas Schwab <schwab@suse.de> + + * config.guess, config.sub: Updated from master source. + +2005-12-25 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) * configure.in: use amdx86-64 for freebsd on x86_64. diff --git a/config.guess b/config.guess index ad5281e66e9..10a8260177a 100755 --- a/config.guess +++ b/config.guess @@ -3,7 +3,7 @@ # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. -timestamp='2005-08-03' +timestamp='2005-12-23' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -764,7 +764,12 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + case ${UNAME_MACHINE} in + pc98) + echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin @@ -779,7 +784,7 @@ EOF i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - x86:Interix*:[34]*) + x86:Interix*:[345]*) echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' exit ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) @@ -851,7 +856,7 @@ EOF #endif #endif EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^CPU/{s: ::g;p;}'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; mips64:Linux:*:*) @@ -870,7 +875,7 @@ EOF #endif #endif EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^CPU/{s: ::g;p;}'`" test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; or32:Linux:*:*) @@ -919,6 +924,9 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-gnu + exit ;; x86_64:Linux:*:*) echo x86_64-unknown-linux-gnu exit ;; @@ -964,7 +972,7 @@ EOF LIBC=gnulibc1 # endif #else - #ifdef __INTEL_COMPILER + #if defined(__INTEL_COMPILER) || defined(__PGI) LIBC=gnu #else LIBC=gnuaout @@ -974,7 +982,7 @@ EOF LIBC=dietlibc #endif EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '/^LIBC/{s: ::g;p;}'`" test x"${LIBC}" != x && { echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit @@ -1185,7 +1193,6 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in - *86) UNAME_PROCESSOR=i686 ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1264,6 +1271,9 @@ EOF i*86:skyos:*:*) echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 diff --git a/config.sub b/config.sub index 1c366dfde9a..8f7b7381c47 100755 --- a/config.sub +++ b/config.sub @@ -3,7 +3,7 @@ # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, # 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. -timestamp='2005-07-08' +timestamp='2005-12-23' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software @@ -119,8 +119,9 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | \ - kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) + nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ + uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; @@ -171,6 +172,10 @@ case $os in -hiux*) os=-hiuxwe2 ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -187,6 +192,10 @@ case $os in # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -239,7 +248,7 @@ case $basic_machine in | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ - | m32r | m32rle | m68000 | m68k | m88k | maxq | mcore \ + | m32r | m32rle | m68000 | m68k | m88k | maxq | mb | microblaze | mcore \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ @@ -257,7 +266,7 @@ case $basic_machine in | mipsisa64sr71k | mipsisa64sr71kel \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ - | ms1 \ + | mt \ | msp430 \ | ns16k | ns32k \ | or32 \ @@ -286,6 +295,9 @@ case $basic_machine in ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; + ms1) + basic_machine=mt-unknown + ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and @@ -336,7 +348,7 @@ case $basic_machine in | mipsisa64sr71k-* | mipsisa64sr71kel-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ - | ms1-* \ + | mt-* \ | msp430-* \ | none-* | np1-* | ns16k-* | ns32k-* \ | orion-* \ @@ -696,6 +708,9 @@ case $basic_machine in basic_machine=i386-pc os=-msdos ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; mvs) basic_machine=i370-ibm os=-mvs @@ -803,6 +818,12 @@ case $basic_machine in pc532 | pc532-*) basic_machine=ns32k-pc532 ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; @@ -859,6 +880,10 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; rom68k) basic_machine=m68k-rom68k os=-coff @@ -1181,14 +1206,15 @@ case $os in | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ | -chorusos* | -chorusrdb* \ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-uclibc* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku*) + | -skyos* | -haiku* | -rdos*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) diff --git a/etc/ChangeLog b/etc/ChangeLog index 4fcfeaf3842..56c72c22d3b 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -2,7 +2,7 @@ * e/eterm-color.ti: Temporarily disable the ri entry. * e/eterm-color: Regenerate. - + 2005-12-21 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> * TODO: Add note on the multi-tty branch. @@ -35,7 +35,7 @@ * orgcard.tex: Version 3.20 -2005-11-16 Nick Roberts <nickrob@snap.net.nz> +2005-11-16 Nick Roberts <nickrob@snap.net.nz> * images/gud/go.xpm, images/gud/go.pbm: Old gud-remove icons. Use for run/continue. @@ -45,7 +45,7 @@ Use a more appropriate variable name. * images/gud/remove.xpm, images/gud/remove.pbm * images/gud/break.xpm, images/gud/break.pbm: Make more intuitive. - + 2005-11-09 Nick Roberts <nickrob@snap.net.nz> * images/gud/pp.xpm, images/gud/pp.pbm: New icons. @@ -55,7 +55,7 @@ * images/copy.xpm, images/copy.pbm, images/low-color/copy.xpm * images/save.xpm, images/save.pbm, images/low-color/save.xpm: Adjust baseline. - + 2005-11-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * images/up-node.xpm, images/prev-node.xpm, images/next-node.xpm @@ -165,18 +165,18 @@ * images/right-arrow.*: Moved here from lisp/toolbar/right_arrow.*. * images/up-arrow.*: Moved here from lisp/toolbar/up_arrow.*. * images/low-color/back-arrow.*: Moved here from - lisp/toolbar/lc-back_arrow.*. + lisp/toolbar/lc-back_arrow.*. * images/low-color/fwd-arrow.*: Moved here from lisp/toolbar/lc-fwd_arrow.*. * images/low-color/jump-to.*: Moved here from lisp/toolbar/lc-jump_to.*. * images/low-color/left-arrow.*: Moved here from - lisp/toolbar/lc-left_arrow.*. + lisp/toolbar/lc-left_arrow.*. * images/low-color/right-arrow.*: Moved here from - lisp/toolbar/lc-right_arrow.*. + lisp/toolbar/lc-right_arrow.*. * images/low-color/up-arrow.*: Moved here from lisp/toolbar/lc-up_arrow.*. - * images/mail/compose.*: Moved here from lisp/toolbar/mail_compose.*. + * images/mail/compose.*: Moved here from lisp/toolbar/mail_compose.*. * images/mail/send.*: Moved here from lisp/toolbar/mail_send.*. * images/README: Incorporated the content of lisp/toolbar/README @@ -191,7 +191,7 @@ next.*, nexti.*, step.*, and stepi.* , respectively, as the file-name no longer clashes on 8+3 filesystems. -2005-10-14 Bill Wohler <wohler@newt.com> +2005-10-14 Bill Wohler <wohler@newt.com> * images/gud/break.*: Moved here from toolbar/gud-break.*. * images/gud/cont.*: Moved here from toolbar/gud-cont.*. @@ -209,10 +209,10 @@ * images/gud/up.*: Moved here from toolbar/gud-up.*. * images/gud/watch.*: Moved here from toolbar/gud-watch.*. -2005-10-14 Bill Wohler <wohler@newt.com> +2005-10-14 Bill Wohler <wohler@newt.com> Released MH-E version 7.85. - + * NEWS, MH-E-NEWS: Updated for release 7.85. 2005-10-10 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> @@ -817,6 +817,10 @@ appears in. *** The variable `cursor-in-non-selected-windows' can now be set to any of the recognized cursor types. ++++ +*** On text terminals, the variable `visible-cursor' controls whether Emacs +uses the "very visible" cursor (the default) or the normal cursor. + ** New faces: +++ diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 223470d2e3d..c8d1cb41dea 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,15 @@ +2005-12-30 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (MOUSE_SUPPORT): Add tooltip.elc. + (lisp1): Add rfn-eshadow.elc, international/utf-16.elc, image.elc, + international/fontset.elc, dnd.elc, mwheel.elc, and tool-bar.elc. + Rearrange the list to be similar to $(shortlisp) in + src/Makefile.in. + (lisp2): Add language/kannada.el, emacs-lisp/syntax.elc, + emacs-lisp/timer.elc, jka-cmpr-hook.elc, font-lock.elc, + jit-lock.elc. Rearrange the list to be similar to $(shortlisp) in + src/Makefile.in. + 2005-12-22 Richard M. Stallman <rms@gnu.org> * Makefile.in (update-game-score.o): Delete spurious final `\'. diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index a1a96098bd8..bf7a293adc6 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -154,7 +154,7 @@ obj= sunfns.o dosfns.o msdos.o \ # lispsource = ../lisp/ -MOUSE_SUPPORT = $(lispsource)select.elc $(lispsource)scroll-bar.elc $(lispsource)mouse.elc +MOUSE_SUPPORT = $(lispsource)select.elc $(lispsource)scroll-bar.elc $(lispsource)mouse.elc $(lispsource)tooltip.elc WINNT_SUPPORT = $(lispsource)ls-lisp.elc $(lispsource)disp-table.elc $(lispsource)w32-fns.elc $(lispsource)dos-w32.elc $(lispsource)w32-vars.elc # lisp files that are loaded up on other platforms @@ -166,33 +166,35 @@ lisp1= \ $(lispsource)buff-menu.elc \ $(lispsource)button.elc \ $(lispsource)emacs-lisp/byte-run.elc \ + $(lispsource)cus-face.elc \ $(lispsource)cus-start.elc \ $(lispsource)custom.elc \ $(lispsource)emacs-lisp/backquote.elc \ $(lispsource)emacs-lisp/lisp-mode.elc \ $(lispsource)emacs-lisp/lisp.elc \ - $(lispsource)env.elc \ - $(lispsource)faces.elc \ - $(lispsource)files.elc \ - $(lispsource)format.elc \ $(lispsource)facemenu.elc \ $(MOUSE_SUPPORT) \ + $(lispsource)faces.elc \ + $(lispsource)files.elc \ $(lispsource)emacs-lisp/float-sup.elc \ + $(lispsource)format.elc \ $(lispsource)frame.elc \ $(lispsource)help.elc \ $(lispsource)indent.elc \ $(lispsource)isearch.elc \ + $(lispsource)rfn-eshadow.elc \ $(lispsource)loadup.el \ $(lispsource)loaddefs.el \ $(lispsource)bindings.elc \ $(lispsource)emacs-lisp/map-ynp.elc \ - $(lispsource)menu-bar.elc \ + $(lispsource)env.elc \ $(lispsource)international/mule.elc \ $(lispsource)international/mule-conf.el \ $(lispsource)international/mule-cmds.elc \ $(lispsource)international/characters.elc \ $(lispsource)international/ucs-tables.elc \ $(lispsource)international/utf-8.elc \ + $(lispsource)international/utf-16.elc \ $(lispsource)international/latin-1.el \ $(lispsource)international/latin-2.el \ $(lispsource)international/latin-3.el \ @@ -200,6 +202,11 @@ lisp1= \ $(lispsource)international/latin-5.el \ $(lispsource)international/latin-8.el \ $(lispsource)international/latin-9.el \ + $(lispsource)image.elc \ + $(lispsource)international/fontset.elc \ + $(lispsource)dnd.elc \ + $(lispsource)mwheel.elc \ + $(lispsource)tool-bar.elc \ $(lispsource)case-table.elc lisp2 = \ @@ -207,6 +214,7 @@ lisp2 = \ $(lispsource)language/cyrillic.elc \ $(lispsource)language/indian.elc \ $(lispsource)language/devanagari.el \ + $(lispsource)language/kannada.el \ $(lispsource)language/malayalam.el \ $(lispsource)language/tamil.el \ $(lispsource)language/english.el \ @@ -226,6 +234,7 @@ lisp2 = \ $(lispsource)language/misc-lang.el \ $(lispsource)language/utf-8-lang.el \ $(lispsource)language/georgian.el \ + $(lispsource)menu-bar.elc \ $(lispsource)paths.el \ $(lispsource)register.elc \ $(lispsource)replace.elc \ @@ -234,11 +243,16 @@ lisp2 = \ $(lispsource)subr.elc \ $(lispsource)term/tty-colors.elc \ $(lispsource)font-core.elc \ + $(lispsource)emacs-lisp/syntax.elc \ + $(lispsource)font-lock.elc \ + $(lispsource)jit-lock.elc \ $(lispsource)textmodes/fill.elc \ $(lispsource)textmodes/page.elc \ $(lispsource)textmodes/paragraphs.elc \ $(lispsource)textmodes/text-mode.elc \ + $(lispsource)emacs-lisp/timer.elc \ $(lispsource)vc-hooks.elc \ + $(lispsource)jka-cmpr-hook.elc \ $(lispsource)ediff-hook.elc \ $(VMS_SUPPORT) \ $(MSDOS_SUPPORT) \ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 288e4d7ed44..1050d3deb84 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,171 @@ +2006-01-01 Richard M. Stallman <rms@gnu.org> + + * cus-edit.el (Custom-set, Custom-save): Ask for confirmation. + (Custom-reset-current, Custom-reset-saved): Likewise. + (Custom-reset-standard): Show message if aborted. + (custom-mode): Doc fix, describing those commands. + + * mouse.el (mouse-drag-region-1): When following link via mouse-2, + put on event-kind property. + +2005-12-31 Chong Yidong <cyd@stupidchicken.com> + + * custom.el (provide-theme): Ban `user' theme name. + (custom-enabling-themes): New variable. + (enable-theme): Don't enable user if custom-enabling-themes is t. + (custom-enabled-themes): Make it a defcustom. + (custom-theme-recalc-face): No-op if face is undefined. + + * cus-edit.el (custom-button-mouse): New variable. + (custom-button-mouse): New face. + (custom-raised-buttons, custom-mode): Use it. + + * cus-theme.el (custom-new-theme-mode): Use custom-button-mouse. + +2005-12-31 Eli Zaretskii <eliz@gnu.org> + + * progmodes/gud.el (gud-display-line): Support hl-line in the + source buffer. + +2005-12-31 Lennart Borgman <lennart.borgman.073@student.lu.se> (tiny change) + + * mouse.el (mouse-drag-window-above): Verify that the found window + overlaps with the given window in the horizontal dimension. + +2005-12-31 Eli Zaretskii <eliz@gnu.org> + + * Makefile.in (cvs-update): New target. + + * makefile.w32-in (cvs-update): Ditto. + +2005-12-30 Chong Yidong <cyd@stupidchicken.com> + + * cus-theme.el (custom-new-theme-mode): Use cus-edit faces. + (custom-new-theme-mode-map): New variable. + +2005-12-30 Richard M. Stallman <rms@gnu.org> + + * custom.el (custom-load-themes): Function deleted. + + * cus-edit.el (custom-save-loaded-themes): Function deleted. + (custom-save-variables): Don't delete or add custom-load-themes call. + +2005-12-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * cus-start.el: Add `visible-cursor'. + + * progmodes/flymake.el (flymake-copy-buffer-to-temp-buffer): Simplify. + (flymake-parse-output-and-residual): Remove `source-buffer' argument. + (flymake-process-filter): Switch to buffer before calling it instead. + (flymake-post-syntax-check, flymake-highlight-err-lines) + (flymake-delete-own-overlays, flymake-parse-err-lines) + (flymake-start-syntax-check, flymake-start-syntax-check-process) + (flymake-count-lines, flymake-parse-residual): + Remove constant buffer argument. + (flymake-start-syntax-check-for-current-buffer): Remove. + Update callers to use flymake-start-syntax-check instead. + (flymake-display-err-menu-for-current-line): + Remove unused var `mouse-pos'. + (flymake-restore-formatting): Comment out unused function. + (flymake-report-status, flymake-report-fatal-status): Remove buffer + argument, use current-buffer instead. Update callers. + +2005-12-30 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-mode): Make completion-ignore-case + buffer-local because choose-completion-delete-max-match requires + that we set completion-ignore-case (i.e., binding via let is not + sufficient). + (bibtex-complete): Always set completion-ignore-case and + choose-completion-string-functions. The latter is needed because + choose-completion-string-functions keeps its value if we quit the + *Completions* buffer without requesting a completion. + +2005-12-30 Andreas Schwab <schwab@suse.de> + + * progmodes/cc-defs.el: Ignore errors from font-lock-compile-keywords. + +2005-12-30 Eli Zaretskii <eliz@gnu.org> + + * jit-lock.el (jit-lock-chunk-size): Doc fix. + +2005-12-30 Juri Linkov <juri@jurta.org> + + * locate.el (locate-fcodes-file, locate-header-face) + * progmodes/delphi.el (delphi-other-face) + * progmodes/glasses.el (glasses-face): Add tag "None" to const nil. + + * paren.el (show-paren-match, show-paren-mismatch): Use existing + group `paren-showing-faces'. + + * net/goto-addr.el (goto-address-highlight-keymap): Fix docstring. + (goto-address): Fix docstring. + + * net/webjump.el (webjump-sample-sites): Update URLs. + + * textmodes/fill.el (fill-single-word-nobreak-p): Use `sentence-end'. + + * subr.el (cancel-change-group): Add listp around pending-undo-list. + +2005-12-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock-compile-keywords): Signal an error when + font-lock-set-defaults hasn't been called. + +2005-12-29 Luc Teirlinck <teirllm@auburn.edu> + + * subr.el (noreturn, 1value): Doc fixes. + +2005-12-29 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-text-in-field-bounds): Handle case + that assoc-string returns nil. + +2005-12-29 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-entry-type-whitespace) + (bibtex-entry-type-str, bibtex-empty-field-re) + (bibtex-search-backward-string, bibtex-preamble-prefix) + (bibtex-search-entry, bibtex-enclosing-entry-maybe-empty-head): Remove. + (bibtex-any-valid-entry-type): New variable. + (bibtex-parse-field-name): Simplify. + (bibtex-parse-string, bibtex-search-forward-string): New arg empty-key. + (bibtex-preamble-prefix): Include left delimiter. + (bibtex-search-forward-field, bibtex-search-backward-field): + Allow unbounded search past entry boundaries (required by bibtex-pop). + (bibtex-text-in-field-bounds): Use push. + (bibtex-text-in-field): Do not use bibtex-narrow-to-entry. + (bibtex-parse-preamble, bibtex-valid-entry) + (bibtex-beginning-first-field): New functions. + (bibtex-skip-to-valid-entry): Use bibtex-valid-entry. Fix regexp. + (bibtex-map-entries): Fix docstring. + (bibtex-flash-head): New arg prompt. Simplify. + (bibtex-enclosing-field): Include code of bibtex-inside-field. + (bibtex-insert-kill): Simplify. Always insert text past the + current field or entry. + (bibtex-format-entry): Use bibtex-parse-field. + (bibtex-pop): Use bibtex-beginning-of-entry and + bibtex-end-of-entry to initiate the search. Insert empty field if + we found ourselves. + (bibtex-print-help-message): New args field and comma. + Handle entry keys. + (bibtex-make-field): Use bibtex-beginning-of-entry. + (bibtex-end-of-entry): Use bibtex-valid-entry. Recognize any + invalid entry. + (bibtex-validate): Use bibtex-valid-entry and bibtex-parse-string. + Handle preambles. Simplify code for thorough test. + (bibtex-next-field, bibtex-find-text, bibtex-find-text-internal): + New arg comma. Handle entry heads. + (bibtex-remove-OPT-or-ALT, bibtex-remove-delimiters) + (bibtex-kill-field, bibtex-copy-field-as-kil, bibtex-empty-field): + New arg comma. + (bibtex-kill-entry): Use bibtex-any-entry-maybe-empty-head. + (bibtex-fill-field): Simplify. + (bibtex-fill-entry): Use bibtex-beginning-first-field and + bibtex-parse-field. + (bibtex-convert-alien): Do not wait before calling bibtex-validate. + (bibtex-complete): Use bibtex-parse-preamble. + 2005-12-29 Nick Roberts <nickrob@snap.net.nz> * progmodes/gdb-ui.el (gdb-tooltip-print, gdb-tooltip-print-1): @@ -11,8 +179,7 @@ 2005-12-28 Bill Wohler <wohler@newt.com> - * simple.el (mh-e-user-agent): Move to mh-e/mh-comp.el and - autoload. + * simple.el (mh-e-user-agent): Move to mh-e/mh-comp.el and autoload. 2005-12-28 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index eaac8d08324..9a4497679ef 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -119,6 +119,9 @@ update-subdirs: doit updates: update-subdirs autoloads mh-autoloads finder-data custom-deps +# This is useful after "cvs up". +cvs-update: recompile autoloads finder-data custom-deps + # Update the AUTHORS file. update-authors: diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 54d0fa23e52..4c92034eaad 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -746,22 +746,26 @@ groups after non-groups, if nil do not order groups at all." (defun Custom-set () "Set changes in all modified options." (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children))) + (if (y-or-n-p "Set all values according to this buffer? ") + (let ((children custom-options)) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) + children)) + (message "Aborted"))) (defun Custom-save () "Set all modified group members and save them." (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set changed rogue)) - (widget-apply child :custom-save))) - children)) - (custom-save-all)) + (if (yes-or-no-p "Save all settings in this buffer? ") + (let ((children custom-options)) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set changed rogue)) + (widget-apply child :custom-save))) + children) + (custom-save-all)) + (message "Aborted"))) (defvar custom-reset-menu '(("Current" . Custom-reset-current) @@ -784,22 +788,26 @@ when the action is chosen.") (defun Custom-reset-current (&rest ignore) "Reset all modified group members to their current value." (interactive) - (let ((children custom-options)) - (mapc (lambda (widget) - (if (memq (widget-get widget :custom-state) - '(modified changed)) - (widget-apply widget :custom-reset-current))) - children))) + (if (y-or-n-p "Update buffer text to show all current settings? ") + (let ((children custom-options)) + (mapc (lambda (widget) + (if (memq (widget-get widget :custom-state) + '(modified changed)) + (widget-apply widget :custom-reset-current))) + children)) + (message "Aborted"))) (defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) - (let ((children custom-options)) - (mapc (lambda (widget) - (if (memq (widget-get widget :custom-state) - '(modified set changed rogue)) - (widget-apply widget :custom-reset-saved))) - children))) + (if (y-or-n-p "Update buffer text to show all saved settings? ") + (let ((children custom-options)) + (mapc (lambda (widget) + (if (memq (widget-get widget :custom-state) + '(modified set changed rogue)) + (widget-apply widget :custom-reset-saved))) + children)) + (message "Aborted"))) (defun Custom-reset-standard (&rest ignore) "Erase all customization (either current or saved) for the group members. @@ -808,18 +816,19 @@ This operation eliminates any saved values for the group members, making them as if they had never been customized at all." (interactive) (let ((children custom-options)) - (when (or (and (= 1 (length children)) - (memq (widget-type (car children)) - '(custom-variable custom-face))) - (yes-or-no-p "Really erase all customizations in this buffer? ")) - (mapc (lambda (widget) - (and (if (widget-get widget :custom-standard-value) - (widget-apply widget :custom-standard-value) - t) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)) - (widget-apply widget :custom-reset-standard))) - children)))) + (if (or (and (= 1 (length children)) + (memq (widget-type (car children)) + '(custom-variable custom-face))) + (yes-or-no-p "Really erase all customizations in this buffer? ")) + (mapc (lambda (widget) + (and (if (widget-get widget :custom-standard-value) + (widget-apply widget :custom-standard-value) + t) + (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)) + (widget-apply widget :custom-reset-standard))) + children) + (message "Aborted")))) ;;; The Customize Commands @@ -1405,6 +1414,9 @@ This button will have a menu with all three reset operations." (defvar custom-button nil "Face used for buttons in customization buffers.") +(defvar custom-button-mouse nil + "Mouse face used for buttons in customization buffers.") + (defvar custom-button-pressed nil "Face used for pressed buttons in customization buffers.") @@ -1419,6 +1431,8 @@ Otherwise use brackets." (custom-set-default variable value) (setq custom-button (if value 'custom-button 'custom-button-unraised)) + (setq custom-button-mouse + (if value 'custom-button-mouse 'highlight)) (setq custom-button-pressed (if value 'custom-button-pressed @@ -1960,6 +1974,16 @@ and `face'." ;; backward-compatibility alias (put 'custom-button-face 'face-alias 'custom-button) +(defface custom-button-mouse + '((((type x w32 mac) (class color)) + (:box (:line-width 2 :style released-button) + :background "grey90" :foreground "black")) + (t + nil)) + "Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil." + :version "22.1" + :group 'custom-faces) + (defface custom-button-unraised '((((min-colors 88) (class color) (background light)) :foreground "blue1" :underline t) @@ -1975,6 +1999,9 @@ and `face'." (setq custom-button (if custom-raised-buttons 'custom-button 'custom-button-unraised)) +(setq custom-button-mouse + (if custom-raised-buttons 'custom-button-mouse 'highlight)) + (defface custom-button-pressed '((((type x w32 mac) (class color)) (:box (:line-width 2 :style pressed-button) @@ -4024,6 +4051,33 @@ if only the first line of the docstring is shown.")) (save-buffer)) (unless old-buffer (kill-buffer (current-buffer)))))) + +;;;###autoload +(defun customize-save-customized () + "Save all user options which have been set in this session." + (interactive) + (mapatoms (lambda (symbol) + (let ((face (get symbol 'customized-face)) + (value (get symbol 'customized-value)) + (face-comment (get symbol 'customized-face-comment)) + (variable-comment + (get symbol 'customized-variable-comment))) + (when face + (put symbol 'saved-face face) + (custom-push-theme 'theme-face symbol 'user 'set value) + (put symbol 'customized-face nil)) + (when value + (put symbol 'saved-value value) + (custom-push-theme 'theme-value symbol 'user 'set value) + (put symbol 'customized-value nil)) + (when variable-comment + (put symbol 'saved-variable-comment variable-comment) + (put symbol 'customized-variable-comment nil)) + (when face-comment + (put symbol 'saved-face-comment face-comment) + (put symbol 'customized-face-comment nil))))) + ;; We really should update all custom buffers here. + (custom-save-all)) ;; Editing the custom file contents in a buffer. @@ -4069,10 +4123,8 @@ This function does not save the buffer." (defun custom-save-variables () "Save all customized variables in `custom-file'." (save-excursion - (custom-save-delete 'custom-load-themes) (custom-save-delete 'custom-reset-variables) (custom-save-delete 'custom-set-variables) - (custom-save-loaded-themes) (custom-save-resets 'theme-value 'custom-reset-variables nil) (let ((standard-output (current-buffer)) (saved-list (make-list 1 0)) @@ -4131,6 +4183,33 @@ This function does not save the buffer." (unless (looking-at "\n") (princ "\n"))))) +(defun custom-save-resets (property setter special) + (let (started-writing ignored-special) + ;; (custom-save-delete setter) Done by caller + (let ((standard-output (current-buffer)) + (mapper `(lambda (object) + (let ((spec (car-safe (get object (quote ,property))))) + (when (and (not (memq object ignored-special)) + (eq (nth 0 spec) 'user) + (eq (nth 1 spec) 'reset)) + ;; Do not write reset statements unless necessary. + (unless started-writing + (setq started-writing t) + (unless (bolp) + (princ "\n")) + (princ "(") + (princ (quote ,setter)) + (princ "\n '(") + (prin1 object) + (princ " ") + (prin1 (nth 3 spec)) + (princ ")"))))))) + (mapc mapper special) + (setq ignored-special special) + (mapatoms mapper) + (when started-writing + (princ ")\n"))))) + (defun custom-save-faces () "Save all customized faces in `custom-file'." (save-excursion @@ -4187,71 +4266,6 @@ This function does not save the buffer." (princ ")") (unless (looking-at "\n") (princ "\n"))))) - -(defun custom-save-resets (property setter special) - (let (started-writing ignored-special) - ;; (custom-save-delete setter) Done by caller - (let ((standard-output (current-buffer)) - (mapper `(lambda (object) - (let ((spec (car-safe (get object (quote ,property))))) - (when (and (not (memq object ignored-special)) - (eq (nth 0 spec) 'user) - (eq (nth 1 spec) 'reset)) - ;; Do not write reset statements unless necessary. - (unless started-writing - (setq started-writing t) - (unless (bolp) - (princ "\n")) - (princ "(") - (princ (quote ,setter)) - (princ "\n '(") - (prin1 object) - (princ " ") - (prin1 (nth 3 spec)) - (princ ")"))))))) - (mapc mapper special) - (setq ignored-special special) - (mapatoms mapper) - (when started-writing - (princ ")\n"))))) - -(defun custom-save-loaded-themes () - (let ((themes (reverse (get 'user 'theme-loads-themes))) - (standard-output (current-buffer))) - (when themes - (unless (bolp) (princ "\n")) - (princ "(custom-load-themes") - (mapc (lambda (theme) - (princ "\n '") - (prin1 theme)) themes) - (princ " )\n")))) - -;;;###autoload -(defun customize-save-customized () - "Save all user options which have been set in this session." - (interactive) - (mapatoms (lambda (symbol) - (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value)) - (face-comment (get symbol 'customized-face-comment)) - (variable-comment - (get symbol 'customized-variable-comment))) - (when face - (put symbol 'saved-face face) - (custom-push-theme 'theme-face symbol 'user 'set value) - (put symbol 'customized-face nil)) - (when value - (put symbol 'saved-value value) - (custom-push-theme 'theme-value symbol 'user 'set value) - (put symbol 'customized-value nil)) - (when variable-comment - (put symbol 'saved-variable-comment variable-comment) - (put symbol 'customized-variable-comment nil)) - (when face-comment - (put symbol 'saved-face-comment face-comment) - (put symbol 'customized-face-comment nil))))) - ;; We really should update all custom buffers here. - (custom-save-all)) ;;; The Customize Menu. @@ -4400,11 +4414,12 @@ Complete content of editable text field. \\[widget-complete] \\<custom-mode-map>\ Invoke button under the mouse pointer. \\[Custom-move-and-invoke] Invoke button under point. \\[widget-button-press] -Set all modifications. \\[Custom-set] -Make all modifications default. \\[Custom-save] -Reset all modified options. \\[Custom-reset-current] -Reset all modified or set options. \\[Custom-reset-saved] -Reset all options. \\[Custom-reset-standard] +Set all options from current text. \\[Custom-set] +Make values in current text permanent. \\[Custom-save] +Make text match actual option values. \\[Custom-reset-current] +Reset options to permanent settings. \\[Custom-reset-saved] +Erase customizations; set options + and buffer text to the standard values. \\[Custom-reset-standard] Entry to this mode calls the value of `custom-mode-hook' if that value is non-nil." @@ -4420,8 +4435,7 @@ if that value is non-nil." (make-local-variable 'widget-button-face) (setq widget-button-face custom-button) (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed) - (if custom-raised-buttons - (set (make-local-variable 'widget-mouse-face) custom-button)) + (set (make-local-variable 'widget-mouse-face) custom-button-mouse) ;; When possible, use relief for buttons, not bracketing. This test ;; may not be optimal. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a851d32d296..30af30045f8 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -274,6 +274,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (words-include-escapes editing-basics boolean) (open-paren-in-column-0-is-defun-start editing-basics boolean "21.1") + ;; term.c + (visible-cursor cursor boolean "22.1") ;; undo.c (undo-limit undo integer) (undo-strong-limit undo integer) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 43cf96e34fa..d7102fc11f7 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -31,11 +31,31 @@ (eval-when-compile (require 'wid-edit)) +(defvar custom-new-theme-mode-map + (let ((map (make-keymap))) + (set-keymap-parent map widget-keymap) + (suppress-keymap map) + (define-key map "n" 'widget-forward) + (define-key map "p" 'widget-backward) + (define-key map [mouse-1] 'widget-move-and-invoke) + map) + "Keymap for `custom-new-theme-mode'.") + (define-derived-mode custom-new-theme-mode nil "New-Theme" "Major mode for the buffer created by `customize-create-theme'. Do not call this mode function yourself. It is only meant for internal use by `customize-create-theme'." - (set-keymap-parent custom-new-theme-mode-map widget-keymap)) + (use-local-map custom-new-theme-mode-map) + (define-key custom-new-theme-mode-map [mouse-1] 'widget-move-and-invoke) + (set (make-local-variable 'widget-documentation-face) 'custom-documentation) + (set (make-local-variable 'widget-button-face) custom-button) + (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed) + (set (make-local-variable 'widget-mouse-face) custom-button-mouse) + (when custom-raised-buttons + (set (make-local-variable 'widget-push-button-prefix) "") + (set (make-local-variable 'widget-push-button-suffix) "") + (set (make-local-variable 'widget-link-prefix) "") + (set (make-local-variable 'widget-link-suffix) ""))) (put 'custom-new-theme-mode 'mode-class 'special) (defvar custom-theme-name) diff --git a/lisp/custom.el b/lisp/custom.el index df2488bda40..18d79a6af23 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -648,8 +648,7 @@ The user has not customized the variable; had he done that, the list would contain an entry for the `user' theme, too. See `custom-known-themes' for a list of known themes." - (unless (or (eq prop 'theme-value) - (eq prop 'theme-face)) + (unless (memq prop '(theme-value theme-face)) (error "Unknown theme property")) (let* ((old (get symbol prop)) (setting (assq theme old)) @@ -1048,21 +1047,15 @@ into this directory." "Return non-nil if THEME has been loaded." (memq theme custom-loaded-themes)) -(defvar custom-enabled-themes '(user) - "Custom themes currently enabled, highest precedence first. -The first one is always `user'.") - -(defun custom-theme-enabled-p (theme) - "Return non-nil if THEME is enabled." - (memq theme custom-enabled-themes)) - (defun provide-theme (theme) - "Indicate that this file provides THEME. -Add THEME to `custom-loaded-themes', and `provide' whatever -feature name is stored in THEME's property `theme-feature'. + "Indicate that this file provides THEME, and mark it as enabled. +Add THEME to `custom-loaded-themes' and `custom-enabled-themes', +and `provide' the feature name stored in THEME's property `theme-feature'. Usually the `theme-feature' property contains a symbol created by `custom-make-theme-feature'." + (if (eq theme 'user) + (error "Custom theme cannot be named `user'")) (custom-check-theme theme) (provide (get theme 'theme-feature)) (push theme custom-loaded-themes) @@ -1120,15 +1113,11 @@ All the themes loaded for BY-THEME are recorded in BY-THEME's property (load-theme theme))) (push theme themes-loaded)) (put by-theme 'theme-loads-themes themes-loaded))) - -(defun custom-load-themes (&rest body) - "Load themes for the USER theme as specified by BODY. - -See `custom-theme-load-themes' for more information on BODY." - (apply 'custom-theme-load-themes 'user body)) ;;; Enabling and disabling loaded themes. +(defvar custom-enabling-themes nil) + (defun enable-theme (theme) "Reenable all variable and face settings defined by THEME. The newly enabled theme gets the highest precedence (after `user'). @@ -1137,9 +1126,9 @@ If it is already enabled, just give it highest precedence (after `user'). This signals an error if THEME does not specify any theme settings. Theme settings are set using `load-theme'." (interactive "SEnable Custom theme: ") + (unless (or (eq theme 'user) (memq theme custom-loaded-themes)) + (error "Theme %s not defined" (symbol-name theme))) (let ((settings (get theme 'theme-settings))) - (if (and (not (eq theme 'user)) (null settings)) - (error "No theme settings defined in %s." (symbol-name theme))) (dolist (s settings) (let* ((prop (car s)) (symbol (cadr s)) @@ -1147,29 +1136,58 @@ settings. Theme settings are set using `load-theme'." (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) (if (eq prop 'theme-value) (custom-theme-recalc-variable symbol) - (if (facep symbol) - (custom-theme-recalc-face symbol)))))) - (setq custom-enabled-themes - (cons theme (delq theme custom-enabled-themes))) - ;; `user' must always be the highest-precedence enabled theme. + (custom-theme-recalc-face symbol))))) (unless (eq theme 'user) - (enable-theme 'user))) + (setq custom-enabled-themes + (cons theme (delq theme custom-enabled-themes))) + (unless custom-enabling-themes + (enable-theme 'user)))) + +(defcustom custom-enabled-themes nil + "List of enabled Custom Themes, highest precedence first. + +This does not include the `user' theme, which is set by Customize, +and always takes precedence over other Custom Themes." + :group 'customize + :type '(repeat symbol) + :set (lambda (symbol themes) + ;; Avoid an infinite loop when custom-enabled-themes is + ;; defined in a theme (e.g. `user'). Enabling the theme sets + ;; custom-enabled-themes, which enables the theme... + (unless custom-enabling-themes + (let ((custom-enabling-themes t)) + (setq themes (delq 'user (delete-dups themes))) + (if (boundp symbol) + (dolist (theme (symbol-value symbol)) + (if (not (memq theme themes)) + (disable-theme theme)))) + (dolist (theme (reverse themes)) + (if (or (custom-theme-loaded-p theme) (eq theme 'user)) + (enable-theme theme) + (load-theme theme))) + (enable-theme 'user) + (custom-set-default symbol themes))))) + +(defun custom-theme-enabled-p (theme) + "Return non-nil if THEME is enabled." + (memq theme custom-enabled-themes)) (defun disable-theme (theme) "Disable all variable and face settings defined by THEME. -See `custom-known-themes' for a list of known themes." +See `custom-enabled-themes' for a list of enabled themes." (interactive "SDisable Custom theme: ") - (let ((settings (get theme 'theme-settings))) - (dolist (s settings) - (let* ((prop (car s)) - (symbol (cadr s)) - (spec-list (get symbol prop))) - (put symbol prop (assq-delete-all theme spec-list)) - (if (eq prop 'theme-value) - (custom-theme-recalc-variable symbol) - (custom-theme-recalc-face symbol))))) - (setq custom-enabled-themes - (delq theme custom-enabled-themes))) + (when (memq theme custom-enabled-themes) + (let ((settings (get theme 'theme-settings))) + (dolist (s settings) + (let* ((prop (car s)) + (symbol (cadr s)) + (spec-list (get symbol prop))) + (put symbol prop (assq-delete-all theme spec-list)) + (if (eq prop 'theme-value) + (custom-theme-recalc-variable symbol) + (custom-theme-recalc-face symbol))))) + (setq custom-enabled-themes + (delq theme custom-enabled-themes)))) (defun custom-theme-value (theme setting-list) "Determine the value specified for THEME according to SETTING-LIST. @@ -1217,9 +1235,10 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (defun custom-theme-recalc-face (face) "Set FACE according to currently enabled custom themes." - (let ((theme-faces (reverse (get face 'theme-face)))) - (dolist (spec theme-faces) - (face-spec-set face (car (cddr spec)))))) + (if (facep face) + (let ((theme-faces (reverse (get face 'theme-face)))) + (dolist (spec theme-faces) + (face-spec-set face (car (cddr spec))))))) (defun custom-theme-reset-variables (theme &rest args) "Reset the specs in THEME of some variables to their values in other themes. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index de366997a93..7819a0e81cc 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1507,6 +1507,13 @@ Here each COMPILED is of the form (MATCHER HIGHLIGHT ...) as shown in the `font-lock-keywords' doc string. If REGEXP is non-nil, it means these keywords are used for `font-lock-keywords' rather than for `font-lock-syntactic-keywords'." + (if (not font-lock-set-defaults) + ;; This should never happen. But some external packages sometimes + ;; call font-lock in unexpected and incorrect ways. It's important to + ;; stop processing at this point, otherwise we may end up changing the + ;; global value of font-lock-keywords and break highlighting in many + ;; other buffers. + (error "Font-lock trying to use keywords before setting them up")) (if (eq (car-safe keywords) t) keywords (setq keywords diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index eb5ace956eb..16db1e25a9a 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -65,7 +65,9 @@ Preserves the `buffer-modified-p' state of the current buffer." :group 'font-lock) (defcustom jit-lock-chunk-size 500 - "*Jit-lock chunks of this many characters, or smaller." + "*Jit-lock fontifies chunks of at most this many characters at a time. + +This variable controls both display-time and stealth fontification." :type 'integer :group 'jit-lock) diff --git a/lisp/locate.el b/lisp/locate.el index 563300f6c03..9676c84f80c 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -144,12 +144,12 @@ (defcustom locate-fcodes-file nil "*File name for the database of file names." - :type '(choice file (const nil)) + :type '(choice (const :tag "None" nil) file) :group 'locate) (defcustom locate-header-face nil "*Face used to highlight the locate header." - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :group 'locate) ;;;###autoload diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 24acf0009c4..f9c33dbed79 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -183,6 +183,9 @@ update-subdirs-SH: doit updates: update-subdirs autoloads mh-autoloads finder-data custom-deps +# This is useful after "cvs up". +cvs-update: recompile autoloads finder-data custom-deps + # Update the AUTHORS file. update-authors: diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 74fd15a2c19..4f3d56f98c9 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,66 @@ +2006-01-01 Bill Wohler <wohler@newt.com> + + * mh-customize.el: Sync docstrings with manual for faces and sort + them alphabetically. + (mh-faces): Move below mh-hooks. + (mh-folder-faces, mh-index-faces, mh-letter-faces) + (mh-show-faces, mh-speed-faces): Delete. Organize faces like + hooks. + (mh-speed-update-interval): Fix group (mh-speedbar, not mh-speed). + (facemenu-unlisted-faces): Might as well ignore all MH-E faces. + (mh-folder-body-face, mh-folder-cur-msg-face) + (mh-folder-cur-msg-number-face, mh-folder-date-face) + (mh-folder-followup-face, mh-folder-msg-number-face) + (mh-folder-deleted-face, mh-folder-refiled-face) + (mh-folder-subject-face, mh-folder-address-face) + (mh-folder-scan-format-face, mh-folder-to-face) + (mh-index-folder-face, mh-show-cc-face, mh-show-date-face) + (mh-show-header-face, mh-show-pgg-good-face) + (mh-show-pgg-unknown-face, mh-show-pgg-bad-face) + (mh-show-to-face, mh-show-from-face, mh-show-subject-face): + Delete. + (mh-folder-cur-msg): Unused. Delete. + (mh-folder-address): Use defface; inherit from mh-folder-subject. + (mh-folder-body, mh-folder-cur-msg-number, mh-folder-date): + Inherit from mh-folder-msg-number. + (mh-folder-deleted): Use defface. Inherit from + mh-folder-msg-number. + (mh-folder-sent-to-me-hint): New face. Inherit from + mh-folder-date. + (mh-folder-sent-to-me-sender): Rename from mh-folder-scan-format. + Use defface. Inherit from mh-folder-followup. + (mh-show-xface): Inherit from mh-show-from and highlight. + (bw-face-generation, bw-toggle-faces) + (bw-new-face-to-old, bw-old-face-to-new): New (tempoarary) + variables, functions for toggling between old and new faces. + + * mh-e.el (font-lock-auto-fontify, font-lock-defaults): Hide in + eval-when-compile. We should probably do this throughout. + (mh-scan-good-msg-regexp, mh-scan-deleted-msg-regexp) + (mh-scan-refiled-msg-regexp, mh-scan-cur-msg-number-regexp) + (mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp) + (mh-scan-subject-regexp): Sync docstrings with manual + (mh-scan-format-regexp): Rename to + mh-scan-sent-to-me-sender-regexp. Drop date parenthesized + expression. Make expression more like the others (anchored at the + beginning of line). Sync docstrings with manual. + (mh-folder-font-lock-keywords): Use faces directly rather than + -face variables. Use mh-scan-sent-to-me-sender-regexp instead of + mh-scan-format-regexp, and within that expression, use faces + mh-folder-sent-to-me-hint and mh-folder-sent-to-me-sender instead + of mh-folder-date-face and mh-folder-scan-format-face which were + misleading. + + * mh-mime.el (mh-mime-security-button-face): Use faces directly + rather than -face variables. + + * mh-utils.el (mh-show-font-lock-keywords): Use faces directly + rather than -face variables. + (mh-face-foreground-compat, mh-face-background-compat): New macros. + (mh-face-display-function): Use mh-face-foreground-compat and + mh-face-background-compat to use inherited attributes of + mh-show-xface on Emacs 22 while still working on Emacs 21. + 2005-12-28 Bill Wohler <wohler@newt.com> * mh-comp.el (mh-e-user-agent): Move here from simple.el. Use diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el index f5556bda2ba..edd6ee41b01 100644 --- a/lisp/mh-e/mh-customize.el +++ b/lisp/mh-e/mh-customize.el @@ -204,57 +204,18 @@ and GNU mailutils." :prefix "mh-" :group 'mh-e) -(defgroup mh-faces nil - "Faces used in MH-E." - :link '(custom-manual "(mh-e)Top") - :prefix "mh-" - :group 'faces - :group 'mh-e) - (defgroup mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e) - - -;;; Faces - -(defgroup mh-folder-faces nil - "Faces used in scan listing." - :link '(custom-manual "(mh-e)Folders") - :prefix "mh-" - :group 'mh-faces - :group 'mh-folder) - -(defgroup mh-index-faces nil - "Faces used in searching." - :link '(custom-manual "(mh-e)Searching") - :prefix "mh-" - :group 'mh-faces - :group 'mh-index) - -(defgroup mh-letter-faces nil - "Faces used in message drafts." - :link '(custom-manual "(mh-e)Editing Drafts") - :prefix "mh-" - :group 'mh-faces - :group 'mh-letter) - -(defgroup mh-show-faces nil - "Faces used in message display." - :link '(custom-manual "(mh-e)Reading Mail") - :prefix "mh-" - :group 'mh-faces - :group 'mh-show) - -(defgroup mh-speed-faces nil - "Faces used in speedbar." - :link '(custom-manual "(mh-e)Speedbar") +(defgroup mh-faces nil + "Faces used in MH-E." + :link '(custom-manual "(mh-e)Top") :prefix "mh-" - :group 'mh-faces - :group 'mh-speed) + :group 'faces + :group 'mh-e) @@ -1883,13 +1844,13 @@ lines you'd like to see." -;;; The Speedbar (:group 'mh-speed) +;;; The Speedbar (:group 'mh-speedbar) (defcustom mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer - :group 'mh-speed) + :group 'mh-speedbar) @@ -2526,81 +2487,42 @@ sequence." -;;; Faces (:group 'mh-*-faces + group where faces described) +;;; Faces (:group 'mh-faces + group where faces described) - +(if (boundp 'facemenu-unlisted-faces) + (add-to-list 'facemenu-unlisted-faces "^mh-")) -;;; Faces Used in Scan Listing (:group 'mh-folder-faces) +(defface mh-folder-address '((t (:inherit mh-folder-subject))) + "Recipient face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-body-face 'mh-folder-body - "Face used to highlight body text in MH-Folder buffers.") (defface mh-folder-body - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:foreground "RosyBrown")) - (((class color) (min-colors 88) (background dark)) - (:foreground "LightSalmon")) - (((class color)) - (:foreground "green")) - (((class grayscale) (background light)) - (:foreground "DimGray" :italic t)) - (((class grayscale) (background dark)) - (:foreground "LightGray" :italic t)) - (t - (:italic t)))) - "Face used to highlight body text in MH-Folder buffers." - :group 'mh-folder-faces) - -(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg - "Face used for the current message line in MH-Folder buffers.") -(defface mh-folder-cur-msg - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:background "LightGreen") ;Use this for solid background colour - ;; (:underline t) ;Use this for underlining - ) - (((class color) (min-colors 88) (background dark)) - (:background "DarkOliveGreen4")) - (((class color)) - (:background "LightGreen")) - (t - (:underline t)))) - "Face used for the current message line in MH-Folder buffers." - :group 'mh-folder-faces) + '((((class color)) + (:inherit mh-folder-msg-number)) + (t + (:inherit mh-folder-msg-number :italic t))) + "Body text face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number - "Face used to highlight the current message in MH-Folder buffers.") (defface mh-folder-cur-msg-number - (mh-defface-compat - '((((class color) (min-colors 88) (background light)) - (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) - (:foreground "Cyan")) - (((class color)) - (:foreground "cyan" :weight bold)) - (((class grayscale) (background light)) - (:foreground "LightGray" :bold t)) - (((class grayscale) (background dark)) - (:foreground "DimGray" :bold t)) - (t - (:bold t)))) - "Face used to highlight the current message in MH-Folder buffers." - :group 'mh-folder-faces) + '((t + (:inherit mh-folder-msg-number :bold t))) + "Current message number face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-date-face 'mh-folder-date - "Face used to highlight the date in MH-Folder buffers.") -(defface mh-folder-date - '((((class color) (background light)) - (:foreground "snow4")) - (((class color) (background dark)) - (:foreground "snow3")) - (t - (:bold t))) - "Face used to highlight the date in MH-Folder buffers." - :group 'mh-folder-faces) +(defface mh-folder-date '((t (:inherit mh-folder-msg-number))) + "Date face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-deleted '((t (:inherit mh-folder-msg-number))) + "Deleted message face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-followup-face 'mh-folder-followup - "Face used to highlight Re: subject text in MH-Folder buffers.") (defface mh-folder-followup '((((class color) (background light)) (:foreground "blue3")) @@ -2608,27 +2530,19 @@ sequence." (:foreground "LightGoldenRod")) (t (:bold t))) - "Face used to highlight Re: subject text in MH-Folder buffers." - :group 'mh-folder-faces) + "\"Re:\" face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-msg-number-face 'mh-folder-msg-number - "Face used to highlight the message number in MH-Folder buffers.") (defface mh-folder-msg-number '((((class color) (background light)) (:foreground "snow4")) (((class color) (background dark)) - (:foreground "snow3")) - (t - (:bold t))) - "Face used to highlight the message number in MH-Folder buffers." - :group 'mh-folder-faces) - -(defvar mh-folder-deleted-face 'mh-folder-deleted - "Face used to highlight deleted messages in MH-Folder buffers.") -(copy-face 'mh-folder-msg-number 'mh-folder-deleted) + (:foreground "snow3"))) + "Message number face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-refiled-face 'mh-folder-refiled - "Face used to highlight refiled messages in MH-Folder buffers.") (defface mh-folder-refiled (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2643,13 +2557,26 @@ sequence." (:foreground "DimGray" :bold t :italic t)) (t (:bold t :italic t)))) - "Face used to highlight refiled messages in MH-Folder buffers." - :group 'mh-folder-faces) + "Refiled message face." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-hint '((t (:inherit mh-folder-date))) + "Fontification hint face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) + +(defface mh-folder-sent-to-me-sender '((t (:inherit mh-folder-followup))) + "Sender face in messages sent directly to us. +The detection of messages sent to us is governed by the scan +format `mh-scan-format-nmh' and the regular expression +`mh-scan-sent-to-me-sender-regexp'." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-subject-face 'mh-folder-subject - "Face used to highlight subject text in MH-Folder buffers.") -(if (boundp 'facemenu-unlisted-faces) - (add-to-list 'facemenu-unlisted-faces "^mh-folder")) (defface mh-folder-subject '((((class color) (background light)) (:foreground "blue4")) @@ -2657,8 +2584,9 @@ sequence." (:foreground "yellow")) (t (:bold t))) - "Face used to highlight subject text in MH-Folder buffers." - :group 'mh-folder-faces) + "Subject face." + :group 'mh-faces + :group 'mh-folder) (defface mh-folder-tick '((((class color) (background dark)) @@ -2667,19 +2595,10 @@ sequence." (:background "#dddf7e")) (t (:underline t))) - "Face used to show ticked messages." - :group 'mh-folder-faces) - -(defvar mh-folder-address-face 'mh-folder-address - "Face used to highlight the address in MH-Folder buffers.") -(copy-face 'mh-folder-subject 'mh-folder-address) - -(defvar mh-folder-scan-format-face 'mh-folder-scan-format - "Face used to highlight `mh-scan-format-regexp' matches in MH-Folder buffers.") -(copy-face 'mh-folder-followup 'mh-folder-scan-format) + "Ticked message face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-folder-to-face 'mh-folder-to - "Face used to highlight the To: string in MH-Folder buffers.") (defface mh-folder-to (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2694,15 +2613,10 @@ sequence." (:foreground "LightGray" :italic t)) (t (:italic t)))) - "Face used to highlight the To: string in MH-Folder buffers." - :group 'mh-folder-faces) - - - -;;; Faces Used in Searching (:group 'mh-index-faces) + "\"To:\" face." + :group 'mh-faces + :group 'mh-folder) -(defvar mh-index-folder-face 'mh-index-folder - "Face used to highlight folders in MH-Index buffers.") (defface mh-index-folder '((((class color) (background light)) (:foreground "dark green" :bold t)) @@ -2710,12 +2624,9 @@ sequence." (:foreground "indian red" :bold t)) (t (:bold t))) - "Face used to highlight folders in MH-Index buffers." - :group 'mh-index-faces) - - - -;;; Faces Used in Message Drafts (:group 'mh-letter-faces) + "Folder heading face in MH-Folder buffers created by searches." + :group 'mh-faces + :group 'mh-index) (defface mh-letter-header-field '((((class color) (background light)) @@ -2724,15 +2635,10 @@ sequence." (:background "gray10")) (t (:bold t))) - "Face used to display header fields in draft buffers." - :group 'mh-letter-faces) - - - -;;; Faces Used in Message Display (:group 'mh-show-faces) + "Editable header field value face in draft buffers." + :group 'mh-faces + :group 'mh-letter) -(defvar mh-show-cc-face 'mh-show-cc - "Face used to highlight cc: header fields.") (defface mh-show-cc (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2747,11 +2653,10 @@ sequence." (:foreground "DimGray" :bold t :italic t)) (t (:bold t :italic t)))) - "Face used to highlight cc: header fields." - :group 'mh-show-faces) + "Face used to highlight \"cc:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-date-face 'mh-show-date - "Face used to highlight the Date: header field.") (defface mh-show-date (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2766,11 +2671,21 @@ sequence." (:foreground "DimGray" :bold t)) (t (:bold t :underline t)))) - "Face used to highlight the Date: header field." - :group 'mh-show-faces) + "Face used to highlight \"Date:\" header fields." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-from + '((((class color) (background light)) + (:foreground "red3")) + (((class color) (background dark)) + (:foreground "cyan")) + (t + (:bold t))) + "Face used to highlight \"From:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-header-face 'mh-show-header - "Face used to deemphasize unspecified header fields.") (defface mh-show-header (mh-defface-compat '((((class color) (min-colors 88) (background light)) @@ -2785,46 +2700,35 @@ sequence." (:foreground "LightGray" :italic t)) (t (:italic t)))) - "Face used to deemphasize unspecified header fields." - :group 'mh-show-faces) + "Face used to deemphasize less interesting header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-pgg-good-face 'mh-show-pgg-good - "Face used to highlight a good PGG signature.") -(defface mh-show-pgg-good - '((t - (:bold t :foreground "LimeGreen"))) - "Face used to highlight a good PGG signature." - :group 'mh-show-faces) - -(defvar mh-show-pgg-unknown-face 'mh-show-pgg-unknown - "Face used to highlight a PGG signature whose status is unknown. -This face is also used for a signature when the signer is -untrusted.") -(defface mh-show-pgg-unknown - '((t - (:bold t :foreground "DarkGoldenrod2"))) - "Face used to highlight a PGG signature whose status is unknown. -This face is also used for a signature when the signer is untrusted." - :group 'mh-show-faces) - -(defvar mh-show-pgg-bad-face 'mh-show-pgg-bad - "Face used to highlight a bad PGG signature.") -(defface mh-show-pgg-bad - '((t - (:bold t :foreground "DeepPink1"))) - "Face used to highlight a bad PGG signature." - :group 'mh-show-faces) +(defface mh-show-pgg-bad '((t (:bold t :foreground "DeepPink1"))) + "Bad PGG signature face." + :group 'mh-faces + :group 'mh-show) -(defface mh-show-signature - '((t - (:italic t))) - "Face used to highlight the message signature." - :group 'mh-show-faces) +(defface mh-show-pgg-good '((t (:bold t :foreground "LimeGreen"))) + "Good PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-pgg-unknown '((t (:bold t :foreground "DarkGoldenrod2"))) + "Unknown or untrusted PGG signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-signature '((t (:italic t))) + "Signature face." + :group 'mh-faces + :group 'mh-show) + +(defface mh-show-subject '((t (:inherit mh-folder-subject))) + "Face used to highlight \"Subject:\" header fields." + :group 'mh-faces + :group 'mh-show) -(defvar mh-show-to-face 'mh-show-to - "Face used to highlight the To: header field.") -(if (boundp 'facemenu-unlisted-faces) - (add-to-list 'facemenu-unlisted-faces "^mh-show")) (defface mh-show-to '((((class color) (background light)) (:foreground "SaddleBrown")) @@ -2835,43 +2739,31 @@ This face is also used for a signature when the signer is untrusted." (((class grayscale) (background dark)) (:foreground "LightGray" :underline t)) (t (:underline t))) - "Face used to highlight the To: header field." - :group 'mh-show-faces) - -(defvar mh-show-from-face 'mh-show-from - "Face used to highlight the From: header field.") -(defface mh-show-from - '((((class color) (background light)) - (:foreground "red3")) - (((class color) (background dark)) - (:foreground "cyan")) - (t - (:bold t))) - "Face used to highlight the From: header field." - :group 'mh-show-faces) - -(defface mh-show-xface - '((t - (:foreground "black" :background "white"))) - "Face used to display the X-Face image. -The background and foreground is used in the image." - :group 'mh-show-faces) - -(defvar mh-show-subject-face 'mh-show-subject - "Face used to highlight the Subject: header field.") -(copy-face 'mh-folder-subject 'mh-show-subject) - - + "Face used to highlight \"To:\" header fields." + :group 'mh-faces + :group 'mh-show) -;;; Faces Used in Speedbar (:group 'mh-speed-faces) +(defface mh-show-xface '((t (:inherit (mh-show-from highlight)))) + "X-Face image face. +The background and foreground are used in the image." + :group 'mh-faces + :group 'mh-show) (defface mh-speedbar-folder '((((class color) (background light)) (:foreground "blue4")) (((class color) (background dark)) (:foreground "light blue"))) - "Face used for folders in the speedbar buffer." - :group 'mh-speed-faces) + "Basic folder face." + :group 'mh-faces + :group 'mh-speedbar) + +(defface mh-speedbar-folder-with-unseen-messages + '((t + (:inherit mh-speedbar-folder :bold t))) + "Folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) (defface mh-speedbar-selected-folder '((((class color) (background light)) @@ -2880,20 +2772,111 @@ The background and foreground is used in the image." (:foreground "red1" :underline t)) (t (:underline t))) - "Face used for the current folder." - :group 'mh-speed-faces) - -(defface mh-speedbar-folder-with-unseen-messages - '((t - (:inherit mh-speedbar-folder :bold t))) - "Face used for folders in the speedbar buffer which have unread messages." - :group 'mh-speed-faces) + "Selected folder face." + :group 'mh-faces + :group 'mh-speedbar) (defface mh-speedbar-selected-folder-with-unseen-messages '((t (:inherit mh-speedbar-selected-folder :bold t))) - "Face used for the current folder when it has unread messages." - :group 'mh-speed-faces) + "Selected folder face when folder contains unread messages." + :group 'mh-faces + :group 'mh-speedbar) + +;;; XXX Temporary function for comparing old and new faces. Delete +;;; when everybody is happy. +(defvar bw-face-generation 'new) + +(defun bw-toggle-faces () + "Toggle between old and new faces." + (interactive) + (cond ((eq bw-face-generation 'new) + (message "Going from new to old...") + (bw-new-face-to-old) + (message "Going from new to old...done") + (setq bw-face-generation 'old)) + ((eq bw-face-generation 'old) + (message "Going from old to new...") + (bw-old-face-to-new) + (message "Going from old to new...done") + (setq bw-face-generation 'new)))) + +(defun bw-new-face-to-old () + "Sets old faces." + (face-spec-set 'mh-folder-body + (mh-defface-compat + '((((class color) (min-colors 88) (background light)) + (:foreground "RosyBrown")) + (((class color) (min-colors 88) (background dark)) + (:foreground "LightSalmon")) + (((class color)) + (:foreground "green")) + (((class grayscale) (background light)) + (:foreground "DimGray" :italic t)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :italic t)) + (t + (:italic t))))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t)))) + + (face-spec-set 'mh-folder-cur-msg-number + (mh-defface-compat + '((((class color) (min-colors 88) (background light)) + (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) + (:foreground "Cyan")) + (((class color)) + (:foreground "cyan" :weight bold)) + (((class grayscale) (background light)) + (:foreground "LightGray" :bold t)) + (((class grayscale) (background dark)) + (:foreground "DimGray" :bold t)) + (t + (:bold t))))) + + (face-spec-set 'mh-folder-date + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t)))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3")) + (t + (:bold t))))) + +(defun bw-old-face-to-new () + "Sets new faces." + (face-spec-set 'mh-folder-body + '((((class color)) + (:inherit mh-folder-msg-number)) + (t + (:inherit mh-folder-msg-number :italic t)))) + + (face-spec-set 'mh-folder-cur-msg-number + '((t + (:inherit mh-folder-msg-number :bold t)))) + + (face-spec-set 'mh-folder-date '((t (:inherit mh-folder-msg-number)))) + + (face-spec-set 'mh-folder-msg-number + '((((class color) (background light)) + (:foreground "snow4")) + (((class color) (background dark)) + (:foreground "snow3"))))) + ;; Local Variables: ;; indent-tabs-mode: nil diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 30034008cec..1deb465c1fe 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -95,8 +95,9 @@ (require 'easymenu) ;; Shush the byte-compiler -(defvar font-lock-auto-fontify) -(defvar font-lock-defaults) +(eval-when-compile + (defvar font-lock-auto-fontify) + (defvar font-lock-defaults)) (defconst mh-version "7.85+cvs" "Version number of MH-E.") @@ -194,7 +195,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-msg-number'. This regular expression should be correct as it is needed by non-fontification functions.") @@ -209,7 +211,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)D\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-deleted'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-deleted'.") @@ -224,7 +227,8 @@ matches the message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\". This expression includes the leading space within the parenthesis -since it looks better to highlight it as well. This regular +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-refiled'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-refiled'.") @@ -246,9 +250,10 @@ matches the message number as in the default of This expression includes the leading space and current message marker \"+\" within the parenthesis since it looks better to -highlight these items as well. This regular expression should be -correct as it is needed by non-fontification functions. See also -`mh-note-cur'.") +highlight these items as well. The highlighting is done with the +face `mh-folder-cur-msg-number'. This regular expression should +be correct as it is needed by non-fontification functions. See +also `mh-note-cur'.") (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" "This regular expression matches a valid date. @@ -258,8 +263,8 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain only one parenthesized expression which matches the date field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression -is not correct, the date will not be highlighted. See also -`mh-scan-format-regexp'.") +is not correct, the date will not be highlighted with the face +`mh-folder-date'.") (defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)" "This regular expression specifies the recipient in messages you sent. @@ -270,8 +275,9 @@ The first is expected to match the \"To:\" that the default scan format file generates. The second is expected to match the recipient's name as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular -expression is not correct, the recipient will not be -highlighted.") +expression is not correct, the \"To:\" string will not be +highlighted with the face `mh-folder-to' and the recipient will +not be highlighted with the face `mh-folder-address'") (defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)" "This regular expression matches the message body fragment. @@ -280,7 +286,8 @@ Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is -not correct, the body fragment will not be highlighted.") +not correct, the body fragment will not be highlighted with the +face `mh-folder-body'.") (defvar mh-scan-subject-regexp "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" @@ -289,12 +296,13 @@ not correct, the body fragment will not be highlighted.") It must match from the beginning of the line. Note that the default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least three parenthesized expressions. -The first is expected to match the \"Re:\" string, if any. The -second matches an optional bracketed number after \"Re:\", such as -in \"Re[2]:\" (and is thus a sub-expression of the first -expression) and the third is expected to match the subject line -itself as in the default of (broken on multiple lines for -readability): +The first is expected to match the \"Re:\" string, if any, and is +highlighted with the face `mh-folder-followup'. The second +matches an optional bracketed number after \"Re:\", such as in +\"Re[2]:\" (and is thus a sub-expression of the first expression) +and the third is expected to match the subject line itself which +is highlighted with the face `mh-folder-subject'. For example, +the default (broken on multiple lines for readability) is ^ *[0-9]+........[ ]*................... \\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)* @@ -303,22 +311,22 @@ readability): This regular expression should be correct as it is needed by non-fontification functions.") -(defvar mh-scan-format-regexp - (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)") - "This regular expression matches the output of scan. +(defvar mh-scan-sent-to-me-sender-regexp + "^ *[0-9]+.\\([bct]\\).....[ ]*\\(..................\\)" + "This regular expression matches messages sent to us. Note that the default setting of `mh-folder-font-lock-keywords' -expects this expression to contain at least three parenthesized +expects this expression to contain at least two parenthesized expressions. The first should match the fontification hint (see -`mh-scan-format-nmh'), the second is found in -`mh-scan-date-regexp', and the third should match the user name +`mh-scan-format-nmh') and the second should match the user name as in the default of - \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp - \"*\\\\(..................\\\\)\")\". + ^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\) -If this regular expression is not correct, the notation hints and -the sender will not be highlighted.") +If this regular expression is not correct, the notation hints +will not be highlighted with the face +`mh-mh-folder-sent-to-me-hint' and the sender will not be +highlighted with the face `mh-folder-sent-to-me-sender'.") @@ -326,31 +334,37 @@ the sender will not be highlighted.") (list ;; Folders when displaying index buffer (list "^\\+.*" - '(0 mh-index-folder-face)) + '(0 'mh-index-folder)) ;; Marked for deletion (list (concat mh-scan-deleted-msg-regexp ".*") - '(0 mh-folder-deleted-face)) + '(0 'mh-folder-deleted)) ;; Marked for refile (list (concat mh-scan-refiled-msg-regexp ".*") - '(0 mh-folder-refiled-face)) - ;;after subj - (list mh-scan-body-regexp '(1 mh-folder-body-face nil t)) + '(0 'mh-folder-refiled)) + ;; After subject + (list mh-scan-body-regexp + '(1 'mh-folder-body nil t)) + ;; Subject '(mh-folder-font-lock-subject - (1 mh-folder-followup-face append t) - (2 mh-folder-subject-face append t)) - ;;current msg + (1 'mh-folder-followup append t) + (2 'mh-folder-subject append t)) + ;; Current message number (list mh-scan-cur-msg-number-regexp - '(1 mh-folder-cur-msg-number-face)) + '(1 'mh-folder-cur-msg-number)) + ;; Message number (list mh-scan-good-msg-regexp - '(1 mh-folder-msg-number-face)) ;; Msg number - (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date + '(1 'mh-folder-msg-number)) + ;; Date + (list mh-scan-date-regexp + '(1 'mh-folder-date)) + ;; Messages from me (To:) (list mh-scan-rcpt-regexp - '(1 mh-folder-to-face) ;; To: - '(2 mh-folder-address-face)) ;; address - ;; scan font-lock name - (list mh-scan-format-regexp - '(1 mh-folder-date-face) - '(3 mh-folder-scan-format-face))) + '(1 'mh-folder-to) + '(2 'mh-folder-address)) + ;; Messages to me + (list mh-scan-sent-to-me-sender-regexp + '(1 'mh-folder-sent-to-me-hint) + '(2 'mh-folder-sent-to-me-sender))) "Keywords (regular expressions) used to fontify the MH-Folder buffer.") (defvar mh-scan-cmd-note-width 1 diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el index 6b8feda8ccc..2818674afae 100644 --- a/lisp/mh-e/mh-init.el +++ b/lisp/mh-e/mh-init.el @@ -1,6 +1,6 @@ ;;; mh-init.el --- MH-E initialization -;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -334,7 +334,7 @@ there. Otherwise, the images directory is added to the (defun mh-defface-compat (spec) "Convert SPEC for defface if necessary to run on older platforms. -See `defface' for the spec definition. +Modifies SPEC in place and returns it. See `defface' for the spec definition. When `mh-min-colors-defined-flag' is nil, this function finds a display with a single \"class\" requirement with a \"color\" @@ -351,7 +351,8 @@ requirements." (loop for entry in spec do (when (not (eq (car entry) t)) (if (assoc 'min-colors (car entry)) - (delq (assoc 'min-colors (car entry)) (car entry))))))) + (delq (assoc 'min-colors (car entry)) (car entry)))))) + spec) (provide 'mh-init) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 4338a94381b..c028890f6a1 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1407,14 +1407,15 @@ Parameter EL is unused." (defun mh-mime-security-button-face (info) "Return the button face to use for encrypted/signed mail based on INFO." (cond ((string-match "OK" info) ;Decrypted mail - mh-show-pgg-good-face) + 'mh-show-pgg-good) ((string-match "Failed" info) ;Decryption failed or signature invalid - mh-show-pgg-bad-face) + 'mh-show-pgg-bad) ((string-match "Undecided" info);Unprocessed mail - mh-show-pgg-unknown-face) + 'mh-show-pgg-unknown) ((string-match "Untrusted" info);Key not trusted - mh-show-pgg-unknown-face) - (t mh-show-pgg-good-face))) + 'mh-show-pgg-unknown) + (t + 'mh-show-pgg-good))) (defun mh-mime-security-press-button (handle) "Callback from security button for part HANDLE." diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index b5d97a2be05..e008c93916e 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -402,18 +402,30 @@ Argument LIMIT limits search." (eval-and-compile ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' (defvar mh-show-font-lock-keywords - '(("^\\(From:\\|Sender:\\)\\(.*\\)" (1 'default) (2 mh-show-from-face)) - (mh-header-to-font-lock (0 'default) (1 mh-show-to-face)) - (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face)) + '(("^\\(From:\\|Sender:\\)\\(.*\\)" + (1 'default) + (2 'mh-show-from)) + (mh-header-to-font-lock + (0 'default) + (1 'mh-show-to)) + (mh-header-cc-font-lock + (0 'default) + (1 'mh-show-cc)) ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" - (1 'default) (2 mh-show-from-face)) - (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face)) + (1 'default) + (2 'mh-show-from)) + (mh-header-subject-font-lock + (0 'default) + (1 'mh-show-subject)) ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" - (1 'default) (2 mh-show-cc-face)) + (1 'default) + (2 'mh-show-cc)) ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" - (1 'default) (2 mh-show-date-face)) - (mh-letter-header-font-lock (0 mh-show-header-face append t))) - "Additional expressions to highlight in MH-show mode.")) + (1 'default) + (2 'mh-show-date)) + (mh-letter-header-font-lock + (0 'mh-show-header append t))) + "Additional expressions to highlight in MH-Show buffers.")) (defvar mh-show-font-lock-keywords-with-cite (eval-when-compile @@ -432,11 +444,13 @@ Argument LIMIT limits search." (beginning-of-line) (end-of-line) (2 font-lock-constant-face nil t) (4 font-lock-comment-face nil t))))))) - "Additional expressions to highlight in MH-show mode.") + "Additional expressions to highlight in MH-Show buffers.") (defvar mh-letter-font-lock-keywords `(,@mh-show-font-lock-keywords-with-cite - (mh-font-lock-field-data (1 'mh-letter-header-field prepend t)))) + (mh-font-lock-field-data + (1 'mh-letter-header-field prepend t))) + "Additional expressions to highlight in MH-Letter buffers.") (defun mh-show-font-lock-fontify-region (beg end loudly) "Limit font-lock in `mh-show-mode' to the header. @@ -1229,6 +1243,32 @@ See also `mh-folder-mode'. (mh-do-in-xemacs (defvar default-enable-multibyte-characters)) +(defmacro mh-face-foreground-compat (face &optional frame inherit) + "Return the foreground color name of FACE, or nil if unspecified. +See documentation for `face-foreground' for a description of the +arguments FACE, FRAME, and INHERIT. + +Calls `face-foreground' correctly in older environments. Versions +of Emacs prior to version 22 lacked an INHERIT argument which +when t tells `face-foreground' to consider an inherited value for +the foreground if the face does not define one itself." + (if (>= emacs-major-version 22) + `(face-foreground ,face ,frame ,inherit) + `(face-foreground ,face ,frame))) + +(defmacro mh-face-background-compat (face &optional frame inherit) + "Return the background color name of face, or nil if unspecified. +See documentation for `back-foreground' for a description of the +arguments FACE, FRAME, and INHERIT. + +Calls `face-background' correctly in older environments. Versions +of Emacs prior to version 22 lacked an INHERIT argument which +when t tells `face-background' to consider an inherited value for +the background if the face does not define one itself." + (if (>= emacs-major-version 22) + `(face-background ,face ,frame ,inherit) + `(face-background ,face ,frame))) + (defun mh-face-display-function () "Display a Face, X-Face, or X-Image-URL header field. If more than one of these are present, then the first one found @@ -1259,9 +1299,11 @@ in this order is used." (mh-funcall-if-exists insert-image (create-image raw type t - :foreground (face-foreground 'mh-show-xface) - :background (face-background 'mh-show-xface)) - " "))) + :foreground + (mh-face-foreground-compat 'mh-show-xface nil t) + :background + (mh-face-background-compat 'mh-show-xface nil t)) + " "))) ;; XEmacs (mh-do-in-xemacs (cond diff --git a/lisp/mouse.el b/lisp/mouse.el index 186fa438b35..ef655ba836f 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -355,14 +355,21 @@ This command must be bound to a mouse click." (defun mouse-drag-window-above (window) "Return the (or a) window directly above WINDOW. That means one whose bottom edge is at the same height as WINDOW's top edge." - (let ((top (nth 1 (window-edges window))) + (let ((start-top (nth 1 (window-edges window))) + (start-left (nth 0 (window-edges window))) + (start-right (nth 2 (window-edges window))) (start-window window) above-window) (setq window (previous-window window 0)) (while (and (not above-window) (not (eq window start-window))) - (if (= (+ (window-height window) (nth 1 (window-edges window))) - top) - (setq above-window window)) + (let ((left (nth 0 (window-edges window))) + (right (nth 2 (window-edges window)))) + (when (and (= (+ (window-height window) (nth 1 (window-edges window))) + start-top) + (or (and (<= left start-left) (<= start-right right)) + (and (<= start-left left) (<= left start-right)) + (and (<= start-left right) (<= right start-right)))) + (setq above-window window))) (setq window (previous-window window))) above-window)) @@ -1025,7 +1032,11 @@ at the same position." (select-window original-window) (if (or (vectorp on-link) (stringp on-link)) (setq event (aref on-link 0)) - (setcar event 'mouse-2))) + (setcar event 'mouse-2) + ;; If this mouse click has never been done by + ;; the user, it doesn't have the necessary + ;; property to be interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click))) (push event unread-command-events)))) ;; Case where the end-event is not a cons cell (it's just a boring diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 9925227619f..e1ae498923b 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -129,7 +129,7 @@ A value of t means there is no limit--fontify regardless of the size." 'goto-address-at-point) (define-key m (kbd "C-c RET") 'goto-address-at-point) m) - "keymap to hold goto-addr's mouse key defs under highlighted URLs.") + "Keymap to hold goto-addr's mouse key defs under highlighted URLs.") (defcustom goto-address-url-face 'bold "Face to use for URLs." @@ -242,7 +242,8 @@ address. If no e-mail address found, return nil." "Sets up goto-address functionality in the current buffer. Allows user to use mouse/keyboard command to click to go to a URL or to send e-mail. -By default, goto-address binds to mouse-2 and C-c RET. +By default, goto-address binds `goto-address-at-point' to mouse-2 and C-c RET +only on URLs and e-mail addresses. Also fontifies the buffer appropriately (see `goto-address-fontify-p' and `goto-address-highlight-p' for more information)." diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index fc7b23ae1ba..4a3baea4f41 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -72,104 +72,184 @@ (defvar webjump-sample-sites '( - ;; FSF, not including Emacs-specific. ("GNU Project FTP Archive" . + ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html [mirrors "ftp://ftp.gnu.org/pub/gnu/" - ;; ASIA: - "ftp://ftp.cs.titech.ac.jp" - "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep" - "ftp://cair-archive.kaist.ac.kr/pub/gnu" - "ftp://ftp.nectec.or.th/pub/mirrors/gnu" - ;; AUSTRALIA: - "ftp://archie.au/gnu" - "ftp://archie.oz/gnu" - "ftp://archie.oz.au/gnu" - ;; AFRICA: - "ftp://ftp.sun.ac.za/pub/gnu" - ;; MIDDLE-EAST: - "ftp://ftp.technion.ac.il/pub/unsupported/gnu" - ;; EUROPE: - "ftp://irisa.irisa.fr/pub/gnu" - "ftp://ftp.univ-lyon1.fr/pub/gnu" - "ftp://ftp.mcc.ac.uk" - "ftp://unix.hensa.ac.uk/mirrors/uunet/systems/gnu" - "ftp://src.doc.ic.ac.uk/gnu" - "ftp://ftp.ieunet.ie/pub/gnu" - "ftp://ftp.eunet.ch" - "ftp://nic.switch.ch/mirror/gnu" - "ftp://ftp.informatik.rwth-aachen.de/pub/gnu" - "ftp://ftp.informatik.tu-muenchen.de" + ;; United States + "ftp://mirrors.kernel.org/gnu" + "ftp://gatekeeper.dec.com/pub/GNU/" + "ftp://ftp.keystealth.org/pub/gnu/" + "ftp://mirrors.usc.edu/pub/gnu/" + "ftp://cudlug.cudenver.edu/pub/mirrors/ftp.gnu.org/" + "ftp://ftp.cise.ufl.edu/pub/mirrors/GNU/" + "ftp://uiarchive.cso.uiuc.edu/pub/ftp/ftp.gnu.org/gnu/" + "ftp://gnu.cs.lewisu.edu/gnu/" + "ftp://ftp.in-span.net/pub/mirrors/ftp.gnu.org/" + "ftp://gnu.ms.uky.edu/pub/mirrors/gnu/" + "ftp://ftp.algx.net/pub/gnu/" + "ftp://aeneas.mit.edu/pub/gnu/" + "ftp://ftp.egr.msu.edu/pub/gnu/" + "ftp://ftp.wayne.edu/pub/gnu/" + "ftp://wuarchive.wustl.edu/mirrors/gnu/" + "ftp://gnu.teleglobe.net/ftp.gnu.org/" + "ftp://ftp.cs.columbia.edu/archives/gnu/prep/" + "ftp://ftp.ece.cornell.edu/pub/mirrors/gnu/" + "ftp://ftp.ibiblio.org/pub/mirrors/gnu/" + "ftp://ftp.cis.ohio-state.edu/mirror/gnu/" + "ftp://ftp.club.cc.cmu.edu/gnu/" + "ftp://ftp.sunsite.utk.edu/pub/gnu/ftp/" + "ftp://thales.memphis.edu/pub/gnu/" + "ftp://gnu.wwc.edu" + "ftp://ftp.twtelecom.net/pub/GNU/" + ;; Africa + "ftp://ftp.sun.ac.za/mirrorsites/ftp.gnu.org" + ;; The Americas + "ftp://ftp.unicamp.br/pub/gnu/" + "ftp://master.softaplic.com.br/pub/gnu/" + "ftp://ftp.matrix.com.br/pub/gnu/" + "ftp://ftp.pucpr.br/gnu" + "ftp://ftp.linorg.usp.br/gnu" + "ftp://ftp.cs.ubc.ca/mirror2/gnu/" + "ftp://cs.ubishops.ca/pub/ftp.gnu.org/" + "ftp://ftp.inf.utfsm.cl/pub/gnu/" + "ftp://sunsite.ulatina.ac.cr/Mirrors/GNU/" + "ftp://www.gnu.unam.mx/pub/gnu/software/" + "ftp://gnu.cem.itesm.mx/pub/mirrors/gnu.org/" + "ftp://ftp.azc.uam.mx/mirrors/gnu/" + ;; Australia + "ftp://mirror.aarnet.edu.au/pub/gnu/" + "ftp://gnu.mirror.pacific.net.au/gnu/" + ;; Asia + "ftp://ftp.cs.cuhk.edu.hk/pub/gnu/gnu/" + "ftp://sunsite.ust.hk/pub/gnu/" + "ftp://ftp.gnupilgrims.org/pub/gnu" + "ftp://www.imtech.res.in/mirror/gnuftp/" + "ftp://kambing.vlsm.org/gnu" + "ftp://ftp.cs.huji.ac.il/mirror/GNU/" + "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/" + "ftp://core.ring.gr.jp/pub/GNU/" + "ftp://ftp.ring.gr.jp/pub/GNU/" + "ftp://mirrors.hbi.co.jp/gnu/" + "ftp://ftp.cs.titech.ac.jp/pub/gnu/" + "ftp://ftpmirror.hanyang.ac.kr/GNU/" + "ftp://ftp.linux.sarang.net/mirror/gnu/gnu/" + "ftp://ftp.xgate.co.kr/pub/mirror/gnu/" + "ftp://ftp://gnu.xinicks.com/" + "ftp://ftp.isu.net.sa/pub/gnu/" + "ftp://ftp.nctu.edu.tw/UNIX/gnu/" + "ftp://coda.nctu.edu.tw/UNIX/gnu/" + "ftp://ftp1.sinica.edu.tw/pub3/GNU/gnu/" + "ftp://gnu.cdpa.nsysu.edu.tw/gnu" + "ftp://ftp.nectec.or.th/pub/mirrors/gnu/" + ;; Europe + "ftp://ftp.gnu.vbs.at/" + "ftp://ftp.univie.ac.at/packages/gnu/" + "ftp://gd.tuwien.ac.at/gnu/gnusrc/" + "ftp://ftp.belnet.be/mirror/ftp.gnu.org/" + "ftp://gnu.blic.net/pub/gnu/" + "ftp://ftp.fi.muni.cz/pub/gnu/" + "ftp://ftp.dkuug.dk/pub/gnu/" + "ftp://sunsite.dk/mirrors/gnu" + "ftp://ftp.funet.fi/pub/gnu/prep/" + "ftp://ftp.irisa.fr/pub/gnu/" + "ftp://ftp.cs.univ-paris8.fr/mirrors/ftp.gnu.org/" + "ftp://ftp.cs.tu-berlin.de/pub/gnu/" + "ftp://ftp.leo.org/pub/comp/os/unix/gnu/" + "ftp://ftp.informatik.rwth-aachen.de/pub/gnu/" + "ftp://ftp.de.uu.net/pub/gnu/" + "ftp://ftp.freenet.de/pub/ftp.gnu.org/gnu/" + "ftp://ftp.cs.uni-bonn.de/pub/gnu/" + "ftp://ftp-stud.fht-esslingen.de/pub/Mirrors/ftp.gnu.org/" + "ftp://ftp.stw-bonn.de/pub/mirror/ftp.gnu.org/" + "ftp://ftp.math.uni-bremen.de/pub/gnu" + "ftp://ftp.forthnet.gr/pub/gnu/" + "ftp://ftp.ntua.gr/pub/gnu/" + "ftp://ftp.duth.gr/pub/gnu/" + "ftp://ftp.physics.auth.gr/pub/gnu/" + "ftp://ftp.esat.net/pub/gnu/" + "ftp://ftp.heanet.ie/mirrors/ftp.gnu.org" + "ftp://ftp.lugroma2.org/pub/gnu/" + "ftp://ftp.gnu.inetcosmos.org/pub/gnu/" + "ftp://ftp.digitaltrust.it/pub/gnu" + "ftp://ftp://rm.mirror.garr.it/mirrors/gnuftp" + "ftp://ftp.nluug.nl/pub/gnu/" + "ftp://ftp.mirror.nl/pub/mirror/gnu/" + "ftp://ftp.nl.uu.net/pub/gnu/" + "ftp://mirror.widexs.nl/pub/gnu/" + "ftp://ftp.easynet.nl/mirror/GNU/" "ftp://ftp.win.tue.nl/pub/gnu" - "ftp://ftp.nl.net" - "ftp://ftp.etsimo.uniovi.es/pub/gnu" - "ftp://ftp.funet.fi/pub/gnu" - "ftp://ftp.denet.dk" - "ftp://ftp.stacken.kth.se" - "ftp://isy.liu.se" - "ftp://ftp.luth.se/pub/unix/gnu" - "ftp://ftp.sunet.se/pub/gnu" - "ftp://archive.eu.net" - ;; SOUTH AMERICA: - "ftp://ftp.inf.utfsm.cl/pub/gnu" - "ftp://ftp.unicamp.br/pub/gnu" - ;; WESTERN CANADA: - "ftp://ftp.cs.ubc.ca/mirror2/gnu" - ;; USA: - "ftp://wuarchive.wustl.edu/systems/gnu" - "ftp://labrea.stanford.edu" - "ftp://ftp.digex.net/pub/gnu" - "ftp://ftp.kpc.com/pub/mirror/gnu" - "ftp://f.ms.uky.edu/pub3/gnu" - "ftp://jaguar.utah.edu/gnustuff" - "ftp://ftp.hawaii.edu/mirrors/gnu" - "ftp://uiarchive.cso.uiuc.edu/pub/gnu" - "ftp://ftp.cs.columbia.edu/archives/gnu/prep" - "ftp://gatekeeper.dec.com/pub/GNU" - "ftp://ftp.uu.net/systems/gnu"]) + "ftp://gnu.mirror.vuurwerk.net/pub/GNU/" + "ftp://gnu.kookel.org/pub/ftp.gnu.org/" + "ftp://ftp.uninett.no/pub/gnu/" + "ftp://ftp.task.gda.pl/pub/gnu/" + "ftp://sunsite.icm.edu.pl/pub/gnu/" + "ftp://ftp.man.poznan.pl/pub/gnu" + "ftp://ftp.ist.utl.pt/pub/GNU/gnu/" + "ftp://ftp.telepac.pt/pub/gnu/" + "ftp://ftp.timisoara.roedu.net/mirrors/ftp.gnu.org/pub/gnu" + "ftp://ftp.chg.ru/pub/gnu/" + "ftp://gnuftp.axitel.ru/" + "ftp://ftp.arnes.si/software/gnu/" + "ftp://ftp.etsimo.uniovi.es/pub/gnu/" + "ftp://ftp.rediris.es/pub/gnu/" + "ftp://ftp.chl.chalmers.se/pub/gnu/" + "ftp://ftp.isy.liu.se/pub/gnu/" + "ftp://ftp.luth.se/pub/unix/gnu/" + "ftp://ftp.stacken.kth.se/pub/gnu/" + "ftp://ftp.sunet.se/pub/gnu/" + "ftp://sunsite.cnlab-switch.ch/mirror/gnu/" + "ftp://ftp.ulak.net.tr/gnu/" + "ftp://ftp.gnu.org.ua" + "ftp://ftp.mcc.ac.uk/pub/gnu/" + "ftp://ftp.mirror.ac.uk/sites/ftp.gnu.org/gnu/" + "ftp://ftp.warwick.ac.uk/pub/gnu/" + "ftp://ftp.hands.com/ftp.gnu.org/" + "ftp://gnu.teleglobe.net/ftp.gnu.org/"]) ("GNU Project Home Page" . "www.gnu.org") ;; Emacs. - ("Emacs Lisp Archive" . - "ftp://ftp.emacs.org/pub/") + ("Emacs Home Page" . + "www.gnu.org/software/emacs/emacs.html") + ("Savannah Emacs page" . + "savannah.gnu.org/projects/emacs") + ("Emacs Lisp List" . + "www.damtp.cam.ac.uk/user/eglen/emacs/ell.html") + ("Emacs Wiki" . + [simple-query "www.emacswiki.org" + "www.emacswiki.org/cgi-bin/wiki/" ""]) ;; Internet search engines. - ("AltaVista" . - [simple-query - "www.altavista.digital.com" - "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q=" - "&r=&d0=&d1="]) - ("Archie" . - [simple-query "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl" - "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""]) - ("Lycos" . - [simple-query "www.lycos.com" - "www.lycos.com/cgi-bin/pursuit?cat=lycos&query=" ""]) + ("Google" . + [simple-query "www.google.com" + "www.google.com/search?q=" ""]) + ("Google Groups" . + [simple-query "groups.google.com" + "groups.google.com/groups?q=" ""]) ("Yahoo" . - [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""]) + [simple-query "www.yahoo.com" "search.yahoo.com/search?p=" ""]) + ("Yahoo: Reference" . "www.yahoo.com/Reference/") ;; Misc. general interest. ("Interactive Weather Information Network" . webjump-to-iwin) ("Usenet FAQs" . - [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html" - "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find=" - ""]) + "www.faqs.org/faqs/") ("RTFM Usenet FAQs by Group" . "ftp://rtfm.mit.edu/pub/usenet-by-group/") ("RTFM Usenet FAQs by Hierachy" . "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/") ("X Consortium Archive" . "ftp.x.org") - ("Yahoo: Reference" . "www.yahoo.com/Reference/") ;; Computer social issues, privacy, professionalism. ("Association for Computing Machinery" . "www.acm.org") - ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/") + ("Computer Professionals for Social Responsibility" . "www.cpsr.org") ("Electronic Frontier Foundation" . "www.eff.org") ("IEEE Computer Society" . "www.computer.org") ("Risks Digest" . webjump-to-risks) - ;; Fun. - ("Bastard Operator from Hell" . "www.replay.com/bofh/") + ;; More. + ("Supplemental Web site list for webjump" . + "www.neilvandyke.org/webjump/") ) "Sample hotlist for WebJump. See the documentation for the `webjump' diff --git a/lisp/paren.el b/lisp/paren.el index f5327c3b344..8b5a134d2d4 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -72,8 +72,8 @@ otherwise)." :group 'paren-showing :version "20.3") -(defgroup paren-showing-faces () - "Group for faces of Show Paren mode" +(defgroup paren-showing-faces nil + "Group for faces of Show Paren mode." :group 'paren-showing :group 'faces :version "22.1") @@ -88,7 +88,7 @@ otherwise)." (t :background "gray")) "Show Paren mode face used for a matching paren." - :group 'show-paren-faces) + :group 'paren-showing-faces) ;; backward-compatibility alias (put 'show-paren-match-face 'face-alias 'show-paren-match) @@ -96,7 +96,7 @@ otherwise)." '((((class color)) (:foreground "white" :background "purple")) (t (:inverse-video t))) "Show Paren mode face used for a mismatching paren." - :group 'show-paren-faces) + :group 'paren-showing-faces) ;; backward-compatibility alias (put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index b237dd9a598..9de0a24f09e 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -72,7 +72,9 @@ (eval-after-load "font-lock" '(if (and (not (featurep 'cc-fix)) ; only load the file once. (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) + (condition-case nil + (font-lock-compile-keywords '("\\<\\>")) + (error nil)) font-lock-keywords)) ; did the previous call foul this up? (load "cc-fix"))) @@ -83,7 +85,9 @@ (progn (require 'font-lock) (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) + (condition-case nil + (font-lock-compile-keywords '("\\<\\>")) + (error nil)) font-lock-keywords))) (cc-load "cc-fix"))) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index cdc557c7274..4c271113b72 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -177,7 +177,7 @@ differs from the default." (defcustom delphi-other-face nil "*Face used to color everything else." - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :group 'delphi) (defconst delphi-directives diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 9ceee6f6920..6f5d0855e19 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -516,15 +516,11 @@ instead of reading master file from disk." (defun flymake-copy-buffer-to-temp-buffer (buffer) "Copy contents of BUFFER into newly created temp buffer." - (let ((contents nil) - (temp-buffer nil)) - (with-current-buffer buffer - (setq contents (buffer-string)) - - (setq temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (buffer-name buffer))))) - (set-buffer temp-buffer) - (insert contents)) - temp-buffer)) + (with-current-buffer + (get-buffer-create (generate-new-buffer-name + (concat "flymake:" (buffer-name buffer)))) + (insert-buffer-substring buffer) + (current-buffer))) (defun flymake-check-include (source-file-name inc-path inc-name include-dirs) "Check if SOURCE-FILE-NAME can be found in include path. @@ -613,7 +609,8 @@ It's flymake process filter." (flymake-log 3 "received %d byte(s) of output from process %d" (length output) pid) (when source-buffer - (flymake-parse-output-and-residual source-buffer output)))) + (with-current-buffer source-buffer + (flymake-parse-output-and-residual output))))) (defun flymake-process-sentinel (process event) "Sentinel for syntax check buffers." @@ -636,8 +633,8 @@ It's flymake process filter." (when source-buffer (with-current-buffer source-buffer - (flymake-parse-residual source-buffer) - (flymake-post-syntax-check source-buffer exit-status command) + (flymake-parse-residual) + (flymake-post-syntax-check exit-status command) (setq flymake-is-running nil)))) (error (let ((err-str (format "Error in process sentinel for buffer %s: %s" @@ -646,60 +643,51 @@ It's flymake process filter." (with-current-buffer source-buffer (setq flymake-is-running nil)))))))) -(defun flymake-post-syntax-check (source-buffer exit-status command) - (with-current-buffer source-buffer - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (flymake-count-lines source-buffer)))) - (flymake-delete-own-overlays source-buffer) - (flymake-highlight-err-lines - source-buffer (with-current-buffer source-buffer flymake-err-info)) +(defun flymake-post-syntax-check (exit-status command) + (setq flymake-err-info flymake-new-err-info) + (setq flymake-new-err-info nil) + (setq flymake-err-info + (flymake-fix-line-numbers + flymake-err-info 1 (flymake-count-lines))) + (flymake-delete-own-overlays) + (flymake-highlight-err-lines flymake-err-info) (let (err-count warn-count) - (with-current-buffer source-buffer - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name source-buffer) err-count warn-count + (setq err-count (flymake-get-err-count flymake-err-info "e")) + (setq warn-count (flymake-get-err-count flymake-err-info "w")) + (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" + (buffer-name) err-count warn-count (- (flymake-float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil)) + (setq flymake-check-start-time nil) (if (and (equal 0 err-count) (equal 0 warn-count)) (if (equal 0 exit-status) - (flymake-report-status source-buffer "" "") ; PASSED - (if (not (with-current-buffer source-buffer - flymake-check-was-interrupted)) - (flymake-report-fatal-status (current-buffer) "CFGERR" + (flymake-report-status "" "") ; PASSED + (if (not flymake-check-was-interrupted) + (flymake-report-fatal-status "CFGERR" (format "Configuration error has occured while running %s" command)) - (flymake-report-status source-buffer nil ""))) ; "STOPPED" - (flymake-report-status source-buffer (format "%d/%d" err-count warn-count) "")))) + (flymake-report-status nil ""))) ; "STOPPED" + (flymake-report-status (format "%d/%d" err-count warn-count) "")))) -(defun flymake-parse-output-and-residual (source-buffer output) +(defun flymake-parse-output-and-residual (output) "Split OUTPUT into lines, merge in residual if necessary." - (with-current-buffer source-buffer - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (with-current-buffer source-buffer - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - source-buffer lines)))))) - -(defun flymake-parse-residual (source-buffer) + (let* ((buffer-residual flymake-output-residual) + (total-output (if buffer-residual (concat buffer-residual output) output)) + (lines-and-residual (flymake-split-output total-output)) + (lines (nth 0 lines-and-residual)) + (new-residual (nth 1 lines-and-residual))) + (setq flymake-output-residual new-residual) + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info lines)))) + +(defun flymake-parse-residual () "Parse residual if it's non empty." - (with-current-buffer source-buffer - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - source-buffer - (list flymake-output-residual))) - (setq flymake-output-residual nil)))) + (when flymake-output-residual + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info + (list flymake-output-residual))) + (setq flymake-output-residual nil))) (defvar flymake-err-info nil "Sorted list of line numbers and lists of err info in the form (file, err-text).") @@ -803,16 +791,11 @@ line number outside the file being compiled." (setq count (1- count)))) err-info-list) -(defun flymake-highlight-err-lines (buffer err-info-list) +(defun flymake-highlight-err-lines (err-info-list) "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (with-current-buffer buffer - (save-excursion - (let* ((idx 0) - (count (length err-info-list))) - (while (< idx count) - (flymake-highlight-line (car (nth idx err-info-list)) - (nth 1 (nth idx err-info-list))) - (setq idx (1+ idx))))))) + (save-excursion + (dolist (err err-info-list) + (flymake-highlight-line (car err) (nth 1 err))))) (defun flymake-overlay-p (ov) "Determine whether overlay OV was created by flymake." @@ -831,16 +814,13 @@ line number outside the file being compiled." ov) (flymake-log 3 "created an overlay at (%d-%d)" beg end))) -(defun flymake-delete-own-overlays (buffer) +(defun flymake-delete-own-overlays () "Delete all flymake overlays in BUFFER." - (with-current-buffer buffer - (let ((ov (overlays-in (point-min) (point-max)))) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (delete-overlay (car ov)) - ;;+(flymake-log 3 "deleted overlay %s" ov) - ) - (setq ov (cdr ov)))))) + (dolist (ol (overlays-in (point-min) (point-max))) + (when (flymake-overlay-p ol) + (delete-overlay ol) + ;;+(flymake-log 3 "deleted overlay %s" ol) + ))) (defun flymake-region-has-flymake-overlays (beg end) "Check if region specified by BEG and END has overlay. @@ -905,19 +885,19 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (flymake-make-overlay beg end tooltip-text face nil))) -(defun flymake-parse-err-lines (err-info-list source-buffer lines) +(defun flymake-parse-err-lines (err-info-list lines) "Parse err LINES, store info in ERR-INFO-LIST." (let* ((count (length lines)) (idx 0) (line-err-info nil) (real-file-name nil) - (source-file-name (buffer-file-name source-buffer)) + (source-file-name buffer-file-name) (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) (while (< idx count) (setq line-err-info (flymake-parse-line (nth idx lines))) (when line-err-info - (setq real-file-name (funcall get-real-file-name-f source-buffer (flymake-ler-get-file line-err-info))) + (setq real-file-name (funcall get-real-file-name-f (current-buffer) (flymake-ler-get-file line-err-info))) (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) (if (flymake-same-files real-file-name source-file-name) @@ -1147,9 +1127,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) include-dirs)) -(defun flymake-restore-formatting (source-buffer) - "Remove any formatting made by flymake." - ) +;; (defun flymake-restore-formatting () +;; "Remove any formatting made by flymake." +;; ) (defun flymake-get-program-dir (buffer) "Get dir to start program in." @@ -1176,38 +1156,36 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." :group 'flymake :type 'boolean) -(defun flymake-start-syntax-check (buffer) - "Start syntax checking for buffer BUFFER." - (unless (bufferp buffer) - (error "Expected a buffer")) - (with-current-buffer buffer - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file (buffer-file-name buffer))) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - (setq flymake-buffer-data (flymake-makehash 'equal)) - - (let* ((source-file-name (buffer-file-name buffer)) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f buffer)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f buffer)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process buffer cmd args dir)))))))) - -(defun flymake-start-syntax-check-process (buffer cmd args dir) +(defun flymake-start-syntax-check () + "Start syntax checking for current buffer." + (interactive) + (flymake-log 3 "flymake is running: %s" flymake-is-running) + (when (and (not flymake-is-running) + (flymake-can-syntax-check-file buffer-file-name)) + (when (or (not flymake-compilation-prevents-syntax-check) + (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") + (flymake-clear-buildfile-cache) + (flymake-clear-project-include-dirs-cache) + + (setq flymake-check-was-interrupted nil) + (setq flymake-buffer-data (flymake-makehash 'equal)) + + (let* ((source-file-name buffer-file-name) + (init-f (flymake-get-init-function source-file-name)) + (cleanup-f (flymake-get-cleanup-function source-file-name)) + (cmd-and-args (funcall init-f (current-buffer))) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args))) + (if (not cmd-and-args) + (progn + (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) + (funcall cleanup-f (current-buffer))) + (progn + (setq flymake-last-change-time nil) + (flymake-start-syntax-check-process cmd args dir))))))) + +(defun flymake-start-syntax-check-process (cmd args dir) "Start syntax check process." (let* ((process nil)) (condition-case err @@ -1219,25 +1197,24 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (set-process-sentinel process 'flymake-process-sentinel) (set-process-filter process 'flymake-process-filter) - (flymake-reg-names (process-id process) (buffer-name buffer)) + (flymake-reg-names (process-id process) (buffer-name)) - (with-current-buffer buffer - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (flymake-float-time))) + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (flymake-float-time)) - (flymake-report-status buffer nil "*") + (flymake-report-status nil "*") (flymake-log 2 "started process %d, command=%s, dir=%s" (process-id process) (process-command process) default-directory) process) (error (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" cmd args (error-message-string err))) - (source-file-name (buffer-file-name buffer)) + (source-file-name buffer-file-name) (cleanup-f (flymake-get-cleanup-function source-file-name))) (flymake-log 0 err-str) - (funcall cleanup-f buffer) - (flymake-report-fatal-status buffer "PROCERR" err-str)))))) + (funcall cleanup-f (current-buffer)) + (flymake-report-fatal-status "PROCERR" err-str)))))) (defun flymake-kill-process (pid &optional rest) "Kill process PID." @@ -1304,12 +1281,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check buffer))))) - -(defun flymake-start-syntax-check-for-current-buffer () - "Run `flymake-start-syntax-check' for current buffer if it isn't already running." - (interactive) - (flymake-start-syntax-check (current-buffer))) + (flymake-start-syntax-check))))) (defun flymake-current-line-no () "Return number of current line in current buffer." @@ -1318,10 +1290,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (end (if (= (point) (point-max)) (point) (1+ (point))))) (count-lines beg end))) -(defun flymake-count-lines (buffer) +(defun flymake-count-lines () "Return number of lines in buffer BUFFER." - (with-current-buffer buffer - (count-lines (point-min) (point-max)))) + (count-lines (point-min) (point-max))) (defun flymake-get-point-pixel-pos () "Return point position in pixels: (x, y)." @@ -1346,7 +1317,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (line-err-info-list (nth 0 (flymake-find-err-info flymake-err-info line-no))) (menu-data (flymake-make-err-menu-data line-no line-err-info-list)) (choice nil) - (mouse-pos (flymake-get-point-pixel-pos)) (menu-pos (list (flymake-get-point-pixel-pos) (selected-window)))) (if menu-data (progn @@ -1402,20 +1372,18 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (make-variable-buffer-local 'flymake-mode-line-status) -(defun flymake-report-status (buffer e-w &optional status) +(defun flymake-report-status (e-w &optional status) "Show status in mode line." - (when (bufferp buffer) - (with-current-buffer buffer - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))))) + (when e-w + (setq flymake-mode-line-e-w e-w)) + (when status + (setq flymake-mode-line-status status)) + (let* ((mode-line " Flymake")) + (when (> (length flymake-mode-line-e-w) 0) + (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) + (setq mode-line (concat mode-line flymake-mode-line-status)) + (setq flymake-mode-line mode-line) + (force-mode-line-update))) (defun flymake-display-warning (warning) "Display a warning to user." @@ -1426,15 +1394,14 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." :group 'flymake :type 'boolean) -(defun flymake-report-fatal-status (buffer status warning) +(defun flymake-report-fatal-status (status warning) "Display a warning and switch flymake mode off." (when flymake-gui-warnings-enabled (flymake-display-warning (format "Flymake: %s. Flymake will be switched OFF" warning)) ) - (with-current-buffer buffer - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name buffer) status warning))) + (flymake-mode 0) + (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" + (buffer-name) status warning)) (defcustom flymake-start-syntax-check-on-find-file t "Start syntax check on find file." @@ -1458,13 +1425,13 @@ With arg, turn Flymake mode on if and only if arg is positive." (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - (flymake-report-status (current-buffer) "" "") + (flymake-report-status "" "") (setq flymake-timer (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) (when flymake-start-syntax-check-on-find-file - (flymake-start-syntax-check-for-current-buffer)))) + (flymake-start-syntax-check)))) ;; Turning the mode OFF. (t @@ -1473,7 +1440,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - (flymake-delete-own-overlays (current-buffer)) + (flymake-delete-own-overlays) (when flymake-timer (cancel-timer flymake-timer) @@ -1504,14 +1471,14 @@ With arg, turn Flymake mode on if and only if arg is positive." (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check-for-current-buffer)) + (flymake-start-syntax-check)) (setq flymake-last-change-time (flymake-float-time)))) (defun flymake-after-save-hook () (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? (progn (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check-for-current-buffer)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) (defun flymake-kill-buffer-hook () (when flymake-timer @@ -1521,7 +1488,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (defun flymake-find-file-hook () ;;+(when flymake-start-syntax-check-on-find-file ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check-for-current-buffer) + ;;+ (flymake-start-syntax-check) ;;+) (when (and (not (local-variable-p 'flymake-mode (current-buffer))) (flymake-can-syntax-check-file buffer-file-name)) @@ -1728,7 +1695,8 @@ Return full-name. Names are real, not patched." (if (not buildfile-dir) (progn (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status buffer "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name)) + (with-current-buffer buffer + (flymake-report-fatal-status "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name))) ) (progn (flymake-set-buffer-value buffer "base-dir" buildfile-dir))) @@ -1748,7 +1716,9 @@ Return full-name. Names are real, not patched." (if (not master-and-temp-master) (progn (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status buffer "!" "") ; NOMASTER + (when (bufferp buffer) + (with-current-buffer buffer + (flymake-report-status "!" ""))) ; NOMASTER ) (progn (setq master-file-name (nth 0 master-and-temp-master)) diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index 18f744e81c8..d19f636ff93 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -82,7 +82,7 @@ For example, you can set `glasses-separator' to an empty string and `glasses-face' to `bold'. Then unreadable identifiers will have no separators, but will have their capitals in bold." :group 'glasses - :type '(choice face (const nil)) + :type '(choice (const :tag "None" nil) face) :set 'glasses-custom-set :initialize 'custom-initialize-default) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index a9ccdf38442..e99262dd670 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -2735,6 +2735,7 @@ Obeying it means displaying in another window the specified file and line." (window (and buffer (or (get-buffer-window buffer) (display-buffer buffer)))) (pos)) + (message "%s %s" (current-buffer) buffer) (if buffer (progn (with-current-buffer buffer @@ -2750,7 +2751,15 @@ Obeying it means displaying in another window the specified file and line." (setq pos (point)) (or gud-overlay-arrow-position (setq gud-overlay-arrow-position (make-marker))) - (set-marker gud-overlay-arrow-position (point) (current-buffer))) + (set-marker gud-overlay-arrow-position (point) (current-buffer)) + ;; If they turned on hl-line, move the hl-line highlight to + ;; the arrow's line. + (when (featurep 'hl-line) + (cond + (global-hl-line-mode + (global-hl-line-highlight)) + ((and hl-line-mode hl-line-sticky-flag) + (hl-line-highlight))))) (cond ((or (< pos (point-min)) (> pos (point-max))) (widen) (goto-char pos)))) diff --git a/lisp/subr.el b/lisp/subr.el index c03fa3be5a0..a3e696d0e95 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -42,17 +42,15 @@ Each element of this list holds the arguments to one call to `defcustom'.") (defalias 'not 'null) (defmacro noreturn (form) - "Evaluates FORM, with the expectation that the evaluation will signal an error -instead of returning to its caller. If FORM does return, an error is -signaled." + "Evaluate FORM, expecting it not to return. +If FORM does return, signal an error." `(prog1 ,form (error "Form marked with `noreturn' did return"))) (defmacro 1value (form) - "Evaluates FORM, with the expectation that the same value will be returned -from all evaluations of FORM. This is the global do-nothing -version of `1value'. There is also `testcover-1value' that -complains if FORM ever does return differing values." + "Evaluate FORM, expecting a constant return value. +This is the global do-nothing version. There is also `testcover-1value' +that complains if FORM ever does return differing values." form) (defmacro lambda (&rest cdr) @@ -1686,7 +1684,7 @@ This finishes the change group by reverting all of its changes." (when (and (consp elt) (not (eq elt (last pending-undo-list)))) (error "Undoing to some unrelated state")) ;; Undo it all. - (while pending-undo-list (undo-more 1)) + (while (listp pending-undo-list) (undo-more 1)) ;; Reset the modified cons cell ELT to its original content. (when (consp elt) (setcar elt old-car) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 161b5fbc126..10b2ca206e9 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -853,7 +853,7 @@ The following is a complex example, see http://link.aps.org/linkfaq.html. :group 'bibtex :type 'boolean) -;; `bibtex-font-lock-keywords' is a user option as well, but since the +;; `bibtex-font-lock-keywords' is a user option, too. But since the ;; patterns used to define this variable are defined in a later ;; section of this file, it is defined later. @@ -1091,7 +1091,7 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") "Regexp matching the name of a BibTeX field.") (defconst bibtex-name-part - (concat ",[ \t\n]*\\(" bibtex-field-name "\\)[ \t\n]*=") + (concat ",[ \t\n]*\\(" bibtex-field-name "\\)") "Regexp matching the name part of a BibTeX field.") (defconst bibtex-reference-key "[][[:alnum:].:;?!`'/*@+|()<>&_^$-]+" @@ -1105,16 +1105,6 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (regexp-opt (mapcar 'car bibtex-entry-field-alist)) "\\)") "Regexp matching the name of a BibTeX entry.") -(defvar bibtex-entry-type-whitespace - (concat "[ \t]*" bibtex-entry-type) - "Regexp matching the name of a BibTeX entry preceded by whitespace.") - -(defvar bibtex-entry-type-str - (concat "@[ \t]*\\(?:" - (regexp-opt (append '("String") - (mapcar 'car bibtex-entry-field-alist))) "\\)") - "Regexp matching the name of a BibTeX entry (including @String).") - (defvar bibtex-entry-head (concat "^[ \t]*\\(" bibtex-entry-type @@ -1132,15 +1122,18 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") bibtex-reference-key "\\)?") "Regexp matching the header line of any BibTeX entry (possibly without key).") +(defvar bibtex-any-valid-entry-type + (concat "^[ \t]*@[ \t]*\\(?:" + (regexp-opt (append '("String" "Preamble") + (mapcar 'car bibtex-entry-field-alist))) "\\)") + "Regexp matching any valid BibTeX entry (including String and Preamble).") + (defconst bibtex-type-in-head 1 "Regexp subexpression number of the type part in `bibtex-entry-head'.") (defconst bibtex-key-in-head 2 "Regexp subexpression number of the key part in `bibtex-entry-head'.") -(defconst bibtex-empty-field-re "\\`\\(\"\"\\|{}\\)\\'" - "Regexp matching the text part (as a string) of an empty field.") - (defconst bibtex-string-type "^[ \t]*\\(@[ \t]*String\\)[ \t]*[({][ \t\n]*" "Regexp matching the name of a BibTeX String entry.") @@ -1148,8 +1141,9 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (concat bibtex-string-type "\\(" bibtex-reference-key "\\)?") "Regexp matching the header line of a BibTeX String entry.") -(defconst bibtex-preamble-prefix "[ \t]*@[ \t]*Preamble[ \t]*" - "Regexp matching the prefix part of a preamble.") +(defconst bibtex-preamble-prefix + "[ \t]*\\(@[ \t]*Preamble\\)[ \t]*[({][ \t\n]*" + "Regexp matching the prefix part of a BibTeX Preamble entry.") (defconst bibtex-font-lock-syntactic-keywords `((,(concat "^[ \t]*\\(" (substring bibtex-comment-start 0 1) "\\)" @@ -1229,12 +1223,9 @@ very first character of the match, the actual starting position of the name part and end position of the match. Move point to end of field name. If `bibtex-autoadd-commas' is non-nil add missing comma at end of preceding BibTeX field as necessary." - (cond ((looking-at ",[ \t\n]*") - (let ((start (point))) - (goto-char (match-end 0)) - (when (looking-at bibtex-field-name) - (goto-char (match-end 0)) - (list start (match-beginning 0) (match-end 0))))) + (cond ((looking-at bibtex-name-part) + (goto-char (match-end 0)) + (list (match-beginning 0) (match-beginning 1) (match-end 0))) ;; Maybe add a missing comma. ((and bibtex-autoadd-commas (looking-at (concat "[ \t\n]*\\(?:" bibtex-field-name @@ -1334,60 +1325,71 @@ the boundaries of the name and text parts of the field. Do not move point." "Search forward to find a BibTeX field of name NAME. If a syntactically correct field is found, return a pair containing the boundaries of the name and text parts of the field. The search -is limited by optional arg BOUND or if nil by the end of the current -entry. Do not move point." +is limited by optional arg BOUND. If BOUND is t the search is limited +by the end of the current entry. Do not move point." (save-match-data (save-excursion - (if bound - ;; If the search is bounded we need not worry we could overshoot. - ;; This is indeed the case when `bibtex-search-forward-field' is - ;; called many times. So we optimize this part of this function. - (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) - (case-fold-search t) left right) - (while (and (not right) - (re-search-forward name-part bound t)) - (setq left (list (match-beginning 0) (match-beginning 1) - (match-end 1)) - ;; Don't worry that the field text could be past bound. - right (bibtex-parse-field-text))) - (if right (cons left right))) - (let ((regexp (concat bibtex-name-part "\\|" - bibtex-any-entry-maybe-empty-head)) - (case-fold-search t) bounds) - (catch 'done - (if (looking-at "[ \t]*@") (goto-char (match-end 0))) - (while (and (not bounds) - (re-search-forward regexp nil t)) - (if (match-beginning 2) - ;; We found a new entry - (throw 'done nil) - ;; We found a field - (goto-char (match-beginning 0)) - (setq bounds (bibtex-parse-field)))) - ;; Step through all fields so that we cannot overshoot. - (while bounds - (goto-char (bibtex-start-of-name-in-field bounds)) - (if (looking-at name) (throw 'done bounds)) - (goto-char (bibtex-end-of-field bounds)) - (setq bounds (bibtex-parse-field))))))))) + (if (eq bound t) + (let ((regexp (concat bibtex-name-part "[ \t\n]*=\\|" + bibtex-any-entry-maybe-empty-head)) + (case-fold-search t) bounds) + (catch 'done + (if (looking-at "[ \t]*@") (goto-char (match-end 0))) + (while (and (not bounds) + (re-search-forward regexp nil t)) + (if (match-beginning 2) + ;; We found a new entry + (throw 'done nil) + ;; We found a field + (goto-char (match-beginning 0)) + (setq bounds (bibtex-parse-field)))) + ;; Step through all fields so that we cannot overshoot. + (while bounds + (goto-char (bibtex-start-of-name-in-field bounds)) + (if (looking-at name) (throw 'done bounds)) + (goto-char (bibtex-end-of-field bounds)) + (setq bounds (bibtex-parse-field))))) + ;; Bounded search or bound is nil (i.e. we cannot overshoot). + ;; Indeed, the search is bounded when `bibtex-search-forward-field' + ;; is called many times. So we optimize this part of this function. + (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) + (case-fold-search t) left right) + (while (and (not right) + (re-search-forward name-part bound t)) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1)) + ;; Don't worry that the field text could be past bound. + right (bibtex-parse-field-text))) + (if right (cons left right))))))) (defun bibtex-search-backward-field (name &optional bound) "Search backward to find a BibTeX field of name NAME. If a syntactically correct field is found, return a pair containing the boundaries of the name and text parts of the field. The search -is limited by the optional arg BOUND. If BOUND is nil the search is +is limited by the optional arg BOUND. If BOUND is t the search is limited by the beginning of the current entry. Do not move point." (save-match-data - (save-excursion - (let ((name-part (concat ",[ \t\n]*\\(?:" name "\\)[ \t\n]*=")) - (case-fold-search t) - bounds) - (unless bound (setq bound (save-excursion (bibtex-beginning-of-entry)))) - (while (and (not bounds) - (search-backward "," bound t) - (looking-at name-part)) - (setq bounds (bibtex-parse-field))) - bounds)))) + (if (eq bound t) + (setq bound (save-excursion (bibtex-beginning-of-entry)))) + (let ((name-part (concat ",[ \t\n]*\\(" name "\\)[ \t\n]*=[ \t\n]*")) + (case-fold-search t) left right) + (save-excursion + ;; the parsing functions are not designed for parsing backwards :-( + (when (search-backward "," bound t) + (or (save-excursion + (when (looking-at name-part) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1))) + (goto-char (match-end 0)) + (setq right (bibtex-parse-field-text)))) + (while (and (not right) + (re-search-backward name-part bound t)) + (setq left (list (match-beginning 0) (match-beginning 1) + (match-end 1))) + (save-excursion + (goto-char (match-end 0)) + (setq right (bibtex-parse-field-text))))) + (if right (cons left right))))))) (defun bibtex-name-in-field (bounds &optional remove-opt-alt) "Get content of name in BibTeX field defined via BOUNDS. @@ -1407,25 +1409,22 @@ by removing field delimiters and concatenating the resulting string. If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (if content (save-excursion + (goto-char (bibtex-start-of-text-in-field bounds)) (let ((epoint (bibtex-end-of-text-in-field bounds)) - content opoint temp) - (goto-char (bibtex-start-of-text-in-field bounds)) + content opoint) (while (< (setq opoint (point)) epoint) - (cond ((looking-at bibtex-field-const) - (let ((mtch (match-string-no-properties 0))) - (goto-char (match-end 0)) - (setq temp (if bibtex-expand-strings - (cdr (assoc-string mtch (bibtex-strings) t))) - content (concat content (or temp mtch))))) - - ((setq temp (bibtex-parse-field-string)) - (setq content (concat content (buffer-substring-no-properties - (1+ (car temp)) - (1- (cdr temp))))) - (goto-char (cdr temp))) - (t (error "Malformed text field"))) + (if (looking-at bibtex-field-const) + (let ((mtch (match-string-no-properties 0))) + (push (or (if bibtex-expand-strings + (cdr (assoc-string mtch (bibtex-strings) t))) + mtch) content) + (goto-char (match-end 0))) + (let ((bounds (bibtex-parse-field-string))) + (push (buffer-substring-no-properties + (1+ (car bounds)) (1- (cdr bounds))) content) + (goto-char (cdr bounds)))) (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t)) - content)) + (apply 'concat (nreverse content)))) (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)))) @@ -1434,19 +1433,15 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." Return nil if not found. If optional arg FOLLOW-CROSSREF is non-nil, follow crossref." (save-excursion - (save-restriction - ;; We want to jump back and forth while searching FIELD - (bibtex-narrow-to-entry) - (goto-char (point-min)) - (let ((bounds (bibtex-search-forward-field field (point-max))) - crossref-field) - (cond (bounds (bibtex-text-in-field-bounds bounds t)) - ((and follow-crossref - (progn (goto-char (point-min)) - (setq bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref" (point-max))))) - (setq crossref-field (bibtex-text-in-field-bounds bounds t)) - (widen) + (let* ((end (if follow-crossref (bibtex-end-of-entry) t)) + (beg (bibtex-beginning-of-entry)) ; move point + (bounds (bibtex-search-forward-field field end))) + (cond (bounds (bibtex-text-in-field-bounds bounds t)) + ((and follow-crossref + (progn (goto-char beg) + (setq bounds (bibtex-search-forward-field + "\\(OPT\\)?crossref" end)))) + (let ((crossref-field (bibtex-text-in-field-bounds bounds t))) (if (bibtex-find-crossref crossref-field) ;; Do not pass FOLLOW-CROSSREF because we want ;; to follow crossrefs only one level of recursion. @@ -1487,42 +1482,28 @@ character of the string entry. Move point past BibTeX string entry." (nth 1 bounds) (match-end 0)))))) -(defun bibtex-parse-string () +(defun bibtex-parse-string (&optional empty-key) "Parse a BibTeX string entry beginning at the position of point. If a syntactically correct entry is found, return a cons pair containing the boundaries of the reference key and text parts of the entry. -Do not move point." - (bibtex-parse-association 'bibtex-parse-string-prefix - 'bibtex-parse-string-postfix)) +If EMPTY-KEY is non-nil, key may be empty. Do not move point." + (let ((bibtex-string-empty-key empty-key)) + (bibtex-parse-association 'bibtex-parse-string-prefix + 'bibtex-parse-string-postfix))) -(defun bibtex-search-forward-string () +(defun bibtex-search-forward-string (&optional empty-key) "Search forward to find a BibTeX string entry. If a syntactically correct entry is found, a pair containing the boundaries of -the reference key and text parts of the string is returned. Do not move point." +the reference key and text parts of the string is returned. +If EMPTY-KEY is non-nil, key may be empty. Do not move point." (save-excursion (save-match-data - (let ((case-fold-search t) - boundaries) - (while (and (not boundaries) + (let ((case-fold-search t) bounds) + (while (and (not bounds) (search-forward-regexp bibtex-string-type nil t)) - (goto-char (match-beginning 0)) - (unless (setq boundaries (bibtex-parse-string)) - (forward-char 1))) - boundaries)))) - -(defun bibtex-search-backward-string () - "Search backward to find a BibTeX string entry. -If a syntactically correct entry is found, a pair containing the boundaries of -the reference key and text parts of the field is returned. Do not move point." - (save-excursion - (save-match-data - (let ((case-fold-search t) - boundaries) - (while (and (not boundaries) - (search-backward-regexp bibtex-string-type nil t)) - (goto-char (match-beginning 0)) - (setq boundaries (bibtex-parse-string))) - boundaries)))) + (save-excursion (goto-char (match-beginning 0)) + (setq bounds (bibtex-parse-string empty-key)))) + bounds)))) (defun bibtex-reference-key-in-string (bounds) "Return the key part of a BibTeX string defined via BOUNDS" @@ -1554,14 +1535,15 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (or (match-string-no-properties bibtex-key-in-head) empty)) -(defun bibtex-preamble-prefix (&optional delim) - "Parse the prefix part of a BibTeX Preamble. -Point must be at beginning of prefix part. If prefix is found move point -to its end and return position of point. If optional arg DELIM is non-nil, -move past the opening delimiter. If no preamble is found return nil." +(defun bibtex-parse-preamble () + "Parse BibTeX preamble. +Point must be at beginning of preamble. Do not move point." (let ((case-fold-search t)) - (re-search-forward (concat "\\=" bibtex-preamble-prefix - (if delim "[({][ \t\n]*")) nil t))) + (when (looking-at bibtex-preamble-prefix) + (let ((start (match-beginning 0)) (pref-start (match-beginning 1)) + (bounds (save-excursion (goto-char (match-end 0)) + (bibtex-parse-string-postfix)))) + (if bounds (cons (list start pref-start) bounds)))))) ;; Helper Functions @@ -1579,6 +1561,35 @@ move past the opening delimiter. If no preamble is found return nil." (+ (count-lines 1 (point)) (if (bolp) 1 0))) +(defun bibtex-valid-entry (&optional empty-key) + "Parse a valid BibTeX entry (maybe without key if EMPTY-KEY is t). +A valid entry is a syntactical correct one with type contained in +`bibtex-entry-field-alist'. Ignore @String and @Preamble entries. +Return a cons pair with buffer positions of beginning and end of entry +if a valid entry is found, nil otherwise. Do not move point. +After a call to this function `match-data' corresponds to the header +of the entry, see regexp `bibtex-entry-head'." + (let ((case-fold-search t) end) + (if (looking-at (if empty-key bibtex-entry-maybe-empty-head + bibtex-entry-head)) + (save-excursion + (save-match-data + (goto-char (match-end 0)) + (let ((entry-closer + (if (save-excursion + (goto-char (match-end bibtex-type-in-head)) + (looking-at "[ \t]*(")) + ",?[ \t\n]*)" ;; entry opened with `(' + ",?[ \t\n]*}")) ;; entry opened with `{' + bounds) + (skip-chars-forward " \t\n") + ;; loop over all BibTeX fields + (while (setq bounds (bibtex-parse-field)) + (goto-char (bibtex-end-of-field bounds))) + ;; This matches the infix* part. + (if (looking-at entry-closer) (setq end (match-end 0))))) + (if end (cons (match-beginning 0) end)))))) + (defun bibtex-skip-to-valid-entry (&optional backward) "Move point to beginning of the next valid BibTeX entry. Do not move if we are already at beginning of a valid BibTeX entry. @@ -1590,32 +1601,27 @@ entry. Return buffer position of beginning and end of entry if a valid entry is found, nil otherwise." (interactive "P") (let ((case-fold-search t) - found) + found bounds) (beginning-of-line) ;; Loop till we look at a valid entry. (while (not (or found (if backward (bobp) (eobp)))) - (let ((pnt (point)) - bounds) - (cond ((or (and (looking-at bibtex-entry-type-whitespace) - (setq found (bibtex-search-entry nil nil t)) - (equal (match-beginning 0) pnt)) - (and (not bibtex-sort-ignore-string-entries) - (setq bounds (bibtex-parse-string)) - (setq found (cons (bibtex-start-of-field bounds) - (bibtex-end-of-string bounds))))) - (goto-char pnt)) - (backward (re-search-backward "^[ \t]*@" nil 'move)) - (t (re-search-forward "\\=[ \t]*@" nil t) ;; don't be stuck - (if (re-search-forward "^[ \t]*@" nil 'move) - (goto-char (match-beginning 0))))))) + (cond ((setq found (or (bibtex-valid-entry) + (and (not bibtex-sort-ignore-string-entries) + (setq bounds (bibtex-parse-string)) + (cons (bibtex-start-of-field bounds) + (bibtex-end-of-string bounds)))))) + (backward (re-search-backward "^[ \t]*@" nil 'move)) + (t (if (re-search-forward "\n\\([ \t]*@\\)" nil 'move) + (goto-char (match-beginning 1)))))) found)) (defun bibtex-map-entries (fun) "Call FUN for each BibTeX entry in buffer (possibly narrowed). FUN is called with three arguments, the key of the entry and the buffer -positions (marker) of beginning and end of entry. Point is inside the entry. -If `bibtex-sort-ignore-string-entries' is non-nil, FUN is not called for -@String entries." +positions of beginning and end of entry. Also, point is at beginning of +entry and `match-data' corresponds to the header of the entry, +see regexp `bibtex-entry-head'. If `bibtex-sort-ignore-string-entries' +is non-nil, FUN is not called for @String entries." (let ((case-fold-search t) found) (save-excursion @@ -1673,75 +1679,19 @@ If FLAG is nil, a message is echoed if point was incremented at least "}" ")")) -(defun bibtex-search-entry (empty-head &optional bound noerror backward) - "Search for a BibTeX entry (maybe without reference key if EMPTY-HEAD is t). -BOUND and NOERROR are exactly as in `re-search-forward'. If BACKWARD -is non-nil, search in reverse direction. Move point past the closing -delimiter (at the beginning of entry if BACKWARD is non-nil). -Return a cons pair with buffer positions of beginning and end of entry. -After a call to this function `match-data' corresponds to the head part -of the entry, see regexp `bibtex-entry-head'. -Ignore @String and @Preamble entries." - (let ((pnt (point)) - (entry-head-re (if empty-head - bibtex-entry-maybe-empty-head - bibtex-entry-head))) - (if backward - (let (found) - (while (and (not found) - (re-search-backward entry-head-re bound noerror)) - (setq found (bibtex-search-entry empty-head pnt t))) - (cond (found - (goto-char (match-beginning 0)) - found) - ((not noerror) ;; yell - (error "Backward search of BibTeX entry failed")) - (t (if (eq noerror t) (goto-char pnt)) ;; don't move - nil))) - (let (found) - (unless bound (setq bound (point-max))) - (while (and (not found) - (re-search-forward entry-head-re bound noerror)) - (save-match-data - (let ((entry-closer - (if (save-excursion - (goto-char (match-end bibtex-type-in-head)) - (looking-at "[ \t]*(")) - ",?[ \t\n]*)" ;; entry opened with `(' - ",?[ \t\n]*}")) ;; entry opened with `{' - bounds) - (skip-chars-forward " \t\n" bound) - ;; loop over all BibTeX fields - (while (and (setq bounds (bibtex-parse-field)) - (<= (bibtex-end-of-field bounds) bound)) - (goto-char (bibtex-end-of-field bounds))) - ;; This matches the infix* part. - (when (and (looking-at entry-closer) - (<= (match-end 0) bound)) - (goto-char (match-end 0)) - (setq found t))))) - (cond (found - (cons (match-beginning 0) (point))) - ((not noerror) ;; yell - (error "Search of BibTeX entry failed")) - (t (if (eq noerror t) (goto-char pnt)) ;; don't move - nil)))))) - -(defun bibtex-flash-head () +(defun bibtex-flash-head (prompt) "Flash at BibTeX entry head before point, if exists." (let ((case-fold-search t) - (pnt (point)) - flash) + (pnt (point))) (save-excursion (bibtex-beginning-of-entry) (when (and (looking-at bibtex-any-entry-maybe-empty-head) (< (point) pnt)) (goto-char (match-beginning bibtex-type-in-head)) - (setq flash (match-end bibtex-key-in-head)) (if (pos-visible-in-window-p (point)) (sit-for 1) - (message "From: %s" - (buffer-substring (point) flash))))))) + (message "%s%s" prompt (buffer-substring-no-properties + (point) (match-end bibtex-key-in-head)))))))) (defun bibtex-make-optional-field (field) "Make an optional field named FIELD in current BibTeX entry." @@ -1772,66 +1722,55 @@ are ignored. Return point" (bibtex-skip-to-valid-entry) (point)) -(defun bibtex-inside-field () - "Try to avoid point being at end of a BibTeX field." - (end-of-line) - (skip-chars-backward " \t") - (if (= (preceding-char) ?,) - (forward-char -2)) - (if (or (= (preceding-char) ?}) - (= (preceding-char) ?\")) - (forward-char -1))) - -(defun bibtex-enclosing-field (&optional noerr) +(defun bibtex-enclosing-field (&optional comma noerr) "Search for BibTeX field enclosing point. +For `bibtex-mode''s internal algorithms, a field begins at the comma +following the preceding field. Usually, this is not what the user expects. +Thus if COMMA is non-nil, the \"current field\" includes the terminating comma. Unless NOERR is non-nil, signal an error if no enclosing field is found. On success return bounds, nil otherwise. Do not move point." - (let ((bounds (bibtex-search-backward-field bibtex-field-name))) - (if (and bounds - (<= (bibtex-start-of-field bounds) (point)) - (>= (bibtex-end-of-field bounds) (point))) - bounds - (unless noerr - (error "Can't find enclosing BibTeX field"))))) - -(defun bibtex-enclosing-entry-maybe-empty-head () - "Search for BibTeX entry enclosing point. Move point to end of entry. -Beginning (but not end) of entry is given by (`match-beginning' 0)." - (let ((case-fold-search t) - (old-point (point))) - (unless (re-search-backward bibtex-entry-maybe-empty-head nil t) - (goto-char old-point) - (error "Can't find beginning of enclosing BibTeX entry")) - (goto-char (match-beginning bibtex-type-in-head)) - (unless (bibtex-search-entry t nil t) - (goto-char old-point) - (error "Can't find end of enclosing BibTeX entry")))) - -(defun bibtex-insert-kill (n) - "Reinsert the Nth stretch of killed BibTeX text." - (if (not bibtex-last-kill-command) - (error "BibTeX kill ring is empty") - (let* ((kr (if (eq bibtex-last-kill-command 'field) - 'bibtex-field-kill-ring - 'bibtex-entry-kill-ring)) - (kryp (if (eq bibtex-last-kill-command 'field) - 'bibtex-field-kill-ring-yank-pointer - 'bibtex-entry-kill-ring-yank-pointer)) - (current (car (set kryp (nthcdr (mod (- n (length (eval kryp))) - (length (eval kr))) - (eval kr)))))) - (if (eq bibtex-last-kill-command 'field) - (progn - (bibtex-find-text) - (if (looking-at "[}\"]") - (forward-char)) - (set-mark (point)) - (message "Mark set") - (bibtex-make-field current t)) - (unless (eobp) (bibtex-beginning-of-entry)) - (set-mark (point)) - (message "Mark set") - (insert current))))) + (save-excursion + (when comma + (end-of-line) + (skip-chars-backward " \t") + (if (= (preceding-char) ?,) (forward-char -1))) + + (let ((bounds (bibtex-search-backward-field bibtex-field-name t))) + (cond ((and bounds + (<= (bibtex-start-of-field bounds) (point)) + (>= (bibtex-end-of-field bounds) (point))) + bounds) + ((not noerr) + (error "Can't find enclosing BibTeX field")))))) + +(defun bibtex-beginning-first-field (&optional beg) + "Move point to beginning of first field. +Optional arg BEG is beginning of entry." + (if beg (goto-char beg) (bibtex-beginning-of-entry)) + (looking-at bibtex-any-entry-maybe-empty-head) + (goto-char (match-end 0))) + +(defun bibtex-insert-kill (n &optional comma) + "Reinsert the Nth stretch of killed BibTeX text (field or entry). +Optional arg COMMA is as in `bibtex-enclosing-field'." + (unless bibtex-last-kill-command (error "BibTeX kill ring is empty")) + (let ((fun (lambda (kryp kr) ;; adapted from `current-kill' + (car (set kryp (nthcdr (mod (- n (length (eval kryp))) + (length kr)) kr)))))) + (if (eq bibtex-last-kill-command 'field) + (progn + ;; insert past the current field + (goto-char (bibtex-end-of-field (bibtex-enclosing-field comma))) + (set-mark (point)) + (message "Mark set") + (bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer + bibtex-field-kill-ring) t)) + ;; insert past the current entry + (bibtex-skip-to-valid-entry) + (set-mark (point)) + (message "Mark set") + (insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer + bibtex-entry-kill-ring))))) (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. @@ -1900,9 +1839,8 @@ Formats current entry according to variable `bibtex-entry-format'." (error "All alternatives are empty")) ;; process all fields - (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name (point-max))) + (bibtex-beginning-first-field (point-min)) + (while (setq bounds (bibtex-parse-field)) (let* ((beg-field (copy-marker (bibtex-start-of-field bounds))) (end-field (copy-marker (bibtex-end-of-field bounds) t)) (beg-name (copy-marker (bibtex-start-of-name-in-field bounds))) @@ -2040,10 +1978,6 @@ Formats current entry according to variable `bibtex-entry-format'." (error "Alternative fields `%s' are defined %s times" altlist found)))))) - ;; update point - (if (looking-at (bibtex-field-right-delimiter)) - (forward-char)) - ;; update comma after last field (if (memq 'last-comma format) (cond ((and bibtex-comma-after-last-field @@ -2536,6 +2470,7 @@ already set." "Complete word fragment before point to longest prefix of COMPLETIONS. COMPLETIONS is an alist of strings. If point is not after the part of a word, all strings are listed. Return completion." + ;; Return value is used by cleanup functions. (let* ((case-fold-search t) (beg (save-excursion (re-search-backward "[ \t{\"]") @@ -2558,13 +2493,13 @@ of a word, all strings are listed. Return completion." (display-completion-list (all-completions part-of-word completions) part-of-word)) (message "Making completion list...done") - ;; return value is handled by choose-completion-string-functions nil)))) (defun bibtex-complete-string-cleanup (str compl) "Cleanup after inserting string STR. Remove enclosing field delimiters for STR. Display message with expansion of STR using expansion list COMPL." + ;; point is at position inside field where completion was requested (save-excursion (let ((abbr (cdr (if (stringp str) (assoc-string str compl t))))) @@ -2624,50 +2559,52 @@ Used as default value of `bibtex-summary-function'." (defun bibtex-pop (arg direction) "Fill current field from the ARGth same field's text in DIRECTION. Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." - (bibtex-find-text) - (save-excursion - ;; parse current field - (bibtex-inside-field) - (let* ((case-fold-search t) - (bounds (bibtex-enclosing-field)) - (start-old-text (bibtex-start-of-text-in-field bounds)) - (stop-old-text (bibtex-end-of-text-in-field bounds)) - (field-name (bibtex-name-in-field bounds t))) + ;; parse current field + (let* ((bounds (bibtex-enclosing-field t)) + (start-old-field (bibtex-start-of-field bounds)) + (start-old-text (bibtex-start-of-text-in-field bounds)) + (end-old-text (bibtex-end-of-text-in-field bounds)) + (field-name (bibtex-name-in-field bounds t)) + failure) + (save-excursion ;; if executed several times in a row, start each search where ;; the last one was finished - (unless (eq last-command 'bibtex-pop) - (bibtex-enclosing-entry-maybe-empty-head) - (setq bibtex-pop-previous-search-point (match-beginning 0) - bibtex-pop-next-search-point (point))) - (if (eq direction 'previous) - (goto-char bibtex-pop-previous-search-point) - (goto-char bibtex-pop-next-search-point)) - ;; Now search for arg'th previous/next similar field - (let (bounds failure new-text) - (while (and (not failure) - (> arg 0)) - (cond ((eq direction 'previous) - (if (setq bounds (bibtex-search-backward-field field-name)) - (goto-char (bibtex-start-of-field bounds)) - (setq failure t))) - ((eq direction 'next) - (if (setq bounds (bibtex-search-forward-field field-name)) - (goto-char (bibtex-end-of-field bounds)) - (setq failure t)))) - (setq arg (- arg 1))) - (if failure - (error "No %s matching BibTeX field" - (if (eq direction 'previous) "previous" "next")) - ;; Found a matching field. Remember boundaries. - (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds) - bibtex-pop-next-search-point (bibtex-end-of-field bounds) - new-text (bibtex-text-in-field-bounds bounds)) - (bibtex-flash-head) + (cond ((eq last-command 'bibtex-pop) + (goto-char (if (eq direction 'previous) + bibtex-pop-previous-search-point + bibtex-pop-next-search-point))) + ((eq direction 'previous) + (bibtex-beginning-of-entry)) + (t (bibtex-end-of-entry))) + ;; Search for arg'th previous/next similar field + (while (and (not failure) + (>= (setq arg (1- arg)) 0)) + ;; The search of BibTeX fields is not bounded by entry boundaries + (if (eq direction 'previous) + (if (setq bounds (bibtex-search-backward-field field-name)) + (goto-char (bibtex-start-of-field bounds)) + (setq failure t)) + (if (setq bounds (bibtex-search-forward-field field-name)) + (goto-char (bibtex-end-of-field bounds)) + (setq failure t)))) + (if failure + (error "No %s matching BibTeX field" + (if (eq direction 'previous) "previous" "next")) + ;; Found a matching field. Remember boundaries. + (let ((new-text (bibtex-text-in-field-bounds bounds)) + (nbeg (copy-marker (bibtex-start-of-field bounds))) + (nend (copy-marker (bibtex-end-of-field bounds)))) + (bibtex-flash-head "From: ") ;; Go back to where we started, delete old text, and pop new. - (goto-char stop-old-text) - (delete-region start-old-text stop-old-text) - (insert new-text))))) - (bibtex-find-text) + (goto-char end-old-text) + (delete-region start-old-text end-old-text) + (if (= nbeg start-old-field) + (insert (bibtex-field-left-delimiter) + (bibtex-field-right-delimiter)) + (insert new-text)) + (setq bibtex-pop-previous-search-point (marker-position nbeg) + bibtex-pop-next-search-point (marker-position nend)))))) + (bibtex-find-text nil nil nil t) (setq this-command 'bibtex-pop)) (defun bibtex-beginning-of-field () @@ -2846,6 +2783,7 @@ if that value is non-nil. (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t) (make-local-variable 'choose-completion-string-functions) + (make-local-variable 'completion-ignore-case) ;; XEmacs needs easy-menu-add, Emacs does not care (easy-menu-add bibtex-edit-menu) (easy-menu-add bibtex-entry-menu) @@ -2861,7 +2799,7 @@ and `bibtex-user-optional-fields'." (let ((e (assoc-string entry-type bibtex-entry-field-alist t)) required optional) (unless e - (error "BibTeX entry type %s not defined" entry-type)) + (error "Fields for BibTeX entry type %s not defined" entry-type)) (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref) (nth 2 e)) (setq required (nth 0 (nth 2 e)) @@ -2918,10 +2856,11 @@ according to `bibtex-field-list', but are not yet present." (save-excursion (bibtex-beginning-of-entry) ;; For inserting new fields, we use the fact that - ;; bibtex-parse-entry moves point to the end of the last field. + ;; `bibtex-parse-entry' moves point to the end of the last field. (let* ((fields-alist (bibtex-parse-entry)) (field-list (bibtex-field-list (cdr (assoc "=type=" fields-alist))))) + (skip-chars-backward " \t\n") (dolist (field (car field-list)) (unless (assoc-string (car field) fields-alist t) (bibtex-make-field field))) @@ -2964,6 +2903,7 @@ entry (for example, the year parts of the keys)." (key (bibtex-key-in-head)) (key-end (match-end bibtex-key-in-head)) (case-fold-search t) + (bibtex-sort-ignore-string-entries t) tmp other-key other bounds) ;; The fields we want to change start right after the key. (goto-char key-end) @@ -3016,28 +2956,28 @@ entry (for example, the year parts of the keys)." (while (re-search-backward (regexp-quote other-suffix) key-end 'move) (replace-match suffix))))))) -(defun bibtex-print-help-message () - "Print helpful information about current field in current BibTeX entry." - (interactive) - (let* ((case-fold-search t) - (type (save-excursion - (bibtex-beginning-of-entry) - (looking-at bibtex-any-entry-maybe-empty-head) - (bibtex-type-in-head))) - comment field-list) - (cond ((bibtex-string= type "string") - (message "String definition")) - ((bibtex-string= type "preamble") - (message "Preamble definition")) - (t - (setq field-list (bibtex-field-list type) - comment - (assoc-string (bibtex-name-in-field (bibtex-enclosing-field) t) - (append (car field-list) (cdr field-list)) - t)) - (if comment - (message "%s" (nth 1 comment)) - (message "No comment available")))))) +(defun bibtex-print-help-message (&optional field comma) + "Print helpful information about current FIELD in current BibTeX entry. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list nil t)) + (unless field (setq field (car (bibtex-find-text-internal nil nil comma)))) + (if (string-match "@" field) + (cond ((bibtex-string= field "@string") + (message "String definition")) + ((bibtex-string= field "@preamble") + (message "Preamble definition")) + (t (message "Entry key"))) + (let* ((case-fold-search t) + (type (save-excursion + (bibtex-beginning-of-entry) + (looking-at bibtex-entry-maybe-empty-head) + (bibtex-type-in-head))) + (field-list (bibtex-field-list type)) + (comment (assoc-string field (append (car field-list) + (cdr field-list)) t))) + (if comment (message "%s" (nth 1 comment)) + (message "No comment available"))))) (defun bibtex-make-field (field &optional move interactive) "Make a field named FIELD in current BibTeX entry. @@ -3052,7 +2992,8 @@ MOVE and INTERACTIVE are t when called interactively." (list (let ((completion-ignore-case t) (field-list (bibtex-field-list (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-beginning-of-entry) + (looking-at bibtex-any-entry-maybe-empty-head) (bibtex-type-in-head))))) (completing-read "BibTeX field name: " (append (car field-list) (cdr field-list)) @@ -3081,8 +3022,9 @@ MOVE and INTERACTIVE are t when called interactively." (t (concat (bibtex-field-left-delimiter) (bibtex-field-right-delimiter)))))) (when interactive - (forward-char -1) - (bibtex-print-help-message))) + ;; (bibtex-find-text nil nil bibtex-help-message) + (if (memq (preceding-char) '(?} ?\")) (forward-char -1)) + (if bibtex-help-message (bibtex-print-help-message (car field))))) (defun bibtex-beginning-of-entry () "Move to beginning of BibTeX entry (beginning of line). @@ -3103,28 +3045,19 @@ of the previous entry. Do not move if ahead of first entry. Return the new location of point." (interactive) (let ((case-fold-search t) - (org (point)) - (pnt (bibtex-beginning-of-entry)) - err bounds) - (cond ((looking-at bibtex-entry-type-whitespace) - (bibtex-search-entry t nil t) - (unless (equal (match-beginning 0) pnt) - (setq err t))) - ;; @String - ((setq bounds (bibtex-parse-string)) + (pnt (point)) + (_ (bibtex-beginning-of-entry)) + (bounds (bibtex-valid-entry t))) + (cond (bounds (goto-char (cdr bounds))) ; regular entry + ;; @String or @Preamble + ((setq bounds (or (bibtex-parse-string t) (bibtex-parse-preamble))) (goto-char (bibtex-end-of-string bounds))) - ;; @Preamble - ((bibtex-preamble-prefix t) - (unless (bibtex-parse-string-postfix) ;; @String postfix OK - (setq err t))) - (t - (if (interactive-p) - (message "Not on a known BibTeX entry.")) - (goto-char org))) - (when err - (goto-char pnt) - (error "Syntactically incorrect BibTeX entry starts here"))) - (point)) + ((looking-at bibtex-any-valid-entry-type) + ;; Parsing of entry failed + (error "Syntactically incorrect BibTeX entry starts here.")) + (t (if (interactive-p) (message "Not on a known BibTeX entry.")) + (goto-char pnt))) + (point))) (defun bibtex-goto-line (arg) "Goto line ARG, counting from beginning of (narrowed) buffer." @@ -3188,7 +3121,7 @@ If mark is active count entries in region, if not in whole buffer." (interactive) (let ((bounds (save-excursion (bibtex-beginning-of-entry) - (bibtex-search-forward-field "abstract")))) + (bibtex-search-forward-field "abstract" t)))) (if bounds (ispell-region (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)) @@ -3216,7 +3149,7 @@ of the head of the entry found. Return nil if no entry found." ;; Don't search CROSSREF-KEY if we don't need it. (if (eq bibtex-maintain-sorted-entries 'crossref) (let ((bounds (bibtex-search-forward-field - "\\(OPT\\)?crossref"))) + "\\(OPT\\)?crossref" t))) (list key (if bounds (bibtex-text-in-field-bounds bounds t)) entry-name)) @@ -3283,7 +3216,7 @@ entry and SPLIT is t." (let ((crossref-key (save-excursion (bibtex-beginning-of-entry) - (let ((bounds (bibtex-search-forward-field "crossref"))) + (let ((bounds (bibtex-search-forward-field "crossref" t))) (if bounds (bibtex-text-in-field-bounds bounds t)))))) (list (bibtex-read-key "Find crossref key: " crossref-key t) @@ -3429,40 +3362,38 @@ Return t if test was successful, nil otherwise." error-list syntax-error) (save-excursion (save-restriction - (if mark-active - (narrow-to-region (region-beginning) (region-end))) + (if mark-active (narrow-to-region (region-beginning) (region-end))) - ;; looking if entries fit syntactical structure + ;; Check syntactical structure of entries (goto-char (point-min)) (bibtex-progress-message "Checking syntactical structure") - (let (bibtex-sort-ignore-string-entries) - (while (re-search-forward "^[ \t]*@" nil t) + (let (bounds end) + (while (setq end (re-search-forward "^[ \t]*@" nil t)) (bibtex-progress-message) - (forward-char -1) - (let ((pnt (point))) - (if (not (looking-at bibtex-entry-type-str)) - (forward-char) - (bibtex-skip-to-valid-entry) - (if (equal (point) pnt) - (forward-char) - (goto-char pnt) - (push (cons (bibtex-current-line) - "Syntax error (check esp. commas, braces, and quotes)") - error-list) - (forward-char)))))) + (goto-char (match-beginning 0)) + (cond ((setq bounds (bibtex-valid-entry)) + (goto-char (cdr bounds))) + ((setq bounds (or (bibtex-parse-string) + (bibtex-parse-preamble))) + (goto-char (bibtex-end-of-string bounds))) + ((looking-at bibtex-any-valid-entry-type) + (push (cons (bibtex-current-line) + "Syntax error (check esp. commas, braces, and quotes)") + error-list) + (goto-char (match-end 0))) + (t (goto-char end))))) (bibtex-progress-message 'done) (if error-list - ;; proceed only if there were no syntax errors. + ;; Continue only if there were no syntax errors. (setq syntax-error t) - ;; looking for duplicate keys and correct sort order + ;; Check for duplicate keys and correct sort order (let (previous current key-list) (bibtex-progress-message "Checking for duplicate keys") (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (goto-char beg) (setq current (bibtex-entry-index)) (cond ((not previous)) ((member key key-list) @@ -3498,18 +3429,13 @@ Return t if test was successful, nil otherwise." (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (let* ((entry-list (progn - (goto-char beg) - (bibtex-search-entry nil end) - (assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t))) + (let* ((entry-list (assoc-string (bibtex-type-in-head) + bibtex-entry-field-alist t)) (req (copy-sequence (elt (elt entry-list 1) 0))) (creq (copy-sequence (elt (elt entry-list 2) 0))) crossref-there bounds alt-there field) - (goto-char beg) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name end)) - (goto-char (bibtex-start-of-text-in-field bounds)) + (bibtex-beginning-first-field beg) + (while (setq bounds (bibtex-parse-field)) (let ((field-name (bibtex-name-in-field bounds))) (if (and (bibtex-string= field-name "month") ;; Check only abbreviated month fields. @@ -3521,18 +3447,19 @@ Return t if test was successful, nil otherwise." (push (cons (bibtex-current-line) "Questionable month field") error-list)) - (setq field (assoc-string field-name req t)) + (setq field (assoc-string field-name req t) + req (delete field req) + creq (delete (assoc-string field-name creq t) creq)) (if (nth 3 field) - (if alt-there (push (cons (bibtex-current-line) - "More than one non-empty alternative") - error-list) + (if alt-there + (push (cons (bibtex-current-line) + "More than one non-empty alternative") + error-list) (setq alt-there t))) - (setq req (delete field req) - creq (delete (assoc-string field-name creq t) creq)) (if (bibtex-string= field-name "crossref") - (setq crossref-there t)))) - (if crossref-there - (setq req creq)) + (setq crossref-there t))) + (goto-char (bibtex-end-of-field bounds))) + (if crossref-there (setq req creq)) (let (alt) (dolist (field req) (if (nth 3 field) @@ -3573,11 +3500,10 @@ Return t if test was successful, nil otherwise." (toggle-read-only 1) (goto-line 3)) ; first error message (display-buffer err-buf) - ;; return nil - nil) + nil) ; return `nil' (i.e., buffer is invalid) (message "%s is syntactically correct" (if mark-active "Region" "Buffer")) - t))) + t))) ; return `t' (i.e., buffer is valid) (defun bibtex-validate-globally (&optional strings) "Check for duplicate keys in `bibtex-files'. @@ -3631,37 +3557,41 @@ Return t if test was successful, nil otherwise." (toggle-read-only 1) (goto-line 3)) ; first error message (display-buffer err-buf) - ;; return nil - nil) + nil) ; return `nil' (i.e., buffer is invalid) (message "No duplicate keys.") - t))) - -(defun bibtex-next-field (begin) - "Move point to end of text of next BibTeX field. -With prefix BEGIN non-nil, move point to its beginning." - (interactive "P") - (bibtex-inside-field) - (let ((start (point))) - (condition-case () - (let ((bounds (bibtex-enclosing-field))) - (goto-char (bibtex-end-of-field bounds)) - (forward-char 2)) - (error - (goto-char start) - (end-of-line) - (forward-char)))) - (bibtex-find-text begin nil bibtex-help-message)) - -(defun bibtex-find-text (&optional begin noerror help) - "Move point to end of text of current BibTeX field. + t))) ; return `t' (i.e., buffer is valid) + +(defun bibtex-next-field (begin &optional comma) + "Move point to end of text of next BibTeX field or entry head. +With prefix BEGIN non-nil, move point to its beginning. Optional arg COMMA +is as in `bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list current-prefix-arg t)) + (let ((bounds (bibtex-find-text-internal t nil comma)) + end-of-entry) + (if (not bounds) + (setq end-of-entry t) + (goto-char (nth 3 bounds)) + (if (assoc-string (car bounds) '("@String" "@Preamble") t) + (setq end-of-entry t) + ;; BibTeX key or field + (if (looking-at ",[ \t\n]*") (goto-char (match-end 0))) + ;; end of entry + (if (looking-at "[)}][ \t\n]*") (setq end-of-entry t)))) + (if (and end-of-entry + (re-search-forward bibtex-any-entry-maybe-empty-head nil t)) + (goto-char (match-beginning 0))) + (bibtex-find-text begin nil bibtex-help-message))) + +(defun bibtex-find-text (&optional begin noerror help comma) + "Move point to end of text of current BibTeX field or entry head. With optional prefix BEGIN non-nil, move point to its beginning. Unless NOERROR is non-nil, an error is signaled if point is not on a BibTeX field. If optional arg HELP is non-nil print help message. -When called interactively, the value of HELP is `bibtex-help-message'." - (interactive (list current-prefix-arg nil bibtex-help-message)) - (let ((pnt (point)) - (bounds (bibtex-find-text-internal))) - (beginning-of-line) +When called interactively, the value of HELP is `bibtex-help-message'. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list current-prefix-arg nil bibtex-help-message t)) + (let ((bounds (bibtex-find-text-internal t nil comma))) (cond (bounds (if begin (progn (goto-char (nth 1 bounds)) @@ -3670,72 +3600,88 @@ When called interactively, the value of HELP is `bibtex-help-message'." (goto-char (nth 2 bounds)) (if (memq (preceding-char) '(?} ?\")) (forward-char -1))) - (if help (bibtex-print-help-message))) - ((looking-at bibtex-entry-maybe-empty-head) - (goto-char (if begin - (match-beginning bibtex-key-in-head) - (match-end 0)))) - (t - (goto-char pnt) - (unless noerror (error "Not on BibTeX field")))))) + (if help (bibtex-print-help-message (car bounds)))) + ((not noerror) (error "Not on BibTeX field"))))) -(defun bibtex-find-text-internal (&optional noerror subfield) - "Find text part of current BibTeX field, @String or @Preamble. -Return list (NAME START END) with field name, start and end of text -or nil if not found. +(defun bibtex-find-text-internal (&optional noerror subfield comma) + "Find text part of current BibTeX field or entry head. +Return list (NAME START-TEXT END-TEXT END) with field or entry name, +start and end of text and end of field or entry head, or nil if not found. If optional arg NOERROR is non-nil, an error message is suppressed if text -is not found. If optional arg SUBFIELD is non-nil START and END correspond -to the current subfield delimited by #." +is not found. If optional arg SUBFIELD is non-nil START-TEXT and END-TEXT +correspond to the current subfield delimited by #. +Optional arg COMMA is as in `bibtex-enclosing-field'." (save-excursion (let ((pnt (point)) - (_ (bibtex-inside-field)) - (bounds (bibtex-enclosing-field t)) + (bounds (bibtex-enclosing-field comma t)) (case-fold-search t) - (bibtex-string-empty-key t) - name start end) + name start-text end-text end failure done no-sub) (bibtex-beginning-of-entry) (cond (bounds (setq name (bibtex-name-in-field bounds t) - start (bibtex-start-of-text-in-field bounds) - end (bibtex-end-of-text-in-field bounds))) + start-text (bibtex-start-of-text-in-field bounds) + end-text (bibtex-end-of-text-in-field bounds) + end (bibtex-end-of-field bounds))) ;; @String - ((setq bounds (bibtex-parse-string)) - (setq name "@String" ;; not a field name! - start (bibtex-start-of-text-in-string bounds) - end (bibtex-end-of-text-in-string bounds))) + ((setq bounds (bibtex-parse-string t)) + (if (<= pnt (bibtex-end-of-string bounds)) + (setq name "@String" ;; not a field name! + start-text (bibtex-start-of-text-in-string bounds) + end-text (bibtex-end-of-text-in-string bounds) + end (bibtex-end-of-string bounds)) + (setq failure t))) ;; @Preamble - ((and (bibtex-preamble-prefix t) - (setq bounds (bibtex-parse-field-text))) - (setq name "@Preamble" ;; not a field name! - start (car bounds) - end (nth 1 bounds))) - (t (unless noerror (error "Not on BibTeX field")))) - (when (and start end subfield) - (goto-char start) - (let (done) + ((setq bounds (bibtex-parse-preamble)) + (if (<= pnt (bibtex-end-of-string bounds)) + (setq name "@Preamble" ;; not a field name! + start-text (bibtex-start-of-text-in-string bounds) + end-text (bibtex-end-of-text-in-string bounds) + end (bibtex-end-of-string bounds)) + (setq failure t))) + ;; BibTeX head + ((looking-at bibtex-entry-maybe-empty-head) + (goto-char (match-end 0)) + (if comma (save-match-data + (re-search-forward "\\=[ \t\n]*," nil t))) + (if (<= pnt (point)) + (setq name (match-string-no-properties bibtex-type-in-head) + start-text (or (match-beginning bibtex-key-in-head) + (match-end 0)) + end-text (or (match-end bibtex-key-in-head) + (match-end 0)) + end end-text + no-sub t) ;; subfields do not make sense + (setq failure t))) + (t (setq failure t))) + (when (and subfield (not failure)) + (setq failure no-sub) + (unless failure + (goto-char start-text) (while (not done) (if (or (prog1 (looking-at bibtex-field-const) - (setq end (match-end 0))) + (setq end-text (match-end 0))) (prog1 (setq bounds (bibtex-parse-field-string)) - (setq end (cdr bounds)))) + (setq end-text (cdr bounds)))) (progn - (if (and (<= start pnt) (<= pnt end)) + (if (and (<= start-text pnt) (<= pnt end-text)) (setq done t) - (goto-char end)) + (goto-char end-text)) (if (looking-at "[ \t\n]*#[ \t\n]*") - (setq start (goto-char (match-end 0))))) - (unless noerror (error "Not on text part of BibTeX field")) - (setq done t start nil end nil))))) - (if (and start end) - (list name start end))))) - -(defun bibtex-remove-OPT-or-ALT () + (setq start-text (goto-char (match-end 0))))) + (setq done t failure t))))) + (cond ((not failure) + (list name start-text end-text end)) + ((and no-sub (not noerror)) + (error "Not on text part of BibTeX field")) + ((not noerror) (error "Not on BibTeX field")))))) + +(defun bibtex-remove-OPT-or-ALT (&optional comma) "Remove the string starting optional/alternative fields. -Align text and go thereafter to end of text." - (interactive) - (bibtex-inside-field) +Align text and go thereafter to end of text. Optional arg COMMA +is as in `bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list t)) (let ((case-fold-search t) - (bounds (bibtex-enclosing-field))) + (bounds (bibtex-enclosing-field comma))) (save-excursion (goto-char (bibtex-start-of-name-in-field bounds)) (when (looking-at "OPT\\|ALT") @@ -3751,14 +3697,14 @@ Align text and go thereafter to end of text." (delete-horizontal-space) (if bibtex-align-at-equal-sign (insert " ") - (indent-to-column bibtex-text-indentation)))) - (bibtex-inside-field))) - -(defun bibtex-remove-delimiters () - "Remove \"\" or {} around current BibTeX field text." - (interactive) - ;; `bibtex-find-text-internal' issues an error message if bounds is nil. - (let* ((bounds (bibtex-find-text-internal nil t)) + (indent-to-column bibtex-text-indentation)))))) + +(defun bibtex-remove-delimiters (&optional comma) + "Remove \"\" or {} around current BibTeX field text. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (let* ((bounds (bibtex-find-text-internal nil t comma)) (start (nth 1 bounds)) (end (nth 2 bounds))) (if (memq (char-before end) '(?\} ?\")) @@ -3766,15 +3712,15 @@ Align text and go thereafter to end of text." (if (memq (char-after start) '(?\{ ?\")) (delete-region start (1+ start))))) -(defun bibtex-kill-field (&optional copy-only) +(defun bibtex-kill-field (&optional copy-only comma) "Kill the entire enclosing BibTeX field. With prefix arg COPY-ONLY, copy the current field to `bibtex-field-kill-ring', -but do not actually kill it." - (interactive "P") +but do not actually kill it. Optional arg COMMA is as in +`bibtex-enclosing-field'. It is t for interactive calls." + (interactive (list current-prefix-arg t)) (save-excursion - (bibtex-inside-field) (let* ((case-fold-search t) - (bounds (bibtex-enclosing-field)) + (bounds (bibtex-enclosing-field comma)) (end (bibtex-end-of-field bounds)) (beg (bibtex-start-of-field bounds))) (goto-char end) @@ -3791,10 +3737,12 @@ but do not actually kill it." (delete-region beg end)))) (setq bibtex-last-kill-command 'field)) -(defun bibtex-copy-field-as-kill () - "Copy the BibTeX field at point to the kill ring." - (interactive) - (bibtex-kill-field t)) +(defun bibtex-copy-field-as-kill (&optional comma) + "Copy the BibTeX field at point to the kill ring. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (bibtex-kill-field t comma)) (defun bibtex-kill-entry (&optional copy-only) "Kill the entire enclosing BibTeX entry. @@ -3806,7 +3754,7 @@ but do not actually kill it." (beg (bibtex-beginning-of-entry)) (end (progn (bibtex-end-of-entry) (if (re-search-forward - bibtex-entry-maybe-empty-head nil 'move) + bibtex-any-entry-maybe-empty-head nil 'move) (goto-char (match-beginning 0))) (point)))) (push (buffer-substring-no-properties beg end) @@ -3831,13 +3779,13 @@ More precisely, reinsert the field or entry killed or yanked most recently. With argument N, reinsert the Nth most recently killed BibTeX item. See also the command \\[bibtex-yank-pop]." (interactive "*p") - (bibtex-insert-kill (1- n)) + (bibtex-insert-kill (1- n) t) (setq this-command 'bibtex-yank)) (defun bibtex-yank-pop (n) "Replace just-yanked killed BibTeX item with a different item. This command is allowed only immediately after a `bibtex-yank' or a -`bibtex-yank-pop'. At such a time, the region contains a reinserted +`bibtex-yank-pop'. In this case, the region contains a reinserted previously killed BibTeX item. `bibtex-yank-pop' deletes that item and inserts in its place a different killed BibTeX item. @@ -3853,13 +3801,14 @@ comes the newest one." (setq this-command 'bibtex-yank) (let ((inhibit-read-only t)) (delete-region (point) (mark t)) - (bibtex-insert-kill n))) - -(defun bibtex-empty-field () - "Delete the text part of the current field, replace with empty text." - (interactive) - (bibtex-inside-field) - (let ((bounds (bibtex-enclosing-field))) + (bibtex-insert-kill n t))) + +(defun bibtex-empty-field (&optional comma) + "Delete the text part of the current field, replace with empty text. +Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for +interactive calls." + (interactive (list t)) + (let ((bounds (bibtex-enclosing-field comma))) (goto-char (bibtex-start-of-text-in-field bounds)) (delete-region (point) (bibtex-end-of-text-in-field bounds)) (insert (bibtex-field-left-delimiter) @@ -3960,7 +3909,7 @@ At end of the cleaning process, the functions in (if (and (listp bibtex-strings) (not (assoc key bibtex-strings))) (push (cons key (bibtex-text-in-string - (save-excursion (bibtex-parse-string)) t)) + (bibtex-parse-string) t)) bibtex-strings))) ;; We have a normal entry. ((listp bibtex-reference-keys) @@ -3988,28 +3937,27 @@ At end of the cleaning process, the functions in If JUSTIFY is non-nil justify as well. If optional arg MOVE is non-nil move point to end of field." (let ((end-field (copy-marker (bibtex-end-of-field bounds)))) - (goto-char (bibtex-start-of-field bounds)) - (if justify - (progn - (forward-char) - (bibtex-delete-whitespace) - (open-line 1) - (forward-char) - (indent-to-column (+ bibtex-entry-offset - bibtex-field-indentation)) - (re-search-forward "[ \t\n]*=" end-field) - (replace-match "=") - (forward-char -1) - (if bibtex-align-at-equal-sign - (indent-to-column - (+ bibtex-entry-offset (- bibtex-text-indentation 2))) - (insert " ")) - (forward-char) - (bibtex-delete-whitespace) - (if bibtex-align-at-equal-sign - (insert " ") - (indent-to-column bibtex-text-indentation))) - (re-search-forward "[ \t\n]*=[ \t\n]*" end-field)) + (if (not justify) + (goto-char (bibtex-start-of-text-in-field bounds)) + (goto-char (bibtex-start-of-field bounds)) + (forward-char) ;; leading comma + (bibtex-delete-whitespace) + (open-line 1) + (forward-char) + (indent-to-column (+ bibtex-entry-offset + bibtex-field-indentation)) + (re-search-forward "[ \t\n]*=" end-field) + (replace-match "=") + (forward-char -1) + (if bibtex-align-at-equal-sign + (indent-to-column + (+ bibtex-entry-offset (- bibtex-text-indentation 2))) + (insert " ")) + (forward-char) + (bibtex-delete-whitespace) + (if bibtex-align-at-equal-sign + (insert " ") + (indent-to-column bibtex-text-indentation))) ;; Paragraphs within fields are not preserved. Bother? (fill-region-as-paragraph (line-beginning-position) end-field default-justification nil (point)) @@ -4017,14 +3965,13 @@ If optional arg MOVE is non-nil move point to end of field." (defun bibtex-fill-field (&optional justify) "Like \\[fill-paragraph], but fill current BibTeX field. -Optional prefix arg JUSTIFY non-nil means justify as well. +If optional prefix JUSTIFY is non-nil justify as well. In BibTeX mode this function is bound to `fill-paragraph-function'." (interactive "*P") (let ((pnt (copy-marker (point))) - (bounds (bibtex-enclosing-field))) - (when bounds - (bibtex-fill-field-bounds bounds justify) - (goto-char pnt)))) + (bounds (bibtex-enclosing-field t))) + (bibtex-fill-field-bounds bounds justify) + (goto-char pnt))) (defun bibtex-fill-entry () "Fill current BibTeX entry. @@ -4035,14 +3982,16 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." (interactive "*") (let ((pnt (copy-marker (point))) (end (copy-marker (bibtex-end-of-entry))) + (beg (bibtex-beginning-of-entry)) ; move point bounds) - (bibtex-beginning-of-entry) (bibtex-delete-whitespace) (indent-to-column bibtex-entry-offset) - (while (setq bounds (bibtex-search-forward-field bibtex-field-name end)) + (bibtex-beginning-first-field beg) + (while (setq bounds (bibtex-parse-field)) (bibtex-fill-field-bounds bounds t t)) (if (looking-at ",") (forward-char)) + (skip-chars-backward " \t\n") (bibtex-delete-whitespace) (open-line 1) (forward-char) @@ -4115,8 +4064,7 @@ If mark is active reformat entries in region, if not in whole buffer." bibtex-autokey-edit-before-use) (save-restriction - (narrow-to-region (if mark-active (region-beginning) (point-min)) - (if mark-active (region-end) (point-max))) + (if mark-active (narrow-to-region (region-beginning) (region-end))) (if (memq 'realign bibtex-entry-format) (bibtex-realign)) (bibtex-progress-message "Formatting" 1) @@ -4143,12 +4091,10 @@ entries from minibuffer." (message "Starting to validate buffer...") (sit-for 1 nil t) (bibtex-realign) - (message - "If errors occur, correct them and call `bibtex-convert-alien' again") - (sit-for 5 nil t) (deactivate-mark) ; So bibtex-validate works on the whole buffer. - (when (let (bibtex-maintain-sorted-entries) - (bibtex-validate)) + (if (not (let (bibtex-maintain-sorted-entries) + (bibtex-validate))) + (message "Correct errors and call `bibtex-convert-alien' again") (message "Starting to reformat entries...") (sit-for 2 nil t) (bibtex-reformat read-options) @@ -4166,10 +4112,9 @@ An error is signaled if point is outside key or BibTeX field." (interactive) (let ((pnt (point)) (case-fold-search t) - (bibtex-string-empty-key t) bounds name compl) (save-excursion - (if (and (setq bounds (bibtex-enclosing-field t)) + (if (and (setq bounds (bibtex-enclosing-field nil t)) (>= pnt (bibtex-start-of-text-in-field bounds)) (<= pnt (bibtex-end-of-text-in-field bounds))) (setq name (bibtex-name-in-field bounds t) @@ -4182,7 +4127,7 @@ An error is signaled if point is outside key or BibTeX field." ;; point is in other field (t (bibtex-strings)))) (bibtex-beginning-of-entry) - (cond ((setq bounds (bibtex-parse-string)) + (cond ((setq bounds (bibtex-parse-string t)) ;; point is inside a @String key (cond ((and (>= pnt (nth 1 (car bounds))) (<= pnt (nth 2 (car bounds)))) @@ -4192,11 +4137,10 @@ An error is signaled if point is outside key or BibTeX field." (<= pnt (bibtex-end-of-text-in-string bounds))) (setq compl (bibtex-strings))))) ;; point is inside a @Preamble field - ((and (bibtex-preamble-prefix t) - (setq bounds (bibtex-parse-field-text)) - (>= pnt (car bounds)) - (<= pnt (nth 1 bounds))) - (setq compl (bibtex-strings))) + ((setq bounds (bibtex-parse-preamble)) + (if (and (>= pnt (bibtex-start-of-text-in-string bounds)) + (<= pnt (bibtex-end-of-text-in-string bounds))) + (setq compl (bibtex-strings)))) ((and (looking-at bibtex-entry-maybe-empty-head) ;; point is inside a key (or (and (match-beginning bibtex-key-in-head) @@ -4209,41 +4153,53 @@ An error is signaled if point is outside key or BibTeX field." (cond ((eq compl 'key) ;; key completion: no cleanup needed - (let (completion-ignore-case) - (bibtex-complete-internal (bibtex-global-key-alist)))) + (setq choose-completion-string-functions nil + completion-ignore-case nil) + (bibtex-complete-internal (bibtex-global-key-alist))) ((eq compl 'crossref-key) ;; crossref key completion - (let (completion-ignore-case) - (setq choose-completion-string-functions - (lambda (choice buffer mini-p base-size) - (let ((choose-completion-string-functions nil)) - (choose-completion-string choice buffer base-size)) - (bibtex-complete-crossref-cleanup choice) - ;; return t (needed by choose-completion-string-functions) - t)) - (bibtex-complete-crossref-cleanup (bibtex-complete-internal - (bibtex-global-key-alist))))) + ;; + ;; If we quit the *Completions* buffer without requesting + ;; a completion, `choose-completion-string-functions' is still + ;; non-nil. Therefore, `choose-completion-string-functions' is + ;; always set (either to non-nil or nil) when a new completion + ;; is requested. + ;; Also, `choose-completion-delete-max-match' requires + ;; that we set `completion-ignore-case' (i.e., binding via `let' + ;; is not sufficient). + (setq completion-ignore-case nil + choose-completion-string-functions + (lambda (choice buffer mini-p base-size) + (setq choose-completion-string-functions nil) + (choose-completion-string choice buffer base-size) + (bibtex-complete-crossref-cleanup choice) + t)) ; needed by choose-completion-string-functions + + (bibtex-complete-crossref-cleanup (bibtex-complete-internal + (bibtex-global-key-alist)))) ((eq compl 'string) ;; string key completion: no cleanup needed - (let ((completion-ignore-case t)) - (bibtex-complete-internal bibtex-strings))) + (setq choose-completion-string-functions nil + completion-ignore-case t) + (bibtex-complete-internal bibtex-strings)) (compl ;; string completion - (let ((completion-ignore-case t)) - (setq choose-completion-string-functions - `(lambda (choice buffer mini-p base-size) - (let ((choose-completion-string-functions nil)) - (choose-completion-string choice buffer base-size)) - (bibtex-complete-string-cleanup choice ',compl) - ;; return t (needed by choose-completion-string-functions) - t)) - (bibtex-complete-string-cleanup (bibtex-complete-internal compl) - compl))) - - (t (error "Point outside key or BibTeX field"))))) + (setq completion-ignore-case t + choose-completion-string-functions + `(lambda (choice buffer mini-p base-size) + (setq choose-completion-string-functions nil) + (choose-completion-string choice buffer base-size) + (bibtex-complete-string-cleanup choice ',compl) + t)) ; needed by choose-completion-string-functions + (bibtex-complete-string-cleanup (bibtex-complete-internal compl) + compl)) + + (t (setq choose-completion-string-functions nil + completion-ignore-case nil) ; default + (error "Point outside key or BibTeX field"))))) (defun bibtex-Article () "Insert a new BibTeX @Article entry; see also `bibtex-entry'." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index ce95c6f026f..48defb7d786 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -291,12 +291,13 @@ act as a paragraph-separator." (defun fill-single-word-nobreak-p () "Don't break a line after the first or before the last word of a sentence." - (or (looking-at "[ \t]*\\sw+[ \t]*[.?!:][ \t]*$") + (or (looking-at (concat "[ \t]*\\sw+" "\\(?:" (sentence-end) "\\)")) (save-excursion (skip-chars-backward " \t") (and (/= (skip-syntax-backward "w") 0) (/= (skip-chars-backward " \t") 0) - (/= (skip-chars-backward ".?!:") 0))))) + (/= (skip-chars-backward ".?!:") 0) + (looking-at (sentence-end)))))) (defun fill-french-nobreak-p () "Return nil if French style allows breaking the line at point. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index ac6afe45608..cc2d1eace59 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,11 @@ +2006-01-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (url-retrieve-synchronously): Don't autoload. + + * url.el (url-retrieve, url-retrieve-synchronously): Autoload. + + * url-cache.el: Require `url'. + 2005-12-27 Stefan Monnier <monnier@iro.umontreal.ca> * url-cache.el (url-store-in-cache): Use save-current-buffer. diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index b8c2b063adc..5113ad0d7d9 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -26,6 +26,7 @@ (require 'url-parse) (require 'url-util) +(require 'url) ;E.g. for url-configuration-directory. (defcustom url-cache-directory (expand-file-name "cache" url-configuration-directory) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 1c9d1d9c0b1..0338eefd268 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -1,7 +1,7 @@ ;;; url-handlers.el --- file-name-handler stuff for URL loading ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -37,7 +37,6 @@ ;; after mm-dissect-buffer and defined in the same file. ;; The following are autoloaded instead of `require'd to avoid eagerly ;; loading all of URL when turning on url-handler-mode in the .emacs. -(autoload 'url-retrieve-synchronously "url" "Retrieve url synchronously.") (autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") (autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") (autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") diff --git a/lisp/url/url.el b/lisp/url/url.el index 6d6540ac82a..f9d06010171 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -1,7 +1,7 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> ;; Keywords: comm, data, processes, hypermedia @@ -114,6 +114,7 @@ Emacs." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Retrieval functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;###autoload (defun url-retrieve (url callback &optional cbargs) "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. URL is either a string or a parsed URL. @@ -155,6 +156,7 @@ already completed." (url-history-update-url url (current-time))) buffer)) +;;;###autoload (defun url-retrieve-synchronously (url) "Retrieve URL synchronously. Return the buffer containing the data, or nil if there are no data diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 075ea879270..0036712fec4 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -39,9 +39,6 @@ ;;; Todo: -;; The xterm mouse escape codes are supposedly also supported by the -;; Linux console, but I have not been able to verify this. - ;; Support multi-click -- somehow. ;;; Code: diff --git a/lispref/ChangeLog b/lispref/ChangeLog index e812c834c01..f3b812390a1 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,22 @@ +2005-12-30 Richard M. Stallman <rms@gnu.org> + + * text.texi (Changing Properties): + Don't use return value of set-text-properties. + +2005-12-29 Luc Teirlinck <teirllm@auburn.edu> + + * modes.texi (Mode Line Format): Correct typo in menu. + +2005-12-29 Richard M. Stallman <rms@gnu.org> + + * modes.texi (Mode Line Top): New node. + (Mode Line Data): Some text moved to new node. + Explain the data structure more concretely. + (Mode Line Basics): Clarifications. + (Mode Line Variables): Clarify intro paragraph. + (%-Constructs): Clarify intro paragraph. + (Mode Line Format): Update menu. + 2005-12-28 Luc Teirlinck <teirllm@auburn.edu> * minibuf.texi (Basic Completion): Update lazy-completion-table diff --git a/lispref/modes.texi b/lispref/modes.texi index 6fd23114044..15954ed1d1d 100644 --- a/lispref/modes.texi +++ b/lispref/modes.texi @@ -1520,8 +1520,9 @@ information displayed in the mode line relates to the enabled major and minor modes. @menu -* Mode Line Basics:: -* Mode Line Data:: The data structure that controls the mode line. +* Base: Mode Line Basics. Basic ideas of mode line control. +* Data: Mode Line Data. The data structure that controls the mode line. +* Top: Mode Line Top. The top level variable, mode-line-format. * Mode Line Variables:: Variables used in that data structure. * %-Constructs:: Putting information into a mode line. * Properties in Mode:: Using text properties in the mode line. @@ -1533,12 +1534,13 @@ minor modes. @subsection Mode Line Basics @code{mode-line-format} is a buffer-local variable that holds a -template used to display the mode line of the current buffer. All -windows for the same buffer use the same @code{mode-line-format}, so -their mode lines appear the same---except for scrolling percentages, and -line and column numbers, since those depend on point and on how the -window is scrolled. @code{header-line-format} is used likewise for -header lines. +@dfn{mode line construct}, a kind of template, which controls the +display the mode line of the current buffer. All windows for the same +buffer use the same @code{mode-line-format}, so their mode lines +appear the same---except for scrolling percentages, and line and +column numbers, since those depend on point and on how the window is +scrolled. The value of @code{header-line-format} specifies the +buffer's header line in the same way, with a mode line construct. For efficiency, Emacs does not recompute the mode line and header line of a window in every redisplay. It does so when circumstances @@ -1567,61 +1569,36 @@ and the frame title. color using the face @code{mode-line}. Other windows' mode lines appear in the face @code{mode-line-inactive} instead. @xref{Faces}. - A window that is just one line tall does not display either a mode -line or a header line, even if the variables call for one. A window -that is two lines tall cannot display both a mode line and a header -line at once; if the variables call for both, only the mode line -actually appears. - @node Mode Line Data @subsection The Data Structure of the Mode Line @cindex mode-line construct - The mode-line contents are controlled by a data structure of lists, -strings, symbols, and numbers kept in buffer-local variables. The data -structure is called a @dfn{mode-line construct}, and it is built in -recursive fashion out of simpler mode-line constructs. The same data -structure is used for constructing frame titles (@pxref{Frame Titles}) -and header lines (@pxref{Header Lines}). - -@defvar mode-line-format -The value of this variable is a mode-line construct with overall -responsibility for the mode-line format. The value of this variable -controls which other variables are used to form the mode-line text, and -where they appear. - -If you set this variable to @code{nil} in a buffer, that buffer does not -have a mode line. -@end defvar - - A mode-line construct may be as simple as a fixed string of text, but -it usually specifies how to use other variables to construct the text. -Many of these variables are themselves defined to have mode-line -constructs as their values. + The mode-line contents are controlled by a data structure called a +@dfn{mode-line construct}, made up of lists, strings, symbols, and +numbers kept in buffer-local variables. Each data type has a specific +meaning for the mode-line appearance, as described below. The same +data structure is used for constructing frame titles (@pxref{Frame +Titles}) and header lines (@pxref{Header Lines}). - The default value of @code{mode-line-format} incorporates the values -of variables such as @code{mode-line-position} and -@code{mode-line-modes} (which in turn incorporates the values of the -variables @code{mode-name} and @code{minor-mode-alist}). Because of -this, very few modes need to alter @code{mode-line-format} itself. For -most purposes, it is sufficient to alter some of the variables that -@code{mode-line-format} either directly or indirectly refers to. + A mode-line construct may be as simple as a fixed string of text, +but it usually specifies how to combine fixed strings with variables' +values to construct the text. Many of these variables are themselves +defined to have mode-line constructs as their values. - A mode-line construct may be a list, a symbol, or a string. If the -value is a list, each element may be a list, a symbol, or a string. - - The mode line can display various faces, if the strings that control -it have the @code{face} property. @xref{Properties in Mode}. In -addition, the face @code{mode-line} is used as a default for the whole -mode line (@pxref{Standard Faces,,, emacs, The GNU Emacs Manual}). + Here are the meanings of various data types as mode-line constructs: @table @code @cindex percent symbol in mode line @item @var{string} -A string as a mode-line construct is displayed verbatim in the mode line -except for @dfn{@code{%}-constructs}. Decimal digits after the @samp{%} -specify the field width for space filling on the right (i.e., the data -is left justified). @xref{%-Constructs}. +A string as a mode-line construct appears verbatim in the mode line +except for @dfn{@code{%}-constructs} in it. These stand for +substitution of other data; see @ref{%-Constructs}. + +If the string has @code{face} properties, they are copied into the +mode line contents too (@pxref{Properties in Mode}). Any characters +in the mode line which have no @code{face} properties are displayed, +by default, in the face @code{mode-line} or @code{mode-line-inactive} +(@pxref{Standard Faces,,, emacs, The GNU Emacs Manual}). @item @var{symbol} A symbol as a mode-line construct stands for its value. The value of @@ -1633,11 +1610,13 @@ There is one exception: if the value of @var{symbol} is a string, it is displayed verbatim: the @code{%}-constructs are not recognized. Unless @var{symbol} is marked as ``risky'' (i.e., it has a -non-@code{nil} @code{risky-local-variable} property), all properties in -any strings, as well as all @code{:eval} and @code{:propertize} forms in -the value of that symbol will be ignored. +non-@code{nil} @code{risky-local-variable} property), all text +properties specified in @var{symbol}'s value are ignored. This +includes the text properties of strings in @var{symbol}'s value, as +well as all @code{:eval} and @code{:propertize} forms in it. -@item (@var{string} @var{rest}@dots{}) @r{or} (@var{list} @var{rest}@dots{}) +@item (@var{string} @var{rest}@dots{}) +@itemx (@var{list} @var{rest}@dots{}) A list whose first element is a string or list means to process all the elements recursively and concatenate the results. This is the most common form of mode-line construct. @@ -1650,7 +1629,7 @@ recursion. @item (:propertize @var{elt} @var{props}@dots{}) A list whose first element is the symbol @code{:propertize} says to -process the mode-line construct @var{elt} recursively and add the text +process the mode-line construct @var{elt} recursively, then add the text properties specified by @var{props} to the result. The argument @var{props} should consist of zero or more pairs @var{text-property} @var{value}. (This feature is new as of Emacs 22.1.) @@ -1677,6 +1656,29 @@ For example, the usual way to show what percentage of a buffer is above the top of the window is to use a list like this: @code{(-3 "%p")}. @end table +@node Mode Line Top +@subsection The Top Level of Mode Line Control + + The variable in overall control of the mode line is +@code{mode-line-format}. + +@defvar mode-line-format +The value of this variable is a mode-line construct that controls the +contents of the mode-line. It is always buffer-local in all buffers. + +If you set this variable to @code{nil} in a buffer, that buffer does +not have a mode line. (A window that is just one line tall never +displays a mode line.) +@end defvar + + The default value of @code{mode-line-format} is designed to use the +values of other variables such as @code{mode-line-position} and +@code{mode-line-modes} (which in turn incorporates the values of the +variables @code{mode-name} and @code{minor-mode-alist}). Very few +modes need to alter @code{mode-line-format} itself. For most +purposes, it is sufficient to alter some of the variables that +@code{mode-line-format} either directly or indirectly refers to. + If you do alter @code{mode-line-format} itself, the new value should use the same variables that appear in the default value (@pxref{Mode Line Variables}), rather than duplicating their contents or displaying @@ -1730,11 +1732,14 @@ these variable names are also the minor mode command names.) @node Mode Line Variables @subsection Variables Used in the Mode Line - This section describes variables incorporated by the -standard value of @code{mode-line-format} into the text of the mode -line. There is nothing inherently special about these variables; any -other variables could have the same effects on the mode line if -@code{mode-line-format} were changed to use them. + This section describes variables incorporated by the standard value +of @code{mode-line-format} into the text of the mode line. There is +nothing inherently special about these variables; any other variables +could have the same effects on the mode line if +@code{mode-line-format}'s value were changed to use them. However, +various parts of Emacs set these variables on the understanding that +they will control parts of the mode line; therefore, practically +speaking, it is essential for the mode line to use them. @defvar mode-line-mule-info This variable holds the value of the mode-line construct that displays @@ -1907,10 +1912,12 @@ specifies addition of text properties. @node %-Constructs @subsection @code{%}-Constructs in the Mode Line - The following table lists the recognized @code{%}-constructs and what -they mean. In any construct except @samp{%%}, you can add a decimal -integer after the @samp{%} to specify a minimum field width. If the -width is less, the field is padded with spaces to the right. + Strings used as mode-line constructs can use certain +@code{%}-constructs to substitute various kinds of data. Here is a +list of the defined @code{%}-constructs, and what they mean. In any +construct except @samp{%%}, you can add a decimal integer after the +@samp{%} to specify a minimum field width. If the width is less, the +field is padded with spaces to the right. @table @code @item %b @@ -2078,6 +2085,11 @@ that do not override it. This is the same as @code{(default-value It is normally @code{nil}, so that ordinary buffers have no header line. @end defvar + A window that is just one line tall never displays a header line. A +window that is two lines tall cannot display both a mode line and a +header line at once; if it has a mode line, then it does not display a +header line. + @node Emulating Mode Line @subsection Emulating Mode-Line Formatting diff --git a/lispref/text.texi b/lispref/text.texi index b8d727efca4..b37715be5a0 100644 --- a/lispref/text.texi +++ b/lispref/text.texi @@ -2735,6 +2735,8 @@ from the specified range of text. Here's an example: @example (set-text-properties @var{start} @var{end} nil) @end example + +Do not rely on the return value of this function. @end defun The easiest way to make a string with text properties diff --git a/man/ChangeLog b/man/ChangeLog index 3c4b718c796..168753ae7a7 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,11 @@ +2005-12-30 Juri Linkov <juri@jurta.org> + + * basic.texi (Position Info): Update example. + +2005-12-29 Romain Francoise <romain@orebokech.com> + + * faq.texi (Using Customize): New node. + 2005-12-28 Luc Teirlinck <teirllm@auburn.edu> * org.texi: Remove blank line in @direntry. It is non-standard diff --git a/man/basic.texi b/man/basic.texi index e8c36d405c1..c2e48263c20 100644 --- a/man/basic.texi +++ b/man/basic.texi @@ -717,14 +717,14 @@ displays the character as @samp{@`A}), and which has font-lock-mode @smallexample character: @`A (2240, #o4300, #x8c0, U+00C0) - charset: [latin-iso8859-1] + charset: latin-iso8859-1 (Right-Hand Part of Latin Alphabet 1@dots{} - code point: [64] + code point: #x40 syntax: w which means: word category: l:Latin - to input: type "`A" with [latin-1-prefix] + to input: type "`A" with latin-1-prefix buffer code: #x81 #xC0 - file code: ESC #x2C #x41 #x40 (encoded by coding system iso-2022-7bit) + file code: #xC0 (encoded by coding system iso-latin-1) display: terminal code #xC0 There are text properties here: diff --git a/man/display.texi b/man/display.texi index 2f813c4b7c0..2a3fc30ad82 100644 --- a/man/display.texi +++ b/man/display.texi @@ -1014,6 +1014,13 @@ terminal itself blinks the cursor, and Emacs has no control over it.) You can control how the cursor appears when it blinks off by setting the variable @code{blink-cursor-alist}. +@vindex visible-cursor + Some text terminals offer two different cursors: the normal cursor +and the very visible cursor, where the latter may be e.g. bigger or +blinking. By default Emacs uses the very visible cursor. Setting the +variable @code{visible-cursor} to @code{nil} makes it use the +normal cursor. + @cindex cursor in non-selected windows @vindex cursor-in-non-selected-windows Normally, the cursor appears in non-selected windows in the ``off'' diff --git a/man/faq.texi b/man/faq.texi index 36564482cc7..b34a4d4ae12 100644 --- a/man/faq.texi +++ b/man/faq.texi @@ -1161,6 +1161,7 @@ In addition, Emacs 22 now includes the Emacs Lisp Reference Manual @menu * Setting up a customization file:: +* Using Customize:: * Debugging a customization file:: * Colors on a TTY:: * Displaying the current line or column:: @@ -1211,7 +1212,7 @@ In addition, Emacs 22 now includes the Emacs Lisp Reference Manual * Escape sequences in shell output:: @end menu -@node Setting up a customization file, Colors on a TTY, Common requests, Common requests +@node Setting up a customization file, Using Customize, Common requests, Common requests @section How do I set up a @file{.emacs} file properly? @cindex @file{.emacs} file, setting up @cindex @file{.emacs} file, locating @@ -1225,11 +1226,11 @@ it causes confusing non-standard behavior. Then they send questions to @email{help-gnu-emacs@@gnu.org} asking why Emacs isn't behaving as documented. -Beginning with version 20.1, Emacs includes the new Customize facility, -which can be invoked using @kbd{M-x customize @key{RET}}. This allows -users who are unfamiliar with Emacs Lisp to modify their @file{.emacs} -files in a relatively straightforward way, using menus rather than Lisp -code. Most packages support Customize as of this writing. +Beginning with version 20.1, Emacs includes the new Customize facility +(@pxref{Using Customize}). This allows users who are unfamiliar with +Emacs Lisp to modify their @file{.emacs} files in a relatively +straightforward way, using menus rather than Lisp code. Most packages +support Customize as of this writing. While Customize might indeed make it easier to configure Emacs, consider taking a bit of time to learn Emacs Lisp and modifying your @@ -1241,7 +1242,26 @@ Sometimes users are unsure as to where their @file{.emacs} file should be found. Visiting the file as @file{~/.emacs} from Emacs will find the correct file. -@node Colors on a TTY, Debugging a customization file, Setting up a customization file, Common requests +@node Using Customize, Colors on a TTY, Setting up a customization file, Common requests +@section How do I start using Customize? +@cindex Customize groups +@cindex Customizing variables +@cindex Customizing faces + +The main Customize entry point is @kbd{M-x customize @key{RET}}. This +command takes you to a buffer listing all the available Customize +groups. From there, you can access all customizable options and faces, +change their values, and save your changes to your init file. +@inforef{Easy Customization, Easy Customization, emacs}. + +If you know the name of the group in advance (e.g. ``shell''), use +@kbd{M-x customize-group @key{RET}}. + +If you wish to customize a single option, use @kbd{M-x customize-option +@key{RET}}. This command prompts you for the name of the option to +customize, with completion. + +@node Colors on a TTY, Debugging a customization file, Using Customize, Common requests @section How do I get colors and syntax highlighting on a TTY? @cindex Colors on a TTY @cindex Syntax highlighting on a TTY diff --git a/src/.gdbinit b/src/.gdbinit index 10f993fdd9f..4120b1e10bf 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -764,6 +764,12 @@ show environment DISPLAY show environment TERM #set args -geometry 80x40+0+0 +# People get bothered when they see messages about non-existent functions... +echo \n +echo If you see messages below about functions not being defined,\n +echo don\'t worry about them. Nothing is wrong.\n +echo \n + # Don't let abort actually run, as it will make # stdio stop working and therefore the `pr' command above as well. break abort diff --git a/src/ChangeLog b/src/ChangeLog index 4f6cb895004..6ad7c939bce 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,51 @@ +2006-01-01 Ken Raeburn <raeburn@gnu.org> + + * callproc.c (Fcall_process_region): Bind file-name-handler-alist + to nil for the call to Fwrite_region. + +2005-12-31 Richard M. Stallman <rms@gnu.org> + + * minibuf.c (read_minibuf): Clear out all other minibuffer windows. + +2005-12-31 Eli Zaretskii <eliz@gnu.org> + + * emacs.c (gdb_pvec_type): A dummy variable for GDB's sake. + +2005-12-30 Luc Teirlinck <teirllm@auburn.edu> + + * textprop.c (set_text_properties): Reword description of return value. + Return Qnil if caller wants to remove all text properties from a + string and the string already has no intervals. + +2005-12-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * term.c (visible_cursor): New boolean var. + (set_terminal_modes, tty_show_cursor): Use "vs" or "ve" depending on + visible_cursor. + (syms_of_term): Export the new var as "visible-cursor". + +2005-12-30 Eli Zaretskii <eliz@gnu.org> + + * .gdbinit: Tell users not to worry about GDB warnings that some + functions do not exist in the binary. + +2005-12-30 Andreas Schwab <schwab@suse.de> + + * process.c (Fnetwork_interface_info): Correctly terminate the + loop over ifflag_table. + +2005-12-29 Richard M. Stallman <rms@gnu.org> + + * lread.c (readevalloop): Test for reading a whole buffer + before actually reading anything. Handle all cases, including + START = END = nil and an already-narrowed buffer. + Convert END to a marker if it is a number. + + * keymap.c (describe_map): Put sparse map elements into an array, + sort them, then output a sequence of identical bindings on one line. + (struct describe_map_elt): New data type. + (describe_map_compare): New function. + 2005-12-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * gtkutil.c (xg_get_file_with_chooser): Changed message shown diff --git a/src/callproc.c b/src/callproc.c index f38b7c03ab3..c7804b485c7 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1133,6 +1133,9 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r int count1 = SPECPDL_INDEX (); specbind (intern ("coding-system-for-write"), val); + /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we + happen to get a ".Z" suffix. */ + specbind (intern ("file-name-handler-alist"), Qnil); Fwrite_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil); unbind_to (count1, Qnil); diff --git a/src/emacs.c b/src/emacs.c index 142da86df95..d38cf4379bf 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -113,6 +113,9 @@ EMACS_INT gdb_data_seg_bits = 0; #endif EMACS_INT PVEC_FLAG = PSEUDOVECTOR_FLAG; EMACS_INT gdb_array_mark_flag = ARRAY_MARK_FLAG; +/* GDB might say "No enum type named pvec_type" if we don't have at + least one symbol with that type, and then xbacktrace could fail. */ +enum pvec_type gdb_pvec_type = PVEC_TYPE_MASK; /* Command line args from shell, as list of strings. */ Lisp_Object Vcommand_line_args; diff --git a/src/keymap.c b/src/keymap.c index 97789a75f1d..64069ca4deb 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -3167,6 +3167,34 @@ describe_translation (definition, args) insert_string ("??\n"); } +/* describe_map puts all the usable elements of a sparse keymap + into an array of `struct describe_map_elt', + then sorts them by the events. */ + +struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; }; + +/* qsort comparison function for sorting `struct describe_map_elt' by + the event field. */ + +static int +describe_map_compare (aa, bb) + const void *aa, *bb; +{ + const struct describe_map_elt *a = aa, *b = bb; + if (INTEGERP (a->event) && INTEGERP (b->event)) + return ((XINT (a->event) > XINT (b->event)) + - (XINT (a->event) < XINT (b->event))); + if (!INTEGERP (a->event) && INTEGERP (b->event)) + return 1; + if (INTEGERP (a->event) && !INTEGERP (b->event)) + return -1; + if (SYMBOLP (a->event) && SYMBOLP (b->event)) + return (Fstring_lessp (a->event, b->event) ? -1 + : Fstring_lessp (b->event, a->event) ? 1 + : 0); + return 0; +} + /* Describe the contents of map MAP, assuming that this map itself is reached by the sequence of prefix keys PREFIX (a string or vector). PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ @@ -3190,6 +3218,13 @@ describe_map (map, prefix, elt_describer, partial, shadow, int first = 1; struct gcpro gcpro1, gcpro2, gcpro3; + /* These accumulate the values from sparse keymap bindings, + so we can sort them and handle them in order. */ + int length_needed = 0; + struct describe_map_elt *vect; + int slots_used = 0; + int i; + suppress = Qnil; if (partial) @@ -3201,6 +3236,12 @@ describe_map (map, prefix, elt_describer, partial, shadow, kludge = Fmake_vector (make_number (1), Qnil); definition = Qnil; + for (tail = map; CONSP (tail); tail = XCDR (tail)) + length_needed++; + + vect = ((struct describe_map_elt *) + alloca (sizeof (struct describe_map_elt) * length_needed)); + GCPRO3 (prefix, definition, kludge); for (tail = map; CONSP (tail); tail = XCDR (tail)) @@ -3215,6 +3256,7 @@ describe_map (map, prefix, elt_describer, partial, shadow, else if (CONSP (XCAR (tail))) { int this_shadowed = 0; + event = XCAR (XCAR (tail)); /* Ignore bindings whose "prefix" are not really valid events. @@ -3255,27 +3297,10 @@ describe_map (map, prefix, elt_describer, partial, shadow, tem = Flookup_key (map, kludge, Qt); if (!EQ (tem, definition)) continue; - if (first) - { - previous_description_column = 0; - insert ("\n", 1); - first = 0; - } - - /* THIS gets the string to describe the character EVENT. */ - insert1 (Fkey_description (kludge, prefix)); - - /* Print a description of the definition of this character. - elt_describer will take care of spacing out far enough - for alignment purposes. */ - (*elt_describer) (definition, Qnil); - - if (this_shadowed) - { - SET_PT (PT - 1); - insert_string (" (binding currently shadowed)"); - SET_PT (PT + 1); - } + vect[slots_used].event = event; + vect[slots_used].definition = definition; + vect[slots_used].shadowed = this_shadowed; + slots_used++; } else if (EQ (XCAR (tail), Qkeymap)) { @@ -3289,6 +3314,68 @@ describe_map (map, prefix, elt_describer, partial, shadow, } } + /* If we found some sparse map events, sort them. */ + + qsort (vect, slots_used, sizeof (struct describe_map_elt), + describe_map_compare); + + /* Now output them in sorted order. */ + + for (i = 0; i < slots_used; i++) + { + Lisp_Object start, end; + + if (first) + { + previous_description_column = 0; + insert ("\n", 1); + first = 0; + } + + ASET (kludge, 0, vect[i].event); + start = vect[i].event; + end = start; + + definition = vect[i].definition; + + /* Find consecutive chars that are identically defined. */ + if (INTEGERP (vect[i].event)) + { + while (i + 1 < slots_used + && XINT (vect[i + 1].event) == XINT (vect[i].event) + 1 + && !NILP (Fequal (vect[i + 1].definition, definition)) + && vect[i].shadowed == vect[i + 1].shadowed) + i++; + end = vect[i].event; + } + + /* Now START .. END is the range to describe next. */ + + /* Insert the string to describe the event START. */ + insert1 (Fkey_description (kludge, prefix)); + + if (!EQ (start, end)) + { + insert (" .. ", 4); + + ASET (kludge, 0, end); + /* Insert the string to describe the character END. */ + insert1 (Fkey_description (kludge, prefix)); + } + + /* Print a description of the definition of this character. + elt_describer will take care of spacing out far enough + for alignment purposes. */ + (*elt_describer) (vect[i].definition, Qnil); + + if (vect[i].shadowed) + { + SET_PT (PT - 1); + insert_string (" (binding currently shadowed)"); + SET_PT (PT + 1); + } + } + UNGCPRO; } diff --git a/src/lread.c b/src/lread.c index 236ebebda13..0eb54393482 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1323,7 +1323,18 @@ readevalloop (readcharfun, stream, sourcename, evalfun, int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; + int bpos; int continue_reading_p; + /* Nonzero if reading an entire buffer. */ + int whole_buffer = 0; + /* 1 on the first time around. */ + int first_sexp = 1; + + if (MARKERP (readcharfun)) + { + if (NILP (start)) + start = readcharfun; + } if (BUFFERP (readcharfun)) b = XBUFFER (readcharfun); @@ -1349,7 +1360,6 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (b != 0 && NILP (b->name)) error ("Reading from killed buffer"); - if (!NILP (start)) { /* Switch to the buffer we are reading from. */ @@ -1364,9 +1374,20 @@ readevalloop (readcharfun, stream, sourcename, evalfun, /* Set point and ZV around stuff to be read. */ Fgoto_char (start); - Fnarrow_to_region (make_number (BEGV), end); + if (!NILP (end)) + Fnarrow_to_region (make_number (BEGV), end); + + /* Just for cleanliness, convert END to a marker + if it is an integer. */ + if (INTEGERP (end)) + end = Fpoint_max_marker (); } + /* On the first cycle, we can easily test here + whether we are reading the whole buffer. */ + if (b && first_sexp) + whole_buffer = (PT == BEG && ZV == Z); + instream = stream; read_next: c = READCHAR; @@ -1416,8 +1437,11 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (!NILP (start) && continue_reading_p) start = Fpoint_marker (); + + /* Restore saved point and BEGV. */ unbind_to (count1, Qnil); + /* Now eval what we just read. */ val = (*evalfun) (val); if (printflag) @@ -1428,11 +1452,12 @@ readevalloop (readcharfun, stream, sourcename, evalfun, else Fprint (val, Qnil); } + + first_sexp = 0; } build_load_history (sourcename, - stream || (INTEGERP (start) && INTEGERP (end) - && XINT (start) == BEG && XINT (end) == Z)); + stream || whole_buffer); UNGCPRO; diff --git a/src/minibuf.c b/src/minibuf.c index 7f3f7fe87ea..b327f2d040a 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -464,6 +464,9 @@ read_minibuf (map, initial, prompt, backup_n, expflag, /* String to add to the history. */ Lisp_Object histstring; + Lisp_Object empty_minibuf; + Lisp_Object dummy, frame; + extern Lisp_Object Qfront_sticky; extern Lisp_Object Qrear_nonsticky; @@ -641,6 +644,22 @@ read_minibuf (map, initial, prompt, backup_n, expflag, Vminibuf_scroll_window = selected_window; if (minibuf_level == 1 || !EQ (minibuf_window, selected_window)) minibuf_selected_window = selected_window; + + /* Empty out the minibuffers of all frames other than the one + where we are going to display one now. + Set them to point to ` *Minibuf-0*', which is always empty. */ + empty_minibuf = Fget_buffer (build_string (" *Minibuf-0*")); + + FOR_EACH_FRAME (dummy, frame) + { + Lisp_Object root_window = Fframe_root_window (frame); + Lisp_Object mini_window = XWINDOW (root_window)->next; + + if (! NILP (mini_window) && !NILP (Fwindow_minibuffer_p (mini_window))) + Fset_window_buffer (mini_window, empty_minibuf, Qnil); + } + + /* Display this minibuffer in the proper window. */ Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil); Fselect_window (minibuf_window, Qnil); XSETFASTINT (XWINDOW (minibuf_window)->hscroll, 0); diff --git a/src/process.c b/src/process.c index 752768a7bad..e869456e5c8 100644 --- a/src/process.c +++ b/src/process.c @@ -3558,7 +3558,7 @@ FLAGS is the current flags of the interface. */) int fnum; any++; - for (fp = ifflag_table; flags != 0 && fp; fp++) + for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++) { if (flags & fp->flag_bit) { diff --git a/src/term.c b/src/term.c index 49356348545..899739de6ae 100644 --- a/src/term.c +++ b/src/term.c @@ -109,6 +109,10 @@ static void delete_tty P_ ((struct terminal *)); #define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) +/* If true, use "vs", otherwise use "ve" to make the cursor visible. */ + +static int visible_cursor; + /* Display space properties */ extern Lisp_Object Qspace, QCalign_to, QCwidth; @@ -217,7 +221,7 @@ tty_set_terminal_modes (struct terminal *terminal) } OUTPUT_IF (tty, tty->TS_termcap_modes); - OUTPUT_IF (tty, tty->TS_cursor_visible); + OUTPUT_IF (tty, visible_cursor ? tty->TS_cursor_visible : tty->TS_cursor_normal); OUTPUT_IF (tty, tty->TS_keypad_mode); losecursor (tty); fflush (tty->output); @@ -359,7 +363,8 @@ tty_show_cursor (struct tty_display_info *tty) { tty->cursor_hidden = 0; OUTPUT_IF (tty, tty->TS_cursor_normal); - OUTPUT_IF (tty, tty->TS_cursor_visible); + if (visible_cursor) + OUTPUT_IF (tty, tty->TS_cursor_visible); } } @@ -3031,6 +3036,13 @@ The functions are run with one argument, the name of the tty that was revived. See `resume-tty'. */); Vresume_tty_functions = Qnil; + DEFVAR_BOOL ("visible-cursor", &visible_cursor, + doc: /* Non-nil means to make the cursor very visible. +This only has an effect when running in a text terminal. +What means \"very visible\" is up to your terminal. It may make the cursor +bigger, or it may make it blink, or it may do nothing at all. */); + visible_cursor = 1; + defsubr (&Stty_display_color_p); defsubr (&Stty_display_color_cells); defsubr (&Stty_no_underline); diff --git a/src/textprop.c b/src/textprop.c index fa9b0e498c5..029f2f41031 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1316,8 +1316,8 @@ the designated part of OBJECT. */) properties PROPERTIES. OBJECT is the buffer or string containing the text. OBJECT nil means use the current buffer. SIGNAL_AFTER_CHANGE_P nil means don't signal after changes. Value - is non-nil if properties were replaced; it is nil if there weren't - any properties to replace. */ + is nil if the function _detected_ that it did not replace any + properties, non-nil otherwise. */ Lisp_Object set_text_properties (start, end, properties, object, signal_after_change_p) @@ -1341,7 +1341,7 @@ set_text_properties (start, end, properties, object, signal_after_change_p) && XFASTINT (end) == SCHARS (object)) { if (! STRING_INTERVALS (object)) - return Qt; + return Qnil; STRING_SET_INTERVALS (object, NULL_INTERVAL); return Qt; |