Mercurial > emacs
changeset 109851:e01fea458062
merge from trunk
| author | Joakim <joakim@localhost.localdomain> |
|---|---|
| date | Thu, 15 Apr 2010 11:20:03 +0200 |
| parents | 242a8b343421 (current diff) d5a9f1780d1e (diff) |
| children | e56f669f17ce |
| files | .arch-inventory admin/charsets/.arch-inventory admin/unidata/.arch-inventory doc/lispref/.arch-inventory etc/.arch-inventory info/.arch-inventory leim/.arch-inventory leim/quail/.arch-inventory lib-src/.arch-inventory lisp/.arch-inventory lisp/calc/.arch-inventory lisp/calendar/.arch-inventory lisp/complete.el lisp/eshell/.arch-inventory lisp/mh-e/.arch-inventory lisp/obsolete/complete.el nt/.arch-inventory src/.arch-inventory src/Makefile.in |
| diffstat | 109 files changed, 3983 insertions(+), 2229 deletions(-) [+] |
line wrap: on
line diff
--- a/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -# Generated files -precious ^(config\.status|config\.cache)$ - -# Install-in-place makes these directories, so just ignore them -backup ^(bin|data|lock|site-lisp)$ - -# arch-tag: 6eeeaa4e-cc7e-4b22-b3d7-1089e155da14
--- a/.bzrignore Sat Apr 03 22:21:58 2010 +0200 +++ b/.bzrignore Thu Apr 15 11:20:03 2010 +0200 @@ -65,3 +65,4 @@ configure.lineno conftest* confdefs.h +core
--- a/admin/CPP-DEFINES Sat Apr 03 22:21:58 2010 +0200 +++ b/admin/CPP-DEFINES Thu Apr 15 11:20:03 2010 +0200 @@ -106,7 +106,6 @@ CRT0_DUMMIES C_SWITCH_MACHINE C_SWITCH_SYSTEM -C_SWITCH_SYSTEM_TEMACS C_SWITCH_X_SYSTEM DATA_SEG_BITS DATA_START
--- a/admin/charsets/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Unlike most emacs dirs, admin/charsets has a simple non-autoconf-generated makefile -source ^(Makefile)$ - -# arch-tag: ee36cfe3-96f8-4e91-aec4-008c80a85e6b
--- a/admin/notes/BRANCH Sat Apr 03 22:21:58 2010 +0200 +++ b/admin/notes/BRANCH Thu Apr 15 11:20:03 2010 +0200 @@ -1,29 +1,26 @@ -This file describes the bzr branch in which it is maintained. -Everything below the line is branch-specific. -________________________________________________________________________ +You can view the available Emacs branches at + +http://bzr.savannah.gnu.org/r/emacs/ -This is the trunk (sometimes mistakenly called "HEAD"). -When people say "use the development version of Emacs" or the -"bzr version of Emacs", this is the branch they are talking about. +Development normally takes places on the trunk. +Sometimes specialized features are developed on separate branches +before possibly being merged to the trunk. -Emacs development takes place on the trunk. Most of the time, Emacs -hackers add to it relatively free of constraint (aside from proper -legal / accounting practices), although sometimes there is related -discussion on the emacs-devel mailing list. +Development is discussed on the emacs-devel mailing list. -Sometime before the release of a new major version of Emacs (eg 22.1), +Sometime before the release of a new major version of Emacs (eg 23.2), a "feature freeze" is imposed on the trunk. No new features may be -added after this point. This is usually many months before the release. -During this time, there is no official place for development of new features. +added after this point. This is usually some months before the release. -Shortly before the release, a release branch is created. For example, -EMACS_22_BASE or EMACS_21_1_RC for Emacs 22.x and 21.x, respectively. -(Unfortunately the naming scheme has not always been consistent.) +Shortly before the release, a release branch is created, and the +trunk is then free for development. +For example, "emacs-23" for Emacs 23.2 and later, "EMACS_23_1_RC" for +23.1, "EMACS_22_BASE" for 22.x, and "EMACS_21_1_RC" for 21.x. -The release branch is used to make the release (22.1), and all later -members of the series (22.2, 22.3, etc). Generally, only bug-fixes have -been allowed in the minor releases, although in 22.x, self-contained -new features were allowed on a case-by-case basis. +Traditionally only bug-fixes were allowed in minor releases. +Recently (22.x, 23.2), self-contained new features were allowed on a +case-by-case basis. -From the point that a release branch is created, the trunk is free for -development for the next major version. +If you are looking at this file in a branch other than the trunk, +there may be some branch-specific documentation below this line. +________________________________________________________________________
--- a/admin/unidata/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Generated at compile time -precious ^unidata\.txt$ - -# arch-tag: 7640ff84-9e72-45e6-a7c7-b7b307b73959
--- a/doc/emacs/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/doc/emacs/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,11 @@ +2010-04-11 Jan Djärv <jan.h.d@swipnet.se> + + * xresources.texi (Lucid Resources): Mention faceName for dialogs. + +2010-04-08 Jan Djärv <jan.h.d@swipnet.se> + + * xresources.texi (Lucid Resources): Mention faceName to set Xft fonts. + 2010-03-30 Eli Zaretskii <eliz@gnu.org> * mule.texi (Input Methods): Mention "C-x 8 RET" and add a
--- a/doc/emacs/xresources.texi Sat Apr 03 22:21:58 2010 +0200 +++ b/doc/emacs/xresources.texi Thu Apr 15 11:20:03 2010 +0200 @@ -399,8 +399,9 @@ @end table @node Lucid Resources -@appendixsec Lucid Menu X Resources +@appendixsec Lucid Menu And Dialog X Resources @cindex Menu X Resources (Lucid widgets) +@cindex Dialog X Resources (Lucid widgets) @cindex Lucid Widget X Resources @ifnottex @@ -415,7 +416,7 @@ @end example @noindent -For example, to specify the font @samp{8x16} for the menu-bar items, +For example, to specify the font @samp{Courier-12} for the menu-bar items, write this: @end ifnottex @iftex @@ -423,11 +424,46 @@ with the Lucid menu widgets, then the menu bar is a separate widget and has its own resources. The resource specifications start with @samp{Emacs.pane.menubar}---for instance, to specify the font -@samp{8x16} for the menu-bar items, write this: +@samp{Courier-12} for the menu-bar items, write this: @end iftex @example -Emacs.pane.menubar.font: 8x16 +Emacs.pane.menubar.faceName: Courier-12 +@end example + +@noindent +To specify a font, use fontconfig font names as values to the @code{faceName} +resource. + +If Emacs is not built with the Xft library, Lucid menus and dialogs can only +display old style fonts. If Emacs is built with Xft and you prefer the old +fonts, you have to specify @samp{none} to @code{faceName}: + +@example +Emacs.pane.menubar.faceName: none +Emacs.pane.dialog.faceName: none +@end example + +@noindent +To specify a non-Xft font, use @code{font}. For example: + +@example +Emacs.pane.menubar.font: lucidasanstypewriter-10 +@end example + +@noindent +The Lucid menus can display multilingual text in your locale with old style +fonts. For more information about fontsets see the man page for +@code{XCreateFontSet}. To enable multilingual menu text you specify a +@code{fontSet} resource instead of the font resource. If both +@code{font} and @code{fontSet} resources are specified, the +@code{fontSet} resource is used. + + Thus, to specify @samp{-*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,*} +for both the popup and menu bar menus, write this: + +@example +Emacs*menu*fontSet: -*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,* @end example @noindent @@ -443,22 +479,7 @@ For dialog boxes, use @samp{dialog*}: @example -Emacs.dialog*.font: 8x16 -@end example - -@noindent -The Lucid menus can display multilingual text in your locale. For -more information about fontsets see the man page for -@code{XCreateFontSet}. To enable multilingual menu text you specify a -@code{fontSet} resource instead of the font resource. If both -@code{font} and @code{fontSet} resources are specified, the -@code{fontSet} resource is used. - - Thus, to specify @samp{-*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,*} -for both the popup and menu bar menus, write this: - -@example -Emacs*menu*fontSet: -*-helvetica-medium-r-*--*-120-*-*-*-*-*-*,* +Emacs.dialog*.faceName: Sans-12 @end example @noindent @@ -473,6 +494,8 @@ Here is a list of the specific resources for menu bars and pop-up menus: @table @code +@item faceName +Xft font for menu item text. @item font Font for menu item text. @item fontSet
--- a/doc/lispref/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Generated files -precious ^(config\.status|config\.cache)$ - -# arch-tag: dde817a2-94ff-4c6e-838c-bb5b33e7f0df
--- a/doc/misc/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/doc/misc/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,14 @@ +2010-04-10 Michael Albinus <michael.albinus@gmx.de> + + Synchronize with Tramp repository. + + * tramp.texi (Auto-save and Backup): Remove reference to Emacs 21. + (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt + supported MS Windows versions. Remove obsolete URL. Use the $() + syntax, texi2dvi reports errors with the backquotes. + + * trampver.texi: Update release number. + 2010-04-01 Teodor Zlatanov <tzz@lifelogs.com> * gnus.texi (Finding the News): Add pointers to the Server buffer
--- a/doc/misc/trampver.texi Sat Apr 03 22:21:58 2010 +0200 +++ b/doc/misc/trampver.texi Thu Apr 15 11:20:03 2010 +0200 @@ -2,14 +2,14 @@ @c texi/trampver.texi. Generated from trampver.texi.in by configure. @c This is part of the Emacs manual. -@c Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -@c Free Software Foundation, Inc. +@c Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, +@c 2010 Free Software Foundation, Inc. @c See file doclicense.texi for copying conditions. @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.1.18-23.2 +@set trampver 2.1.19-pre @c Other flags from configuration @set instprefix /usr/local
--- a/etc/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -# Unlike most emacs dirs, etc has a simple non-autoconf-generated makefile -source ^(Makefile)$ - -# Auto-generated files, which ignore -precious ^(buildobj\.lst)$ - -# Generated files (DOC-X is generated on windows) -backup ^(DOC(|-[0-9.]*|-X))$ - -# Install-in-place on NT makes this directory, so just ignore it -backup ^(icons)$ - -# arch-tag: 5a1d62e0-593a-48cd-8743-8d45dc58dfae
--- a/etc/NEWS Sat Apr 03 22:21:58 2010 +0200 +++ b/etc/NEWS Thu Apr 15 11:20:03 2010 +0200 @@ -65,12 +65,28 @@ ** GTK scroll-bars are now placed on the right by default. Use `set-scroll-bar-mode' to change this. +** Lucid menus and dialogs can display antialiased fonts if Emacs is built +with Xft. + +** New scrolling commands `scroll-up-command' and `scroll-down-command' +(bound to C-v/[next] and M-v/[prior]) does not signal errors at top/bottom +of buffer at first key-press (instead moves to top/bottom of buffer) +when a new variable `scroll-error-top-bottom' is non-nil. + +** New scrolling commands `scroll-up-line' and `scroll-down-line' +scroll a line instead of full screen. + +** New variable `scroll-preserve-screen-position-commands' defines +a list of scroll command affected by `scroll-preserve-screen-position. + * Editing Changes in Emacs 24.1 * Changes in Specialized Modes and Packages in Emacs 24.1 +** partial-completion-mode is now obsolete. + ** mpc.el: Can use pseudo tags of the form tag1|tag2 as a union of two tags. ** Customize @@ -88,6 +104,8 @@ ** VC and related modes +*** New VC commands: vc-log-incoming and vc-log-outgoing. + *** vc-dir for Bzr supports viewing shelve contents and shelving snapshots. *** Special markup can be added to log-edit buffers. @@ -96,6 +114,10 @@ Author: NAME line will add "--author NAME" to the "bzr commit" command. +**** For Git, adding an +Author: NAME +line will add "--author NAME" to the "git commit" command. + **** For Hg, adding an Author: NAME line will add "--user NAME" to the "hg commit" command. @@ -124,6 +146,8 @@ * Incompatible Lisp Changes in Emacs 24.1 +** Passing a nil argument to a minor mode function now turns the mode + ON unconditionally. * Lisp changes in Emacs 24.1
--- a/info/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -# There are only three real source files in this directory: -# -# "dir", ".cvsignore", and this file, ".arch-inventory" - -# Everything else is generated at compile time. Unfortunately, the "backup" -# category overrides the "source" category, so we have to have horrible -# regexp that matches everything _except_ "dir"... - -# 1 or 2 characters long -backup ^[a-zA-Z0-9][-_.a-zA-Z0-9]?$ -# 4 or more characters long -backup ^[a-zA-Z0-9][-_.a-zA-Z0-9][-_.a-zA-Z0-9][-_.a-zA-Z0-9]+$ -# 3 chars long, but 1st char not "d" -backup ^[abce-zA-Z0-9][-_.a-zA-Z0-9][-_.a-zA-Z0-9]$ -# 3 chars long, but 2nd char not "i" -backup ^[a-zA-Z0-9][-_.a-hj-zA-Z0-9][-_.a-zA-Z0-9]$ -# 3 chars long, but 3rd char not "r" -backup ^[a-zA-Z0-9][-_.a-zA-Z0-9][-_.a-qs-zA-Z0-9]$ - -# arch-tag: 60144ab9-cdc1-45b6-8193-b9683c80ec86
--- a/leim/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated files, which ignore. -precious ^(stamp-subdir|changed\..*|leim-list\.el)$ - -# arch-tag: a4cda8ae-2a52-4d85-bd29-14e25c7ed2a2
--- a/leim/quail/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore. -precious ^([A-Z0-9].*|tsang-.*|quick-.*)\.el$ - -# arch-tag: 3d0d3e6b-f7c3-4dce-9135-a72ba7fe095d
--- a/lib-src/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -# Ignore binaries -backup ^(test-distrib|make-docfile|profile|digest-doc|movemail|fakemail|blessmail|hexl|update-game-score|etags|ctags|emacsclient|b2m|ebrowse|sorted-doc)$ - -# Building actually makes a copy/link of the source file -precious ^(ctags\.c)$ - -# Windows generates this -backup ^(DOC)$ - -# arch-tag: da33b3d6-170d-4fe5-9eb8-ed2753bc9b4f
--- a/lib-src/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/lib-src/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,19 @@ +2010-04-12 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (ALL_CFLAGS, LINK_CFLAGS, CPP_CFLAGS): Move to the + non-cpp section. + +2010-04-11 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE): Define using + autoconf, not cpp. + (ALL_CFLAGS): Use them as make variables. + +2010-04-07 Christoph <cschol2112@googlemail.com> (tiny change) + + * makefile.w32-in (OTHER_PLATFORM_SUPPORT): Use parenthesis + for macros for nmake compatibility. + 2010-04-03 Juanma Barranquero <lekktu@gmail.com> Add stubs for Windows, required after CVE-2010-0825 change.
--- a/lib-src/Makefile.in Sat Apr 03 22:21:58 2010 +0200 +++ b/lib-src/Makefile.in Thu Apr 15 11:20:03 2010 +0200 @@ -34,6 +34,8 @@ version=@version@ configuration=@configuration@ EXEEXT=@EXEEXT@ +C_SWITCH_SYSTEM=@c_switch_system@ +C_SWITCH_MACHINE=@c_switch_machine@ # Program name transformation. TRANSFORM = @program_transform_name@ @@ -150,6 +152,12 @@ ## Extra libraries to use when linking movemail. LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) +# Those files shared with other GNU utilities need HAVE_CONFIG_H +# defined before they know they can take advantage of the information +# in ../src/config.h. +ALL_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) -DHAVE_CONFIG_H -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} +LINK_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) -DHAVE_CONFIG_H -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CFLAGS} +CPP_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) -DHAVE_CONFIG_H -I. -I../src -I${srcdir} -I${srcdir}/../src ${CPPFLAGS} ${CFLAGS} # ========================== start of cpp stuff ======================= /* From here on, comments must be done in C syntax. */ @@ -168,14 +176,6 @@ #define LIBS_MACHINE #endif -#ifndef C_SWITCH_SYSTEM -#define C_SWITCH_SYSTEM -#endif - -#ifndef C_SWITCH_MACHINE -#define C_SWITCH_MACHINE -#endif - #undef MOVEMAIL_NEEDS_BLESSING #ifndef MAIL_USE_FLOCK #ifndef MAIL_USE_LOCKF @@ -191,15 +191,6 @@ LOADLIBES=LIBS_SYSTEM LIBS_MACHINE -/* Those files shared with other GNU utilities need HAVE_CONFIG_H - defined before they know they can take advantage of the information - in ../src/config.h. */ -ALL_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ - -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} -LINK_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ - -I. -I../src -I${srcdir} -I${srcdir}/../src ${LDFLAGS} ${CFLAGS} -CPP_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \ - -I. -I../src -I${srcdir} -I${srcdir}/../src ${CPPFLAGS} ${CFLAGS} .SUFFIXES: .m
--- a/lib-src/makefile.w32-in Sat Apr 03 22:21:58 2010 +0200 +++ b/lib-src/makefile.w32-in Thu Apr 15 11:20:03 2010 +0200 @@ -195,8 +195,8 @@ $(lispsource)term/pc-win.elc \ $(lispsource)x-dnd.elc \ $(lispsource)term/x-win.elc \ - ${lispsource}emacs-lisp/easymenu.elc \ - ${lispsource}term/ns-win.elc + $(lispsource)emacs-lisp/easymenu.elc \ + $(lispsource)term/ns-win.elc lisp1= \
--- a/lisp/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(loaddefs|finder-inf|cus-load)\.el$ - -# arch-tag: fc62dc9f-3a91-455b-b8e7-d49df66beee0
--- a/lisp/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,336 @@ +2010-04-15 Juanma Barranquero <lekktu@gmail.com> + + Simplify by using `define-derived-mode'. + * info.el (Info-mode): + * calendar/todo-mode.el (todo-mode): + * play/gomoku.el (gomoku-mode): Define with `define-derived-mode'. + (gomoku-mode-map): Move initialization into declaration. + +2010-04-14 Michael Albinus <michael.albinus@gmx.de> + + Fix Bug#5840. + * ido.el (ido-file-name-all-completions-1): + * minibuffer.el (minibuffer-completion-help): + * net/tramp.el (tramp-completion-mode-p): Use `non-essential'. + +2010-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (non-essential): New var. + + Add a new field `location' to bookmarks for non-file bookmarks. + * bookmark.el (bookmark-location): Use the new field, if present. + (bookmark-insert-location): Undo last change, not needed any more. + * man.el (Man-bookmark-make-record): + * woman.el (woman-bookmark-make-record): Add `location' field. + +2010-04-14 Juri Linkov <juri@jurta.org> + + * simple.el (scroll-error-top-bottom): New defcustom. + (scroll-up-command, scroll-down-command): Use it. Doc fix. + + * emulation/pc-select.el (pc-select-override-scroll-error): + Obsolete in favor of `scroll-error-top-bottom'. + +2010-04-14 Juri Linkov <juri@jurta.org> + + * tutorial.el (tutorial--default-keys): Rebind `C-v' to + `scroll-up-command' and `M-v' to `scroll-down-command'. + + * emulation/cua-rect.el (cua--init-rectangles): + * forms.el (forms--change-commands): + * image-mode.el (image-mode-map): + Remap scroll-down-command and scroll-up-command + in addition to scroll-down and scroll-up. + +2010-04-14 Juri Linkov <juri@jurta.org> + + * mwheel.el (scroll-preserve-screen-position-commands): + Add mwheel-scroll to this list of commands. + + * simple.el (scroll-preserve-screen-position-commands): + Add scroll-up-command, scroll-down-command, scroll-up-line, + scroll-down-line to this list of commands. + +2010-04-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * obsolete/complete.el: Move from lisp/complete.el. + + * pcomplete.el (pcomplete-here*): Fix mistaken change (bug#5935). + + * emacs-lisp/easy-mmode.el (define-minor-mode): Passing a nil argument + to the minor mode function now turns the mode ON unconditionally. + +2010-04-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-dir.el (vc-dir-kill-line): New command. + (vc-dir-mode-map): Bind it to C-k. + + * bookmark.el (bookmark-insert-location): Handle a nil filename. + + * woman.el: Add bookmark declarations to silence the compiler. + (bookmark-prop-get): Use `man-args' rather than `filename' as a first + step to compatibility between man and woman bookmarks. + Adjust for Man-default-bookmark-title renaming. + (woman-bookmark-jump): Adjust accordingly. Don't forget to autoload. + + * man.el: Add bookmark declarations to silence the compiler. + (Man-name-local-regexp): Make it match NAME as well. + (Man-getpage-in-background): Return the buffer. + (Man-notify-when-ready): Use `case'. + (man-set-default-bookmark-title): Rename to Man-default-bookmark-title. + Don't hardcode "NAME". Simplify. + (Man-bookmark-make-record): Use Man-arguments rather than buffer-name. + Rename from Man-bookmark-make-record. + (Man-bookmark-jump): Rename from man-bookmark-jump. Simplify now that + we have the actual man-args. Use Man-getpage-in-background rather + than `man' since the arg is already processed. Let bookmark.el do the + window handling. Only wait for the relevant process. + Don't forget to autoload. + + * bookmark.el (bookmark-default-file): Use locate-user-emacs-file. + +2010-04-12 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * woman.el (woman-bookmark-make-record, woman-bookmark-jump): + New functions. + (woman-mode): Setup bookmark support. + + * man.el (man-set-default-bookmark-title, man-bookmark-make-record) + (man-bookmark-jump): New functions. + (Man-mode): Setup bookmark support. + +2010-04-10 Jari Aalto <jari.aalto@cante.net> + + * comint.el (comint-password-prompt-regexp): Use regexp-opt, and + recognize ssh-keygen prompt (Bug#2817). + +2010-04-10 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-do-copy-or-rename-file): Add progress reporter. + +2010-04-10 Michael Albinus <michael.albinus@gmx.de> + + Synchronize with Tramp repository. + + * net/tramp.el (tramp-completion-function-alist) + (tramp-file-name-regexp, tramp-chunksize) + (tramp-local-coding-commands, tramp-remote-coding-commands): + Fix docstring. + (tramp-remote-process-environment): Use `format' instead of `concat'. + (tramp-handle-directory-files-and-attributes) + (tramp-get-remote-path): Use `copy-tree'. + (tramp-handle-file-name-all-completions): Backward/ XEmacs + compatibility: Use `completion-ignore-case' if + `read-file-name-completion-ignore-case' does not exist. + (tramp-do-copy-or-rename-file-directly): Do not use + `tramp-handle-file-remote-p'. + (tramp-do-copy-or-rename-file-out-of-band): + Use `tramp-compat-delete-directory'. + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-compute-multi-hops, tramp-maybe-open-connection): + Use `format-spec-make'. + (tramp-find-foreign-file-name-handler) + (tramp-advice-make-auto-save-file-name) + (tramp-set-auto-save-file-modes): Remove superfluous check for + `stringp'. This is done inside `tramp-tramp-file-p'. + (tramp-debug-outline-regexp): New defconst. + (tramp-get-debug-buffer): Use it. + (tramp-check-for-regexp): Use (forward-line 1). + (tramp-set-auto-save-file-modes): Adapt version check. + + * net/tramp-compat.el (tramp-advice-file-expand-wildcards): + Wrap call of `featurep' for 2nd argument. + (tramp-compat-make-temp-file): Simplify fallback implementation. + (tramp-compat-copy-tree): Remove function. + (tramp-compat-delete-directory): Provide implementation for older + Emacsen. + + * net/tramp-fish.el (tramp-fish-handle-directory-files-and-attributes): + Do not use `tramp-fish-handle-file-attributes. + + * net/trampver.el: Update release number. + +2010-04-10 Glenn Morris <rgm@gnu.org> + + * progmodes/compile.el (compilation-save-buffers-predicate): + Add missing :version tag. + +2010-04-09 Sam Steingold <sds@gnu.org> + + * progmodes/compile.el (compilation-save-buffers-predicate): + Remove the "autoload" cookie. + + * progmodes/bug-reference.el (turn-on-bug-reference-mode) + (turn-on-bug-reference-prog-mode): Remove, `bug-reference-mode' + and `bug-reference-prog-mode' can be used in hooks directly. + +2010-04-09 Dan Nicolaescu <dann@ics.uci.edu> + + Add --author support to git commit. + * vc-git.el (vc-git-checkin): Pass extra-args to the commit command. + (vc-git-log-edit-mode): New minor mode. + (log-edit-mode, log-edit-extra-flags, log-edit-mode): + New declarations. + +2010-04-09 Eric Raymond <esr@snark.thyrsus.com> + + * vc-hooks.el, vc-git.el: Improve documentation comments. + +2010-04-08 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix some of the problems in defsubst* (bug#5728). + * emacs-lisp/cl-macs.el (defsubst*): Don't substitute non-trivial args. + (cl-defsubst-expand): Do the substitutions simultaneously (bug#5728). + +2010-04-07 Sam Steingold <sds@gnu.org> + + * progmodes/compile.el (compilation-save-buffers-predicate): + New custom variable. + (compile, recompile): Pass it to `save-some-buffers'. + +2010-04-07 Jan Djärv <jan.h.d@swipnet.se> + + * wid-edit.el (widget-choose): Move cursor to the second line of + the buffer (Bug#5695). + +2010-04-07 Dan Nicolaescu <dann@ics.uci.edu> + + Add new VC methods: vc-log-incoming and vc-log-outgoing. + * vc.el (vc-print-log-setup-buttons): New function split out from + vc-print-log-internal. + (vc-log-internal-common): New function, a parametrized version of + vc-print-log-internal. + (vc-print-log-internal): Just call vc-log-internal-common with the + right arguments. + (vc-incoming-outgoing-internal): + (vc-log-incoming, vc-log-outgoing): New functions. + (vc-log-view-type): New permanent local variable. + + * vc-hooks.el (vc-menu-map): Bind vc-log-incoming and vc-log-outgoing. + + * vc-bzr.el (vc-bzr-log-view-mode): Use vc-log-view-type instead + of the dynamic bound vc-short-log. + (vc-bzr-log-incoming, vc-bzr-log-outgoing): New functions. + + * vc-git.el (vc-git-log-outgoing): New function. + (vc-git-log-view-mode): Use vc-log-view-type instead + of the dynamic bound vc-short-log. + + * vc-hg.el (vc-hg-log-view-mode): Use vc-log-view-type instead + of the dynamic bound vc-short-log. Highlight the tag. + (vc-hg-log-incoming, vc-hg-log-outgoing): New functions. + (vc-hg-outgoing, vc-hg-incoming, vc-hg-outgoing-mode): + (vc-hg-incoming-mode): Remove. + (vc-hg-extra-menu-map): Do not bind vc-hg-incoming and vc-hg-outgoing. + +2010-04-07 Dan Nicolaescu <dann@ics.uci.edu> + + Fix default-directory for vc-root-diff. + * vc.el (vc-root-diff): Bind default-directory to the root + directory for the diff command. + +2010-04-07 Michael McNamara <mac@mail.brushroad.com> + + * progmodes/verilog-mode.el (verilog-forward-sexp): + (verilog-calc-1): Support "disable fork" and "fork wait" multi + word keywords, suggested by Steve Pearlmutter. + (verilog-pretty-declarations): Support lineup of declarations in + port lists. + (verilog-skip-backward-comments, verilog-skip-forward-comment-p): + fix bug for /* / comments + (verilog-backward-syntactic-ws, verilog-forward-syntactic-ws): + Speed up and simplfy as this is never called with a bound. + (verilog-pretty-declarations): Enhance to line up declarations + inside a parameter list, suggested by Alan Morgan. + (verilog-pretty-expr): Tune assignment regular expression match + string for corner cases; also use markers instead of character + number as indent changes the later. + +2010-04-07 Wilson Snyder <wsnyder@wsnyder.org> + + * progmodes/verilog-mode.el (verilog-type-keywords): Fix pulldown as missing + keyword. + (verilog-read-sub-decls-line): Fix comments in AUTO_TEMPLATE + causing truncation of AUTOWIRE signals. Reported by Bruce + Tennant. + (verilog-auto-inst, verilog-auto-inst-port): Add vl_mbits for + AUTO_TEMPLATEs needing multiple array bits. Suggested by Bruce + Tennant. + (verilog-keywords): + (verilog-1800-2005-keywords, verilog-1800-2009-keywords): Add IEEE + 1800-2009 keywords, including "global.". + +2010-04-06 John Wiegley <jwiegley@gmail.com> + + * ido.el (ido-add-virtual-buffers-to-list): Fix duplicated names + appearing in buffer list (if a live buffer name matched a recentf + file basename). Should use uniquify to offer a real solution. + +2010-04-06 John Wiegley <jwiegley@gmail.com> + + * ido.el (ido-use-virtual-buffers, ido-virtual): Move a ChangeLog + comment to code, and add a :version tag. + (ido-virtual-buffers): Move defvar to fix byte-compiler warning. + +2010-04-06 Juanma Barranquero <lekktu@gmail.com> + + Enable recentf-mode if using virtual buffers. + * ido.el (recentf-list): Declare for byte-compiler. + (ido-virtual-buffers): Move up to silence byte-compiler. Add docstring. + (ido-make-buffer-list): Simplify. + (ido-add-virtual-buffers-to-list): Simplify. Enable recentf-mode. + +2010-04-05 Juri Linkov <juri@jurta.org> + + Scrolling commands which scroll a line instead of full screen. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html + + * simple.el (scroll-up-line, scroll-down-line): New commands. + Put property isearch-scroll=t on them. + + * emulation/ws-mode.el (scroll-down-line, scroll-up-line): + Remove commands. + +2010-04-05 Juri Linkov <juri@jurta.org> + + Scrolling commands which do not signal errors at top/bottom. + http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html + + * simple.el (scroll-up-command, scroll-down-command): New commands. + Put property isearch-scroll=t on them. + + * bindings.el (global-map): Rebind [prior] from `scroll-down' to + `scroll-down-command' and [next] from `scroll-up' to + `scroll-up-command'. + + * emulation/cua-base.el: Put property CUA=move on + `scroll-up-command' and `scroll-down-command'. + (cua--init-keymaps): Remap `scroll-up-command' to `cua-scroll-up' + and `scroll-down-command' to `cua-scroll-down'. + +2010-04-05 Juanma Barranquero <lekktu@gmail.com> + + * help.el (describe-mode): Return nil. + +2010-04-04 John Wiegley <jwiegley@gmail.com> + + * ido.el (ido-use-virtual-buffers): New variable to indicate + whether "virtual buffer" support is enabled for IDO. + (ido-virtual): Face used to indicate virtual buffers in the list. + (ido-buffer-internal): If a buffer is chosen, and no such buffer + exists, but a virtual buffer of that name does (which would be why + it was in the list), recreate the buffer by reopening the file. + (ido-make-buffer-list): If virtual buffers are being used, call + `ido-add-virtual-buffers-to-list' before the make list hook. + (ido-virtual-buffers): New variable which contains a copy of the + current contents of the `recentf-list', albeit pared down for the + sake of speed, and with proper faces applied. + (ido-add-virtual-buffers-to-list): Using the `recentf-list', + create a list of "virtual buffers" to present to the user in + addition to the currently open set. Note that this logic could + get rather slow if that list is too large. With the default + `recentf-max-saved-items' of 200, there is little speed penalty. + 2010-04-03 Stefan Monnier <monnier@iro.umontreal.ca> * font-lock.el: Require CL when compiling.
--- a/lisp/bindings.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/bindings.el Thu Apr 15 11:20:03 2010 +0200 @@ -873,8 +873,8 @@ (define-key global-map [up] 'previous-line) (define-key global-map [right] 'forward-char) (define-key global-map [down] 'next-line) -(define-key global-map [prior] 'scroll-down) -(define-key global-map [next] 'scroll-up) +(define-key global-map [prior] 'scroll-down-command) +(define-key global-map [next] 'scroll-up-command) (define-key global-map [C-up] 'backward-paragraph) (define-key global-map [C-down] 'forward-paragraph) (define-key global-map [C-prior] 'scroll-right)
--- a/lisp/bookmark.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/bookmark.el Thu Apr 15 11:20:03 2010 +0200 @@ -92,7 +92,7 @@ (if bookmark-file ;; In case user set `bookmark-file' in her .emacs: bookmark-file - (convert-standard-filename "~/.emacs.bmk")) + (locate-user-emacs-file "bookmarks" ".emacs.bmk")) "File in which to save bookmarks by default." :type 'file :group 'bookmark) @@ -1176,7 +1176,7 @@ (or no-history (bookmark-maybe-historicize-string bookmark)) (let ((start (point))) (prog1 - (insert (bookmark-location bookmark)) ; *Return this line* + (insert (bookmark-location bookmark)) (if (display-mouse-p) (add-text-properties start @@ -1191,10 +1191,16 @@ (defalias 'bookmark-locate 'bookmark-insert-location) (defun bookmark-location (bookmark) - "Return the name of the file associated with BOOKMARK, or nil if none. + "Return a description of the location of BOOKMARK. BOOKMARK may be a bookmark name (a string) or a bookmark record." (bookmark-maybe-load-default-file) - (bookmark-get-filename bookmark)) + ;; We could call the `handler' and ask for it to construct a description + ;; dynamically: it would open up several new possibilities, but it + ;; would have the major disadvantage of forcing to load each and + ;; every handler when the user calls bookmark-menu. + (or (bookmark-prop-get bookmark 'location) + (bookmark-get-filename bookmark) + "-- Unknown location --")) ;;;###autoload
--- a/lisp/calc/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(.*-loaddefs)\.el$ - -# arch-tag: 5258f69e-459b-449b-bdd7-bdbd5f948cb9
--- a/lisp/calc/calc-frac.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/calc/calc-frac.el Thu Apr 15 11:20:03 2010 +0200 @@ -205,16 +205,32 @@ n temp)) (math-div n d))) - - (defun calcFunc-fdiv (a b) ; [R I I] [Public] - (if (Math-num-integerp a) - (if (Math-num-integerp b) - (if (Math-zerop b) - (math-reject-arg a "*Division by zero") - (math-make-frac (math-trunc a) (math-trunc b))) - (math-reject-arg b 'integerp)) - (math-reject-arg a 'integerp))) + (cond + ((Math-num-integerp a) + (cond + ((Math-num-integerp b) + (if (Math-zerop b) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-trunc a) (math-trunc b)))) + ((eq (car-safe b) 'frac) + (if (Math-zerop (nth 1 b)) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-mul (math-trunc a) (nth 2 b)) (nth 1 b)))) + (t (math-reject-arg b 'integerp)))) + ((eq (car-safe a) 'frac) + (cond + ((Math-num-integerp b) + (if (Math-zerop b) + (math-reject-arg a "*Division by zero") + (math-make-frac (cadr a) (math-mul (nth 2 a) (math-trunc b))))) + ((eq (car-safe b) 'frac) + (if (Math-zerop (nth 1 b)) + (math-reject-arg a "*Division by zero") + (math-make-frac (math-mul (nth 1 a) (nth 2 b)) (math-mul (nth 2 a) (nth 1 b))))) + (t (math-reject-arg b 'integerp)))) + (t + (math-reject-arg a 'integerp)))) (provide 'calc-frac)
--- a/lisp/calendar/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(.*-loaddefs)\.el$ - -# arch-tag: 6246cac0-cd69-4d59-8677-c1451a4d5831
--- a/lisp/calendar/todo-mode.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/calendar/todo-mode.el Thu Apr 15 11:20:03 2010 +0200 @@ -918,17 +918,9 @@ ;; As calendar reads .todo-do before todo-mode is loaded. ;;;###autoload -(defun todo-mode () - "Major mode for editing TODO lists. - -\\{todo-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'todo-mode) - (setq mode-name "TODO") - (use-local-map todo-mode-map) - (easy-menu-add todo-menu) - (run-mode-hooks 'todo-mode-hook)) +(define-derived-mode todo-mode nil "TODO" + "Major mode for editing TODO lists." + (easy-menu-add todo-menu)) (defvar date) (defvar entry)
--- a/lisp/comint.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/comint.el Thu Apr 15 11:20:03 2010 +0200 @@ -340,11 +340,17 @@ ;; Some implementations of passwd use "Password (again)" as the 2nd prompt. ;; Something called "perforce" uses "Enter password:". (defcustom comint-password-prompt-regexp - "\\(\\(Enter \\|[Oo]ld \\|[Nn]ew \\|'s \\|login \\|\ -Kerberos \\|CVS \\|UNIX \\| SMB \\|LDAP \\|\\[sudo] \\|^\\)\ -\[Pp]assword\\( (again)\\)?\\|\ -pass phrase\\|\\(Enter \\|Repeat \\|Bad \\)?[Pp]assphrase\\)\ -\\(?:, try again\\)?\\(?: for [^:]+\\)?:\\s *\\'" + (concat + "^\\(" + (regexp-opt + '("Enter" "Enter same" "Old" "old" "New" "new" "'s" "login" + "Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad")) + " +\\)?" + (regexp-opt + '("password" "Password" "passphrase" "Passphrase" + "pass phrase" "Pass phrase")) + "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\ +\\(?: for [^:]+\\)?:\\s *\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." :type 'regexp
--- a/lisp/complete.el Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1123 +0,0 @@ -;;; complete.el --- partial completion mechanism plus other goodies - -;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Dave Gillespie <daveg@synaptics.com> -;; Keywords: abbrev convenience -;; -;; Special thanks to Hallvard Furuseth for his many ideas and contributions. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Extended completion for the Emacs minibuffer. -;; -;; The basic idea is that the command name or other completable text is -;; divided into words and each word is completed separately, so that -;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous -;; each word is completed as much as possible and then the cursor is -;; left at the first position where typing another letter will resolve -;; the ambiguity. -;; -;; Word separators for this purpose are hyphen, space, and period. -;; These would most likely occur in command names, Info menu items, -;; and file names, respectively. But all word separators are treated -;; alike at all times. -;; -;; This completion package replaces the old-style completer's key -;; bindings for TAB, SPC, RET, and `?'. The old completer is still -;; available on the Meta versions of those keys. If you set -;; PC-meta-flag to nil, the old completion keys will be left alone -;; and the partial completer will use the Meta versions of the keys. - - -;; Usage: M-x partial-completion-mode. During completable minibuffer entry, -;; -;; TAB means to do a partial completion; -;; SPC means to do a partial complete-word; -;; RET means to do a partial complete-and-exit; -;; ? means to do a partial completion-help. -;; -;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform -;; original Emacs completions, and M-TAB etc. do partial completion. -;; To do this, put the command, -;; -;; (setq PC-meta-flag nil) -;; -;; in your .emacs file. To load partial completion automatically, put -;; -;; (partial-completion-mode t) -;; -;; in your .emacs file, too. Things will be faster if you byte-compile -;; this file when you install it. -;; -;; As an extra feature, in cases where RET would not normally -;; complete (such as `C-x b'), the M-RET key will always do a partial -;; complete-and-exit. Thus `C-x b f.c RET' will select or create a -;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing -;; buffer whose name matches that pattern (perhaps "filing.c"). -;; (PC-meta-flag does not affect this behavior; M-RET used to be -;; undefined in this situation.) -;; -;; The regular M-TAB (lisp-complete-symbol) command also supports -;; partial completion in this package. - -;; In addition, this package includes a feature for accessing include -;; files. For example, `C-x C-f <sys/time.h> RET' reads the file -;; /usr/include/sys/time.h. The variable PC-include-file-path is a -;; list of directories in which to search for include files. Completion -;; is supported in include file names. - - -;;; Code: - -(defgroup partial-completion nil - "Partial Completion of items." - :prefix "pc-" - :group 'minibuffer - :group 'convenience) - -(defcustom PC-first-char 'find-file - "Control how the first character of a string is to be interpreted. -If nil, the first character of a string is not taken literally if it is a word -delimiter, so that \".e\" matches \"*.e*\". -If t, the first character of a string is always taken literally even if it is a -word delimiter, so that \".e\" matches \".e*\". -If non-nil and non-t, the first character is taken literally only for file name -completion." - :type '(choice (const :tag "delimiter" nil) - (const :tag "literal" t) - (other :tag "find-file" find-file)) - :group 'partial-completion) - -(defcustom PC-meta-flag t - "If non-nil, TAB means PC completion and M-TAB means normal completion. -Otherwise, TAB means normal completion and M-TAB means Partial Completion." - :type 'boolean - :group 'partial-completion) - -(defcustom PC-word-delimiters "-_. " - "A string of characters treated as word delimiters for completion. -Some arcane rules: -If `]' is in this string, it must come first. -If `^' is in this string, it must not come first. -If `-' is in this string, it must come first or right after `]'. -In other words, if S is this string, then `[S]' must be a valid Emacs regular -expression (not containing character ranges like `a-z')." - :type 'string - :group 'partial-completion) - -(defcustom PC-include-file-path '("/usr/include" "/usr/local/include") - "A list of directories in which to look for include files. -If nil, means use the colon-separated path in the variable $INCPATH instead." - :type '(repeat directory) - :group 'partial-completion) - -(defcustom PC-disable-includes nil - "If non-nil, include-file support in \\[find-file] is disabled." - :type 'boolean - :group 'partial-completion) - -(defvar PC-default-bindings t - "If non-nil, default partial completion key bindings are suppressed.") - -(defvar PC-env-vars-alist nil - "A list of the environment variable names and values.") - - -(defun PC-bindings (bind) - (let ((completion-map minibuffer-local-completion-map) - (must-match-map minibuffer-local-must-match-map)) - (cond ((not bind) - ;; These bindings are the default bindings. It would be better to - ;; restore the previous bindings. - (define-key read-expression-map "\e\t" 'lisp-complete-symbol) - - (define-key completion-map "\t" 'minibuffer-complete) - (define-key completion-map " " 'minibuffer-complete-word) - (define-key completion-map "?" 'minibuffer-completion-help) - - (define-key must-match-map "\r" 'minibuffer-complete-and-exit) - (define-key must-match-map "\n" 'minibuffer-complete-and-exit) - - (define-key global-map [remap lisp-complete-symbol] nil)) - (PC-default-bindings - (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol) - - (define-key completion-map "\t" 'PC-complete) - (define-key completion-map " " 'PC-complete-word) - (define-key completion-map "?" 'PC-completion-help) - - (define-key completion-map "\e\t" 'PC-complete) - (define-key completion-map "\e " 'PC-complete-word) - (define-key completion-map "\e\r" 'PC-force-complete-and-exit) - (define-key completion-map "\e\n" 'PC-force-complete-and-exit) - (define-key completion-map "\e?" 'PC-completion-help) - - (define-key must-match-map "\r" 'PC-complete-and-exit) - (define-key must-match-map "\n" 'PC-complete-and-exit) - - (define-key must-match-map "\e\r" 'PC-complete-and-exit) - (define-key must-match-map "\e\n" 'PC-complete-and-exit) - - (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) - -(defvar PC-do-completion-end nil - "Internal variable used by `PC-do-completion'.") - -(make-variable-buffer-local 'PC-do-completion-end) - -(defvar PC-goto-end nil - "Internal variable set in `PC-do-completion', used in -`choose-completion-string-functions'.") - -(make-variable-buffer-local 'PC-goto-end) - -;;;###autoload -(define-minor-mode partial-completion-mode - "Toggle Partial Completion mode. -With prefix ARG, turn Partial Completion mode on if ARG is positive. - -When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is -nil) is enhanced so that if some string is divided into words and each word is -delimited by a character in `PC-word-delimiters', partial words are completed -as much as possible and `*' characters are treated likewise in file names. - -For example, M-x p-c-m expands to M-x partial-completion-mode since no other -command begins with that sequence of characters, and -\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no -other file in that directory begins with that sequence of characters. - -Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted -specially in \\[find-file]. For example, -\\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'. -See also the variable `PC-include-file-path'. - -Partial Completion mode extends the meaning of `completion-auto-help' (which -see), so that if it is neither nil nor t, Emacs shows the `*Completions*' -buffer only on the second attempt to complete. That is, if TAB finds nothing -to complete, the first TAB just says \"Next char not unique\" and the -second TAB brings up the `*Completions*' buffer." - :global t :group 'partial-completion - ;; Deal with key bindings... - (PC-bindings partial-completion-mode) - ;; Deal with include file feature... - (cond ((not partial-completion-mode) - (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) - ((not PC-disable-includes) - (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) - ;; Adjust the completion selection in *Completion* buffers to the way - ;; we work. The default minibuffer completion code only completes the - ;; text before point and leaves the text after point alone (new in - ;; Emacs-22). In contrast we use the whole text and we even sometimes - ;; move point to a place before EOB, to indicate the first position where - ;; there's a difference, so when the user uses choose-completion, we have - ;; to trick choose-completion into replacing the whole minibuffer text - ;; rather than only the text before point. --Stef - (funcall - (if partial-completion-mode 'add-hook 'remove-hook) - 'choose-completion-string-functions - (lambda (choice buffer &rest ignored) - ;; When completing M-: (lisp- ) with point before the ), it is - ;; not appropriate to go to point-max (unlike the filename case). - (if (and (not PC-goto-end) - (minibufferp buffer)) - (goto-char (point-max)) - ;; Need a similar hack for the non-minibuffer-case -- gm. - (when PC-do-completion-end - (goto-char PC-do-completion-end) - (setq PC-do-completion-end nil))) - (setq PC-goto-end nil) - nil)) - ;; Build the env-completion and mapping table. - (when (and partial-completion-mode (null PC-env-vars-alist)) - (setq PC-env-vars-alist - (mapcar (lambda (string) - (let ((d (string-match "=" string))) - (cons (concat "$" (substring string 0 d)) - (and d (substring string (1+ d)))))) - process-environment)))) - - -(defun PC-complete () - "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. -For example, \"M-x b--di\" would match `byte-recompile-directory', or any -name which consists of three or more words, the first beginning with \"b\" -and the third beginning with \"di\". - -The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and -`beginning-of-defun', so this would produce a list of completions -just like when normal Emacs completions are ambiguous. - -Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", -\".\", and SPC." - (interactive) - (if (PC-was-meta-key) - (minibuffer-complete) - ;; If the previous command was not this one, - ;; never scroll, always retry completion. - (or (eq last-command this-command) - (setq minibuffer-scroll-window nil)) - (let ((window minibuffer-scroll-window)) - ;; If there's a fresh completion window with a live buffer, - ;; and this command is repeated, scroll that window. - (if (and window (window-buffer window) - (buffer-name (window-buffer window))) - (with-current-buffer (window-buffer window) - (if (pos-visible-in-window-p (point-max) window) - (set-window-start window (point-min) nil) - (scroll-other-window))) - (PC-do-completion nil))))) - - -(defun PC-complete-word () - "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. -See `PC-complete' for details. -This can be bound to other keys, like `-' and `.', if you wish." - (interactive) - (if (eq (PC-was-meta-key) PC-meta-flag) - (if (eq last-command-event ? ) - (minibuffer-complete-word) - (self-insert-command 1)) - (self-insert-command 1) - (if (eobp) - (PC-do-completion 'word)))) - - -(defun PC-complete-space () - "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. -See `PC-complete' for details. -This is suitable for binding to other keys which should act just like SPC." - (interactive) - (if (eq (PC-was-meta-key) PC-meta-flag) - (minibuffer-complete-word) - (insert " ") - (if (eobp) - (PC-do-completion 'word)))) - - -(defun PC-complete-and-exit () - "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. -See `PC-complete' for details." - (interactive) - (if (eq (PC-was-meta-key) PC-meta-flag) - (minibuffer-complete-and-exit) - (PC-do-complete-and-exit))) - -(defun PC-force-complete-and-exit () - "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. -See `PC-complete' for details." - (interactive) - (let ((minibuffer-completion-confirm nil)) - (PC-do-complete-and-exit))) - -(defun PC-do-complete-and-exit () - (cond - ((= (point-max) (minibuffer-prompt-end)) - ;; Duplicate the "bug" that Info-menu relies on... - (exit-minibuffer)) - ((eq minibuffer-completion-confirm 'confirm) - (if (or (eq last-command this-command) - (test-completion (field-string) - minibuffer-completion-table - minibuffer-completion-predicate)) - (exit-minibuffer) - (PC-temp-minibuffer-message " [Confirm]"))) - ((eq minibuffer-completion-confirm 'confirm-after-completion) - ;; Similar to the above, but only if trying to exit immediately - ;; after typing TAB (this catches most minibuffer typos). - (if (and (memq last-command minibuffer-confirm-exit-commands) - (not (test-completion (field-string) - minibuffer-completion-table - minibuffer-completion-predicate))) - (PC-temp-minibuffer-message " [Confirm]") - (exit-minibuffer))) - (t - (let ((flag (PC-do-completion 'exit))) - (and flag - (if (or (eq flag 'complete) - (not minibuffer-completion-confirm)) - (exit-minibuffer) - (PC-temp-minibuffer-message " [Confirm]"))))))) - - -(defun PC-completion-help () - "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. -See `PC-complete' for details." - (interactive) - (if (eq (PC-was-meta-key) PC-meta-flag) - (minibuffer-completion-help) - (PC-do-completion 'help))) - -(defun PC-was-meta-key () - (or (/= (length (this-command-keys)) 1) - (let ((key (aref (this-command-keys) 0))) - (if (integerp key) - (>= key 128) - (not (null (memq 'meta (event-modifiers key)))))))) - - -(defvar PC-ignored-extensions 'empty-cache) -(defvar PC-delims 'empty-cache) -(defvar PC-ignored-regexp nil) -(defvar PC-word-failed-flag nil) -(defvar PC-delim-regex nil) -(defvar PC-ndelims-regex nil) -(defvar PC-delims-list nil) - -(defvar PC-completion-as-file-name-predicate - (lambda () minibuffer-completing-file-name) - "A function testing whether a minibuffer completion now will work filename-style. -The function takes no arguments, and typically looks at the value -of `minibuffer-completion-table' and the minibuffer contents.") - -;; Returns the sequence of non-delimiter characters that follow regexp in string. -(defun PC-chunk-after (string regexp) - (if (not (string-match regexp string)) - (let ((message "String %s didn't match regexp %s")) - (message message string regexp) - (error message string regexp))) - (let ((result (substring string (match-end 0)))) - ;; result may contain multiple chunks - (if (string-match PC-delim-regex result) - (setq result (substring result 0 (match-beginning 0)))) - result)) - -(defun test-completion-ignore-case (str table pred) - "Like `test-completion', but ignores case when possible." - ;; Binding completion-ignore-case to nil ensures, for compatibility with - ;; standard completion, that the return value is exactly one of the - ;; possibilities. Do this binding only if pred is nil, out of paranoia; - ;; perhaps it is safe even if pred is non-nil. - (if pred - (test-completion str table pred) - (let ((completion-ignore-case nil)) - (test-completion str table pred)))) - -;; The following function is an attempt to work around two problems: - -;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to -;; return the value "". With a change from 2002-07-07 it returns t which caused -;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t" -;; error. `PC-try-completion' returns STRING in this case. - -;; (2) (try-completion "" '((""))) returned t before the above-mentioned change. -;; Since `PC-chop-word' operates on the return value of `try-completion' this -;; case might have provoked a similar error as in (1). `PC-try-completion' -;; returns "" instead. I don't know whether this is a real problem though. - -;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you -;; should try to look at the following discussions when you encounter problems: -;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23), -;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24), -;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]" -;; starting 2007-03-05). -(defun PC-try-completion (string alist &optional predicate) - "Like `try-completion' but return STRING instead of t." - (let ((result (try-completion string alist predicate))) - (if (eq result t) string result))) - -;; TODO document MODE magic... -(defun PC-do-completion (&optional mode beg end goto-end) - "Internal function to do the work of partial completion. -Text to be completed lies between BEG and END. Normally when -replacing text in the minibuffer, this function replaces up to -point-max (as is appropriate for completing a file name). If -GOTO-END is non-nil, however, it instead replaces up to END." - (or beg (setq beg (minibuffer-prompt-end))) - (or end (setq end (point-max))) - (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) - 'PC-read-file-name-internal - minibuffer-completion-table)) - (pred minibuffer-completion-predicate) - (filename (funcall PC-completion-as-file-name-predicate)) - (dirname nil) ; non-nil only if a filename is being completed - ;; The following used to be "(dirlength 0)" which caused the erasure of - ;; the entire buffer text before `point' when inserting a completion - ;; into a buffer. - dirlength - (str (buffer-substring beg end)) - (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) - (ambig nil) - basestr origstr - env-on - regex - p offset - abbreviated - (poss nil) - helpposs - (case-fold-search completion-ignore-case)) - - ;; Check if buffer contents can already be considered complete - (if (and (eq mode 'exit) - (test-completion str table pred)) - 'complete - - ;; Do substitutions in directory names - (and filename - (setq basestr (or (file-name-directory str) "")) - (setq dirlength (length basestr)) - ;; Do substitutions in directory names - (setq p (substitute-in-file-name basestr)) - (not (string-equal basestr p)) - (setq str (concat p (file-name-nondirectory str))) - (progn - (delete-region beg end) - (insert str) - (setq end (+ beg (length str))))) - - ;; Prepare various delimiter strings - (or (equal PC-word-delimiters PC-delims) - (setq PC-delims PC-word-delimiters - PC-delim-regex (concat "[" PC-delims "]") - PC-ndelims-regex (concat "[^" PC-delims "]*") - PC-delims-list (append PC-delims nil))) - - ;; Add wildcards if necessary - (and filename - (let ((dir (file-name-directory str)) - (file (file-name-nondirectory str)) - ;; The base dir for file-completion was passed in `predicate'. - (default-directory (if (stringp pred) (expand-file-name pred) - default-directory))) - (while (and (stringp dir) (not (file-directory-p dir))) - (setq dir (directory-file-name dir)) - (setq file (concat (replace-regexp-in-string - PC-delim-regex "*\\&" - (file-name-nondirectory dir)) - "*/" file)) - (setq dir (file-name-directory dir))) - (setq origstr str str (concat dir file)))) - - ;; Look for wildcard expansions in directory name - (and filename - (string-match "\\*.*/" str) - (let ((pat str) - ;; The base dir for file-completion was passed in `predicate'. - (default-directory (if (stringp pred) (expand-file-name pred) - default-directory)) - files) - (setq p (1+ (string-match "/[^/]*\\'" pat))) - (while (setq p (string-match PC-delim-regex pat p)) - (setq pat (concat (substring pat 0 p) - "*" - (substring pat p)) - p (+ p 2))) - (setq files (file-expand-wildcards (concat pat "*"))) - (if files - (let ((dir (file-name-directory (car files))) - (p files)) - (while (and (setq p (cdr p)) - (equal dir (file-name-directory (car p))))) - (if p - (setq filename nil table nil - pred (if (stringp pred) nil pred) - ambig t) - (delete-region beg end) - (setq str (concat dir (file-name-nondirectory str))) - (insert str) - (setq end (+ beg (length str))))) - (if origstr - ;; If the wildcards were introduced by us, it's - ;; possible that PC-read-file-name-internal can - ;; still find matches for the original string - ;; even if we couldn't, so remove the added - ;; wildcards. - (setq str origstr) - (setq filename nil table nil - pred (if (stringp pred) nil pred)))))) - - ;; Strip directory name if appropriate - (if filename - (if incname - (setq basestr (substring str incname) - dirname (substring str 0 incname)) - (setq basestr (file-name-nondirectory str) - dirname (file-name-directory str)) - ;; Make sure str is consistent with its directory and basename - ;; parts. This is important on DOZe'NT systems when str only - ;; includes a drive letter, like in "d:". - (setq str (concat dirname basestr))) - (setq basestr str)) - - ;; Convert search pattern to a standard regular expression - (setq regex (regexp-quote basestr) - offset (if (and (> (length regex) 0) - (not (eq (aref basestr 0) ?\*)) - (or (eq PC-first-char t) - (and PC-first-char filename))) 1 0) - p offset) - (while (setq p (string-match PC-delim-regex regex p)) - (if (eq (aref regex p) ? ) - (setq regex (concat (substring regex 0 p) - PC-ndelims-regex - PC-delim-regex - (substring regex (1+ p))) - p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) - (let ((bump (if (memq (aref regex p) - '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) - -1 0))) - (setq regex (concat (substring regex 0 (+ p bump)) - PC-ndelims-regex - (substring regex (+ p bump))) - p (+ p (length PC-ndelims-regex) 1))))) - (setq p 0) - (if filename - (while (setq p (string-match "\\\\\\*" regex p)) - (setq regex (concat (substring regex 0 p) - "[^/]*" - (substring regex (+ p 2)))))) - ;;(setq the-regex regex) - (setq regex (concat "\\`" regex)) - - (and (> (length basestr) 0) - (= (aref basestr 0) ?$) - (setq env-on t - table PC-env-vars-alist - pred nil)) - - ;; Find an initial list of possible completions - (unless (setq p (string-match (concat PC-delim-regex - (if filename "\\|\\*" "")) - str - (+ (length dirname) offset))) - - ;; Minibuffer contains no hyphens -- simple case! - (setq poss (all-completions (if env-on basestr str) - table - pred)) - (unless (or poss (string-equal str "")) - ;; Try completion as an abbreviation, e.g. "mvb" -> - ;; "m-v-b" -> "multiple-value-bind", but only for - ;; non-empty strings. - (setq origstr str - abbreviated t) - (if filename - (cond - ;; "alpha" or "/alpha" -> expand whole path. - ((string-match "^/?\\([A-Za-z0-9]+\\)$" str) - (setq - basestr "" - p nil - poss (file-expand-wildcards - (concat "/" - (mapconcat #'list (match-string 1 str) "*/") - "*")) - beg (1- beg))) - ;; Alphanumeric trailer -> expand trailing file - ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str) - (setq regex (concat "\\`" - (mapconcat #'list - (match-string 2 str) - "[A-Za-z0-9]*[^A-Za-z0-9]")) - p (1+ (length (match-string 1 str)))))) - (setq regex (concat "\\`" (mapconcat (lambda (c) - (regexp-quote (string c))) - str "[^-]*-")) - p 1)))) - (when p - ;; Use all-completions to do an initial cull. This is a big win, - ;; since all-completions is written in C! - (let ((compl (all-completions (if env-on - (file-name-nondirectory (substring str 0 p)) - (substring str 0 p)) - table - pred))) - (setq p compl) - (when (and compl abbreviated) - (if filename - (progn - (setq p nil) - (dolist (x compl) - (when (string-match regex x) - (push x p))) - (setq basestr (try-completion "" p))) - (setq basestr (mapconcat 'list str "-")) - (delete-region beg end) - (setq end (+ beg (length basestr))) - (insert basestr)))) - (while p - (and (string-match regex (car p)) - (progn - (set-text-properties 0 (length (car p)) '() (car p)) - (setq poss (cons (car p) poss)))) - (setq p (cdr p)))) - - ;; If table had duplicates, they can be here. - (delete-dups poss) - - ;; Handle completion-ignored-extensions - (and filename - (not (eq mode 'help)) - (let ((p2 poss)) - - ;; Build a regular expression representing the extensions list - (or (equal completion-ignored-extensions PC-ignored-extensions) - (setq PC-ignored-regexp - (concat "\\(" - (mapconcat - 'regexp-quote - (setq PC-ignored-extensions - completion-ignored-extensions) - "\\|") - "\\)\\'"))) - - ;; Check if there are any without an ignored extension. - ;; Also ignore `.' and `..'. - (setq p nil) - (while p2 - (or (string-match PC-ignored-regexp (car p2)) - (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) - (setq p (cons (car p2) p))) - (setq p2 (cdr p2))) - - ;; If there are "good" names, use them - (and p (setq poss p)))) - - ;; Now we have a list of possible completions - - (cond - - ;; No valid completions found - ((null poss) - (if (and (eq mode 'word) - (not PC-word-failed-flag)) - (let ((PC-word-failed-flag t)) - (delete-backward-char 1) - (PC-do-completion 'word)) - (when abbreviated - (delete-region beg end) - (insert origstr)) - (beep) - (PC-temp-minibuffer-message (if ambig - " [Ambiguous dir name]" - (if (eq mode 'help) - " [No completions]" - " [No match]"))) - nil)) - - ;; More than one valid completion found - ((or (cdr (setq helpposs poss)) - (memq mode '(help word))) - - ;; Is the actual string one of the possible completions? - (setq p (and (not (eq mode 'help)) poss)) - (while (and p - (not (string-equal (car p) basestr))) - (setq p (cdr p))) - (and p (null mode) - (PC-temp-minibuffer-message " [Complete, but not unique]")) - (if (and p - (not (and (null mode) - (eq this-command last-command)))) - t - - ;; If ambiguous, try for a partial completion - (let ((improved nil) - prefix - (pt nil) - (skip "\\`")) - - ;; Check if next few letters are the same in all cases - (if (and (not (eq mode 'help)) - (setq prefix (PC-try-completion - (PC-chunk-after basestr skip) poss))) - (let ((first t) i) - (if (eq mode 'word) - (setq prefix (PC-chop-word prefix basestr))) - (goto-char (+ beg (length dirname))) - (while (and (progn - (setq i 0) ; index into prefix string - (while (< i (length prefix)) - (if (and (< (point) end) - (or (eq (downcase (aref prefix i)) - (downcase (following-char))) - (and (looking-at " ") - (memq (aref prefix i) - PC-delims-list)))) - ;; replace " " by the actual delimiter - ;; or input char by prefix char - (progn - (delete-char 1) - (insert (substring prefix i (1+ i)))) - ;; insert a new character - (progn - (and filename (looking-at "\\*") - (progn - (delete-char 1) - (setq end (1- end)))) - (setq improved t) - (insert (substring prefix i (1+ i))) - (setq end (1+ end)))) - (setq i (1+ i))) - (or pt (setq pt (point))) - (looking-at PC-delim-regex)) - (setq skip (concat skip - (regexp-quote prefix) - PC-ndelims-regex) - prefix (PC-try-completion - (PC-chunk-after - ;; not basestr, because that does - ;; not reflect insertions - (buffer-substring - (+ beg (length dirname)) end) - skip) - (mapcar - (lambda (x) - (when (string-match skip x) - (substring x (match-end 0)))) - poss))) - (or (> i 0) (> (length prefix) 0)) - (or (not (eq mode 'word)) - (and first (> (length prefix) 0) - (setq first nil - prefix (substring prefix 0 1)))))) - (goto-char (if (eq mode 'word) end - (or pt beg))))) - - (if (and (eq mode 'word) - (not PC-word-failed-flag)) - - (if improved - - ;; We changed it... would it be complete without the space? - (if (test-completion (buffer-substring - (field-beginning) (1- end)) - table pred) - (delete-region (1- end) end))) - - (if improved - - ;; We changed it... enough to be complete? - (and (eq mode 'exit) - (test-completion-ignore-case (field-string) table pred)) - - ;; If totally ambiguous, display a list of completions - (if (or (eq completion-auto-help t) - (and completion-auto-help - (eq last-command this-command)) - (eq mode 'help)) - (let ((prompt-end (minibuffer-prompt-end))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list (sort helpposs 'string-lessp)) - (setq PC-do-completion-end end - PC-goto-end goto-end) - (with-current-buffer standard-output - ;; Record which part of the buffer we are completing - ;; so that choosing a completion from the list - ;; knows how much old text to replace. - ;; This was briefly nil in the non-dirname case. - ;; However, if one calls PC-lisp-complete-symbol - ;; on "(ne-f" with point on the hyphen, PC offers - ;; all completions starting with "(ne", some of - ;; which do not match the "-f" part (maybe it - ;; should not, but it does). In such cases, - ;; completion gets confused trying to figure out - ;; how much to replace, so we tell it explicitly - ;; (ie, the number of chars in the buffer before beg). - ;; - ;; Note that choose-completion-string-functions - ;; plays around with point. - (setq completion-base-size (if dirname - dirlength - (- beg prompt-end)))))) - (PC-temp-minibuffer-message " [Next char not unique]")) - ;; Expansion of filenames is not reversible, - ;; so just keep the prefix. - (when (and abbreviated filename) - (delete-region (point) end)) - nil))))) - - ;; Only one possible completion - (t - (if (and (equal basestr (car poss)) - (not (and env-on filename)) - (not abbreviated)) - (if (null mode) - (PC-temp-minibuffer-message " [Sole completion]")) - (delete-region beg end) - (insert (format "%s" - (if filename - (substitute-in-file-name (concat dirname (car poss))) - (car poss))))) - t))))) - -(defun PC-chop-word (new old) - (let ((i -1) - (j -1)) - (while (and (setq i (string-match PC-delim-regex old (1+ i))) - (setq j (string-match PC-delim-regex new (1+ j))))) - (if (and j - (or (not PC-word-failed-flag) - (setq j (string-match PC-delim-regex new (1+ j))))) - (substring new 0 (1+ j)) - new))) - -(defvar PC-not-minibuffer nil) - -(defun PC-temp-minibuffer-message (message) - "A Lisp version of `temp_minibuffer_message' from minibuf.c." - (cond (PC-not-minibuffer - (message "%s" message) - (sit-for 2) - (message "")) - ((fboundp 'temp-minibuffer-message) - (temp-minibuffer-message message)) - (t - (let ((point-max (point-max))) - (save-excursion - (goto-char point-max) - (insert message)) - (let ((inhibit-quit t)) - (sit-for 2) - (delete-region point-max (point-max)) - (when quit-flag - (setq quit-flag nil - unread-command-events '(7)))))))) - -;; Does not need to be buffer-local (?) because only used when one -;; PC-l-c-s immediately follows another. -(defvar PC-lisp-complete-end nil - "Internal variable used by `PC-lisp-complete-symbol'.") - -(defun PC-lisp-complete-symbol () - "Perform completion on Lisp symbol preceding point. -That symbol is compared against the symbols that exist -and any additional characters determined by what is there -are inserted. -If the symbol starts just after an open-parenthesis, -only symbols with function definitions are considered. -Otherwise, all symbols with function definitions, values -or properties are considered." - (interactive) - (let* ((end - (save-excursion - (with-syntax-table lisp-mode-syntax-table - (skip-syntax-forward "_w") - (point)))) - (beg (save-excursion - (with-syntax-table lisp-mode-syntax-table - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point)))) - (minibuffer-completion-table obarray) - (minibuffer-completion-predicate - (if (eq (char-after (1- beg)) ?\() - 'fboundp - (function (lambda (sym) - (or (boundp sym) (fboundp sym) - (symbol-plist sym)))))) - (PC-not-minibuffer t)) - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html - ;; - ;; This deals with cases like running PC-l-c-s on "M-: (n-f". - ;; The first call to PC-l-c-s expands this to "(ne-f", and moves - ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after, - ;; then without the last-command check, one is offered all - ;; completions of "(ne", which is presumably not what one wants. - ;; - ;; This is arguably (at least, it seems to be the existing intended - ;; behavior) what one _does_ want if point has been explicitly - ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds - ;; completion-base-size to nil, then completion does not replace the - ;; correct amount of text in such cases. - ;; - ;; Neither of these problems occur when using PC for filenames in the - ;; minibuffer, because in that case PC-do-completion is called without - ;; an explicit value for END, and so uses (point-max). This is fine for - ;; a filename, because the end of the filename must be at the end of - ;; the minibuffer. The same is not true for lisp symbols. - ;; - ;; [1] An alternate fix would be to not move point to the hyphen - ;; in such cases, but that would make the behavior different from - ;; that for filenames. It seems PC moves point to the site of the - ;; first difference between the possible completions. - ;; - ;; Alternatively alternatively, maybe end should be computed in - ;; the same way as beg. That would change the behavior though. - (if (equal last-command 'PC-lisp-complete-symbol) - (PC-do-completion nil beg PC-lisp-complete-end t) - (if PC-lisp-complete-end - (move-marker PC-lisp-complete-end end) - (setq PC-lisp-complete-end (copy-marker end t))) - (PC-do-completion nil beg end t)))) - -(defun PC-complete-as-file-name () - "Perform completion on file names preceding point. - Environment vars are converted to their values." - (interactive) - (let* ((end (point)) - (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" - (point-min) t) - (+ (point) 2) - (point-min))) - (minibuffer-completion-table 'PC-read-file-name-internal) - (minibuffer-completion-predicate nil) - (PC-not-minibuffer t)) - (goto-char end) - (PC-do-completion nil beg end))) - -;; Facilities for loading C header files. This is independent from the -;; main completion code. See also the variable `PC-include-file-path' -;; at top of this file. - -(defun PC-look-for-include-file () - (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) - (let ((name (substring (buffer-file-name) - (match-beginning 1) (match-end 1))) - (punc (aref (buffer-file-name) (match-beginning 0))) - (path nil) - new-buf) - (kill-buffer (current-buffer)) - (if (equal name "") - (with-current-buffer (car (buffer-list)) - (save-excursion - (beginning-of-line) - (if (looking-at - "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") - (setq name (buffer-substring (match-beginning 1) - (match-end 1)) - punc (char-after (1- (match-beginning 1)))) - ;; Suggested by Frank Siebenlist: - (if (or (looking-at - "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") - (looking-at - "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") - (looking-at - "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) - (progn - (setq name (buffer-substring (match-beginning 1) - (match-end 1)) - punc ?\< - path load-path) - (if (string-match "\\.elc$" name) - (setq name (substring name 0 -1)) - (or (string-match "\\.el$" name) - (setq name (concat name ".el"))))) - (error "Not on an #include line")))))) - (or (string-match "\\.[[:alnum:]]+$" name) - (setq name (concat name ".h"))) - (if (eq punc ?\<) - (let ((path (or path (PC-include-file-path)))) - (while (and path - (not (file-exists-p - (concat (file-name-as-directory (car path)) - name)))) - (setq path (cdr path))) - (if path - (setq name (concat (file-name-as-directory (car path)) name)) - (error "No such include file: <%s>" name))) - (let ((dir (with-current-buffer (car (buffer-list)) - default-directory))) - (if (file-exists-p (concat dir name)) - (setq name (concat dir name)) - (error "No such include file: `%s'" name)))) - (setq new-buf (get-file-buffer name)) - (if new-buf - ;; no need to verify last-modified time for this! - (set-buffer new-buf) - (set-buffer (create-file-buffer name)) - (erase-buffer) - (insert-file-contents name t)) - ;; Returning non-nil with the new buffer current - ;; is sufficient to tell find-file to use it. - t) - nil)) - -(defun PC-include-file-path () - (or PC-include-file-path - (let ((env (getenv "INCPATH")) - (path nil) - pos) - (or env (error "No include file path specified")) - (while (setq pos (string-match ":[^:]+$" env)) - (setq path (cons (substring env (1+ pos)) path) - env (substring env 0 pos))) - path))) - -;; This is adapted from lib-complete.el, by Mike Williams. -(defun PC-include-file-all-completions (file search-path &optional full) - "Return all completions for FILE in any directory on SEARCH-PATH. -If optional third argument FULL is non-nil, returned pathnames should be -absolute rather than relative to some directory on the SEARCH-PATH." - (setq search-path - (mapcar (lambda (dir) - (if dir (file-name-as-directory dir) default-directory)) - search-path)) - (if (file-name-absolute-p file) - ;; It's an absolute file name, so don't need search-path - (progn - (setq file (expand-file-name file)) - (file-name-all-completions - (file-name-nondirectory file) (file-name-directory file))) - (let ((subdir (file-name-directory file)) - (ndfile (file-name-nondirectory file)) - file-lists) - ;; Append subdirectory part to each element of search-path - (if subdir - (setq search-path - (mapcar (lambda (dir) (concat dir subdir)) - search-path) - file )) - ;; Make list of completions in each directory on search-path - (while search-path - (let* ((dir (car search-path)) - (subdir (if full dir subdir))) - (if (file-directory-p dir) - (progn - (setq file-lists - (cons - (mapcar (lambda (file) (concat subdir file)) - (file-name-all-completions ndfile - (car search-path))) - file-lists)))) - (setq search-path (cdr search-path)))) - ;; Compress out duplicates while building complete list (slloooow!) - (let ((sorted (sort (apply 'nconc file-lists) - (lambda (x y) (not (string-lessp x y))))) - compressed) - (while sorted - (if (equal (car sorted) (car compressed)) nil - (setq compressed (cons (car sorted) compressed))) - (setq sorted (cdr sorted))) - compressed)))) - -(defun PC-read-file-name-internal (string pred action) - "Extend `read-file-name-internal' to handle include files. -This is only used by " - (if (string-match "<\\([^\"<>]*\\)>?\\'" string) - (let* ((name (match-string 1 string)) - (str2 (substring string (match-beginning 0))) - (completion-table - (mapcar (lambda (x) - (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) - (PC-include-file-all-completions - name (PC-include-file-path))))) - (cond - ((not completion-table) nil) - ((eq action 'lambda) (test-completion str2 completion-table nil)) - ((eq action nil) (PC-try-completion str2 completion-table nil)) - ((eq action t) (all-completions str2 completion-table nil)))) - (read-file-name-internal string pred action))) - - -(provide 'complete) - -;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 -;;; complete.el ends here
--- a/lisp/dired.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/dired.el Thu Apr 15 11:20:03 2010 +0200 @@ -3974,7 +3974,7 @@ ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" -;;;;;; "bb37ec379c0a523368794491b691fd8d") +;;;;;; "2f8d3d5a31b969b181e23c40d6bb16a0") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\
--- a/lisp/emacs-lisp/cl-loaddefs.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emacs-lisp/cl-loaddefs.el Thu Apr 15 11:20:03 2010 +0200 @@ -282,7 +282,7 @@ ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "273ba25f4a116c61a464dbe55f1f8c63") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "7fad7dd60f2f96ba90432f885015d61b") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\
--- a/lisp/emacs-lisp/cl-macs.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emacs-lisp/cl-macs.el Thu Apr 15 11:20:03 2010 +0200 @@ -128,6 +128,12 @@ (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) (defun cl-expr-access-order (x v) + ;; This apparently tries to return nil iff the expression X evaluates + ;; the variables V in the same order as they appear in V (so as to + ;; be able to replace those vars with the expressions they're bound + ;; to). + ;; FIXME: This is very naive, it doesn't even check to see if those + ;; variables appear more than once. (if (cl-const-expr-p x) v (if (consp x) (progn @@ -2616,21 +2622,36 @@ (cons '&cl-quote args)) (list* 'cl-defsubst-expand (list 'quote argns) (list 'quote (list* 'block name body)) - (not (or unsafe (cl-expr-access-order pbody argns))) + ;; We used to pass `simple' as + ;; (not (or unsafe (cl-expr-access-order pbody argns))) + ;; But this is much too simplistic since it + ;; does not pay attention to the argvs (and + ;; cl-expr-access-order itself is also too naive). + nil (and (memq '&key args) 'cl-whole) unsafe argns))) (list* 'defun* name args body)))) (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole (if (cl-simple-exprs-p argvs) (setq simple t)) - (let ((lets (delq nil - (mapcar* (function - (lambda (argn argv) - (if (or simple (cl-const-expr-p argv)) - (progn (setq body (subst argv argn body)) - (and unsafe (list argn argv))) - (list argn argv)))) - argns argvs)))) + (let* ((substs ()) + (lets (delq nil + (mapcar* (function + (lambda (argn argv) + (if (or simple (cl-const-expr-p argv)) + (progn (push (cons argn argv) substs) + (and unsafe (list argn argv))) + (list argn argv)))) + argns argvs)))) + ;; FIXME: `sublis/subst' will happily substitute the symbol + ;; `argn' in places where it's not used as a reference + ;; to a variable. + ;; FIXME: `sublis/subst' will happily copy `argv' to a different + ;; scope, leading to name capture. + (setq body (cond ((null substs) body) + ((null (cdr substs)) + (subst (cdar substs) (caar substs) body)) + (t (sublis substs body)))) (if lets (list 'let lets body) body))))
--- a/lisp/emacs-lisp/easy-mmode.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emacs-lisp/easy-mmode.el Thu Apr 15 11:20:03 2010 +0200 @@ -222,15 +222,10 @@ (interactive (list (or current-prefix-arg 'toggle))) (let ((,last-message (current-message))) (setq ,mode - (cond - ((eq arg 'toggle) (not ,mode)) - (arg (> (prefix-numeric-value arg) 0)) - (t - (if (null ,mode) t - (message - "Toggling %s off; better pass an explicit argument." - ',mode) - nil)))) + (if (eq arg 'toggle) + (not ,mode) + ;; A nil argument also means ON now. + (> (prefix-numeric-value arg) 0))) ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
--- a/lisp/emulation/cua-base.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emulation/cua-base.el Thu Apr 15 11:20:03 2010 +0200 @@ -1440,6 +1440,8 @@ ;; scrolling (define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up) (define-key cua-global-keymap [remap scroll-down] 'cua-scroll-down) + (define-key cua-global-keymap [remap scroll-up-command] 'cua-scroll-up) + (define-key cua-global-keymap [remap scroll-down-command] 'cua-scroll-down) (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region) (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill) @@ -1499,6 +1501,7 @@ move-end-of-line move-beginning-of-line end-of-buffer beginning-of-buffer scroll-up scroll-down + scroll-up-command scroll-down-command up-list down-list backward-up-list end-of-defun beginning-of-defun forward-sexp backward-sexp
--- a/lisp/emulation/cua-rect.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emulation/cua-rect.el Thu Apr 15 11:20:03 2010 +0200 @@ -1432,6 +1432,8 @@ (define-key cua--rectangle-keymap [remap beginning-of-buffer] 'cua-resize-rectangle-top) (define-key cua--rectangle-keymap [remap scroll-down] 'cua-resize-rectangle-page-up) (define-key cua--rectangle-keymap [remap scroll-up] 'cua-resize-rectangle-page-down) + (define-key cua--rectangle-keymap [remap scroll-down-command] 'cua-resize-rectangle-page-up) + (define-key cua--rectangle-keymap [remap scroll-up-command] 'cua-resize-rectangle-page-down) (define-key cua--rectangle-keymap [remap delete-backward-char] 'cua-delete-char-rectangle) (define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle)
--- a/lisp/emulation/pc-select.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emulation/pc-select.el Thu Apr 15 11:20:03 2010 +0200 @@ -93,6 +93,9 @@ errors are suppressed." :type 'boolean :group 'pc-select) +(define-obsolete-variable-alias 'pc-select-override-scroll-error + 'scroll-error-top-bottom + "24.1") (defcustom pc-select-selection-keys-only nil "*Non-nil means only bind the basic selection keys when started.
--- a/lisp/emulation/ws-mode.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/emulation/ws-mode.el Thu Apr 15 11:20:03 2010 +0200 @@ -339,16 +339,6 @@ (+ left-margin (/ (- fill-column left-margin line-length) 2)))))) -(defun scroll-down-line () - "Scroll one line down." - (interactive) - (scroll-down 1)) - -(defun scroll-up-line () - "Scroll one line up." - (interactive) - (scroll-up 1)) - ;;;;;;;;;;; ;; wordstar special variables:
--- a/lisp/eshell/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Generated files -precious ^(esh-groups)\.el$ - -# arch-tag: 8dc7bfaa-6ca6-4be0-915a-1e539c3dabfb
--- a/lisp/forms.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/forms.el Thu Apr 15 11:20:03 2010 +0200 @@ -1407,7 +1407,9 @@ (if forms-forms-scroll (progn (local-set-key [remap scroll-up] 'forms-next-record) - (local-set-key [remap scroll-down] 'forms-prev-record))) + (local-set-key [remap scroll-down] 'forms-prev-record) + (local-set-key [remap scroll-up-command] 'forms-next-record) + (local-set-key [remap scroll-down-command] 'forms-prev-record))) ;; ;; beginning-of-buffer -> forms-first-record ;; end-of-buffer -> forms-end-record
--- a/lisp/gnus/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/gnus/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,22 @@ +2010-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-sum.el (gnus-summary-bookmark-make-record): Add `location' field. + +2010-04-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-sum.el: Add bookmark declarations to silence the compiler. + (gnus-mark-xrefs-as-read, gnus-summary-limit-to-bodies): + Use with-current-buffer to silence the byte-compiler. + (gnus-summary-bookmark-make-record): Use derived-mode-p and don't + bother to require `gnus'. + (gnus-summary-bookmark-jump): Don't forget to autoload. Simplify. + +2010-04-12 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * gnus-sum.el (gnus-summary-bookmark-make-record) + (gnus-summary-bookmark-jump): New functions. + (gnus-summary-mode): Setup bookmark support. + 2010-04-01 Andreas Schwab <schwab@linux-m68k.org> * mm-uu.el (mm-uu-pgp-signed-extract-1): Use buffer-file-coding-system
--- a/lisp/gnus/gnus-sum.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Thu Apr 15 11:20:03 2010 +0200 @@ -3017,7 +3017,7 @@ (declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ()) - +(defvar bookmark-make-record-function) (defun gnus-summary-mode (&optional group) @@ -3072,6 +3072,8 @@ (gnus-run-mode-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) (mm-enable-multibyte) + (set (make-local-variable 'bookmark-make-record-function) + 'gnus-summary-bookmark-make-record) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -6090,8 +6092,7 @@ "Look through all the headers and mark the Xrefs as read." (let ((virtual (gnus-virtual-group-p from-newsgroup)) name info xref-hashtb idlist method nth4) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) (mapatoms @@ -8341,8 +8342,7 @@ (dolist (data gnus-newsgroup-data) (let (gnus-mark-article-hook) (gnus-summary-select-article t t nil (gnus-data-number data))) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (article-goto-body) (let* ((case-fold-search t) (found (if headersp @@ -9026,7 +9026,7 @@ (setq group (format "%s-%d" gnus-newsgroup-name article)) (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) - (save-excursion + (save-excursion ;;What for? (with-temp-buffer (insert-buffer-substring gnus-original-article-buffer) ;; Remove some headers that may lead nndoc to make @@ -12640,6 +12640,42 @@ (gnus-summary-limit (gnus-sorted-nunion old new)))) (gnus-summary-position-point))) +;;; Bookmark support for Gnus. +(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-default-handler "bookmark" (bmk)) +(declare-function bookmark-get-bookmark-record "bookmark" (bmk)) + +(defun gnus-summary-bookmark-make-record () + "Make a bookmark entry for a Gnus summary buffer." + (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current) + (error "Please retry from the Gnus summary buffer")) ;[1] + (let* ((subject (elt (gnus-summary-article-header) 1)) + (grp (car gnus-article-current)) + (art (cdr gnus-article-current)) + (head (gnus-summary-article-header art)) + (id (mail-header-id head))) + `(,subject + ,@(bookmark-make-record-default 'point-only) + (location . ,(format "Gnus %s:%d:%s" grp art id)) + (group . ,grp) (article . ,art) + (message-id . ,id) (handler . gnus-summary-bookmark-jump)))) + +;;;###autoload +(defun gnus-summary-bookmark-jump (bookmark) + "Handler function for record returned by `gnus-summary-bookmark-make-record'. +BOOKMARK is a bookmark name or a bookmark record." + (let ((group (bookmark-prop-get bookmark 'group)) + (article (bookmark-prop-get bookmark 'article)) + (id (bookmark-prop-get bookmark 'message-id))) + (gnus-fetch-group group (list article)) + (gnus-summary-insert-cached-articles) + (gnus-summary-goto-article id nil 'force) + (bookmark-default-handler + `("" + (buffer . ,(current-buffer)) + . ,(bookmark-get-bookmark-record bookmark))))) + (gnus-summary-make-all-marking-commands) (gnus-ems-redefine)
--- a/lisp/help.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/help.el Thu Apr 15 11:20:03 2010 +0200 @@ -872,7 +872,9 @@ (insert (format-mode-line mode nil nil buffer)) (add-text-properties start (point) '(face bold))))) (princ " mode:\n") - (princ (documentation major-mode)))))) + (princ (documentation major-mode))))) + ;; For the sake of IELM and maybe others + nil) (defun describe-minor-mode (minor-mode)
--- a/lisp/ido.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/ido.el Thu Apr 15 11:20:03 2010 +0200 @@ -323,6 +323,7 @@ ;;; Code: (defvar cua-inhibit-cua-keys) +(defvar recentf-list) ;;; User Variables ;; @@ -774,6 +775,24 @@ :type '(repeat string) :group 'ido) +(defcustom ido-use-virtual-buffers nil + "If non-nil, refer to past buffers as well as existing ones. +Essentially it works as follows: Say you are visiting a file and +the buffer gets cleaned up by mignight.el. Later, you want to +switch to that buffer, but find it's no longer open. With +virtual buffers enabled, the buffer name stays in the buffer +list (using the ido-virtual face, and always at the end), and if +you select it, it opens the file back up again. This allows you +to think less about whether recently opened files are still open +or not. Most of the time you can quit Emacs, restart, and then +switch to a file buffer that was previously open as if it still +were. + This feature relies upon the `recentf' package, which will be +enabled if this variable is configured to a non-nil value." + :version "24.1" + :type 'boolean + :group 'ido) + (defcustom ido-use-faces t "Non-nil means use ido faces to highlighting first match, only match and subdirs in the alternatives." @@ -798,6 +817,11 @@ "Face used by ido for highlighting subdirs in the alternatives." :group 'ido) +(defface ido-virtual '((t (:inherit font-lock-builtin-face))) + "Face used by ido for matching virtual buffer names." + :version "24.1" + :group 'ido) + (defface ido-indicator '((((min-colors 88) (class color)) (:foreground "yellow1" :background "red1" @@ -1030,6 +1054,11 @@ "Non-nil means to explicitly cursor on entry to minibuffer. Value is an integer which is number of chars to right of prompt.") +(defvar ido-virtual-buffers nil + "List of virtual buffers, that is, past visited files. +This is a copy of `recentf-list', pared down and with faces applied. +Only used if `ido-use-virtual-buffers' is non-nil.") + ;;; Variables with dynamic bindings. ;;; Declared here to keep the byte compiler quiet. @@ -2155,7 +2184,8 @@ (ido-directory-too-big nil) (require-match (confirm-nonexistent-file-or-buffer)) (buf (ido-read-internal 'buffer (or prompt "Buffer: ") 'ido-buffer-history default - require-match initial))) + require-match initial)) + filename) ;; Choose the buffer name: either the text typed in, or the head ;; of the list of matches @@ -2191,6 +2221,16 @@ (point)))) (ido-visit-buffer buf method t))) + ;; check for a virtual buffer reference + ((and ido-use-virtual-buffers ido-virtual-buffers + (setq filename (assoc buf ido-virtual-buffers))) + (ido-visit-buffer (find-file-noselect (cdr filename)) method t)) + + ((and (eq ido-create-new-buffer 'prompt) + (null require-match) + (not (y-or-n-p (format "No buffer matching `%s', create one? " buf)))) + nil) + ;; buffer doesn't exist ((and (eq ido-create-new-buffer 'never) (null require-match)) @@ -3344,15 +3384,41 @@ (if ido-temp-list (nconc ido-temp-list ido-current-buffers) (setq ido-temp-list ido-current-buffers)) - (if (and default (buffer-live-p (get-buffer default))) - (progn - (setq ido-temp-list - (delete default ido-temp-list)) - (setq ido-temp-list - (cons default ido-temp-list)))) + (when (and default (buffer-live-p (get-buffer default))) + (setq ido-temp-list + (cons default (delete default ido-temp-list)))) + (if ido-use-virtual-buffers + (ido-add-virtual-buffers-to-list)) (run-hooks 'ido-make-buffer-list-hook) ido-temp-list)) +(defun ido-add-virtual-buffers-to-list () + "Add recently visited files, and bookmark files, to the buffer list. +This is to make them appear as if they were \"virtual buffers\"." + ;; If no buffers matched, and virtual buffers are being used, then + ;; consult the list of past visited files, to see if we can find + ;; the file which the user might thought was still open. + (unless recentf-mode (recentf-mode 1)) + (setq ido-virtual-buffers nil) + (let (name) + (dolist (head recentf-list) + (and (setq name (file-name-nondirectory head)) + (null (get-file-buffer head)) + (not (assoc name ido-virtual-buffers)) + (not (member name ido-temp-list)) + (not (ido-ignore-item-p name ido-ignore-buffers)) + ;;(file-exists-p head) + (push (cons name head) ido-virtual-buffers)))) + (when ido-virtual-buffers + (if ido-use-faces + (dolist (comp ido-virtual-buffers) + (put-text-property 0 (length (car comp)) + 'face 'ido-virtual + (car comp)))) + (setq ido-temp-list + (nconc ido-temp-list + (nreverse (mapcar #'car ido-virtual-buffers)))))) + (defun ido-make-choice-list (default) ;; Return the current list of choices. ;; If DEFAULT is non-nil, and corresponds to an element of choices, @@ -3392,7 +3458,7 @@ ;; Strip method:user@host: part of tramp completions. ;; Tramp completions do not include leading slash. (let* ((len (1- (length dir))) - (tramp-completion-mode t) + (non-essential t) (compl (or (file-name-all-completions "" dir) ;; work around bug in ange-ftp.
--- a/lisp/image-mode.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/image-mode.el Thu Apr 15 11:20:03 2010 +0200 @@ -302,6 +302,8 @@ (define-key map [remap next-line] 'image-next-line) (define-key map [remap scroll-up] 'image-scroll-up) (define-key map [remap scroll-down] 'image-scroll-down) + (define-key map [remap scroll-up-command] 'image-scroll-up) + (define-key map [remap scroll-down-command] 'image-scroll-down) (define-key map [remap move-beginning-of-line] 'image-bol) (define-key map [remap move-end-of-line] 'image-eol) (define-key map [remap beginning-of-buffer] 'image-bob)
--- a/lisp/info.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/info.el Thu Apr 15 11:20:03 2010 +0200 @@ -3833,7 +3833,7 @@ ;; Autoload cookie needed by desktop.el ;;;###autoload -(defun Info-mode () +(define-derived-mode Info-mode nil "Info" "Info mode provides commands for browsing through the Info documentation tree. Documentation in Info is divided into \"nodes\", each of which discusses one topic and contains references to other nodes which discuss related @@ -3895,23 +3895,17 @@ \\[clone-buffer] Select a new cloned Info buffer in another window. \\[universal-argument] \\[info] Move to new Info file with completion. \\[universal-argument] N \\[info] Select Info buffer with prefix number in the name *info*<N>." - (kill-all-local-variables) - (setq major-mode 'Info-mode) - (setq mode-name "Info") + :syntax-table text-mode-syntax-table + :abbrev-table text-mode-abbrev-table (setq tab-width 8) - (use-local-map Info-mode-map) (add-hook 'activate-menubar-hook 'Info-menu-update nil t) - (set-syntax-table text-mode-syntax-table) - (setq local-abbrev-table text-mode-abbrev-table) (setq case-fold-search t) (setq buffer-read-only t) (make-local-variable 'Info-current-file) (make-local-variable 'Info-current-subfile) (make-local-variable 'Info-current-node) - (make-local-variable 'Info-tag-table-marker) - (setq Info-tag-table-marker (make-marker)) - (make-local-variable 'Info-tag-table-buffer) - (setq Info-tag-table-buffer nil) + (set (make-local-variable 'Info-tag-table-marker) (make-marker)) + (set (make-local-variable 'Info-tag-table-buffer) nil) (make-local-variable 'Info-history) (make-local-variable 'Info-history-forward) (make-local-variable 'Info-index-alternatives) @@ -3920,12 +3914,10 @@ '(:eval (get-text-property (point-min) 'header-line)))) (set (make-local-variable 'tool-bar-map) info-tool-bar-map) ;; This is for the sake of the invisible text we use handling titles. - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t) - (make-local-variable 'desktop-save-buffer) - (make-local-variable 'widen-automatically) - (setq widen-automatically nil) - (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) + (set (make-local-variable 'line-move-ignore-invisible) t) + (set (make-local-variable 'desktop-save-buffer) + 'Info-desktop-buffer-misc-data) + (set (make-local-variable 'widen-automatically) nil) (add-hook 'kill-buffer-hook 'Info-kill-buffer nil t) (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) @@ -3944,8 +3936,7 @@ 'Info-revert-buffer-function) (Info-set-mode-line) (set (make-local-variable 'bookmark-make-record-function) - 'Info-bookmark-make-record) - (run-mode-hooks 'Info-mode-hook)) + 'Info-bookmark-make-record)) ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too.
--- a/lisp/man.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/man.el Thu Apr 15 11:20:03 2010 +0200 @@ -221,6 +221,11 @@ :type '(repeat string) :group 'man) +(defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$") + "Regexp that matches the text that precedes the command's name. +Used in `bookmark-set' to get the default bookmark name." + :type 'string :group 'bookmark) + (defvar manual-program "man" "The name of the program that produces man pages.") @@ -883,7 +888,8 @@ (man man-args))) (defun Man-getpage-in-background (topic) - "Use TOPIC to build and fire off the manpage and cleaning command." + "Use TOPIC to build and fire off the manpage and cleaning command. +Return the buffer in which the manpage will appear." (let* ((man-args topic) (bufname (concat "*Man " man-args "*")) (buffer (get-buffer bufname))) @@ -961,15 +967,16 @@ (format "exited abnormally with code %d" exit-status))) (setq msg exit-status)) - (Man-bgproc-sentinel bufname msg))))))) + (Man-bgproc-sentinel bufname msg))))) + buffer)) (defun Man-notify-when-ready (man-buffer) "Notify the user when MAN-BUFFER is ready. See the variable `Man-notify-method' for the different notification behaviors." (let ((saved-frame (with-current-buffer man-buffer Man-original-frame))) - (cond - ((eq Man-notify-method 'newframe) + (case Man-notify-method + (newframe ;; Since we run asynchronously, perhaps while Emacs is waiting ;; for input, we must not leave a different buffer current. We ;; can't rely on the editor command loop to reselect the @@ -980,28 +987,27 @@ (set-window-dedicated-p (frame-selected-window frame) t) (or (display-multi-frame-p frame) (select-frame frame))))) - ((eq Man-notify-method 'pushy) + (pushy (switch-to-buffer man-buffer)) - ((eq Man-notify-method 'bully) + (bully (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer) (delete-other-windows)) - ((eq Man-notify-method 'aggressive) + (aggressive (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer)) - ((eq Man-notify-method 'friendly) + (friendly (and (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) - ((eq Man-notify-method 'polite) + (polite (beep) (message "Manual buffer %s is ready" (buffer-name man-buffer))) - ((eq Man-notify-method 'quiet) + (quiet (message "Manual buffer %s is ready" (buffer-name man-buffer))) - ((or (eq Man-notify-method 'meek) - t) + (t ;; meek (message "")) ))) @@ -1269,6 +1275,8 @@ ;; ====================================================================== ;; set up manual mode in buffer and build alists +(defvar bookmark-make-record-function) + (put 'Man-mode 'mode-class 'special) (defun Man-mode () @@ -1325,6 +1333,8 @@ (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) (set (make-local-variable 'outline-regexp) Man-heading-regexp) (set (make-local-variable 'outline-level) (lambda () 1)) + (set (make-local-variable 'bookmark-make-record-function) + 'Man-bookmark-make-record) (Man-build-page-list) (Man-strip-page-headers) (Man-unindent) @@ -1659,6 +1669,45 @@ (setq path nil)) (setq complete-path nil))) complete-path)) + +;;; Bookmark Man Support +(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-default-handler "bookmark" (bmk)) +(declare-function bookmark-get-bookmark-record "bookmark" (bmk)) + +(defun Man-default-bookmark-title () + "Default bookmark name for Man or WoMan pages. +Uses `Man-name-local-regexp'." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward Man-name-local-regexp nil t) + (skip-chars-forward "\n\t ") + (buffer-substring-no-properties (point) (line-end-position))))) + +(defun Man-bookmark-make-record () + "Make a bookmark entry for a Man buffer." + `(,(Man-default-bookmark-title) + ,@(bookmark-make-record-default 'point-only) + (location . ,(concat "man " Man-arguments)) + (man-args . ,Man-arguments) + (handler . Man-bookmark-jump))) + +;;;###autoload +(defun Man-bookmark-jump (bookmark) + "Default bookmark handler for Man buffers." + (let* ((man-args (bookmark-prop-get bookmark 'man-args)) + ;; Let bookmark.el do the window handling. + ;; This let-binding needs to be active during the call to both + ;; Man-getpage-in-background and accept-process-output. + (Man-notify-method 'meek) + (buf (Man-getpage-in-background man-args)) + (proc (get-buffer-process buf))) + (while (and proc (eq (process-status proc) 'run)) + (accept-process-output proc)) + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) + ;; Init the man package variables, if not already done. (Man-init-defvars)
--- a/lisp/mh-e/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(mh-loaddefs)\.el$ - -# arch-tag: 03c1cf02-6c80-44af-b4ec-b41b53fbf8f2
--- a/lisp/minibuffer.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/minibuffer.el Thu Apr 15 11:20:03 2010 +0200 @@ -1028,7 +1028,8 @@ "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (let* ((start (field-beginning)) + (let* ((non-essential t) + (start (field-beginning)) (string (field-string)) (completions (completion-all-completions string
--- a/lisp/mwheel.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/mwheel.el Thu Apr 15 11:20:03 2010 +0200 @@ -246,6 +246,8 @@ (run-with-timer mouse-wheel-inhibit-click-time nil 'mwheel-inhibit-click-timeout)))) +(add-to-list 'scroll-preserve-screen-position-commands 'mwheel-scroll) + (defvar mwheel-installed-bindings nil) ;; preloaded ;;;###autoload
--- a/lisp/net/tramp-compat.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/net/tramp-compat.el Thu Apr 15 11:20:03 2010 +0200 @@ -22,9 +22,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is GNU Emacs 23. This -;; package provides compatibility functions for GNU Emacs 21, GNU -;; Emacs 22 and XEmacs 21.4+. +;; Tramp's main Emacs version for development is GNU Emacs 24. This +;; package provides compatibility functions for GNU Emacs 22, GNU +;; Emacs 23 and XEmacs 21.4+. ;;; Code: @@ -120,7 +120,7 @@ (tramp-file-name-handler 'file-remote-p file identification connected))))) - ;; `process-file' exists since Emacs 22. + ;; `process-file' does not exist in XEmacs. (unless (fboundp 'process-file) (defalias 'process-file (lambda (program &optional infile buffer display &rest args) @@ -154,7 +154,9 @@ ;; return the original filename if it can't expand anything. Let's ;; just hope that this doesn't break anything else. ;; It is not needed anymore since GNU Emacs 23.2. - (unless (or (featurep 'xemacs) (featurep 'files 'remote-wildcards)) + (unless (or (featurep 'xemacs) + ;; `featurep' has only one argument in XEmacs. + (funcall 'featurep 'files 'remote-wildcards)) (defadvice file-expand-wildcards (around tramp-advice-file-expand-wildcards activate) (let ((name (ad-get-arg 0))) @@ -211,10 +213,9 @@ "`temp-directory' is defined -- using /tmp.")) (file-name-as-directory "/tmp")))) -;; `make-temp-file' exists in Emacs only. The third parameter SUFFIX -;; has been introduced with Emacs 22. We try it, if it fails, we fall -;; back to `make-temp-name', creating the temporary file immediately -;; in order to avoid a security hole. +;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own +;; implementation with `make-temp-name', creating the temporary file +;; immediately in order to avoid a security hole. (defsubst tramp-compat-make-temp-file (filename &optional dir-flag) "Create a temporary file (compat function). Add the extension of FILENAME, if existing." @@ -224,43 +225,34 @@ (tramp-compat-temporary-file-directory))) (extension (file-name-extension filename t)) result) - (condition-case nil + (if (fboundp 'make-temp-file) (setq result (funcall (symbol-function 'make-temp-file) prefix dir-flag extension)) - (error - ;; We use our own implementation, taken from files.el. - (while - (condition-case () - (progn - (setq result (concat (make-temp-name prefix) extension)) - (if dir-flag - (make-directory result) - (write-region - "" nil result nil 'silent nil - ;; 7th parameter is MUSTBENEW in Emacs, and - ;; CODING-SYSTEM in XEmacs. It is not a security - ;; hole in XEmacs if we cannot use this parameter, - ;; because XEmacs uses a user-specific - ;; subdirectory with 0700 permissions. - (when (not (featurep 'xemacs)) 'excl))) - nil) - (file-already-exists t)) - ;; The file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil))) + ;; We use our own implementation, taken from files.el. + (while + (condition-case () + (progn + (setq result (concat (make-temp-name prefix) extension)) + (if dir-flag + (make-directory result) + (write-region "" nil result nil 'silent)) + nil) + (file-already-exists t)) + ;; The file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil)) result)) -;; `most-positive-fixnum' arrived in Emacs 22. Before, and in XEmacs, -;; it is a fixed value. +;; `most-positive-fixnum' does not exist in XEmacs. (defsubst tramp-compat-most-positive-fixnum () "Return largest positive integer value (compat function)." (cond ((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum)) - ;; Default value in XEmacs and Emacs 21. + ;; Default value in XEmacs. (t 134217727))) -;; ID-FORMAT exists since Emacs 22. +;; ID-FORMAT does not exists in XEmacs. (defun tramp-compat-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files (compat function)." (cond @@ -292,8 +284,8 @@ (funcall (symbol-function 'copy-directory) directory newname keep-time parents) - ;; If default-directory is a remote directory, make sure we find - ;; its copy-directory handler. + ;; If `default-directory' is a remote directory, make sure we find + ;; its `copy-directory' handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) (find-file-name-handler newname 'copy-directory)))) (if handler @@ -325,32 +317,28 @@ (if keep-time (set-file-times newname (nth 5 (file-attributes directory)))))))) -;; `copy-tree' is a built-in function in XEmacs. In Emacs 21, it is -;; an autoloaded function in cl-extra.el. Since Emacs 22, it is part -;; of subr.el. There are problems when autoloading, therefore we test -;; for `subrp' and `symbol-file'. Implementation is taken from Emacs 23. -(defun tramp-compat-copy-tree (tree) - "Make a copy of TREE (compat function)." - (if (or (subrp 'copy-tree) (symbol-file 'copy-tree)) - (funcall (symbol-function 'copy-tree) tree) - (let (result) - (while (consp tree) - (let ((newcar (car tree))) - (if (consp (car tree)) - (setq newcar (tramp-compat-copy-tree (car tree)))) - (push newcar result)) - (setq tree (cdr tree))) - (nconc (nreverse result) tree)))) - ;; RECURSIVE has been introduced with Emacs 23.2. (defun tramp-compat-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files (compat function)." - (if recursive - (funcall (symbol-function 'delete-directory) directory recursive) - (delete-directory directory))) + (if (null recursive) + (delete-directory directory) + (condition-case nil + (funcall (symbol-function 'delete-directory) directory recursive) + ;; This Emacs version does not support the RECURSIVE flag. We + ;; use the implementation from Emacs 23.2. + (error + (setq directory (directory-file-name (expand-file-name directory))) + (if (not (file-symlink-p directory)) + (mapc (lambda (file) + (if (eq t (car (file-attributes file))) + (tramp-compat-delete-directory file recursive) + (delete-file file))) + (directory-files + directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (delete-directory directory))))) -;; `number-sequence' has been introduced in Emacs 22. Implementation -;; is taken from Emacs 23. +;; `number-sequence' does not exist in XEmacs. Implementation is +;; taken from Emacs 23. (defun tramp-compat-number-sequence (from &optional to inc) "Return a sequence of numbers from FROM to TO as a list (compat function)." (if (or (subrp 'number-sequence) (symbol-file 'number-sequence))
--- a/lisp/net/tramp-fish.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/net/tramp-fish.el Thu Apr 15 11:20:03 2010 +0200 @@ -341,10 +341,10 @@ "Like `directory-files-and-attributes' for Tramp files." (mapcar (lambda (x) - ;; We cannot call `file-attributes' for backward compatibility reasons. - ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. - (cons x (tramp-fish-handle-file-attributes - (if full x (expand-file-name x directory)) id-format))) + (cons x + (tramp-compat-file-attributes + (if full x (expand-file-name x directory)) + id-format))) (directory-files directory full match nosort))) (defun tramp-fish-handle-expand-file-name (name &optional dir) @@ -1030,15 +1030,15 @@ ;; last line ((looking-at "^$") (return))) - ;; delete line + ;; Delete line. (forward-line) (delete-region (point-min) (point)))) - ;; delete trailing empty line + ;; Delete trailing empty line. (forward-line) (delete-region (point-min) (point)) - ;; Return entry in file-attributes format + ;; Return entry in `file-attributes' format. (list localname link -1 uid gid '(0 0) mtime '(0 0) size mode nil))) (defun tramp-fish-retrieve-data (vec)
--- a/lisp/net/tramp.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/net/tramp.el Thu Apr 15 11:20:03 2010 +0200 @@ -36,7 +36,7 @@ ;; Notes: ;; ----- ;; -;; This package only works for Emacs 21.1 and higher, and for XEmacs 21.4 +;; This package only works for Emacs 22.1 and higher, and for XEmacs 21.4 ;; and higher. For XEmacs 21, you need the package `fsf-compat' for ;; the `with-timeout' macro. ;; @@ -79,7 +79,7 @@ (when (featurep 'tramp-compat) (unload-feature 'tramp-compat 'force)))) -(require 'format-spec) ; from Gnus 5.8, also in tar ball +(require 'format-spec) ;; As long as password.el is not part of (X)Emacs, it shouldn't ;; be mandatory (if (featurep 'xemacs) @@ -871,9 +871,9 @@ (defvar tramp-completion-function-alist nil "*Alist of methods for remote files. -This is a list of entries of the form (NAME PAIR1 PAIR2 ...). +This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\). Each NAME stands for a remote access method. Each PAIR is of the form -\(FUNCTION FILE). FUNCTION is responsible to extract user names and host +\(FUNCTION FILE\). FUNCTION is responsible to extract user names and host names from FILE for completion. The following predefined FUNCTIONs exists: * `tramp-parse-rhosts' for \"~/.rhosts\" like files, @@ -1025,7 +1025,7 @@ (defcustom tramp-remote-process-environment `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C" - ,(concat "TERM=" tramp-terminal-type) + ,(format "TERM=%s" tramp-terminal-type) "EMACS=t" ;; Deprecated. ,(format "INSIDE_EMACS=%s,tramp:%s" emacs-version tramp-version) "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" @@ -1429,14 +1429,14 @@ (t (error "Wrong `tramp-syntax' defined"))) "*Regular expression matching file names handled by Tramp. This regexp should match Tramp file names but no other file names. -\(When tramp.el is loaded, this regular expression is prepended to +When tramp.el is loaded, this regular expression is prepended to `file-name-handler-alist', and that is searched sequentially. Thus, if the Tramp entry appears rather early in the `file-name-handler-alist' and is a bit too general, then some files might be considered Tramp files which are not really Tramp files. Please note that the entry in `file-name-handler-alist' is made when -this file (tramp.el) is loaded. This means that this variable must be set +this file \(tramp.el\) is loaded. This means that this variable must be set before loading tramp.el. Alternatively, `file-name-handler-alist' can be updated after changing this variable. @@ -1566,18 +1566,18 @@ In the Emacs normally running Tramp, evaluate the above code \(replace \"xxx\" and \"yyy\" by the remote user and host name, -respectively). You can do this, for example, by pasting it into +respectively\). You can do this, for example, by pasting it into the `*scratch*' buffer and then hitting C-j with the cursor after the last closing parenthesis. Note that it works only if you have configured -\"ssh\" to run without password query, see ssh-agent(1). +\"ssh\" to run without password query, see ssh-agent\(1\). You will see the number of bytes sent successfully to the remote host. If that number exceeds 1000, you can stop the execution by hitting C-g, because your Emacs is likely clean. When it is necessary to set `tramp-chunksize', you might consider to -use an out-of-the-band method (like \"scp\") instead of an internal one -\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases +use an out-of-the-band method \(like \"scp\"\) instead of an internal one +\(like \"ssh\"\), because setting `tramp-chunksize' to non-nil decreases performance. If your Emacs is buggy, the code stops and gives you an indication @@ -3166,7 +3166,7 @@ (when (file-directory-p directory) (setq directory (expand-file-name directory)) (let* ((temp - (tramp-compat-copy-tree + (copy-tree (with-parsed-tramp-file-name directory nil (with-file-property v localname @@ -3297,7 +3297,12 @@ (tramp-shell-quote-argument localname) (tramp-shell-quote-argument filename) (if (symbol-value - 'read-file-name-completion-ignore-case) + ;; `read-file-name-completion-ignore-case' + ;; is introduced with Emacs 22.1. + (if (boundp + 'read-file-name-completion-ignore-case) + 'read-file-name-completion-ignore-case + 'completion-ignore-case)) 1 0))) (format (concat @@ -3382,7 +3387,6 @@ "file-name-all-completions" result)))))))) -;; The following isn't needed for Emacs 20 but for 19.34? (defun tramp-handle-file-name-completion (filename directory &optional predicate) "Like `file-name-completion' for Tramp files." @@ -3520,7 +3524,8 @@ (unless (memq op '(copy rename)) (error "Unknown operation `%s', must be `copy' or `rename'" op)) (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname))) + (t2 (tramp-tramp-file-p newname)) + pr tm) (when (and (not ok-if-already-exists) (file-exists-p newname)) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -3530,7 +3535,16 @@ (with-parsed-tramp-file-name (if t1 filename newname) nil (tramp-message v 0 "Transferring %s to %s..." filename newname)) - (prog1 + ;; We start a pulsing progress reporter. Introduced in Emacs 24.1. + (when (> (nth 7 (file-attributes filename)) tramp-copy-size-limit) + (condition-case nil + (setq pr (funcall + 'make-progress-reporter + (format "Transferring %s to %s..." filename newname)) + tm (run-at-time 0 0.1 'progress-reporter-update pr)) + (error nil))) + + (unwind-protect (cond ;; Both are Tramp files. ((and t1 t2) @@ -3600,6 +3614,8 @@ (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-file-property v localname))) + ;; Stop progress reporter. + (if tm (cancel-timer tm)) (with-parsed-tramp-file-name (if t1 filename newname) nil (tramp-message v 0 "Transferring %s to %s...done" filename newname))))) @@ -3650,9 +3666,13 @@ "Unknown operation `%s', must be `copy' or `rename'" op)))) (localname1 - (if t1 (tramp-handle-file-remote-p filename 'localname) filename)) + (if t1 + (tramp-file-name-handler 'file-remote-p filename 'localname) + filename)) (localname2 - (if t2 (tramp-handle-file-remote-p newname 'localname) newname)) + (if t2 + (tramp-file-name-handler 'file-remote-p newname 'localname) + newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) @@ -3814,7 +3834,7 @@ ;; Save exit. (condition-case nil (if dir-flag - (delete-directory + (tramp-compat-delete-directory (expand-file-name ".." tmpfile) 'recursive) (delete-file tmpfile)) (error)))) @@ -3841,10 +3861,11 @@ port (or (and port (number-to-string port)) "")) ;; Compose copy command. - (setq spec `((?h . ,host) (?u . ,user) (?p . ,port) - (?t . ,(tramp-get-connection-property - (tramp-get-connection-process v) "temp-file" "")) - (?k . ,(if keep-date " " ""))) + (setq spec (format-spec-make + ?h host ?u user ?p port + ?t (tramp-get-connection-property + (tramp-get-connection-process v) "temp-file" "") + ?k (if keep-date " " "")) copy-program (tramp-get-method-parameter method 'tramp-copy-program) copy-keep-date (tramp-get-method-parameter @@ -3934,7 +3955,7 @@ (unless (eq op 'copy) (if (file-regular-p filename) (delete-file filename) - (delete-directory filename 'recursive)))))) + (tramp-compat-delete-directory filename 'recursive)))))) (defun tramp-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -4863,9 +4884,9 @@ "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil ;; We set both variables. It doesn't matter whether it is - ;; Emacs or XEmacs + ;; Emacs or XEmacs. (let ((backup-directory-alist - ;; Emacs case + ;; Emacs case. (when (boundp 'backup-directory-alist) (if (symbol-value 'tramp-backup-directory-alist) (mapcar @@ -4881,7 +4902,7 @@ (symbol-value 'backup-directory-alist)))) (bkup-backup-directory-info - ;; XEmacs case + ;; XEmacs case. (when (boundp 'bkup-backup-directory-info) (if (symbol-value 'tramp-bkup-backup-directory-info) (mapcar @@ -5295,7 +5316,7 @@ "Return file name related to OPERATION file primitive. ARGS are the arguments OPERATION has been called with." (cond - ; FILE resp DIRECTORY + ;; FILE resp DIRECTORY. ((member operation (list 'access-file 'byte-compiler-base-file-name 'delete-directory 'delete-file 'diff-latest-backup-file 'directory-file-name @@ -5313,9 +5334,9 @@ 'load 'make-directory 'make-directory-internal 'set-file-modes 'substitute-in-file-name 'unhandled-file-name-directory 'vc-registered - ; Emacs 22 only + ;; Emacs 22+ only. 'set-file-times - ; XEmacs only + ;; XEmacs only. 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename 'dired-recursive-delete-directory 'dired-set-file-modtime @@ -5325,14 +5346,14 @@ (if (file-name-absolute-p (nth 0 args)) (nth 0 args) (expand-file-name (nth 0 args)))) - ; FILE DIRECTORY resp FILE1 FILE2 + ;; FILE DIRECTORY resp FILE1 FILE2. ((member operation (list 'add-name-to-file 'copy-file 'expand-file-name 'file-name-all-completions 'file-name-completion 'file-newer-than-file-p 'make-symbolic-link 'rename-file - ; Emacs 23 only + ;; Emacs 23+ only. 'copy-directory - ; XEmacs only + ;; XEmacs only. 'dired-make-relative-symlink 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) (save-match-data @@ -5340,39 +5361,39 @@ ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args)) ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args)) (t (buffer-file-name (current-buffer)))))) - ; START END FILE + ;; START END FILE. ((eq operation 'write-region) (nth 2 args)) - ; BUF + ;; BUFFER. ((member operation (list 'set-visited-file-modtime 'verify-visited-file-modtime - ; since Emacs 22 only + ;; Emacs 22+ only. 'make-auto-save-file-name - ; XEmacs only + ;; XEmacs only. 'backup-buffer)) (buffer-file-name (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) - ; COMMAND + ;; COMMAND. ((member operation - (list ; not in Emacs 23 + (list ;; not in Emacs 23+. 'dired-call-process - ; Emacs only + ;; Emacs only. 'shell-command - ; since Emacs 22 only + ;; Emacs 22+ only. 'process-file - ; since Emacs 23 only + ;; Emacs 23+ only. 'start-file-process - ; XEmacs only + ;; XEmacs only. 'dired-print-file 'dired-shell-call-process - ; nowhere yet + ;; nowhere yet. 'executable-find 'start-process 'call-process)) default-directory) - ; unknown file primitive + ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) (defun tramp-find-foreign-file-name-handler (filename) "Return foreign file name handler if exists." - (when (and (stringp filename) (tramp-tramp-file-p filename)) + (when (tramp-tramp-file-p filename) (let ((v (tramp-dissect-file-name filename t)) (handler tramp-foreign-file-name-handler-alist) elt res) @@ -5506,7 +5527,9 @@ ;; disable this part of the completion, unless the user implicitly ;; indicated his interest in using a fancier completion system. (or (eq tramp-syntax 'sep) - (featurep 'tramp) ; If it's loaded, we may as well use it. + (featurep 'tramp) ;; If it's loaded, we may as well use + ;; it. `partial-completion-mode' does not exist in + ;; XEmacs. It is obsoleted with Emacs 24.1. (and (boundp 'partial-completion-mode) partial-completion-mode) ;; FIXME: These may have been loaded even if the user never ;; intended to use them. @@ -5582,7 +5605,8 @@ (defun tramp-completion-mode-p () "Checks whether method / user name / host name completion is active." (or - ;; Signal from outside. + ;; Signal from outside. `non-essential' has been introduced in Emacs 24. + (and (boundp 'non-essential) (symbol-value 'non-essential)) tramp-completion-mode ;; Emacs. (equal last-input-event 'tab) @@ -6257,22 +6281,24 @@ (format "*debug tramp/%s %s@%s*" method user host) (format "*debug tramp/%s %s*" method host)))) +(defconst tramp-debug-outline-regexp + "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #") + (defun tramp-get-debug-buffer (vec) "Get the debug buffer for VEC." (with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec)) (when (bobp) (setq buffer-undo-list t) - ;; Activate outline-mode. This runs `text-mode-hook' and + ;; Activate `outline-mode'. This runs `text-mode-hook' and ;; `outline-mode-hook'. We must prevent that local processes - ;; die. Yes: I've seen `flyspell-mode', which starts "ispell" - ;; ... - (let ((default-directory (tramp-compat-temporary-file-directory))) + ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". + ;; Furthermore, `outline-regexp' must have the correct value + ;; already, because it is used by `font-lock-compile-keywords'. + (let ((default-directory (tramp-compat-temporary-file-directory)) + (outline-regexp tramp-debug-outline-regexp)) (outline-mode)) - (set (make-local-variable 'outline-regexp) - "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #") -; (set (make-local-variable 'outline-regexp) -; "[a-z.-]+:[0-9]+: [a-z0-9-]+ (\\([0-9]+\\)) #") + (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) (set (make-local-variable 'outline-level) 'tramp-outline-level)) (current-buffer))) @@ -6307,7 +6333,7 @@ (setq result (concat "\\" progname)))) (unless result (when ignore-tilde - ;; Remove all ~/foo directories from dirlist. In Emacs 20, + ;; Remove all ~/foo directories from dirlist. In XEmacs, ;; `remove' is in CL, and we want to avoid CL dependencies. (let (newdl d) (while dirlist @@ -6624,7 +6650,7 @@ ;; Discard echo from remote output. (tramp-set-connection-property proc "check-remote-echo" nil) (tramp-message proc 5 "echo-mark found") - (forward-line) + (forward-line 1) (delete-region begin (point)) (goto-char (point-min))))) @@ -6895,7 +6921,7 @@ "List of local coding commands for inline transfer. Each item is a list that looks like this: -\(FORMAT ENCODING DECODING) +\(FORMAT ENCODING DECODING\) FORMAT is symbol describing the encoding/decoding format. It can be `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. @@ -6928,7 +6954,7 @@ "List of remote coding commands for inline transfer. Each item is a list that looks like this: -\(FORMAT ENCODING DECODING) +\(FORMAT ENCODING DECODING\) FORMAT is symbol describing the encoding/decoding format. It can be `b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing. @@ -7089,8 +7115,9 @@ (setq proxy (format-spec proxy - `((?u . ,(or (tramp-file-name-user (car target-alist)) "")) - (?h . ,(or (tramp-file-name-host (car target-alist)) ""))))) + (format-spec-make + ?u (or (tramp-file-name-user (car target-alist)) "") + ?h (or (tramp-file-name-host (car target-alist)) "")))) (with-parsed-tramp-file-name proxy l ;; Add the hop. (add-to-list 'target-alist l) @@ -7308,8 +7335,7 @@ l-host (or l-host "") l-user (or l-user "") l-port (or l-port "") - spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port) - (?t . ,tmpfile)) + spec (format-spec-make ?h l-host ?u l-user ?p l-port ?t tmpfile) command (concat ;; We do not want to see the trailing local prompt in @@ -7981,7 +8007,7 @@ (tramp-get-connection-process vec) vec) "remote-path" - (let* ((remote-path (tramp-compat-copy-tree tramp-remote-path)) + (let* ((remote-path (copy-tree tramp-remote-path)) (elt1 (memq 'tramp-default-remote-path remote-path)) (elt2 (memq 'tramp-own-remote-path remote-path)) (default-remote-path @@ -8280,7 +8306,7 @@ (defadvice make-auto-save-file-name (around tramp-advice-make-auto-save-file-name () activate) "Invoke `tramp-handle-make-auto-save-file-name' for Tramp files." - (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))) + (if (tramp-tramp-file-p (buffer-file-name)) ;; We cannot call `tramp-handle-make-auto-save-file-name' ;; directly, because this would bypass the locking mechanism. (setq ad-return-value @@ -8294,14 +8320,13 @@ 'around 'tramp-advice-make-auto-save-file-name) (ad-activate 'make-auto-save-file-name)))) -;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have -;; permission 0666 minus umask. This is a security threat. +;; In XEmacs < 21.5, autosaved remote files have permission 0666 minus +;; umask. This is a security threat. (defun tramp-set-auto-save-file-modes () "Set permissions of autosaved remote files to the original permissions." (let ((bfn (buffer-file-name))) - (when (and (stringp bfn) - (tramp-tramp-file-p bfn) + (when (and (tramp-tramp-file-p bfn) (buffer-modified-p) (stringp buffer-auto-save-file-name) (not (equal bfn buffer-auto-save-file-name))) @@ -8313,10 +8338,9 @@ (set-file-modes buffer-auto-save-file-name (or (file-modes bfn) (tramp-octal-to-decimal "0600")))))) -(unless (or (> emacs-major-version 21) - (and (featurep 'xemacs) - (= emacs-major-version 21) - (> emacs-minor-version 4))) +(unless (and (featurep 'xemacs) + (= emacs-major-version 21) + (> emacs-minor-version 4)) (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes) (add-hook 'tramp-unload-hook (lambda () @@ -8560,7 +8584,6 @@ ;; * Remove unneeded parameters from methods. ;; * Make it work for different encodings, and for different file name ;; encodings, too. (Daniel Pittman) -;; * Progress reports while copying files. (Michael Kifer) ;; * Don't search for perl5 and perl. Instead, only search for perl and ;; then look if it's the right version (with `perl -v'). ;; * When editing a remote CVS controlled file as a different user, VC @@ -8625,12 +8648,13 @@ ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) ;; * Do not handle files with drive letter as remote. (Bug#5447) -;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448) +;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705) ;; * Try telnet+curl as new method. It might be useful for busybox, ;; without built-in uuencode/uudecode. ;; * Let `shell-dynamic-complete-*' and `comint-dynamic-complete' work ;; on remote hosts. ;; * Use secrets.el for password handling. +;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el
--- a/lisp/net/trampver.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/net/trampver.el Thu Apr 15 11:20:03 2010 +0200 @@ -1,8 +1,8 @@ ;;; trampver.el --- Transparent Remote Access, Multiple Protocol ;;; lisp/trampver.el. Generated from trampver.el.in by configure. -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes @@ -24,19 +24,20 @@ ;;; Code: -;; In the Tramp CVS repository, the version numer and the bug report address -;; are auto-frobbed from configure.ac, so you should edit that file and run -;; "autoconf && ./configure" to change them. (X)Emacs version check is defined -;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. +;; In the Tramp CVS repository, the version number and the bug report +;; address are auto-frobbed from configure.ac, so you should edit that +;; file and run "autoconf && ./configure" to change them. (X)Emacs +;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; +;; should be changed only there. -(defconst tramp-version "2.1.18-23.2" +(defconst tramp-version "2.1.19-pre" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") ;; Check for (X)Emacs version. -(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (= emacs-major-version 21) (< emacs-minor-version 4))) (format "Tramp 2.1.18-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) +(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) (provide 'trampver)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/complete.el Thu Apr 15 11:20:03 2010 +0200 @@ -0,0 +1,1124 @@ +;;; complete.el --- partial completion mechanism plus other goodies + +;; Copyright (C) 1990, 1991, 1992, 1993, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Dave Gillespie <daveg@synaptics.com> +;; Keywords: abbrev convenience +;; Obsolete-since: 24.1 +;; +;; Special thanks to Hallvard Furuseth for his many ideas and contributions. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extended completion for the Emacs minibuffer. +;; +;; The basic idea is that the command name or other completable text is +;; divided into words and each word is completed separately, so that +;; "M-x p-b" expands to "M-x print-buffer". If the entry is ambiguous +;; each word is completed as much as possible and then the cursor is +;; left at the first position where typing another letter will resolve +;; the ambiguity. +;; +;; Word separators for this purpose are hyphen, space, and period. +;; These would most likely occur in command names, Info menu items, +;; and file names, respectively. But all word separators are treated +;; alike at all times. +;; +;; This completion package replaces the old-style completer's key +;; bindings for TAB, SPC, RET, and `?'. The old completer is still +;; available on the Meta versions of those keys. If you set +;; PC-meta-flag to nil, the old completion keys will be left alone +;; and the partial completer will use the Meta versions of the keys. + + +;; Usage: M-x partial-completion-mode. During completable minibuffer entry, +;; +;; TAB means to do a partial completion; +;; SPC means to do a partial complete-word; +;; RET means to do a partial complete-and-exit; +;; ? means to do a partial completion-help. +;; +;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform +;; original Emacs completions, and M-TAB etc. do partial completion. +;; To do this, put the command, +;; +;; (setq PC-meta-flag nil) +;; +;; in your .emacs file. To load partial completion automatically, put +;; +;; (partial-completion-mode t) +;; +;; in your .emacs file, too. Things will be faster if you byte-compile +;; this file when you install it. +;; +;; As an extra feature, in cases where RET would not normally +;; complete (such as `C-x b'), the M-RET key will always do a partial +;; complete-and-exit. Thus `C-x b f.c RET' will select or create a +;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing +;; buffer whose name matches that pattern (perhaps "filing.c"). +;; (PC-meta-flag does not affect this behavior; M-RET used to be +;; undefined in this situation.) +;; +;; The regular M-TAB (lisp-complete-symbol) command also supports +;; partial completion in this package. + +;; In addition, this package includes a feature for accessing include +;; files. For example, `C-x C-f <sys/time.h> RET' reads the file +;; /usr/include/sys/time.h. The variable PC-include-file-path is a +;; list of directories in which to search for include files. Completion +;; is supported in include file names. + + +;;; Code: + +(defgroup partial-completion nil + "Partial Completion of items." + :prefix "pc-" + :group 'minibuffer + :group 'convenience) + +(defcustom PC-first-char 'find-file + "Control how the first character of a string is to be interpreted. +If nil, the first character of a string is not taken literally if it is a word +delimiter, so that \".e\" matches \"*.e*\". +If t, the first character of a string is always taken literally even if it is a +word delimiter, so that \".e\" matches \".e*\". +If non-nil and non-t, the first character is taken literally only for file name +completion." + :type '(choice (const :tag "delimiter" nil) + (const :tag "literal" t) + (other :tag "find-file" find-file)) + :group 'partial-completion) + +(defcustom PC-meta-flag t + "If non-nil, TAB means PC completion and M-TAB means normal completion. +Otherwise, TAB means normal completion and M-TAB means Partial Completion." + :type 'boolean + :group 'partial-completion) + +(defcustom PC-word-delimiters "-_. " + "A string of characters treated as word delimiters for completion. +Some arcane rules: +If `]' is in this string, it must come first. +If `^' is in this string, it must not come first. +If `-' is in this string, it must come first or right after `]'. +In other words, if S is this string, then `[S]' must be a valid Emacs regular +expression (not containing character ranges like `a-z')." + :type 'string + :group 'partial-completion) + +(defcustom PC-include-file-path '("/usr/include" "/usr/local/include") + "A list of directories in which to look for include files. +If nil, means use the colon-separated path in the variable $INCPATH instead." + :type '(repeat directory) + :group 'partial-completion) + +(defcustom PC-disable-includes nil + "If non-nil, include-file support in \\[find-file] is disabled." + :type 'boolean + :group 'partial-completion) + +(defvar PC-default-bindings t + "If non-nil, default partial completion key bindings are suppressed.") + +(defvar PC-env-vars-alist nil + "A list of the environment variable names and values.") + + +(defun PC-bindings (bind) + (let ((completion-map minibuffer-local-completion-map) + (must-match-map minibuffer-local-must-match-map)) + (cond ((not bind) + ;; These bindings are the default bindings. It would be better to + ;; restore the previous bindings. + (define-key read-expression-map "\e\t" 'lisp-complete-symbol) + + (define-key completion-map "\t" 'minibuffer-complete) + (define-key completion-map " " 'minibuffer-complete-word) + (define-key completion-map "?" 'minibuffer-completion-help) + + (define-key must-match-map "\r" 'minibuffer-complete-and-exit) + (define-key must-match-map "\n" 'minibuffer-complete-and-exit) + + (define-key global-map [remap lisp-complete-symbol] nil)) + (PC-default-bindings + (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol) + + (define-key completion-map "\t" 'PC-complete) + (define-key completion-map " " 'PC-complete-word) + (define-key completion-map "?" 'PC-completion-help) + + (define-key completion-map "\e\t" 'PC-complete) + (define-key completion-map "\e " 'PC-complete-word) + (define-key completion-map "\e\r" 'PC-force-complete-and-exit) + (define-key completion-map "\e\n" 'PC-force-complete-and-exit) + (define-key completion-map "\e?" 'PC-completion-help) + + (define-key must-match-map "\r" 'PC-complete-and-exit) + (define-key must-match-map "\n" 'PC-complete-and-exit) + + (define-key must-match-map "\e\r" 'PC-complete-and-exit) + (define-key must-match-map "\e\n" 'PC-complete-and-exit) + + (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) + +(defvar PC-do-completion-end nil + "Internal variable used by `PC-do-completion'.") + +(make-variable-buffer-local 'PC-do-completion-end) + +(defvar PC-goto-end nil + "Internal variable set in `PC-do-completion', used in +`choose-completion-string-functions'.") + +(make-variable-buffer-local 'PC-goto-end) + +;;;###autoload +(define-minor-mode partial-completion-mode + "Toggle Partial Completion mode. +With prefix ARG, turn Partial Completion mode on if ARG is positive. + +When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is +nil) is enhanced so that if some string is divided into words and each word is +delimited by a character in `PC-word-delimiters', partial words are completed +as much as possible and `*' characters are treated likewise in file names. + +For example, M-x p-c-m expands to M-x partial-completion-mode since no other +command begins with that sequence of characters, and +\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no +other file in that directory begins with that sequence of characters. + +Unless `PC-disable-includes' is non-nil, the `<...>' sequence is interpreted +specially in \\[find-file]. For example, +\\[find-file] <sys/time.h> RET finds the file `/usr/include/sys/time.h'. +See also the variable `PC-include-file-path'. + +Partial Completion mode extends the meaning of `completion-auto-help' (which +see), so that if it is neither nil nor t, Emacs shows the `*Completions*' +buffer only on the second attempt to complete. That is, if TAB finds nothing +to complete, the first TAB just says \"Next char not unique\" and the +second TAB brings up the `*Completions*' buffer." + :global t :group 'partial-completion + ;; Deal with key bindings... + (PC-bindings partial-completion-mode) + ;; Deal with include file feature... + (cond ((not partial-completion-mode) + (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) + ((not PC-disable-includes) + (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) + ;; Adjust the completion selection in *Completion* buffers to the way + ;; we work. The default minibuffer completion code only completes the + ;; text before point and leaves the text after point alone (new in + ;; Emacs-22). In contrast we use the whole text and we even sometimes + ;; move point to a place before EOB, to indicate the first position where + ;; there's a difference, so when the user uses choose-completion, we have + ;; to trick choose-completion into replacing the whole minibuffer text + ;; rather than only the text before point. --Stef + (funcall + (if partial-completion-mode 'add-hook 'remove-hook) + 'choose-completion-string-functions + (lambda (choice buffer &rest ignored) + ;; When completing M-: (lisp- ) with point before the ), it is + ;; not appropriate to go to point-max (unlike the filename case). + (if (and (not PC-goto-end) + (minibufferp buffer)) + (goto-char (point-max)) + ;; Need a similar hack for the non-minibuffer-case -- gm. + (when PC-do-completion-end + (goto-char PC-do-completion-end) + (setq PC-do-completion-end nil))) + (setq PC-goto-end nil) + nil)) + ;; Build the env-completion and mapping table. + (when (and partial-completion-mode (null PC-env-vars-alist)) + (setq PC-env-vars-alist + (mapcar (lambda (string) + (let ((d (string-match "=" string))) + (cons (concat "$" (substring string 0 d)) + (and d (substring string (1+ d)))))) + process-environment)))) + + +(defun PC-complete () + "Like minibuffer-complete, but allows \"b--di\"-style abbreviations. +For example, \"M-x b--di\" would match `byte-recompile-directory', or any +name which consists of three or more words, the first beginning with \"b\" +and the third beginning with \"di\". + +The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and +`beginning-of-defun', so this would produce a list of completions +just like when normal Emacs completions are ambiguous. + +Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", +\".\", and SPC." + (interactive) + (if (PC-was-meta-key) + (minibuffer-complete) + ;; If the previous command was not this one, + ;; never scroll, always retry completion. + (or (eq last-command this-command) + (setq minibuffer-scroll-window nil)) + (let ((window minibuffer-scroll-window)) + ;; If there's a fresh completion window with a live buffer, + ;; and this command is repeated, scroll that window. + (if (and window (window-buffer window) + (buffer-name (window-buffer window))) + (with-current-buffer (window-buffer window) + (if (pos-visible-in-window-p (point-max) window) + (set-window-start window (point-min) nil) + (scroll-other-window))) + (PC-do-completion nil))))) + + +(defun PC-complete-word () + "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details. +This can be bound to other keys, like `-' and `.', if you wish." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (if (eq last-command-event ? ) + (minibuffer-complete-word) + (self-insert-command 1)) + (self-insert-command 1) + (if (eobp) + (PC-do-completion 'word)))) + + +(defun PC-complete-space () + "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details. +This is suitable for binding to other keys which should act just like SPC." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-complete-word) + (insert " ") + (if (eobp) + (PC-do-completion 'word)))) + + +(defun PC-complete-and-exit () + "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-complete-and-exit) + (PC-do-complete-and-exit))) + +(defun PC-force-complete-and-exit () + "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (let ((minibuffer-completion-confirm nil)) + (PC-do-complete-and-exit))) + +(defun PC-do-complete-and-exit () + (cond + ((= (point-max) (minibuffer-prompt-end)) + ;; Duplicate the "bug" that Info-menu relies on... + (exit-minibuffer)) + ((eq minibuffer-completion-confirm 'confirm) + (if (or (eq last-command this-command) + (test-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate)) + (exit-minibuffer) + (PC-temp-minibuffer-message " [Confirm]"))) + ((eq minibuffer-completion-confirm 'confirm-after-completion) + ;; Similar to the above, but only if trying to exit immediately + ;; after typing TAB (this catches most minibuffer typos). + (if (and (memq last-command minibuffer-confirm-exit-commands) + (not (test-completion (field-string) + minibuffer-completion-table + minibuffer-completion-predicate))) + (PC-temp-minibuffer-message " [Confirm]") + (exit-minibuffer))) + (t + (let ((flag (PC-do-completion 'exit))) + (and flag + (if (or (eq flag 'complete) + (not minibuffer-completion-confirm)) + (exit-minibuffer) + (PC-temp-minibuffer-message " [Confirm]"))))))) + + +(defun PC-completion-help () + "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations. +See `PC-complete' for details." + (interactive) + (if (eq (PC-was-meta-key) PC-meta-flag) + (minibuffer-completion-help) + (PC-do-completion 'help))) + +(defun PC-was-meta-key () + (or (/= (length (this-command-keys)) 1) + (let ((key (aref (this-command-keys) 0))) + (if (integerp key) + (>= key 128) + (not (null (memq 'meta (event-modifiers key)))))))) + + +(defvar PC-ignored-extensions 'empty-cache) +(defvar PC-delims 'empty-cache) +(defvar PC-ignored-regexp nil) +(defvar PC-word-failed-flag nil) +(defvar PC-delim-regex nil) +(defvar PC-ndelims-regex nil) +(defvar PC-delims-list nil) + +(defvar PC-completion-as-file-name-predicate + (lambda () minibuffer-completing-file-name) + "A function testing whether a minibuffer completion now will work filename-style. +The function takes no arguments, and typically looks at the value +of `minibuffer-completion-table' and the minibuffer contents.") + +;; Returns the sequence of non-delimiter characters that follow regexp in string. +(defun PC-chunk-after (string regexp) + (if (not (string-match regexp string)) + (let ((message "String %s didn't match regexp %s")) + (message message string regexp) + (error message string regexp))) + (let ((result (substring string (match-end 0)))) + ;; result may contain multiple chunks + (if (string-match PC-delim-regex result) + (setq result (substring result 0 (match-beginning 0)))) + result)) + +(defun test-completion-ignore-case (str table pred) + "Like `test-completion', but ignores case when possible." + ;; Binding completion-ignore-case to nil ensures, for compatibility with + ;; standard completion, that the return value is exactly one of the + ;; possibilities. Do this binding only if pred is nil, out of paranoia; + ;; perhaps it is safe even if pred is non-nil. + (if pred + (test-completion str table pred) + (let ((completion-ignore-case nil)) + (test-completion str table pred)))) + +;; The following function is an attempt to work around two problems: + +;; (1) When complete.el was written, (try-completion "" '(("") (""))) used to +;; return the value "". With a change from 2002-07-07 it returns t which caused +;; `PC-lisp-complete-symbol' to fail with a "Wrong type argument: sequencep, t" +;; error. `PC-try-completion' returns STRING in this case. + +;; (2) (try-completion "" '((""))) returned t before the above-mentioned change. +;; Since `PC-chop-word' operates on the return value of `try-completion' this +;; case might have provoked a similar error as in (1). `PC-try-completion' +;; returns "" instead. I don't know whether this is a real problem though. + +;; Since `PC-try-completion' is not a guaranteed to fix these bugs reliably, you +;; should try to look at the following discussions when you encounter problems: +;; - emacs-pretest-bug ("Partial Completion" starting 2007-02-23), +;; - emacs-devel ("[address-of-OP: Partial completion]" starting 2007-02-24), +;; - emacs-devel ("[address-of-OP: EVAL and mouse selection in *Completions*]" +;; starting 2007-03-05). +(defun PC-try-completion (string alist &optional predicate) + "Like `try-completion' but return STRING instead of t." + (let ((result (try-completion string alist predicate))) + (if (eq result t) string result))) + +;; TODO document MODE magic... +(defun PC-do-completion (&optional mode beg end goto-end) + "Internal function to do the work of partial completion. +Text to be completed lies between BEG and END. Normally when +replacing text in the minibuffer, this function replaces up to +point-max (as is appropriate for completing a file name). If +GOTO-END is non-nil, however, it instead replaces up to END." + (or beg (setq beg (minibuffer-prompt-end))) + (or end (setq end (point-max))) + (let* ((table (if (eq minibuffer-completion-table 'read-file-name-internal) + 'PC-read-file-name-internal + minibuffer-completion-table)) + (pred minibuffer-completion-predicate) + (filename (funcall PC-completion-as-file-name-predicate)) + (dirname nil) ; non-nil only if a filename is being completed + ;; The following used to be "(dirlength 0)" which caused the erasure of + ;; the entire buffer text before `point' when inserting a completion + ;; into a buffer. + dirlength + (str (buffer-substring beg end)) + (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str))) + (ambig nil) + basestr origstr + env-on + regex + p offset + abbreviated + (poss nil) + helpposs + (case-fold-search completion-ignore-case)) + + ;; Check if buffer contents can already be considered complete + (if (and (eq mode 'exit) + (test-completion str table pred)) + 'complete + + ;; Do substitutions in directory names + (and filename + (setq basestr (or (file-name-directory str) "")) + (setq dirlength (length basestr)) + ;; Do substitutions in directory names + (setq p (substitute-in-file-name basestr)) + (not (string-equal basestr p)) + (setq str (concat p (file-name-nondirectory str))) + (progn + (delete-region beg end) + (insert str) + (setq end (+ beg (length str))))) + + ;; Prepare various delimiter strings + (or (equal PC-word-delimiters PC-delims) + (setq PC-delims PC-word-delimiters + PC-delim-regex (concat "[" PC-delims "]") + PC-ndelims-regex (concat "[^" PC-delims "]*") + PC-delims-list (append PC-delims nil))) + + ;; Add wildcards if necessary + (and filename + (let ((dir (file-name-directory str)) + (file (file-name-nondirectory str)) + ;; The base dir for file-completion was passed in `predicate'. + (default-directory (if (stringp pred) (expand-file-name pred) + default-directory))) + (while (and (stringp dir) (not (file-directory-p dir))) + (setq dir (directory-file-name dir)) + (setq file (concat (replace-regexp-in-string + PC-delim-regex "*\\&" + (file-name-nondirectory dir)) + "*/" file)) + (setq dir (file-name-directory dir))) + (setq origstr str str (concat dir file)))) + + ;; Look for wildcard expansions in directory name + (and filename + (string-match "\\*.*/" str) + (let ((pat str) + ;; The base dir for file-completion was passed in `predicate'. + (default-directory (if (stringp pred) (expand-file-name pred) + default-directory)) + files) + (setq p (1+ (string-match "/[^/]*\\'" pat))) + (while (setq p (string-match PC-delim-regex pat p)) + (setq pat (concat (substring pat 0 p) + "*" + (substring pat p)) + p (+ p 2))) + (setq files (file-expand-wildcards (concat pat "*"))) + (if files + (let ((dir (file-name-directory (car files))) + (p files)) + (while (and (setq p (cdr p)) + (equal dir (file-name-directory (car p))))) + (if p + (setq filename nil table nil + pred (if (stringp pred) nil pred) + ambig t) + (delete-region beg end) + (setq str (concat dir (file-name-nondirectory str))) + (insert str) + (setq end (+ beg (length str))))) + (if origstr + ;; If the wildcards were introduced by us, it's + ;; possible that PC-read-file-name-internal can + ;; still find matches for the original string + ;; even if we couldn't, so remove the added + ;; wildcards. + (setq str origstr) + (setq filename nil table nil + pred (if (stringp pred) nil pred)))))) + + ;; Strip directory name if appropriate + (if filename + (if incname + (setq basestr (substring str incname) + dirname (substring str 0 incname)) + (setq basestr (file-name-nondirectory str) + dirname (file-name-directory str)) + ;; Make sure str is consistent with its directory and basename + ;; parts. This is important on DOZe'NT systems when str only + ;; includes a drive letter, like in "d:". + (setq str (concat dirname basestr))) + (setq basestr str)) + + ;; Convert search pattern to a standard regular expression + (setq regex (regexp-quote basestr) + offset (if (and (> (length regex) 0) + (not (eq (aref basestr 0) ?\*)) + (or (eq PC-first-char t) + (and PC-first-char filename))) 1 0) + p offset) + (while (setq p (string-match PC-delim-regex regex p)) + (if (eq (aref regex p) ? ) + (setq regex (concat (substring regex 0 p) + PC-ndelims-regex + PC-delim-regex + (substring regex (1+ p))) + p (+ p (length PC-ndelims-regex) (length PC-delim-regex))) + (let ((bump (if (memq (aref regex p) + '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\)) + -1 0))) + (setq regex (concat (substring regex 0 (+ p bump)) + PC-ndelims-regex + (substring regex (+ p bump))) + p (+ p (length PC-ndelims-regex) 1))))) + (setq p 0) + (if filename + (while (setq p (string-match "\\\\\\*" regex p)) + (setq regex (concat (substring regex 0 p) + "[^/]*" + (substring regex (+ p 2)))))) + ;;(setq the-regex regex) + (setq regex (concat "\\`" regex)) + + (and (> (length basestr) 0) + (= (aref basestr 0) ?$) + (setq env-on t + table PC-env-vars-alist + pred nil)) + + ;; Find an initial list of possible completions + (unless (setq p (string-match (concat PC-delim-regex + (if filename "\\|\\*" "")) + str + (+ (length dirname) offset))) + + ;; Minibuffer contains no hyphens -- simple case! + (setq poss (all-completions (if env-on basestr str) + table + pred)) + (unless (or poss (string-equal str "")) + ;; Try completion as an abbreviation, e.g. "mvb" -> + ;; "m-v-b" -> "multiple-value-bind", but only for + ;; non-empty strings. + (setq origstr str + abbreviated t) + (if filename + (cond + ;; "alpha" or "/alpha" -> expand whole path. + ((string-match "^/?\\([A-Za-z0-9]+\\)$" str) + (setq + basestr "" + p nil + poss (file-expand-wildcards + (concat "/" + (mapconcat #'list (match-string 1 str) "*/") + "*")) + beg (1- beg))) + ;; Alphanumeric trailer -> expand trailing file + ((string-match "^\\(.+/\\)\\([A-Za-z0-9]+\\)$" str) + (setq regex (concat "\\`" + (mapconcat #'list + (match-string 2 str) + "[A-Za-z0-9]*[^A-Za-z0-9]")) + p (1+ (length (match-string 1 str)))))) + (setq regex (concat "\\`" (mapconcat (lambda (c) + (regexp-quote (string c))) + str "[^-]*-")) + p 1)))) + (when p + ;; Use all-completions to do an initial cull. This is a big win, + ;; since all-completions is written in C! + (let ((compl (all-completions (if env-on + (file-name-nondirectory (substring str 0 p)) + (substring str 0 p)) + table + pred))) + (setq p compl) + (when (and compl abbreviated) + (if filename + (progn + (setq p nil) + (dolist (x compl) + (when (string-match regex x) + (push x p))) + (setq basestr (try-completion "" p))) + (setq basestr (mapconcat 'list str "-")) + (delete-region beg end) + (setq end (+ beg (length basestr))) + (insert basestr)))) + (while p + (and (string-match regex (car p)) + (progn + (set-text-properties 0 (length (car p)) '() (car p)) + (setq poss (cons (car p) poss)))) + (setq p (cdr p)))) + + ;; If table had duplicates, they can be here. + (delete-dups poss) + + ;; Handle completion-ignored-extensions + (and filename + (not (eq mode 'help)) + (let ((p2 poss)) + + ;; Build a regular expression representing the extensions list + (or (equal completion-ignored-extensions PC-ignored-extensions) + (setq PC-ignored-regexp + (concat "\\(" + (mapconcat + 'regexp-quote + (setq PC-ignored-extensions + completion-ignored-extensions) + "\\|") + "\\)\\'"))) + + ;; Check if there are any without an ignored extension. + ;; Also ignore `.' and `..'. + (setq p nil) + (while p2 + (or (string-match PC-ignored-regexp (car p2)) + (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) + (setq p (cons (car p2) p))) + (setq p2 (cdr p2))) + + ;; If there are "good" names, use them + (and p (setq poss p)))) + + ;; Now we have a list of possible completions + + (cond + + ;; No valid completions found + ((null poss) + (if (and (eq mode 'word) + (not PC-word-failed-flag)) + (let ((PC-word-failed-flag t)) + (delete-backward-char 1) + (PC-do-completion 'word)) + (when abbreviated + (delete-region beg end) + (insert origstr)) + (beep) + (PC-temp-minibuffer-message (if ambig + " [Ambiguous dir name]" + (if (eq mode 'help) + " [No completions]" + " [No match]"))) + nil)) + + ;; More than one valid completion found + ((or (cdr (setq helpposs poss)) + (memq mode '(help word))) + + ;; Is the actual string one of the possible completions? + (setq p (and (not (eq mode 'help)) poss)) + (while (and p + (not (string-equal (car p) basestr))) + (setq p (cdr p))) + (and p (null mode) + (PC-temp-minibuffer-message " [Complete, but not unique]")) + (if (and p + (not (and (null mode) + (eq this-command last-command)))) + t + + ;; If ambiguous, try for a partial completion + (let ((improved nil) + prefix + (pt nil) + (skip "\\`")) + + ;; Check if next few letters are the same in all cases + (if (and (not (eq mode 'help)) + (setq prefix (PC-try-completion + (PC-chunk-after basestr skip) poss))) + (let ((first t) i) + (if (eq mode 'word) + (setq prefix (PC-chop-word prefix basestr))) + (goto-char (+ beg (length dirname))) + (while (and (progn + (setq i 0) ; index into prefix string + (while (< i (length prefix)) + (if (and (< (point) end) + (or (eq (downcase (aref prefix i)) + (downcase (following-char))) + (and (looking-at " ") + (memq (aref prefix i) + PC-delims-list)))) + ;; replace " " by the actual delimiter + ;; or input char by prefix char + (progn + (delete-char 1) + (insert (substring prefix i (1+ i)))) + ;; insert a new character + (progn + (and filename (looking-at "\\*") + (progn + (delete-char 1) + (setq end (1- end)))) + (setq improved t) + (insert (substring prefix i (1+ i))) + (setq end (1+ end)))) + (setq i (1+ i))) + (or pt (setq pt (point))) + (looking-at PC-delim-regex)) + (setq skip (concat skip + (regexp-quote prefix) + PC-ndelims-regex) + prefix (PC-try-completion + (PC-chunk-after + ;; not basestr, because that does + ;; not reflect insertions + (buffer-substring + (+ beg (length dirname)) end) + skip) + (mapcar + (lambda (x) + (when (string-match skip x) + (substring x (match-end 0)))) + poss))) + (or (> i 0) (> (length prefix) 0)) + (or (not (eq mode 'word)) + (and first (> (length prefix) 0) + (setq first nil + prefix (substring prefix 0 1)))))) + (goto-char (if (eq mode 'word) end + (or pt beg))))) + + (if (and (eq mode 'word) + (not PC-word-failed-flag)) + + (if improved + + ;; We changed it... would it be complete without the space? + (if (test-completion (buffer-substring + (field-beginning) (1- end)) + table pred) + (delete-region (1- end) end))) + + (if improved + + ;; We changed it... enough to be complete? + (and (eq mode 'exit) + (test-completion-ignore-case (field-string) table pred)) + + ;; If totally ambiguous, display a list of completions + (if (or (eq completion-auto-help t) + (and completion-auto-help + (eq last-command this-command)) + (eq mode 'help)) + (let ((prompt-end (minibuffer-prompt-end))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list (sort helpposs 'string-lessp)) + (setq PC-do-completion-end end + PC-goto-end goto-end) + (with-current-buffer standard-output + ;; Record which part of the buffer we are completing + ;; so that choosing a completion from the list + ;; knows how much old text to replace. + ;; This was briefly nil in the non-dirname case. + ;; However, if one calls PC-lisp-complete-symbol + ;; on "(ne-f" with point on the hyphen, PC offers + ;; all completions starting with "(ne", some of + ;; which do not match the "-f" part (maybe it + ;; should not, but it does). In such cases, + ;; completion gets confused trying to figure out + ;; how much to replace, so we tell it explicitly + ;; (ie, the number of chars in the buffer before beg). + ;; + ;; Note that choose-completion-string-functions + ;; plays around with point. + (setq completion-base-size (if dirname + dirlength + (- beg prompt-end)))))) + (PC-temp-minibuffer-message " [Next char not unique]")) + ;; Expansion of filenames is not reversible, + ;; so just keep the prefix. + (when (and abbreviated filename) + (delete-region (point) end)) + nil))))) + + ;; Only one possible completion + (t + (if (and (equal basestr (car poss)) + (not (and env-on filename)) + (not abbreviated)) + (if (null mode) + (PC-temp-minibuffer-message " [Sole completion]")) + (delete-region beg end) + (insert (format "%s" + (if filename + (substitute-in-file-name (concat dirname (car poss))) + (car poss))))) + t))))) + +(defun PC-chop-word (new old) + (let ((i -1) + (j -1)) + (while (and (setq i (string-match PC-delim-regex old (1+ i))) + (setq j (string-match PC-delim-regex new (1+ j))))) + (if (and j + (or (not PC-word-failed-flag) + (setq j (string-match PC-delim-regex new (1+ j))))) + (substring new 0 (1+ j)) + new))) + +(defvar PC-not-minibuffer nil) + +(defun PC-temp-minibuffer-message (message) + "A Lisp version of `temp_minibuffer_message' from minibuf.c." + (cond (PC-not-minibuffer + (message "%s" message) + (sit-for 2) + (message "")) + ((fboundp 'temp-minibuffer-message) + (temp-minibuffer-message message)) + (t + (let ((point-max (point-max))) + (save-excursion + (goto-char point-max) + (insert message)) + (let ((inhibit-quit t)) + (sit-for 2) + (delete-region point-max (point-max)) + (when quit-flag + (setq quit-flag nil + unread-command-events '(7)))))))) + +;; Does not need to be buffer-local (?) because only used when one +;; PC-l-c-s immediately follows another. +(defvar PC-lisp-complete-end nil + "Internal variable used by `PC-lisp-complete-symbol'.") + +(defun PC-lisp-complete-symbol () + "Perform completion on Lisp symbol preceding point. +That symbol is compared against the symbols that exist +and any additional characters determined by what is there +are inserted. +If the symbol starts just after an open-parenthesis, +only symbols with function definitions are considered. +Otherwise, all symbols with function definitions, values +or properties are considered." + (interactive) + (let* ((end + (save-excursion + (with-syntax-table lisp-mode-syntax-table + (skip-syntax-forward "_w") + (point)))) + (beg (save-excursion + (with-syntax-table lisp-mode-syntax-table + (backward-sexp 1) + (while (= (char-syntax (following-char)) ?\') + (forward-char 1)) + (point)))) + (minibuffer-completion-table obarray) + (minibuffer-completion-predicate + (if (eq (char-after (1- beg)) ?\() + 'fboundp + (function (lambda (sym) + (or (boundp sym) (fboundp sym) + (symbol-plist sym)))))) + (PC-not-minibuffer t)) + ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html + ;; + ;; This deals with cases like running PC-l-c-s on "M-: (n-f". + ;; The first call to PC-l-c-s expands this to "(ne-f", and moves + ;; point to the hyphen [1]. If one calls PC-l-c-s immediately after, + ;; then without the last-command check, one is offered all + ;; completions of "(ne", which is presumably not what one wants. + ;; + ;; This is arguably (at least, it seems to be the existing intended + ;; behavior) what one _does_ want if point has been explicitly + ;; positioned on the hyphen. Note that if PC-do-completion (qv) binds + ;; completion-base-size to nil, then completion does not replace the + ;; correct amount of text in such cases. + ;; + ;; Neither of these problems occur when using PC for filenames in the + ;; minibuffer, because in that case PC-do-completion is called without + ;; an explicit value for END, and so uses (point-max). This is fine for + ;; a filename, because the end of the filename must be at the end of + ;; the minibuffer. The same is not true for lisp symbols. + ;; + ;; [1] An alternate fix would be to not move point to the hyphen + ;; in such cases, but that would make the behavior different from + ;; that for filenames. It seems PC moves point to the site of the + ;; first difference between the possible completions. + ;; + ;; Alternatively alternatively, maybe end should be computed in + ;; the same way as beg. That would change the behavior though. + (if (equal last-command 'PC-lisp-complete-symbol) + (PC-do-completion nil beg PC-lisp-complete-end t) + (if PC-lisp-complete-end + (move-marker PC-lisp-complete-end end) + (setq PC-lisp-complete-end (copy-marker end t))) + (PC-do-completion nil beg end t)))) + +(defun PC-complete-as-file-name () + "Perform completion on file names preceding point. + Environment vars are converted to their values." + (interactive) + (let* ((end (point)) + (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" + (point-min) t) + (+ (point) 2) + (point-min))) + (minibuffer-completion-table 'PC-read-file-name-internal) + (minibuffer-completion-predicate nil) + (PC-not-minibuffer t)) + (goto-char end) + (PC-do-completion nil beg end))) + +;; Facilities for loading C header files. This is independent from the +;; main completion code. See also the variable `PC-include-file-path' +;; at top of this file. + +(defun PC-look-for-include-file () + (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) + (let ((name (substring (buffer-file-name) + (match-beginning 1) (match-end 1))) + (punc (aref (buffer-file-name) (match-beginning 0))) + (path nil) + new-buf) + (kill-buffer (current-buffer)) + (if (equal name "") + (with-current-buffer (car (buffer-list)) + (save-excursion + (beginning-of-line) + (if (looking-at + "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]") + (setq name (buffer-substring (match-beginning 1) + (match-end 1)) + punc (char-after (1- (match-beginning 1)))) + ;; Suggested by Frank Siebenlist: + (if (or (looking-at + "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"") + (looking-at + "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"") + (looking-at + "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]")) + (progn + (setq name (buffer-substring (match-beginning 1) + (match-end 1)) + punc ?\< + path load-path) + (if (string-match "\\.elc$" name) + (setq name (substring name 0 -1)) + (or (string-match "\\.el$" name) + (setq name (concat name ".el"))))) + (error "Not on an #include line")))))) + (or (string-match "\\.[[:alnum:]]+$" name) + (setq name (concat name ".h"))) + (if (eq punc ?\<) + (let ((path (or path (PC-include-file-path)))) + (while (and path + (not (file-exists-p + (concat (file-name-as-directory (car path)) + name)))) + (setq path (cdr path))) + (if path + (setq name (concat (file-name-as-directory (car path)) name)) + (error "No such include file: <%s>" name))) + (let ((dir (with-current-buffer (car (buffer-list)) + default-directory))) + (if (file-exists-p (concat dir name)) + (setq name (concat dir name)) + (error "No such include file: `%s'" name)))) + (setq new-buf (get-file-buffer name)) + (if new-buf + ;; no need to verify last-modified time for this! + (set-buffer new-buf) + (set-buffer (create-file-buffer name)) + (erase-buffer) + (insert-file-contents name t)) + ;; Returning non-nil with the new buffer current + ;; is sufficient to tell find-file to use it. + t) + nil)) + +(defun PC-include-file-path () + (or PC-include-file-path + (let ((env (getenv "INCPATH")) + (path nil) + pos) + (or env (error "No include file path specified")) + (while (setq pos (string-match ":[^:]+$" env)) + (setq path (cons (substring env (1+ pos)) path) + env (substring env 0 pos))) + path))) + +;; This is adapted from lib-complete.el, by Mike Williams. +(defun PC-include-file-all-completions (file search-path &optional full) + "Return all completions for FILE in any directory on SEARCH-PATH. +If optional third argument FULL is non-nil, returned pathnames should be +absolute rather than relative to some directory on the SEARCH-PATH." + (setq search-path + (mapcar (lambda (dir) + (if dir (file-name-as-directory dir) default-directory)) + search-path)) + (if (file-name-absolute-p file) + ;; It's an absolute file name, so don't need search-path + (progn + (setq file (expand-file-name file)) + (file-name-all-completions + (file-name-nondirectory file) (file-name-directory file))) + (let ((subdir (file-name-directory file)) + (ndfile (file-name-nondirectory file)) + file-lists) + ;; Append subdirectory part to each element of search-path + (if subdir + (setq search-path + (mapcar (lambda (dir) (concat dir subdir)) + search-path) + file )) + ;; Make list of completions in each directory on search-path + (while search-path + (let* ((dir (car search-path)) + (subdir (if full dir subdir))) + (if (file-directory-p dir) + (progn + (setq file-lists + (cons + (mapcar (lambda (file) (concat subdir file)) + (file-name-all-completions ndfile + (car search-path))) + file-lists)))) + (setq search-path (cdr search-path)))) + ;; Compress out duplicates while building complete list (slloooow!) + (let ((sorted (sort (apply 'nconc file-lists) + (lambda (x y) (not (string-lessp x y))))) + compressed) + (while sorted + (if (equal (car sorted) (car compressed)) nil + (setq compressed (cons (car sorted) compressed))) + (setq sorted (cdr sorted))) + compressed)))) + +(defun PC-read-file-name-internal (string pred action) + "Extend `read-file-name-internal' to handle include files. +This is only used by " + (if (string-match "<\\([^\"<>]*\\)>?\\'" string) + (let* ((name (match-string 1 string)) + (str2 (substring string (match-beginning 0))) + (completion-table + (mapcar (lambda (x) + (format (if (string-match "/\\'" x) "<%s" "<%s>") x)) + (PC-include-file-all-completions + name (PC-include-file-path))))) + (cond + ((not completion-table) nil) + ((eq action 'lambda) (test-completion str2 completion-table nil)) + ((eq action nil) (PC-try-completion str2 completion-table nil)) + ((eq action t) (all-completions str2 completion-table nil)))) + (read-file-name-internal string pred action))) + + +(provide 'complete) + +;; arch-tag: fc7e2768-ff44-4e22-b579-4d825b968458 +;;; complete.el ends here
--- a/lisp/pcomplete.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/pcomplete.el Thu Apr 15 11:20:03 2010 +0200 @@ -1113,7 +1113,7 @@ (defmacro pcomplete-here* (&optional form stub form-only) "An alternate form which does not participate in argument paring." (declare (debug t)) - `(pcomplete-here (lambda () ,form) ,stub t ,form-only)) + `(pcomplete-here ,form ,stub t ,form-only)) ;; display support
--- a/lisp/play/gomoku.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/play/gomoku.el Thu Apr 15 11:20:03 2010 +0200 @@ -102,59 +102,60 @@ "*Number of lines between the Gomoku board and the top of the window.") -(defvar gomoku-mode-map nil +(defvar gomoku-mode-map + (let ((map (make-sparse-keymap))) + + ;; Key bindings for cursor motion. + (define-key map "y" 'gomoku-move-nw) ; y + (define-key map "u" 'gomoku-move-ne) ; u + (define-key map "b" 'gomoku-move-sw) ; b + (define-key map "n" 'gomoku-move-se) ; n + (define-key map "h" 'backward-char) ; h + (define-key map "l" 'forward-char) ; l + (define-key map "j" 'gomoku-move-down) ; j + (define-key map "k" 'gomoku-move-up) ; k + + (define-key map [kp-7] 'gomoku-move-nw) + (define-key map [kp-9] 'gomoku-move-ne) + (define-key map [kp-1] 'gomoku-move-sw) + (define-key map [kp-3] 'gomoku-move-se) + (define-key map [kp-4] 'backward-char) + (define-key map [kp-6] 'forward-char) + (define-key map [kp-2] 'gomoku-move-down) + (define-key map [kp-8] 'gomoku-move-up) + + (define-key map "\C-n" 'gomoku-move-down) ; C-n + (define-key map "\C-p" 'gomoku-move-up) ; C-p + + ;; Key bindings for entering Human moves. + (define-key map "X" 'gomoku-human-plays) ; X + (define-key map "x" 'gomoku-human-plays) ; x + (define-key map " " 'gomoku-human-plays) ; SPC + (define-key map "\C-m" 'gomoku-human-plays) ; RET + (define-key map "\C-c\C-p" 'gomoku-human-plays) ; C-c C-p + (define-key map "\C-c\C-b" 'gomoku-human-takes-back) ; C-c C-b + (define-key map "\C-c\C-r" 'gomoku-human-resigns) ; C-c C-r + (define-key map "\C-c\C-e" 'gomoku-emacs-plays) ; C-c C-e + + (define-key map [kp-enter] 'gomoku-human-plays) + (define-key map [insert] 'gomoku-human-plays) + (define-key map [down-mouse-1] 'gomoku-click) + (define-key map [drag-mouse-1] 'gomoku-click) + (define-key map [mouse-1] 'gomoku-click) + (define-key map [down-mouse-2] 'gomoku-click) + (define-key map [mouse-2] 'gomoku-mouse-play) + (define-key map [drag-mouse-2] 'gomoku-mouse-play) + + (define-key map [remap previous-line] 'gomoku-move-up) + (define-key map [remap next-line] 'gomoku-move-down) + (define-key map [remap move-beginning-of-line] 'gomoku-beginning-of-line) + (define-key map [remap move-end-of-line] 'gomoku-end-of-line) + (define-key map [remap undo] 'gomoku-human-takes-back) + (define-key map [remap advertised-undo] 'gomoku-human-takes-back) + map) + "Local keymap to use in Gomoku mode.") -(if gomoku-mode-map nil - (setq gomoku-mode-map (make-sparse-keymap)) - - ;; Key bindings for cursor motion. - (define-key gomoku-mode-map "y" 'gomoku-move-nw) ; y - (define-key gomoku-mode-map "u" 'gomoku-move-ne) ; u - (define-key gomoku-mode-map "b" 'gomoku-move-sw) ; b - (define-key gomoku-mode-map "n" 'gomoku-move-se) ; n - (define-key gomoku-mode-map "h" 'backward-char) ; h - (define-key gomoku-mode-map "l" 'forward-char) ; l - (define-key gomoku-mode-map "j" 'gomoku-move-down) ; j - (define-key gomoku-mode-map "k" 'gomoku-move-up) ; k - - (define-key gomoku-mode-map [kp-7] 'gomoku-move-nw) - (define-key gomoku-mode-map [kp-9] 'gomoku-move-ne) - (define-key gomoku-mode-map [kp-1] 'gomoku-move-sw) - (define-key gomoku-mode-map [kp-3] 'gomoku-move-se) - (define-key gomoku-mode-map [kp-4] 'backward-char) - (define-key gomoku-mode-map [kp-6] 'forward-char) - (define-key gomoku-mode-map [kp-2] 'gomoku-move-down) - (define-key gomoku-mode-map [kp-8] 'gomoku-move-up) - - (define-key gomoku-mode-map "\C-n" 'gomoku-move-down) ; C-n - (define-key gomoku-mode-map "\C-p" 'gomoku-move-up) ; C-p - - ;; Key bindings for entering Human moves. - (define-key gomoku-mode-map "X" 'gomoku-human-plays) ; X - (define-key gomoku-mode-map "x" 'gomoku-human-plays) ; x - (define-key gomoku-mode-map " " 'gomoku-human-plays) ; SPC - (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays) ; RET - (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays) ; C-c C-p - (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-c C-b - (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns) ; C-c C-r - (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays) ; C-c C-e - - (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays) - (define-key gomoku-mode-map [insert] 'gomoku-human-plays) - (define-key gomoku-mode-map [down-mouse-1] 'gomoku-click) - (define-key gomoku-mode-map [drag-mouse-1] 'gomoku-click) - (define-key gomoku-mode-map [mouse-1] 'gomoku-click) - (define-key gomoku-mode-map [down-mouse-2] 'gomoku-click) - (define-key gomoku-mode-map [mouse-2] 'gomoku-mouse-play) - (define-key gomoku-mode-map [drag-mouse-2] 'gomoku-mouse-play) - - (define-key gomoku-mode-map [remap previous-line] 'gomoku-move-up) - (define-key gomoku-mode-map [remap next-line] 'gomoku-move-down) - (define-key gomoku-mode-map [remap move-beginning-of-line] 'gomoku-beginning-of-line) - (define-key gomoku-mode-map [remap move-end-of-line] 'gomoku-end-of-line) - (define-key gomoku-mode-map [remap undo] 'gomoku-human-takes-back) - (define-key gomoku-mode-map [remap advertised-undo] 'gomoku-human-takes-back)) (defvar gomoku-emacs-won () "For making font-lock use the winner's face for the line.") @@ -182,28 +183,20 @@ ;; allow View Mode to be activated in its buffer. (put 'gomoku-mode 'mode-class 'special) -(defun gomoku-mode () +(define-derived-mode gomoku-mode nil "Gomoku" "Major mode for playing Gomoku against Emacs. You and Emacs play in turn by marking a free square. You mark it with X and Emacs marks it with O. The winner is the first to get five contiguous marks horizontally, vertically or in diagonal. - +\\<gomoku-mode-map> You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays]. -Other useful commands: -\\{gomoku-mode-map} -Entry to this mode calls the value of `gomoku-mode-hook' if that value -is non-nil." - (interactive) - (kill-all-local-variables) - (setq major-mode 'gomoku-mode - mode-name "Gomoku") +Other useful commands:\n +\\{gomoku-mode-map}" (gomoku-display-statistics) - (use-local-map gomoku-mode-map) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(gomoku-font-lock-keywords t)) - (toggle-read-only t) - (run-mode-hooks 'gomoku-mode-hook)) + (toggle-read-only t)) ;;; ;;; THE BOARD.
--- a/lisp/progmodes/bug-reference.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/progmodes/bug-reference.el Thu Apr 15 11:20:03 2010 +0200 @@ -130,11 +130,6 @@ (widen) (bug-reference-unfontify (point-min) (point-max))))) -(defun turn-on-bug-reference-mode () - "Unconditionally turn bug reference mode on." - (unless bug-reference-mode - (bug-reference-mode))) - ;;;###autoload (define-minor-mode bug-reference-prog-mode "Like `bug-reference-mode', but only buttonize in comments and strings." @@ -148,10 +143,5 @@ (widen) (bug-reference-unfontify (point-min) (point-max))))) -(defun turn-on-bug-reference-prog-mode () - "Unconditionally turn bug reference prog mode on." - (unless bug-reference-prog-mode - (bug-reference-prog-mode))) - ;; arch-tag: b138abce-e5c3-475e-bd58-7afba40387ea ;;; bug-reference.el ends here
--- a/lisp/progmodes/compile.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/progmodes/compile.el Thu Apr 15 11:20:03 2010 +0200 @@ -583,6 +583,21 @@ :type 'boolean :group 'compilation) +(defcustom compilation-save-buffers-predicate nil + "The second argument (PRED) passed to `save-some-buffers' before compiling. +E.g., one can set this to + (lambda () + (string-prefix-p my-compilation-root (file-truename (buffer-file-name)))) +to limit saving to files located under `my-compilation-root'. +Note, that, in general, `compilation-directory' cannot be used instead +of `my-compilation-root' here." + :type '(choice + (const :tag "Default (save all file-visiting buffers)" nil) + (const :tag "Save all buffers" t) + function) + :group 'compilation + :version "24.1") + ;;;###autoload (defcustom compilation-search-path '(nil) "List of directories to search for source files named in error messages. @@ -1097,7 +1112,8 @@ (consp current-prefix-arg))) (unless (equal command (eval compile-command)) (setq compile-command command)) - (save-some-buffers (not compilation-ask-about-save) nil) + (save-some-buffers (not compilation-ask-about-save) + compilation-save-buffers-predicate) (setq-default compilation-directory default-directory) (compilation-start command comint)) @@ -1108,7 +1124,8 @@ original use. Otherwise, recompile using `compile-command'. If the optional argument `edit-command' is non-nil, the command can be edited." (interactive "P") - (save-some-buffers (not compilation-ask-about-save) nil) + (save-some-buffers (not compilation-ask-about-save) + compilation-save-buffers-predicate) (let ((default-directory (or compilation-directory default-directory))) (when edit-command (setcar compilation-arguments
--- a/lisp/progmodes/verilog-mode.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/progmodes/verilog-mode.el Thu Apr 15 11:20:03 2010 +0200 @@ -79,7 +79,7 @@ ;; .emacs, or in your site's site-load.el ; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t ) -; (add-to-list 'auto-mode-alist '("\\.[ds]?v\\'" . verilog-mode)) +; (add-to-list 'auto-mode-alist '("\\.[ds]?vh?\\'" . verilog-mode)) ;; If you want to customize Verilog mode to fit your needs better, ;; you may add these lines (the values of the variables presented @@ -118,9 +118,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "556" +(defconst verilog-mode-version "565" "Version of this Verilog mode.") -(defconst verilog-mode-release-date "2009-12-10-GNU" +(defconst verilog-mode-release-date "2010-03-01-GNU" "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -2116,7 +2116,8 @@ `( "endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass" )))) -(defconst verilog-disable-fork-re "disable\\s-+fork") +(defconst verilog-disable-fork-re "disable\\s-+fork\\>") +(defconst verilog-fork-wait-re "fork\\s-+wait\\>") (defconst verilog-extended-case-re "\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?") (defconst verilog-extended-complete-re (concat "\\(\\<extern\\s-+\\|\\<virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)" @@ -2198,6 +2199,11 @@ "unique" "unsigned" "use" "uwire" "var" "vectored" "virtual" "void" "wait" "wait_order" "wand" "weak0" "weak1" "while" "wildcard" "wire" "with" "within" "wor" "xnor" "xor" + ;; 1800-2009 + "accept_on" "checker" "endchecker" "eventually" "global" "implies" + "let" "nexttime" "reject_on" "restrict" "s_always" "s_eventually" + "s_nexttime" "s_until" "s_until_with" "strong" "sync_accept_on" + "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ) "List of Verilog keywords.") @@ -2314,7 +2320,7 @@ "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam" "event" "genvar" "inout" "input" "integer" "localparam" "logic" "mailbox" "nand" "nmos" "not" "notif0" "notif1" "or" - "output" "parameter" "pmos" "pull0" "pull1" "pullup" + "output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup" "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply" "supply0" "supply1" "time" "tran" "tranif0" "tranif1" @@ -2328,7 +2334,7 @@ '("surefire" "synopsys" "rtl_synthesis" "verilint" "leda" "0in") nil ))) - (verilog-p1800-keywords + (verilog-1800-2005-keywords (eval-when-compile (verilog-regexp-opt '("alias" "assert" "assume" "automatic" "before" "bind" @@ -2352,6 +2358,15 @@ "wait_order" "weak0" "weak1" "wildcard" "with" "within" ) nil ))) + (verilog-1800-2009-keywords + (eval-when-compile + (verilog-regexp-opt + '("accept_on" "checker" "endchecker" "eventually" "global" + "implies" "let" "nexttime" "reject_on" "restrict" "s_always" + "s_eventually" "s_nexttime" "s_until" "s_until_with" "strong" + "sync_accept_on" "sync_reject_on" "unique0" "until" + "until_with" "untyped" "weak" ) nil ))) + (verilog-ams-keywords (eval-when-compile (verilog-regexp-opt @@ -2403,11 +2418,17 @@ 'font-lock-type-face)) (cons (concat "\\<\\(" verilog-type-font-keywords "\\)\\>") 'font-lock-type-face) - ;; Fontify IEEE-P1800 keywords appropriately + ;; Fontify IEEE-1800-2005 keywords appropriately (if verilog-highlight-p1800-keywords - (cons (concat "\\<\\(" verilog-p1800-keywords "\\)\\>") + (cons (concat "\\<\\(" verilog-1800-2005-keywords "\\)\\>") 'verilog-font-lock-p1800-face) - (cons (concat "\\<\\(" verilog-p1800-keywords "\\)\\>") + (cons (concat "\\<\\(" verilog-1800-2005-keywords "\\)\\>") + 'font-lock-type-face)) + ;; Fontify IEEE-1800-2009 keywords appropriately + (if verilog-highlight-p1800-keywords + (cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>") + 'verilog-font-lock-p1800-face) + (cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>") 'font-lock-type-face)) ;; Fontify Verilog-AMS keywords (cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>") @@ -2580,20 +2601,28 @@ (setq md 3) ;; ender is third item in regexp ) ((match-end 4) - ;; might be "disable fork" - (if (or - (looking-at verilog-disable-fork-re) - (and (looking-at "fork") - (progn - (forward-word -1) - (looking-at verilog-disable-fork-re)))) - (progn - (goto-char (match-end 0)) - (forward-word 1) - (setq reg nil)) - (progn - ;; Search forward for matching join - (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )))) + ;; might be "disable fork" or "fork wait" + (let + (here) + (if (looking-at verilog-fork-wait-re) + (progn ;; it is a fork wait; ignore it + (goto-char (match-end 0)) + (setq reg nil)) + (if (or + (looking-at verilog-disable-fork-re) + (and (looking-at "fork") + (progn + (setq here (point)) ;; sometimes a fork is just a fork + (forward-word -1) + (looking-at verilog-disable-fork-re)))) + (progn ;; it is a disable fork; ignore it + (goto-char (match-end 0)) + (forward-word 1) + (setq reg nil)) + (progn ;; it is a nice simple fork + (goto-char here) ;; return from looking for "disable fork" + ;; Search forward for matching join + (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )))))) ((match-end 6) ;; Search forward for matching endclass (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" )) @@ -2644,12 +2673,27 @@ (let ((depth 1)) (while (verilog-re-search-forward reg nil 'move) (cond - ((match-end md) ; the closer in reg, so we are climbing out + ((match-end md) ; a closer in regular expression, so we are climbing out (setq depth (1- depth)) (if (= 0 depth) ; we are out! (throw 'skip 1))) - ((match-end 1) ; the opener in reg, so we are deeper now - (setq depth (1+ depth)))))) + ((match-end 1) ; an opener in the r-e, so we are in deeper now + (setq here (point)) ; remember where we started + (goto-char (match-beginning 1)) + (cond + ((looking-at verilog-fork-wait-re) + (goto-char (match-end 0))) ; false alarm + ((if (or + (looking-at verilog-disable-fork-re) + (and (looking-at "fork") + (progn + (forward-word -1) + (looking-at verilog-disable-fork-re)))) + (progn ;; it is a disable fork; another false alarm + (goto-char (match-end 0))) + (progn ;; it is a simple fork (or has nothing to do with fork) + (goto-char here) + (setq depth (1+ depth)))))))))) (if (verilog-re-search-forward reg nil 'move) (throw 'skip 1)))))) @@ -4532,8 +4576,9 @@ ((match-end 4) ; *sigh* could be "disable fork" (let ((here (point))) (verilog-beg-of-statement) - (if (looking-at verilog-disable-fork-re) - t ; is disable fork, this is a normal statement + (if (or (looking-at verilog-disable-fork-re) + (looking-at verilog-fork-wait-re)) + t ; this is a normal statement (progn ; or is fork, starts a new block (goto-char here) (throw 'nesting 'block))))) @@ -4882,31 +4927,13 @@ (goto-char back) t)))))))) -(defun verilog-backward-syntactic-ws (&optional bound) - "Backward skip over syntactic whitespace for Emacs 19. -Optional BOUND limits search." - (save-restriction - (let* ((bound (or bound (point-min))) (here bound) ) - (if (< bound (point)) - (progn - (narrow-to-region bound (point)) - (while (/= here (point)) - (setq here (point)) - (verilog-skip-backward-comments)))))) - t) - -(defun verilog-forward-syntactic-ws (&optional bound) - "Forward skip over syntactic whitespace for Emacs 19. -Optional BOUND limits search." - (save-restriction - (let* ((bound (or bound (point-max))) - (here bound)) - (if (> bound (point)) - (progn - (narrow-to-region (point) bound) - (while (/= here (point)) - (setq here (point)) - (forward-comment (buffer-size)))))))) +(defun verilog-backward-syntactic-ws () + (verilog-skip-backward-comments) + (forward-comment (- (buffer-size)))) + +(defun verilog-forward-syntactic-ws () + (verilog-skip-forward-comment-p) + (forward-comment (buffer-size))) (defun verilog-backward-ws&directives (&optional bound) "Backward skip over syntactic whitespace and compiler directives for Emacs 19. @@ -5119,14 +5146,11 @@ (search-backward "/*") (skip-chars-backward " \t\n\f") t) - ((and (not (bobp)) - (= (char-before) ?\/) - (= (char-before (1- (point))) ?\*)) - (goto-char (- (point) 2)) - t) - (t - (skip-chars-backward " \t\n\f") - nil))))))) + ((if (and (not (bobp)) + (= (char-before) ?\/) + (= (char-before (1- (point))) ?\*)) + (goto-char (- (point) 2)) + (/= (skip-chars-backward " \t\n\f") 0))))))))) (defun verilog-skip-forward-comment-p () "If in comment, move to end and return true." @@ -5134,16 +5158,18 @@ (progn (setq state (save-excursion (verilog-syntax-ppss))) (cond - ((nth 3 state) + ((nth 3 state) ;Inside string t) ((nth 7 state) ;Inside // comment (end-of-line) (forward-char 1) t) ((nth 4 state) ;Inside any comment + (search-forward "*/") + (skip-chars-forward " \t\n\f") t) (t - nil))))) + (skip-chars-forward " \t\n\f")))))) (defun verilog-indent-line-relative () "Cheap version of indent line. @@ -5376,108 +5402,143 @@ "Line up declarations around point. Be verbose about progress unless optional QUIET set." (interactive) - (save-excursion - (if (progn - (verilog-beg-of-statement-1) - (and (not (verilog-in-directive-p)) ;; could have `define input foo - (not (verilog-parenthesis-depth)) ;; could be in a #(param block ) + (let* ((m1 (make-marker)) + (e (point)) + el + r + (here (point)) + ind + start + startpos + end + endpos + base-ind + ) + (save-excursion + (if (progn +; (verilog-beg-of-statement-1) + (beginning-of-line) + (verilog-forward-syntactic-ws) + (and (not (verilog-in-directive-p)) ;; could have `define input foo (looking-at verilog-declaration-re))) - (let* ((m1 (make-marker)) - (e (point)) - (r) - (here (point)) - ;; Start of declaration range - (start - (progn - (verilog-beg-of-statement-1) - (while (and (looking-at verilog-declaration-re) - (not (bobp))) - (skip-chars-backward " \t") - (setq e (point)) - (beginning-of-line) - (verilog-backward-syntactic-ws) - (backward-char) - (verilog-beg-of-statement-1)) - e)) - ;; End of declaration range - (end - (progn - (goto-char here) - (verilog-end-of-statement) - (setq e (point)) ;Might be on last line - (verilog-forward-syntactic-ws) - (while (looking-at verilog-declaration-re) - ;;(beginning-of-line) - (verilog-end-of-statement) - (setq e (point)) - (verilog-forward-syntactic-ws)) - e)) - (edpos (set-marker (make-marker) end)) - (ind) - (base-ind - (progn - (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) - (verilog-forward-ws&directives) - (current-column)))) - (goto-char start) - (if (and (not quiet) - (> (- end start) 100)) - (message "Lining up declarations..(please stand by)")) - ;; Get the beginning of line indent first - (while (progn (setq e (marker-position edpos)) - (< (point) e)) - (cond - ( (save-excursion (skip-chars-backward " \t") - (bolp)) - (verilog-forward-ws&directives) - (indent-line-to base-ind) - (verilog-forward-ws&directives) - (verilog-re-search-forward "[ \t\n\f]" e 'move)) - (t - (just-one-space) - (verilog-re-search-forward "[ \t\n\f]" e 'move))) - ;;(forward-line) - ) - ;; Now find biggest prefix - (setq ind (verilog-get-lineup-indent start edpos)) - ;; Now indent each line. - (goto-char start) - (while (progn (setq e (marker-position edpos)) - (setq r (- e (point))) - (> r 0)) - (setq e (point)) - (unless quiet (message "%d" r)) - (verilog-indent-line) - (cond - ((or (and verilog-indent-declaration-macros - (looking-at verilog-declaration-re-2-macro)) - (looking-at verilog-declaration-re-2-no-macro)) - (let ((p (match-end 0))) - (set-marker m1 p) - (if (verilog-re-search-forward "[[#`]" p 'move) - (progn - (forward-char -1) - (just-one-space) - (goto-char (marker-position m1)) - (just-one-space) - (indent-to ind)) - (progn - (just-one-space) - (indent-to ind))))) - ((verilog-continued-line-1 start) - (goto-char e) - (indent-line-to ind)) - ((verilog-in-struct-p) - ;; could have a declaration of a user defined item - (goto-char e) - (verilog-end-of-statement)) - (t ; Must be comment or white space - (goto-char e) - (verilog-forward-ws&directives) - (forward-line -1))) - (forward-line 1)) - (unless quiet (message "")))))) + (progn + (if (verilog-parenthesis-depth) + ;; in an argument list or parameter block + (setq el (backward-up-list -1) + start (progn + (goto-char e) + (backward-up-list 1) + (forward-line) ;; ignore ( input foo, + (verilog-re-search-forward verilog-declaration-re el 'move) + (goto-char (match-beginning 0)) + (skip-chars-backward " \t") + (point)) + startpos (set-marker (make-marker) start) + end (progn + (goto-char start) + (backward-up-list -1) + (forward-char -1) + (verilog-backward-syntactic-ws) + (point)) + endpos (set-marker (make-marker) end) + base-ind (progn + (goto-char start) + (verilog-do-indent (verilog-calculate-indent)) + (verilog-forward-ws&directives) + (current-column)) + ) + ;; in a declaration block (not in argument list) + (setq + start (progn + (verilog-beg-of-statement-1) + (while (and (looking-at verilog-declaration-re) + (not (bobp))) + (skip-chars-backward " \t") + (setq e (point)) + (beginning-of-line) + (verilog-backward-syntactic-ws) + (backward-char) + (verilog-beg-of-statement-1)) + e) + startpos (set-marker (make-marker) start) + end (progn + (goto-char here) + (verilog-end-of-statement) + (setq e (point)) ;Might be on last line + (verilog-forward-syntactic-ws) + (while (looking-at verilog-declaration-re) + ;;(beginning-of-line) + (verilog-end-of-statement) + (setq e (point)) + (verilog-forward-syntactic-ws)) + e) + endpos (set-marker (make-marker) end) + base-ind (progn + (goto-char start) + (verilog-do-indent (verilog-calculate-indent)) + (verilog-forward-ws&directives) + (current-column)))) + ;; OK, start and end are set + (goto-char (marker-position startpos)) + (if (and (not quiet) + (> (- end start) 100)) + (message "Lining up declarations..(please stand by)")) + ;; Get the beginning of line indent first + (while (progn (setq e (marker-position endpos)) + (< (point) e)) + (cond + ((save-excursion (skip-chars-backward " \t") + (bolp)) + (verilog-forward-ws&directives) + (indent-line-to base-ind) + (verilog-forward-ws&directives) + (if (< (point) e) + (verilog-re-search-forward "[ \t\n\f]" e 'move))) + (t + (just-one-space) + (verilog-re-search-forward "[ \t\n\f]" e 'move))) + ;;(forward-line) + ) + ;; Now find biggest prefix + (setq ind (verilog-get-lineup-indent (marker-position startpos) endpos)) + ;; Now indent each line. + (goto-char (marker-position startpos)) + (while (progn (setq e (marker-position endpos)) + (setq r (- e (point))) + (> r 0)) + (setq e (point)) + (unless quiet (message "%d" r)) + (verilog-indent-line) + (verilog-forward-ws&directives) + (cond + ((or (and verilog-indent-declaration-macros + (looking-at verilog-declaration-re-2-macro)) + (looking-at verilog-declaration-re-2-no-macro)) + (let ((p (match-end 0))) + (set-marker m1 p) + (if (verilog-re-search-forward "[[#`]" p 'move) + (progn + (forward-char -1) + (just-one-space) + (goto-char (marker-position m1)) + (just-one-space) + (indent-to ind)) + (progn + (just-one-space) + (indent-to ind))))) + ((verilog-continued-line-1 (marker-position startpos)) + (goto-char e) + (indent-line-to ind)) + ((verilog-in-struct-p) + ;; could have a declaration of a user defined item + (goto-char e) + (verilog-end-of-statement)) + (t ; Must be comment or white space + (goto-char e) + (verilog-forward-ws&directives) + (forward-line -1))) + (forward-line 1)) + (unless quiet (message ""))))))) (defun verilog-pretty-expr (&optional quiet myre) "Line up expressions around point, optionally QUIET with regexp MYRE." @@ -5486,7 +5547,8 @@ (if (or (eq myre nil) (string-equal myre "")) (setq myre "\\(<\\|:\\)?=")) - (setq myre (concat "\\(^[^;#:<=>]*\\)\\(" myre "\\)")) + ;; want to match the first <= | := | = + (setq myre (concat "\\(^.*?\\)\\(" myre "\\)")) (let ((rexp(concat "^\\s-*" verilog-complete-reg))) (beginning-of-line) (if (and (not (looking-at rexp )) @@ -5529,7 +5591,7 @@ (beginning-of-line) ) e)) - (edpos (set-marker (make-marker) end)) + (endpos (set-marker (make-marker) end)) (ind) ) (goto-char start) @@ -5539,7 +5601,7 @@ (message "Lining up expressions..(please stand by)")) ;; Set indent to minimum throughout region - (while (< (point) (marker-position edpos)) + (while (< (point) (marker-position endpos)) (beginning-of-line) (verilog-just-one-space myre) (end-of-line) @@ -5547,11 +5609,11 @@ ) ;; Now find biggest prefix - (setq ind (verilog-get-lineup-indent-2 myre start edpos)) + (setq ind (verilog-get-lineup-indent-2 myre start endpos)) ;; Now indent each line. (goto-char start) - (while (progn (setq e (marker-position edpos)) + (while (progn (setq e (marker-position endpos)) (setq r (- e (point))) (> r 0)) (setq e (point)) @@ -5679,7 +5741,8 @@ ;; No lineup-string found (goto-char b) (end-of-line) - (skip-chars-backward " \t") + (verilog-backward-syntactic-ws) + ;;(skip-chars-backward " \t") (1+ (current-column)))))) (defun verilog-get-lineup-indent-2 (myre b edpos) @@ -5747,7 +5810,7 @@ '( "and" "buf" "bufif0" "bufif1" "cmos" "defparam" "inout" "input" "integer" "localparam" "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" - "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pullup" + "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup" "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0" "rtranif1" "semaphore" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" "triand" "trior" "trireg" "wand" "wire" "wor" "xnor" "xor" @@ -6974,7 +7037,7 @@ (verilog-read-sub-decls-expr submoddecls comment port (buffer-substring - (point) (1- (progn (backward-char 1) ; start at ( + (point) (1- (progn (search-backward "(") ; start at ( (forward-sexp 1) (point)))))))) ; expr ;; (forward-line 1))))) @@ -8747,6 +8810,8 @@ (defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-dir nil "See `verilog-auto-inst'.") ; Prevent compile warning +(defvar vl-bits nil "See `verilog-auto-inst'.") ; Prevent compile warning +(defvar vl-mbits nil "See `verilog-auto-inst'.") ; Prevent compile warning (defun verilog-auto-inst-port (port-st indent-pt tpl-list tpl-num for-star par-values) "Print out a instantiation connection for this PORT-ST. @@ -8762,6 +8827,8 @@ (vl-name (verilog-sig-name port-st)) (vl-width (verilog-sig-width port-st)) (vl-modport (verilog-sig-modport port-st)) + (vl-mbits (if (verilog-sig-multidim port-st) + (verilog-sig-multidim-string port-st) "")) (vl-bits (if (or verilog-auto-inst-vector (not (assoc port vector-skip-list)) (not (equal (verilog-sig-bits port-st) @@ -9110,6 +9177,7 @@ vl-name Name portion of the input/output port. vl-bits Bus bits portion of the input/output port ('[2:0]'). + vl-mbits Multidimensional array bits for port ('[2:0][3:0]'). vl-width Width of the input/output port ('3' for [2:0]). May be a (...) expression if bits isn't a constant. vl-dir Direction of the pin input/output/inout/interface.
--- a/lisp/simple.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/simple.el Thu Apr 15 11:20:03 2010 +0200 @@ -3940,6 +3940,14 @@ If `widen-automatically' is nil, these commands will do something else as a fallback, and won't change the buffer bounds.") +(defvar non-essential nil + "Whether the currently executing code is performing an essential task. +This variable should be non-nil only when running code which should not +disturb the user. E.g. it can be used to prevent Tramp from prompting the +user for a password when we are simply scanning a set of files in the +background or displaying possible completions before the user even asked +for it.") + (defun pop-global-mark () "Pop off global mark ring and jump to the top location." (interactive) @@ -4738,6 +4746,111 @@ visual-line-mode turn-on-visual-line-mode :lighter " vl") +;;; Scrolling commands. + +;;; Scrolling commands which does not signal errors at top/bottom +;;; of buffer at first key-press (instead moves to top/bottom +;;; of buffer). + +(defcustom scroll-error-top-bottom nil + "Move point to top/bottom of buffer before signalling a scrolling error. +A value of nil means just signal an error if no more scrolling possible. +A value of t means point moves to the beginning or the end of the buffer +\(depending on scrolling direction) when no more scrolling possible. +When point is already on that position, then signal an error." + :type 'boolean + :group 'scrolling + :version "24.1") + +(defun scroll-up-command (&optional arg) + "Scroll text of selected window upward ARG lines; or near full screen if no ARG. +If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot +scroll window further, move cursor to the bottom line. +When point is already on that position, then signal an error. +A near full screen is `next-screen-context-lines' less than a full screen. +Negative ARG means scroll downward. +If ARG is the atom `-', scroll downward by nearly full screen." + (interactive "^P") + (cond + ((null scroll-error-top-bottom) + (scroll-up arg)) + ((eq arg '-) + (scroll-down-command nil)) + ((< (prefix-numeric-value arg) 0) + (scroll-down-command (- (prefix-numeric-value arg)))) + ((eobp) + (scroll-up arg)) ; signal error + (t + (condition-case nil + (scroll-up arg) + (end-of-buffer + (if arg + ;; When scrolling by ARG lines can't be done, + ;; move by ARG lines instead. + (forward-line arg) + ;; When ARG is nil for full-screen scrolling, + ;; move to the bottom of the buffer. + (goto-char (point-max)))))))) + +(put 'scroll-up-command 'isearch-scroll t) +(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-command) + +(defun scroll-down-command (&optional arg) + "Scroll text of selected window down ARG lines; or near full screen if no ARG. +If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot +scroll window further, move cursor to the top line. +When point is already on that position, then signal an error. +A near full screen is `next-screen-context-lines' less than a full screen. +Negative ARG means scroll upward. +If ARG is the atom `-', scroll upward by nearly full screen." + (interactive "^P") + (cond + ((null scroll-error-top-bottom) + (scroll-down arg)) + ((eq arg '-) + (scroll-up-command nil)) + ((< (prefix-numeric-value arg) 0) + (scroll-up-command (- (prefix-numeric-value arg)))) + ((bobp) + (scroll-down arg)) ; signal error + (t + (condition-case nil + (scroll-down arg) + (beginning-of-buffer + (if arg + ;; When scrolling by ARG lines can't be done, + ;; move by ARG lines instead. + (forward-line (- arg)) + ;; When ARG is nil for full-screen scrolling, + ;; move to the top of the buffer. + (goto-char (point-min)))))))) + +(put 'scroll-down-command 'isearch-scroll t) +(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-command) + +;;; Scrolling commands which scroll a line instead of full screen. + +(defun scroll-up-line (&optional arg) + "Scroll text of selected window upward ARG lines; or one line if no ARG. +If ARG is omitted or nil, scroll upward by one line. +This is different from `scroll-up-command' that scrolls a full screen." + (interactive "p") + (scroll-up (or arg 1))) + +(put 'scroll-up-line 'isearch-scroll t) +(add-to-list 'scroll-preserve-screen-position-commands 'scroll-up-line) + +(defun scroll-down-line (&optional arg) + "Scroll text of selected window down ARG lines; or one line if no ARG. +If ARG is omitted or nil, scroll down by one line. +This is different from `scroll-down-command' that scrolls a full screen." + (interactive "p") + (scroll-down (or arg 1))) + +(put 'scroll-down-line 'isearch-scroll t) +(add-to-list 'scroll-preserve-screen-position-commands 'scroll-down-line) + + (defun scroll-other-window-down (lines) "Scroll the \"other window\" down. For more details, see the documentation for `scroll-other-window'."
--- a/lisp/tutorial.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/tutorial.el Thu Apr 15 11:20:03 2010 +0200 @@ -218,8 +218,8 @@ (save-buffers-kill-terminal [?\C-x ?\C-c]) ;; * SUMMARY - (scroll-up [?\C-v]) - (scroll-down [?\M-v]) + (scroll-up-command [?\C-v]) + (scroll-down-command [?\M-v]) (recenter-top-bottom [?\C-l]) ;; * BASIC CURSOR CONTROL
--- a/lisp/vc-arch.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-arch.el Thu Apr 15 11:20:03 2010 +0200 @@ -254,8 +254,7 @@ (buffer-substring (point-min) (1- (point-max))))))))) (defun vc-arch-workfile-unchanged-p (file) - "Check if FILE is unchanged by diffing against the master version. -Return non-nil if FILE is unchanged." + "Stub: arch workfiles are always considered to be in a changed state," nil) (defun vc-arch-state (file)
--- a/lisp/vc-bzr.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-bzr.el Thu Apr 15 11:20:03 2010 +0200 @@ -478,7 +478,6 @@ (defvar log-view-font-lock-keywords) (defvar log-view-current-tag-function) (defvar log-view-per-file-logs) -(defvar vc-short-log) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. @@ -486,13 +485,13 @@ (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-message-re) - (if vc-short-log + (if (eq vc-log-view-type 'short) "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?" "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) ;; log-view-font-lock-keywords is careful to use the buffer-local ;; value of log-view-message-re only since Emacs-23. - (if vc-short-log + (if (eq vc-log-view-type 'short) (append `((,log-view-message-re (1 'log-view-message-face) (2 'change-log-name) @@ -526,6 +525,14 @@ (list vc-bzr-log-switches) vc-bzr-log-switches))))) +(defun vc-bzr-log-incoming (buffer remote-location) + (apply 'vc-bzr-command "missing" buffer 'async nil + (list "--theirs-only" (unless (string= remote-location "") remote-location)))) + +(defun vc-bzr-log-outgoing (buffer remote-location) + (apply 'vc-bzr-command "missing" buffer 'async nil + (list "--mine-only" (unless (string= remote-location "") remote-location)))) + (defun vc-bzr-show-log-entry (revision) "Find entry for patch name REVISION in bzr change log buffer." (goto-char (point-min))
--- a/lisp/vc-dir.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-dir.el Thu Apr 15 11:20:03 2010 +0200 @@ -263,6 +263,7 @@ (define-key map [mouse-2] 'vc-dir-toggle-mark) (define-key map [follow-link] 'mouse-face) (define-key map "x" 'vc-dir-hide-up-to-date) + (define-key map [?\C-k] 'vc-dir-kill-line) (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired? (define-key map "Q" 'vc-dir-query-replace-regexp) (define-key map (kbd "M-s a C-s") 'vc-dir-isearch) @@ -1088,6 +1089,13 @@ (ewoc-delete vc-ewoc crt)) (setq crt prev))))) +(defun vc-dir-kill-line () + "Remove the current line from display." + (interactive) + (let ((crt (ewoc-locate vc-ewoc)) + (inhibit-read-only t)) + (ewoc-delete vc-ewoc crt))) + (defun vc-dir-printer (fileentry) (vc-call-backend vc-dir-backend 'dir-printer fileentry))
--- a/lisp/vc-git.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-git.el Thu Apr 15 11:20:03 2010 +0200 @@ -171,7 +171,14 @@ (defun vc-git-state (file) "Git-specific version of `vc-state'." - ;; FIXME: This can't set 'ignored yet + ;; FIXME: This can't set 'ignored or 'conflict yet + ;; The 'ignored state could be detected with `git ls-files -i -o + ;; --exclude-standard` It also can't set 'needs-update or + ;; 'needs-merge. The rough equivalent would be that upstream branch + ;; for current branch is in fast-forward state i.e. current branch + ;; is direct ancestor of corresponding upstream branch, and the file + ;; was modified upstream. But we can't check that without a network + ;; operation. (if (not (vc-git-registered file)) 'unregistered (vc-git--call nil "add" "--refresh" "--" (file-relative-name file)) @@ -541,10 +548,10 @@ (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) -(defun vc-git-checkin (files rev comment &optional extra-args-ignored) +(defun vc-git-checkin (files rev comment &optional extra-args) (let ((coding-system-for-write git-commits-coding-system)) - (vc-git-command nil 0 files "commit" - "-m" comment "--only" "--"))) + (apply 'vc-git-command nil 0 files + (nconc (list "commit" "-m" comment) extra-args (list "--only" "--"))))) (defun vc-git-find-revision (file rev buffer) (let* (process-file-side-effects @@ -592,25 +599,32 @@ (when start-revision (list start-revision)) '("--"))))))) +(defun vc-git-log-outgoing (buffer remote-location) + (interactive) + (vc-git-command + buffer 0 nil + "log" (if (string= remote-location "") + ;; FIXME: this hardcodes the location, it should compute + ;; it properly. + "origin/master..HEAD" + remote-location))) + (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) -;; Dynamically bound. -(defvar vc-short-log) - (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; We need the faces add-log. ;; Don't have file markers, so use impossible regexp. (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if vc-short-log + (if (eq vc-log-view-type 'short) "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" "^commit *\\([0-9a-z]+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) - (if vc-short-log + (if (eq vc-log-view-type 'short) '( ;; Same as log-view-message-re, except that we don't ;; want the shy group for the tag name. @@ -776,6 +790,21 @@ (progn (forward-line 1) (1- (point))))))))) (or (vc-git-symbolic-commit next-rev) next-rev))) +(declare-function log-edit-mode "log-edit" ()) +(defvar log-edit-extra-flags) +(defvar log-edit-before-checkin-process) + +(define-derived-mode vc-git-log-edit-mode log-edit-mode "Git-log-edit" + "Mode for editing Git commit logs. +If a line like: +Author: NAME +is present in the log, it is removed, and +--author=NAME +is passed to the git commit command." + (set (make-local-variable 'log-edit-extra-flags) nil) + (set (make-local-variable 'log-edit-before-checkin-process) + '(("^Author:[ \t]+\\(.*\\)[ \t]*$" . (list "--author" (match-string 1)))))) + (defun vc-git-delete-file (file) (vc-git-command nil 0 file "rm" "-f" "--"))
--- a/lisp/vc-hg.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-hg.el Thu Apr 15 11:20:03 2010 +0200 @@ -245,23 +245,23 @@ (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) -(defvar vc-short-log) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces (set (make-local-variable 'log-view-file-re) "\\`a\\`") (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if vc-short-log - "^\\([0-9]+\\)\\(?:\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" + (if (eq vc-log-view-type 'short) + "^\\([0-9]+\\)\\(\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) (set (make-local-variable 'log-view-font-lock-keywords) - (if vc-short-log + (if (eq vc-log-view-type 'short) (append `((,log-view-message-re (1 'log-view-message-face) - (2 'log-view-message-face) - (3 'change-log-date) - (4 'change-log-name)))) + (2 'highlight nil lax) + (3 'log-view-message-face) + (4 'change-log-date) + (5 'change-log-name)))) (append log-view-font-lock-keywords '( @@ -277,7 +277,8 @@ ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" (1 'change-log-email)) ("^date: \\(.+\\)" (1 'change-log-date)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) + ("^tag: +\\([^ ]+\\)$" (1 'highlight)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) (declare-function log-edit-mode "log-edit" ()) (defvar log-edit-extra-flags) @@ -454,8 +455,6 @@ (defvar vc-hg-extra-menu-map (let ((map (make-sparse-keymap))) - (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming)) - (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing)) map)) (defun vc-hg-extra-menu () vc-hg-extra-menu-map) @@ -464,14 +463,6 @@ (defvar log-view-vc-backend) -(define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing" - "Mode for browsing Hg outgoing changes." - (set (make-local-variable 'log-view-vc-backend) 'Hg)) - -(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming" - "Mode for browsing Hg incoming changes." - (set (make-local-variable 'log-view-vc-backend) 'Hg)) - (defstruct (vc-hg-extra-fileinfo (:copier nil) (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name)) @@ -577,33 +568,13 @@ ;; (vc-hg-dir-extra-header "Global id : " "id" "-i") ))) -;; FIXME: this adds another top level menu, instead figure out how to -;; replace the Log-View menu. -(easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map - "Hg-outgoing Display Menu" - `("Hg-outgoing" - ["Push selected" vc-hg-push])) - -(easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map - "Hg-incoming Display Menu" - `("Hg-incoming" - ["Pull selected" vc-hg-pull])) +(defun vc-hg-log-incoming (buffer remote-location) + (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "") + remote-location))) -(defun vc-hg-outgoing () - (interactive) - (let ((bname "*Hg outgoing*") - (vc-short-log nil)) - (vc-hg-command bname 1 nil "outgoing" "-n") - (pop-to-buffer bname) - (vc-hg-outgoing-mode))) - -(defun vc-hg-incoming () - (interactive) - (let ((bname "*Hg incoming*") - (vc-short-log nil)) - (vc-hg-command bname 0 nil "incoming" "-n") - (pop-to-buffer bname) - (vc-hg-incoming-mode))) +(defun vc-hg-log-outgoing (buffer remote-location) + (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") + remote-location))) (declare-function log-view-get-marked "log-view" ())
--- a/lisp/vc-hooks.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc-hooks.el Thu Apr 15 11:20:03 2010 +0200 @@ -396,7 +396,7 @@ (defun vc-backend-subdirectory-name (file) - "Return where the master and lock FILEs for the current directory are kept." + "Return where the repository for the current directory is kept." (symbol-name (vc-backend file))) (defun vc-name (file) @@ -460,17 +460,20 @@ 'edited The working file has been edited by the user. If locking is used for the file, this state means that the current version is locked by the calling user. + This status should *not* be reported for files + which have a changed mtime but the same content + as the repo copy. USER The current version of the working file is locked by some other USER (a string). - 'needs-update The file has not been edited by the user, but there is + 'needs-update The file has not been edited by the user, but there is a more recent version on the current branch stored - in the master file. + in the repository. 'needs-merge The file has been edited by the user, and there is also a more recent version on the current branch stored in - the master file. This state can only occur if locking + the repository. This state can only occur if locking is not used for the file. 'unlocked-changes The working version of the file is not locked, @@ -549,7 +552,7 @@ unchanged)))) (defun vc-default-workfile-unchanged-p (backend file) - "Check if FILE is unchanged by diffing against the master version. + "Check if FILE is unchanged by diffing against the repository version. Return non-nil if FILE is unchanged." (zerop (condition-case err ;; If the implementation supports it, let the output @@ -981,6 +984,12 @@ (define-key map [vc-update-change-log] `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log :help ,(purecopy "Find change log file and add entries from recent version control logs"))) + (define-key map [vc-log-out] + `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing + :help ,(purecopy "Show a log of changes that will be sent with a push operation"))) + (define-key map [vc-log-in] + `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming + :help ,(purecopy "Show a log of changes that will be received with a pull operation"))) (define-key map [vc-print-log] `(menu-item ,(purecopy "Show History") vc-print-log :help ,(purecopy "List the change log of the current file set in a window")))
--- a/lisp/vc.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/vc.el Thu Apr 15 11:20:03 2010 +0200 @@ -63,11 +63,18 @@ ;; although you might prefer to use C-c C-a (i.e. `log-edit-insert-changelog') ;; from the commit buffer instead or to set `log-edit-setup-invert'. ;; -;; The vc code maintains some internal state in order to reduce expensive -;; version-control operations to a minimum. Some names are only computed -;; once. If you perform version control operations with the backend while -;; vc's back is turned, or move/rename master files while vc is running, -;; vc may get seriously confused. Don't do these things! +;; When using SCCS, RCS, CVS: be careful not to do repo surgery, or +;; operations like registrations and deletions and renames, outside VC +;; while VC is running. The support for these systems was designed +;; when disks were much slower, and the code maintains a lot of +;; internal state in order to reduce expensive operations to a +;; minimum. Thus, if you mess with the repo while VC's back is turned, +;; VC may get seriously confused. +;; +;; When using Subversion or a later system, anything you do outside VC +;; *through the VCS tools* should safely interlock with VC +;; operations. Under these VC does little state caching, because local +;; operations are assumed to be fast. The dividing line is ;; ;; ADDING SUPPORT FOR OTHER BACKENDS ;; @@ -196,7 +203,7 @@ ;; ;; Return non-nil if FILE is unchanged from the working revision. ;; This function should do a brief comparison of FILE's contents -;; with those of the repository master of the working revision. If +;; with those of the repository copy of the working revision. If ;; the backend does not have such a brief-comparison feature, the ;; default implementation of this function can be used, which ;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff @@ -345,6 +352,16 @@ ;; revision. At this point START-REVISION is only required to work ;; in conjunction with LIMIT = 1. ;; +;; * log-outgoing (backend remote-location) +;; +;; Insert in BUFFER the revision log for the changes that will be +;; sent when performing a push operation to REMOTE-LOCATION. +;; +;; * log-incoming (backend remote-location) +;; +;; Insert in BUFFER the revision log for the changes that will be +;; received when performing a pull operation from REMOTE-LOCATION. +;; ;; - log-view-mode () ;; ;; Mode to use for the output of print-log. This defaults to @@ -774,7 +791,7 @@ (defcustom vc-checkout-carefully (= (user-uid) 0) "Non-nil means be extra-careful in checkout. Verify that the file really is not locked -and that its contents match what the master file says." +and that its contents match what the repository version says." :type 'boolean :group 'vc) (make-obsolete-variable 'vc-checkout-carefully @@ -1508,7 +1525,7 @@ (not (string= (vc-working-revision file) "0"))) (push file filtered) ;; This file is added but not yet committed; - ;; there is no master file to diff against. + ;; there is no repository version to diff against. (if (or rev1 rev2) (error "No revisions of %s exist" file) ;; We regard this as "changed". @@ -1642,9 +1659,14 @@ (error "Buffer is not version controlled")) (setq rootdir (vc-call-backend backend 'root default-directory)) (setq working-revision (vc-working-revision rootdir)) - (vc-diff-internal - t (list backend (list rootdir) working-revision) nil nil - (called-interactively-p 'interactive))))) + ;; VC diff for the root directory produces output that is + ;; relative to it. Bind default-directory to the root directory + ;; here, this way the *vc-diff* buffer is setup correctly, so + ;; relative file names work. + (let ((default-directory rootdir)) + (vc-diff-internal + t (list backend (list rootdir) working-revision) nil nil + (called-interactively-p 'interactive)))))) ;;;###autoload (defun vc-revision-other-window (rev) @@ -1886,6 +1908,29 @@ (defvar log-view-vc-backend) (defvar log-view-vc-fileset) +(defun vc-print-log-setup-buttons (working-revision is-start-revision limit pl-return) + (when (and limit (not (eq 'limit-unsupported pl-return)) + (not is-start-revision)) + (goto-char (point-max)) + (lexical-let ((working-revision working-revision) + (limit limit)) + (widget-create 'push-button + :notify (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + :help-echo "Show the log again, and double the number of log entries shown" + "Show 2X entries") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + :help-echo "Show the log again, showing all entries" + "Show unlimited entries")) + (widget-setup))) + (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) ;; Don't switch to the output buffer before running the command, @@ -1893,6 +1938,8 @@ ;; buffer can be accessed by the command. (let ((dir-present nil) (vc-short-log nil) + (buffer-name "*vc-change-log*") + type pl-return) (dolist (file files) (when (file-directory-p file) @@ -1901,44 +1948,64 @@ (not (null (if dir-present (memq 'directory vc-log-short-style) (memq 'file vc-log-short-style))))) + (setq type (if vc-short-log 'short 'long)) + (lexical-let + ((working-revision working-revision) + (limit limit) + (shortlog vc-short-log) + (is-start-revision is-start-revision)) + (vc-log-internal-common + backend buffer-name files type + (lambda (bk buf type-arg files-arg) + (vc-call-backend bk 'print-log files-arg buf + shortlog (when is-start-revision working-revision) limit)) + (lambda (bk files-arg ret) + (vc-print-log-setup-buttons working-revision + is-start-revision limit ret)) + (lambda (bk) + (vc-call-backend bk 'show-log-entry working-revision)))))) - (setq pl-return (vc-call-backend - backend 'print-log files "*vc-change-log*" - vc-short-log (when is-start-revision working-revision) limit)) - (pop-to-buffer "*vc-change-log*") +(defvar vc-log-view-type nil + "Set this to differentiate the different types of logs.") +(put 'vc-log-view-type 'permanent-local t) + +(defun vc-log-internal-common (backend + buffer-name + files + type + backend-func + setup-buttons-func + goto-location-func) + (let (retval) + (with-current-buffer (get-buffer-create buffer-name) + (set (make-local-variable 'vc-log-view-type) type)) + (setq retval (funcall backend-func backend buffer-name type files)) + (pop-to-buffer buffer-name) (let ((inhibit-read-only t)) ;; log-view-mode used to be called with inhibit-read-only bound ;; to t, so let's keep doing it, just in case. - (vc-call-backend backend 'log-view-mode)) - (set (make-local-variable 'log-view-vc-backend) backend) - (set (make-local-variable 'log-view-vc-fileset) files) - + (vc-call-backend backend 'log-view-mode) + (set (make-local-variable 'log-view-vc-backend) backend) + (set (make-local-variable 'log-view-vc-fileset) files)) (vc-exec-after `(let ((inhibit-read-only t)) - (when (and ,limit (not ,(eq 'limit-unsupported pl-return)) - (not ,is-start-revision)) - (goto-char (point-max)) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - ',backend ',files ',working-revision nil (* 2 ,limit))) - :help-echo "Show the log again, and double the number of log entries shown" - "Show 2X entries") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - ',backend ',files ',working-revision nil nil)) - :help-echo "Show the log again, showing all entries" - "Show unlimited entries") - (widget-setup)) - + (funcall ',setup-buttons-func ',backend ',files ',retval) (shrink-window-if-larger-than-buffer) - ;; move point to the log entry for the working revision - (vc-call-backend ',backend 'show-log-entry ',working-revision) + (funcall ',goto-location-func ',backend) (setq vc-sentinel-movepoint (point)) (set-buffer-modified-p nil))))) +(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type) + (vc-log-internal-common + backend buffer-name nil type + (lexical-let + ((remote-location remote-location)) + (lambda (bk buf type-arg files) + (vc-call-backend bk type-arg buf remote-location))) + (lambda (bk files-arg ret)) + (lambda (bk) + (goto-char (point-min))))) + ;;;###autoload (defun vc-print-log (&optional working-revision limit) "List the change log of the current fileset in a window. @@ -1999,6 +2066,32 @@ (vc-print-log-internal backend (list rootdir) working-revision nil limit))) ;;;###autoload +(defun vc-log-incoming (&optional remote-location) + "Show a log of changes that will be received with a pull operation from REMOTE-LOCATION." + (interactive "sRemote location (empty for default): ") + (let ((backend + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) + (vc-mode (vc-backend buffer-file-name)))) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (vc-incoming-outgoing-internal backend remote-location "*vc-incoming*" 'log-incoming))) + +;;;###autoload +(defun vc-log-outgoing (&optional remote-location) + "Show a log of changes that will be sent with a push operation to REMOTE-LOCATION." + (interactive "sRemote location (empty for default): ") + (let ((backend + (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + ((derived-mode-p 'dired-mode) (vc-responsible-backend default-directory)) + (vc-mode (vc-backend buffer-file-name)))) + rootdir working-revision) + (unless backend + (error "Buffer is not version controlled")) + (vc-incoming-outgoing-internal backend remote-location "*vc-outgoing*" 'log-outgoing))) + +;;;###autoload (defun vc-revert () "Revert working copies of the selected fileset to their repository contents. This asks for confirmation if the buffer contents are not identical @@ -2232,7 +2325,7 @@ (if unmodified-file (copy-file unmodified-file file 'ok-if-already-exists 'keep-date) - (when (y-or-n-p "Get base revision from master? ") + (when (y-or-n-p "Get base revision from repository? ") (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) (when modified-file @@ -2319,7 +2412,7 @@ ;;;###autoload (defun vc-rename-file (old new) - "Rename file OLD to NEW, and rename its master file likewise." + "Rename file OLD to NEW in both work area and repository." (interactive "fVC rename file: \nFRename to: ") ;; in CL I would have said (setq new (merge-pathnames new old)) (let ((old-base (file-name-nondirectory old)))
--- a/lisp/wid-edit.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/wid-edit.el Thu Apr 15 11:20:03 2010 +0200 @@ -253,7 +253,9 @@ ;; Allocate digits to disabled alternatives ;; so that the digit of a given alternative never varies. (setq next-digit (1+ next-digit))) - (insert "\nC-g = Quit")) + (insert "\nC-g = Quit") + (goto-char (point-min)) + (forward-line)) (or some-choice-enabled (error "None of the choices is currently meaningful")) (define-key map [?\C-g] 'keyboard-quit)
--- a/lisp/woman.el Sat Apr 03 22:21:58 2010 +0200 +++ b/lisp/woman.el Thu Apr 15 11:20:03 2010 +0200 @@ -1897,6 +1897,7 @@ (setq woman-emulation value) (woman-reformat-last-file)) +(defvar bookmark-make-record-function) (put 'woman-mode 'mode-class 'special) (defun woman-mode () @@ -1934,6 +1935,9 @@ ;; `make-local-variable' in case imenu not yet loaded! woman-imenu-generic-expression) (set (make-local-variable 'imenu-space-replacement) " ") + ;; Bookmark support. + (set (make-local-variable 'bookmark-make-record-function) + 'woman-bookmark-make-record) ;; For reformat ... ;; necessary when reformatting a file in its old buffer: (setq imenu--last-menubar-index-alist nil) @@ -4516,6 +4520,36 @@ (recenter 0)))))))) nil) ; for woman-file-readable-p etc. +;;; Bookmark Woman support. +(declare-function bookmark-make-record-default "bookmark" (&optional pos-only)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-default-handler "bookmark" (bmk)) +(declare-function bookmark-get-bookmark-record "bookmark" (bmk)) + +;; FIXME: woman.el and man.el should be better integrated so, for +;; example, bookmarks of one can be used with the other. + +(defun woman-bookmark-make-record () + "Make a bookmark entry for a Woman buffer." + `(,(Man-default-bookmark-title) + ,@(bookmark-make-record-default 'point-only) + (location . ,(concat "woman " woman-last-file-name)) + ;; Use the same form as man's bookmarks, as much as possible. + (man-args . ,woman-last-file-name) + (handler . woman-bookmark-jump))) + +;;;###autoload +(defun woman-bookmark-jump (bookmark) + "Default bookmark handler for Woman buffers." + (let* ((file (bookmark-prop-get bookmark 'man-args)) + ;; FIXME: we need woman-find-file-noselect, since + ;; save-window-excursion can't protect us from the case where + ;; woman-find-file creates a new frame. + (buf (save-window-excursion + (woman-find-file file) (current-buffer)))) + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) + (provide 'woman) ;; arch-tag: eea35e90-552f-4712-a94b-d9ffd3db7651
--- a/lwlib/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,59 @@ +2010-04-11 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE) + (C_SWITCH_X_SITE): Define using autoconf. + +2010-04-11 Jan Djärv <jan.h.d@swipnet.se> + + * lwlib-Xaw.c (widget_xft_data): New for Xft data. + (fill_xft_data, openFont, get_text_width_and_height) + (draw_text, set_text, find_xft_data, command_press) + (command_reset): New functions. + (xaw_update_one_widget): Call set_text for dialog and buttons + if HAVE_XFT. Also set internalHeight for buttons. + (xaw_destroy_instance): Free all Xft related data. + (button_actions, buttonTrans): New structures. + (make_dialog): Call XtAppAddActions for button_actions. + Find xft font to use and call fill_xft_data for widgets. + (xaw_create_dialog): Pass instance parameter to make_dialog. + + * lwlib-int.h (_widget_instance): Add Xft data if HAVE_XFT. + Override translations for buttons. If depth is 16 or more, tell + Xaw3d to not be nice to colormap. + Remove separator widget, use XtNhorizDistance on first right button + instead. + +2010-04-08 Jan Djärv <jan.h.d@swipnet.se> + + * xlwmenu.c (xlwmenu_default_font): Make static. + (xlwMenuResources): Add XtNfaceName and XtNdefaultFace. + (string_width): Use XftTextExtentsUtf8 if HAVE_XFT. + (MENU_FONT_HEIGHT, MENU_FONT_ASCENT): Add versions for + HAVE_XFT. + (size_menu): Set max_rest_width in window_state structure. + (display_menu_item): If HAVE_XFT and xft_draw is set, use + XftDrawRect and XftDrawStringUtf8 to draw text. + (make_windows_if_needed): Set max_rest_width and xft_draw + in windows[i]. + (openXftFont): New. + (XlwMenuInitialize): Call openXftFont if HAVE_XFT. If mw->menu.font + is not set, load font fixed and save it in xlwmenu_default_font. + (XlwMenuInitialize): Set max_rest_width and xft_draw in windows[0]. + (XlwMenuClassInitialize): Initialize xlwmenu_default_font. + (XlwMenuRealize): Set xft_fg, xft_bg, xft_disabled_fg and + windows[0].xft_draw if xft_font is set. + (XlwMenuDestroy): Destroy all xft_draw and close xft_font. + (facename_changed): New. + (XlwMenuSetValues): Call facename_changed. If face name did change, + close old fonts and destroy xft_draw:s. Then create new ones. + + * xlwmenu.h (XtNfaceName, XtCFaceName, XtNdefaultFace, + XtCDefaultFace): New. + + * xlwmenuP.h (_window_state): Add max_rest_width and xft_draw. + (_XlwMenu_part): Add faceName,xft_fg, xft_bg, xft_disabled_fg and + xft_font. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/lwlib/Makefile.in Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/Makefile.in Thu Apr 15 11:20:03 2010 +0200 @@ -26,6 +26,8 @@ srcdir=@srcdir@ VPATH=@srcdir@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ +C_SWITCH_SYSTEM=@c_switch_system@ +C_SWITCH_MACHINE=@c_switch_machine@ CC=@CC@ CFLAGS=@CFLAGS@
--- a/lwlib/lwlib-Xaw.c Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/lwlib-Xaw.c Thu Apr 15 11:20:03 2010 +0200 @@ -54,6 +54,22 @@ #include <X11/Xatom.h> +#ifdef HAVE_XFT +#include <X11/Xft/Xft.h> + +struct widget_xft_data +{ + Widget widget; + XftFont *xft_font; + XftDraw *xft_draw; + XftColor xft_fg, xft_bg; + int p_width, p_height; + Pixmap p; +}; + + +#endif + static void xaw_generic_callback (/*Widget, XtPointer, XtPointer*/); @@ -130,6 +146,207 @@ } #endif +#ifdef HAVE_XFT +static void +fill_xft_data (struct widget_xft_data *data, Widget widget, XftFont *font) +{ + data->widget = widget; + data->xft_font = font; + Pixel bg, fg; + XColor colors[2]; + int screen = XScreenNumberOfScreen (XtScreen (widget)); + + XtVaGetValues (widget, + XtNbackground, &bg, + XtNforeground, &fg, + NULL); + + colors[0].pixel = data->xft_fg.pixel = fg; + colors[1].pixel = data->xft_bg.pixel = bg; + XQueryColors (XtDisplay (widget), + DefaultColormapOfScreen (XtScreen (widget)), + colors, 2); + + data->xft_fg.color.alpha = 0xFFFF; + data->xft_fg.color.red = colors[0].red; + data->xft_fg.color.green = colors[0].green; + data->xft_fg.color.blue = colors[0].blue; + data->xft_bg.color.alpha = 0xFFFF; + data->xft_bg.color.red = colors[1].red; + data->xft_bg.color.green = colors[1].green; + data->xft_bg.color.blue = colors[1].blue; + + data->p = None; + data->xft_draw = 0; + data->p_width = data->p_height = 0; +} + +static XftFont* +openFont (Widget widget, char *name) +{ + char *fname = name; + int screen = XScreenNumberOfScreen (XtScreen (widget)); + int len = strlen (fname), i = len-1; + XftFont *fn; + + /* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */ + while (i > 0 && isdigit (fname[i])) + --i; + if (fname[i] == ' ') + { + fname = xstrdup (name); + fname[i] = '-'; + } + + fn = XftFontOpenName (XtDisplay (widget), screen, fname); + if (fname != name) free (fname); + + return fn; +} + +static int +get_text_width_and_height (Widget widget, char *text, + XftFont *xft_font, + int *height) +{ + int w = 0, h = 0; + char *bp = text; + + while (bp && *bp != '\0') + { + XGlyphInfo gi; + char *cp = strchr (bp, '\n'); + XftTextExtentsUtf8 (XtDisplay (widget), xft_font, + (FcChar8 *) bp, + cp ? cp - bp : strlen (bp), + &gi); + bp = cp ? cp + 1 : NULL; + h += xft_font->height; + if (w < gi.width) w = gi.width; + } + + *height = h; + return w; +} + +static void +draw_text (struct widget_xft_data *data, char *lbl, int inverse) +{ + Screen *sc = XtScreen (data->widget); + int screen = XScreenNumberOfScreen (sc); + int y = data->xft_font->ascent; + int x = inverse ? 0 : 2; + char *bp = lbl; + + data->xft_draw = XftDrawCreate (XtDisplay (data->widget), + data->p, + DefaultVisual (XtDisplay (data->widget), + screen), + DefaultColormapOfScreen (sc)); + XftDrawRect (data->xft_draw, + inverse ? &data->xft_fg : &data->xft_bg, + 0, 0, data->p_width, data->p_height); + + if (!inverse) y += 2; + while (bp && *bp != '\0') + { + char *cp = strchr (bp, '\n'); + XftDrawStringUtf8 (data->xft_draw, + inverse ? &data->xft_bg : &data->xft_fg, + data->xft_font, x, y, bp, cp ? cp - bp : strlen (bp)); + bp = cp ? cp + 1 : NULL; + /* 1.2 gives reasonable line spacing. */ + y += data->xft_font->height * 1.2; + } + +} + + +static void +set_text (struct widget_xft_data *data, Widget toplevel, char *lbl, int margin) +{ + int screen = XScreenNumberOfScreen (XtScreen (data->widget)); + int width, height; + + width = get_text_width_and_height (data->widget, lbl, data->xft_font, + &height); + data->p_width = width + margin; + data->p_height = height + margin; + + data->p = XCreatePixmap (XtDisplay (data->widget), + XtWindow (toplevel), + data->p_width, + data->p_height, + DefaultDepthOfScreen (XtScreen (data->widget))); + draw_text (data, lbl, 0); + XtVaSetValues (data->widget, XtNbitmap, data->p, NULL); +} + +static struct widget_xft_data * +find_xft_data (Widget widget) +{ + widget_instance *inst = NULL; + Widget parent = XtParent (widget); + struct widget_xft_data *data = NULL; + int nr; + while (parent && !inst) + { + inst = lw_get_widget_instance (parent); + parent = XtParent (parent); + } + if (!inst || !inst->xft_data || !inst->xft_data[0].xft_font) return; + + for (nr = 0; data == NULL && nr < inst->nr_xft_data; ++nr) + { + if (inst->xft_data[nr].widget == widget) + data = &inst->xft_data[nr]; + } + + return data; +} + +static void +command_press (Widget widget, + XEvent* event, + String *params, + Cardinal *num_params) +{ + struct widget_xft_data *data = find_xft_data (widget); + if (data) + { + char *lbl; + /* Since this isn't used for rectangle buttons, use it to for armed. */ + XtVaSetValues (widget, XtNcornerRoundPercent, 1, NULL); + + XtVaGetValues (widget, XtNlabel, &lbl, NULL); + draw_text (data, lbl, 1); + } +} + +static void +command_reset (Widget widget, + XEvent* event, + String *params, + Cardinal *num_params) +{ + struct widget_xft_data *data = find_xft_data (widget); + if (data) + { + Dimension cr; + XtVaGetValues (widget, XtNcornerRoundPercent, &cr, NULL); + if (cr == 1) + { + char *lbl; + XtVaSetValues (widget, XtNcornerRoundPercent, 0, NULL); + XtVaGetValues (widget, XtNlabel, &lbl, NULL); + draw_text (data, lbl, 0); + } + } +} + + +#endif + void #ifdef PROTOTYPES xaw_update_one_widget (widget_instance *instance, Widget widget, @@ -150,15 +367,21 @@ #endif if (XtIsSubclass (widget, dialogWidgetClass)) { - Arg al[1]; - int ac = 0; - XtSetArg (al[ac], XtNlabel, val->contents->value); ac++; - XtSetValues (widget, al, ac); + +#ifdef HAVE_XFT + if (instance->xft_data && instance->xft_data[0].xft_font) + { + set_text (&instance->xft_data[0], instance->parent, + val->contents->value, 10); + } +#endif + XtVaSetValues (widget, XtNlabel, val->contents->value, NULL); } else if (XtIsSubclass (widget, commandWidgetClass)) { Dimension bw = 0; - Arg al[3]; + Arg al[10]; + int ac = 0; XtVaGetValues (widget, XtNborderWidth, &bw, NULL); if (bw == 0) @@ -174,10 +397,30 @@ } XtSetSensitive (widget, val->enabled); - XtSetArg (al[0], XtNlabel, val->value); + XtSetArg (al[ac], XtNlabel, val->value);ac++; /* Force centered button text. Se above. */ - XtSetArg (al[1], XtNjustify, XtJustifyCenter); - XtSetValues (widget, al, 2); + XtSetArg (al[ac], XtNjustify, XtJustifyCenter);ac++; +#ifdef HAVE_XFT + if (instance->xft_data && instance->xft_data[0].xft_font) + { + int th; + int nr; + for (nr = 0; nr < instance->nr_xft_data; ++nr) + if (instance->xft_data[nr].widget == widget) + break; + if (nr < instance->nr_xft_data) + { + set_text (&instance->xft_data[nr], instance->parent, + val->value, 6); + + /* Must set internalHeight to twice the highlight thickness, + or else it gets overwritten by our pixmap. Probably a bug. */ + XtVaGetValues (widget, XtNhighlightThickness, &th, NULL); + XtSetArg (al[ac], XtNinternalHeight, 2*th);ac++; + } + } +#endif + XtSetValues (widget, al, ac); XtRemoveAllCallbacks (widget, XtNcallback); XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); } @@ -198,6 +441,28 @@ xaw_destroy_instance (instance) widget_instance *instance; { +#ifdef HAVE_XFT + if (instance->xft_data) + { + int i; + for (i = 0; i < instance->nr_xft_data; ++i) + { + if (instance->xft_data[i].xft_draw) + XftDrawDestroy (instance->xft_data[i].xft_draw); + if (instance->xft_data[i].p != None) + { + XtVaSetValues (instance->xft_data[i].widget, XtNbitmap, None, + NULL); + XFreePixmap (XtDisplay (instance->widget), + instance->xft_data[i].p); + } + } + if (instance->xft_data[0].xft_font) + XftFontClose (XtDisplay (instance->widget), + instance->xft_data[0].xft_font); + free (instance->xft_data); + } +#endif if (XtIsSubclass (instance->widget, dialogWidgetClass)) /* Need to destroy the Shell too. */ XtDestroyWidget (XtParent (instance->widget)); @@ -298,8 +563,21 @@ }; static Boolean actions_initted = False; +#ifdef HAVE_XFT +static XtActionsRec button_actions[] = + { + { "my_reset", command_reset }, + { "my_press", command_press }, + }; +char buttonTrans[] = + "<Leave>: reset() my_reset()\n" + "<Btn1Down>: set() my_press()\n" + "<Btn1Up>: my_reset() notify() unset()\n"; +#endif + static Widget -make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, radio_box, list, left_buttons, right_buttons) +make_dialog (name, parent, pop_up_p, shell_title, icon_name, text_input_slot, + radio_box, list, left_buttons, right_buttons, instance) char* name; Widget parent; Boolean pop_up_p; @@ -310,6 +588,7 @@ Boolean list; int left_buttons; int right_buttons; + widget_instance *instance; { Arg av [20]; int ac = 0; @@ -319,6 +598,10 @@ Widget dialog; Widget button; XtTranslations override; +#ifdef HAVE_XFT + XftFont *xft_font = 0; + XtTranslations button_override; +#endif if (! pop_up_p) abort (); /* not implemented */ if (text_input_slot) abort (); /* not implemented */ @@ -330,6 +613,10 @@ XtAppContext app = XtWidgetToApplicationContext (parent); XtAppAddActions (app, xaw_actions, sizeof (xaw_actions) / sizeof (xaw_actions[0])); +#ifdef HAVE_XFT + XtAppAddActions (app, button_actions, + sizeof (button_actions) / sizeof (button_actions[0])); +#endif actions_initted = True; } @@ -351,6 +638,49 @@ override = XtParseTranslationTable (dialogOverride); XtOverrideTranslations (dialog, override); +#ifdef HAVE_XFT + { + int num; + Widget *ch = NULL; + Widget w = 0; + XtVaGetValues (dialog, + XtNnumChildren, &num, + XtNchildren, &ch, NULL); + for (i = 0; i < num; ++i) + { + if (!XtIsSubclass (ch[i], commandWidgetClass) + && XtIsSubclass (ch[i], labelWidgetClass)) + { + w = ch[i]; + break; + } + } + instance->xft_data = 0; + instance->nr_xft_data = 0; + if (w) + { + XtResource rec[] = + { { "faceName", "FaceName", XtRString, sizeof(String), 0, XtRString, + (XtPointer)"Sans-14" }}; + char *faceName; + XtVaGetSubresources (dialog, &faceName, "Dialog", "dialog", + rec, 1, 0, NULL); + if (strcmp ("none", faceName) != 0) + xft_font = openFont (dialog, faceName); + if (xft_font) + { + instance->nr_xft_data = left_buttons + right_buttons + 1; + instance->xft_data = calloc (instance->nr_xft_data, + sizeof(*instance->xft_data)); + + fill_xft_data (&instance->xft_data[0], w, xft_font); + } + } + + button_override = XtParseTranslationTable (buttonTrans); + } +#endif + bc = 0; button = 0; for (i = 0; i < left_buttons; i++) @@ -362,51 +692,56 @@ XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; +#ifdef HAVE_XAW3D + if (DefaultDepthOfScreen (XtScreen (dialog)) >= 16) + { + /* Turn of dithered shadow if we can. Looks bad */ + XtSetArg (av [ac], "beNiceToColormap", False); ac++; + } +#endif sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); +#ifdef HAVE_XFT + if (xft_font) + { + fill_xft_data (&instance->xft_data[bc], button, xft_font); + XtOverrideTranslations (button, button_override); + } +#endif } - if (right_buttons) - { - /* Create a separator - I want the separator to take up the slack between the buttons on - the right and the buttons on the left (that is I want the buttons - after the separator to be packed against the right edge of the - window) but I can't seem to make it do it. - */ - ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; -/* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */ - XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; - XtSetArg (av [ac], XtNright, XtChainRight); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; - XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNlabel, ""); ac++; - XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */ - XtSetArg (av [ac], XtNborderWidth, 0); ac++; - XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++; - XtSetArg (av [ac], XtNresizable, False); ac++; - XtSetArg (av [ac], XtNsensitive, False); ac++; - button = XtCreateManagedWidget ("separator", - /* labelWidgetClass, */ - /* This has to be Command to fake out - the Dialog widget... */ - commandWidgetClass, - dialog, av, ac); - } for (i = 0; i < right_buttons; i++) { ac = 0; XtSetArg (av [ac], XtNfromHoriz, button); ac++; + if (i == 0) + { + /* Separator to the other buttons. */ + XtSetArg (av [ac], XtNhorizDistance, 30); ac++; + } XtSetArg (av [ac], XtNleft, XtChainRight); ac++; XtSetArg (av [ac], XtNright, XtChainRight); ac++; XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; XtSetArg (av [ac], XtNresizable, True); ac++; +#ifdef HAVE_XAW3D + if (DefaultDepthOfScreen (XtScreen (dialog)) >= 16) + { + /* Turn of dithered shadow if we can. Looks bad */ + XtSetArg (av [ac], "beNiceToColormap", False); ac++; + } +#endif sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); +#ifdef HAVE_XFT + if (xft_font) + { + fill_xft_data (&instance->xft_data[bc], button, xft_font); + XtOverrideTranslations (button, button_override); + } +#endif } return dialog; @@ -472,8 +807,7 @@ widget = make_dialog (name, parent, pop_up_p, shell_name, icon_name, text_input_slot, radio_box, - list, left_buttons, right_buttons); - + list, left_buttons, right_buttons, instance); return widget; }
--- a/lwlib/lwlib-int.h Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/lwlib-int.h Thu Apr 15 11:20:03 2010 +0200 @@ -28,11 +28,17 @@ extern char *safe_strdup __P ((const char *)); +struct widget_xft_data; + typedef struct _widget_instance { Widget widget; Widget parent; Boolean pop_up_p; +#ifdef HAVE_XFT + struct widget_xft_data *xft_data; + int nr_xft_data; +#endif struct _widget_info* info; struct _widget_instance* next; } widget_instance;
--- a/lwlib/xlwmenu.c Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/xlwmenu.c Thu Apr 15 11:20:03 2010 +0200 @@ -30,6 +30,7 @@ #include "lisp.h" #include <stdio.h> +#include <ctype.h> #include <sys/types.h> #if (defined __sun) && !(defined SUNOS41) @@ -69,7 +70,7 @@ static int pointer_grabbed; static XEvent menu_post_event; -XFontStruct *xlwmenu_default_font; +static XFontStruct *xlwmenu_default_font; static char xlwMenuTranslations [] = @@ -128,6 +129,13 @@ {XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), offset(menu.fontSet), XtRFontSet, NULL}, #endif +#ifdef HAVE_XFT +#define DEFAULT_FACENAME "Sans-10" + {XtNfaceName, XtCFaceName, XtRString, sizeof(String), + offset(menu.faceName), XtRString, DEFAULT_FACENAME}, + {XtNdefaultFace, XtCDefaultFace, XtRInt, sizeof(int), + offset(menu.default_face), XtRImmediate, (XtPointer)1}, +#endif {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(menu.font), XtRString, "XtDefaultFont"}, {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), @@ -352,10 +360,20 @@ { XCharStruct xcs; int drop; +#ifdef HAVE_XFT + if (mw->menu.xft_font) + { + XGlyphInfo gi; + XftTextExtentsUtf8 (XtDisplay (mw), mw->menu.xft_font, + (FcChar8 *) s, + strlen (s), &gi); + return gi.width; + } +#endif #ifdef HAVE_X_I18N - XRectangle ink, logical; if (mw->menu.fontSet) { + XRectangle ink, logical; XmbTextExtents (mw->menu.fontSet, s, strlen (s), &ink, &logical); return logical.width; } @@ -366,6 +384,20 @@ } +#ifdef HAVE_XFT +#define MENU_FONT_HEIGHT(mw) \ + ((mw)->menu.xft_font != NULL \ + ? (mw)->menu.xft_font->height \ + : ((mw)->menu.fontSet != NULL \ + ? (mw)->menu.font_extents->max_logical_extent.height \ + : (mw)->menu.font->ascent + (mw)->menu.font->descent)) +#define MENU_FONT_ASCENT(mw) \ + ((mw)->menu.xft_font != NULL \ + ? (mw)->menu.xft_font->ascent \ + : ((mw)->menu.fontSet != NULL \ + ? - (mw)->menu.font_extents->max_logical_extent.y \ + : (mw)->menu.font->ascent)) +#else #ifdef HAVE_X_I18N #define MENU_FONT_HEIGHT(mw) \ ((mw)->menu.fontSet != NULL \ @@ -380,6 +412,7 @@ ((mw)->menu.font->ascent + (mw)->menu.font->descent) #define MENU_FONT_ASCENT(mw) ((mw)->menu.font->ascent) #endif +#endif static int arrow_width (mw) @@ -559,6 +592,7 @@ ws->width += 2 * mw->menu.shadow_thickness; ws->height += 2 * mw->menu.shadow_thickness; + ws->max_rest_width = max_rest_width; if (horizontal_p) { @@ -987,6 +1021,9 @@ int width; enum menu_separator separator; int separator_p = lw_separator_p (val->name, &separator, 0); +#ifdef HAVE_XFT + XftColor *xftfg; +#endif /* compute the sizes of the item */ size_menu_item (mw, val, horizontal_p, &label_width, &rest_width, @@ -1024,6 +1061,9 @@ else text_gc = mw->menu.disabled_gc; deco_gc = mw->menu.foreground_gc; +#ifdef HAVE_XFT + xftfg = val->enabled ? &mw->menu.xft_fg : &mw->menu.xft_disabled_fg; +#endif if (separator_p) { @@ -1048,6 +1088,21 @@ x_offset += ws->button_width; +#ifdef HAVE_XFT + if (ws->xft_draw) + { + int draw_y = y + v_spacing + shadow; + XftDrawRect (ws->xft_draw, &mw->menu.xft_bg, + x_offset, draw_y, + ws->width, font_height); + XftDrawStringUtf8 (ws->xft_draw, xftfg, + mw->menu.xft_font, + x_offset, draw_y + font_ascent, + (unsigned char *) display_string, + strlen (display_string)); + } + else +#endif #ifdef HAVE_X_I18N if (mw->menu.fontSet) XmbDrawString (XtDisplay (mw), ws->window, mw->menu.fontSet, @@ -1082,6 +1137,21 @@ } else if (val->key) { +#ifdef HAVE_XFT + if (ws->xft_draw) + { + XGlyphInfo gi; + int draw_x = ws->width - ws->max_rest_width + + mw->menu.arrow_spacing; + int draw_y = y + v_spacing + shadow + font_ascent; + XftDrawStringUtf8 (ws->xft_draw, xftfg, + mw->menu.xft_font, + draw_x, draw_y, + (unsigned char *) val->key, + strlen (val->key)); + } + else +#endif #ifdef HAVE_X_I18N if (mw->menu.fontSet) XmbDrawString (XtDisplay (mw), ws->window, @@ -1242,6 +1312,9 @@ int mask; Window root = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw))); window_state* windows; +#ifdef HAVE_XFT + int screen = XScreenNumberOfScreen (mw->core.screen); +#endif if (mw->menu.windows_length >= n) return; @@ -1280,10 +1353,21 @@ windows [i].y = 0; windows [i].width = 1; windows [i].height = 1; + windows [i].max_rest_width = 0; windows [i].window = XCreateWindow (XtDisplay (mw), root, 0, 0, 1, 1, 0, 0, CopyFromParent, CopyFromParent, mask, &xswa); - } +#ifdef HAVE_XFT + if (mw->menu.xft_font) + mw->menu.windows [i].xft_draw + = XftDrawCreate (XtDisplay (mw), + windows [i].window, + DefaultVisual (XtDisplay (mw), screen), + mw->core.colormap); + else + mw->menu.windows [i].xft_draw = 0; +#endif + } } /* Value is non-zero if WINDOW is part of menu bar widget W. */ @@ -1758,6 +1842,44 @@ XtReleaseGC ((Widget) mw, mw->menu.shadow_bottom_gc); } +#ifdef HAVE_XFT +static int +openXftFont (mw) + XlwMenuWidget mw; +{ + char *fname = mw->menu.faceName; + + mw->menu.xft_font = 0; + mw->menu.default_face = fname && strcmp (fname, DEFAULT_FACENAME) == 0; + + if (fname && strcmp (fname, "none") != 0) + { + int screen = XScreenNumberOfScreen (mw->core.screen); + int len = strlen (fname), i = len-1; + /* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */ + while (i > 0 && isdigit (fname[i])) + --i; + if (fname[i] == ' ') + { + fname = xstrdup (mw->menu.faceName); + fname[i] = '-'; + } + + mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, fname); + if (!mw->menu.xft_font) + { + fprintf (stderr, "Can't find font '%s'\n", fname); + mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, + DEFAULT_FACENAME); + } + } + + if (fname != mw->menu.faceName) free (fname); + + return mw->menu.xft_font != 0; +} +#endif + static void XlwMenuInitialize (request, mw, args, num_args) Widget request; @@ -1779,7 +1901,7 @@ mw->menu.contents = tem; #endif -/* mw->menu.cursor = XCreateFontCursor (display, mw->menu.cursor_shape); */ + /* mw->menu.cursor = XCreateFontCursor (display, mw->menu.cursor_shape); */ mw->menu.cursor = mw->menu.cursor_shape; mw->menu.gray_pixmap @@ -1787,11 +1909,24 @@ gray_bitmap_width, gray_bitmap_height, (unsigned long)1, (unsigned long)0, 1); - /* I don't understand why this ends up 0 sometimes, - but it does. This kludge works around it. - Can anyone find a real fix? -- rms. */ - if (mw->menu.font == 0) - mw->menu.font = xlwmenu_default_font; +#ifdef HAVE_XFT + if (openXftFont (mw)) + ; + else +#endif + + if (!mw->menu.font) + { + if (!xlwmenu_default_font) + xlwmenu_default_font = XLoadQueryFont (display, "fixed"); + mw->menu.font = xlwmenu_default_font; + if (!mw->menu.font) + { + fprintf (stderr, "Menu font fixed not found, can't continue.\n"); + abort (); + } + } + #ifdef HAVE_X_I18N if (mw->menu.fontSet) mw->menu.font_extents = XExtentsOfFontSet (mw->menu.fontSet); @@ -1818,6 +1953,10 @@ mw->menu.windows [0].y = 0; mw->menu.windows [0].width = 0; mw->menu.windows [0].height = 0; + mw->menu.windows [0].max_rest_width = 0; +#ifdef HAVE_XFT + mw->menu.windows [0].xft_draw = 0; +#endif size_menu (mw, 0); mw->core.width = mw->menu.windows [0].width; @@ -1827,6 +1966,7 @@ static void XlwMenuClassInitialize () { + xlwmenu_default_font = 0; } static void @@ -1861,6 +2001,38 @@ mw->menu.windows [0].y = w->core.y; mw->menu.windows [0].width = w->core.width; mw->menu.windows [0].height = w->core.height; + +#ifdef HAVE_XFT + if (mw->menu.xft_font) + { + XColor colors[3]; + int screen = XScreenNumberOfScreen (mw->core.screen); + mw->menu.windows [0].xft_draw + = XftDrawCreate (XtDisplay (w), + mw->menu.windows [0].window, + DefaultVisual (XtDisplay (w), screen), + mw->core.colormap); + colors[0].pixel = mw->menu.xft_fg.pixel = mw->menu.foreground; + colors[1].pixel = mw->menu.xft_bg.pixel = mw->core.background_pixel; + colors[2].pixel = mw->menu.xft_disabled_fg.pixel + = mw->menu.disabled_foreground; + XQueryColors (XtDisplay (mw), mw->core.colormap, colors, 3); + mw->menu.xft_fg.color.alpha = 0xFFFF; + mw->menu.xft_fg.color.red = colors[0].red; + mw->menu.xft_fg.color.green = colors[0].green; + mw->menu.xft_fg.color.blue = colors[0].blue; + mw->menu.xft_bg.color.alpha = 0xFFFF; + mw->menu.xft_bg.color.red = colors[1].red; + mw->menu.xft_bg.color.green = colors[1].green; + mw->menu.xft_bg.color.blue = colors[1].blue; + mw->menu.xft_disabled_fg.color.alpha = 0xFFFF; + mw->menu.xft_disabled_fg.color.red = colors[2].red; + mw->menu.xft_disabled_fg.color.green = colors[2].green; + mw->menu.xft_disabled_fg.color.blue = colors[2].blue; + } + else + mw->menu.windows [0].xft_draw = 0; +#endif } /* Only the toplevel menubar/popup is a widget so it's the only one that @@ -1942,13 +2114,37 @@ client exits. Nice, eh? */ +#ifdef HAVE_XFT + if (mw->menu.windows [0].xft_draw) + XftDrawDestroy (mw->menu.windows [0].xft_draw); + if (mw->menu.xft_font) + XftFontClose (XtDisplay (mw), mw->menu.xft_font); +#endif + /* start from 1 because the one in slot 0 is w->core.window */ for (i = 1; i < mw->menu.windows_length; i++) - XDestroyWindow (XtDisplay (mw), mw->menu.windows [i].window); + { + XDestroyWindow (XtDisplay (mw), mw->menu.windows [i].window); +#ifdef HAVE_XFT + if (mw->menu.windows [i].xft_draw) + XftDrawDestroy (mw->menu.windows [i].xft_draw); +#endif + } + if (mw->menu.windows) XtFree ((char *) mw->menu.windows); } +static int +facename_changed (XlwMenuWidget newmw, + XlwMenuWidget oldmw) +{ + /* This will fore a new XftFont even if the same sting is set. + This is good, as rendering parameters may have changed and + we just want to do a redisplay. */ + return newmw->menu.faceName != oldmw->menu.faceName; +} + static Boolean XlwMenuSetValues (current, request, new) Widget current; @@ -1972,6 +2168,9 @@ if (newmw->core.background_pixel != oldmw->core.background_pixel || newmw->menu.foreground != oldmw->menu.foreground +#ifdef HAVE_XFT + || facename_changed (newmw, oldmw) +#endif #ifdef HAVE_X_I18N || newmw->menu.fontSet != oldmw->menu.fontSet || (newmw->menu.fontSet == NULL && newmw->menu.font != oldmw->menu.font) @@ -2004,6 +2203,29 @@ } } +#ifdef HAVE_XFT + if (facename_changed (newmw, oldmw)) + { + int i; + int screen = XScreenNumberOfScreen (newmw->core.screen); + if (newmw->menu.xft_font) + XftFontClose (XtDisplay (newmw), newmw->menu.xft_font); + openXftFont (newmw); + for (i = 0; i < newmw->menu.windows_length; i++) + { + if (newmw->menu.windows [i].xft_draw) + XftDrawDestroy (newmw->menu.windows [i].xft_draw); + newmw->menu.windows [i].xft_draw = 0; + } + if (newmw->menu.xft_font) + for (i = 0; i < newmw->menu.windows_length; i++) + newmw->menu.windows [i].xft_draw + = XftDrawCreate (XtDisplay (newmw), + newmw->menu.windows [i].window, + DefaultVisual (XtDisplay (newmw), screen), + newmw->core.colormap); + } +#endif #ifdef HAVE_X_I18N if (newmw->menu.fontSet != oldmw->menu.fontSet && newmw->menu.fontSet != NULL) {
--- a/lwlib/xlwmenu.h Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/xlwmenu.h Thu Apr 15 11:20:03 2010 +0200 @@ -58,6 +58,10 @@ #define XtCResizeToPreferred "ResizeToPreferred" #define XtNallowResize "allowResize" #define XtCAllowResize "AllowResize" +#define XtNfaceName "faceName" +#define XtCFaceName "FaceName" +#define XtNdefaultFace "defaultFace" +#define XtCDefaultFace "DefaultFace" /* Motif-compatible resource names */ #define XmNshadowThickness "shadowThickness"
--- a/lwlib/xlwmenuP.h Sat Apr 03 22:21:58 2010 +0200 +++ b/lwlib/xlwmenuP.h Thu Apr 15 11:20:03 2010 +0200 @@ -25,6 +25,9 @@ #include "xlwmenu.h" #include <X11/CoreP.h> +#ifdef HAVE_XFT +#include <X11/Xft/Xft.h> +#endif /* Elements in the stack arrays. */ typedef struct _window_state @@ -35,9 +38,13 @@ Dimension width; Dimension height; Dimension label_width; + int max_rest_width; /* Width of toggle buttons or radio buttons. */ Dimension button_width; +#ifdef HAVE_XFT + XftDraw* xft_draw; +#endif } window_state; @@ -49,6 +56,12 @@ XFontSet fontSet; XFontSetExtents *font_extents; #endif +#ifdef HAVE_XFT + String faceName; + int default_face; + XftFont* xft_font; + XftColor xft_fg, xft_bg, xft_disabled_fg; +#endif XFontStruct* font; Pixel foreground; Pixel disabled_foreground;
--- a/nt/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -source ^subdirs\.el$ - -# arch-tag: 01b87183-9d94-4b6b-93cb-fece25c4eec9
--- a/oldXMenu/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/oldXMenu/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,8 @@ +2010-04-11 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE) + (C_SWITCH_X_SITE): Define using autoconf. + 2010-03-10 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.2.
--- a/oldXMenu/Makefile.in Sat Apr 03 22:21:58 2010 +0200 +++ b/oldXMenu/Makefile.in Thu Apr 15 11:20:03 2010 +0200 @@ -46,6 +46,8 @@ srcdir=@srcdir@ VPATH=@srcdir@ C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ +C_SWITCH_SYSTEM=@c_switch_system@ +C_SWITCH_MACHINE=@c_switch_machine@ EXTRA=insque.o CC=@CC@
--- a/src/.arch-inventory Sat Apr 03 22:21:58 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -# Source files which don't match the usual naming conventions, mostly dot files -source ^\.(gdbinit|dbxinit)$ - -# Auto-generated files, which ignore -precious ^(config\.stamp|config\.h|epaths\.h|buildobj\.lst)$ -precious ^(TAGS-LISP)$ -precious ^(buildobj\.lst)$ - -backup ^(stamp-oldxmenu|prefix-args|temacs|emacs|emacs-[0-9.]*)$ -backup ^(bootstrap-emacs)$ - -# arch-tag: 277cc7ae-b3f5-44af-abf1-84c073164543
--- a/src/ChangeLog Sat Apr 03 22:21:58 2010 +0200 +++ b/src/ChangeLog Thu Apr 15 11:20:03 2010 +0200 @@ -1,3 +1,185 @@ +2010-04-14 Dan Nicolaescu <dann@ics.uci.edu> + + Reduce cpp use in Makefile.in. + * Makefile.in (DBUS_CFLAGS, DBUS_LIBS, GCONF_CFLAGS, GCONF_LIBS) + (LIBSOUND, CFLAGS_SOUND, RSVG_LIBS, RSVG_CFLAGS, INTERVALS_H) + (GETLOADAVG_LIBS, RUN_TEMACS): Move to the autoconf section. + (ORDINARY_LINK): Remove, defined in src/s/gnu.h. + (CRT0_COMPILE): Remove, inline it in the only user. + +2010-04-14 Juri Linkov <juri@jurta.org> + + * window.c (keys_of_window): Rebind `C-v' from `scroll-up' to + `scroll-up-command' and `M-v' from `scroll-down' to + `scroll-down-command'. + +2010-04-14 Juri Linkov <juri@jurta.org> + + * window.c (Vscroll_preserve_screen_position_commands): New variable + with the default value as the list of Qscroll_down and Qscroll_up. + (window_scroll_pixel_based, window_scroll_line_based): Search the + last command in the list Vscroll_preserve_screen_position_commands + instead of comparing with Qscroll_up and Qscroll_down. + +2010-04-13 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (xg_set_geometry): Set geometry for PPosition also. + (x_wm_set_size_hint): Dont set position flags, gtk_window_parse_geometry + does that. + + * xfns.c (Fx_create_frame, x_create_tip_frame): Set default border width + to zero. + +2010-04-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * term.c (init_tty): Move common text outside of #ifdef TERMINFO. + + Try to solve the problem of spurious EOF chars in long lines of text + sent to interactive subprocesses. + * sysdep.c (child_setup_tty): Do not enable ICANON any more. + (system_process_attributes): Remove unused var `ttotal'. + * process.c (send_process): Don't bother breaking long line with EOF + chars when talking to ttys any more. + (wait_reading_process_output): Output a warning when called in such + a way that it could block without being interruptible. + + Try to detect file modification within the same second. + * buffer.h (struct buffer): New field modtime_size. + * buffer.c (reset_buffer): Initialize it. + * fileio.c (Finsert_file_contents, Fwrite_region): Set it. + (Fverify_visited_file_modtime): Check it. + (Fclear_visited_file_modtime, Fset_visited_file_modtime): Clear it. + (Fset_visited_file_modtime): Set (or clear) it. + +2010-04-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * process.c (status_notify): Remove unused var `ro'. + +2010-04-12 Jan Djärv <jan.h.d@swipnet.se> + + * xfns.c (select_visual): Don't call error if XGetVisualInfo returns + more than one visual (Bug#5938). + +2010-04-12 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (C_SWITCH_SYSTEM,C_SWITCH_MACHINE,C_SWITCH_X_SITE): Undefine. + +2010-04-11 Dan Nicolaescu <dann@ics.uci.edu> + + Remove C_SWITCH_SYSTEM_TEMACS. + * s/darwin.h (C_SWITCH_SYSTEM_TEMACS): Remove. + (malloc, realloc, free): Use emacs, not temacs for conditional + definition. + + * Makefile.in (C_SWITCH_SYSTEM_TEMACS): Remove. + (ALL_CFLAGS): Do not use C_SWITCH_SYSTEM_TEMACS. + + Use autoconf, not cpp for some variables. + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE) + (C_SWITCH_X_SITE): Define using autoconf, not cpp. + (ALL_CFLAGS): Use them as make variables. + (really-lwlib, really-oldXMenu): Do not pass them. + +2010-04-11 Jan Djärv <jan.h.d@swipnet.se> + + * xmenu.c (apply_systemfont_to_dialog): New. + (create_and_show_dialog): Call apply_systemfont_to_dialog if HAVE_XFT. + +2010-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * process.c (exec_sentinel): Preserve current-buffer. + + * process.c (read_process_output): Move the save-current-buffer to + apply to both the filter and the non-filter branches. + +2010-04-10 Dan Nicolaescu <dann@ics.uci.edu> + + * s/msdos.h (UNEXEC): New definition. + +2010-04-10 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * dispextern.h (TRY_WINDOW_CHECK_MARGINS) + (TRY_WINDOW_IGNORE_FONTS_CHANGE): New defines. + + * xdisp.c (try_window): Change arg from CHECK_MARGINS to FLAGS. + Don't abort with fonts change if TRY_WINDOW_IGNORE_FONTS_CHANGE is + set in FLAGS. Callers with non-zero CHECK_MARGINS changed to use + TRY_WINDOW_CHECK_MARGINS. + + * xfns.c (Fx_show_tip): Undo last change. Call try_window with + TRY_WINDOW_IGNORE_FONTS_CHANGE (Bug#2423). Subtract last glyph's + width only when it is for padding. + +2010-04-09 Jan Djärv <jan.h.d@swipnet.se> + + * xfns.c (Fx_show_tip): Call try_window in a loop until + fonts_changed_p is zero (Bug#2423). + +2010-04-08 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (set_cursor_from_row): Don't dereference glyphs beyond + the end of TEXT_AREA. (Bug#5856) + +2010-04-08 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c (XSETTINGS_FONT_NAME): Move XSETTINGS_FONT_NAME out of + HAVE_GCONF. + +2010-04-08 Eli Zaretskii <eliz@gnu.org> + + * bidi.c (bidi_resolve_weak): Use prev.type_after_w1, instead of + prev.orig_type, for resolving type of NSM. (Bug#5858) + +2010-04-08 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c (current_font, SYSTEM_FONT, XSETTINGS_FONT_NAME): New. + (parse_xft_settings): Also check for XSETTINGS_FONT_NAME and save that + in current_font. + (init_gconf): Read value of SYSTEM_FONT and save it in current_font. + (Ffont_get_system_normal_font, xsettings_get_system_normal_font): New + functions. + (syms_of_xsettings): Initialize current_font. defsubr + Sfont_get_system_normal_font. + + * xsettings.h (Ffont_get_system_normal_font, + xsettings_get_system_normal_font): Declare. + + * xfns.c (extern xlwmenu_default_font): Remove. + (Fx_create_frame): Remove setting of xlwmenu_default_font, moved + to xlwmenu.c. + + * menu.c (digest_single_submenu): If USE_LUCID and HAVE_XFT, encode + menu items in UTF-8. + + * xmenu.c: include xsettings.h and xlwmenu.h if USE_LUCID. + (apply_systemfont_to_menu): New function. + (set_frame_menubar, create_and_show_popup_menu): Call + apply_systemfont_to_menu. + +2010-04-07 Jan Djärv <jan.h.d@swipnet.se> + + * frame.h (FRAME_TEXT_LINES_TO_PIXEL_HEIGHT): Don't use + FRAME_LINE_TO_PIXEL_Y. + + * xterm.c (x_set_window_size_1): Don't add border_width/height to + pixelwidth/height. + +2010-04-07 Dan Nicolaescu <dann@ics.uci.edu> + + Simplify code for HP machines. + * m/hp800.h (LOAD_AVE_TYPE, LOAD_AVE_CVT, NO_REMAP): Do not define + for GNU_LINUX, not needed. + (UNEXEC, NEED_BSDTTY): Move definitions... + * s/hpux10-20.h (UNEXEC, NEED_BSDTTY): ... here. + + * m/iris4d.h (UNEXEC): Move definition ... + * s/irix6-5.h (UNEXEC): ... here. + +2010-04-04 Jan Djärv <jan.h.d@swipnet.se> + + * xfns.c (set_machine_and_pid_properties): New function. + (Fx_create_frame): Call set_machine_and_pid_properties. + 2010-04-03 Eli Zaretskii <eliz@gnu.org> * bidi.c (bidi_resolve_explicit, bidi_level_of_next_char): Check
--- a/src/Makefile.in Sat Apr 03 22:21:58 2010 +0200 +++ b/src/Makefile.in Thu Apr 15 11:20:03 2010 +0200 @@ -76,11 +76,32 @@ LIBXPM=@LIBXPM@ XFT_LIBS=@XFT_LIBS@ +C_SWITCH_SYSTEM=@c_switch_system@ +C_SWITCH_MACHINE=@c_switch_machine@ + +C_SWITCH_X_SITE=@C_SWITCH_X_SITE@ + +DBUS_CFLAGS = @DBUS_CFLAGS@ +DBUS_LIBS = @DBUS_LIBS@ + +GCONF_CFLAGS = @GCONF_CFLAGS@ +GCONF_LIBS = @GCONF_LIBS@ + +LIBSOUND= @LIBSOUND@ +CFLAGS_SOUND= @CFLAGS_SOUND@ + +RSVG_LIBS= @RSVG_LIBS@ +RSVG_CFLAGS= @RSVG_CFLAGS@ + +INTERVALS_H = dispextern.h intervals.h composite.h + +GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ + +RUN_TEMACS = `/bin/pwd`/temacs + # ========================== start of cpp stuff ======================= /* From here on, comments must be done in C syntax. */ -C_SWITCH_SYSTEM= - /* just to be sure the sh is used */ SHELL=/bin/sh @@ -92,6 +113,11 @@ DEPFLAGS = -MMD -MF deps/$*.d #endif +/* Undefine until the user can be moved in the non-cpp section. */ +#undef C_SWITCH_SYSTEM +#undef C_SWITCH_MACHINE +#undef C_SWITCH_X_SITE + /* Do not let the file name mktime.c get messed up. */ #ifdef mktime #undef mktime @@ -110,14 +136,6 @@ do not let it interfere with this file. */ #undef register -/* GNU libc requires ORDINARY_LINK so that its own crt0 is used. - GNU/Linux is an exception because it uses a funny variant of GNU libc. */ -#ifdef __GNU_LIBRARY__ -#ifndef GNU_LINUX -#define ORDINARY_LINK -#endif -#endif - /* Some machines do not find the standard C libraries in the usual place. */ #ifndef ORDINARY_LINK #ifndef LIB_STANDARD @@ -164,12 +182,6 @@ #define LD_SWITCH_SYSTEM_TEMACS #endif -/* Some s/SYSTEM.h files define this to request special switches - for compiling temacs. */ -#ifndef C_SWITCH_SYSTEM_TEMACS -#define C_SWITCH_SYSTEM_TEMACS -#endif - /* Some m/MACHINE.h files define this to request special switches in ld. */ #ifndef LD_SWITCH_MACHINE #define LD_SWITCH_MACHINE @@ -181,16 +193,6 @@ #define LD_SWITCH_MACHINE_TEMACS #endif -/* Some m/MACHINE.h files define this to request special switches in cc. */ -#ifndef C_SWITCH_MACHINE -#define C_SWITCH_MACHINE -#endif - -/* Some s/SYSTEM.h files define this to request special switches in cc. */ -#ifndef C_SWITCH_SYSTEM -#define C_SWITCH_SYSTEM -#endif - /* These macros are for switches specifically related to X Windows. */ #ifndef C_SWITCH_X_MACHINE #define C_SWITCH_X_MACHINE @@ -200,10 +202,6 @@ #define C_SWITCH_X_SYSTEM #endif -#ifndef C_SWITCH_X_SITE -#define C_SWITCH_X_SITE -#endif - #ifndef LD_SWITCH_X_SITE #define LD_SWITCH_X_SITE #endif @@ -214,10 +212,6 @@ #ifndef ORDINARY_LINK -#ifndef CRT0_COMPILE -#define CRT0_COMPILE $(CC) -c $(ALL_CFLAGS) -#endif - #ifndef START_FILES #ifdef NO_REMAP #define START_FILES pre-crt0.o /lib/crt0.o @@ -247,16 +241,9 @@ #endif #ifdef HAVE_DBUS -DBUS_CFLAGS = @DBUS_CFLAGS@ -DBUS_LIBS = @DBUS_LIBS@ DBUS_OBJ = dbusbind.o #endif -#ifdef HAVE_GCONF -GCONF_CFLAGS = @GCONF_CFLAGS@ -GCONF_LIBS = @GCONF_LIBS@ -#endif - /* DO NOT use -R. There is a special hack described in lastfile.c which is used instead. Some initialized data areas are modified at initial startup, then labeled as part of the text area when @@ -268,11 +255,13 @@ -DHAVE_CONFIG_H is needed for some other files to take advantage of the information in ``config.h''. */ +#undef C_SWITCH_MACHINE +#undef C_SWITCH_SYSTEM +#undef C_SWITCH_X_SITE + /* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM since it may have -I options that should override those two. */ - -ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} ${GCONF_CFLAGS} ${CFLAGS} @FREETYPE_CFLAGS@ @FONTCONFIG_CFLAGS@ @LIBOTF_CFLAGS@ @M17N_FLT_CFLAGS@ ${DEPFLAGS} - +ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} ${GCONF_CFLAGS} ${CFLAGS} @FREETYPE_CFLAGS@ @FONTCONFIG_CFLAGS@ @LIBOTF_CFLAGS@ @M17N_FLT_CFLAGS@ ${DEPFLAGS} ALL_OBJC_CFLAGS=$(ALL_CFLAGS) @GNU_OBJC_CFLAGS@ .SUFFIXES: .m @@ -459,15 +448,6 @@ #define YMF_PASS_LDFLAGS(flags) flags #endif -/* Allow config.h to specify a replacement file for unexec.c. */ -#ifndef UNEXEC -#define UNEXEC unexec.o -#endif - -INTERVALS_H = dispextern.h intervals.h composite.h - -GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ - #ifdef MSDOS #ifdef HAVE_X_WINDOWS MSDOS_OBJ = dosfns.o msdos.o xmenu.o @@ -858,8 +838,6 @@ @FREETYPE_LIBS@ @FONTCONFIG_LIBS@ @LIBOTF_LIBS@ @M17N_FLT_LIBS@ \ $(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR) -RUN_TEMACS = `/bin/pwd`/temacs - all: emacs${EXEEXT} $(OTHER_FILES) emacs${EXEEXT}: temacs${EXEEXT} ${etc}DOC ${lisp} @@ -930,9 +908,6 @@ /* Encode the values of these two macros in Make variables, so we can use $(...) to substitute their values within "...". */ -C_SWITCH_MACHINE_1 = C_SWITCH_MACHINE -C_SWITCH_SYSTEM_1 = C_SWITCH_SYSTEM -C_SWITCH_X_SITE_1 = C_SWITCH_X_SITE C_SWITCH_X_MACHINE_1 = C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM_1 = C_SWITCH_X_SYSTEM @@ -942,11 +917,8 @@ really-lwlib: cd ${lwlibdir}; ${MAKE} ${MFLAGS} \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \ - "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \ "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \ - "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \ - "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \ - "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)" + "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" @true /* make -t should not create really-lwlib. */ .PHONY: really-lwlib #else /* not USE_X_TOOLKIT */ @@ -955,11 +927,8 @@ really-oldXMenu: cd ${oldXMenudir}; ${MAKE} ${MFLAGS} \ CC='${CC}' CFLAGS='${CFLAGS}' MAKE='${MAKE}' \ - "C_SWITCH_X_SITE=$(C_SWITCH_X_SITE_1)" \ "C_SWITCH_X_MACHINE=$(C_SWITCH_X_MACHINE_1)" \ - "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" \ - "C_SWITCH_MACHINE=$(C_SWITCH_MACHINE_1)" \ - "C_SWITCH_SYSTEM=$(C_SWITCH_SYSTEM_1)" + "C_SWITCH_X_SYSTEM=$(C_SWITCH_X_SYSTEM_1)" @true /* make -t should not create really-oldXMenu. */ .PHONY: really-oldXMenu #endif /* not USE_X_TOOLKIT */ @@ -984,7 +953,7 @@ #ifdef AUTO_DEPEND @-test -d deps || mkdir deps #endif - CRT0_COMPILE ${srcdir}/ecrt0.c + $(CC) -c $(ALL_CFLAGS) ${srcdir}/ecrt0.c doc.o: buildobj.h #ifndef AUTO_DEPEND
--- a/src/bidi.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/bidi.c Thu Apr 15 11:20:03 2010 +0200 @@ -1347,12 +1347,14 @@ if (type == WEAK_NSM) /* W1 */ { /* Note that we don't need to consider the case where the - prev character has its type overridden by an RLO or LRO: - such characters are outside the current level run, and - thus not relevant to this NSM. Thus, NSM gets the - orig_type of the previous character. */ + prev character has its type overridden by an RLO or LRO, + because then either the type of this NSM would have been + also overridden, or the previous character is outside the + current level run, and thus not relevant to this NSM. + This is why NSM gets the type_after_w1 of the previous + character. */ if (bidi_it->prev.type != UNKNOWN_BT) - type = bidi_it->prev.orig_type; + type = bidi_it->prev.type_after_w1; else if (bidi_it->sor == R2L) type = STRONG_R; else if (bidi_it->sor == L2R)
--- a/src/buffer.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/buffer.c Thu Apr 15 11:20:03 2010 +0200 @@ -693,6 +693,7 @@ b->file_truename = Qnil; b->directory = (current_buffer) ? current_buffer->directory : Qnil; b->modtime = 0; + b->modtime_size = -1; XSETFASTINT (b->save_length, 0); b->last_window_start = 1; /* It is more conservative to start out "changed" than "unchanged". */
--- a/src/buffer.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/buffer.h Thu Apr 15 11:20:03 2010 +0200 @@ -513,6 +513,12 @@ 0 means visited file modtime unknown; in no case complain about any mismatch on next save attempt. */ int modtime; + /* Size of the file when modtime was set. This is used to detect the + case where the file grew while we were reading it, so the modtime + is still the same (since it's rounded up to seconds) but we're actually + not up-to-date. -1 means the size is unknown. Only meaningful if + modtime is actually set. */ + EMACS_INT modtime_size; /* The value of text->modiff at the last auto-save. */ int auto_save_modified; /* The value of text->modiff at the last display error.
--- a/src/dispextern.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/dispextern.h Thu Apr 15 11:20:03 2010 +0200 @@ -2974,6 +2974,10 @@ XRectangle *)); #endif +/* Flags passed to try_window. */ +#define TRY_WINDOW_CHECK_MARGINS (1 << 0) +#define TRY_WINDOW_IGNORE_FONTS_CHANGE (1 << 1) + /* Defined in fringe.c */ int lookup_fringe_bitmap (Lisp_Object);
--- a/src/fileio.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/fileio.c Thu Apr 15 11:20:03 2010 +0200 @@ -4092,6 +4092,7 @@ if (NILP (handler)) { current_buffer->modtime = st.st_mtime; + current_buffer->modtime_size = st.st_size; current_buffer->filename = orig_filename; } @@ -4695,7 +4696,10 @@ to avoid a "file has changed on disk" warning on next attempt to save. */ if (visiting) - current_buffer->modtime = st.st_mtime; + { + current_buffer->modtime = st.st_mtime; + current_buffer->modtime_size = st.st_size; + } if (failure) error ("IO error writing %s: %s", SDATA (filename), @@ -5004,11 +5008,13 @@ else st.st_mtime = 0; } - if (st.st_mtime == b->modtime - /* If both are positive, accept them if they are off by one second. */ - || (st.st_mtime > 0 && b->modtime > 0 - && (st.st_mtime == b->modtime + 1 - || st.st_mtime == b->modtime - 1))) + if ((st.st_mtime == b->modtime + /* If both are positive, accept them if they are off by one second. */ + || (st.st_mtime > 0 && b->modtime > 0 + && (st.st_mtime == b->modtime + 1 + || st.st_mtime == b->modtime - 1))) + && (st.st_size == b->modtime_size + || b->modtime_size < 0)) return Qt; return Qnil; } @@ -5020,6 +5026,7 @@ () { current_buffer->modtime = 0; + current_buffer->modtime_size = -1; return Qnil; } @@ -5049,7 +5056,10 @@ Lisp_Object time_list; { if (!NILP (time_list)) - current_buffer->modtime = cons_to_long (time_list); + { + current_buffer->modtime = cons_to_long (time_list); + current_buffer->modtime_size = -1; + } else { register Lisp_Object filename; @@ -5068,7 +5078,10 @@ filename = ENCODE_FILE (filename); if (stat (SDATA (filename), &st) >= 0) - current_buffer->modtime = st.st_mtime; + { + current_buffer->modtime = st.st_mtime; + current_buffer->modtime_size = st.st_size; + } } return Qnil;
--- a/src/frame.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/frame.h Thu Apr 15 11:20:03 2010 +0200 @@ -997,8 +997,8 @@ + FRAME_INTERNAL_BORDER_WIDTH (f)) #define FRAME_TEXT_LINES_TO_PIXEL_HEIGHT(f, lines) \ - (FRAME_LINE_TO_PIXEL_Y (f, lines) \ - + FRAME_INTERNAL_BORDER_WIDTH (f)) + ((lines) * FRAME_LINE_HEIGHT (f) \ + + 2 * FRAME_INTERNAL_BORDER_WIDTH (f)) /* Return the row/column (zero-based) of the character cell containing
--- a/src/gtkutil.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/gtkutil.c Thu Apr 15 11:20:03 2010 +0200 @@ -529,7 +529,7 @@ xg_set_geometry (f) FRAME_PTR f; { - if (f->size_hint_flags & USPosition) + if (f->size_hint_flags & (USPosition | PPosition)) { int left = f->left_pos; int xneg = f->size_hint_flags & XNegative; @@ -542,9 +542,7 @@ if (yneg) top = -top; - sprintf (geom_str, "=%dx%d%c%d%c%d", - FRAME_PIXEL_WIDTH (f), - FRAME_TOTAL_PIXEL_HEIGHT (f), + sprintf (geom_str, "%c%d%c%d", (xneg ? '-' : '+'), left, (yneg ? '-' : '+'), top); @@ -552,9 +550,6 @@ geom_str)) fprintf (stderr, "Failed to parse: '%s'\n", geom_str); } - else if (f->size_hint_flags & PPosition) - gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - f->left_pos, f->top_pos); } /* Clear under internal border if any. As we use a mix of Gtk+ and X calls @@ -956,16 +951,6 @@ else if (win_gravity == StaticGravity) size_hints.win_gravity = GDK_GRAVITY_STATIC; - if (flags & PPosition) hint_flags |= GDK_HINT_POS; - if (flags & USPosition) hint_flags |= GDK_HINT_USER_POS; - if (flags & USSize) hint_flags |= GDK_HINT_USER_SIZE; - - if (user_position) - { - hint_flags &= ~GDK_HINT_POS; - hint_flags |= GDK_HINT_USER_POS; - } - if (hint_flags != f->output_data.x->hint_flags || memcmp (&size_hints, &f->output_data.x->size_hints,
--- a/src/m/hp800.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/m/hp800.h Thu Apr 15 11:20:03 2010 +0200 @@ -41,9 +41,9 @@ #define EXPLICIT_SIGN_EXTEND -/* Common definitions for HPUX and GNU/Linux. */ +/* Stuff for just HPUX. */ -#if defined (__hpux) || defined (GNU_LINUX) +#if defined (__hpux) /* Define NO_REMAP if memory segmentation makes it not work well to change the boundary between the text section and data section @@ -52,26 +52,6 @@ #define NO_REMAP -#endif /* __hpux or GNU_LINUX */ - -/* Stuff for just GNU/Linux. */ - -#ifdef GNU_LINUX - -/* Data type of load average, as read out of kmem. */ - -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ - -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - -#endif /* GNU_LINUX */ - -/* Stuff for just HPUX. */ - -#ifdef __hpux - /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. @@ -88,14 +68,6 @@ #define DATA_START 0x40000000 #define TEXT_START 0x00000000 -/* This machine requires completely different unexec code - which lives in a separate file. Specify the file name. */ - -#define UNEXEC unexhp9k800.o - -/* Include the file bsdtty.h, since this machine has job control. */ -#define NEED_BSDTTY - /* Data type of load average, as read out of kmem. */ #define LOAD_AVE_TYPE double
--- a/src/m/iris4d.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/m/iris4d.h Thu Apr 15 11:20:03 2010 +0200 @@ -36,12 +36,6 @@ #define EXPLICIT_SIGN_EXTEND -/* This machine requires completely different unexec code - which lives in a separate file. Specify the file name. */ - -#undef UNEXEC -#define UNEXEC unexelf.o - #define TEXT_START 0x400000 /*
--- a/src/menu.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/menu.c Thu Apr 15 11:20:03 2010 +0200 @@ -697,6 +697,12 @@ ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); } +#elif defined (USE_LUCID) && defined (HAVE_XFT) + if (STRINGP (pane_name)) + { + pane_name = ENCODE_UTF_8 (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } #elif !defined (HAVE_MULTILINGUAL_MENU) if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) { @@ -770,6 +776,18 @@ descrip = ENCODE_SYSTEM (descrip); ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); } +#elif USE_LUCID + if (STRINGP (item_name)) + { + item_name = ENCODE_UTF_8 (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip)) + { + descrip = ENCODE_UTF_8 (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } #elif !defined (HAVE_MULTILINGUAL_MENU) if (STRING_MULTIBYTE (item_name)) {
--- a/src/process.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/process.c Thu Apr 15 11:20:03 2010 +0200 @@ -4643,6 +4643,10 @@ FD_ZERO (&Connecting); #endif + if (time_limit == 0 && wait_proc && !NILP (Vinhibit_quit) + && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit))) + message ("Blocking call to accept-process-output with quit inhibited!!"); + /* If wait_proc is a process to watch, set wait_channel accordingly. */ if (wait_proc != NULL) wait_channel = wait_proc->infd; @@ -5314,6 +5318,8 @@ struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; int readmax = 4096; + int count = SPECPDL_INDEX (); + Lisp_Object odeactivate; chars = (char *) alloca (carryover + readmax); if (carryover) @@ -5386,15 +5392,16 @@ /* Now set NBYTES how many bytes we must decode. */ nbytes += carryover; + odeactivate = Vdeactivate_mark; + /* There's no good reason to let process filters change the current + buffer, and many callers of accept-process-output, sit-for, and + friends don't expect current-buffer to be changed from under them. */ + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + /* Read and dispose of the process output. */ outstream = p->filter; if (!NILP (outstream)) { - /* We inhibit quit here instead of just catching it so that - hitting ^G when a filter happens to be running won't screw - it up. */ - int count = SPECPDL_INDEX (); - Lisp_Object odeactivate; Lisp_Object obuffer, okeymap; Lisp_Object text; int outer_running_asynch_code = running_asynch_code; @@ -5402,10 +5409,12 @@ /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ - odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); okeymap = current_buffer->keymap; + /* We inhibit quit here instead of just catching it so that + hitting ^G when a filter happens to be running won't screw + it up. */ specbind (Qinhibit_quit, Qt); specbind (Qlast_nonmenu_event, Qt); @@ -5474,9 +5483,6 @@ restore_search_regs (); running_asynch_code = outer_running_asynch_code; - /* Handling the process output should not deactivate the mark. */ - Vdeactivate_mark = odeactivate; - /* Restore waiting_for_user_input_p as it was when we were called, in case the filter clobbered it. */ waiting_for_user_input_p = waiting; @@ -5492,27 +5498,19 @@ cause trouble (for example it would make sit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); - - unbind_to (count, Qnil); - return nbytes; } /* If no filter, write into buffer if it isn't dead. */ - if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) + else if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) { Lisp_Object old_read_only; int old_begv, old_zv; int old_begv_byte, old_zv_byte; - Lisp_Object odeactivate; int before, before_byte; int opoint_byte; Lisp_Object text; struct buffer *b; - int count = SPECPDL_INDEX (); - - odeactivate = Vdeactivate_mark; - - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + Fset_buffer (p->buffer); opoint = PT; opoint_byte = PT_BYTE; @@ -5610,13 +5608,14 @@ if (old_begv != BEGV || old_zv != ZV) Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - /* Handling the process output should not deactivate the mark. */ - Vdeactivate_mark = odeactivate; current_buffer->read_only = old_read_only; SET_PT_BOTH (opoint, opoint_byte); - unbind_to (count, Qnil); } + /* Handling the process output should not deactivate the mark. */ + Vdeactivate_mark = odeactivate; + + unbind_to (count, Qnil); return nbytes; } @@ -5773,34 +5772,6 @@ { int this = len; - /* Decide how much data we can send in one batch. - Long lines need to be split into multiple batches. */ - if (p->pty_flag) - { - /* Starting this at zero is always correct when not the first - iteration because the previous iteration ended by sending C-d. - It may not be correct for the first iteration - if a partial line was sent in a separate send_process call. - If that proves worth handling, we need to save linepos - in the process object. */ - int linepos = 0; - unsigned char *ptr = (unsigned char *) buf; - unsigned char *end = (unsigned char *) buf + len; - - /* Scan through this text for a line that is too long. */ - while (ptr != end && linepos < pty_max_bytes) - { - if (*ptr == '\n') - linepos = 0; - else - linepos++; - ptr++; - } - /* If we found one, break the line there - and put in a C-d to force the buffer through. */ - this = ptr - buf; - } - /* Send this batch, using one or more write calls. */ while (this > 0) { @@ -5904,11 +5875,6 @@ len -= rv; this -= rv; } - - /* If we sent just part of the string, put in an EOF (C-d) - to force it through, before we send the rest. */ - if (len > 0) - Fprocess_send_eof (proc); } } else @@ -6845,6 +6811,11 @@ XSETBUFFER (obuffer, current_buffer); okeymap = current_buffer->keymap; + /* There's no good reason to let sentinels change the current + buffer, and many callers of accept-process-output, sit-for, and + friends don't expect current-buffer to be changed from under them. */ + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + sentinel = p->sentinel; if (NILP (sentinel)) return; @@ -6982,13 +6953,11 @@ when a process becomes runnable. */ else if (!EQ (symbol, Qrun) && !NILP (buffer)) { - Lisp_Object ro, tem; + Lisp_Object tem; struct buffer *old = current_buffer; int opoint, opoint_byte; int before, before_byte; - ro = XBUFFER (buffer)->read_only; - /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ if (NILP (XBUFFER (buffer)->name))
--- a/src/s/darwin.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/s/darwin.h Thu Apr 15 11:20:03 2010 +0200 @@ -165,9 +165,7 @@ each); under Cocoa 31 commands are required. */ #define LD_SWITCH_SYSTEM_TEMACS -prebind LIBS_NSGUI -Xlinker -headerpad -Xlinker HEADERPAD_EXTRA -#define C_SWITCH_SYSTEM_TEMACS -Dtemacs - -#ifdef temacs +#ifdef emacs #define malloc unexec_malloc #define realloc unexec_realloc #define free unexec_free
--- a/src/s/hpux10-20.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/s/hpux10-20.h Thu Apr 15 11:20:03 2010 +0200 @@ -89,6 +89,11 @@ #define HAVE_PERROR /* Delete this line for version 6. */ +#define UNEXEC unexhp9k800.o + +/* Include the file bsdtty.h, since this machine has job control. */ +#define NEED_BSDTTY + /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/pty/tty%c%x", c, i);
--- a/src/s/irix6-5.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/s/irix6-5.h Thu Apr 15 11:20:03 2010 +0200 @@ -82,6 +82,8 @@ /* Tell process_send_signal to use VSUSP instead of VSWTCH. */ #define PREFER_VSUSP +#define UNEXEC unexelf.o + /* define MAIL_USE_FLOCK if the mailer uses flock to interlock access to /usr/spool/mail/$USER. The alternative is that a lock file named
--- a/src/s/msdos.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/s/msdos.h Thu Apr 15 11:20:03 2010 +0200 @@ -172,5 +172,7 @@ #define NO_REMAP +#define UNEXEC unexec.o + /* arch-tag: d184f860-815d-4ff4-8187-d05c0f3c37d0 (do not change this comment) */
--- a/src/sysdep.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/sysdep.c Thu Apr 15 11:20:03 2010 +0200 @@ -529,8 +529,6 @@ #endif s.main.c_oflag &= ~TAB3; /* Disable tab expansion */ s.main.c_cflag = (s.main.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */ - s.main.c_lflag |= ICANON; /* Enable erase/kill and eof processing */ - s.main.c_cc[VEOF] = 04; /* insure that EOF is Control-D */ s.main.c_cc[VERASE] = CDISABLE; /* disable erase processing */ s.main.c_cc[VKILL] = CDISABLE; /* disable kill processing */ @@ -560,7 +558,6 @@ /* rms: Formerly it set s.main.c_cc[VINTR] to 0377 here unconditionally. Then a SIGNALS_VIA_CHARACTERS conditional would force it to 0377. That looks like duplicated code. */ - s.main.c_cc[VEOL] = CDISABLE; s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */ #endif /* AIX */ @@ -573,6 +570,18 @@ s.main.sg_kill = 0377; s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */ + /* We used to enable ICANON (and set VEOF to 04), but this leads to + problems where process.c wants to send EOFs every once in a while + to force the output, which leads to weird effects when the + subprocess has disabled ICANON and ends up seeing those spurious + extra EOFs. So we don't send EOFs any more in + process.c:send_process, and instead we disable ICANON by default, + so if a subsprocess sets up ICANON, it's his problem (or the Elisp + package that talks to it) to deal with lines that are too long. */ + s.main.c_lflag &= ~ICANON; /* Disable line editing and eof processing */ + s.main.c_cc[VMIN] = 1; + s.main.c_cc[VTIME] = 0; + #endif /* not HAVE_TERMIO */ EMACS_SET_TTY (out, &s, 0); @@ -3344,7 +3353,7 @@ unsigned long minflt, majflt, cminflt, cmajflt, vsize; time_t sec; unsigned usec; - EMACS_TIME tnow, tstart, tboot, telapsed,ttotal; + EMACS_TIME tnow, tstart, tboot, telapsed; double pcpu, pmem; Lisp_Object attrs = Qnil; Lisp_Object cmd_str, decoded_cmd, tem;
--- a/src/term.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/term.c Thu Apr 15 11:20:03 2010 +0200 @@ -3593,25 +3593,18 @@ } if (status == 0) { -#ifdef TERMINFO maybe_fatal (must_succeed, terminal, "Terminal type %s is not defined", "Terminal type %s is not defined.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ -`setenv TERM ...') to specify the correct type. It may be necessary\n\ -to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.", - terminal_type); +`setenv TERM ...') to specify the correct type. It may be necessary\n" +#ifdef TERMINFO +"to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.", #else - maybe_fatal (must_succeed, terminal, - "Terminal type %s is not defined", - "Terminal type %s is not defined.\n\ -If that is not the actual type of terminal you have,\n\ -use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ -`setenv TERM ...') to specify the correct type. It may be necessary\n\ -to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.", +"to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.", +#endif terminal_type); -#endif } #ifndef TERMINFO @@ -3878,20 +3871,15 @@ { maybe_fatal (must_succeed, terminal, "Terminal type \"%s\" is not powerful enough to run Emacs", -# ifdef TERMINFO "Terminal type \"%s\" is not powerful enough to run Emacs.\n\ It lacks the ability to position the cursor.\n\ If that is not the actual type of terminal you have,\n\ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ -`setenv TERM ...') to specify the correct type. It may be necessary\n\ -to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.", +`setenv TERM ...') to specify the correct type. It may be necessary\n" +# ifdef TERMINFO +"to do `unset TERMINFO' (C-shell: `unsetenv TERMINFO') as well.", # else /* TERMCAP */ - "Terminal type \"%s\" is not powerful enough to run Emacs.\n\ -It lacks the ability to position the cursor.\n\ -If that is not the actual type of terminal you have,\n\ -use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ -`setenv TERM ...') to specify the correct type. It may be necessary\n\ -to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.", +"to do `unset TERMCAP' (C-shell: `unsetenv TERMCAP') as well.", # endif /* TERMINFO */ terminal_type); }
--- a/src/window.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/window.c Thu Apr 15 11:20:03 2010 +0200 @@ -168,6 +168,10 @@ Lisp_Object Vscroll_preserve_screen_position; +/* List of commands affected by `Vscroll_preserve_screen_position'. */ + +Lisp_Object Vscroll_preserve_screen_position_commands; + /* Non-nil means that text is inserted before window's markers. */ Lisp_Object Vwindow_point_insertion_type; @@ -4946,8 +4950,8 @@ possibility of point becoming "stuck" on a tall line when scrolling by one line. */ if (window_scroll_pixel_based_preserve_y < 0 - || (!EQ (current_kboard->Vlast_command, Qscroll_up) - && !EQ (current_kboard->Vlast_command, Qscroll_down))) + || NILP (Fmemq (current_kboard->Vlast_command, + Vscroll_preserve_screen_position_commands))) { start_display (&it, w, start); move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); @@ -5207,8 +5211,8 @@ if (!NILP (Vscroll_preserve_screen_position)) { if (window_scroll_preserve_vpos <= 0 - || (!EQ (current_kboard->Vlast_command, Qscroll_up) - && !EQ (current_kboard->Vlast_command, Qscroll_down))) + || NILP (Fmemq (current_kboard->Vlast_command, + Vscroll_preserve_screen_position_commands))) { struct position posit = *compute_motion (startpos, 0, 0, 0, @@ -7265,9 +7269,19 @@ A value of t means point keeps its screen position if the scroll command moved it vertically out of the window, e.g. when scrolling by full screens. -Any other value means point always keeps its screen position. */); +Any other value means point always keeps its screen position. +Scroll commands are defined by the variable +`scroll-preserve-screen-position-commands'. */); Vscroll_preserve_screen_position = Qnil; + DEFVAR_LISP ("scroll-preserve-screen-position-commands", + &Vscroll_preserve_screen_position_commands, + doc: /* A list of commands whose scrolling should keep screen position unchanged. +This list defines the names of scroll commands affected by the variable +`scroll-preserve-screen-position'. */); + Vscroll_preserve_screen_position_commands = + Fcons (Qscroll_down, Fcons (Qscroll_up, Qnil)); + DEFVAR_LISP ("window-point-insertion-type", &Vwindow_point_insertion_type, doc: /* Type of marker to use for `window-point'. */); Vwindow_point_insertion_type = Qnil; @@ -7377,9 +7391,9 @@ initial_define_key (control_x_map, '<', "scroll-left"); initial_define_key (control_x_map, '>', "scroll-right"); - initial_define_key (global_map, Ctl ('V'), "scroll-up"); + initial_define_key (global_map, Ctl ('V'), "scroll-up-command"); initial_define_key (meta_map, Ctl ('V'), "scroll-other-window"); - initial_define_key (meta_map, 'v', "scroll-down"); + initial_define_key (meta_map, 'v', "scroll-down-command"); } /* arch-tag: 90a9c576-0590-48f1-a5f1-6c96a0452d9f
--- a/src/xdisp.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xdisp.c Thu Apr 15 11:20:03 2010 +0200 @@ -6570,7 +6570,10 @@ /* Scan forward from CHARPOS in the current buffer, until we find a stop position > current IT's position. Then handle the stop position before that. This is called when we bump into a stop - position while reordering bidirectional text. */ + position while reordering bidirectional text. CHARPOS should be + the last previously processed stop_pos (or BEGV, if none were + processed yet) whose position is less that IT's current + position. */ static void handle_stop_backwards (it, charpos) @@ -12550,6 +12553,9 @@ EMACS_INT pos_before = MATRIX_ROW_START_CHARPOS (row) + delta; EMACS_INT pos_after = MATRIX_ROW_END_CHARPOS (row) + delta; struct glyph *glyph_before = glyph - 1, *glyph_after = end; + /* A glyph beyond the edge of TEXT_AREA which we should never + touch. */ + struct glyph *glyphs_end = end; /* Non-zero means we've found a match for cursor position, but that glyph has the avoid_cursor_p flag set. */ int match_with_avoid_cursor = 0; @@ -12591,7 +12597,7 @@ /* If the glyph row is reversed, we need to process it from back to front, so swap the edge pointers. */ - end = glyph - 1; + glyphs_end = end = glyph - 1; glyph += row->used[TEXT_AREA] - 1; /* Reverse the known positions in the row. */ last_pos = pos_after = MATRIX_ROW_START_CHARPOS (row) + delta; @@ -12769,7 +12775,8 @@ /* Step 2: If we didn't find an exact match for point, we need to look for a proper place to put the cursor among glyphs between GLYPH_BEFORE and GLYPH_AFTER. */ - if (!(BUFFERP (glyph->object) && glyph->charpos == pt_old) + if (!((row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end) + && BUFFERP (glyph->object) && glyph->charpos == pt_old) && bpos_covered < pt_old) { if (row->ends_in_ellipsis_p && pos_after == last_pos) @@ -12935,9 +12942,15 @@ struct glyph *g1 = MATRIX_ROW_GLYPH_START (matrix, w->cursor.vpos) + w->cursor.hpos; + /* Don't consider glyphs that are outside TEXT_AREA. */ + if (!(row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end)) + return 0; /* Keep the candidate whose buffer position is the closest to point. */ - if (BUFFERP (g1->object) + if (/* previous candidate is a glyph in TEXT_AREA of that row */ + w->cursor.hpos >= 0 + && w->cursor.hpos < MATRIX_ROW_USED(matrix, w->cursor.vpos) + && BUFFERP (g1->object) && (g1->charpos == pt_old /* an exact match always wins */ || (BUFFERP (glyph->object) && eabs (g1->charpos - pt_old) @@ -14190,7 +14203,7 @@ = try_window_reusing_current_matrix (w))) { IF_DEBUG (debug_method_add (w, "1")); - if (try_window (window, startp, 1) < 0) + if (try_window (window, startp, TRY_WINDOW_CHECK_MARGINS) < 0) /* -1 means we need to scroll. 0 means we need new matrices, but fonts_changed_p is set in that case, so we will detect it below. */ @@ -14541,13 +14554,15 @@ Value is 1 if successful. It is zero if fonts were loaded during redisplay which makes re-adjusting glyph matrices necessary, and -1 if point would appear in the scroll margins. - (We check that only if CHECK_MARGINS is nonzero. */ + (We check the former only if TRY_WINDOW_IGNORE_FONTS_CHANGE is + unset in FLAGS, and the latter only if TRY_WINDOW_CHECK_MARGINS is + set in FLAGS.) */ int -try_window (window, pos, check_margins) +try_window (window, pos, flags) Lisp_Object window; struct text_pos pos; - int check_margins; + int flags; { struct window *w = XWINDOW (window); struct it it; @@ -14569,12 +14584,12 @@ { if (display_line (&it)) last_text_row = it.glyph_row - 1; - if (fonts_changed_p) + if (fonts_changed_p && !(flags & TRY_WINDOW_IGNORE_FONTS_CHANGE)) return 0; } /* Don't let the cursor end in the scroll margins. */ - if (check_margins + if ((flags & TRY_WINDOW_CHECK_MARGINS) && !MINI_WINDOW_P (w)) { int this_scroll_margin;
--- a/src/xfns.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xfns.c Thu Apr 15 11:20:03 2010 +0200 @@ -110,11 +110,6 @@ extern LWLIB_ID widget_id_tick; -#ifdef USE_LUCID -/* This is part of a kludge--see lwlib/xlwmenu.c. */ -extern XFontStruct *xlwmenu_default_font; -#endif - extern void free_frame_menubar (); extern double atof (); @@ -203,6 +198,10 @@ extern Lisp_Object Vwindow_system_version; +/* In editfns.c */ + +extern Lisp_Object Vsystem_name; + /* The below are defined in frame.c. */ #if GLYPH_DEBUG @@ -3145,6 +3144,37 @@ return Qnil; } +static void +set_machine_and_pid_properties (struct frame *f) +{ + /* See the above comment "Note: Encoding strategy". */ + XTextProperty text; + int bytes, stringp; + int do_free_text_value = 0; + long pid = (long) getpid (); + + text.value = x_encode_text (Vsystem_name, + Qcompound_text, 0, &bytes, &stringp, + &do_free_text_value); + text.encoding = (stringp ? XA_STRING + : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT); + text.format = 8; + text.nitems = bytes; + XSetWMClientMachine (FRAME_X_DISPLAY (f), + FRAME_OUTER_WINDOW (f), + &text); + if (do_free_text_value) + xfree (text.value); + + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_OUTER_WINDOW (f), + XInternAtom (FRAME_X_DISPLAY (f), + "_NET_WM_PID", + False), + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &pid, 1); +} + DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, doc: /* Make a new X window, which is called a "frame" in Emacs terms. @@ -3344,17 +3374,9 @@ error ("Invalid frame font"); } -#ifdef USE_LUCID - /* Prevent lwlib/xlwmenu.c from crashing because of a bug - whereby it fails to get any font. */ - BLOCK_INPUT; - xlwmenu_default_font = XLoadQueryFont (FRAME_X_DISPLAY (f), "fixed"); - UNBLOCK_INPUT; -#endif - /* Frame contents get displaced if an embedded X window has a border. */ if (! FRAME_X_EMBEDDED_P (f)) - x_default_parameter (f, parms, Qborder_width, make_number (2), + x_default_parameter (f, parms, Qborder_width, make_number (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 1 in order to match xterm. We recognize either @@ -3531,19 +3553,24 @@ ; } + BLOCK_INPUT; + + /* Set machine name and pid for the purpose of window managers. */ + set_machine_and_pid_properties(f); + /* Set the WM leader property. GTK does this itself, so this is not needed when using GTK. */ if (dpyinfo->client_leader_window != 0) { - BLOCK_INPUT; XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), dpyinfo->Xatom_wm_client_leader, XA_WINDOW, 32, PropModeReplace, (unsigned char *) &dpyinfo->client_leader_window, 1); - UNBLOCK_INPUT; } + UNBLOCK_INPUT; + /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ if (FRAME_HAS_MINIBUF_P (f) @@ -4102,7 +4129,7 @@ vinfo_template.screen = XScreenNumberOfScreen (screen); vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask, &vinfo_template, &n_visuals); - if (n_visuals != 1) + if (n_visuals <= 0) fatal ("Can't get proper X visual info"); dpyinfo->n_planes = vinfo->depth; @@ -4820,7 +4847,7 @@ needed to determine window geometry. */ x_default_font_parameter (f, parms); - x_default_parameter (f, parms, Qborder_width, make_number (2), + x_default_parameter (f, parms, Qborder_width, make_number (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 2 in order to match xterm. We recognize either @@ -5201,7 +5228,7 @@ clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); - try_window (FRAME_ROOT_WINDOW (f), pos, 0); + try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Compute width and height of the tooltip. */ width = height = 0; @@ -5218,15 +5245,15 @@ /* Let the row go over the full width of the frame. */ row->full_width_p = 1; + row_width = row->pixel_width; /* There's a glyph at the end of rows that is used to place the cursor there. Don't include the width of this glyph. */ if (row->used[TEXT_AREA]) { last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; - row_width = row->pixel_width - last->pixel_width; + if (INTEGERP (last->object)) + row_width -= last->pixel_width; } - else - row_width = row->pixel_width; height += row->height; width = max (width, row_width);
--- a/src/xmenu.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xmenu.c Thu Apr 15 11:20:03 2010 +0200 @@ -81,6 +81,8 @@ #include <X11/StringDefs.h> #include <X11/Shell.h> #ifdef USE_LUCID +#include "xsettings.h" +#include "../lwlib/xlwmenu.h" #ifdef HAVE_XAW3D #include <X11/Xaw3d/Paned.h> #else /* !HAVE_XAW3D */ @@ -950,6 +952,49 @@ return 1; } +#ifdef USE_LUCID +static void +apply_systemfont_to_dialog (w) + Widget w; +{ + const char *fn = xsettings_get_system_normal_font (); + if (fn) + { + XrmDatabase db = XtDatabase (XtDisplay (w)); + if (db) + XrmPutStringResource (&db, "*dialog.faceName", fn); + } +} + +static void +apply_systemfont_to_menu (w) + Widget w; +{ + const char *fn = xsettings_get_system_normal_font (); + int defflt; + + if (!fn) return; + + if (XtIsShell (w)) /* popup menu */ + { + Widget *childs = NULL; + int num = 0; + + XtVaGetValues (w, XtNnumChildren, &num, NULL); + if (num != 1) return; /* Should only be one. */ + + childs[0] = 0; + XtVaGetValues (w, XtNchildren, &childs, NULL); + if (childs && *childs) w = *childs; + } + + /* Only use system font if the default is used for the menu. */ + XtVaGetValues (w, XtNdefaultFace, &defflt, NULL); + if (defflt) + XtVaSetValues (w, XtNfaceName, fn, NULL); +} +#endif + /* Set the contents of the menubar widgets of frame F. The argument FIRST_TIME is currently ignored; it is set the first time this is called, from initialize_frame_menubar. */ @@ -1262,6 +1307,7 @@ /* Make menu pop down on C-g. */ XtOverrideTranslations (menubar_widget, override); + apply_systemfont_to_menu (menubar_widget); } { @@ -1608,6 +1654,8 @@ popup_deactivate_callback, menu_highlight_callback); + apply_systemfont_to_menu (menu); + dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; @@ -2012,11 +2060,13 @@ abort(); dialog_id = widget_id_tick++; +#ifdef HAVE_XFT + apply_systemfont_to_dialog (f->output_data.x->widget); +#endif lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, f->output_data.x->widget, 1, 0, dialog_selection_callback, 0, 0); lw_modify_all_widgets (dialog_id, first_wv->contents, True); - /* Display the dialog box. */ lw_pop_up_all_widgets (dialog_id); popup_activated_flag = 1;
--- a/src/xsettings.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xsettings.c Thu Apr 15 11:20:03 2010 +0200 @@ -39,6 +39,7 @@ #endif static char *current_mono_font; +static char *current_font; static struct x_display_info *first_dpyinfo; static Lisp_Object Qfont_name, Qfont_render; static int use_system_font; @@ -63,9 +64,12 @@ kbd_buffer_store_event (&event); } +#define XSETTINGS_FONT_NAME "Gtk/FontName" + #ifdef HAVE_GCONF -#define SYSTEM_MONO_FONT "/desktop/gnome/interface/monospace_font_name" +#define SYSTEM_MONO_FONT "/desktop/gnome/interface/monospace_font_name" +#define SYSTEM_FONT "/desktop/gnome/interface/font_name" /* Callback called when something changed in GConf that we care about, that is SYSTEM_MONO_FONT. */ @@ -235,7 +239,7 @@ memset (settings, 0, sizeof (*settings)); - while (bytes_parsed+4 < bytes && settings_seen < 6 + while (bytes_parsed+4 < bytes && settings_seen < 7 && i < n_settings) { int type = prop[bytes_parsed++]; @@ -243,7 +247,7 @@ CARD32 vlen, ival = 0; char name[128]; /* The names we are looking for are not this long. */ char sval[128]; /* The values we are looking for are not this long. */ - int is_xft; + int want_this; int to_cpy; sval[0] = '\0'; @@ -264,13 +268,14 @@ bytes_parsed += 4; /* Skip serial for this value */ if (bytes_parsed > bytes) return BadLength; - is_xft = nlen > 6 && strncmp (name, "Xft/", 4) == 0; + want_this = (nlen > 6 && strncmp (name, "Xft/", 4) == 0) + || (strcmp (XSETTINGS_FONT_NAME, name) == 0); switch (type) { case 0: /* Integer */ if (bytes_parsed+4 > bytes) return BadLength; - if (is_xft) + if (want_this) { memcpy (&ival, prop+bytes_parsed, 4); if (my_bo != that_bo) ival = SWAP32 (ival); @@ -283,7 +288,7 @@ memcpy (&vlen, prop+bytes_parsed, 4); bytes_parsed += 4; if (my_bo != that_bo) vlen = SWAP32 (vlen); - if (is_xft) + if (want_this) { to_cpy = vlen > 127 ? 127 : vlen; memcpy (sval, prop+bytes_parsed, to_cpy); @@ -303,7 +308,7 @@ return BadValue; } - if (is_xft) + if (want_this) { ++settings_seen; if (strcmp (name, "Xft/Antialias") == 0) @@ -361,6 +366,11 @@ else settings->seen &= ~SEEN_LCDFILTER; } + else if (strcmp (name, XSETTINGS_FONT_NAME) == 0) + { + free (current_font); + current_font = xstrdup (sval); + } } } @@ -571,6 +581,12 @@ current_mono_font = xstrdup (s); g_free (s); } + s = gconf_client_get_string (gconf_client, SYSTEM_FONT, NULL); + if (s) + { + current_font = xstrdup (s); + g_free (s); + } gconf_client_set_error_handling (gconf_client, GCONF_CLIENT_HANDLE_NONE); gconf_client_add_dir (gconf_client, SYSTEM_MONO_FONT, @@ -635,6 +651,23 @@ return current_mono_font; } +const char * +xsettings_get_system_normal_font () +{ + return current_font; +} + +DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, + Sfont_get_system_normal_font, + 0, 0, 0, + doc: /* Get the system default font. */) + () +{ + return current_font && use_system_font + ? make_string (current_font, strlen (current_font)) + : Qnil; +} + DEFUN ("font-get-system-font", Ffont_get_system_font, Sfont_get_system_font, 0, 0, 0, doc: /* Get the system default monospaced font. */) @@ -649,6 +682,7 @@ syms_of_xsettings () { current_mono_font = NULL; + current_font = NULL; first_dpyinfo = NULL; #ifdef HAVE_GCONF gconf_client = NULL; @@ -659,6 +693,7 @@ Qfont_render = intern_c_string ("font-render"); staticpro (&Qfont_render); defsubr (&Sfont_get_system_font); + defsubr (&Sfont_get_system_normal_font); DEFVAR_BOOL ("font-use-system-font", &use_system_font, doc: /* *Non-nil means to use the system defined font. */);
--- a/src/xsettings.h Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xsettings.h Thu Apr 15 11:20:03 2010 +0200 @@ -21,10 +21,13 @@ #define XSETTINGS_H EXFUN (Ffont_get_system_font, 0); +EXFUN (Ffont_get_system_normal_font, 0); + extern void xsettings_initialize P_ ((struct x_display_info *dpyinfo)); extern void xft_settings_event P_ ((struct x_display_info *dpyinfo, XEvent *)); extern const char *xsettings_get_system_font P_ ((void)); +extern const char *xsettings_get_system_normal_font P_ ((void)); #endif /* XSETTINGS_H */
--- a/src/xterm.c Sat Apr 03 22:21:58 2010 +0200 +++ b/src/xterm.c Thu Apr 15 11:20:03 2010 +0200 @@ -8931,11 +8931,9 @@ compute_fringe_widths (f, 0); - pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, cols) - + 2*f->border_width; + pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, cols); pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, rows) - + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f) - + 2*f->border_width; + + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f); if (change_gravity) f->win_gravity = NorthWestGravity; x_wm_set_size_hint (f, (long) 0, 0);