# HG changeset patch # User Katsumi Yamaoka # Date 1271161493 0 # Node ID 90955ad81bff0eb43bb0c8b3bd4f2bd0ec2da621 # Parent de8a1b891175d023cbd793fafee625e8221abbd0# Parent 686c788ffbb69af92048caa380daf5c264625617 Merge from mainline. diff -r de8a1b891175 -r 90955ad81bff .arch-inventory --- a/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff admin/CPP-DEFINES --- a/admin/CPP-DEFINES Sun Apr 11 10:53:01 2010 +0000 +++ b/admin/CPP-DEFINES Tue Apr 13 12:24:53 2010 +0000 @@ -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 diff -r de8a1b891175 -r 90955ad81bff admin/charsets/.arch-inventory --- a/admin/charsets/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff admin/unidata/.arch-inventory --- a/admin/unidata/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff doc/emacs/ChangeLog --- a/doc/emacs/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/doc/emacs/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,7 @@ +2010-04-11 Jan Djärv + + * xresources.texi (Lucid Resources): Mention faceName for dialogs. + 2010-04-08 Jan Djärv * xresources.texi (Lucid Resources): Mention faceName to set Xft fonts. diff -r de8a1b891175 -r 90955ad81bff doc/emacs/xresources.texi --- a/doc/emacs/xresources.texi Sun Apr 11 10:53:01 2010 +0000 +++ b/doc/emacs/xresources.texi Tue Apr 13 12:24:53 2010 +0000 @@ -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 @@ -434,12 +435,13 @@ 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 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}: +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 @@ -477,7 +479,7 @@ For dialog boxes, use @samp{dialog*}: @example -Emacs.dialog*.font: 8x16 +Emacs.dialog*.faceName: Sans-12 @end example @noindent diff -r de8a1b891175 -r 90955ad81bff doc/lispref/.arch-inventory --- a/doc/lispref/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff etc/.arch-inventory --- a/etc/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff etc/NEWS --- a/etc/NEWS Sun Apr 11 10:53:01 2010 +0000 +++ b/etc/NEWS Tue Apr 13 12:24:53 2010 +0000 @@ -65,7 +65,8 @@ ** GTK scroll-bars are now placed on the right by default. Use `set-scroll-bar-mode' to change this. -** Lucid menus can display antialiased fonts if Emacs is build with Xft. +** 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 [next] and [prior]) does not signal errors at top/bottom @@ -80,6 +81,8 @@ * 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 @@ -139,6 +142,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 diff -r de8a1b891175 -r 90955ad81bff info/.arch-inventory --- a/info/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff leim/.arch-inventory --- a/leim/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff leim/quail/.arch-inventory --- a/leim/quail/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lib-src/.arch-inventory --- a/lib-src/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lib-src/ChangeLog --- a/lib-src/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/lib-src/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,14 @@ +2010-04-12 Dan Nicolaescu + + * Makefile.in (ALL_CFLAGS, LINK_CFLAGS, CPP_CFLAGS): Move to the + non-cpp section. + +2010-04-11 Dan Nicolaescu + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE): Define using + autoconf, not cpp. + (ALL_CFLAGS): Use them as make variables. + 2010-04-07 Christoph (tiny change) * makefile.w32-in (OTHER_PLATFORM_SUPPORT): Use parenthesis diff -r de8a1b891175 -r 90955ad81bff lib-src/Makefile.in --- a/lib-src/Makefile.in Sun Apr 11 10:53:01 2010 +0000 +++ b/lib-src/Makefile.in Tue Apr 13 12:24:53 2010 +0000 @@ -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 diff -r de8a1b891175 -r 90955ad81bff lisp/.arch-inventory --- a/lisp/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lisp/ChangeLog --- a/lisp/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,51 @@ +2010-04-13 Stefan Monnier + + * 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 + + * 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 + + * 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 * comint.el (comint-password-prompt-regexp): Use regexp-opt, and @@ -13,10 +61,9 @@ * 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-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 @@ -24,11 +71,11 @@ `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): + 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-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 @@ -38,8 +85,8 @@ (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. + * 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 @@ -69,8 +116,8 @@ 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. + (log-edit-mode, log-edit-extra-flags, log-edit-mode): + New declarations. 2010-04-09 Eric Raymond diff -r de8a1b891175 -r 90955ad81bff lisp/bookmark.el --- a/lisp/bookmark.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/bookmark.el Tue Apr 13 12:24:53 2010 +0000 @@ -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,9 @@ (or no-history (bookmark-maybe-historicize-string bookmark)) (let ((start (point))) (prog1 - (insert (bookmark-location bookmark)) ; *Return this line* + ;; FIXME: Each bookmark should come with a `location' method + ;; rather than just say "-- no file --". + (insert (or (bookmark-location bookmark) " -- no file --")) (if (display-mouse-p) (add-text-properties start diff -r de8a1b891175 -r 90955ad81bff lisp/calc/.arch-inventory --- a/lisp/calc/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lisp/calendar/.arch-inventory --- a/lisp/calendar/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lisp/complete.el --- a/lisp/complete.el Sun Apr 11 10:53:01 2010 +0000 +++ /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 -;; 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 . - -;;; 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 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] 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 diff -r de8a1b891175 -r 90955ad81bff lisp/emacs-lisp/easy-mmode.el --- a/lisp/emacs-lisp/easy-mmode.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/emacs-lisp/easy-mmode.el Tue Apr 13 12:24:53 2010 +0000 @@ -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)) diff -r de8a1b891175 -r 90955ad81bff lisp/eshell/.arch-inventory --- a/lisp/eshell/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/gnus/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,18 @@ +2010-04-12 Stefan Monnier + + * 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 + + * 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 * mm-uu.el (mm-uu-pgp-signed-extract-1): Use buffer-file-coding-system diff -r de8a1b891175 -r 90955ad81bff lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Tue Apr 13 12:24:53 2010 +0000 @@ -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,41 @@ (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) + (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) diff -r de8a1b891175 -r 90955ad81bff lisp/man.el --- a/lisp/man.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/man.el Tue Apr 13 12:24:53 2010 +0000 @@ -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,44 @@ (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) + (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) diff -r de8a1b891175 -r 90955ad81bff lisp/mh-e/.arch-inventory --- a/lisp/mh-e/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff lisp/obsolete/complete.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/obsolete/complete.el Tue Apr 13 12:24:53 2010 +0000 @@ -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 +;; 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 . + +;;; 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 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] 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 diff -r de8a1b891175 -r 90955ad81bff lisp/pcomplete.el --- a/lisp/pcomplete.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/pcomplete.el Tue Apr 13 12:24:53 2010 +0000 @@ -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 diff -r de8a1b891175 -r 90955ad81bff lisp/vc-dir.el --- a/lisp/vc-dir.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/vc-dir.el Tue Apr 13 12:24:53 2010 +0000 @@ -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)) diff -r de8a1b891175 -r 90955ad81bff lisp/woman.el --- a/lisp/woman.el Sun Apr 11 10:53:01 2010 +0000 +++ b/lisp/woman.el Tue Apr 13 12:24:53 2010 +0000 @@ -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,35 @@ (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) + ;; 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 diff -r de8a1b891175 -r 90955ad81bff lwlib/ChangeLog --- a/lwlib/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/lwlib/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,28 @@ +2010-04-11 Dan Nicolaescu + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE) + (C_SWITCH_X_SITE): Define using autoconf. + +2010-04-11 Jan Djärv + + * 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 * xlwmenu.c (xlwmenu_default_font): Make static. diff -r de8a1b891175 -r 90955ad81bff lwlib/Makefile.in --- a/lwlib/Makefile.in Sun Apr 11 10:53:01 2010 +0000 +++ b/lwlib/Makefile.in Tue Apr 13 12:24:53 2010 +0000 @@ -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@ diff -r de8a1b891175 -r 90955ad81bff lwlib/lwlib-Xaw.c --- a/lwlib/lwlib-Xaw.c Sun Apr 11 10:53:01 2010 +0000 +++ b/lwlib/lwlib-Xaw.c Tue Apr 13 12:24:53 2010 +0000 @@ -54,6 +54,22 @@ #include +#ifdef HAVE_XFT +#include + +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[] = + ": reset() my_reset()\n" + ": set() my_press()\n" + ": 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; } diff -r de8a1b891175 -r 90955ad81bff lwlib/lwlib-int.h --- a/lwlib/lwlib-int.h Sun Apr 11 10:53:01 2010 +0000 +++ b/lwlib/lwlib-int.h Tue Apr 13 12:24:53 2010 +0000 @@ -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; diff -r de8a1b891175 -r 90955ad81bff nt/.arch-inventory --- a/nt/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3 +0,0 @@ -source ^subdirs\.el$ - -# arch-tag: 01b87183-9d94-4b6b-93cb-fece25c4eec9 diff -r de8a1b891175 -r 90955ad81bff oldXMenu/ChangeLog --- a/oldXMenu/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/oldXMenu/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,8 @@ +2010-04-11 Dan Nicolaescu + + * Makefile.in (C_SWITCH_SYSTEM, C_SWITCH_MACHINE) + (C_SWITCH_X_SITE): Define using autoconf. + 2010-03-10 Chong Yidong * Branch for 23.2. diff -r de8a1b891175 -r 90955ad81bff oldXMenu/Makefile.in --- a/oldXMenu/Makefile.in Sun Apr 11 10:53:01 2010 +0000 +++ b/oldXMenu/Makefile.in Tue Apr 13 12:24:53 2010 +0000 @@ -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@ diff -r de8a1b891175 -r 90955ad81bff src/.arch-inventory --- a/src/.arch-inventory Sun Apr 11 10:53:01 2010 +0000 +++ /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 diff -r de8a1b891175 -r 90955ad81bff src/ChangeLog --- a/src/ChangeLog Sun Apr 11 10:53:01 2010 +0000 +++ b/src/ChangeLog Tue Apr 13 12:24:53 2010 +0000 @@ -1,3 +1,70 @@ +2010-04-13 Jan Djärv + + * xfns.c (Fx_create_frame, x_create_tip_frame): Set default border width + to zero. + +2010-04-13 Stefan Monnier + + * 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 + + * process.c (status_notify): Remove unused var `ro'. + +2010-04-12 Jan Djärv + + * xfns.c (select_visual): Don't call error if XGetVisualInfo returns + more than one visual (Bug#5938). + +2010-04-12 Dan Nicolaescu + + * Makefile.in (C_SWITCH_SYSTEM,C_SWITCH_MACHINE,C_SWITCH_X_SITE): Undefine. + +2010-04-11 Dan Nicolaescu + + 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 + + * xmenu.c (apply_systemfont_to_dialog): New. + (create_and_show_dialog): Call apply_systemfont_to_dialog if HAVE_XFT. + +2010-04-11 Stefan Monnier + + * 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 * s/msdos.h (UNEXEC): New definition. diff -r de8a1b891175 -r 90955ad81bff src/Makefile.in --- a/src/Makefile.in Sun Apr 11 10:53:01 2010 +0000 +++ b/src/Makefile.in Tue Apr 13 12:24:53 2010 +0000 @@ -75,11 +75,14 @@ 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@ + # ========================== 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 @@ -91,6 +94,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 @@ -163,12 +171,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 @@ -180,16 +182,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 @@ -199,10 +191,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 @@ -267,9 +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} ${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} ${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 @@ -924,9 +916,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 @@ -936,11 +925,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 */ @@ -949,11 +935,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 */ diff -r de8a1b891175 -r 90955ad81bff src/buffer.c --- a/src/buffer.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/buffer.c Tue Apr 13 12:24:53 2010 +0000 @@ -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". */ diff -r de8a1b891175 -r 90955ad81bff src/buffer.h --- a/src/buffer.h Sun Apr 11 10:53:01 2010 +0000 +++ b/src/buffer.h Tue Apr 13 12:24:53 2010 +0000 @@ -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. diff -r de8a1b891175 -r 90955ad81bff src/fileio.c --- a/src/fileio.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/fileio.c Tue Apr 13 12:24:53 2010 +0000 @@ -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; diff -r de8a1b891175 -r 90955ad81bff src/process.c --- a/src/process.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/process.c Tue Apr 13 12:24:53 2010 +0000 @@ -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)) diff -r de8a1b891175 -r 90955ad81bff src/s/darwin.h --- a/src/s/darwin.h Sun Apr 11 10:53:01 2010 +0000 +++ b/src/s/darwin.h Tue Apr 13 12:24:53 2010 +0000 @@ -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 diff -r de8a1b891175 -r 90955ad81bff src/sysdep.c --- a/src/sysdep.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/sysdep.c Tue Apr 13 12:24:53 2010 +0000 @@ -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; diff -r de8a1b891175 -r 90955ad81bff src/term.c --- a/src/term.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/term.c Tue Apr 13 12:24:53 2010 +0000 @@ -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); } diff -r de8a1b891175 -r 90955ad81bff src/xfns.c --- a/src/xfns.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/xfns.c Tue Apr 13 12:24:53 2010 +0000 @@ -3376,7 +3376,7 @@ /* 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 @@ -4129,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; @@ -4847,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 diff -r de8a1b891175 -r 90955ad81bff src/xmenu.c --- a/src/xmenu.c Sun Apr 11 10:53:01 2010 +0000 +++ b/src/xmenu.c Tue Apr 13 12:24:53 2010 +0000 @@ -954,6 +954,19 @@ #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; { @@ -964,15 +977,15 @@ if (XtIsShell (w)) /* popup menu */ { - Widget *childs[1]; + 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[0] && *childs[0]) w = *childs[0]; + XtVaGetValues (w, XtNchildren, &childs, NULL); + if (childs && *childs) w = *childs; } /* Only use system font if the default is used for the menu. */ @@ -2047,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;