procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from mainline.

Browse source
This commit is contained in:
Paul Eggert 2011-01-11 21:57:19 -08:00
commit 7ea5475741
44 changed files with 4906 additions and 733 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
admin/bzrmerge.el
View file

@ -1,22 +1,22 @@
;;; bzrmerge.el ---
;; Copyright (C) 2010 Stefan Monnier
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
@ -202,7 +202,7 @@ Does not make other difference."
"merge" "-r" (format "%s" endrevno) from)
(call-process "bzr" nil t nil "revert" ".")
(call-process "bzr" nil t nil "unshelve")))
(defvar bzrmerge-already-done nil)
(defun bzrmerge-apply (missing from)

6
doc/lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2011-01-11 Stefan Monnier <monnier@iro.umontreal.ca>
* loading.texi (Hooks for Loading): Adjust doc of eval-after-load.
2011-01-02 Eli Zaretskii <eliz@gnu.org>
* modes.texi (Emulating Mode Line): Fix last change.
@ -8884,7 +8888,7 @@
;; End:
Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
2007, 2008, 2009, 2010 Free Software Foundation, Inc.
2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
This file is part of GNU Emacs.

2
doc/lispref/files.texi
View file

@ -1919,7 +1919,7 @@ The variable @code{directory-abbrev-alist} contains an alist of
abbreviations to use for file directories. Each element has the form
@code{(@var{from} . @var{to})}, and says to replace @var{from} with
@var{to} when it appears in a directory name. The @var{from} string is
actually a regular expression; it should always start with @samp{\`}.
actually a regular expression; it ought to always start with @samp{\`}.
The @var{to} string should be an ordinary absolute directory name. Do
not use @samp{~} to stand for a home directory in that string. The
function @code{abbreviate-file-name} performs these substitutions.

3
doc/lispref/loading.texi
View file

@ -962,7 +962,8 @@ example, @file{my_inst.elc} or @file{my_inst.elc.gz} in some directory
@end example
@var{library} can also be a feature (i.e.@: a symbol), in which case
@var{form} is evaluated when @code{(provide @var{library})} is called.
@var{form} is evaluated at the end of any file where
@code{(provide @var{library})} is called.
An error in @var{form} does not undo the load, but does prevent
execution of the rest of @var{form}.

5
doc/misc/ChangeLog
View file

@ -1,3 +1,8 @@
2011-01-10 Jan Moringen <jan.moringen@uni-bielefeld.de>
* dbus.texi (Receiving Method Calls): New function
dbus-register-service. Rearrange node.
2011-01-07 Paul Eggert <eggert@cs.ucla.edu>
* texinfo.tex: Update to version 2010-12-23.17 from gnulib,

86
doc/misc/dbus.texi
View file

@ -1244,9 +1244,73 @@ message has been arrived, and @var{handler} is called. Example:
@cindex method calls, returning
@cindex returning method calls
Emacs can also offer own methods, which can be called by other
applications. These methods could be an implementation of an
interface of a well known service, like @samp{org.freedesktop.TextEditor}.
In order to register methods on the D-Bus, Emacs has to request a well
known name on the D-Bus under which it will be available for other
clients. Names on the D-Bus can be registered and unregistered using
the following functions:
@defun dbus-register-service bus service &rest flags
Register the known name @var{service} on D-Bus @var{bus}.
@var{bus} is either the symbol @code{:system} or the symbol
@code{:session}.
@var{service} is the service name to be registered on the D-Bus. It
must be a known name.
@var{flags} is a subset of the following keywords:
@itemize
@item @code{:allow-replacement}: Allow another service to become the primary
owner if requested.
@item @code{:replace-existing}: Request to replace the current primary owner.
@item @code{:do-not-queue}: If we can not become the primary owner do not
place us in the queue.
@end itemize
One of the following keywords is returned:
@itemize
@item @code{:primary-owner}: We have become the primary owner of the name
@var{service}.
@item @code{:in-queue}: We could not become the primary owner and
have been placed in the queue.
@item @code{:exists}: We already are in the queue.
@item @code{:already-owner}: We already are the primary
owner.
@end itemize
@end defun
@defun dbus-unregister-service bus service
Unregister all objects from D-Bus @var{bus}, registered by Emacs for
@var{service}.
@var{bus} is either the symbol @code{:system} or the symbol
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
known name. Emacs releases its association to @var{service} from
D-Bus.
One of the following keywords is returned:
@itemize
@item @code{:released}: We successfully released the name @var{service}.
@item @code{:non-existent}: The name @var{service} does not exist on the bus.
@item @code{:not-owner}: We are not an owner of the name @var{service}.
@end itemize
@end defun
When a name has been chosen, Emacs can offer own methods, which can be
called by other applications. These methods could be an
implementation of an interface of a well known service, like
@samp{org.freedesktop.TextEditor}.
It could be also an implementation of an own interface. In this case,
the service name must be @samp{org.gnu.Emacs}. The object path shall
@ -1300,7 +1364,7 @@ When @var{dont-register-service} is non-@code{nil}, the known name
@var{service} is not registered. This means that other D-Bus clients
have no way of noticing the newly registered method. When interfaces
are constructed incrementally by adding single methods or properties
at a time, @var{dont-register-service} can be use to prevent other
at a time, @var{dont-register-service} can be used to prevent other
clients from discovering the still incomplete interface.
The default D-Bus timeout when waiting for a message reply is 25
@ -1414,7 +1478,7 @@ When @var{dont-register-service} is non-@code{nil}, the known name
@var{service} is not registered. This means that other D-Bus clients
have no way of noticing the newly registered method. When interfaces
are constructed incrementally by adding single methods or properties
at a time, @var{dont-register-service} can be use to prevent other
at a time, @var{dont-register-service} can be used to prevent other
clients from discovering the still incomplete interface.
@noindent Example:
@ -1491,18 +1555,6 @@ registered for the respective service, Emacs releases its association
to the service from D-Bus.
@end defun
@defun dbus-unregister-service bus service
Unregister all objects from D-Bus @var{bus}, registered by Emacs for
@var{service}.
@var{bus} is either the symbol @code{:system} or the symbol
@code{:session}.
@var{service} is the D-Bus service name of the D-Bus. It must be a
known name. Emacs releases its association to @var{service} from
D-Bus.
@end defun
@node Signals
@chapter Sending and receiving signals.

11
etc/ChangeLog
View file

@ -1,3 +1,14 @@
2011-01-10 Jan Moringen <jan.moringen@uni-bielefeld.de>
* NEWS: Add new function dbus-register-service.
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* themes/tango-theme.el, themes/tango-dark-theme.el: Let-bind
tango palette colors. Only define faces for color displays.
Customize the ansi-color-names-vector variable. Add Ediff,
Flyspell, and Semantic faces as suggested by Jan Moringen.
2011-01-08 Andreas Schwab <schwab@linux-m68k.org>
* compilation.txt: Add column to gcc-include sample.

18
etc/NEWS
View file

@ -219,9 +219,10 @@ Emacs no longer looks for custom themes in `load-path'. The default
is to search in `custom-theme-directory', followed by a built-in theme
directory named "themes/" in `data-directory'.
*** New option `custom-safe-theme-files' lists known-safe theme files.
If a theme is not in this list, Emacs queries before loading it.
The default value treats all themes included in Emacs as safe.
*** New option `custom-safe-themes' records known-safe theme files.
If a theme is not in this list, Emacs queries before loading it, and
offers to save the theme to `custom-safe-themes' automatically. By
default, all themes included in Emacs are treated as safe.
** The user option `remote-file-name-inhibit-cache' controls whether
the remote file-name cache is used for read access.
@ -322,6 +323,10 @@ prompts for a number to count from and for a format string.
* Changes in Specialized Modes and Packages in Emacs 24.1
** Prolog mode has been completely revamped, with lots of additional
functionality such as more intelligent indentation, electricty, support for
more variants, including Mercury, and a lot more.
** shell-mode can track your cwd by reading it from your prompt.
Just set shell-dir-cookie-re to an appropriate regexp.
@ -564,7 +569,12 @@ threads simultaneously.
*** It is possible now, to access alternative buses than the default
system or session bus.
*** dbus-register-{method,property} do not necessarily register names anymore.
*** dbus-register-{service,method,property}
The -method and -property functions do not automatically register
names anymore.
The new function dbus-register-service registers a service known name
on a D-Bus without simultaneously registering a property or a method.
** Tramp

178
etc/themes/tango-dark-theme.el
View file

@ -1,6 +1,9 @@
;;; tango-dark-theme.el --- Tango-based custom theme for faces
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
;; This file is part of GNU Emacs.
@ -25,63 +28,124 @@
;;; Code:
(deftheme tango-dark
"Theme for faces, based on the Tango palette on a dark background.
Basic, Font Lock, Isearch, Gnus, and Message faces are included.")
"Theme for faces, based on the Tango palette with a dark background.
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.")
(custom-theme-set-faces
'tango-dark
'(default ((t (:foreground "#eeeeec" :background "#2e3436"))))
'(cursor ((t (:foreground "#2e3436" :background "#fce94f"))))
'(highlight ((t (:foreground "#2e3436" :background "#edd400"))))
'(region ((t (:background "#555753"))))
'(font-lock-builtin-face ((t (:foreground "#ad7fa8"))))
'(font-lock-comment-face ((t (:foreground "#73d216"))))
'(font-lock-constant-face ((t (:foreground "#e6a8df"))))
'(font-lock-function-name-face ((t (:foreground "#fce94f"))))
'(font-lock-keyword-face ((t (:foreground "#8cc4ff"))))
'(font-lock-string-face ((t (:foreground "#e9b96e"))))
'(font-lock-type-face ((t (:foreground "#a5ff4d"))))
'(font-lock-variable-name-face ((t (:foreground "#fcaf3e"))))
'(font-lock-warning-face ((t (:foreground "#ef2929"))))
'(button ((t (:underline t :foreground "#729fcf"))))
'(link ((t (:underline t :foreground "#729fcf"))))
'(link-visited ((t (:underline t :foreground "#3465a4"))))
'(mode-line ((t (:box (:line-width -1 :style released-button)
:background "#d3d7cf" :foreground "black"))))
'(mode-line-inactive ((t (:box (:line-width -1 :style released-button)
:background "#555753" :foreground "white"))))
'(isearch ((t (:foreground "#ffffff" :background "#ce5c00"))))
'(lazy-highlight ((t (:background "#8f5902"))))
'(gnus-group-news-1 ((t (:foreground "#ad7fa8"))))
'(gnus-group-news-1-low ((t (:foreground "#75507b"))))
'(gnus-group-news-2 ((t (:foreground "#729fcf"))))
'(gnus-group-news-2-low ((t (:foreground "#3465a4"))))
'(gnus-group-news-3 ((t (:foreground "#8ae234"))))
'(gnus-group-news-3-low ((t (:foreground "#73d216"))))
'(gnus-group-news-4 ((t (:foreground "#e9b9e6"))))
'(gnus-group-news-4-low ((t (:foreground "#c17d11"))))
'(gnus-group-news-5 ((t (:foreground "#fcaf3e"))))
'(gnus-group-news-5-low ((t (:foreground "#f57900"))))
'(gnus-group-news-low ((t (:foreground "#edd400"))))
'(gnus-group-mail-1 ((t (:foreground "#ad7fa8"))))
'(gnus-group-mail-1-low ((t (:foreground "#75507b"))))
'(gnus-group-mail-2 ((t (:foreground "#729fcf"))))
'(gnus-group-mail-2-low ((t (:foreground "#3465a4"))))
'(gnus-group-mail-3 ((t (:foreground "#8ae234"))))
'(gnus-group-mail-3-low ((t (:foreground "#73d216"))))
'(gnus-group-mail-low ((t (:foreground "#edd400"))))
'(gnus-header-content ((t (:weight normal :foreground "#c4a000"))))
'(gnus-header-from ((t (:foreground "#edd400"))))
'(gnus-header-subject ((t (:foreground "#8ae234"))))
'(gnus-header-name ((t (:foreground "#729fcf"))))
'(gnus-header-newsgroups ((t (:foreground "#c17d11"))))
'(message-header-name ((t (:foreground "#729fcf"))))
'(message-header-cc ((t (:foreground "#c4a000"))))
'(message-header-other ((t (:foreground "#c17d11"))))
'(message-header-subject ((t (:foreground "#8ae234"))))
'(message-header-to ((t (:foreground "#edd400"))))
'(message-cited-text ((t (:foreground "#8ae234"))))
'(message-separator ((t (:foreground "#ad7fa8")))))
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
(butter-1 "#fce94f") (butter-2 "#edd400") (butter-3 "#c4a000")
(orange-1 "#fcaf3e") (orange-2 "#f57900") (orange-3 "#ce5c00")
(choc-1 "#e9b96e") (choc-2 "#c17d11") (choc-3 "#8f5902")
(cham-1 "#8ae234") (cham-2 "#73d216") (cham-3 "#4e9a06")
(blue-1 "#729fcf") (blue-2 "#3465a4") (blue-3 "#204a87")
(plum-1 "#ad7fa8") (plum-2 "#75507b") (plum-3 "#5c3566")
(red-1 "#ef2929") (red-2 "#cc0000") (red-3 "#a40000")
(alum-1 "#eeeeec") (alum-2 "#d3d7cf") (alum-3 "#babdb6")
(alum-4 "#888a85") (alum-5 "#555753") (alum-6 "#2e3436")
;; Not in Tango palette; used for better contrast.
(cham-0 "#b4fa70") (blue-0 "#8cc4ff") (plum-0 "#e6a8df")
(red-0 "#ff4b4b") (alum-5.5 "#41423f") (alum-7 "#212526"))
(custom-theme-set-faces
'tango-dark
`(default ((,class (:foreground ,alum-1 :background ,alum-6))))
`(cursor ((,class (:foreground ,alum-6 :background ,butter-1))))
;; Highlighting faces
`(fringe ((,class (:background ,alum-7))))
`(highlight ((,class (:foreground ,alum-6 :background ,butter-2))))
`(region ((,class (:background ,alum-5))))
`(secondary-selection ((,class (:background ,blue-3))))
`(isearch ((,class (:foreground ,alum-1 :background ,orange-3))))
`(lazy-highlight ((,class (:background ,choc-3))))
`(trailing-whitespace ((,class (:background ,red-3))))
;; Mode line faces
`(mode-line ((,class
(:box (:line-width -1 :style released-button)
:background ,alum-2 :foreground ,alum-6))))
`(mode-line-inactive ((,class
(:box (:line-width -1 :style released-button)
:background ,alum-5 :foreground ,alum-1))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:foreground ,cham-0))))
`(escape-glyph ((,class (:foreground ,butter-3))))
;; Font lock faces
`(font-lock-builtin-face ((,class (:foreground ,plum-1))))
`(font-lock-comment-face ((,class (:foreground ,cham-2))))
`(font-lock-constant-face ((,class (:foreground ,plum-0))))
`(font-lock-function-name-face ((,class (:foreground ,butter-1))))
`(font-lock-keyword-face ((,class (:foreground ,cham-0))))
`(font-lock-string-face ((,class (:foreground ,choc-1))))
`(font-lock-type-face ((,class (:foreground ,blue-0))))
`(font-lock-variable-name-face ((,class (:foreground ,orange-1))))
`(font-lock-warning-face ((,class (:foreground ,red-0))))
;; Button and link faces
`(button ((,class (:underline t :foreground ,blue-1))))
`(link ((,class (:underline t :foreground ,blue-1))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces
`(gnus-group-news-1 ((,class (:foreground ,plum-1))))
`(gnus-group-news-1-low ((,class (:foreground ,plum-2))))
`(gnus-group-news-2 ((,class (:foreground ,blue-1))))
`(gnus-group-news-2-low ((,class (:foreground ,blue-2))))
`(gnus-group-news-3 ((,class (:foreground ,cham-1))))
`(gnus-group-news-3-low ((,class (:foreground ,cham-2))))
`(gnus-group-news-4 ((,class (:foreground ,plum-0))))
`(gnus-group-news-4-low ((,class (:foreground ,choc-2))))
`(gnus-group-news-5 ((,class (:foreground ,orange-1))))
`(gnus-group-news-5-low ((,class (:foreground ,orange-2))))
`(gnus-group-news-low ((,class (:foreground ,butter-2))))
`(gnus-group-mail-1 ((,class (:foreground ,plum-1))))
`(gnus-group-mail-1-low ((,class (:foreground ,plum-2))))
`(gnus-group-mail-2 ((,class (:foreground ,blue-1))))
`(gnus-group-mail-2-low ((,class (:foreground ,blue-2))))
`(gnus-group-mail-3 ((,class (:foreground ,cham-1))))
`(gnus-group-mail-3-low ((,class (:foreground ,cham-2))))
`(gnus-group-mail-low ((,class (:foreground ,butter-2))))
`(gnus-header-content ((,class (:weight normal :foreground ,butter-3))))
`(gnus-header-from ((,class (:foreground ,butter-2))))
`(gnus-header-subject ((,class (:foreground ,cham-1))))
`(gnus-header-name ((,class (:foreground ,blue-1))))
`(gnus-header-newsgroups ((,class (:foreground ,choc-2))))
;; Message faces
`(message-header-name ((,class (:foreground ,blue-1))))
`(message-header-cc ((,class (:foreground ,butter-3))))
`(message-header-other ((,class (:foreground ,choc-2))))
`(message-header-subject ((,class (:foreground ,cham-1))))
`(message-header-to ((,class (:foreground ,butter-2))))
`(message-cited-text ((,class (:foreground ,cham-1))))
`(message-separator ((,class (:foreground ,plum-1))))
;; SMerge faces
`(smerge-refined-change ((,class (:background ,blue-3))))
;; Ediff faces
`(ediff-current-diff-A ((,class (:background ,alum-5))))
`(ediff-fine-diff-A ((,class (:background ,blue-3))))
`(ediff-even-diff-A ((,class (:background ,alum-5.5))))
`(ediff-odd-diff-A ((,class (:background ,alum-5.5))))
`(ediff-current-diff-B ((,class (:background ,alum-5))))
`(ediff-fine-diff-B ((,class (:background ,choc-3))))
`(ediff-even-diff-B ((,class (:background ,alum-5.5))))
`(ediff-odd-diff-B ((,class (:background ,alum-5.5))))
;; Flyspell faces
`(flyspell-duplicate ((,class (:underline ,orange-1))))
`(flyspell-incorrect ((,class (:underline ,red-1))))
;; Semantic faces
`(semantic-decoration-on-includes ((,class (:underline ,alum-4))))
`(semantic-decoration-on-private-members-face
((,class (:background ,plum-3))))
`(semantic-decoration-on-protected-members-face
((,class (:background ,choc-3))))
`(semantic-decoration-on-unknown-includes
((,class (:background ,red-3))))
`(semantic-decoration-on-unparsed-includes
((,class (:background ,alum-5.5))))
`(semantic-tag-boundary-face ((,class (:overline ,blue-1))))
`(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))))
(custom-theme-set-variables
'tango-dark
`(ansi-color-names-vector [,alum-7 ,red-0 ,cham-0 ,butter-1
,blue-1 ,plum-1 ,blue-0 ,alum-1])))
(provide-theme 'tango-dark)

171
etc/themes/tango-theme.el
View file

@ -1,6 +1,9 @@
;;; tango-theme.el --- Tango-based custom theme for faces
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; Authors: Chong Yidong <cyd@stupidchicken>
;; Jan Moringen <jan.moringen@uni-bielefeld.de>
;; This file is part of GNU Emacs.
@ -25,63 +28,117 @@
;;; Code:
(deftheme tango
"Theme for faces, based on the Tango palette on a light background.
Basic, Font Lock, Isearch, Gnus, and Message faces are included.")
"Theme for faces, based on the Tango palette with a light background.
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
Semantic, and Ansi-Color faces are included.")
(custom-theme-set-faces
'tango
'(default ((t (:foreground "#16191a" :background "#eeeeec"))))
'(cursor ((t (:foreground "#eeeeec" :background "#204a87"))))
'(highlight ((t (:background "#babdb6"))))
'(region ((t (:background "#babdb6"))))
'(font-lock-builtin-face ((t (:weight bold :foreground "#204a87"))))
'(font-lock-comment-face ((t (:foreground "#204a87"))))
'(font-lock-constant-face ((t (:weight bold :foreground "#5c3566"))))
'(font-lock-function-name-face ((t (:weight bold :foreground "#ce5c00"))))
'(font-lock-keyword-face ((t (:foreground "#a40000"))))
'(font-lock-string-face ((t (:foreground "#5c3566"))))
'(font-lock-type-face ((t (:weight bold :foreground "#4e9a06"))))
'(font-lock-variable-name-face ((t (:weight bold :foreground "#c17d11"))))
'(font-lock-warning-face ((t (:foreground "#cc0000"))))
'(button ((t (:underline t :foreground "#204a87"))))
'(link ((t (:underline t :foreground "#204a87"))))
'(link-visited ((t (:underline t :foreground "#3465a4"))))
'(mode-line ((t (:box (:line-width -1 :style released-button)
:background "#d3d7cf" :foreground "black"))))
'(mode-line-inactive ((t (:box (:line-width -1 :style released-button)
:background "#babdb6" :foreground "black"))))
'(isearch ((t (:foreground "#ffffff" :background "#ce5c00"))))
'(lazy-highlight ((t (:background "#e9b96e"))))
'(gnus-group-news-1 ((t (:weight bold :foreground "#5c3566"))))
'(gnus-group-news-1-low ((t (:foreground "#5c3566"))))
'(gnus-group-news-2 ((t (:weight bold :foreground "#204a87"))))
'(gnus-group-news-2-low ((t (:foreground "#204a87"))))
'(gnus-group-news-3 ((t (:weight bold :foreground "#4e0a06"))))
'(gnus-group-news-3-low ((t (:foreground "#4e0a06"))))
'(gnus-group-news-4 ((t (:weight bold :foreground "#7a4c02"))))
'(gnus-group-news-4-low ((t (:foreground "#7a4c02"))))
'(gnus-group-news-5 ((t (:weight bold :foreground "#ce5c00"))))
'(gnus-group-news-5-low ((t (:foreground "#ce5c00"))))
'(gnus-group-news-low ((t (:foreground "#888a85"))))
'(gnus-group-mail-1 ((t (:weight bold :foreground "#5c3566"))))
'(gnus-group-mail-1-low ((t (:foreground "#5c3566"))))
'(gnus-group-mail-2 ((t (:weight bold :foreground "#204a87"))))
'(gnus-group-mail-2-low ((t (:foreground "#204a87"))))
'(gnus-group-mail-3 ((t (:weight bold :foreground "#4e0a06"))))
'(gnus-group-mail-3-low ((t (:foreground "#4e0a06"))))
'(gnus-group-mail-low ((t (:foreground "#888a85"))))
'(gnus-header-content ((t (:foreground "#4e9a06"))))
'(gnus-header-from ((t (:weight bold :foreground "#c4a000"))))
'(gnus-header-subject ((t (:foreground "#4e0a06"))))
'(gnus-header-name ((t (:foreground "#204a87"))))
'(gnus-header-newsgroups ((t (:foreground "#888a85"))))
'(message-header-name ((t (:foreground "#204a87"))))
'(message-header-cc ((t (:foreground "#c4a000"))))
'(message-header-other ((t (:foreground "#c17d11"))))
'(message-header-subject ((t (:foreground "#4e0a06"))))
'(message-header-to ((t (:weight bold :foreground "#c4a000"))))
'(message-cited-text ((t (:foreground "#888a85"))))
'(message-separator ((t (:weight bold :foreground "#4e9a06")))))
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
(butter-1 "#fce94f") (butter-2 "#edd400") (butter-3 "#c4a000")
(orange-1 "#fcaf3e") (orange-2 "#f57900") (orange-3 "#ce5c00")
(choc-1 "#e9b96e") (choc-2 "#c17d11") (choc-3 "#8f5902")
(cham-1 "#8ae234") (cham-2 "#73d216") (cham-3 "#4e9a06")
(blue-1 "#729fcf") (blue-2 "#3465a4") (blue-3 "#204a87")
(plum-1 "#ad7fa8") (plum-2 "#75507b") (plum-3 "#5c3566")
(red-1 "#ef2929") (red-2 "#cc0000") (red-3 "#a40000")
(alum-1 "#eeeeec") (alum-2 "#d3d7cf") (alum-3 "#babdb6")
(alum-4 "#888a85") (alum-5 "#555753") (alum-6 "#2e3436")
;; Not in Tango palette; used for better contrast.
(cham-4 "#346604") (blue-0 "#8cc4ff"))
(custom-theme-set-faces
'tango
`(default ((,class (:foreground ,"#16191a" :background ,alum-1))))
`(cursor ((,class (:foreground ,alum-1 :background ,blue-3))))
;; Highlighting faces
`(fringe ((,class (:background ,alum-2))))
`(highlight ((,class (:background ,alum-3))))
`(region ((,class (:background ,alum-3))))
`(secondary-selection ((,class (:background ,blue-0))))
`(isearch ((,class (:foreground ,"#ffffff" :background ,orange-3))))
`(lazy-highlight ((,class (:background ,choc-1))))
`(trailing-whitespace ((,class (:background ,red-1))))
;; Mode line faces
`(mode-line ((,class (:box (:line-width -1 :style released-button)
:background ,alum-2 :foreground ,alum-6))))
`(mode-line-inactive ((,class (:box (:line-width -1 :style released-button)
:background ,alum-4 :foreground ,alum-6))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:weight bold :foreground ,blue-3))))
`(escape-glyph ((,class (:foreground ,red-3))))
;; Font lock faces
`(font-lock-builtin-face ((,class (:weight bold :foreground ,plum-3))))
`(font-lock-comment-face ((,class (:foreground ,cham-4))))
`(font-lock-constant-face ((,class (:weight bold :foreground ,blue-3))))
`(font-lock-function-name-face ((,class (:foreground ,red-3))))
`(font-lock-keyword-face ((,class (:weight bold :foreground ,choc-2))))
`(font-lock-string-face ((,class (:foreground ,plum-3))))
`(font-lock-type-face ((,class (:foreground ,blue-3))))
`(font-lock-variable-name-face ((,class (:weight bold :foreground ,orange-3))))
`(font-lock-warning-face ((,class (:foreground ,red-2))))
;; Button and link faces
`(button ((,class (:underline t :foreground ,blue-3))))
`(link ((,class (:underline t :foreground ,blue-3))))
`(link-visited ((,class (:underline t :foreground ,blue-2))))
;; Gnus faces
`(gnus-group-news-1 ((,class (:weight bold :foreground ,plum-3))))
`(gnus-group-news-1-low ((,class (:foreground ,plum-3))))
`(gnus-group-news-2 ((,class (:weight bold :foreground ,blue-3))))
`(gnus-group-news-2-low ((,class (:foreground ,blue-3))))
`(gnus-group-news-3 ((,class (:weight bold :foreground ,"#4e0a06"))))
`(gnus-group-news-3-low ((,class (:foreground ,"#4e0a06"))))
`(gnus-group-news-4 ((,class (:weight bold :foreground ,"#7a4c02"))))
`(gnus-group-news-4-low ((,class (:foreground ,"#7a4c02"))))
`(gnus-group-news-5 ((,class (:weight bold :foreground ,orange-3))))
`(gnus-group-news-5-low ((,class (:foreground ,orange-3))))
`(gnus-group-news-low ((,class (:foreground ,"#888a85"))))
`(gnus-group-mail-1 ((,class (:weight bold :foreground ,plum-3))))
`(gnus-group-mail-1-low ((,class (:foreground ,plum-3))))
`(gnus-group-mail-2 ((,class (:weight bold :foreground ,blue-3))))
`(gnus-group-mail-2-low ((,class (:foreground ,blue-3))))
`(gnus-group-mail-3 ((,class (:weight bold :foreground ,"#4e0a06"))))
`(gnus-group-mail-3-low ((,class (:foreground ,"#4e0a06"))))
`(gnus-group-mail-low ((,class (:foreground ,"#888a85"))))
`(gnus-header-content ((,class (:foreground ,cham-3))))
`(gnus-header-from ((,class (:weight bold :foreground ,butter-3))))
`(gnus-header-subject ((,class (:foreground ,"#4e0a06"))))
`(gnus-header-name ((,class (:foreground ,blue-3))))
`(gnus-header-newsgroups ((,class (:foreground ,"#888a85"))))
;; Message faces
`(message-header-name ((,class (:foreground ,blue-3))))
`(message-header-cc ((,class (:foreground ,butter-3))))
`(message-header-other ((,class (:foreground ,choc-2))))
`(message-header-subject ((,class (:foreground ,"#4e0a06"))))
`(message-header-to ((,class (:weight bold :foreground ,butter-3))))
`(message-cited-text ((,class (:foreground ,"#888a85"))))
`(message-separator ((,class (:weight bold :foreground ,cham-3))))
;; SMerge
`(smerge-refined-change ((,class (:background ,plum-1))))
;; Ediff
`(ediff-current-diff-A ((,class (:background ,blue-1))))
`(ediff-fine-diff-A ((,class (:background ,plum-1))))
`(ediff-current-diff-B ((,class (:background ,butter-1))))
`(ediff-fine-diff-B ((,class (:background ,orange-1))))
;; Flyspell
`(flyspell-duplicate ((,class (:underline ,orange-1))))
`(flyspell-incorrect ((,class (:underline ,red-1))))
;; Semantic faces
`(semantic-decoration-on-includes ((,class (:underline ,cham-4))))
`(semantic-decoration-on-private-members-face
((,class (:background ,alum-2))))
`(semantic-decoration-on-protected-members-face
((,class (:background ,alum-2))))
`(semantic-decoration-on-unknown-includes
((,class (:background ,choc-3))))
`(semantic-decoration-on-unparsed-includes
((,class (:underline ,orange-3))))
`(semantic-tag-boundary-face ((,class (:overline ,blue-1))))
`(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))))
(custom-theme-set-variables
'tango
`(ansi-color-names-vector [,alum-6 ,red-3 ,cham-3 ,butter-3
,blue-3 ,plum-3 ,blue-1 ,alum-1])))
(provide-theme 'tango)

1
etc/themes/tsdh-dark-theme.el
View file

@ -31,6 +31,7 @@
'(diff-indicator-changed ((t (:weight bold))))
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
'(hl-line ((t (:background "grey28"))))
'(message-header-subject ((t (:foreground "SkyBlue"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))

1
etc/themes/tsdh-light-theme.el
View file

@ -31,6 +31,7 @@
'(diff-indicator-changed ((t (:weight bold))))
'(diff-indicator-removed ((t (:inherit diff-indicator-changed))))
'(diff-removed ((t (:inherit diff-changed :background "sandy brown"))))
'(dired-directory ((t (:inherit font-lock-function-name-face :weight bold))))
'(hl-line ((t (:background "grey95"))))
'(minibuffer-prompt ((t (:background "yellow" :foreground "medium blue" :box (:line-width -1 :color "red" :style released-button) :weight bold))))
'(mode-line ((t (:box (:line-width -1 :color "red" :style released-button) :family "DejaVu Sans"))))

137
lisp/ChangeLog
View file

@ -1,5 +1,128 @@
2011-01-11 Johan Bockgård <bojohan@gnu.org>
* emacs-lisp/unsafep.el (unsafep): Handle backquoted forms.
2011-01-11 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/prolog.el: Fix up coding convention and such.
(prolog-indent-width): Use the same default as in
previous prolog.el rather than tab-width which depends on which buffer
is current when the file is loaded.
(prolog-electric-newline-flag): Only enable if electric-indent-mode
is not available.
(prolog-emacs): Remove. Use (featurep 'xemacs) instead.
(prolog-known-systems): Remove.
(prolog-mode-syntax-table, prolog-inferior-mode-map):
Move initialization into declaration.
(prolog-mode-map): Move initialization into declaration.
Remove system-specific mode-map vars, since they referred to the same
keymap anyway.
(prolog-mode-variables): Obey the user's preference w.r.t
adaptive-fill-mode. Prefer symbol-value to `eval'.
(prolog-mode-keybindings-edit): Add compatibility bindings.
(prolog-mode): Use define-derived-mode. Don't handle mercury here.
(mercury-mode-map): New var.
(mercury-mode, prolog-inferior-mode): Use define-derived-mode.
(prolog-ensure-process, prolog-process-insert-string)
(prolog-consult-compile): Use with-current-buffer.
(prolog-guess-fill-prefix): Simplify data flow.
(prolog-replace-in-string): New function to use instead of
replace-in-string.
(prolog-enable-sicstus-sd): Don't abuse `eval'.
(prolog-uncomment-region): Use `uncomment-region' when available.
(prolog-electric-colon, prolog-electric-dash): Use `eolp'.
(prolog-int-to-char, prolog-char-to-int): New functions to use instead
of int-to-char and char-to-int.
(prolog-mode-hook, prolog-inferior-mode-hook): Don't force font-lock.
2011-01-11 Stefan Bruda <stefan@bruda.ca>
* progmodes/prolog.el: Replace by a whole new file.
2011-01-11 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (eval-after-load): Fix timing for features (bug#7769).
(declare-function, undefined, insert-for-yank)
(replace-regexp-in-string): Follow checkdoc's recommendations.
2011-01-10 Stefan Monnier <monnier@iro.umontreal.ca>
* calendar/diary-lib.el (diary-mode): Refresh *Calendar* after
refreshing the diary buffer.
2011-01-10 Ken Manheimer <ken.manheimer@gmail.com>
* allout.el: Add 2011 to the file copyright.
(allout-encrypt-string): Prevent encryption from adding an extra
newline at the end of the topic body.
(allout-version): Increment to 2.3.
2011-01-10 Michael Albinus <michael.albinus@gmx.de>
* net/dbus.el (dbus-unregister-service): Complete doc.
Fix call of dbus-error signal.
(dbus-register-property): Use `dont-register' keyword.
2011-01-10 Jan Moringen <jan.moringen@uni-bielefeld.de>
* net/dbus.el (dbus-unregister-service): Translate returned
integer into a symbol.
(dbus-register-property): Use `dbus-register-service' to do the
name registration.
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* progmodes/idlw-help.el (idlwave-help-link): Inherit from link face.
Suggested by Joakim Verona.
* comint.el (comint-highlight-prompt): Inherit minibuffer-prompt.
* wid-edit.el (visibility): Replace :on-image and :off-image
widget properties with :on-glyph and :off-glyph, for consistency
with the `visibility' widget.
(widget-toggle-value-create, widget-visibility-value-create):
Merge into a single function `widget-toggle-value-create'.
* cus-edit.el (custom-variable-value-create, custom-visibility)
(custom-face-edit-value-create, custom-face-value-create):
Replace :on-image and :off-image widget properties with :on-glyph and
:off-glyph, for consistency with the `visibility' widget.
2011-01-09 Andreas Schwab <schwab@linux-m68k.org>
* net/ldap.el (ldap-search-internal): Don't use eval.
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* subr.el (read-char-choice): Use read-key.
* custom.el (custom-safe-themes): Rename from
custom-safe-theme-files. Add :risky tag.
(load-theme, custom-theme-load-confirm): Save sha1 hashes to
custom-safe-themes, not filenames. Suggested by Stefan Monnier.
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* tool-bar.el (tool-bar-setup): Remove Help button. Remove label
from Search and add a label to Undo.
* vc/vc-dir.el (vc-dir-tool-bar-map): Rearrange, removing
inappropriate buttons and adding :vert-only tags.
* progmodes/compile.el (compilation-mode-tool-bar-map): Adjust to
removal of Help tool-bar button. Remove Undo button for space.
* info.el (info-tool-bar-map): Add :vert-only tags.
2011-01-08 Tassilo Horn <tassilo@member.fsf.org>
* doc-view.el (doc-view-mode-p): Check for png or imagemagick
image backend support. Either of them is fine.
2011-01-08 Chong Yidong <cyd@stupidchicken.com>
* subr.el (y-or-n-p): Doc fix.
* custom.el (custom-safe-theme-files): New defcustom.
(custom-theme-load-confirm): New function.
(load-theme): Load theme using `load', confirming with
@ -97,7 +220,7 @@
2011-01-04 Jan Moringen <jan.moringen@uni-bielefeld.de>
* net/dbus.el (dbus-register-property): Added optional parameter
* net/dbus.el (dbus-register-property): Add optional parameter
dont-register-service. Updated docstring accordingly.
2011-01-04 Andreas Schwab <schwab@linux-m68k.org>
@ -266,8 +389,8 @@
2010-12-30 Tassilo Horn <tassilo@member.fsf.org>
* doc-view.el (doc-view-mode, doc-view-toggle-display): Use
normal-mode without doc-view-mode bindings in auto-mode-alist as
* doc-view.el (doc-view-mode, doc-view-toggle-display):
Use normal-mode without doc-view-mode bindings in auto-mode-alist as
fallback instead of hard coding fundamental mode.
2010-12-30 Tassilo Horn <tassilo@member.fsf.org>
@ -462,8 +585,8 @@
2010-12-16 Leo <sdl.web@gmail.com>
* eshell/eshell.el (eshell-directory-name): Use
locate-user-emacs-file (Bug#7578).
* eshell/eshell.el (eshell-directory-name):
Use locate-user-emacs-file (Bug#7578).
2010-12-15 Glenn Morris <rgm@gnu.org>
@ -488,8 +611,8 @@
(tramp-handle-insert-file-contents): Do not set permanent-local
property.
* net/tramp-cache.el (tramp-persistency-file-name): Use
`locate-user-emacs-file' if fboundp.
* net/tramp-cache.el (tramp-persistency-file-name):
Use `locate-user-emacs-file' if fboundp.
* net/tramp-sh.el (tramp-methods): Add "ksu".
(tramp-default-user-alist): Add "ksu". Use `regexp-opt' for

17
lisp/allout.el
View file

@ -1,12 +1,12 @@
;;; allout.el --- extensive outline mode for use alone and with other modes
;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
;; Created: Dec 1991 -- first release to usenet
;; Version: 2.2.2
;; Version: 2.3
;; Keywords: outlines wp languages
;; Website: http://myriadicity.net/Sundry/EmacsAllout
@ -569,7 +569,7 @@ themselves:
`!' - exclamation point/bang -- emphatic
`[' - open square bracket -- meta-note, about item instead of item's subject
`\"' - double quote -- a quotation or other citation
`=' - equal sign -- an assignement, equating a name with some connotation
`=' - equal sign -- an assignment, some kind of definition
`^' - carat -- relates to something above
Some are more elusive, but their rationale may be recognizable:
@ -891,7 +891,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring."
;;;_ #1 Internal Outline Formatting and Configuration
;;;_ : Version
;;;_ = allout-version
(defvar allout-version "2.2.2"
(defvar allout-version "2.3"
"Version of currently loaded outline package. (allout.el)")
;;;_ > allout-version
(defun allout-version (&optional here)
@ -6226,10 +6226,11 @@ signal."
(epg-decrypt-string epg-context
(encode-coding-string massaged-text
(or encoding 'utf-8)))
(epg-encrypt-string epg-context
(encode-coding-string massaged-text
(or encoding 'utf-8))
recipients)))
(replace-regexp-in-string "\n$" ""
(epg-encrypt-string epg-context
(encode-coding-string massaged-text
(or encoding 'utf-8))
recipients))))
;; validate result -- non-empty
(if (not result-text)

5
lisp/calendar/diary-lib.el
View file

@ -1,7 +1,7 @@
;;; diary-lib.el --- diary functions
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@ -2346,6 +2346,9 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
'(diary-font-lock-keywords t))
(add-to-invisibility-spec '(diary . nil))
(add-hook 'after-save-hook 'diary-redraw-calendar nil t)
;; In case the file was modified externally, refresh the calendar
;; after refreshing the diary buffer.
(add-hook 'after-revert-hook 'diary-redraw-calendar nil t)
(if diary-header-line-flag
(setq header-line-format diary-header-line-format)))

4
lisp/comint.el
View file

@ -227,9 +227,7 @@ This variable is buffer-local."
:group 'comint)
(defface comint-highlight-prompt
'((((min-colors 88) (background dark)) (:foreground "cyan1"))
(((background dark)) (:foreground "cyan"))
(t (:foreground "dark blue")))
'((t :inherit minibuffer-prompt))
"Face to use to highlight prompts."
:group 'comint)

20
lisp/cus-edit.el
View file

@ -2551,9 +2551,9 @@ try matching its doc string against `custom-guess-doc-alist'."
(push (widget-create-child-and-convert
widget 'custom-visibility
:help-echo "Show the value of this option."
:on-image "down"
:on-glyph "down"
:on "Hide"
:off-image "right"
:off-glyph "right"
:off "Show Value"
:action 'custom-toggle-hide-variable
nil)
@ -2573,8 +2573,8 @@ try matching its doc string against `custom-guess-doc-alist'."
:help-echo "Hide the value of this option."
:on "Hide"
:off "Show"
:on-image "down"
:off-image "right"
:on-glyph "down"
:off-glyph "right"
:action 'custom-toggle-hide-variable
t)
buttons)
@ -2603,8 +2603,8 @@ try matching its doc string against `custom-guess-doc-alist'."
:help-echo "Hide or show this option."
:on "Hide"
:off "Show"
:on-image "down"
:off-image "right"
:on-glyph "down"
:off-glyph "right"
:action 'custom-toggle-hide-variable
t)
buttons)
@ -3056,8 +3056,8 @@ to switch between two values."
:pressed-face 'custom-visibility
:mouse-face 'highlight
:pressed-face 'highlight
:on-image nil
:off-image nil)
:on-glyph nil
:off-glyph nil)
(defface custom-visibility
'((t :height 0.8 :inherit link))
@ -3120,7 +3120,7 @@ face attributes (as specified by a `default' defface entry)."
:pressed-face 'custom-visibility
:mouse-face 'highlight
:on "Hide Unused Attributes" :off "Show All Attributes"
:on-image nil :off-image nil
:on-glyph nil :off-glyph nil
:always-active t
:action 'custom-face-edit-value-visibility-action
show-all)
@ -3475,7 +3475,7 @@ the present value is saved to its :shown-value property instead."
widget 'custom-visibility
:help-echo "Hide or show this face."
:on "Hide" :off "Show"
:on-image "down" :off-image "right"
:on-glyph "down" :off-glyph "right"
:action 'custom-toggle-hide-face
(not hiddenp))
buttons)

136
lisp/custom.el
View file

@ -1105,14 +1105,16 @@ property `theme-feature' (which is usually a symbol created by
(let ((custom-enabling-themes t))
(enable-theme 'user))))
(defcustom custom-safe-theme-files '(default)
"List of theme files that are considered safe to load.
Each list element should be either an absolute file name, or the
symbol `default', which stands for the built-in Emacs theme
directory (a directory named \"themes\" in `data-directory'."
(defcustom custom-safe-themes '(default)
"List of themes that are considered safe to load.
Each list element should be the `sha1' hash of a theme file, or
the symbol `default', which stands for any theme in the built-in
Emacs theme directory (a directory named \"themes\" in
`data-directory')."
:type '(repeat
(choice file (const :tag "Built-in theme directory" default)))
(choice string (const :tag "Built-in themes" default)))
:group 'customize
:risky t
:version "24.1")
(defvar safe-functions) ; From unsafep.el
@ -1140,74 +1142,74 @@ in one of the directories specified by `custom-theme-load-path'."
(put theme 'theme-documentation nil))
(let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
'("" "c"))))
'("" "c")))
hash)
(unless fn
(error "Unable to find theme file for `%s'." theme))
;; Check file safety.
(when (or (and (memq 'default custom-safe-theme-files)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
(member fn custom-safe-theme-files)
;; If the file is not in the builtin theme directory or
;; in `custom-safe-theme-files', check it with unsafep.
(with-temp-buffer
(require 'unsafep)
(insert-file-contents fn)
(let ((safe-functions (append '(provide-theme deftheme
custom-theme-set-variables
custom-theme-set-faces)
safe-functions))
unsafep form)
(while (and (setq form (condition-case nil
(let ((read-circle nil))
(read (current-buffer)))
(end-of-file nil)))
(null (setq unsafep (unsafep form)))))
(or (null unsafep)
(custom-theme-load-confirm fn)))))
(let ((custom--inhibit-theme-enable no-enable))
(load fn)))))
(with-temp-buffer
(insert-file-contents fn)
(setq hash (sha1 (current-buffer)))
;; Check file safety.
(when (or (and (memq 'default custom-safe-themes)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
(member hash custom-safe-themes)
;; If the theme is not in `custom-safe-themes', check
;; it with unsafep.
(progn
(require 'unsafep)
(let ((safe-functions
(append '(provide-theme deftheme
custom-theme-set-variables
custom-theme-set-faces)
safe-functions))
unsafep form)
(while (and (setq form (condition-case nil
(let ((read-circle nil))
(read (current-buffer)))
(end-of-file nil)))
(null (setq unsafep (unsafep form)))))
(or (null unsafep)
(custom-theme-load-confirm hash)))))
(let ((custom--inhibit-theme-enable no-enable))
(eval-buffer))))))
(defun custom-theme-load-confirm (filename)
(defun custom-theme-load-confirm (hash)
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
query also about adding HASH to `custom-safe-themes'."
(if noninteractive
nil
(let ((existing-buffer (find-buffer-visiting filename))
(exit-chars '(?y ?n ?\s ?\C-g))
(let ((exit-chars '(?y ?n ?\s))
prompt char)
(save-window-excursion
(if existing-buffer
(pop-to-buffer existing-buffer)
(find-file filename))
(unwind-protect
(progn
(setq prompt
(format "This theme is not guaranteed to be safe. Really load? %s"
(if (< (line-number-at-pos (point-max))
(window-body-height))
"(y or n) "
(push ?\C-v exit-chars)
"Type y or n, or C-v to scroll: ")))
(goto-char (point-min))
(while (null char)
(setq char (read-char-choice prompt exit-chars t))
(when (eq char ?\C-v)
(condition-case nil
(scroll-up)
(error (goto-char (point-min))))
(setq char nil)))
(when (memq char '(?\s ?y))
(push filename custom-safe-theme-files)
;; Offer to save to `custom-safe-theme-files'.
(and (or custom-file user-init-file)
(y-or-n-p "Treat %s as safe for future loads? "
(file-name-nondirectory filename))
(let ((coding-system-for-read nil))
(customize-save-variable
'custom-safe-theme-files
custom-safe-theme-files)))
t))
;; Unwind form.
(unless existing-buffer (kill-buffer)))))))
(rename-buffer "*Custom Theme*" t)
(emacs-lisp-mode)
(display-buffer (current-buffer))
(setq prompt
(format "This theme is not guaranteed to be safe. Really load? %s"
(if (< (line-number-at-pos (point-max))
(window-body-height))
"(y or n) "
(push ?\C-v exit-chars)
"Type y or n, or C-v to scroll: ")))
(goto-char (point-min))
(while (null char)
(setq char (read-char-choice prompt exit-chars))
(when (eq char ?\C-v)
(condition-case nil
(scroll-up)
(error (goto-char (point-min))))
(setq char nil)))
(when (memq char '(?\s ?y))
(push hash custom-safe-themes)
;; Offer to save to `custom-safe-themes'.
(and (or custom-file user-init-file)
(y-or-n-p "Treat this theme as safe for future loads? ")
(let ((coding-system-for-read nil))
(customize-save-variable 'custom-safe-themes
custom-safe-themes)))
t)))))
(defun custom-theme-name-valid-p (name)
"Return t if NAME is a valid name for a Custom theme, nil otherwise.

3
lisp/doc-view.el
View file

@ -621,7 +621,8 @@ It's a subdirectory of `doc-view-cache-directory'."
Document types are symbols like `dvi', `ps', `pdf', or `odf' (any
OpenDocument format)."
(and (display-graphic-p)
(image-type-available-p 'png)
(or (image-type-available-p 'imagemagick)
(image-type-available-p 'png))
(cond
((eq type 'dvi)
(and (doc-view-mode-p 'pdf)

3
lisp/emacs-lisp/unsafep.el
View file

@ -202,6 +202,9 @@ UNSAFEP-VARS is a list of symbols with local bindings."
(dolist (x (nthcdr 3 form))
(setq reason (unsafep-progn (cdr x)))
(if reason (throw 'unsafep reason))))))
((eq fun '\`)
;; Backquoted form - safe if its expansion is.
(unsafep (cdr (backquote-process (cadr form)))))
(t
;;First unsafep-function call above wasn't nil, no special case applies
reason)))))

2
lisp/files.el
View file

@ -57,7 +57,7 @@ when it has unsaved changes."
A list of elements of the form (FROM . TO), each meaning to replace
FROM with TO when it appears in a directory name. This replacement is
done when setting up the default directory of a newly visited file.
*Every* FROM string should start with \"\\\\`\".
*Every* FROM string ought to start with \"\\\\`\".
FROM and TO should be equivalent names, which refer to the
same directory. Do not use `~' in the TO strings;

19
lisp/gnus/ChangeLog
View file

@ -1,3 +1,22 @@
2011-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-convert-partial-article): Protect against
zero-length body parts.
* mm-decode.el (mm-preferred-alternative-precedence): Discourage
showing empty parts.
* gnus-int.el (gnus-request-accept-article): Don't try to update marks
and stuff if the backend didn't return the article number. This fixes
an Exchange-related nnimap bug.
* gnus-sum.el (gnus-summary-next-article): Remove hack to reselect
group window, because it does the wrong thing when a separate frame
displays the group buffer.
* proto-stream.el (open-protocol-stream): Protect against the low-level
transport functions returning nil.
2011-01-07 Daiki Ueno <ueno@unixuser.org>
* mml2015.el (epg-sub-key-fingerprint): Autoload.

6
lisp/gnus/gnus-int.el
View file

@ -1,7 +1,7 @@
;;; gnus-int.el --- backend interface functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@ -711,7 +711,9 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(if (stringp group) (gnus-group-real-name group) group)
(cadr gnus-command-method)
last)))
(when (and gnus-agent (gnus-agent-method-p gnus-command-method))
(when (and gnus-agent
(gnus-agent-method-p gnus-command-method)
(cdr result))
(gnus-agent-regenerate-group group (list (cdr result))))
result))

3
lisp/gnus/gnus-sum.el
View file

@ -7687,9 +7687,6 @@ If BACKWARD, the previous article is selected instead of the next."
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
;; For some reason, the group window gets selected. We change
;; it back.
(select-window (get-buffer-window (current-buffer)))
;; Select next unread newsgroup automagically.
(cond
((or (not gnus-auto-select-next)

21
lisp/gnus/mm-decode.el
View file

@ -1,7 +1,7 @@
;;; mm-decode.el --- Functions for decoding MIME things
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@ -1367,13 +1367,18 @@ Use CMD as the process."
(defun mm-preferred-alternative-precedence (handles)
"Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
(let ((seq (nreverse (mapcar #'mm-handle-media-type
handles))))
(dolist (disc (reverse mm-discouraged-alternatives))
(dolist (elem (copy-sequence seq))
(when (string-match disc elem)
(setq seq (nconc (delete elem seq) (list elem))))))
seq))
(setq handles (reverse handles))
(dolist (disc (reverse mm-discouraged-alternatives))
(dolist (handle (copy-sequence handles))
(when (string-match disc (mm-handle-media-type handle))
(setq handles (nconc (delete handle handles) (list handle))))))
;; Remove empty parts.
(dolist (handle (copy-sequence handles))
(unless (with-current-buffer (mm-handle-buffer handle)
(goto-char (point-min))
(re-search-forward "[^ \t\n]" nil t))
(setq handles (nconc (delete handle handles) (list handle)))))
(mapcar #'mm-handle-media-type handles))
(defun mm-get-content-id (id)
"Return the handle(s) referred to by ID."

2
lisp/gnus/nnimap.el
View file

@ -582,7 +582,7 @@ textual parts.")
;; Collect all the body parts.
(while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]")
(setq id (match-string 1)
bytes (nnimap-get-length))
bytes (or (nnimap-get-length) 0))
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point)))
(push (list id (buffer-substring (point) (+ (point) bytes)))

21
lisp/gnus/proto-stream.el
View file

@ -1,6 +1,6 @@
;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
@ -101,14 +101,17 @@ command to switch on STARTTLS otherwise."
(setq type 'network))
((eq type 'ssl)
(setq type 'tls)))
(destructuring-bind (stream greeting capabilities)
(funcall (intern (format "proto-stream-open-%s" type) obarray)
name buffer host service parameters)
(list (and stream
(memq (process-status stream)
'(open run))
stream)
greeting capabilities))))
(let ((open-result
(funcall (intern (format "proto-stream-open-%s" type) obarray)
name buffer host service parameters)))
(if (null open-result)
(list nil nil nil)
(destructuring-bind (stream greeting capabilities) open-result
(list (and stream
(memq (process-status stream)
'(open run))
stream)
greeting capabilities))))))
(defun proto-stream-open-network-only (name buffer host service parameters)
(let ((start (with-current-buffer buffer (point)))

11
lisp/info.el
View file

@ -3777,13 +3777,16 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map
:vert-only t)
(define-key-after map [separator-2] menu-bar-separator)
(tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map
:vert-only t)
(tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map)
(define-key-after map [separator-3] menu-bar-separator)
(tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map
:label "Index Search")
(tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map)
(tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map)
:label "Index")
(tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
:vert-only t)
(tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
:vert-only t)
map))
(defvar Info-menu-last-node nil)

43
lisp/net/dbus.el
View file

@ -183,7 +183,18 @@ association to the service from D-Bus."
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address. SERVICE must be a known service name."
denoting the bus address. SERVICE must be a known service name.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
`:released': Service has become the primary owner of the name.
`:non-existent': Service name does not exist on this bus.
`:not-owner': We are neither the primary owner nor waiting in the
queue of this service."
(maphash
(lambda (key value)
(dolist (elt value)
@ -193,9 +204,14 @@ denoting the bus address. SERVICE must be a known service name."
(puthash key (delete elt value) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table))))))
dbus-registered-objects-table)
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"ReleaseName" service))
(let ((reply (dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"ReleaseName" service)))
(case reply
(1 :released)
(2 :non-existent)
(3 :not-owner)
(t (signal 'dbus-error (list "Could not unregister service" service))))))
(defun dbus-call-method-non-blocking-handler (&rest args)
"Handler for reply messages of asynchronous D-Bus message calls.
@ -914,17 +930,20 @@ clients from discovering the still incomplete interface."
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"RequestName" service 0))
;; Add the handler. We use `dbus-service-emacs' as service name, in
;; order to let unregister SERVICE despite of this default handler.
;; Add handlers for the three property-related methods.
(dbus-register-method
bus service path dbus-interface-properties "Get" 'dbus-property-handler
dont-register-service)
bus service path dbus-interface-properties "Get"
'dbus-property-handler 'dont-register)
(dbus-register-method
bus service path dbus-interface-properties "GetAll" 'dbus-property-handler
dont-register-service)
bus service path dbus-interface-properties "GetAll"
'dbus-property-handler 'dont-register)
(dbus-register-method
bus service path dbus-interface-properties "Set" 'dbus-property-handler
dont-register-service)
bus service path dbus-interface-properties "Set"
'dbus-property-handler 'dont-register)
;; Register the name SERVICE with BUS.
(unless dont-register-service
(dbus-register-service bus service))
;; Send the PropertiesChanged signal.
(when emits-signal

12
lisp/net/ldap.el
View file

@ -1,7 +1,7 @@
;;; ldap.el --- client interface to LDAP for Emacs
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
;; Maintainer: FSF
@ -556,13 +556,9 @@ an alist of attribute/value pairs."
(if (and sizelimit
(not (equal "" sizelimit)))
(setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
(eval `(call-process ldap-ldapsearch-prog
nil
buf
nil
,@arglist
,@ldap-ldapsearch-args
,@filter))
(apply #'call-process ldap-ldapsearch-prog
nil buf nil
(append arglist ldap-ldapsearch-args filter))
(insert "\n")
(goto-char (point-min))

5
lisp/org/ChangeLog
View file

@ -1,3 +1,8 @@
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* org-faces.el (org-link): Inherit from link face.
Suggested by Joakim Verona.
2010-12-11 Tassilo Horn <tassilo@member.fsf.org>
* org-footnote.el (org-footnote-create-definition): Place

6
lisp/org/org-faces.el
View file

@ -1,6 +1,6 @@
;;; org-faces.el --- Face definitions for Org-mode.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
@ -247,9 +247,7 @@ column view defines special faces for each outline level. See the file
:group 'org-faces)
(defface org-link
'((((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t)))
'((t :inherit link))
"Face for links."
:group 'org-faces)

10
lisp/progmodes/compile.el
View file

@ -1569,9 +1569,11 @@ Returns the compilation buffer created."
(defvar compilation-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
(when (keymapp (butlast tool-bar-map))
(let ((map (butlast (copy-keymap tool-bar-map)))
(help (last tool-bar-map))) ;; Keep Help last in tool bar
(when (keymapp tool-bar-map)
(let ((map (copy-keymap tool-bar-map)))
(define-key map [undo] nil)
(define-key map [separator-2] nil)
(define-key-after map [separator-compile] menu-bar-separator)
(tool-bar-local-item
"left-arrow" 'previous-error-no-select 'previous-error-no-select map
:rtl "right-arrow"
@ -1588,7 +1590,7 @@ Returns the compilation buffer created."
(tool-bar-local-item
"refresh" 'recompile 'recompile map
:help "Restart compilation")
(append map help))))
map)))
(put 'compilation-mode 'mode-class 'special)

5
lisp/progmodes/idlw-help.el
View file

@ -1,7 +1,7 @@
;;; idlw-help.el --- HTML Help code for IDLWAVE
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; 2009, 2010, 2011 Free Software Foundation, Inc.
;;
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@ -195,8 +195,7 @@ support."
:type 'string)
(defface idlwave-help-link
'((((class color)) (:foreground "Blue"))
(t (:weight bold)))
'((t :inherit link))
"Face for highlighting links into IDLWAVE online help."
:group 'idlwave-online-help)

4260
lisp/progmodes/prolog.el
View file

File diff suppressed because it is too large Load diff

44
lisp/subr.el
View file

@ -1,7 +1,7 @@
;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -60,7 +60,7 @@ function-definitions that `check-declare' does not recognize, e.g.
`defstruct'.
To specify a value for FILEONLY without passing an argument list,
set ARGLIST to `t'. This is necessary because `nil' means an
set ARGLIST to t. This is necessary because nil means an
empty argument list, rather than an unspecified one.
Note that for the purposes of `check-declare', this statement
@ -483,6 +483,7 @@ saving keyboard macros (see `edmacro-mode')."
(read-kbd-macro keys))
(defun undefined ()
"Beep to tell the user this binding is undefined."
(interactive)
(ding))
@ -1599,11 +1600,7 @@ extension for a compressed format \(e.g. \".gz\") on FILE will not affect
this name matching.
Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
is evaluated whenever that feature is `provide'd. Note that although
provide statements are usually at the end of files, this is not always
the case (e.g., sometimes they are at the start to avoid a recursive
load error). If your FORM should not be evaluated until the code in
FILE has been, do not use the symbol form for FILE in such cases.
is evaluated at the end of any file that `provide's this feature.
Usually FILE is just a library name like \"font-lock\" or a feature name
like 'font-lock.
@ -1612,11 +1609,27 @@ This function makes or adds to an entry on `after-load-alist'."
;; Add this FORM into after-load-alist (regardless of whether we'll be
;; evaluating it now).
(let* ((regexp-or-feature
(if (stringp file) (setq file (purecopy (load-history-regexp file))) file))
(if (stringp file)
(setq file (purecopy (load-history-regexp file)))
file))
(elt (assoc regexp-or-feature after-load-alist)))
(unless elt
(setq elt (list regexp-or-feature))
(push elt after-load-alist))
(when (symbolp regexp-or-feature)
;; For features, the after-load-alist elements get run when `provide' is
;; called rather than at the end of the file. So add an indirection to
;; make sure that `form' is really run "after-load" in case the provide
;; call happens early.
(setq form
`(when load-file-name
(let ((fun (make-symbol "eval-after-load-helper")))
(fset fun `(lambda (file)
(if (not (equal file ',load-file-name))
nil
(remove-hook 'after-load-functions ',fun)
,',form)))
(add-hook 'after-load-functions fun)))))
;; Add FORM to the element unless it's already there.
(unless (member form (cdr elt))
(nconc elt (purecopy (list form))))
@ -1872,7 +1885,7 @@ This function echoes `.' for each character that the user types.
The user ends with RET, LFD, or ESC. DEL or C-h rubs out.
C-y yanks the current kill. C-u kills line.
C-g quits; if `inhibit-quit' was non-nil around this function,
then it returns nil if the user types C-g, but quit-flag remains set.
then it returns nil if the user types C-g, but `quit-flag' remains set.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
@ -1985,7 +1998,7 @@ keyboard-quit events while waiting for a valid input."
(unless (get-text-property 0 'face prompt)
(setq prompt (propertize prompt 'face 'minibuffer-prompt)))
(setq char (let ((inhibit-quit inhibit-keyboard-quit))
(read-event prompt)))
(read-key prompt)))
(cond
((not (numberp char)))
((memq char chars)
@ -2043,8 +2056,11 @@ floating point support."
(defun y-or-n-p (prompt &rest args)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
The argument PROMPT is the string to display to ask the question.
It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
The string to display to ask the question is obtained by
formatting the string PROMPT with arguments ARGS (see `format').
The result should end in a space; `y-or-n-p' adds \"(y or n) \"
to it.
No confirmation of the answer is requested; a single character is enough.
Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
the bindings in `query-replace-map'; see the documentation of that variable
@ -2493,7 +2509,7 @@ Replaces `category' properties with their defined properties."
(defvar yank-undo-function)
(defun insert-for-yank (string)
"Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
"Call `insert-for-yank-1' repetitively for each `yank-handler' segment.
See `insert-for-yank-1' for more details."
(let (to)
@ -3177,7 +3193,7 @@ is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function, it is called with the actual text of each
match, and its value is used as the replacement text. When REP is called,
the match-data are the result of matching REGEXP against a substring
the match data are the result of matching REGEXP against a substring
of STRING.
To replace only the first match (if any), make REGEXP match up to \\'

25
lisp/tool-bar.el
View file

@ -254,7 +254,7 @@ holds a keymap."
(tool-bar-add-item-from-menu 'save-buffer "save" nil
:label "Save")
(define-key-after (default-value 'tool-bar-map) [separator-1] menu-bar-separator)
(tool-bar-add-item-from-menu 'undo "undo" nil :vert-only t)
(tool-bar-add-item-from-menu 'undo "undo" nil)
(define-key-after (default-value 'tool-bar-map) [separator-2] menu-bar-separator)
(tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut])
"cut" nil :vert-only t)
@ -263,25 +263,22 @@ holds a keymap."
(tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
"paste" nil :vert-only t)
(define-key-after (default-value 'tool-bar-map) [separator-3] menu-bar-separator)
(tool-bar-add-item-from-menu 'nonincremental-search-forward "search"
nil :label "Search")
(tool-bar-add-item-from-menu 'isearch-forward "search"
nil :label "Search" :vert-only t)
;;(tool-bar-add-item-from-menu 'ispell-buffer "spell")
;; There's no icon appropriate for News and we need a command rather
;; than a lambda for Read Mail.
;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose")
;; tool-bar-add-item-from-menu itself operates on
;; (default-value 'tool-bar-map), but when we don't use that function,
;; we must explicitly operate on the default value.
(let ((tool-bar-map (default-value 'tool-bar-map)))
(tool-bar-add-item "help" (lambda ()
(interactive)
(popup-menu menu-bar-help-menu))
'help
:help "Pop up the Help menu")))
;; Help button on a tool bar is rather non-standard...
;; (let ((tool-bar-map (default-value 'tool-bar-map)))
;; (tool-bar-add-item "help" (lambda ()
;; (interactive)
;; (popup-menu menu-bar-help-menu))
;; 'help
;; :help "Pop up the Help menu"))
)
(if (featurep 'move-toolbar)
(defcustom tool-bar-position 'top

53
lisp/vc/vc-dir.el
View file

@ -196,7 +196,7 @@ See `run-hooks'."
'(menu-item "Show Incoming Log" vc-log-incoming
:help "Show a log of changes that will be received with a pull operation"))
(define-key map [log]
'(menu-item "Show history" vc-print-log
'(menu-item "Show History" vc-print-log
:help "List the change log of the current file set in a window"))
(define-key map [rlog]
'(menu-item "Show Top of the Tree History " vc-print-root-log
@ -307,33 +307,36 @@ If BODY uses EVENT, it should be a variable,
(defvar vc-dir-tool-bar-map
(let ((map (make-sparse-keymap)))
(tool-bar-local-item-from-menu 'vc-dir-find-file "open"
map vc-dir-mode-map)
(tool-bar-local-item "bookmark_add"
'vc-dir-toggle-mark 'vc-dir-toggle-mark map
:help "Toggle mark on current item"
:label "Toggle Mark")
(tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow"
map vc-dir-mode-map
:rtl "right-arrow")
(tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow"
map vc-dir-mode-map
:rtl "left-arrow")
(tool-bar-local-item-from-menu 'find-file "new" map nil
:label "New File" :vert-only t)
(tool-bar-local-item-from-menu 'menu-find-file-existing "open" map nil
:label "Open" :vert-only t)
(tool-bar-local-item-from-menu 'dired "diropen" map nil
:vert-only t)
(tool-bar-local-item-from-menu 'quit-window "close" map vc-dir-mode-map
:vert-only t)
(tool-bar-local-item-from-menu 'vc-next-action "saveas" map
vc-dir-mode-map :label "Commit")
(tool-bar-local-item-from-menu 'vc-print-log "info"
map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'revert-buffer "refresh"
map vc-dir-mode-map)
(tool-bar-local-item-from-menu 'nonincremental-search-forward
"search" map nil
:label "Search")
(tool-bar-local-item-from-menu 'vc-dir-query-replace-regexp
"search-replace" map vc-dir-mode-map
:label "Replace")
map vc-dir-mode-map
:label "Log")
(define-key-after map [separator-1] menu-bar-separator)
(tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
map vc-dir-mode-map
:label "Cancel")
(tool-bar-local-item-from-menu 'quit-window "exit"
map vc-dir-mode-map)
:label "Stop" :vert-only t)
(tool-bar-local-item-from-menu 'revert-buffer "refresh"
map vc-dir-mode-map :vert-only t)
(define-key-after map [separator-2] menu-bar-separator)
(tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [cut])
"cut" map nil :vert-only t)
(tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [copy])
"copy" map nil :vert-only t)
(tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [paste])
"paste" map nil :vert-only t)
(define-key-after map [separator-3] menu-bar-separator)
(tool-bar-local-item-from-menu 'isearch-forward
"search" map nil
:label "Search" :vert-only t)
map))
(defun vc-dir-node-directory (node)

44
lisp/wid-edit.el
View file

@ -2162,21 +2162,13 @@ when he invoked the menu."
(defun widget-toggle-value-create (widget)
"Insert text representing the `on' and `off' states."
(if (widget-value widget)
(let ((image (widget-get widget :on-glyph)))
(and (display-graphic-p)
(listp image)
(not (eq (car image) 'image))
(widget-put widget :on-glyph (setq image (eval image))))
(widget-image-insert widget
(widget-get widget :on)
image))
(let ((image (widget-get widget :off-glyph)))
(and (display-graphic-p)
(listp image)
(not (eq (car image) 'image))
(widget-put widget :off-glyph (setq image (eval image))))
(widget-image-insert widget (widget-get widget :off) image))))
(let* ((val (widget-value widget))
(text (widget-get widget (if val :on :off)))
(img (widget-image-find
(widget-get widget (if val :on-glyph :off-glyph)))))
(widget-image-insert widget (or text "")
(if img
(append img '(:ascent center))))))
(defun widget-toggle-action (widget &optional event)
;; Toggle value.
@ -2816,34 +2808,22 @@ Return an alist of (TYPE MATCH)."
"An indicator and manipulator for hidden items.
The following properties have special meanings for this widget:
:on-image Image filename or spec to display when the item is visible.
:on-glyph Image filename or spec to display when the item is visible.
:on Text shown if the \"on\" image is nil or cannot be displayed.
:off-image Image filename or spec to display when the item is hidden.
:off-glyph Image filename or spec to display when the item is hidden.
:off Text shown if the \"off\" image is nil cannot be displayed."
:format "%[%v%]"
:button-prefix ""
:button-suffix ""
:on-image "down"
:on-glyph "down"
:on "Hide"
:off-image "right"
:off-glyph "right"
:off "Show"
:value-create 'widget-visibility-value-create
:action 'widget-toggle-action
:match (lambda (widget value) t))
(defun widget-visibility-value-create (widget)
;; Insert text representing the `on' and `off' states.
(let* ((val (widget-value widget))
(text (widget-get widget (if val :on :off)))
(img (widget-image-find
(widget-get widget (if val :on-image :off-image)))))
(widget-image-insert widget
(if text
(concat widget-push-button-prefix text
widget-push-button-suffix)
"")
(if img
(append img '(:ascent center))))))
(defalias 'widget-visibility-value-create 'widget-toggle-value-create)
;;; The `documentation-link' Widget.
;;

42
src/ChangeLog
View file

@ -1,4 +1,4 @@
2011-01-09 Paul Eggert <eggert@cs.ucla.edu>
2011-01-11 Paul Eggert <eggert@cs.ucla.edu>
Give a name FLOAT_TO_STRING_BUFSIZE to the constant 350.
* lisp.h (FLOAT_TO_STRING_BUFSIZE): New macro.
@ -27,14 +27,50 @@
(float_to_string): Use dtoastr rather than rolling our own code,
which had an off-by-one bug on non-IEEE hosts.
2011-01-08 Paul Eggert <eggert@cs.ucla.edu>
Automate syncing from gnulib.
* Makefile.in (lib): New macro.
(ALL_CFLAGS): Add -I$(lib) -I$(srcdir)/../lib.
($(lib)/libgnu.a): New rule.
(temacs$(EXEEXT)): Also link $(lib)/libgnu.a.
2011-01-11 Tassilo Horn <tassilo@member.fsf.org>
* image.c (imagemagick_load_image, Finit_image_library): Free
intermediate image after creating a MagickWand from it. Terminate
MagickWand environment after image loading.
2011-01-10 Michael Albinus <michael.albinus@gmx.de>
* dbusbind.c (Fdbus_register_service): Raise an error in case of
unexpected return values.
(Fdbus_register_method): Remove connection initialization.
2011-01-10 Jan Moringen <jan.moringen@uni-bielefeld.de>
* dbusbind.c (QCdbus_request_name_allow_replacement): New symbol;
used by Fdbus_register_service.
(QCdbus_request_name_replace_existing): Likewise.
(QCdbus_request_name_do_not_queue): Likewise.
(QCdbus_request_name_reply_primary_owner): Likewise.
(QCdbus_request_name_reply_in_queue): Likewise.
(QCdbus_request_name_reply_exists): Likewise.
(QCdbus_request_name_reply_already_owner): Likewise.
(Fdbus_register_service): New function.
(Fdbus_register_method): Use Fdbus_register_service to do the name
registration.
(syms_of_dbusbind): Add symbols dbus-register-service,
:allow-replacement, :replace-existing, :do-not-queue,
:primary-owner, :existing, :in-queue and :already-owner.
2011-01-09 Chong Yidong <cyd@stupidchicken.com>
* gtkutil.c (update_frame_tool_bar): Don't advance tool-bar index
when removing extra buttons.
2011-01-08 Chong Yidong <cyd@stupidchicken.com>
* fns.c (Fyes_or_no_p): Doc fix.
2011-01-08 Andreas Schwab <schwab@linux-m68k.org>
* fns.c (Fyes_or_no_p): Add usage.

164
src/dbusbind.c
View file

@ -38,6 +38,7 @@ Lisp_Object Qdbus_call_method_asynchronously;
Lisp_Object Qdbus_method_return_internal;
Lisp_Object Qdbus_method_error_internal;
Lisp_Object Qdbus_send_signal;
Lisp_Object Qdbus_register_service;
Lisp_Object Qdbus_register_signal;
Lisp_Object Qdbus_register_method;
@ -50,6 +51,17 @@ Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
/* Lisp symbol for method call timeout. */
Lisp_Object QCdbus_timeout;
/* Lisp symbols for name request flags. */
Lisp_Object QCdbus_request_name_allow_replacement;
Lisp_Object QCdbus_request_name_replace_existing;
Lisp_Object QCdbus_request_name_do_not_queue;
/* Lisp symbols for name request replies. */
Lisp_Object QCdbus_request_name_reply_primary_owner;
Lisp_Object QCdbus_request_name_reply_in_queue;
Lisp_Object QCdbus_request_name_reply_exists;
Lisp_Object QCdbus_request_name_reply_already_owner;
/* Lisp symbols of D-Bus types. */
Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
@ -1835,6 +1847,114 @@ xd_read_queued_messages (int fd, void *data, int for_read)
xd_in_read_queued_messages = 0;
}
DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service,
2, MANY, 0,
doc: /* Register known name SERVICE on the D-Bus BUS.
BUS is either a Lisp symbol, `:system' or `:session', or a string
denoting the bus address.
SERVICE is the D-Bus service name that should be registered. It must
be a known name.
FLAGS are keywords, which control how the service name is registered.
The following keywords are recognized:
`:allow-replacement': Allow another service to become the primary
owner if requested.
`:replace-existing': Request to replace the current primary owner.
`:do-not-queue': If we can not become the primary owner do not place
us in the queue.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
`:primary-owner': Service has become the primary owner of the
requested name.
`:in-queue': Service could not become the primary owner and has been
placed in the queue.
`:exists': Service is already in the queue.
`:already-owner': Service is already the primary owner.
Example:
\(dbus-register-service :session dbus-service-emacs)
=> :primary-owner.
\(dbus-register-service
:session "org.freedesktop.TextEditor"
dbus-service-allow-replacement dbus-service-replace-existing)
=> :already-owner.
usage: (dbus-register-service BUS SERVICE &rest FLAGS) */)
(int nargs, register Lisp_Object *args)
{
Lisp_Object bus, service;
struct gcpro gcpro1, gcpro2;
DBusConnection *connection;
unsigned int i;
unsigned int value;
unsigned int flags = 0;
int result;
DBusError derror;
bus = args[0];
service = args[1];
/* Check parameters. */
CHECK_STRING (service);
/* Process flags. */
for (i = 2; i < nargs; ++i) {
value = ((EQ (args[i], QCdbus_request_name_replace_existing))
? DBUS_NAME_FLAG_REPLACE_EXISTING
: (EQ (args[i], QCdbus_request_name_allow_replacement))
? DBUS_NAME_FLAG_ALLOW_REPLACEMENT
: (EQ (args[i], QCdbus_request_name_do_not_queue))
? DBUS_NAME_FLAG_DO_NOT_QUEUE
: -1);
if (value == -1)
XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]);
flags |= value;
}
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
/* Request the known name from the bus. */
dbus_error_init (&derror);
result = dbus_bus_request_name (connection, SDATA (service), flags,
&derror);
if (dbus_error_is_set (&derror))
XD_ERROR (derror);
/* Cleanup. */
dbus_error_free (&derror);
/* Return object. */
switch (result)
{
case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER:
return QCdbus_request_name_reply_primary_owner;
case DBUS_REQUEST_NAME_REPLY_IN_QUEUE:
return QCdbus_request_name_reply_in_queue;
case DBUS_REQUEST_NAME_REPLY_EXISTS:
return QCdbus_request_name_reply_exists;
case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER:
return QCdbus_request_name_reply_already_owner;
default:
/* This should not happen. */
XD_SIGNAL2 (build_string ("Could not register service"), service);
}
}
DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal,
6, MANY, 0,
doc: /* Register for signal SIGNAL on the D-Bus BUS.
@ -2011,9 +2131,8 @@ discovering the still incomplete interface.*/)
Lisp_Object dont_register_service)
{
Lisp_Object key, key1, value;
DBusConnection *connection;
int result;
DBusError derror;
Lisp_Object args[2] = { bus, service };
/* Check parameters. */
CHECK_STRING (service);
@ -2025,21 +2144,9 @@ discovering the still incomplete interface.*/)
/* TODO: We must check for a valid service name, otherwise there is
a segmentation fault. */
/* Open a connection to the bus. */
connection = xd_initialize (bus, TRUE);
/* Request the known name from the bus. We can ignore the result,
it is set to -1 if there is an error - kind of redundancy. */
/* Request the name. */
if (NILP (dont_register_service))
{
dbus_error_init (&derror);
result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
if (dbus_error_is_set (&derror))
XD_ERROR (derror);
/* Cleanup. */
dbus_error_free (&derror);
}
Fdbus_register_service (2, args);
/* Create a hash table entry. We use nil for the unique name,
because the method might be called from anybody. */
@ -2091,6 +2198,10 @@ syms_of_dbusbind (void)
staticpro (&Qdbus_send_signal);
defsubr (&Sdbus_send_signal);
Qdbus_register_service = intern_c_string ("dbus-register-service");
staticpro (&Qdbus_register_service);
defsubr (&Sdbus_register_service);
Qdbus_register_signal = intern_c_string ("dbus-register-signal");
staticpro (&Qdbus_register_signal);
defsubr (&Sdbus_register_signal);
@ -2112,6 +2223,27 @@ syms_of_dbusbind (void)
QCdbus_session_bus = intern_c_string (":session");
staticpro (&QCdbus_session_bus);
QCdbus_request_name_allow_replacement = intern_c_string (":allow-replacement");
staticpro (&QCdbus_request_name_allow_replacement);
QCdbus_request_name_replace_existing = intern_c_string (":replace-existing");
staticpro (&QCdbus_request_name_replace_existing);
QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue");
staticpro (&QCdbus_request_name_do_not_queue);
QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner");
staticpro (&QCdbus_request_name_reply_primary_owner);
QCdbus_request_name_reply_exists = intern_c_string (":exists");
staticpro (&QCdbus_request_name_reply_exists);
QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue");
staticpro (&QCdbus_request_name_reply_in_queue);
QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner");
staticpro (&QCdbus_request_name_reply_already_owner);
QCdbus_timeout = intern_c_string (":timeout");
staticpro (&QCdbus_timeout);

11
src/fns.c
View file

@ -2460,10 +2460,13 @@ do_yes_or_no_p (Lisp_Object prompt)
DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, MANY, 0,
doc: /* Ask user a yes-or-no question. Return t if answer is yes.
Takes one argument, which is the string to display to ask the question.
It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
The user must confirm the answer with RET,
and can edit it until it has been confirmed.
The string to display to ask the question is obtained by
formatting the string PROMPT with arguments ARGS (see `format').
The result should end in a space; `yes-or-no-p' adds
\"(yes or no) \" to it.
The user must confirm the answer with RET, and can edit it until it
has been confirmed.
Under a windowing system a dialog box will be used if `last-nonmenu-event'
is nil, and `use-dialog-box' is non-nil.

2
src/gtkutil.c
View file

@ -4439,7 +4439,7 @@ update_frame_tool_bar (FRAME_PTR f)
/* Remove buttons not longer needed. */
do
{
ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), j++);
ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), j);
if (ti)
gtk_container_remove (GTK_CONTAINER (wtoolbar), GTK_WIDGET (ti));
} while (ti != NULL);

11
src/image.c
View file

@ -7518,6 +7518,9 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
image. Interface :index is same as for GIF. First we "ping" the
image to see how many sub-images it contains. Pinging is faster
than loading the image to find out things about it. */
/* MagickWandGenesis() initializes the imagemagick library. */
MagickWandGenesis ();
image = image_spec_value (img->spec, QCindex, NULL);
ino = INTEGERP (image) ? XFASTINT (image) : 0;
ping_wand = NewMagickWand ();
@ -7546,6 +7549,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
img->data.lisp_val));
DestroyMagickWand (ping_wand);
/* Now, after pinging, we know how many images are inside the
file. If its not a bundle, just one. */
@ -7563,6 +7567,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
if (im_image != NULL)
{
image_wand = NewMagickWandFromImage (im_image);
DestroyImage(im_image);
status = MagickTrue;
}
else
@ -7573,7 +7578,7 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
image_wand = NewMagickWand ();
status = MagickReadImageBlob (image_wand, contents, size);
}
image_error ("im read failed", Qnil, Qnil);
if (status == MagickFalse) goto imagemagick_error;
/* If width and/or height is set in the display spec assume we want
@ -7802,11 +7807,13 @@ imagemagick_load_image (/* Pointer to emacs frame structure. */
/* Final cleanup. image_wand should be the only resource left. */
DestroyMagickWand (image_wand);
MagickWandTerminus ();
return 1;
imagemagick_error:
DestroyMagickWand (image_wand);
MagickWandTerminus ();
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil);
return 0;
@ -8678,8 +8685,6 @@ of `dynamic-library-alist', which see). */)
#if defined (HAVE_IMAGEMAGICK)
if (EQ (type, Qimagemagick))
{
/* MagickWandGenesis() initializes the imagemagick library. */
MagickWandGenesis ();
return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions,
libraries);
}