Mercurial > emacs
changeset 90385:72dea2ff0142
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-57
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 226-238)
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: lisp/progmodes/python.el (python-mode): Fix typo.
* gnus--rel--5.10 (patch 86-90)
- Update from CVS
- Merge from emacs--devo--0
line wrap: on
line diff
--- a/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,7 @@ +2006-04-20 Ramprasad B <ramprasad_i82@yahoo.com> + + * Copyright (sources/emacs): updated copyright year(s) + 2006-04-01 Eli Zaretskii <eliz@gnu.org> * configure: Regenerated. @@ -6225,7 +6229,7 @@ ;; coding: iso-2022-7bit ;; End: - Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002 + Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, 2006 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted provided the copyright notice and this notice are preserved.
--- a/INSTALL Mon Apr 17 08:41:12 2006 +0000 +++ b/INSTALL Fri Apr 21 05:39:14 2006 +0000 @@ -1,5 +1,6 @@ GNU Emacs Installation Guide -Copyright (c) 1992, 94, 96, 97, 2000, 01, 02 Free software Foundation, Inc. +Copyright (c) 1992, 1994, 1996, 1997, 2000, 2001, 2002, 2006 +Free software Foundation, Inc. See the end of the file for copying permissions.
--- a/Makefile.in Mon Apr 17 08:41:12 2006 +0000 +++ b/Makefile.in Fri Apr 21 05:39:14 2006 +0000 @@ -2,7 +2,7 @@ # DIST: make most of the changes to this file you might want, so try # DIST: that first. -# Copyright (C) 1992,93,94,95,96,97,98,1999,2000,01,02,03,04,2005 +# Copyright (C) 1992,93,94,95,96,97,98,1999,2000,01,02,03,04,2005,2006 # Free Software Foundation, Inc. # This file is part of GNU Emacs.
--- a/admin/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,7 @@ +2006-04-17 Ramprasad B <ramprasad_i82@yahoo.com> + + * ./* (Copyright): Updated Copyright year(s) + 2006-02-24 Reiner Steib <Reiner.Steib@gmx.de> * FOR-RELEASE (BUGS): Add URLs/MIDs.
--- a/admin/FOR-RELEASE Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/FOR-RELEASE Fri Apr 21 05:39:14 2006 +0000 @@ -37,6 +37,9 @@ ** Is there a basic problem with cl-byte-compile-compiler-macro? +** Recalculate the tool bar height after changing the default font. +(Bug report by Yamamoto Mistuharu, 31 Mar 2006) + ** Markus Gritsch's report about Emacs looping on Windoze with the following .emacs file, and then reduce Emacs frame width to "something quite narrow": (setq-default truncate-lines t)
--- a/admin/alloc-colors.c Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/alloc-colors.c Fri Apr 21 05:39:14 2006 +0000 @@ -1,5 +1,5 @@ /* Allocate X colors. Used for testing with dense colormaps. - Copyright (C) 2001 Free Software Foundation, Inc. + Copyright (C) 2001, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs.
--- a/admin/build-configs Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/build-configs Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ #! /usr/bin/perl -# Copyright (C) 2001 Free Software Foundation, Inc. +# Copyright (C) 2001, 2006 Free Software Foundation, Inc. # # This file is part of GNU Emacs. #
--- a/admin/cus-test.el Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/cus-test.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; cus-test.el --- tests for custom types and load problems -;; Copyright (C) 1998, 2000, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2002, 2006 Free Software Foundation, Inc. ;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de> ;; Maintainer: Markus Rost <rost@math.ohio-state.edu>
--- a/admin/diff-tar-files Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/diff-tar-files Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ #! /bin/sh -# Copyright (C) 2001 Free Software Foundation, Inc. +# Copyright (C) 2001, 2006 Free Software Foundation, Inc. # # This file is part of GNU Emacs. #
--- a/admin/make-emacs Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/make-emacs Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ #! /usr/bin/perl -# Copyright (C) 2001 Free Software Foundation, Inc. +# Copyright (C) 2001, 2006 Free Software Foundation, Inc. # # This file is part of GNU Emacs. #
--- a/admin/revdiff Mon Apr 17 08:41:12 2006 +0000 +++ b/admin/revdiff Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ #! /usr/bin/perl -# Copyright (C) 2001 Free Software Foundation, Inc. +# Copyright (C) 2001, 2006 Free Software Foundation, Inc. # # This file is part of GNU Emacs. #
--- a/config.bat Mon Apr 17 08:41:12 2006 +0000 +++ b/config.bat Fri Apr 21 05:39:14 2006 +0000 @@ -1,7 +1,7 @@ @echo off rem ---------------------------------------------------------------------- rem Configuration script for MSDOS -rem Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2004 +rem Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2004, 2006 rem Free Software Foundation, Inc. rem This file is part of GNU Emacs.
--- a/config.guess Mon Apr 17 08:41:12 2006 +0000 +++ b/config.guess Fri Apr 21 05:39:14 2006 +0000 @@ -1,9 +1,9 @@ #! /bin/sh # Attempt to guess a canonical system name. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. -timestamp='2005-12-23' +timestamp='2006-04-20' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by
--- a/config.sub Mon Apr 17 08:41:12 2006 +0000 +++ b/config.sub Fri Apr 21 05:39:14 2006 +0000 @@ -1,9 +1,9 @@ #! /bin/sh # Configuration validation subroutine script. # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. -timestamp='2005-12-23' +timestamp='2006-04-20' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software
--- a/configure Mon Apr 17 08:41:12 2006 +0000 +++ b/configure Fri Apr 21 05:39:14 2006 +0000 @@ -2,7 +2,7 @@ # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59. # -# Copyright (C) 2003 Free Software Foundation, Inc. +# Copyright (C) 2003, 2006 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ##
--- a/etc/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,24 @@ +2006-04-21 Nick Roberts <nickrob@snap.net.nz> + + * NEWS: Mention t-mouse.el. Touch up description of gdb-ui.el. + +2006-04-20 Carsten Dominik <dominik@science.uva.nl> + + * orgcard.tex: Version number change only. + +2006-04-18 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-refcard.tex: Bump version to 5.11. Remove duplicate + \def's. Update date. + +2006-04-18 Bill Wohler <wohler@newt.com> + + * MORE.STUFF: Add MH-E. + +2006-04-18 Carsten Dominik <dominik@science.uva.nl> + + * orgcard.tex: Version number change only. + 2006-04-12 Kenichi Handa <handa@m17n.org> * PROBLEMS (C-SPC fails ...): Explicitly say fcitx in the header. @@ -23,7 +44,7 @@ 2006-03-28 Bill Wohler <wohler@newt.com> * images/README: Update with following information. - + * images/data-save.xpm, images/mail/flag-for-followup.xpm: * images/zoom-in.xpm, images/zoom-out.xpm: New images from GNOME 2.12. @@ -32,27 +53,27 @@ * images/mail/flag-for-followup.pbm, images/mail/inbox.pbm: * images/mail/move.pbm, images/next-page.pbm, images/zoom-out.pbm: New bitmaps for new images. - - * images/refresh.xpm, images/sort-ascending.xpm, + + * images/refresh.xpm, images/sort-ascending.xpm, * images/sort-descending.xpm: Update with GTK 2.x images. Note that the default GTK icons are not overridden by the GNOME theme due to a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in wide circulation, then the GTK icons should be replaced with the equivalent GNOME icons. Until then, we should be consistent with GTK first, then GNOME. - - * images/mail/repack.xpm, images/mail/reply-from.xpm: + + * images/mail/repack.xpm, images/mail/reply-from.xpm: * images/mail/reply-to.xpm, images/search-replace.xpm: * images/separator.xpm, images/show.xpm: Update custom icons to be closer to their GNOME counterparts. - - * images/attach.pbm, images/exit.pbm, images/mail/compose.pbm: + + * images/attach.pbm, images/exit.pbm, images/mail/compose.pbm: * images/mail/repack.pbm, images/mail/reply-all.pbm: * images/mail/reply-from.pbm, images/mail/reply-to.pbm: * images/mail/reply.pbm, images/mail/send.pbm, images/show.pbm: * images/search-replace.pbm: Update bitmaps. - - * images/execute.pbm, images/execute.xpm, images/fld-open.pbm: + + * images/execute.pbm, images/execute.xpm, images/fld-open.pbm: * images/fld-open.xpm, images/highlight.pbm, images/highlight.xpm: * images/mail.pbm, images/mail.xpm, images/mail/alias.pbm: * images/mail/alias.xpm, images/mail/refile.pbm:
--- a/etc/MORE.STUFF Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/MORE.STUFF Fri Apr 21 05:39:14 2006 +0000 @@ -71,6 +71,8 @@ * Ispell: <URL:http://www.eng.utah.edu/~kstevens/ispell-page.html> + * MH-E: <URL:http://mh-e.sourceforge.net/> + * PC Selection: <URL:ftp://ftp.thp.uni-duisburg.de/pub/source/elisp/> * PS mode: <URL:http://odur.let.rug.nl/%7Ekleiweg/postscript/>
--- a/etc/NEWS Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/NEWS Fri Apr 21 05:39:14 2006 +0000 @@ -1924,6 +1924,10 @@ paragraph will scroll the buffer by the respective amount of lines instead and point will be kept vertically fixed relative to window boundaries during scrolling. + +** The file t-mouse.el is now part of Emacs and provides access to mouse +events from the console. It still requires gpm to work but has been updated +for Emacs 22. In particular, the mode-line is now position sensitive. * Changes in Specialized Modes and Packages in Emacs 22.1: @@ -2702,14 +2706,15 @@ +++ *** The new package gdb-ui.el provides an enhanced graphical interface to -GDB. You can interact with GDB through the GUD buffer in the usual way, but +GDB. You can interact with GDB through the GUD buffer in the usual way, but there are also further buffers which control the execution and describe the state of your program. It can separate the input/output of your program from that of GDB and watches expressions in the speedbar. It also uses features of Emacs 21/22 such as the toolbar, and bitmaps in the fringe to indicate breakpoints. -Use M-x gdb to start GDB-UI. +To use this package just type M-x gdb. See the Emacs manual if you want the +old behaviour. *** The variable tooltip-gud-tips-p has been removed. GUD tooltips can now be toggled independently of normal tooltips with the minor mode
--- a/etc/TODO Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/TODO Fri Apr 21 05:39:14 2006 +0000 @@ -9,15 +9,14 @@ * Small but important fixes needed in existing features: +** whitespace-cleanup should work only on the region if the region is active. + ** Distribute a bar cursor of width > 1 evenly between the two glyphs on each side of the bar (what to do at the edges?). ** Make vc-checkin avoid reverting the buffer if has not changed after the checkin. Comparing (md5 BUFFER) to (md5 FILE) should be enough. -** Make vc-annotate show place the cursor in the annotate buffer at the - same line as the current buffer. - ** buffer-offer-save should be a permanent local. ** revert-buffer should eliminate overlays and the mark.
--- a/etc/gnus-refcard.tex Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/gnus-refcard.tex Fri Apr 21 05:39:14 2006 +0000 @@ -76,8 +76,9 @@ % \input{gnusref} % % % % % % % % % % % % % % % % % % % % % % % % % % %% include file for the Gnus refcard and booklet -\def\progver{5.10}\def\refver{5.10-2} % program and refcard versions -\def\date{Mar, 2005} +\def\progver{5.11} % program version +% \def\refver{5.10-2} % refcard version (not used) +\def\date{April, 2006} \def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$} %% @@ -1267,10 +1268,6 @@ \begin{document} -\def\progver{5.10}\def\refver{5.10-1} % program and refcard versions -\def\date{Jan 10th, 2004} -\def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$} - \ifthenelse{\isundefined{\booklettrue}}{ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \raggedbottom\raggedright \twocolumn
--- a/etc/orgcard.tex Mon Apr 17 08:41:12 2006 +0000 +++ b/etc/orgcard.tex Fri Apr 21 05:39:14 2006 +0000 @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{4.23} +\def\orgversionnumber{4.25} \def\year{2006} % %**start of header
--- a/leim/leim-ext.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/leim-ext.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;; leim-ext.el -- extra leim configulation -*- coding:iso-2022-7bit; -*- -;; Copyright (C) 2004 +;; Copyright (C) 2004, 2006 ;; Free Software Foundation, Inc. ;; Copyright (C) 2004, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST)
--- a/leim/makefile.w32-in Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/makefile.w32-in Fri Apr 21 05:39:14 2006 +0000 @@ -1,5 +1,5 @@ # -*- Makefile -*- for leim subdirectory in GNU Emacs on the Microsoft W32 API. -# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 +# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 # Free Software Foundation, Inc. # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 # National Institute of Advanced Industrial Science and Technology (AIST)
--- a/leim/quail/croatian.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/croatian.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; quail/croatian.el -- Quail package for inputing Croatian -*-coding: iso-8859-2;-*- -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. ;; Author: Hrvoje Nik¹iæ <hniksic@xemacs.org>, ;; modeled after czech.el by Milan Zamazal.
--- a/leim/quail/cyril-jis.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/cyril-jis.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/cyrillic.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/cyrillic.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; cyrillic.el --- Quail package for inputting Cyrillic characters -;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005 +;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006 ;; Free Software Foundation, Inc. ;; Copyright (C) 1997, 2003 ;; National Institute of Advanced Industrial Science and Technology (AIST)
--- a/leim/quail/czech.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/czech.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; czech.el --- Quail package for inputting Czech -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1998, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2001, 2006 Free Software Foundation, Inc. ;; Author: Milan Zamazal <pdm@zamazal.org> ;; Maintainer: Pavel Jan,Bm(Bk <Pavel@Janik.cz>
--- a/leim/quail/ethiopic.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/ethiopic.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997, 1998, 1999, 2001 +;; Copyright (C) 1997, 1998, 1999, 2001, 2006 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/georgian.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/georgian.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; georgian.el --- Quail package for inputting Georgian characters -*-coding: utf-8;-*- -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: i18n
--- a/leim/quail/greek.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/greek.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; greek.el --- Quail package for inputting Greek -*-coding: iso-2022-7bit-*- -;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 2001 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/hangul.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/hangul.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; hangul.el --- Quail package for inputting Korean Hangul characters -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/hangul3.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/hangul3.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; hangul3.el --- Quail package for inputting Korean Hangul characters -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 2002 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/hanja.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/hanja.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/hanja3.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/hanja3.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997, 1999, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2002, 2006 Free Software Foundation, Inc. ;; Author: Koaunghi Un <koanughi.un@zdv.uni-tuebingen.de> ;; Keywords: mule, quail, multilingual, input method, Korean, Hanja
--- a/leim/quail/indian.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/indian.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; indian.el --- Quail packages for inputting Indian -;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc. ;; Author: KAWABATA, Taichi <kawabata@m17n.org>
--- a/leim/quail/japanese.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/japanese.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; japanese.el --- Quail package for inputting Japanese -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/latin-alt.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/latin-alt.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*- -;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1999 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/latin-ltx.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/latin-ltx.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*- -;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/latin-post.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/latin-post.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*- -;; Copyright (C) 1997, 1998, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1999 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/latin-pre.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/latin-pre.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*- -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2006 ;; Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000, 2005 ;; National Institute of Advanced Industrial Science and Technology (AIST)
--- a/leim/quail/lrt.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/lrt.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1999 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/py-punct.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/py-punct.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 2000 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/sgml-input.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/sgml-input.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8 -*- -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: i18n
--- a/leim/quail/sisheng.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/sisheng.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration -;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2006 Free Software Foundation, Inc. ;; Author: Werner LEMBERG <wl@gnu.org>
--- a/leim/quail/slovak.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/slovak.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; slovak.el --- Quail package for inputting Slovak -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1998, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2001, 2006 Free Software Foundation, Inc. ;; Authors: Tibor ,B)(Bimko <tibor.simko@fmph.uniba.sk> ;; Milan Zamazal <pdm@zamazal.org>
--- a/leim/quail/symbol-ksc.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/symbol-ksc.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2005, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/tibetan.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/tibetan.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2006 Free Software Foundation, Inc. ;; Copyright (C) 1997, 1998, 1999, 2000 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/uni-input.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/uni-input.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; uni-input.el --- Hex Unicode input method -;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc. ;; Copyright (C) 2004 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021
--- a/leim/quail/vntelex.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/vntelex.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; vntelex.el --- Quail package for Vietnamese by Telex method -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2006 Free Software Foundation, Inc. ;; Author: Werner Lemberg <wl@gnu.org> ;; Keywords: multilingual, input method, Vietnamese
--- a/leim/quail/welsh.el Mon Apr 17 08:41:12 2006 +0000 +++ b/leim/quail/welsh.el Fri Apr 21 05:39:14 2006 +0000 @@ -1,6 +1,6 @@ ;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: iso-2022-7bit;-*- -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: i18n
--- a/lisp/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,173 @@ +2006-04-21 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-data-list-register-values-handler): + Use font-lock-warning-face for any errors e.g. no stack. + (gdb-stack-list-locals-handler): Display any errors e.g. no stack. + +2006-04-20 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/sh-script.el (sh-shell): Mark as safe. + + * newcomment.el (comment-start, comment-start-skip) + (comment-end-skip, comment-end): Mark as safe. + +2006-04-20 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-deadline-announce): Face removed. + (org-level-faces, org-n-levels): Converted to constant. + (org-compatible-face): New function. + (org-hide, org-level-1, org-level-2, org-level-3, org-level-4) + (org-level-5, org-level-6, org-level-7, org-level-8) + (org-special-keyword, org-warning, org-headline-done, org-link) + (org-date, org-tag, org-todo, org-done, org-table, org-formula) + (org-scheduled-today, org-scheduled-previously, org-time-grid): + Face definition revised for better color tty support. + (org-bold-re, org-italic-re, org-underline-re): New constants. + (org-set-font-lock-defaults): Use the new constants. + (org-agenda-highlight-todo): New function. + (org-agenda-todo): Fixed bug with point at end of line. + (org-agenda-change-all-lines, org-finalize-agenda-entries): + Fontify TODO keywords. + (org-insert-link): Preserve relative path in ../ links. + (org-export-as-html): Convert links pointing to .org files into + links that will work beteen the exported HTML files. + (org-todo-list): Fix bug when arg=0. + (org-insert-heading): More fine-tuning. + +2006-04-19 Romain Francoise <romain@orebokech.com> + + * mail/rmail.el (rmail-convert-to-babyl-format): Use second group + from `rmail-mime-charset-pattern'. + +2006-04-18 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/python.el (python-mode): Fix typo. + +2006-04-18 J.D. Smith <jdsmith@as.arizona.edu> + + * comint.el (comint-previous-input): Don't clobber input line + when moving off either end of the input history ring. + (comint-delete-input): New function, used by + `comint-previous-input' and others. + (comint-previous-matching-input): Use + `coming-delete-input'. Save the partial input if leaving the + edit line. Goto point-max before deleting input to avoid + partial input fragments hanging around. + (comint-restore-input): New function, used by + `comint-previous-input', and bound to "C-c C-j". + +2006-04-18 Luc Teirlinck <teirllm@auburn.edu> + + * imenu.el (imenu--index-alist): Balance parentheses. + +2006-04-18 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/python.el (python-mode): Add support for + hs-minor-mode. + +2006-04-19 Reiner Steib <Reiner.Steib@gmx.de> + + * abbrev.el (read-abbrev-file): Use abbrev-file-name if optional + file is nil. + +2006-04-18 Richard Stallman <rms@gnu.org> + + * tooltip.el (tooltip-mode, tooltip-use-echo-area): Doc fixes. + + * imenu.el (imenu-create-index-function, imenu--index-alist) + (imenu--last-menubar-index-alist, imenu--make-index-alist) + (imenu-default-create-index-function, imenu--generic-function): + Doc fixes. + + * image-mode.el (image-toggle-display): Handle tar and arc subfiles. + + * help-mode.el (help-mode): Set view-exit-action to delete window. + + * env.el (setenv): Get rid of arg UNSET. Interactive unsetting + now works by passing nil as arg. + + * apropos.el (apropos-print): Don't do where-is on self-insert-command. + + * abbrev.el (edit-abbrevs-redefine): Temporarily widen. + (read-abbrev-file): Provide default when reading filename. + + * files.el (enable-local-variables): Allow :all as value. + (hack-local-variables): Implement that value. + (safe-local-variable-values, safe-local-eval-forms) + (enable-local-variables): Mark as risky. + (find-file-visit-truename, kept-old-versions): Mark safe. + + * time-stamp.el (time-stamp-format, time-stamp-line-limit) + (time-stamp-start, time-stamp-end, time-stamp-inserts-lines) + (time-stamp-count, time-stamp-pattern): Add safe-local-variable prop. + +2006-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/tcl.el (tcl-send-string, tcl-send-region): + Use forward-line so as to get to BOL even in the presence of fields. + (tcl-eval-region): Strip surrounding space to avoid multiple prompts + in return. + (inferior-tcl): Tell tclsh to work in interactive mode. + + * complete.el (partial-completion-mode): + Use 'choose-completion-string-functions to make sure that + choose-completion fills the minibuffer properly. + + * complete.el (PC-old-read-file-name-internal): Remove. + (PC-read-include-file-name-internal): Remove. Turn it into an advice + of read-file-name-internal. + (partial-completion-mode): Enable/disable this advice. + +2006-04-18 Juanma Barranquero <lekktu@gmail.com> + + * net/tramp.el (tramp-completion-file-name-handler): Revert change + of 2006-04-17. + +2006-04-18 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-insert-heading): Insert heading before + current if at beginning of line. + (org-todo, org-date): New faces. + (org-table-align): Make sure tooltip window contains full text. + (org-no-properties): New defsubst. + (org-set-font-lock-defaults): Use new faces. + +2006-04-18 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-speedbar-item-info): Display frame address + for root variables. + + * progmodes/gdb-ui.el (gdb-pc-address): Rename from gdb-frame-address. + (gdb-frame-address): Re-use to identify frame for watch expression. + (gdb-var-list, gdb-var-create-handler): Add frame address for root + variables. + (gdb-init-1, gdb-source, gdb-post-prompt, ) + (gdb-assembler-custom, gdb-invalidate-assembler): Use gdb-pc-address. + (gdb-frame-handler): Get gdb-frame-address. + +2006-04-17 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.53. + + * net/tramp.el (tramp-completion-mode): ?\t has event-modifier + 'control. Reported by Matthias F,bv(Brste <slashdevslashnull@gmx.net>. + (tramp-completion-file-name-handler): Add autoload cookie for + adding to `file-name-handler-alist'. + + * net/tramp-smb.el (tramp-smb-wait-for-output): Wait always for + the prompt. If it returns earlier (when detecting an error + message), the rest of the output will merge accidently with the + output of the next command. Reported by M Jared Finder + <jared@hpalace.com>. + + * net/tramp-vc.el (vc-user-login-name): Wrap defadvice with a test + for `process-file', in order to let it work for older Emacsen too. + +2006-04-17 Ralf Angeli <angeli@iwi.uni-sb.de> + + * textmodes/tex-mode.el (tex-font-lock-match-suscript): New function. + (tex-font-lock-keywords-3): Use it. + 2006-04-16 Stefan Monnier <monnier@iro.umontreal.ca> * newcomment.el (comment-add): New function. @@ -2928,7 +3098,7 @@ (vc-default-update-changelog): Don't use vc-user-login-name, we don't need it here. - * tramp-vc.el (vc-user-login-name): Comment out defadvice, it is + * net/tramp-vc.el (vc-user-login-name): Comment out defadvice, it is no longer necessary. 2006-01-25 Kenichi Handa <handa@m17n.org>
--- a/lisp/abbrev.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/abbrev.el Fri Apr 21 05:39:14 2006 +0000 @@ -160,8 +160,10 @@ (defun edit-abbrevs-redefine () "Redefine abbrevs according to current buffer contents." (interactive) - (define-abbrevs t) - (set-buffer-modified-p nil)) + (save-restriction + (widen) + (define-abbrevs t) + (set-buffer-modified-p nil))) (defun define-abbrevs (&optional arg) "Define abbrevs according to current visible buffer contents. @@ -195,9 +197,12 @@ Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Optional second argument QUIETLY non-nil means don't display a message." - (interactive "fRead abbrev file: ") - (load (if (and file (> (length file) 0)) file abbrev-file-name) - nil quietly) + (interactive + (list + (read-file-name (format "Read abbrev file (default %s): " + abbrev-file-name) + nil abbrev-file-name t))) + (load (or file abbrev-file-name) nil quietly) (setq abbrevs-changed nil)) (defun quietly-read-abbrev-file (&optional file)
--- a/lisp/apropos.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/apropos.el Fri Apr 21 05:39:14 2006 +0000 @@ -908,6 +908,7 @@ ;; Calculate key-bindings if we want them. (and do-keys (commandp symbol) + (not (eq symbol 'self-insert-command)) (indent-to 30 1) (if (let ((keys (save-excursion
--- a/lisp/comint.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/comint.el Fri Apr 21 05:39:14 2006 +0000 @@ -558,6 +558,9 @@ "Non-nil if you are accumulating input lines to send as input together. The command \\[comint-accumulate] sets this.") +(defvar comint-stored-incomplete-input nil + "Stored input for history cycling.") + (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand) (put 'comint-input-ring 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) @@ -638,6 +641,7 @@ (make-local-variable 'comint-scroll-to-bottom-on-input) (make-local-variable 'comint-move-point-for-output) (make-local-variable 'comint-scroll-show-maximum-output) + (make-local-variable 'comint-stored-incomplete-input) ;; This makes it really work to keep point at the bottom. (make-local-variable 'scroll-conservatively) (setq scroll-conservatively 10000) @@ -1015,6 +1019,16 @@ (t arg))) +(defun comint-restore-input () + "Restore unfinished input." + (interactive) + (when comint-input-ring-index + (comint-delete-input) + (when (> (length comint-stored-incomplete-input) 0) + (insert comint-stored-incomplete-input) + (message "Input restored")) + (setq comint-input-ring-index nil))) + (defun comint-search-start (arg) "Index to start a directional search, starting at `comint-input-ring-index'." (if comint-input-ring-index @@ -1035,9 +1049,18 @@ arg))) (defun comint-previous-input (arg) - "Cycle backwards through input history." + "Cycle backwards through input history, saving input." (interactive "*p") - (comint-previous-matching-input "." arg)) + (if (and comint-input-ring-index + (or ;; leaving the "end" of the ring + (and (< arg 0) ; going down + (eq comint-input-ring-index 0)) + (and (> arg 0) ; going up + (eq comint-input-ring-index + (1- (ring-length comint-input-ring))))) + comint-stored-incomplete-input) + (comint-restore-input) + (comint-previous-matching-input "." arg))) (defun comint-next-input (arg) "Cycle forwards through input history." @@ -1077,6 +1100,14 @@ (if (string-match regexp (ring-ref comint-input-ring n)) n))) +(defun comint-delete-input () + "Delete all input between accumulation or process mark and point." + (delete-region + ;; Can't use kill-region as it sets this-command + (or (marker-position comint-accum-marker) + (process-mark (get-buffer-process (current-buffer)))) + (point-max))) + (defun comint-previous-matching-input (regexp n) "Search backwards through input history for match for REGEXP. \(Previous history elements are earlier commands.) @@ -1088,13 +1119,13 @@ ;; Has a match been found? (if (null pos) (error "Not found") + ;; If leaving the edit line, save partial input + (if (null comint-input-ring-index) ;not yet on ring + (setq comint-stored-incomplete-input + (funcall comint-get-old-input))) (setq comint-input-ring-index pos) (message "History item: %d" (1+ pos)) - (delete-region - ;; Can't use kill-region as it sets this-command - (or (marker-position comint-accum-marker) - (process-mark (get-buffer-process (current-buffer)))) - (point)) + (comint-delete-input) (insert (ring-ref comint-input-ring pos))))) (defun comint-next-matching-input (regexp n)
--- a/lisp/complete.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/complete.el Fri Apr 21 05:39:14 2006 +0000 @@ -141,8 +141,6 @@ "A list of the environment variable names and values.") -(defvar PC-old-read-file-name-internal nil) - (defun PC-bindings (bind) (let ((completion-map minibuffer-local-completion-map) (must-match-map minibuffer-local-must-match-map)) @@ -219,21 +217,32 @@ ((not PC-disable-includes) (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) ;; ... with some underhand redefining. - (cond ((and (not partial-completion-mode) - (functionp PC-old-read-file-name-internal)) - (fset 'read-file-name-internal PC-old-read-file-name-internal)) - ((and (not PC-disable-includes) (not PC-old-read-file-name-internal)) - (setq PC-old-read-file-name-internal - (symbol-function 'read-file-name-internal)) - (fset 'read-file-name-internal - 'PC-read-include-file-name-internal))) - (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)))) + (cond ((not partial-completion-mode) + (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file) + (ad-activate 'read-file-name-internal)) + ((not PC-disable-includes) + (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file) + (ad-activate 'read-file-name-internal))) + ;; 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 (&rest x) (goto-char (point-max)) 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 () @@ -930,20 +939,23 @@ (setq sorted (cdr sorted))) compressed)))) -(defun PC-read-include-file-name-internal (string dir action) - (if (string-match "<\\([^\"<>]*\\)>?$" string) - (let* ((name (substring string (match-beginning 1) (match-end 1))) +(defadvice read-file-name-internal (around PC-include-file disable) + (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0)) + (let* ((string (ad-get-arg 0)) + (action (ad-get-arg 2)) + (name (substring string (match-beginning 1) (match-end 1))) (str2 (substring string (match-beginning 0))) (completion-table - (mapcar (function (lambda (x) (list (format "<%s>" x)))) + (mapcar (lambda (x) (format "<%s>" x)) (PC-include-file-all-completions name (PC-include-file-path))))) - (cond - ((not completion-table) nil) - ((eq action nil) (try-completion str2 completion-table nil)) - ((eq action t) (all-completions str2 completion-table nil)) - ((eq action 'lambda) (test-completion str2 completion-table nil)))) - (funcall PC-old-read-file-name-internal string dir action))) + (setq ad-return-value + (cond + ((not completion-table) nil) + ((eq action 'lambda) (test-completion str2 completion-table nil)) + ((eq action nil) (try-completion str2 completion-table nil)) + ((eq action t) (all-completions str2 completion-table nil))))) + ad-do-it)) (provide 'complete)
--- a/lisp/env.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/env.el Fri Apr 21 05:39:14 2006 +0000 @@ -90,28 +90,30 @@ ;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set? -(defun setenv (variable &optional value unset substitute-env-vars) +(defun setenv (variable &optional value substitute-env-vars) "Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or -nil, the environment variable VARIABLE will be removed. UNSET -if non-nil means to remove VARIABLE from the environment. -SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment -variables in VALUE with `substitute-env-vars', where see. -Value is the new value if VARIABLE, or nil if removed from the -environment. +nil, the environment variable VARIABLE will be removed. Interactively, a prefix argument means to unset the variable. Interactively, the current value (if any) of the variable appears at the front of the history list when you type in the new value. Interactively, always replace environment variables in the new value. +SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment +variables in VALUE with `substitute-env-vars', which see. +This is normally used only for interactive calls. + +The return value is the new value of VARIABLE, or nil if +it was removed from the environment. + This function works by modifying `process-environment'. As a special case, setting variable `TZ' calls `set-time-zone-rule' as a side-effect." (interactive (if current-prefix-arg - (list (read-envvar-name "Clear environment variable: " 'exact) nil t) + (list (read-envvar-name "Clear environment variable: " 'exact) nil) (let* ((var (read-envvar-name "Set environment variable: " nil)) (value (getenv var))) (when value @@ -121,7 +123,6 @@ (read-from-minibuffer (format "Set %s to value: " var) nil nil nil 'setenv-history value) - nil t)))) (if (and (multibyte-string-p variable) locale-coding-system) (let ((codings (find-coding-systems-string (concat variable value)))) @@ -129,10 +130,9 @@ (memq (coding-system-base locale-coding-system) codings)) (error "Can't encode `%s=%s' with `locale-coding-system'" variable (or value ""))))) - (if unset - (setq value nil) - (if substitute-env-vars - (setq value (substitute-env-vars value)))) + (and value + substitute-env-vars + (setq value (substitute-env-vars value))) (if (multibyte-string-p variable) (setq variable (encode-coding-string variable locale-coding-system))) (if (and value (multibyte-string-p value))
--- a/lisp/files.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/files.el Fri Apr 21 05:39:14 2006 +0000 @@ -452,6 +452,8 @@ \(When you say yes to certain values, they are remembered as safe.) :safe means set the safe variables, and ignore the rest. +:all means set all variables, whether safe or not. + (Don't set it permanently to :all.) nil means always ignore the file local variables. Any other value means always query you once whether to set them all. @@ -464,8 +466,9 @@ The command \\[normal-mode], when used interactively, always obeys file local variable specifications and the -*- line, and ignores this variable." - :type '(choice (const :tag "Obey" t) + :type '(choice (const :tag "Query Unsafe" t) (const :tag "Safe Only" :safe) + (const :tag "Do all" :all) (const :tag "Ignore" nil) (other :tag "Query" other)) :group 'find-file) @@ -2283,6 +2286,7 @@ default-text-properties display-time-string enable-local-eval + enable-local-variables eval exec-directory exec-path @@ -2318,6 +2322,8 @@ parse-time-rules process-environment rmail-output-file-alist + safe-local-variable-values + safe-local-eval-forms save-some-buffers-action-alist special-display-buffer-names standard-input @@ -2355,9 +2361,11 @@ (c-indent-level . integerp) (comment-column . integerp) (compile-command . string-or-null-p) + (find-file-visit-truename . t) (fill-column . integerp) (fill-prefix . string-or-null-p) (indent-tabs-mode . t) + (kept-old-versions . integerp) (kept-new-versions . integerp) (left-margin . t) (no-byte-compile . t) @@ -2630,6 +2638,7 @@ (if (or (and (eq enable-local-variables t) (null unsafe-vars) (null risky-vars)) + (eq enable-local-variables :all) (hack-local-variables-confirm result unsafe-vars risky-vars)) (dolist (elt result)
--- a/lisp/gnus/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,57 @@ +2006-04-20 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-util.el (gnus-replace-in-string): Prefer + replace-regexp-in-string over of replace-in-string. + +2006-04-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map. + + * gnus-sum.el: Ditto. + + * gnus-util.el (gnus-select-frame-set-input-focus): Use + select-frame-set-input-focus if it is available in XEmacs; use + definition defined in Emacs 22 for old Emacsen. + +2006-04-17 Reiner Steib <Reiner.Steib@gmx.de> + + [ Merge from Gnus trunk. ] + + * mm-util.el (mm-charset-synonym-alist): Improve doc string. + (mm-charset-override-alist): New variable. + (mm-charset-to-coding-system): Use it. + (mm-codepage-setup): New helper function. + (mm-charset-eval-alist): New variable. + (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn + about unknown charsets. Add allow-override. Use + `mm-charset-override-alist' only when decoding. + (mm-detect-mime-charset-region): Use :mime-charset. + + * mm-bodies.el (mm-decode-body, mm-decode-string): Call + `mm-charset-to-coding-system' with allow-override argument. + + * message.el (message-tool-bar-zap-list, message-tool-bar) + (message-tool-bar-gnome, message-tool-bar-retro): New variables. + (message-tool-bar-local-item-from-menu): Remove. + (message-tool-bar-map): Replace by `message-make-tool-bar'. + (message-make-tool-bar): New function. + (message-mode): Use `message-make-tool-bar'. + + * gnus-sum.el (gnus-summary-tool-bar) + (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) + (gnus-summary-tool-bar-zap-list): New variables. + (gnus-summary-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + + * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) + (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New + variables. + (gnus-group-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + (gnus-group-tool-bar-update): New function. + + * gmm-utils.el: New file. + 2006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de> * flow-fill.el (fill-flowed): Remove trailing space from blank
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gmm-utils.el Fri Apr 21 05:39:14 2006 +0000 @@ -0,0 +1,413 @@ +;;; gmm-utils.el --- Utility functions for Gnus, Message and MML + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Reiner Steib <reiner.steib@gmx.de> +;; Keywords: news + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This library provides self-contained utility functions. The functions are +;; used in Gnus, Message and MML, but within this library there are no +;; dependencies on Gnus, Message, or MML or Gnus. + +;;; Code: + +;; (require 'wid-edit) + +(defgroup gmm nil + "Utility functions for Gnus, Message and MML" + :prefix "gmm-" + :version "23.0" ;; No Gnus + :group 'lisp) + +;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error + +(defcustom gmm-verbose 7 + "Integer that says how verbose gmm should be. +The higher the number, the more messages will flash to say what +it done. At zero, it will be totally mute; at five, it will +display most important messages; and at ten, it will keep on +jabbering all the time." + :type 'integer + :group 'gmm) + +;;;###autoload +(defun gmm-message (level &rest args) + "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. + +Guideline for numbers: +1 - error messages, 3 - non-serious error messages, 5 - messages for things +that take a long time, 7 - not very important messages on stuff, 9 - messages +inside loops." + (if (<= level gmm-verbose) + (apply 'message args) + ;; We have to do this format thingy here even if the result isn't + ;; shown - the return value has to be the same as the return value + ;; from `message'. + (apply 'format args))) + +;;;###autoload +(defun gmm-error (level &rest args) + "Beep an error if LEVEL is equal to or less than `gmm-verbose'. +ARGS are passed to `message'." + (when (<= (floor level) gmm-verbose) + (apply 'message args) + (ding) + (let (duration) + (when (and (floatp level) + (not (zerop (setq duration (* 10 (- level (floor level))))))) + (sit-for duration)))) + nil) + +;;;###autoload +(defun gmm-widget-p (symbol) + "Non-nil iff SYMBOL is a widget." + (get symbol 'widget-type)) + +;; Copy of the `nnmail-lazy' code from `nnmail.el': +(define-widget 'gmm-lazy 'default + "Base widget for recursive datastructures. + +This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." + :format "%{%t%}: %v" + :convert-widget 'widget-value-convert-widget + :value-create (lambda (widget) + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value + widget (widget-convert type) value))))) + :value-delete 'widget-children-value-delete + :value-get (lambda (widget) + (widget-value (car (widget-get widget :children)))) + :value-inline (lambda (widget) + (widget-apply (car (widget-get widget :children)) + :value-inline)) + :default-get (lambda (widget) + (widget-default-get + (widget-convert (widget-get widget :type)))) + :match (lambda (widget value) + (widget-apply (widget-convert (widget-get widget :type)) + :match value)) + :validate (lambda (widget) + (widget-apply (car (widget-get widget :children)) :validate))) + +;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs +;; version will provide customizable tool bar buttons using a different +;; interface. + +;; TODO: Extend API so that the "Command" entry can be a function or a plist. +;; In case of a list it should have the format... +;; +;; (:none command-without-modifier +;; :shift command-with-shift-pressed +;; :control command-with-ctrl-pressed +;; :control-shift command-with-control-and-shift-pressed +;; ;; mouse-2 and mouse-3 can't be used in Emacs yet. +;; :mouse-2 command-on-mouse-2-press +;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands +;; +;; Combinations of mouse-[23] plus shift and/or controll might be overkill. +;; +;; Then use (plist-get rs-command :none), (plist-get rs-command :shift) + +(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) + "Tool bar list item." + :tag "Tool bar item" + :type '(choice + (list :tag "Command and Icon" + (function :tag "Command") + (string :tag "Icon file") + (choice + (const :tag "Default map" nil) + ;; Note: Usually we need non-nil attributes if map is t. + (const :tag "No menu" t) + (sexp :tag "Other map")) + (plist :inline t :tag "Properties")) + (list :tag "Separator" + (const :tag "No command" gmm-ignore) + (string :tag "Icon file") + (const :tag "No map") + (plist :inline t :tag "Properties")))) + +(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) + "Tool bar zap list." + :tag "Tool bar zap list" + :type '(choice (const :tag "Zap all" t) + (const :tag "Keep all" nil) + (list + ;; :value + ;; Work around (bug in customize?), see + ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de> + ;; (new-file open-file dired kill-buffer write-file + ;; print-buffer customize help) + (set :inline t + (const new-file) + (const open-file) + (const dired) + (const kill-buffer) + (const save-buffer) + (const write-file) + (const undo) + (const cut) + (const copy) + (const paste) + (const search-forward) + (const print-buffer) + (const customize) + (const help)) + (repeat :inline t + :tag "Other" + (symbol :tag "Icon item"))))) + +;; (defun gmm-color-cells (&optional display) +;; "Return the number of color cells supported by DISPLAY. +;; Compatibility function." +;; ;; `display-color-cells' doesn't return more than 256 even if color depth is +;; ;; > 8 in Emacs 21. +;; ;; +;; ;; Feel free to add proper XEmacs support. +;; (let* ((cells (and (fboundp 'display-color-cells) +;; (display-color-cells display))) +;; (plane (and (fboundp 'x-display-planes) +;; (ash 1 (x-display-planes)))) +;; (none -1)) +;; (max (if (integerp cells) cells none) +;; (if (integerp plane) plane none)))) + +(defcustom gmm-tool-bar-style + (if (and (boundp 'tool-bar-mode) + tool-bar-mode + (and (fboundp 'display-visual-class) + (not (memq (display-visual-class) + (list 'static-gray 'gray-scale + 'static-color 'pseudo-color))))) + 'gnome + 'retro) + "Prefered tool bar style." + :type '(choice (const :tag "GNOME style" 'gnome) + (const :tag "Retro look" 'retro)) + :group 'gmm) + +(defvar tool-bar-map) + +;;;###autoload +(defun gmm-tool-bar-from-list (icon-list zap-list default-map) + "Make a tool bar from ICON-LIST. + +Within each entry of ICON-LIST, the first element is a menu +command, the second element is an icon file name and the third +element is a test function. You can use \\[describe-key] +<menu-entry> to find out the name of a menu command. The fourth +and all following elements are passed a the PROPS argument to the +function `tool-bar-local-item'. + +If ZAP-LIST is a list, remove those item from the default +`tool-bar-map'. If it is t, start with a new sparse map. You +can use \\[describe-key] <icon> to find out the name of an icon +item. When \\[describe-key] <icon> shows \"<tool-bar> <new-file> +runs the command find-file\", then use `new-file' in ZAP-LIST. + +DEFAULT-MAP specifies the default key map for ICON-LIST." + (let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we + ;; could use some other local variable. + (tool-bar-map (if (eq zap-list t) + (make-sparse-keymap) + (copy-keymap tool-bar-map)))) + (when (listp zap-list) + ;; Zap some items which aren't relevant for this mode and take up space. + (dolist (key zap-list) + (define-key tool-bar-map (vector key) nil))) + (mapc (lambda (el) + (let ((command (car el)) + (icon (nth 1 el)) + (fmap (or (nth 2 el) default-map)) + (props (cdr (cdr (cdr el)))) ) + ;; command may stem from different from-maps: + (cond ((eq command 'gmm-ignore) + ;; The dummy `gmm-ignore', see `gmm-tool-bar-item' + ;; widget. Suppress tooltip by adding `:enable nil'. + (if (fboundp 'tool-bar-local-item) + (apply 'tool-bar-local-item icon nil nil + tool-bar-map :enable nil props) + ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS) + ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) + (apply 'tool-bar-add-item icon nil nil :enable nil props))) + ((equal fmap t) ;; Not a menu command + (if (fboundp 'tool-bar-local-item) + (apply 'tool-bar-local-item + icon command + (intern icon) ;; reuse icon or fmap here? + tool-bar-map props) + ;; Emacs 21 compatibility: + (apply 'tool-bar-add-item + icon command + (intern icon) + props))) + (t ;; A menu command + (if (fboundp 'tool-bar-local-item-from-menu) + (apply 'tool-bar-local-item-from-menu + ;; (apply 'tool-bar-local-item icon def key + ;; tool-bar-map props) + command icon tool-bar-map (symbol-value fmap) + props) + ;; Emacs 21 compatibility: + (apply 'tool-bar-add-item-from-menu + command icon (symbol-value fmap) + props)))) + t)) + (if (symbolp icon-list) + (eval icon-list) + icon-list)) + tool-bar-map)) + +;; WARNING: The following is subject to change. Don't rely on it yet. + +;; From MH-E without modifications: + +(defmacro gmm-defun-compat (name function arg-list &rest body) + "Create function NAME. +If FUNCTION exists, then NAME becomes an alias for FUNCTION. +Otherwise, create function NAME with ARG-LIST and BODY." + (let ((defined-p (fboundp function))) + (if defined-p + `(defalias ',name ',function) + `(defun ,name ,arg-list ,@body)))) + +(gmm-defun-compat gmm-image-search-load-path + image-search-load-path (file &optional path) + "Emacs 21 and XEmacs don't have `image-search-load-path'. +This function returns nil on those systems." + nil) + +;; From MH-E with modifications: + +;; Don't use `gmm-defun-compat' until API changes in +;; `image-load-path-for-library' in Emacs CVS are completed. + +(defun gmm-image-load-path-for-library (library image &optional path no-error) + "Return a suitable search path for images relative to LIBRARY. + +First it searches for IMAGE in `image-load-path' (excluding +\"`data-directory'/images\") and `load-path', followed by a path +suitable for LIBRARY, which includes \"../../etc/images\" and +\"../etc/images\" relative to the library file itself, and then +in \"`data-directory'/images\". + +Then this function returns a list of directories which contains +first the directory in which IMAGE was found, followed by the +value of `load-path'. If PATH is given, it is used instead of +`load-path'. + +If NO-ERROR is non-nil and a suitable path can't be found, don't +signal an error. Instead, return a list of directories as before, +except that nil appears in place of the image directory. + +Here is an example that uses a common idiom to provide +compatibility with versions of Emacs that lack the variable +`image-load-path': + + ;; Shush compiler. + (defvar image-load-path) + + (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (mh-tool-bar-folder-buttons-init))" + (unless library (error "No library specified")) + (unless image (error "No image specified")) + (let (image-directory image-directory-load-path) + ;; Check for images in image-load-path or load-path. + (let ((img image) + (dir (or + ;; Images in image-load-path. + (gmm-image-search-load-path image) ;; "gmm-" prefix! + ;; Images in load-path. + (locate-library image))) + parent) + ;; Since the image might be in a nested directory (for + ;; example, mail/attach.pbm), adjust `image-directory' + ;; accordingly. + (when dir + (setq dir (file-name-directory dir)) + (while (setq parent (file-name-directory img)) + (setq img (directory-file-name parent) + dir (expand-file-name "../" dir)))) + (setq image-directory-load-path dir)) + + ;; If `image-directory-load-path' isn't Emacs' image directory, + ;; it's probably a user preference, so use it. Then use a + ;; relative setting if possible; otherwise, use + ;; `image-directory-load-path'. + (cond + ;; User-modified image-load-path? + ((and image-directory-load-path + (not (equal image-directory-load-path + (file-name-as-directory + (expand-file-name "images" data-directory))))) + (setq image-directory image-directory-load-path)) + ;; Try relative setting. + ((let (library-name d1ei d2ei) + ;; First, find library in the load-path. + (setq library-name (locate-library library)) + (if (not library-name) + (error "Cannot find library %s in load-path" library)) + ;; And then set image-directory relative to that. + (setq + ;; Go down 2 levels. + d2ei (file-name-as-directory + (expand-file-name + (concat (file-name-directory library-name) "../../etc/images"))) + ;; Go down 1 level. + d1ei (file-name-as-directory + (expand-file-name + (concat (file-name-directory library-name) "../etc/images")))) + (setq image-directory + ;; Set it to nil if image is not found. + (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) + ((file-exists-p (expand-file-name image d1ei)) d1ei))))) + ;; Use Emacs' image directory. + (image-directory-load-path + (setq image-directory image-directory-load-path)) + (no-error + (message "Could not find image %s for library %s" image library)) + (t + (error "Could not find image %s for library %s" image library))) + + ;; Return an augmented `path' or `load-path'. + (nconc (list image-directory) + (delete image-directory (copy-sequence (or path load-path)))))) + +(defun gmm-customize-mode (&optional mode) + "Customize customization group for MODE. +If mode is nil, use `major-mode' of the curent buffer." + (interactive) + (customize-group + (or mode + (intern (let ((mode (symbol-name major-mode))) + (string-match "^\\(.+\\)-mode$" mode) + (match-string 1 mode)))))) + +(provide 'gmm-utils) + +;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 +;;; gmm-utils.el ends here
--- a/lisp/gnus/gnus-group.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/gnus-group.el Fri Apr 21 05:39:14 2006 +0000 @@ -29,7 +29,7 @@ (eval-when-compile (require 'cl) - (defvar tool-bar-map)) + (defvar tool-bar-mode)) (require 'gnus) (require 'gnus-start) @@ -39,6 +39,7 @@ (require 'gnus-range) (require 'gnus-win) (require 'gnus-undo) +(require 'gmm-utils) (require 'time-date) (require 'gnus-ems) @@ -979,36 +980,135 @@ (gnus-run-hooks 'gnus-group-menu-hook))) -(defvar gnus-group-toolbar-map nil) - -;; Emacs 21 tool bar. Should be no-op otherwise. -(defun gnus-group-make-tool-bar () - (if (and - (condition-case nil (require 'tool-bar) (error nil)) - (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-group-toolbar-map)) - (setq gnus-group-toolbar-map - (let ((tool-bar-map (make-sparse-keymap)) - (load-path (mm-image-load-path))) - (tool-bar-add-item-from-menu - 'gnus-group-get-new-news "get-news" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-catchup-current "catchup" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-describe-group "describe-group" gnus-group-mode-map) - (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe - :help "Subscribe to the current group") - (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe - 'unsubscribe - :help "Unsubscribe from the current group") - (tool-bar-add-item-from-menu - 'gnus-group-exit "exit-gnus" gnus-group-mode-map) - tool-bar-map))) - (if gnus-group-toolbar-map - (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map))) + +(defvar gnus-group-tool-bar-map nil) + +(defun gnus-group-tool-bar-update (&optional symbol value) + "Update group buffer toolbar. +Setter function for custom variables." + (when symbol + (set-default symbol value)) + ;; (setq-default gnus-group-tool-bar-map nil) + ;; (use-local-map gnus-group-mode-map) + (when (gnus-alive-p) + (with-current-buffer gnus-group-buffer + (gnus-group-make-tool-bar t)))) + +(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'gnus-group-tool-bar-gnome + 'gnus-group-tool-bar-retro) + "Specifies the Gnus group tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-group-mode-map'. + +Pre-defined symbols include `gnus-group-tool-bar-gnome' and +`gnus-group-tool-bar-retro'." + :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome) + (const :tag "Retro look" gnus-group-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-gnome + '((gnus-group-post-news "mail/compose") + ;; Some useful agent icons? I don't use the agent so agent users should + ;; suggest useful commands: + (gnus-agent-toggle-plugged "connect" t + :visible (and gnus-agent (not gnus-plugged))) + (gnus-agent-toggle-plugged "disconnect" t + :visible (and gnus-agent gnus-plugged)) + ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) + ;; should have a better help text. + (gnus-group-send-queue "mail/outbox" t + :visible (and gnus-agent gnus-plugged) + :help "Send articles from the queue group") + (gnus-group-get-new-news "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + ;; FIXME: gnus-*-read-group should have a better help text. + (gnus-topic-read-group "open" nil + :visible (and (boundp 'gnus-topic-mode) + gnus-topic-mode)) + (gnus-group-read-group "open" nil + :visible (not (and (boundp 'gnus-topic-mode) + gnus-topic-mode))) + ;; (gnus-group-find-new-groups "???" nil) + (gnus-group-save-newsrc "save") + (gnus-group-describe-group "describe") + (gnus-group-unsubscribe-current-group "gnus/toggle-subscription") + (gnus-group-prev-unread-group "left-arrow") + (gnus-group-next-unread-group "right-arrow") + (gnus-group-exit "exit") + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (gnus-info-find-node "help")) + "List of functions for the group tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-retro + '((gnus-group-get-new-news "gnus/get-news") + (gnus-group-get-new-news-this-group "gnus/gnntg") + (gnus-group-catchup-current "gnus/catchup") + (gnus-group-describe-group "gnus/describe-group") + (gnus-group-subscribe "gnus/subscribe" t + :help "Subscribe to the current group") + (gnus-group-unsubscribe "gnus/unsubscribe" t + :help "Unsubscribe from the current group") + (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) + "List of functions for the group tool bar (retro look). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-zap-list t + "List of icon items from the global tool bar. +These items are not displayed in the Gnus group mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defvar image-load-path) + +(defun gnus-group-make-tool-bar (&optional force) + "Make a group mode tool bar from `gnus-group-tool-bar'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). + ;; Why? --rsteib + (or (not gnus-group-tool-bar-map) force)) + (let* ((load-path + (gmm-image-load-path-for-library "gnus" + "gnus/toggle-subscription.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path))) + (map (gmm-tool-bar-from-list gnus-group-tool-bar + gnus-group-tool-bar-zap-list + 'gnus-group-mode-map))) + (if map + (set (make-local-variable 'tool-bar-map) map)))) + gnus-group-tool-bar-map) (defun gnus-group-mode () "Major mode for reading news. @@ -1379,6 +1479,17 @@ (gnus-range-difference (list active) (gnus-info-read info)) seen)))))) +;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't +;; update the state (enabled/disabled) of the icon `gnus-group-describe-group' +;; automatically. After `C-l' the state is correct. See the following report +;; on emacs-devel +;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>: +;; From: Reiner Steib +;; Subject: tool bar icons not updated according to :active condition +;; Newsgroups: gmane.emacs.devel +;; Date: Mon, 23 Jan 2006 19:59:13 +0100 +;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de> + (defcustom gnus-group-update-tool-bar (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode)
--- a/lisp/gnus/gnus-sum.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/gnus-sum.el Fri Apr 21 05:39:14 2006 +0000 @@ -29,7 +29,7 @@ (eval-when-compile (require 'cl) - (defvar tool-bar-map)) + (defvar tool-bar-mode)) (require 'gnus) (require 'gnus-group) @@ -38,6 +38,7 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +(require 'gmm-utils) (require 'mm-decode) (require 'nnoo) @@ -2546,47 +2547,161 @@ (defvar gnus-summary-tool-bar-map nil) -;; Emacs 21 tool bar. Should be no-op otherwise. -(defun gnus-summary-make-tool-bar () - (if (and (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-summary-tool-bar-map)) - (setq gnus-summary-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap)) - (load-path (mm-image-load-path))) - (tool-bar-add-item-from-menu - 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-post-news "post" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-followup "followup" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-reply "reply" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-save-article "save-art" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-uu-post-news "uu-post" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-catchup "catchup" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-exit "exit-summ" gnus-summary-mode-map) - tool-bar-map))) - (if gnus-summary-tool-bar-map - (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) +;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only +;; affect _new_ message buffers. We might add a function that walks thru all +;; summary-mode buffers and force the update. +(defun gnus-summary-tool-bar-update (&optional symbol value) + "Update summary mode toolbar. +Setter function for custom variables." + (setq-default gnus-summary-tool-bar-map nil) + (when symbol + ;; When used as ":set" function: + (set-default symbol value)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + (gnus-summary-make-tool-bar)))) + +(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'gnus-summary-tool-bar-gnome + 'gnus-summary-tool-bar-retro) + "Specifies the Gnus summary tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-summary-mode-map'. + +Pre-defined symbols include `gnus-summary-tool-bar-gnome' and +`gnus-summary-tool-bar-retro'." + :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome) + (const :tag "Retro look" gnus-summary-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-gnome + '((gnus-summary-post-news "mail/compose" nil) + (gnus-summary-insert-new-articles "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + (gnus-summary-reply-with-original "mail/reply") + (gnus-summary-reply "mail/reply" nil :visible nil) + (gnus-summary-followup-with-original "mail/reply-all") + (gnus-summary-followup "mail/reply-all" nil :visible nil) + (gnus-summary-mail-forward "mail/forward") + (gnus-summary-save-article "mail/save") + (gnus-summary-search-article-forward "search" nil :visible nil) + (gnus-summary-print-article "print") + (gnus-summary-tick-article-forward "flag-followup" nil :visible nil) + ;; Some new commands that may need more suitable icons: + (gnus-summary-save-newsrc "save" nil :visible nil) + ;; (gnus-summary-show-article "stock_message-display" nil :visible nil) + (gnus-summary-prev-article "left-arrow") + (gnus-summary-next-article "right-arrow") + (gnus-summary-next-page "next-page") + ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil) + ;; + ;; Maybe some sort-by-... could be added: + ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil) + ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil) + (gnus-summary-mark-as-expirable + "delete" nil + :visible (gnus-check-backend-function 'request-expire-articles + gnus-newsgroup-name)) + (gnus-summary-mark-as-spam + "mail/spam" t + :visible (and (fboundp 'spam-group-ham-contents-p) + (spam-group-ham-contents-p gnus-newsgroup-name)) + :help "Mark as spam") + (gnus-summary-mark-as-read-forward + "mail/not-spam" nil + :visible (and (fboundp 'spam-group-spam-contents-p) + (spam-group-spam-contents-p gnus-newsgroup-name))) + ;; + (gnus-summary-exit "exit") + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (gnus-info-find-node "help")) + "List of functions for the summary tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-retro + '((gnus-summary-prev-unread-article "gnus/prev-ur") + (gnus-summary-next-unread-article "gnus/next-ur") + (gnus-summary-post-news "gnus/post") + (gnus-summary-followup-with-original "gnus/fuwo") + (gnus-summary-followup "gnus/followup") + (gnus-summary-reply-with-original "gnus/reply-wo") + (gnus-summary-reply "gnus/reply") + (gnus-summary-caesar-message "gnus/rot13") + (gnus-uu-decode-uu "gnus/uu-decode") + (gnus-summary-save-article-file "gnus/save-aif") + (gnus-summary-save-article "gnus/save-art") + (gnus-uu-post-news "gnus/uu-post") + (gnus-summary-catchup "gnus/catchup") + (gnus-summary-catchup-and-exit "gnus/cu-exit") + (gnus-summary-exit "gnus/exit-summ") + ;; Some new command that may need more suitable icons: + (gnus-summary-print-article "gnus/print" nil :visible nil) + (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil) + (gnus-summary-save-newsrc "gnus/save" nil :visible nil) + ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil) + (gnus-summary-search-article-forward "gnus/search" nil :visible nil) + ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil) + ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil) + ;; + (gnus-info-find-node "gnus/help" nil :visible nil)) + "List of functions for the summary tool bar (retro look). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-zap-list t + "List of icon items from the global tool bar. +These items are not displayed in the Gnus summary mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defvar image-load-path) + +(defun gnus-summary-make-tool-bar (&optional force) + "Make a summary mode tool bar from `gnus-summary-tool-bar'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + (or (not gnus-summary-tool-bar-map) force)) + (let* ((load-path + (gmm-image-load-path-for-library "gnus" + "mail/save.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path))) + (map (gmm-tool-bar-from-list gnus-summary-tool-bar + gnus-summary-tool-bar-zap-list + 'gnus-summary-mode-map))) + (when map + ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode' + ;; uses it's value. + (setq gnus-summary-tool-bar-map map)))) + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar."
--- a/lisp/gnus/gnus-util.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/gnus-util.el Fri Apr 21 05:39:14 2006 +0000 @@ -61,8 +61,11 @@ (eval-and-compile (cond - ((fboundp 'replace-in-string) - (defalias 'gnus-replace-in-string 'replace-in-string)) + ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5, + ;; SXEmacs 22.1.4) over `replace-in-string'. The later leads to inf-loops + ;; on empty matches: + ;; (replace-in-string "foo" "/*$" "/") + ;; (replace-in-string "xe" "\\(x\\)?" "") ((fboundp 'replace-regexp-in-string) (defun gnus-replace-in-string (string regexp newtext &optional literal) "Replace all matches for REGEXP with NEWTEXT in STRING. @@ -71,6 +74,8 @@ This is a compatibility function for different Emacsen." (replace-regexp-in-string regexp newtext string nil literal))) + ((fboundp 'replace-in-string) + (defalias 'gnus-replace-in-string 'replace-in-string)) (t (defun gnus-replace-in-string (string regexp newtext &optional literal) "Replace all matches for REGEXP with NEWTEXT in STRING. @@ -1424,20 +1429,19 @@ (defun gnus-select-frame-set-input-focus (frame) "Select FRAME, raise it, and set input focus, if possible." (cond ((featurep 'xemacs) - (raise-frame frame) - (select-frame frame) - (focus-frame frame)) - ;; The function `select-frame-set-input-focus' won't set - ;; the input focus under Emacs 21.2 and X window system. - ;;((fboundp 'select-frame-set-input-focus) - ;; (defalias 'gnus-select-frame-set-input-focus - ;; 'select-frame-set-input-focus) - ;; (select-frame-set-input-focus frame)) + (if (fboundp 'select-frame-set-input-focus) + (select-frame-set-input-focus frame) + (raise-frame frame) + (select-frame frame) + (focus-frame frame))) + ;; `select-frame-set-input-focus' defined in Emacs 21 will not + ;; set the input focus. + ((>= emacs-major-version 22) + (select-frame-set-input-focus frame)) (t (raise-frame frame) (select-frame frame) - (cond ((and (eq window-system 'x) - (fboundp 'x-focus-frame)) + (cond ((memq window-system '(x mac)) (x-focus-frame frame)) ((eq window-system 'w32) (w32-focus-frame frame)))
--- a/lisp/gnus/message.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/message.el Fri Apr 21 05:39:14 2006 +0000 @@ -37,6 +37,7 @@ (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary (require 'canlock) (require 'mailheader) +(require 'gmm-utils) (require 'nnheader) ;; This is apparently necessary even though things are autoloaded. ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better @@ -2529,7 +2530,7 @@ (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t)) (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) + (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) (gnus-make-local-hook 'after-change-functions) @@ -6586,53 +6587,123 @@ ;; Support for toolbar (eval-when-compile - (defvar tool-bar-map) (defvar tool-bar-mode)) -(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) - ;; We need to make tool bar entries in local keymaps with - ;; `tool-bar-local-item-from-menu' in Emacs >= 22 - (if (fboundp 'tool-bar-local-item-from-menu) - (tool-bar-local-item-from-menu command icon in-map from-map props) - (tool-bar-add-item-from-menu command icon from-map props))) - -(defun message-tool-bar-map () - (or message-tool-bar-map - (setq message-tool-bar-map - (and - (condition-case nil (require 'tool-bar) (error nil)) - (fboundp 'tool-bar-add-item-from-menu) +;; Note: The :set function in the `message-tool-bar*' variables will only +;; affect _new_ message buffers. We might add a function that walks thru all +;; message-mode buffers and force the update. +(defun message-tool-bar-update (&optional symbol value) + "Update message mode toolbar. +Setter function for custom variables." + (setq-default message-tool-bar-map nil) + (when symbol + ;; When used as ":set" function: + (set-default symbol value))) + +(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'message-tool-bar-gnome + 'message-tool-bar-retro) + "Specifies the message mode tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `message-mode-map'. + +Pre-defined symbols include `message-tool-bar-gnome' and +`message-tool-bar-retro'." + :type '(repeat gmm-tool-bar-list-item) + :type '(choice (const :tag "GNOME style" message-tool-bar-gnome) + (const :tag "Retro look" message-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-gnome + '((ispell-message "spell" nil + :visible (or (not (boundp 'flyspell-mode)) + (not flyspell-mode))) + (flyspell-buffer "spell" t + :visible (and (boundp 'flyspell-mode) + flyspell-mode) + :help "Flyspell whole buffer") + (gmm-ignore "separator") + (message-send-and-exit "mail/send") + (message-dont-send "mail/save-draft") + (message-kill-buffer "close") ;; stock_cancel + (mml-attach-file "attach" mml-mode-map) + (mml-preview "mail/preview" mml-mode-map) + ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) + (message-insert-importance-high "important" nil :visible nil) + (message-insert-importance-low "unimportant" nil :visible nil) + (message-insert-disposition-notification-to "receipt" nil :visible nil) + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (message-info "help" t :help "Message manual")) + "List of items for the message tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for details on the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-retro + '(;; Old Emacs 21 icon for consistency. + (message-send-and-exit "gnus/mail_send") + (message-kill-buffer "close") + (message-dont-send "cancel") + (mml-attach-file "attach" mml-mode-map) + (ispell-message "spell") + (mml-preview "preview" mml-mode-map) + (message-insert-importance-high "gnus/important") + (message-insert-importance-low "gnus/unimportant") + (message-insert-disposition-notification-to "gnus/receipt")) + "List of items for the message tool bar (retro style). + +See `gmm-tool-bar-from-list' for details on the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-zap-list + '(new-file open-file dired kill-buffer write-file + print-buffer customize help) + "List of icon items from the global tool bar. +These items are not displayed on the message mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defvar image-load-path) + +(defun message-make-tool-bar (&optional force) + "Make a message mode tool bar from `message-tool-bar-list'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) tool-bar-mode - (let ((tool-bar-map (copy-keymap tool-bar-map)) - (load-path (mm-image-load-path))) - ;; Zap some items which aren't so relevant and take - ;; up space. - (dolist (key '(print-buffer kill-buffer save-buffer - write-file dired open-file)) - (define-key tool-bar-map (vector key) nil)) - (message-tool-bar-local-item-from-menu - 'message-send-and-exit "mail/send" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-kill-buffer "close" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-dont-send "cancel" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'mml-attach-file "attach" tool-bar-map mml-mode-map) - (message-tool-bar-local-item-from-menu - 'ispell-message "spell" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'mml-preview "preview" - tool-bar-map mml-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-importance-high "important" - tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-importance-low "unimportant" - tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-disposition-notification-to "receipt" - tool-bar-map message-mode-map) - tool-bar-map))))) + (or (not message-tool-bar-map) force)) + (setq message-tool-bar-map + (let* ((load-path + (gmm-image-load-path-for-library "message" + "mail/save-draft.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (gmm-tool-bar-from-list message-tool-bar + message-tool-bar-zap-list + 'message-mode-map)))) + message-tool-bar-map) ;;; Group name completion.
--- a/lisp/gnus/mm-bodies.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/mm-bodies.el Fri Apr 21 05:39:14 2006 +0000 @@ -56,6 +56,8 @@ ;; known to break servers. ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], ;; so this can't happen :-/. + ;; PPS: Yes, it can happen if the user specifies UTF-16 in the MML + ;; markup. - jh. (utf-16 . base64) (utf-16be . base64) (utf-16le . base64)) @@ -250,7 +252,10 @@ (mm-decode-content-transfer-encoding encoding type)) (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. (not (eq charset 'gnus-decoded))) - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + charset nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) @@ -281,7 +286,11 @@ (setq charset mail-parse-charset)) (or (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + charset + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets))
--- a/lisp/gnus/mm-util.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/gnus/mm-util.el Fri Apr 21 05:39:14 2006 +0000 @@ -177,6 +177,29 @@ ;; no-MULE XEmacs: (car (memq cs (mm-get-coding-system-list)))))) +(defun mm-codepage-setup (number &optional alias) + "Create a coding system cpNUMBER. +The coding system is created using `codepage-setup'. If ALIAS is +non-nil, an alias is created and added to +`mm-charset-synonym-alist'. If ALIAS is a string, it's used as +the alias. Else windows-NUMBER is used." + (interactive + (let ((completion-ignore-case t) + (candidates (cp-supported-codepages))) + (list (completing-read "Setup DOS Codepage: (default 437) " candidates + nil t nil nil "437")))) + (when alias + (setq alias (if (stringp alias) + (intern alias) + (intern (format "windows-%s" number))))) + (let* ((cp (intern (format "cp%s" number)))) + (unless (mm-coding-system-p cp) + (codepage-setup number)) + (when (and alias + ;; Don't add alias if setup of cp failed. + (mm-coding-system-p cp)) + (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) + (defvar mm-charset-synonym-alist `( ;; Not in XEmacs, but it's not a proper MIME charset anyhow. @@ -200,8 +223,61 @@ ,@(if (and (not (mm-coding-system-p 'windows-1250)) (mm-coding-system-p 'cp1250)) '((windows-1250 . cp1250))) + ;; A Microsoft misunderstanding. + ,@(if (and (not (mm-coding-system-p 'unicode)) + (mm-coding-system-p 'utf-16-le)) + '((unicode . utf-16-le))) + ;; A Microsoft misunderstanding. + ,@(unless (mm-coding-system-p 'ks_c_5601-1987) + (if (mm-coding-system-p 'cp949) + '((ks_c_5601-1987 . cp949)) + '((ks_c_5601-1987 . euc-kr)))) ) - "A mapping from invalid charset names to the real charset names.") + "A mapping from unknown or invalid charset names to the real charset names.") + +(defcustom mm-charset-override-alist + `((iso-8859-1 . windows-1252)) + "A mapping from undesired charset names to their replacement. + +You may add pairs like (iso-8859-1 . windows-1252) here, +i.e. treat iso-8859-1 as windows-1252. windows-1252 is a +superset of iso-8859-1." + :type '(list (set :inline t + (const (iso-8859-1 . windows-1252)) + (const (undecided . windows-1252))) + (repeat :inline t + :tag "Other options" + (cons (symbol :tag "From charset") + (symbol :tag "To charset")))) + :version "23.0" ;; No Gnus + :group 'mime) + +(defcustom mm-charset-eval-alist + (if (featurep 'xemacs) + nil ;; I don't know what would be useful for XEmacs. + '(;; Emacs 21 offers 1250 1251 1253 1257. Emacs 22 provides autoloads for + ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing). + (windows-1250 . (mm-codepage-setup 1250 t)) + (windows-1251 . (mm-codepage-setup 1251 t)) + (windows-1253 . (mm-codepage-setup 1253 t)) + (windows-1257 . (mm-codepage-setup 1257 t)))) + "An alist of (CHARSET . FORM) pairs. +If an article is encoded in an unknown CHARSET, FORM is +evaluated. This allows to load additional libraries providing +charsets on demand. If supported by your Emacs version, you +could use `autoload-coding-system' here." + :version "23.0" ;; No Gnus + :type '(list (set :inline t + (const (windows-1250 . (mm-codepage-setup 1250 t))) + (const (windows-1251 . (mm-codepage-setup 1251 t))) + (const (windows-1253 . (mm-codepage-setup 1253 t))) + (const (windows-1257 . (mm-codepage-setup 1257 t))) + (const (cp850 . (mm-codepage-setup 850 nil)))) + (repeat :inline t + :tag "Other options" + (cons (symbol :tag "charset") + (symbol :tag "form")))) + :group 'mime) (defvar mm-binary-coding-system (cond @@ -396,11 +472,17 @@ (pop alist)) out))) -(defun mm-charset-to-coding-system (charset &optional lbt) +(defun mm-charset-to-coding-system (charset &optional lbt + allow-override) "Return coding-system corresponding to CHARSET. CHARSET is a symbol naming a MIME charset. If optional argument LBT (`unix', `dos' or `mac') is specified, it is -used as the line break code type of the coding system." +used as the line break code type of the coding system. + +If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to +map undesired charset names to their replacement. This should +only be used for decoding, not for encoding." + ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'. (when (stringp charset) (setq charset (intern (downcase charset)))) (when lbt @@ -412,6 +494,11 @@ ((or (null (mm-get-coding-system-list)) (not (fboundp 'coding-system-get))) charset) + ;; Check override list quite early. Should only used for decoding, not for + ;; encoding! + ((and allow-override + (let ((cs (cdr (assq charset mm-charset-override-alist)))) + (and cs (mm-coding-system-p cs) cs)))) ;; ascii ((eq charset 'us-ascii) 'ascii) @@ -424,9 +511,27 @@ ;;; (eq charset (coding-system-get charset 'mime-charset)) ) charset) + ;; Eval expressions from `mm-charset-eval-alist' + ((let* ((el (assq charset mm-charset-eval-alist)) + (cs (car el)) + (form (cdr el))) + (and cs + form + (prog2 + ;; Avoid errors... + (condition-case nil (eval form) (error nil)) + ;; (message "Failed to eval `%s'" form)) + (mm-coding-system-p cs) + (message "Added charset `%s' via `mm-charset-eval-alist'" cs)) + cs))) ;; Translate invalid charsets. ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) - (and cs (mm-coding-system-p cs) cs))) + (and cs + (mm-coding-system-p cs) + ;; (message + ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'" + ;; cs charset) + cs))) ;; Last resort: search the coding system list for entries which ;; have the right mime-charset in case the canonical name isn't ;; defined (though it should be). @@ -438,6 +543,11 @@ (eq charset (or (coding-system-get c :mime-charset) (coding-system-get c 'mime-charset)))) (setq cs c))) + (unless cs + ;; Warn the user about unknown charset: + (if (fboundp 'gnus-message) + (gnus-message 7 "Unknown charset: %s" charset) + (message "Unknown charset: %s" charset))) cs)))) (defsubst mm-replace-chars-in-string (string from to) @@ -1001,7 +1111,8 @@ (defun mm-detect-mime-charset-region (start end) "Detect MIME charset of the text in the region between START and END." (let ((cs (mm-detect-coding-region start end))) - (coding-system-get cs 'mime-charset))) + (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset)))) (defun mm-detect-mime-charset-region (start end) "Detect MIME charset of the text in the region between START and END." (let ((cs (mm-detect-coding-region start end)))
--- a/lisp/help-mode.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/help-mode.el Fri Apr 21 05:39:14 2006 +0000 @@ -197,6 +197,7 @@ (view-mode) (make-local-variable 'view-no-disable-on-exit) (setq view-no-disable-on-exit t) + (setq view-exit-action (lambda (buffer) (delete-window))) (run-mode-hooks 'help-mode-hook)) ;;;###autoload
--- a/lisp/image-mode.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/image-mode.el Fri Apr 21 05:39:14 2006 +0000 @@ -139,7 +139,11 @@ ;; was inserted (let* ((image (if (and (buffer-file-name) - (not (buffer-modified-p))) + (not (buffer-modified-p)) + (not (and (boundp 'archive-superior-buffer) + archive-superior-buffer)) + (not (and (boundp 'tar-superior-buffer) + tar-superior-buffer))) (progn (clear-image-cache) (create-image (buffer-file-name))) (create-image
--- a/lisp/imenu.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/imenu.el Fri Apr 21 05:39:14 2006 +0000 @@ -208,18 +208,13 @@ ;;;###autoload (defvar imenu-create-index-function 'imenu-default-create-index-function - "The function to use for creating a buffer index. - -It should be a function that takes no arguments and returns an index -of the current buffer as an alist. + "The function to use for creating an index alist of the current buffer. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). -The function `imenu--subalist-p' tests an element and returns t -if it is a sub-alist. +It should be a function that takes no arguments and returns +an index alist of the current buffer. The function is +called within a `save-excursion'. -This function is called within a `save-excursion'.") +See `imenu--index-alist' for the format of the buffer index alist.") ;;;###autoload (make-variable-buffer-local 'imenu-create-index-function) @@ -431,15 +426,27 @@ ;; The latest buffer index. ;; Buffer local. (defvar imenu--index-alist nil - "The buffer index computed for this buffer in Imenu. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).") + "The buffer index alist computed for this buffer in Imenu. + +Simple elements in the alist look like (INDEX-NAME . POSITION). +POSITION is the buffer position of the item; to go to the item +is simply to move point to that position. + +Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...). +To \"go to\" a special element means applying FUNCTION +to INDEX-NAME, POSITION, and the ARGUMENTS. + +A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). +The function `imenu--subalist-p' tests an element and returns t +if it is a sub-alist. + +There is one simple element with negative POSITION; selecting that +element recalculates the buffer's index alist.") (make-variable-buffer-local 'imenu--index-alist) (defvar imenu--last-menubar-index-alist nil - "The latest buffer index used to update the menu bar menu.") + "The latest buffer index alist used to update the menu bar menu.") (make-variable-buffer-local 'imenu--last-menubar-index-alist) @@ -547,19 +554,12 @@ (defun imenu--make-index-alist (&optional noerror) - "Create an index-alist for the definitions in the current buffer. - + "Create an index alist for the definitions in the current buffer. +This works by using the hook function `imenu-create-index-function'. Report an error if the list is empty unless NOERROR is supplied and non-nil. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). -The function `imenu--subalist-p' tests an element and returns t -if it is a sub-alist. - -There is one simple element with negative POSITION; that's intended -as a way for the user to ask to recalculate the buffer's index alist." +See `imenu--index-alist' for the format of the index alist." (or (and imenu--index-alist (or (not imenu-auto-rescan) (and imenu-auto-rescan @@ -657,11 +657,15 @@ (make-variable-buffer-local 'imenu-syntax-alist) (defun imenu-default-create-index-function () - "*Wrapper for index searching functions. + "*Default function to create an index alist of the current buffer. -Moves point to end of buffer and then repeatedly calls +The most general method is to move point to end of buffer, then repeatedly call `imenu-prev-index-position-function' and `imenu-extract-index-name-function'. -Their results are gathered into an index alist." +All the results returned by the latter are gathered into an index alist. +This method is used if those two variables are non-nil. + +The alternate method, which is the one most often used, is to call +`imenu--generic-function' with `imenu-generic-expression' as argument." ;; These should really be done by setting imenu-create-index-function ;; in these major modes. But save that change for later. (cond ((and imenu-prev-index-position-function @@ -687,27 +691,6 @@ (t (error "This buffer cannot use `imenu-default-create-index-function'")))) -;; Not used and would require cl at run time -;; (defun imenu--flatten-index-alist (index-alist &optional concat-names prefix) -;; ;; Takes a nested INDEX-ALIST and returns a flat index alist. -;; ;; If optional CONCAT-NAMES is non-nil, then a nested index has its -;; ;; name and a space concatenated to the names of the children. -;; ;; Third argument PREFIX is for internal use only. -;; (mapcan -;; (lambda (item) -;; (let* ((name (car item)) -;; (pos (cdr item)) -;; (new-prefix (and concat-names -;; (if prefix -;; (concat prefix imenu-level-separator name) -;; name)))) -;; (cond -;; ((or (markerp pos) (numberp pos)) -;; (list (cons new-prefix pos))) -;; (t -;; (imenu--flatten-index-alist pos new-prefix))))) -;; index-alist)) - ;;; ;;; Generic index gathering function. ;;; @@ -724,7 +707,7 @@ ;; This function can be called with quitting disabled, ;; so it needs to be careful never to loop! (defun imenu--generic-function (patterns) - "Return an index of the current buffer as an alist. + "Return an index alist of the current buffer based on PATTERNS. PATTERNS is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX) @@ -732,9 +715,8 @@ (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) with zero or more ARGUMENTS. The former format creates a simple element in the index alist when it matches; the latter creates a -special element of the form (NAME POSITION-MARKER FUNCTION -ARGUMENTS...) with FUNCTION and ARGUMENTS copied from -`imenu-generic-expression'. +special element of the form (INDEX-NAME POSITION-MARKER FUNCTION +ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS. MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested.
--- a/lisp/mail/rmail.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mail/rmail.el Fri Apr 21 05:39:14 2006 +0000 @@ -1994,7 +1994,7 @@ (re-search-backward rmail-mime-charset-pattern start t)))) - (intern (downcase (match-string 1)))))) + (intern (downcase (match-string 2)))))) (rmail-decode-region start (point) mime-charset))))) ;; Add an X-Coding-System: header if we don't have one. (save-excursion @@ -2155,7 +2155,7 @@ (re-search-backward rmail-mime-charset-pattern start t)))) - (intern (downcase (match-string 1)))))) + (intern (downcase (match-string 2)))))) (rmail-decode-region start (point) mime-charset))) (save-excursion (goto-char start)
--- a/lisp/mh-e/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,83 @@ +2006-04-20 Bill Wohler <wohler@newt.com> + + * mh-tool-bar.el (image-load-path): Define to shush compiler. + (mh-buffer-exists-p): Move inside mh-do-in-gnu-emacs since it + isn't used outside of it. + (mh-tool-bar-folder-buttons-init, + mh-tool-bar-letter-buttons-init): Update load-path/image-load-path + before setting buttons. This code used to be in + mh-folder-mode/mh-letter-mode but this was the wrong place since + mh-tool-bar-*-buttons-init can also be called when customizing the + buttons. + (mh-tool-bar-update): New function which updates tool-bar-map in + all of the MH-E buffers after customizing the buttons (closes SF + #1452718). + (mh-tool-bar-folder-buttons-set, mh-tool-bar-letter-buttons-set): + Call it (closes SF #1452718). + + * mh-folder.el (mh-folder-buttons-init-flag): Delete. Use + mh-folder-tool-bar-map instead. + (image-load-path): Delete. No longer used. + (mh-folder-mode): Moved setting of image-load-path into + mh-tool-bar-folder-buttons-init. + + * mh-letter.el (mh-letter-buttons-init-flag): Delete. Use + mh-letter-tool-bar-map instead. + (image-load-path): Delete. No longer used. + (mh-letter-mode): Moved setting of image-load-path into + mh-tool-bar-letter-buttons-init. + + * mh-seq.el (mh-narrow-to-seq, mh-widen): Use with-current-buffer + instead of set-buffer. + +2006-04-19 Bill Wohler <wohler@newt.com> + + * mh-tool-bar.el (mh-tool-bar-define): Fix enable-expr so that one + can permanently disable a button (such as a separator) with nil. + +2006-04-18 Bill Wohler <wohler@newt.com> + + * mh-e.el (defcustom-mh, defface-mh, defgroup-mh, mh-face-data) + (mh-strip-package-version, mh-face-data, mh-inherit-face-flag) + (mh-min-colors-defined-flag): Do not unbind these macros and + variables. Nice idea, but too many nasty side-effects. These + macros are needed by [Cc]ustom-make-dependencies when creating the + MH-E customization groups in mh-cus-load.el. These disappeared + when the macros above were introduced. Besides, if a developer + were to try to show the help for a macro or variable they were + looking at and got [No match] when they did so, that would be bad. + +2006-04-17 Bill Wohler <wohler@newt.com> + + * mh-comp.el (mh-insert-x-mailer): Strip build number from + version in X-Mailer field (closes SF #1466481). + + * mh-acros.el (mh-defun-compat): Rename to defun-mh in order that + variables and functions with the same name are found correctly by + find-func (invoked by clicking on the filename link in the *Help* + buffer). + (mh-defmacro-compat): Rename to defmacro-mh. Ditto. + * mh-e.el: (mh-defgroup): Rename to defgroup-mh. Ditto. + (mh-defcustom): Rename to defcustom-mh. Ditto. + (mh-defface): Rename to defface-mh. Ditto. + (mh-font-lock-add-keywords): Make changes according to these + renamings. + + * mh-e.el, mh-compat.el, mh-gnus.el: Use the new names (closes SF + #1472029). + + * mh-utils.el (mh-sub-folders-actual): Mention that folder must + have been processed by mh-normalize-folder-name. + (mh-folder-completion-function): Handle completion of folders with + absolute names. Also, when flag is t, display complete folder name + to provide proper highlighting in Emacs 22 now that + minibuffer-completing-file-name is nil (closes SF #1470518). + (mh-folder-completing-read): No longer set + minibuffer-completing-file-name to t. This was causing "Can't set + current directory errors" when browsing absolute file names. + Another benefit of this change is that SPC can be used for + completion again (closes SF #1470518). + 2006-04-15 Bill Wohler <wohler@newt.com> * mh-compat.el (mh-font-lock-add-keywords): Fix typo in docstring. @@ -147,7 +227,7 @@ (mh-scan-line-formats, mh-search, mh-sending-mail) (mh-sequences, mh-show, mh-speedbar, mh-thread, mh-tool-bar) (mh-hooks, mh-faces): Add :package-version keyword to these - groups. + groups (closes SF #1452724). (mh-alias-completion-ignore-case-flag) (mh-alias-expand-aliases-flag, mh-alias-flash-on-comma) (mh-alias-insert-file, mh-alias-insertion-location) @@ -193,7 +273,7 @@ (mh-show-use-xface-flag, mh-store-default-directory) (mh-summary-height, mh-speed-update-interval) (mh-show-threads-flag, mh-tool-bar-search-function): Add - :package-version keyword to these options. + :package-version keyword to these options (closes SF #1452724). (mh-after-commands-processed-hook) (mh-alias-reloaded-hook, mh-before-commands-processed-hook) (mh-before-quit-hook, mh-before-send-letter-hook) @@ -204,7 +284,7 @@ (mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook) (mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook) (mh-unseen-updated-hook): Add :package-version keyword to these - hooks. + hooks (closes SF #1452724). (mh-min-colors-defined-flag) (mh-folder-address, mh-folder-body, mh-folder-cur-msg-number) (mh-folder-date, mh-folder-deleted, mh-folder-followup) @@ -218,10 +298,10 @@ (mh-speedbar-folder, mh-speedbar-folder-with-unseen-messages) (mh-speedbar-selected-folder) (mh-speedbar-selected-folder-with-unseen-messages): : Add - :package-version keyword to these faces. + :package-version keyword to these faces (closes SF #1452724). * mh-tool-bar.el (mh-tool-bar-define): Added commented-out - :package-version keywords. + :package-version keywords (closes SF #1452724). 2006-03-28 Bill Wohler <wohler@newt.com>
--- a/lisp/mh-e/mh-acros.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-acros.el Fri Apr 21 05:39:14 2006 +0000 @@ -82,7 +82,7 @@ (funcall ',function ,@args)))) ;;;###mh-autoload -(defmacro mh-defun-compat (name function arg-list &rest body) +(defmacro defun-mh (name function arg-list &rest body) "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." @@ -90,10 +90,10 @@ (if defined-p `(defalias ',name ',function) `(defun ,name ,arg-list ,@body)))) -(put 'mh-defun-compat 'lisp-indent-function 'defun) +(put 'defun-mh 'lisp-indent-function 'defun) ;;;###mh-autoload -(defmacro mh-defmacro-compat (name macro arg-list &rest body) +(defmacro defmacro-mh (name macro arg-list &rest body) "Create macro NAME. If MACRO exists, then NAME becomes an alias for MACRO. Otherwise, create macro NAME with ARG-LIST and BODY." @@ -101,7 +101,7 @@ (if defined-p `(defalias ',name ',macro) `(defmacro ,name ,arg-list ,@body)))) -(put 'mh-defmacro-compat 'lisp-indent-function 'defun) +(put 'defmacro-mh 'lisp-indent-function 'defun)
--- a/lisp/mh-e/mh-comp.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-comp.el Fri Apr 21 05:39:14 2006 +0000 @@ -912,7 +912,10 @@ (format "MH-E %s; %s; %sEmacs %s" mh-version mh-variant-in-use (if mh-xemacs-flag "X" "GNU ") - (cond ((not mh-xemacs-flag) emacs-version) + (cond ((not mh-xemacs-flag) + (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?" + emacs-version) + (match-string 0 emacs-version)) ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" emacs-version) (match-string 0 emacs-version))
--- a/lisp/mh-e/mh-compat.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-compat.el Fri Apr 21 05:39:14 2006 +0000 @@ -62,7 +62,7 @@ (load filename noerror t) (load (format "%s" feature) noerror t))))) -(mh-defun-compat mh-assoc-string assoc-string (key list case-fold) +(defun-mh mh-assoc-string assoc-string (key list case-fold) "Like `assoc' but specifically for strings. Case is ignored if CASE-FOLD is non-nil. This function is used by Emacs versions that lack `assoc-string', @@ -77,7 +77,7 @@ 'cancel-timer 'delete-itimer)) -(mh-defun-compat mh-display-color-cells display-color-cells (&optional display) +(defun-mh mh-display-color-cells display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. This function is used by XEmacs to return 2 when `device-color-cells' returns nil. This happens when compiling or @@ -115,12 +115,12 @@ `(face-background ,face ,frame) `(face-background ,face ,frame ,inherit))) -(mh-defun-compat mh-font-lock-add-keywords font-lock-add-keywords +(defun-mh mh-font-lock-add-keywords font-lock-add-keywords (mode keywords &optional how) "XEmacs does not have `font-lock-add-keywords'. This function returns nil on that system.") -(mh-defun-compat mh-image-load-path-for-library +(defun-mh mh-image-load-path-for-library image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -215,7 +215,7 @@ (nconc (list image-directory) (delete image-directory (copy-sequence (or path load-path)))))) -(mh-defun-compat mh-image-search-load-path +(defun-mh mh-image-search-load-path image-search-load-path (file &optional path) "Emacs 21 and XEmacs don't have `image-search-load-path'. This function returns nil on those systems." @@ -234,13 +234,13 @@ 'point-at-eol)) (mh-require 'mailabbrev nil t) -(mh-defun-compat mh-mail-abbrev-make-syntax-table +(defun-mh mh-mail-abbrev-make-syntax-table mail-abbrev-make-syntax-table () "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'. This function returns nil on those systems." nil) -(mh-defun-compat mh-match-string-no-properties +(defun-mh mh-match-string-no-properties match-string-no-properties (num &optional string) "Return string of text matched by last search, without text properties. This function is used by XEmacs that lacks `match-string-no-properties'. @@ -249,7 +249,7 @@ (buffer-substring-no-properties (match-beginning num) (match-end num))) -(mh-defun-compat mh-replace-regexp-in-string replace-regexp-in-string +(defun-mh mh-replace-regexp-in-string replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace REGEXP with REP everywhere in STRING and return result. This function is used by XEmacs that lacks `replace-regexp-in-string'. @@ -269,7 +269,7 @@ "A list of characters that are _NOT_ reserved in the URL spec. This is taken from RFC 2396.")) -(mh-defun-compat mh-url-hexify-string url-hexify-string (str) +(defun-mh mh-url-hexify-string url-hexify-string (str) "Escape characters in a string. This is a copy of `url-hexify-string' from url-util.el in Emacs 22; needed by Emacs 21." @@ -283,7 +283,7 @@ (char-to-string char))) str "")) -(mh-defun-compat mh-view-mode-enter +(defun-mh mh-view-mode-enter view-mode-enter (&optional return-to exit-action) "Enter View mode. This function is used by XEmacs that lacks `view-mode-enter'.
--- a/lisp/mh-e/mh-e.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-e.el Fri Apr 21 05:39:14 2006 +0000 @@ -114,11 +114,11 @@ (eval-when-compile `((,(concat "(\\(" ;; Function declarations (use font-lock-function-name-face). - "\\(mh-def\\(un\\|macro\\)-compat\\)\\|" + "\\(def\\(un\\|macro\\)-mh\\)\\|" ;; Variable declarations (use font-lock-variable-name-face). - "\\(mh-def\\(custom\\|face\\)\\)\\|" + "\\(def\\(custom\\|face\\)-mh\\)\\|" ;; Group declarations (use font-lock-type-face). - "\\(mh-defgroup\\)" + "\\(defgroup-mh\\)" "\\)\\>" ;; Any whitespace and defined object. "[ \t'\(]*" @@ -684,7 +684,7 @@ (t t)) collect keyword)))) -(defmacro mh-defgroup (symbol members doc &rest args) +(defmacro defgroup-mh (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. See documentation for `defgroup' for a description of the arguments SYMBOL, MEMBERS, DOC and ARGS. @@ -692,9 +692,9 @@ keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args))) -(put 'mh-defgroup 'lisp-indent-function 'defun) - -(defmacro mh-defcustom (symbol value doc &rest args) +(put 'defgroup-mh 'lisp-indent-function 'defun) + +(defmacro defcustom-mh (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. See documentation for `defcustom' for a description of the arguments SYMBOL, VALUE, DOC and ARGS. @@ -702,9 +702,9 @@ keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args))) -(put 'mh-defcustom 'lisp-indent-function 'defun) - -(defmacro mh-defface (face spec doc &rest args) +(put 'defcustom-mh 'lisp-indent-function 'defun) + +(defmacro defface-mh (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. See documentation for `defface' for a description of the arguments FACE, SPEC, DOC and ARGS. @@ -712,13 +712,13 @@ keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defface ,face ,spec ,doc ,@(mh-strip-package-version args))) -(put 'mh-defface 'lisp-indent-function 'defun) +(put 'defface-mh 'lisp-indent-function 'defun) ;;; Variant Support -(mh-defcustom mh-path nil +(defcustom-mh mh-path nil "*Additional list of directories to search for MH. See `mh-variant'." :group 'mh-e @@ -932,7 +932,7 @@ (mapconcat '(lambda (x) (format "%s" (car x))) (mh-variants) " or ")))))) -(mh-defcustom mh-variant 'autodetect +(defcustom-mh mh-variant 'autodetect "*Specifies the variant used by MH-E. The default setting of this option is \"Auto-detect\" which means @@ -1017,7 +1017,7 @@ ;;; MH-E Customization Groups -(mh-defgroup mh-e nil +(defgroup-mh mh-e nil "Emacs interface to the MH mail system. MH is the Rand Mail Handler. Other implementations include nmh and GNU mailutils." @@ -1025,126 +1025,126 @@ :group 'mail :package-version '(MH-E . "8.0")) -(mh-defgroup mh-alias nil +(defgroup-mh mh-alias nil "Aliases." :link '(custom-manual "(mh-e)Aliases") :prefix "mh-alias-" :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-folder nil +(defgroup-mh mh-folder nil "Organizing your mail with folders." :prefix "mh-" :link '(custom-manual "(mh-e)Folders") :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-folder-selection nil +(defgroup-mh mh-folder-selection nil "Folder selection." :prefix "mh-" :link '(custom-manual "(mh-e)Folder Selection") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-identity nil +(defgroup-mh mh-identity nil "Identities." :link '(custom-manual "(mh-e)Identities") :prefix "mh-identity-" :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-inc nil +(defgroup-mh mh-inc nil "Incorporating your mail." :prefix "mh-inc-" :link '(custom-manual "(mh-e)Incorporating Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-junk nil +(defgroup-mh mh-junk nil "Dealing with junk mail." :link '(custom-manual "(mh-e)Junk") :prefix "mh-junk-" :group 'mh-e :package-version '(MH-E . "7.3")) -(mh-defgroup mh-letter nil +(defgroup-mh mh-letter nil "Editing a draft." :prefix "mh-" :link '(custom-manual "(mh-e)Editing Drafts") :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-ranges nil +(defgroup-mh mh-ranges nil "Ranges." :prefix "mh-" :link '(custom-manual "(mh-e)Ranges") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-scan-line-formats nil +(defgroup-mh mh-scan-line-formats nil "Scan line formats." :link '(custom-manual "(mh-e)Scan Line Formats") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-search nil +(defgroup-mh mh-search nil "Searching." :link '(custom-manual "(mh-e)Searching") :prefix "mh-search-" :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-sending-mail nil +(defgroup-mh mh-sending-mail nil "Sending mail." :prefix "mh-" :link '(custom-manual "(mh-e)Sending Mail") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-sequences nil +(defgroup-mh mh-sequences nil "Sequences." :prefix "mh-" :link '(custom-manual "(mh-e)Sequences") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-show nil +(defgroup-mh mh-show nil "Reading your mail." :prefix "mh-" :link '(custom-manual "(mh-e)Reading Mail") :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-speedbar nil +(defgroup-mh mh-speedbar nil "The speedbar." :prefix "mh-speed-" :link '(custom-manual "(mh-e)Speedbar") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-thread nil +(defgroup-mh mh-thread nil "Threading." :prefix "mh-thread-" :link '(custom-manual "(mh-e)Threading") :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-tool-bar nil +(defgroup-mh mh-tool-bar nil "The tool bar" :link '(custom-manual "(mh-e)Tool Bar") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "8.0")) -(mh-defgroup mh-hooks nil +(defgroup-mh mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e :package-version '(MH-E . "7.1")) -(mh-defgroup mh-faces nil +(defgroup-mh mh-faces nil "Faces used in MH-E." :link '(custom-manual "(mh-e)Top") :prefix "mh-" @@ -1160,7 +1160,7 @@ ;;; Aliases (:group 'mh-alias) -(mh-defcustom mh-alias-completion-ignore-case-flag t +(defcustom-mh mh-alias-completion-ignore-case-flag t "*Non-nil means don't consider case significant in MH alias completion. As MH ignores case in the aliases, so too does MH-E. However, you @@ -1171,7 +1171,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-expand-aliases-flag nil +(defcustom-mh mh-alias-expand-aliases-flag nil "*Non-nil means to expand aliases entered in the minibuffer. In other words, aliases entered in the minibuffer will be @@ -1181,7 +1181,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-flash-on-comma t +(defcustom-mh mh-alias-flash-on-comma t "*Specify whether to flash address or warn on translation. This option controls the behavior when a [comma] is pressed while @@ -1194,7 +1194,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-insert-file nil +(defcustom-mh mh-alias-insert-file nil "*Filename used to store a new MH-E alias. The default setting of this option is \"Use Aliasfile Profile @@ -1208,7 +1208,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-insertion-location 'sorted +(defcustom-mh mh-alias-insertion-location 'sorted "Specifies where new aliases are entered in alias files. This option is set to \"Alphabetical\" by default. If you organize @@ -1220,7 +1220,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-local-users t +(defcustom-mh mh-alias-local-users t "*If on, local users are added to alias completion. Aliases are created from \"/etc/passwd\" entries with a user ID @@ -1241,7 +1241,7 @@ :group 'mh-alias :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-local-users-prefix "local." +(defcustom-mh mh-alias-local-users-prefix "local." "*String prefixed to the real names of users from the password file. This option can also be set to \"Use Login\". @@ -1263,7 +1263,7 @@ :group 'mh-alias :package-version '(MH-E . "7.4")) -(mh-defcustom mh-alias-passwd-gecos-comma-separator-flag t +(defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t "*Non-nil means the gecos field in the password file uses a comma separator. In the example in `mh-alias-local-users-prefix', commas are used @@ -1277,7 +1277,7 @@ ;;; Organizing Your Mail with Folders (:group 'mh-folder) -(mh-defcustom mh-new-messages-folders t +(defcustom-mh mh-new-messages-folders t "Folders searched for the \"unseen\" sequence. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1292,7 +1292,7 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defcustom mh-ticked-messages-folders t +(defcustom-mh mh-ticked-messages-folders t "Folders searched for `mh-tick-seq'. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1307,7 +1307,7 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defcustom mh-large-folder 200 +(defcustom-mh mh-large-folder 200 "The number of messages that indicates a large folder. If a folder is deemed to be large, that is the number of messages @@ -1319,7 +1319,7 @@ :group 'mh-folder :package-version '(MH-E . "7.0")) -(mh-defcustom mh-recenter-summary-flag nil +(defcustom-mh mh-recenter-summary-flag nil "*Non-nil means to recenter the summary window. If this option is turned on, recenter the summary window when the @@ -1328,13 +1328,13 @@ :group 'mh-folder :package-version '(MH-E . "7.0")) -(mh-defcustom mh-recursive-folders-flag nil +(defcustom-mh mh-recursive-folders-flag nil "*Non-nil means that commands which operate on folders do so recursively." :type 'boolean :group 'mh-folder :package-version '(MH-E . "7.0")) -(mh-defcustom mh-sortm-args nil +(defcustom-mh mh-sortm-args nil "*Additional arguments for \"sortm\"\\<mh-folder-mode-map>. This option is consulted when a prefix argument is used with @@ -1348,7 +1348,7 @@ ;;; Folder Selection (:group 'mh-folder-selection) -(mh-defcustom mh-default-folder-for-message-function nil +(defcustom-mh mh-default-folder-for-message-function nil "Function to select a default folder for refiling or \"Fcc:\". When this function is called, the current buffer contains the message @@ -1360,7 +1360,7 @@ :group 'mh-folder-selection :package-version '(MH-E . "8.0")) -(mh-defcustom mh-default-folder-list nil +(defcustom-mh mh-default-folder-list nil "*List of addresses and folders. The folder name associated with the first address found in this @@ -1378,7 +1378,7 @@ :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(mh-defcustom mh-default-folder-must-exist-flag t +(defcustom-mh mh-default-folder-must-exist-flag t "*Non-nil means guessed folder name must exist to be used. If the derived folder does not exist, and this option is on, then @@ -1392,7 +1392,7 @@ :group 'mh-folder-selection :package-version '(MH-E . "7.2")) -(mh-defcustom mh-default-folder-prefix "" +(defcustom-mh mh-default-folder-prefix "" "*Prefix used for folder names generated from aliases. The prefix is used to prevent clutter in your mail directory. @@ -1411,7 +1411,7 @@ Real definition will take effect when mh-identity is loaded." nil))) -(mh-defcustom mh-identity-list nil +(defcustom-mh mh-identity-list nil "*List of identities. To customize this option, click on the \"INS\" button and enter a label @@ -1480,7 +1480,7 @@ :group 'mh-identity :package-version '(MH-E . "7.1")) -(mh-defcustom mh-auto-fields-list nil +(defcustom-mh mh-auto-fields-list nil "List of recipients for which header lines are automatically inserted. This option can be used to set the identity depending on the @@ -1541,14 +1541,14 @@ :group 'mh-identity :package-version '(MH-E . "7.3")) -(mh-defcustom mh-auto-fields-prompt-flag t +(defcustom-mh mh-auto-fields-prompt-flag t "*Non-nil means to prompt before sending if fields inserted. See `mh-auto-fields-list'." :type 'boolean :group 'mh-identity :package-version '(MH-E . "8.0")) -(mh-defcustom mh-identity-default nil +(defcustom-mh mh-identity-default nil "Default identity to use when `mh-letter-mode' is called. See `mh-identity-list'." :type (append @@ -1559,7 +1559,7 @@ :group 'mh-identity :package-version '(MH-E . "7.1")) -(mh-defcustom mh-identity-handlers +(defcustom-mh mh-identity-handlers '(("From" . mh-identity-handler-top) (":default" . mh-identity-handler-bottom) (":attribution-verb" . mh-identity-handler-attribution-verb) @@ -1595,7 +1595,7 @@ ;;; Incorporating Your Mail (:group 'mh-inc) -(mh-defcustom mh-inc-prog "inc" +(defcustom-mh mh-inc-prog "inc" "*Program to incorporate new mail into a folder. This program generates a one-line summary for each of the new @@ -1614,7 +1614,7 @@ Real definition will take effect when mh-inc is loaded." nil))) -(mh-defcustom mh-inc-spool-list nil +(defcustom-mh mh-inc-spool-list nil "*Alternate spool files. You can use the `mh-inc-spool-list' variable to direct MH-E to @@ -1687,7 +1687,7 @@ until (executable-find (symbol-name (car element))) finally return (car element))))) -(mh-defcustom mh-junk-background nil +(defcustom-mh mh-junk-background nil "If on, spam programs are run in background. By default, the programs are run in the foreground, but this can @@ -1699,14 +1699,14 @@ :group 'mh-junk :package-version '(MH-E . "8.0")) -(mh-defcustom mh-junk-disposition nil +(defcustom-mh mh-junk-disposition nil "Disposition of junk mail." :type '(choice (const :tag "Delete Spam" nil) (string :tag "Spam Folder")) :group 'mh-junk :package-version '(MH-E . "8.0")) -(mh-defcustom mh-junk-program nil +(defcustom-mh mh-junk-program nil "Spam program that MH-E should use. The default setting of this option is \"Auto-detect\" which means @@ -1724,7 +1724,7 @@ ;;; Editing a Draft (:group 'mh-letter) -(mh-defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh) +(defcustom-mh mh-compose-insertion (if (locate-library "mml") 'mml 'mh) "Type of tags used when composing MIME messages. In addition to MH-style directives, MH-E also supports MML (MIME @@ -1738,7 +1738,7 @@ :group 'mh-letter :package-version '(MH-E . "7.0")) -(mh-defcustom mh-compose-skipped-header-fields +(defcustom-mh mh-compose-skipped-header-fields '("From" "Organization" "References" "In-Reply-To" "X-Face" "Face" "X-Image-URL" "X-Mailer") "List of header fields to skip over when navigating in draft." @@ -1746,13 +1746,13 @@ :group 'mh-letter :package-version '(MH-E . "7.4")) -(mh-defcustom mh-compose-space-does-completion-flag nil +(defcustom-mh mh-compose-space-does-completion-flag nil "*Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header." :type 'boolean :group 'mh-letter :package-version '(MH-E . "7.4")) -(mh-defcustom mh-delete-yanked-msg-window-flag nil +(defcustom-mh mh-delete-yanked-msg-window-flag nil "*Non-nil means delete any window displaying the message. This deletes the window containing the original message after @@ -1762,7 +1762,7 @@ :group 'mh-letter :package-version '(MH-E . "7.0")) -(mh-defcustom mh-extract-from-attribution-verb "wrote:" +(defcustom-mh mh-extract-from-attribution-verb "wrote:" "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. The attribution consists of the sender's name and email address @@ -1776,7 +1776,7 @@ :group 'mh-letter :package-version '(MH-E . "7.0")) -(mh-defcustom mh-ins-buf-prefix "> " +(defcustom-mh mh-ins-buf-prefix "> " "*String to put before each line of a yanked or inserted message. The prefix \"> \" is the default setting of this option. I @@ -1792,7 +1792,7 @@ :group 'mh-letter :package-version '(MH-E . "6.0")) -(mh-defcustom mh-letter-complete-function 'ispell-complete-word +(defcustom-mh mh-letter-complete-function 'ispell-complete-word "*Function to call when completing outside of address or folder fields. In the body of the message, @@ -1802,7 +1802,7 @@ :group 'mh-letter :package-version '(MH-E . "7.1")) -(mh-defcustom mh-letter-fill-column 72 +(defcustom-mh mh-letter-fill-column 72 "*Fill column to use in MH Letter mode. By default, this option is 72 to allow others to quote your @@ -1811,7 +1811,7 @@ :group 'mh-letter :package-version '(MH-E . "6.0")) -(mh-defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") +(defcustom-mh mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") "Default method to use in security tags. This option is used to select between a variety of mail security @@ -1834,7 +1834,7 @@ :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-defcustom mh-signature-file-name "~/.signature" +(defcustom-mh mh-signature-file-name "~/.signature" "*Source of user's signature. By default, the text of your signature is taken from the file @@ -1857,7 +1857,7 @@ :group 'mh-letter :package-version '(MH-E . "6.0")) -(mh-defcustom mh-signature-separator-flag t +(defcustom-mh mh-signature-separator-flag t "*Non-nil means a signature separator should be inserted. It is not recommended that you change this option since various @@ -1868,7 +1868,7 @@ :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-defcustom mh-x-face-file "~/.face" +(defcustom-mh mh-x-face-file "~/.face" "*File containing face header field to insert in outgoing mail. If the file starts with either of the strings \"X-Face:\", \"Face:\" @@ -1897,7 +1897,7 @@ :group 'mh-letter :package-version '(MH-E . "7.0")) -(mh-defcustom mh-yank-behavior 'attribution +(defcustom-mh mh-yank-behavior 'attribution "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. To include the entire message, including the entire header, use @@ -1944,7 +1944,7 @@ ;;; Ranges (:group 'mh-ranges) -(mh-defcustom mh-interpret-number-as-range-flag t +(defcustom-mh mh-interpret-number-as-range-flag t "*Non-nil means interpret a number as a range. Since one of the most frequent ranges used is \"last:N\", MH-E @@ -1964,7 +1964,7 @@ Real definition, below, uses variables that aren't defined yet." (set-default symbol value)))) -(mh-defcustom mh-adaptive-cmd-note-flag t +(defcustom-mh mh-adaptive-cmd-note-flag t "*Non-nil means that the message number width is determined dynamically. If you've created your own format to handle long message numbers, @@ -1993,7 +1993,7 @@ "unless you use \"Use MH-E scan Format\"") (set-default symbol value))) -(mh-defcustom mh-scan-format-file t +(defcustom-mh mh-scan-format-file t "Specifies the format file to pass to the scan program. The default setting for this option is \"Use MH-E scan Format\". This @@ -2032,7 +2032,7 @@ "is set to \"Use MH-E scan Format\"") (set-default symbol value))) -(mh-defcustom mh-scan-prog "scan" +(defcustom-mh mh-scan-prog "scan" "*Program used to scan messages. The name of the program that generates a listing of one line per @@ -2047,7 +2047,7 @@ ;;; Searching (:group 'mh-search) -(mh-defcustom mh-search-program nil +(defcustom-mh mh-search-program nil "Search program that MH-E shall use. The default setting of this option is \"Auto-detect\" which means @@ -2070,7 +2070,7 @@ ;;; Sending Mail (:group 'mh-sending-mail) -(mh-defcustom mh-compose-forward-as-mime-flag t +(defcustom-mh mh-compose-forward-as-mime-flag t "*Non-nil means that messages are forwarded as attachments. By default, this option is on which means that the forwarded @@ -2086,7 +2086,7 @@ :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(mh-defcustom mh-compose-letter-function nil +(defcustom-mh mh-compose-letter-function nil "Invoked when starting a new draft. However, it is the last function called before you edit your @@ -2098,13 +2098,13 @@ :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(mh-defcustom mh-compose-prompt-flag nil +(defcustom-mh mh-compose-prompt-flag nil "*Non-nil means prompt for header fields when composing a new draft." :type 'boolean :group 'mh-sending-mail :package-version '(MH-E . "7.4")) -(mh-defcustom mh-forward-subject-format "%s: %s" +(defcustom-mh mh-forward-subject-format "%s: %s" "*Format string for forwarded message subject. This option is a string which includes two escapes (\"%s\"). The @@ -2114,7 +2114,7 @@ :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(mh-defcustom mh-insert-x-mailer-flag t +(defcustom-mh mh-insert-x-mailer-flag t "*Non-nil means append an \"X-Mailer:\" header field to the header. This header field includes the version of MH-E and Emacs that you @@ -2124,7 +2124,7 @@ :group 'mh-sending-mail :package-version '(MH-E . "7.0")) -(mh-defcustom mh-redist-full-contents-flag nil +(defcustom-mh mh-redist-full-contents-flag nil "*Non-nil means the \"dist\" command needs entire letter for redistribution. This option must be turned on if \"dist\" requires the whole @@ -2136,7 +2136,7 @@ :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(mh-defcustom mh-reply-default-reply-to nil +(defcustom-mh mh-reply-default-reply-to nil "*Sets the person or persons to whom a reply will be sent. This option is set to \"Prompt\" by default so that you are @@ -2152,7 +2152,7 @@ :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(mh-defcustom mh-reply-show-message-flag t +(defcustom-mh mh-reply-show-message-flag t "*Non-nil means the MH-Show buffer is displayed when replying. If you include the message automatically, you can hide the @@ -2169,7 +2169,7 @@ ;; the docstring: "Additional sequences that should not to be preserved can be ;; specified by setting `mh-unpropagated-sequences' appropriately." XXX -(mh-defcustom mh-refile-preserves-sequences-flag t +(defcustom-mh mh-refile-preserves-sequences-flag t "*Non-nil means that sequences are preserved when messages are refiled. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2180,7 +2180,7 @@ :group 'mh-sequences :package-version '(MH-E . "7.4")) -(mh-defcustom mh-tick-seq 'tick +(defcustom-mh mh-tick-seq 'tick "The name of the MH sequence for ticked messages. You can customize this option if you already use the \"tick\" @@ -2192,7 +2192,7 @@ :group 'mh-sequences :package-version '(MH-E . "7.3")) -(mh-defcustom mh-update-sequences-after-mh-show-flag t +(defcustom-mh mh-update-sequences-after-mh-show-flag t "*Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>. Three sequences are maintained internally by MH-E and pushed out @@ -2209,7 +2209,7 @@ ;;; Reading Your Mail (:group 'mh-show) -(mh-defcustom mh-bury-show-buffer-flag t +(defcustom-mh mh-bury-show-buffer-flag t "*Non-nil means show buffer is buried. One advantage of not burying the show buffer is that one can @@ -2220,7 +2220,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-clean-message-header-flag t +(defcustom-mh mh-clean-message-header-flag t "*Non-nil means remove extraneous header fields. See also `mh-invisible-header-fields-default' and @@ -2229,7 +2229,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) +(defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode"))) "*Non-nil means attachments are handled\\<mh-folder-mode-map>. MH-E can handle attachments as well if the Gnus `mm-decode' @@ -2247,7 +2247,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-display-buttons-for-alternatives-flag nil +(defcustom-mh mh-display-buttons-for-alternatives-flag nil "*Non-nil means display buttons for all alternative attachments. Sometimes, a mail program will produce multiple alternatives of @@ -2259,7 +2259,7 @@ :group 'mh-show :package-version '(MH-E . "7.4")) -(mh-defcustom mh-display-buttons-for-inline-parts-flag nil +(defcustom-mh mh-display-buttons-for-inline-parts-flag nil "*Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>. The sender can request that attachments should be viewed inline so @@ -2282,7 +2282,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-do-not-confirm-flag nil +(defcustom-mh mh-do-not-confirm-flag nil "*Non-nil means non-reversible commands do not prompt for confirmation. Commands such as `mh-pack-folder' prompt to confirm whether to @@ -2294,7 +2294,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-fetch-x-image-url nil +(defcustom-mh mh-fetch-x-image-url nil "*Control fetching of \"X-Image-URL:\" header field image. Ths option controls the fetching of the \"X-Image-URL:\" header @@ -2330,7 +2330,7 @@ :group 'mh-show :package-version '(MH-E . "7.3")) -(mh-defcustom mh-graphical-smileys-flag t +(defcustom-mh mh-graphical-smileys-flag t "*Non-nil means graphical smileys are displayed. It is a long standing custom to inject body language using a @@ -2345,7 +2345,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-graphical-emphasis-flag t +(defcustom-mh mh-graphical-emphasis-flag t "*Non-nil means graphical emphasis is displayed. A few typesetting features are indicated in ASCII text with @@ -2362,7 +2362,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-highlight-citation-style 'gnus +(defcustom-mh mh-highlight-citation-style 'gnus "Style for highlighting citations. If the sender of the message has cited other messages in his @@ -2589,7 +2589,7 @@ `mh-invisible-header-fields' and `mh-invisible-header-fields', it cannot be run until both variables have been initialized.") -(mh-defcustom mh-invisible-header-fields nil +(defcustom-mh mh-invisible-header-fields nil "*Additional header fields to hide. Header fields that you would like to hide that aren't listed in @@ -2610,7 +2610,7 @@ :group 'mh-show :package-version '(MH-E . "7.1")) -(mh-defcustom mh-invisible-header-fields-default nil +(defcustom-mh mh-invisible-header-fields-default nil "*List of hidden header fields. The header fields listed in this option are hidden, although you @@ -2663,7 +2663,7 @@ ;; Compile invisible header fields. (mh-invisible-headers) -(mh-defcustom mh-lpr-command-format "lpr -J '%s'" +(defcustom-mh mh-lpr-command-format "lpr -J '%s'" "*Command used to print\\<mh-folder-mode-map>. This option contains the Unix command line which performs the @@ -2680,7 +2680,7 @@ :group 'mh-show :package-version '(MH-E . "6.0")) -(mh-defcustom mh-max-inline-image-height nil +(defcustom-mh mh-max-inline-image-height nil "*Maximum inline image height if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2696,7 +2696,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-max-inline-image-width nil +(defcustom-mh mh-max-inline-image-width nil "*Maximum inline image width if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2712,7 +2712,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-mhl-format-file nil +(defcustom-mh mh-mhl-format-file nil "*Specifies the format file to pass to the \"mhl\" program. Normally MH-E takes care of displaying messages itself (rather than @@ -2736,7 +2736,7 @@ :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defcustom mh-mime-save-parts-default-directory t +(defcustom-mh mh-mime-save-parts-default-directory t "Default directory to use for \\<mh-folder-mode-map>\\[mh-mime-save-parts]. The default value for this option is \"Prompt Always\" so that @@ -2752,7 +2752,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-print-background-flag nil +(defcustom-mh mh-print-background-flag nil "*Non-nil means messages should be printed in the background\\<mh-folder-mode-map>. Normally messages are printed in the foreground. If this is slow on @@ -2768,7 +2768,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-show-maximum-size 0 +(defcustom-mh mh-show-maximum-size 0 "*Maximum size of message (in bytes) to display automatically. This option provides an opportunity to skip over large messages @@ -2778,7 +2778,7 @@ :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defcustom mh-show-use-xface-flag (>= emacs-major-version 21) +(defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21) "*Non-nil means display face images in MH-show buffers. MH-E can display the content of \"Face:\", \"X-Face:\", and @@ -2818,7 +2818,7 @@ :group 'mh-show :package-version '(MH-E . "7.0")) -(mh-defcustom mh-store-default-directory nil +(defcustom-mh mh-store-default-directory nil "*Default directory for \\<mh-folder-mode-map>\\[mh-store-msg]. If you would like to change the initial default directory, @@ -2830,7 +2830,7 @@ :group 'mh-show :package-version '(MH-E . "6.0")) -(mh-defcustom mh-summary-height nil +(defcustom-mh mh-summary-height nil "*Number of lines in MH-Folder buffer (including the mode line). The default value of this option is \"Automatic\" which means @@ -2845,7 +2845,7 @@ ;;; The Speedbar (:group 'mh-speedbar) -(mh-defcustom mh-speed-update-interval 60 +(defcustom-mh mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer @@ -2854,7 +2854,7 @@ ;;; Threading (:group 'mh-thread) -(mh-defcustom mh-show-threads-flag nil +(defcustom-mh mh-show-threads-flag nil "*Non-nil means new folders start in threaded mode. Threading large number of messages can be time consuming so this @@ -2870,7 +2870,7 @@ ;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined ;; dynamically in mh-tool-bar.el. -(mh-defcustom mh-tool-bar-search-function 'mh-search +(defcustom-mh mh-tool-bar-search-function 'mh-search "*Function called by the tool bar search button. By default, this is set to `mh-search'. You can also choose @@ -2883,7 +2883,7 @@ ;; XEmacs has a couple of extra customizations... (mh-do-in-xemacs - (mh-defcustom mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag + (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag "*If non-nil, use tool bar. This option controls whether to show the MH-E icons at all. By @@ -2899,7 +2899,7 @@ (set-default symbol value)) :package-version '(MH-E . "7.3")) - (mh-defcustom mh-xemacs-tool-bar-position nil + (defcustom-mh mh-xemacs-tool-bar-position nil "*Tool bar location. This option controls the placement of the tool bar along the four @@ -2921,7 +2921,7 @@ ;;; Hooks (:group 'mh-hooks + group where hook described) -(mh-defcustom mh-after-commands-processed-hook nil +(defcustom-mh mh-after-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] after performing outstanding refile and delete requests. Variables that are useful in this hook include @@ -2933,14 +2933,14 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defcustom mh-alias-reloaded-hook nil +(defcustom-mh mh-alias-reloaded-hook nil "Hook run by `mh-alias-reload' after loading aliases." :type 'hook :group 'mh-hooks :group 'mh-alias :package-version '(MH-E . "8.0")) -(mh-defcustom mh-before-commands-processed-hook nil +(defcustom-mh mh-before-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests. Variables that are useful in this hook include `mh-delete-list' @@ -2951,7 +2951,7 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defcustom mh-before-quit-hook nil +(defcustom-mh mh-before-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] before quitting MH-E. This hook is called before the quit occurs, so you might use it @@ -2964,7 +2964,7 @@ :group 'mh-folder :package-version '(MH-E . "6.0")) -(mh-defcustom mh-before-send-letter-hook nil +(defcustom-mh mh-before-send-letter-hook nil "Hook run at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command. For example, if you want to check your spelling in your message @@ -2975,7 +2975,7 @@ :group 'mh-letter :package-version '(MH-E . "6.0")) -(mh-defcustom mh-delete-msg-hook nil +(defcustom-mh mh-delete-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion. For example, a past maintainer of MH-E used this once when he @@ -2985,7 +2985,7 @@ :group 'mh-show :package-version '(MH-E . "6.0")) -(mh-defcustom mh-find-path-hook nil +(defcustom-mh mh-find-path-hook nil "Hook run by `mh-find-path' after reading the user's MH profile. This hook can be used the change the value of the variables that @@ -2996,28 +2996,28 @@ :group 'mh-e :package-version '(MH-E . "7.0")) -(mh-defcustom mh-folder-mode-hook nil +(defcustom-mh mh-folder-mode-hook nil "Hook run by `mh-folder-mode' when visiting a new folder." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(mh-defcustom mh-forward-hook nil +(defcustom-mh mh-forward-hook nil "Hook run by `mh-forward' on a forwarded letter." :type 'hook :group 'mh-hooks :group 'mh-sending-mail :package-version '(MH-E . "8.0")) -(mh-defcustom mh-inc-folder-hook nil +(defcustom-mh mh-inc-folder-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-inc-folder] after incorporating mail into a folder." :type 'hook :group 'mh-hooks :group 'mh-inc :package-version '(MH-E . "6.0")) -(mh-defcustom mh-insert-signature-hook nil +(defcustom-mh mh-insert-signature-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-insert-signature] after signature has been inserted. Hook functions may access the actual name of the file or the @@ -3028,7 +3028,7 @@ :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-defcustom mh-kill-folder-suppress-prompt-hooks '(mh-search-p) +(defcustom-mh mh-kill-folder-suppress-prompt-hooks '(mh-search-p) "Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder]. The hook functions are called with no arguments and should return @@ -3046,7 +3046,7 @@ :group 'mh-folder :package-version '(MH-E . "7.4")) -(mh-defcustom mh-letter-mode-hook nil +(defcustom-mh mh-letter-mode-hook nil "Hook run by `mh-letter-mode' on a new letter. This hook allows you to do some processing before editing a @@ -3059,14 +3059,14 @@ :group 'mh-sending-mail :package-version '(MH-E . "6.0")) -(mh-defcustom mh-mh-to-mime-hook nil +(defcustom-mh mh-mh-to-mime-hook nil "Hook run on the formatted letter by \\<mh-letter-mode-map>\\[mh-mh-to-mime]." :type 'hook :group 'mh-hooks :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-defcustom mh-search-mode-hook nil +(defcustom-mh mh-search-mode-hook nil "Hook run upon entry to `mh-search-mode'\\<mh-folder-mode-map>. If you find that you do the same thing over and over when editing @@ -3078,7 +3078,7 @@ :group 'mh-search :package-version '(MH-E . "8.0")) -(mh-defcustom mh-quit-hook nil +(defcustom-mh mh-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] after quitting MH-E. This hook is not run in an MH-E context, so you might use it to @@ -3090,14 +3090,14 @@ :group 'mh-folder :package-version '(MH-E . "6.0")) -(mh-defcustom mh-refile-msg-hook nil +(defcustom-mh mh-refile-msg-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-refile-msg] after marking each message for refiling." :type 'hook :group 'mh-hooks :group 'mh-folder :package-version '(MH-E . "6.0")) -(mh-defcustom mh-show-hook nil +(defcustom-mh mh-show-hook nil "Hook run after \\<mh-folder-mode-map>\\[mh-show] shows a message. It is the last thing called after messages are displayed. It's @@ -3108,7 +3108,7 @@ :group 'mh-show :package-version '(MH-E . "6.0")) -(mh-defcustom mh-show-mode-hook nil +(defcustom-mh mh-show-mode-hook nil "Hook run upon entry to `mh-show-mode'. This hook is called early on in the process of the message @@ -3119,7 +3119,7 @@ :group 'mh-show :package-version '(MH-E . "6.0")) -(mh-defcustom mh-unseen-updated-hook nil +(defcustom-mh mh-unseen-updated-hook nil "Hook run after the unseen sequence has been updated. The variable `mh-seen-list' can be used by this hook to obtain @@ -3139,7 +3139,7 @@ ;; To add a new face: ;; 1. Add entry to variable mh-face-data. -;; 2. Create face using mh-defface (which removes min-color spec and +;; 2. Create face using defface-mh (which removes min-color spec and ;; :package-version keyword where these are not supported), ;; accessing face data with function mh-face-data. ;; 3. Add inherit argument to function mh-face-data if applicable. @@ -3288,7 +3288,7 @@ (:underline t))))) "MH-E face data. Used by function `mh-face-data' which returns spec that is -consumed by `mh-defface'.") +consumed by `defface-mh'.") (require 'cus-face) @@ -3341,14 +3341,14 @@ (setq new-spec (cons entry new-spec))))) new-spec)))) -(mh-defface mh-folder-address +(defface-mh mh-folder-address (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Recipient face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-body +(defface-mh mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) (:inherit mh-folder-msg-number)) @@ -3359,7 +3359,7 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-cur-msg-number +(defface-mh mh-folder-cur-msg-number (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number :bold t)))) "Current message number face." @@ -3367,39 +3367,39 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-date +(defface-mh mh-folder-date (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Date face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-deleted +(defface-mh mh-folder-deleted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Deleted message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-followup (mh-face-data 'mh-folder-followup) +(defface-mh mh-folder-followup (mh-face-data 'mh-folder-followup) "\"Re:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) +(defface-mh mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) "Message number face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-refiled (mh-face-data 'mh-folder-refiled) +(defface-mh mh-folder-refiled (mh-face-data 'mh-folder-refiled) "Refiled message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-sent-to-me-hint +(defface-mh mh-folder-sent-to-me-hint (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date)))) "Fontification hint face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3409,7 +3409,7 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-sent-to-me-sender +(defface-mh mh-folder-sent-to-me-sender (mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup)))) "Sender face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3419,98 +3419,98 @@ :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-subject (mh-face-data 'mh-folder-subject) +(defface-mh mh-folder-subject (mh-face-data 'mh-folder-subject) "Subject face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-tick (mh-face-data 'mh-folder-tick) +(defface-mh mh-folder-tick (mh-face-data 'mh-folder-tick) "Ticked message face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-to (mh-face-data 'mh-folder-to) +(defface-mh mh-folder-to (mh-face-data 'mh-folder-to) "\"To:\" face." :group 'mh-faces :group 'mh-folder :package-version '(MH-E . "8.0")) -(mh-defface mh-letter-header-field (mh-face-data 'mh-letter-header-field) +(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces :group 'mh-letter :package-version '(MH-E . "8.0")) -(mh-defface mh-search-folder (mh-face-data 'mh-search-folder) +(defface-mh mh-search-folder (mh-face-data 'mh-search-folder) "Folder heading face in MH-Folder buffers created by searches." :group 'mh-faces :group 'mh-search :package-version '(MH-E . "8.0")) -(mh-defface mh-show-cc (mh-face-data 'mh-show-cc) +(defface-mh mh-show-cc (mh-face-data 'mh-show-cc) "Face used to highlight \"cc:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-date (mh-face-data 'mh-show-date) +(defface-mh mh-show-date (mh-face-data 'mh-show-date) "Face used to highlight \"Date:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-from (mh-face-data 'mh-show-from) +(defface-mh mh-show-from (mh-face-data 'mh-show-from) "Face used to highlight \"From:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-header (mh-face-data 'mh-show-header) +(defface-mh mh-show-header (mh-face-data 'mh-show-header) "Face used to deemphasize less interesting header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) +(defface-mh mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) "Bad PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) +(defface-mh mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) "Good PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) +(defface-mh mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) "Unknown or untrusted PGG signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-signature (mh-face-data 'mh-show-signature) +(defface-mh mh-show-signature (mh-face-data 'mh-show-signature) "Signature face." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-subject +(defface-mh mh-show-subject (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Face used to highlight \"Subject:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-to (mh-face-data 'mh-show-to) +(defface-mh mh-show-to (mh-face-data 'mh-show-to) "Face used to highlight \"To:\" header fields." :group 'mh-faces :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-show-xface +(defface-mh mh-show-xface (mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight))))) "X-Face image face. The background and foreground are used in the image." @@ -3518,13 +3518,13 @@ :group 'mh-show :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) +(defface-mh mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) "Basic folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-folder-with-unseen-messages +(defface-mh mh-speedbar-folder-with-unseen-messages (mh-face-data 'mh-speedbar-folder '((t (:inherit mh-speedbar-folder :bold t)))) "Folder face when folder contains unread messages." @@ -3532,14 +3532,14 @@ :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-selected-folder +(defface-mh mh-speedbar-selected-folder (mh-face-data 'mh-speedbar-selected-folder) "Selected folder face." :group 'mh-faces :group 'mh-speedbar :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-selected-folder-with-unseen-messages +(defface-mh mh-speedbar-selected-folder-with-unseen-messages (mh-face-data 'mh-speedbar-selected-folder '((t (:inherit mh-speedbar-selected-folder :bold t)))) "Selected folder face when folder contains unread messages." @@ -3547,16 +3547,6 @@ :group 'mh-speedbar :package-version '(MH-E . "8.0")) -;; Get rid of temporary functions and data structures. -(fmakunbound 'mh-defcustom) -(fmakunbound 'mh-defface) -(fmakunbound 'mh-defgroup) -(fmakunbound 'mh-face-data) -(fmakunbound 'mh-strip-package-version) -(makunbound 'mh-face-data) -(makunbound 'mh-inherit-face-flag) -(makunbound 'mh-min-colors-defined-flag) - (provide 'mh-e) ;; Local Variables:
--- a/lisp/mh-e/mh-folder.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-folder.el Fri Apr 21 05:39:14 2006 +0000 @@ -524,11 +524,8 @@ ;; Shush compiler. (defvar desktop-save-buffer) (defvar font-lock-auto-fontify) -(defvar image-load-path) (defvar font-lock-defaults) ; XEmacs -(defvar mh-folder-buttons-init-flag nil) - ;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) @@ -590,13 +587,8 @@ \\{mh-folder-mode-map}" (mh-do-in-gnu-emacs - (unless mh-folder-buttons-init-flag - (let* ((load-path (mh-image-load-path-for-library "mh-e" "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (mh-tool-bar-folder-buttons-init) - (setq mh-folder-buttons-init-flag t))) + (unless mh-folder-tool-bar-map + (mh-tool-bar-folder-buttons-init)) (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)) (mh-do-in-xemacs (mh-tool-bar-init :folder))
--- a/lisp/mh-e/mh-gnus.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-gnus.el Fri Apr 21 05:39:14 2006 +0000 @@ -39,19 +39,19 @@ (mh-require 'mml nil t) ;; Copy of function from gnus-util.el. -(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map) +(defun-mh mh-gnus-local-map-property gnus-local-map-property (map) "Return a list suitable for a text property list specifying keymap MAP." (cond (mh-xemacs-flag (list 'keymap map)) ((>= emacs-major-version 21) (list 'keymap map)) (t (list 'local-map map)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2) +(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2) (append (if (listp (car handles1)) handles1 (list handles1)) (if (listp (car handles2)) handles2 (list handles2)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mh-mm-set-handle-multipart-parameter +(defun-mh mh-mm-set-handle-multipart-parameter mm-set-handle-multipart-parameter (handle parameter value) ;; HANDLE could be a CTL. (if handle @@ -59,7 +59,7 @@ (car handle)))) ;; Copy of function from mm-view.el. -(mh-defun-compat mh-mm-inline-text-vcard mm-inline-text-vcard (handle) +(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) (let (buffer-read-only) (mm-insert-inline handle @@ -73,17 +73,17 @@ ;; Function from mm-decode.el used in PGP messages. Just define it with older ;; Gnus to avoid compiler warning. -(mh-defun-compat mh-mm-possibly-verify-or-decrypt +(defun-mh mh-mm-possibly-verify-or-decrypt mm-possibly-verify-or-decrypt (parts ctl) nil) ;; Copy of macro in mm-decode.el. -(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter +(defmacro-mh mh-mm-handle-multipart-ctl-parameter mm-handle-multipart-ctl-parameter (handle parameter) `(get-text-property 0 ,parameter (car ,handle))) ;; Copy of function in mm-decode.el. -(mh-defun-compat mh-mm-readable-p mm-readable-p (handle) +(defun-mh mh-mm-readable-p mm-readable-p (handle) "Say whether the content of HANDLE is readable." (and (< (with-current-buffer (mm-handle-buffer handle) (buffer-size)) 10000) @@ -93,7 +93,7 @@ (not (mh-mm-long-lines-p 76)))))) ;; Copy of function in mm-bodies.el. -(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length) +(defun-mh mh-mm-long-lines-p mm-long-lines-p (length) "Say whether any of the lines in the buffer is longer than LENGTH." (save-excursion (goto-char (point-min)) @@ -105,21 +105,21 @@ (and (> (current-column) length) (current-column)))) -(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) +(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) ;; Released Gnus doesn't keep handles associated with externally displayed ;; MIME parts. So this will always return nil. nil) -(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list) +(defun-mh mh-mm-destroy-parts mm-destroy-parts (list) "Older versions of Emacs don't have this function." nil) -(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) +(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) "Emacs 21 and XEmacs don't have this function." nil) ;; Copy of function in mml.el. -(mh-defun-compat mh-mml-minibuffer-read-disposition +(defun-mh mh-mml-minibuffer-read-disposition mml-minibuffer-read-disposition (type &optional default) (unless default (setq default (if (and (string-match "\\`text/" type)
--- a/lisp/mh-e/mh-letter.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-letter.el Fri Apr 21 05:39:14 2006 +0000 @@ -275,10 +275,7 @@ ;;; MH-Letter Mode -(defvar mh-letter-buttons-init-flag nil) - ;; Shush compiler. -(defvar image-load-path) (defvar font-lock-defaults) ; XEmacs ;; Ensure new buffers won't get this mode if default-major-mode is nil. @@ -313,13 +310,8 @@ (make-local-variable 'mh-sent-from-folder) (make-local-variable 'mh-sent-from-msg) (mh-do-in-gnu-emacs - (unless mh-letter-buttons-init-flag - (let* ((load-path (mh-image-load-path-for-library "mh-e" "mh-logo.xpm")) - (image-load-path (cons (car load-path) - (when (boundp 'image-load-path) - image-load-path)))) - (mh-tool-bar-letter-buttons-init) - (setq mh-letter-buttons-init-flag t))) + (unless mh-letter-tool-bar-map + (mh-tool-bar-letter-buttons-init)) (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)) (mh-do-in-xemacs (mh-tool-bar-init :letter))
--- a/lisp/mh-e/mh-seq.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-seq.el Fri Apr 21 05:39:14 2006 +0000 @@ -238,8 +238,7 @@ (set (make-local-variable 'tool-bar-map) mh-folder-seq-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) - (save-excursion - (set-buffer (get-buffer mh-show-buffer)) + (with-current-buffer mh-show-buffer (set (make-local-variable 'tool-bar-map) mh-show-seq-tool-bar-map)))) (push 'widen mh-view-ops))) @@ -371,8 +370,7 @@ (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode) (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map) (when (buffer-live-p (get-buffer mh-show-buffer)) - (save-excursion - (set-buffer (get-buffer mh-show-buffer)) + (with-current-buffer mh-show-buffer (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
--- a/lisp/mh-e/mh-tool-bar.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-tool-bar.el Fri Apr 21 05:39:14 2006 +0000 @@ -83,6 +83,9 @@ ;;; Tool Bar Creation +;; Shush compiler. +(defvar image-load-path) + (defmacro mh-tool-bar-define (defaults &rest buttons) "Define a tool bar for MH-E. DEFAULTS is the list of buttons that are present by default. It @@ -151,7 +154,7 @@ (doc (if (string-match "\\(.*\\)\n" full-doc) (match-string 1 full-doc) full-doc)) - (enable-expr (or (nth 4 button) t)) + (enable-expr (if (eql (length button) 4) t (nth 4 button))) (modes (nth 1 button)) functions show-sym) (when (memq 'letter modes) (setq functions `(:letter ,name))) @@ -178,7 +181,7 @@ (t 'folder-vectors))) (list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons) (t 'mh-tool-bar-folder-buttons))) - (key (intern (concat "mh-" type1 "tool-bar-" name-str))) + (key (intern (concat "mh-" type1 "-tool-bar-" name-str))) (setter (intern (concat type1 "-button-setter"))) (mbuttons (cond ((eq type :letter) 'letter-buttons) ((eq type :show) 'show-buttons) @@ -209,50 +212,79 @@ (unless (memq x letter-buttons) (error "Letter defaults contains unknown button %s" x))) `(eval-when (compile load eval) - (defun mh-buffer-exists-p (mode) - "Test whether a buffer with major mode MODE is present." - (loop for buf in (buffer-list) - when (save-excursion - (set-buffer buf) - (eq major-mode mode)) - return t)) - ;; GNU Emacs tool bar specific code (mh-do-in-gnu-emacs + (defun mh-buffer-exists-p (mode) + "Test whether a buffer with major mode MODE is present." + (loop for buf in (buffer-list) + when (with-current-buffer buf + (eq major-mode mode)) + return t)) ;; Tool bar initialization functions (defun mh-tool-bar-folder-buttons-init () (when (mh-buffer-exists-p 'mh-folder-mode) - (setq mh-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse folder-button-setter) - tool-bar-map)) - (setq mh-show-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse show-button-setter) - tool-bar-map)) - (setq mh-show-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) - ,@(nreverse show-seq-button-setter) - tool-bar-map)) - (setq mh-folder-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) - ,@(nreverse sequence-button-setter) - tool-bar-map)))) + (let* ((load-path (mh-image-load-path-for-library "mh-e" + "mh-logo.xpm")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (setq mh-folder-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse folder-button-setter) + tool-bar-map)) + (setq mh-folder-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) + ,@(nreverse sequence-button-setter) + tool-bar-map)) + (setq mh-show-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse show-button-setter) + tool-bar-map)) + (setq mh-show-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) + ,@(nreverse show-seq-button-setter) + tool-bar-map))))) (defun mh-tool-bar-letter-buttons-init () (when (mh-buffer-exists-p 'mh-letter-mode) - (setq mh-letter-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse letter-button-setter) - tool-bar-map)))) + (let* ((load-path (mh-image-load-path-for-library "mh-e" + "mh-logo.xpm")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (setq mh-letter-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse letter-button-setter) + tool-bar-map))))) ;; Custom setter functions + (defun mh-tool-bar-update (mode default-map sequence-map) + "Update `tool-bar-map' in all buffers of MODE. +Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." + (loop for buf in (buffer-list) + do (with-current-buffer buf + (if (eq mode major-mode) + (let ((map (if mh-folder-view-stack + sequence-map + default-map))) + ;; Yes, make-local-variable is necessary since we + ;; get here during initialization when loading + ;; mh-e.el, after the +inbox buffer has been + ;; created, but before mh-folder-mode has run and + ;; created the local map. + (set (make-local-variable 'tool-bar-map) map)))))) (defun mh-tool-bar-folder-buttons-set (symbol value) "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." (set-default symbol value) - (mh-tool-bar-folder-buttons-init)) + (mh-tool-bar-folder-buttons-init) + (mh-tool-bar-update 'mh-folder-mode mh-folder-tool-bar-map + mh-folder-seq-tool-bar-map) + (mh-tool-bar-update 'mh-show-mode mh-show-tool-bar-map + mh-show-seq-tool-bar-map)) (defun mh-tool-bar-letter-buttons-set (symbol value) "Construct tool bar for `mh-letter-mode'." (set-default symbol value) - (mh-tool-bar-letter-buttons-init))) + (mh-tool-bar-letter-buttons-init) + (mh-tool-bar-update 'mh-letter-mode mh-letter-tool-bar-map + mh-letter-tool-bar-map))) ;; XEmacs specific code (mh-do-in-xemacs (defvar mh-tool-bar-folder-vector-map @@ -318,7 +350,8 @@ 'mh-tool-bar-folder-buttons '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults)) "List of buttons to include in MH-Folder tool bar." - :group 'mh-tool-bar :set 'mh-tool-bar-folder-buttons-set + :group 'mh-tool-bar + :set 'mh-tool-bar-folder-buttons-set :type '(set ,@(loop for x in folder-buttons for y in folder-docs collect `(const :tag ,y ,x))) @@ -328,7 +361,8 @@ 'mh-tool-bar-letter-buttons '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults)) "List of buttons to include in MH-Letter tool bar." - :group 'mh-tool-bar :set 'mh-tool-bar-letter-buttons-set + :group 'mh-tool-bar + :set 'mh-tool-bar-letter-buttons-set :type '(set ,@(loop for x in letter-buttons for y in letter-docs collect `(const :tag ,y ,x)))
--- a/lisp/mh-e/mh-utils.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/mh-e/mh-utils.el Fri Apr 21 05:39:14 2006 +0000 @@ -556,10 +556,18 @@ sub-folders) sub-folders))) +;; FIXME: This function does not do well if FOLDER does not exist. It +;; then changes the context to that folder which causes problems down +;; the line. Since a folder in the cache could later be deleted, it +;; would be good for mh-sub-folders-actual to return nil in this case +;; so that mh-sub-folders could delete it from the cache. This +;; function could protect itself by using a temporary context. (defun mh-sub-folders-actual (folder) "Execute the command folders to return the sub-folders of FOLDER. Filters out the folder names that start with \".\" so that -directories that aren't usually mail folders are hidden." +directories that aren't usually mail folders are hidden. +Expects FOLDER to have already been normalized with + (mh-normalize-folder-name folder nil nil t)" (let ((arg-list `(,(expand-file-name "folders" mh-progs) nil (t nil) nil "-noheader" "-norecurse" "-nototal" ,@(if (stringp folder) (list folder) ()))) @@ -683,36 +691,44 @@ (defun mh-folder-completion-function (name predicate flag) "Programmable completion for folder names. NAME is the partial folder name that has been input. PREDICATE if -non-nil is a function that is used to filter the possible choices -and FLAG determines whether the completion is over." +non-nil is a function that is used to filter the possible +choices. FLAG is nil to indicate `try-completion', t for +`all-completions', or the symbol lambda for `test-completion'. +See Info node `(elisp) Programmed Completion' for details." (let* ((orig-name name) + ;; After normalization, name is nil, +, or +something. If a + ;; trailing slash is present, it is preserved. (name (mh-normalize-folder-name name nil t)) (last-slash (mh-search-from-end ?/ name)) - (last-complete (if last-slash (substring name 0 last-slash) nil)) + ;; nil if + or +folder; +folder/ if slash present. + (last-complete (if last-slash (substring name 0 (1+ last-slash)) nil)) + ;; Either +folder/remainder, +remainder, or "". (remainder (cond (last-complete (substring name (1+ last-slash))) - ((and (> (length name) 0) (equal (aref name 0) ?+)) - (substring name 1)) + (name (substring name 1)) (t "")))) (cond ((eq flag nil) - (let ((try-res (try-completion - name - (mapcar (lambda (x) - (cons (if (not last-complete) - (concat "+" (car x)) - (concat last-complete "/" (car x))) - (cdr x))) - (mh-sub-folders last-complete t)) - predicate))) + (let ((try-res + (try-completion + name + (mapcar (lambda (x) + (cons (concat (or last-complete "+") (car x)) + (cdr x))) + (mh-sub-folders last-complete t)) + predicate))) (cond ((eq try-res nil) nil) ((and (eq try-res t) (equal name orig-name)) t) ((eq try-res t) name) (t try-res)))) ((eq flag t) - (all-completions - remainder (mh-sub-folders last-complete t) predicate)) + (mapcar (lambda (x) + (concat (or last-complete "+") x)) + (all-completions + remainder (mh-sub-folders last-complete t) predicate))) ((eq flag 'lambda) - (let ((path (concat mh-user-path - (substring (mh-normalize-folder-name name) 1)))) + (let ((path (concat (unless (and (> (length name) 1) + (eq (aref name 1) ?/)) + mh-user-path) + (substring name 1)))) (cond (mh-allow-root-folder-flag (file-exists-p path)) ((equal path mh-user-path) nil) (t (file-exists-p path)))))))) @@ -726,8 +742,7 @@ If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name corresponding to `mh-user-path'." (mh-normalize-folder-name - (let ((minibuffer-completing-file-name t) - (completion-root-regexp "^[+/]") + (let ((completion-root-regexp "^[+/]") (minibuffer-local-completion-map mh-folder-completion-map) (mh-allow-root-folder-flag allow-root-folder-flag)) (completing-read prompt 'mh-folder-completion-function nil nil nil
--- a/lisp/net/tramp-smb.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/net/tramp-smb.el Fri Apr 21 05:39:14 2006 +0000 @@ -979,7 +979,7 @@ ;; Algorithm: get waiting output. See if last line contains ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err)) + (while (not found) ;; Accept pending output. (tramp-accept-process-output proc)
--- a/lisp/net/tramp.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/net/tramp.el Fri Apr 21 05:39:14 2006 +0000 @@ -4458,24 +4458,28 @@ file) (member (match-string 1 file) (mapcar 'car tramp-methods))) ((or (equal last-input-event 'tab) - ;; Emacs - (and (integerp last-input-event) - (not (event-modifiers last-input-event)) - (or (char-equal last-input-event ?\?) - (char-equal last-input-event ?\t) ; handled by 'tab already? - (char-equal last-input-event ?\ ))) + ;; Emacs + (and (integerp last-input-event) + (or + ;; ?\t has event-modifier 'control + (char-equal last-input-event ?\t) + (and (not (event-modifiers last-input-event)) + (or (char-equal last-input-event ?\?) + (char-equal last-input-event ?\ ))))) ;; XEmacs (and (featurep 'xemacs) - (not (event-modifiers last-input-event)) - (or (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\?) - (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\t) - (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\ )))) + (or + ;; ?\t has event-modifier 'control + (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\t) + (and (not (event-modifiers last-input-event)) + (or (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\?) + (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\ )))))) t))) (defun tramp-completion-handle-file-exists-p (filename)
--- a/lisp/net/trampver.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/net/trampver.el Fri Apr 21 05:39:14 2006 +0000 @@ -30,7 +30,7 @@ ;; are auto-frobbed from configure.ac, so you should edit that file and run ;; "autoconf && ./configure" to change them. -(defconst tramp-version "2.0.52" +(defconst tramp-version "2.0.53" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org"
--- a/lisp/newcomment.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/newcomment.el Fri Apr 21 05:39:14 2006 +0000 @@ -108,21 +108,25 @@ ;;;###autoload (defvar comment-start nil "*String to insert to start a new comment, or nil if no comment syntax.") +;;;###autoload(put 'comment-start 'safe-local-variable 'string-or-null-p) ;;;###autoload (defvar comment-start-skip nil "*Regexp to match the start of a comment plus everything up to its body. If there are any \\(...\\) pairs, the comment delimiter text is held to begin at the place matched by the close of the first pair.") +;;;###autoload(put 'comment-start-skip 'safe-local-variable 'string-or-null-p) ;;;###autoload (defvar comment-end-skip nil "Regexp to match the end of a comment plus everything up to its body.") +;;;###autoload(put 'comment-end-skip 'safe-local-variable 'string-or-null-p) ;;;###autoload (defvar comment-end "" "*String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") +;;;###autoload(put 'comment-end 'safe-local-variable 'string-or-null-p) ;;;###autoload (defvar comment-indent-function 'comment-indent-default
--- a/lisp/progmodes/gdb-ui.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/gdb-ui.el Fri Apr 21 05:39:14 2006 +0000 @@ -100,7 +100,9 @@ (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) -(defvar gdb-frame-address "main" "Initialization for Assembler buffer.") +(defvar gdb-pc-address nil "Initialization for Assembler buffer. +Set to \"main\" at start if gdb-show-main is t.") +(defvar gdb-frame-address nil "Identity of frame for watch expression.") (defvar gdb-previous-frame-address nil) (defvar gdb-memory-address "main") (defvar gdb-previous-frame nil) @@ -109,8 +111,9 @@ (defvar gdb-current-language nil) (defvar gdb-var-list nil "List of variables in watch window. -Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where -STATUS is nil (unchanged), `changed' or `out-of-scope'.") +Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP) +where STATUS is nil (unchanged), `changed' or `out-of-scope', FP the frame +address for root variables.") (defvar gdb-force-update t "Non-nil means that view of watch expressions will be updated in the speedbar.") (defvar gdb-main-file nil "Source file from which program execution begins.") @@ -516,7 +519,7 @@ (setq comint-input-sender 'gdb-send) ;; (re-)initialize - (setq gdb-frame-address (if gdb-show-main "main" nil)) + (setq gdb-pc-address (if gdb-show-main "main" nil)) (setq gdb-previous-frame-address nil gdb-memory-address "main" gdb-previous-frame nil @@ -720,7 +723,7 @@ expr) (match-string 2) (match-string 3) - nil nil))) + nil nil gdb-frame-address))) (push var gdb-var-list) (speedbar 1) (unless (string-equal @@ -1206,7 +1209,7 @@ (cons (match-string 1 args) (string-to-number (match-string 2 args)))) - (setq gdb-frame-address (match-string 3 args)) + (setq gdb-pc-address (match-string 3 args)) ;; cover for auto-display output which comes *before* ;; stopped annotation (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) @@ -1357,7 +1360,7 @@ (gdb-get-buffer-create 'gdb-breakpoints-buffer) (gdb-invalidate-breakpoints) ;; Do this through gdb-get-selected-frame -> gdb-frame-handler - ;; so gdb-frame-address is updated. + ;; so gdb-pc-address is updated. ;; (gdb-invalidate-assembler) (if (string-equal gdb-version "pre-6.4") @@ -3004,11 +3007,11 @@ (pos 1) (address) (flag) (bptno)) (with-current-buffer buffer (save-excursion - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (progn (goto-char (point-min)) - (if (and gdb-frame-address - (search-forward gdb-frame-address nil t)) + (if (and gdb-pc-address + (search-forward gdb-pc-address nil t)) (progn (setq pos (point)) (beginning-of-line) @@ -3038,7 +3041,7 @@ (goto-char (point-min)) (if (search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (with-current-buffer buffer (set-window-point (get-buffer-window buffer 0) pos))))) @@ -3100,7 +3103,7 @@ (special-display-frame-alist gdb-frame-parameters)) (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) -;; modified because if gdb-frame-address has changed value a new command +;; modified because if gdb-pc-address has changed value a new command ;; must be enqueued to update the buffer with the new output (defun gdb-invalidate-assembler (&optional ignored) (if (gdb-get-buffer 'gdb-assembler-buffer) @@ -3109,7 +3112,7 @@ (string-equal gdb-selected-frame gdb-previous-frame)) (if (or (not (member 'gdb-invalidate-assembler gdb-pending-triggers)) - (not (string-equal gdb-frame-address + (not (string-equal gdb-pc-address gdb-previous-frame-address))) (progn ;; take previous disassemble command, if any, off the queue @@ -3122,11 +3125,11 @@ (gdb-enqueue-input (list (concat gdb-server-prefix "disassemble " - (if (member gdb-frame-address '(nil "main")) nil "0x") - gdb-frame-address "\n") + (if (member gdb-pc-address '(nil "main")) nil "0x") + gdb-pc-address "\n") 'gdb-assembler-handler)) (push 'gdb-invalidate-assembler gdb-pending-triggers) - (setq gdb-previous-frame-address gdb-frame-address) + (setq gdb-previous-frame-address gdb-pc-address) (setq gdb-previous-frame gdb-selected-frame))))))) (defun gdb-get-selected-frame () @@ -3141,8 +3144,10 @@ (setq gdb-pending-triggers (delq 'gdb-get-selected-frame gdb-pending-triggers)) (goto-char (point-min)) - (if (re-search-forward "Stack level \\([0-9]+\\)" nil t) - (setq gdb-frame-number (match-string 1))) + (when (re-search-forward + "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t) + (setq gdb-frame-number (match-string 1)) + (setq gdb-frame-address (match-string 2))) (goto-char (point-min)) (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-+?\\)\ \\(?: (\\(\\S-+?\\):[0-9]+?)\\)*;? " @@ -3154,7 +3159,7 @@ (if (gdb-get-buffer 'gdb-assembler-buffer) (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) (setq mode-name (concat "Machine:" gdb-selected-frame)))) - (setq gdb-frame-address (match-string 1)) + (setq gdb-pc-address (match-string 1)) (if (and (match-string 3) gud-overlay-arrow-position) (let ((buffer (marker-buffer gud-overlay-arrow-position)) (position (marker-position gud-overlay-arrow-position))) @@ -3289,6 +3294,7 @@ (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) (let ((buffer-read-only nil)) (erase-buffer) + (put-text-property 0 (length err) 'face font-lock-warning-face err) (insert err) (goto-char (point-min))))) (let ((register-list (reverse gdb-register-names)) @@ -3385,36 +3391,44 @@ (defun gdb-stack-list-locals-handler () (setq gdb-pending-triggers (delq 'gdb-invalidate-locals-1 gdb-pending-triggers)) - (let (local locals-list) - (goto-char (point-min)) - (while (re-search-forward gdb-stack-list-locals-regexp nil t) - (let ((local (list (match-string 1) - (match-string 2) - nil))) - (if (looking-at ",value=\\(\".*\"\\).*?}") - (setcar (nthcdr 2 local) (read (match-string 1)))) - (push local locals-list))) - (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) - (and buf (with-current-buffer buf - (let* ((window (get-buffer-window buf 0)) - (start (window-start window)) - (p (window-point window)) - (buffer-read-only nil)) - (erase-buffer) - (dolist (local locals-list) - (setq name (car local)) - (if (or (not (nth 2 local)) - (string-match "\\0x" (nth 2 local))) - (add-text-properties 0 (length name) - `(mouse-face highlight - help-echo "mouse-2: create watch expression" - local-map ,gdb-locals-watch-map-1) - name)) + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (let ((err (match-string 1))) + (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert err) + (goto-char (point-min))))) + (let (local locals-list) + (goto-char (point-min)) + (while (re-search-forward gdb-stack-list-locals-regexp nil t) + (let ((local (list (match-string 1) + (match-string 2) + nil))) + (if (looking-at ",value=\\(\".*\"\\).*?}") + (setcar (nthcdr 2 local) (read (match-string 1)))) + (push local locals-list))) + (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) + (and buf (with-current-buffer buf + (let* ((window (get-buffer-window buf 0)) + (start (window-start window)) + (p (window-point window)) + (buffer-read-only nil)) + (erase-buffer) + (dolist (local locals-list) + (setq name (car local)) + (if (or (not (nth 2 local)) + (string-match "^\\0x" (nth 2 local))) + (add-text-properties 0 (length name) + `(mouse-face highlight + help-echo "mouse-2: create watch expression" + local-map ,gdb-locals-watch-map-1) + name)) (insert (concat name "\t" (nth 1 local) "\t" (nth 2 local) "\n"))) - (set-window-start window start) - (set-window-point window p))))))) + (set-window-start window start) + (set-window-point window p)))))))) (defun gdb-get-register-names () "Create a list of register names."
--- a/lisp/progmodes/gud.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/gud.el Fri Apr 21 05:39:14 2006 +0000 @@ -374,8 +374,9 @@ (defun gud-speedbar-item-info () "Display the data type of the watch expression element." (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) - (if (nth 4 var) - (speedbar-message "%s" (nth 3 var))))) + (if (nth 6 var) + (speedbar-message "%s: %s" (nth 6 var) (nth 3 var)) + (speedbar-message "%s" (nth 3 var))))) (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb."
--- a/lisp/progmodes/idlw-help.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/idlw-help.el Fri Apr 21 05:39:14 2006 +0000 @@ -864,6 +864,7 @@ (erase-buffer) (insert-file-contents file nil nil nil 'replace)) (idlwave-help-error name type class keyword))) + (goto-char (point-min)) (if (and idlwave-help-fontify-source-code (not in-buf)) (idlwave-help-fontify))) (idlwave-help-error name type class keyword))
--- a/lisp/progmodes/python.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/python.el Fri Apr 21 05:39:14 2006 +0000 @@ -1744,6 +1744,14 @@ #'python-eldoc-function) (add-hook 'eldoc-mode-hook '(lambda () (run-python nil t)) nil t) ; need it running + (unless (assoc 'python-mode hs-special-modes-alist) + (setq + hs-special-modes-alist + (cons (list + 'python-mode "^\\s-*def\\>" nil "#" + (lambda (arg)(python-end-of-defun)(skip-chars-backward " \t\n")) + nil) + hs-special-modes-alist))) (if (featurep 'hippie-exp) (set (make-local-variable 'hippie-expand-try-functions-list) (cons 'python-try-complete hippie-expand-try-functions-list)))
--- a/lisp/progmodes/sh-script.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/sh-script.el Fri Apr 21 05:39:14 2006 +0000 @@ -356,6 +356,7 @@ (defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file)) "The shell being programmed. This is set by \\[sh-set-shell].") +;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp) (defvar sh-mode-abbrev-table nil)
--- a/lisp/progmodes/tcl.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/progmodes/tcl.el Fri Apr 21 05:39:14 2006 +0000 @@ -1042,7 +1042,7 @@ (defun tcl-send-string (proc string) (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) - (beginning-of-line) + (forward-line 0) ;Not (beginning-of-line) because of fields. (if (looking-at comint-prompt-regexp) (set-marker inferior-tcl-delete-prompt-marker (point)))) (comint-send-string proc string)) @@ -1050,7 +1050,7 @@ (defun tcl-send-region (proc start end) (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) - (beginning-of-line) + (forward-line 0) ;Not (beginning-of-line) because of fields. (if (looking-at comint-prompt-regexp) (set-marker inferior-tcl-delete-prompt-marker (point)))) (comint-send-region proc start end)) @@ -1080,7 +1080,11 @@ Prefix argument means switch to the Tcl buffer afterwards." (interactive "r\nP") (let ((proc (inferior-tcl-proc))) - (tcl-send-region proc start end) + (tcl-send-region + proc + ;; Strip leading and trailing whitespace. + (save-excursion (goto-char start) (skip-chars-forward " \t\n") (point)) + (save-excursion (goto-char end) (skip-chars-backward " \t\n") (point))) (tcl-send-string proc "\n") (if and-go (switch-to-tcl t)))) @@ -1149,7 +1153,12 @@ (unless (comint-check-proc "*inferior-tcl*") (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil tcl-command-switches)) - (inferior-tcl-mode)) + (inferior-tcl-mode) + ;; Make tclsh display a prompt on ms-windows (or under Unix, when a tty + ;; wasn't used). Doesn't affect wish, unfortunately. + (unless (process-tty-name (inferior-tcl-proc)) + (tcl-send-string (inferior-tcl-proc) + "set ::tcl_interactive 1; concat\n"))) (set (make-local-variable 'tcl-application) cmd) (setq inferior-tcl-buffer "*inferior-tcl*") (pop-to-buffer "*inferior-tcl*"))
--- a/lisp/textmodes/org.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/textmodes/org.el Fri Apr 21 05:39:14 2006 +0000 @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.23 +;; Version: 4.25 ;; ;; This file is part of GNU Emacs. ;; @@ -81,6 +81,15 @@ ;; ;; Changes since version 4.00: ;; --------------------------- +;; Version 4.25 +;; - Revision of the font-lock faces section, with better tty support. +;; - TODO keywords in Agenda buffer are fontified. +;; - Export converts links between .org files to links between .html files. +;; - Better support for bold/italic/underline emphasis. +;; +;; Version 4.24 +;; - Bug fixes. +;; ;; Version 4.23 ;; - Bug fixes. ;; @@ -179,7 +188,7 @@ ;;; Customization variables -(defvar org-version "4.23" +(defvar org-version "4.25" "The version number of the file org.el.") (defun org-version () (interactive) @@ -189,7 +198,7 @@ ;; of outline.el. (defconst org-noutline-p (featurep 'noutline) "Are we using the new outline mode?") -(defconst org-xemacs-p (featurep 'xemacs)) +(defconst org-xemacs-p (featurep 'xemacs)) ;; FIXME: used by external code? (defconst org-format-transports-properties-p (let ((x "a")) (add-text-properties 0 1 '(test t) x) @@ -232,7 +241,11 @@ (defcustom org-startup-align-all-tables nil "Non-nil means, align all tables when visiting a file. This is useful when the column width in tables is forced with <N> cookies -in table fields. Such tables will look correct only after the first re-align." +in table fields. Such tables will look correct only after the first re-align. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: align + #+STARTUP: noalign" :group 'org-startup :type 'boolean) @@ -242,7 +255,6 @@ immediate reminder of any due deadlines. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: - #+STARTUP: dlcheck #+STARTUP: nodlcheck" :group 'org-startup @@ -396,7 +408,12 @@ promotion/demotion commands. It also influences how levels are handled by the exporters. Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified." +for fontification also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: odd + #+STARTUP: oddeven" :group 'org-edit-structure :group 'org-font-lock :type 'boolean) @@ -1124,7 +1141,7 @@ :type 'boolean) (defgroup org-priorities nil - "Keywords in Org-mode." + "Priorities in Org-mode." :tag "Org Priorities" :group 'org-todo) @@ -1179,7 +1196,7 @@ :type 'boolean) (defgroup org-tags nil - "Options concerning startup of Org-mode." + "Options concerning tags in Org-mode." :tag "Org Tags" :group 'org) @@ -1818,6 +1835,18 @@ :group 'org-export-html :type 'string) +(defcustom org-export-html-link-org-files-as-html t + "Non-nil means, make file links to `file.org' point to `file.html'. +When org-mode is exporting an org-mode file to HTML, links to +non-html files are directly put into a href tag in HTML. +However, links to other Org-mode files (recognized by the +extension `.org.) should become links to the corresponding html +file, assuming that the linked org-mode file will also be +converted to HTML. +When nil, the links still point to the plain `.org' file." + :group 'org-export-html + :type 'boolean) + (defcustom org-export-html-inline-images t "Non-nil means, inline images into exported HTML pages. The link will still be to the original location of the image file. @@ -1903,7 +1932,12 @@ background. You may have to customize the face `org-hide' to make this work. Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." +also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: hidestars + #+STARTUP: showstars" :group 'org-font-lock :type 'boolean) @@ -1926,188 +1960,246 @@ :tag "Org Faces" :group 'org-font-lock) +(defun org-compatible-face (specs) + "Make a compatible face specification. +XEmacs and Emacs 21 do not know about the `min-colors' attribute. +For them we convert a (min-colors 8) entry to a `tty' entry and move it +to the top of the list. The `min-colors' attribute will be removed from +any other entries, and any resulting duplicates will be removed entirely." + (if (or (featurep 'xemacs) (< emacs-major-version 22)) + (let (r e a) + (while (setq e (pop specs)) + (cond + ((memq (car e) '(t default)) (push e r)) + ((setq a (member '(min-colors 8) (car e))) + (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) + (cdr e))))) + ((setq a (assq 'min-colors (car e))) + (setq e (cons (delq a (car e)) (cdr e))) + (or (assoc (car e) r) (push e r))) + (t (or (assoc (car e) r) (push e r))))) + (nreverse r)) + specs)) + (defface org-hide - '( - (((type tty) (class color)) (:foreground "white")) - (((class color) (background light)) (:foreground "white")) - (((class color) (background dark)) (:foreground "black")) - (t (:inverse-video nil))) - "Face used for level 1 headlines." + '((((background light)) (:foreground "white")) + (((background dark)) (:foreground "black"))) + "Face used to hide leading stars in headlines. +The forground color of this face should be equal to the background +color of the frame." :group 'org-faces) (defface org-level-1 ;; font-lock-function-name-face - '((((type tty) (class color)) (:foreground "blue" :weight bold)) - (((class color) (background light)) (:foreground "Blue")) - (((class color) (background dark)) (:foreground "LightSkyBlue")) - (t (:inverse-video t :bold t))) + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) "Face used for level 1 headlines." :group 'org-faces) (defface org-level-2 ;; font-lock-variable-name-face - '((((type tty) (class color)) (:foreground "yellow" :weight light)) - (((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "LightGoldenrod")) - (t (:bold t :italic t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8) (background light)) (:foreground "yellow")) + (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) + (t (:bold t)))) "Face used for level 2 headlines." :group 'org-faces) (defface org-level-3 ;; font-lock-keyword-face - '((((type tty) (class color)) (:foreground "cyan" :weight bold)) - (((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:bold t))) + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) + (((class color) (min-colors 16) (background light)) (:foreground "Purple")) + (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) + (t (:bold t)))) "Face used for level 3 headlines." :group 'org-faces) (defface org-level-4 ;; font-lock-comment-face - '((((type tty pc) (class color) (background light)) (:foreground "red")) - (((type tty pc) (class color) (background dark)) (:foreground "red1")) - (((class color) (background light)) (:foreground "Firebrick")) - (((class color) (background dark)) (:foreground "chocolate1")) - (t (:bold t :italic t))) + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) (:foreground "red")) + (((class color) (min-colors 16) (background dark)) (:foreground "red1")) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face used for level 4 headlines." :group 'org-faces) (defface org-level-5 ;; font-lock-type-face - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "ForestGreen")) - (((class color) (background dark)) (:foreground "PaleGreen")) - (t (:bold t :underline t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")))) "Face used for level 5 headlines." :group 'org-faces) (defface org-level-6 ;; font-lock-constant-face - '((((type tty) (class color)) (:foreground "magenta")) - (((class color) (background light)) (:foreground "CadetBlue")) - (((class color) (background dark)) (:foreground "Aquamarine")) - (t (:bold t :underline t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 8)) (:foreground "magenta")))) "Face used for level 6 headlines." :group 'org-faces) (defface org-level-7 ;; font-lock-builtin-face - '((((type tty) (class color)) (:foreground "blue" :weight light)) - (((class color) (background light)) (:foreground "Orchid")) - (((class color) (background dark)) (:foreground "LightSteelBlue")) - (t (:bold t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 8)) (:foreground "blue")))) ;; FIXME: for dark bg? "Face used for level 7 headlines." :group 'org-faces) (defface org-level-8 ;; font-lock-string-face - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "RosyBrown")) - (((class color) (background dark)) (:foreground "LightSalmon")) - (t (:italic t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8)) (:foreground "green")))) "Face used for level 8 headlines." :group 'org-faces) (defface org-special-keyword ;; font-lock-string-face - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "RosyBrown")) - (((class color) (background dark)) (:foreground "LightSalmon")) - (t (:italic t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) "Face used for special keywords." :group 'org-faces) (defface org-warning ;; font-lock-warning-face - '((((type tty) (class color)) (:foreground "red")) - (((class color) (background light)) (:foreground "Red" :bold t)) - (((class color) (background dark)) (:foreground "Red1" :bold t)) -; (((class color) (background dark)) (:foreground "Pink" :bold t)) - (t (:inverse-video t :bold t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face for deadlines and TODO keywords." :group 'org-faces) (defface org-headline-done ;; font-lock-string-face - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "RosyBrown")) - (((class color) (background dark)) (:foreground "LightSalmon")) - (t (:italic t))) - "Face used to indicate that a headline is DONE. See also the variable -`org-fontify-done-headline'." + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8) (background light)) (:bold nil)))) + "Face used to indicate that a headline is DONE. +This face is only used if `org-fontify-done-headline' is set." + :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))) + "Face for links." + :group 'org-faces) + +(defface org-date + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t))) + "Face for links." + :group 'org-faces) + +(defface org-tag + '((t (:bold t))) + "Face for tags." :group 'org-faces) -;; Inheritance does not work for xemacs. So we just copy... - -(defface org-deadline-announce - '((((type tty) (class color)) (:foreground "blue" :weight bold)) - (((class color) (background light)) (:foreground "Blue")) - (((class color) (background dark)) (:foreground "LightSkyBlue")) - (t (:inverse-video t :bold t))) - "Face for upcoming deadlines." +(defface org-todo ;; font-lock-warning-face + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:inverse-video t :bold t)))) + "Face for TODO keywords." + :group 'org-faces) + +(defface org-done ;; font-lock-type-face + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t)))) + "Face used for DONE." + :group 'org-faces) + +(defface org-table ;; font-lock-function-name-face + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8) (background light)) (:foreground "blue")) + (((class color) (min-colors 8) (background dark))))) + "Face used for tables." + :group 'org-faces) + +(defface org-formula + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red")) + (t (:bold t :italic t)))) + "Face for formulas." :group 'org-faces) (defface org-scheduled-today - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "DarkGreen")) - (((class color) (background dark)) (:foreground "PaleGreen")) - (t (:bold t :underline t))) + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t)))) "Face for items scheduled for a certain day." :group 'org-faces) (defface org-scheduled-previously - '((((type tty pc) (class color) (background light)) (:foreground "red")) - (((type tty pc) (class color) (background dark)) (:foreground "red1")) - (((class color) (background light)) (:foreground "Firebrick")) - (((class color) (background dark)) (:foreground "chocolate1")) - (t (:bold t :italic t))) + (org-compatible-face + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) "Face for items scheduled previously, and not yet done." :group 'org-faces) -(defface org-formula - '((((type tty pc) (class color) (background light)) (:foreground "red")) - (((type tty pc) (class color) (background dark)) (:foreground "red1")) - (((class color) (background light)) (:foreground "Firebrick")) - (((class color) (background dark)) (:foreground "chocolate1")) - (t (:bold t :italic t))) - "Face for formulas." - :group 'org-faces) - -(defface org-link - '((((type tty) (class color)) (:foreground "cyan" :weight bold)) - (((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:bold t))) - "Face for links." - :group 'org-faces) - -(defface org-tag - '((((type tty) (class color)) (:weight bold)) - (((class color) (background light)) (:weight bold)) - (((class color) (background dark)) (:weight bold)) - (t (:bold t))) - "Face for tags." - :group 'org-faces) - -(defface org-done ;; font-lock-type-face - '((((type tty) (class color)) (:foreground "green")) - (((class color) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) - (t (:bold t :underline t))) - "Face used for DONE." - :group 'org-faces) - -(defface org-table ;; font-lock-function-name-face - '((((type tty) (class color)) (:foreground "blue" :weight bold)) - (((class color) (background light)) (:foreground "Blue")) - (((class color) (background dark)) (:foreground "LightSkyBlue")) - (t (:inverse-video t :bold t))) - "Face used for tables." - :group 'org-faces) - (defface org-time-grid ;; font-lock-variable-name-face - '((((type tty) (class color)) (:foreground "yellow" :weight light)) - (((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "LightGoldenrod")) - (t (:bold t :italic t))) + (org-compatible-face + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) ; FIXME: turn off??? "Face used for time grids." :group 'org-faces) -(defvar org-level-faces +(defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 org-level-5 org-level-6 org-level-7 org-level-8 )) -(defvar org-n-levels (length org-level-faces)) - +(defconst org-n-levels (length org-level-faces)) + +(defconst org-bold-re + (if (featurep 'xemacs) + "\\([ ]\\|^\\)\\(\\*\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)\\*\\)\\([ ,.]\\|$\\)" + "\\([ ]\\|^\\)\\(\\*\\(\\w[[:word:] -_]*?\\w\\)\\*\\)\\([ ,.]\\|$\\)") + "Regular expression for bold emphasis.") +(defconst org-italic-re + (if (featurep 'xemacs) + "\\([ ]\\|^\\)\\(/\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)/\\)\\([ ,.]\\|$\\)" + "\\([ ]\\|^\\)\\(/\\(\\w[[:word:] -_]*?\\w\\)/\\)\\([ ,.]\\|$\\)") + "Regular expression for italic emphasis.") +(defconst org-underline-re + (if (featurep 'xemacs) + "\\([ ]\\|^\\)\\(_\\(\\w[a-zA-Z0-9-_ ]*?\\w\\)_\\)\\([ ,.]\\|$\\)" + "\\([ ]\\|^\\)\\(_\\(\\w[[:word:] -_]*?\\w\\)_\\)\\([ ,.]\\|$\\)") + "Regular expression for underline emphasis.") ;; Variables for pre-computed regular expressions, all buffer local (defvar org-done-string nil @@ -2400,6 +2492,10 @@ s) (match-string-no-properties num string))) +(defsubst org-no-properties (s) + (remove-text-properties 0 (length s) org-rm-props s) + s) + (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> org-time-stamp-rounding-minutes 0) @@ -2530,7 +2626,9 @@ (defun org-activate-bracket-links (limit) "Run through the buffer and add overlays to bracketed links." (if (re-search-forward org-bracket-link-regexp limit t) - (let* ((help (concat "LINK: " (org-match-string-no-properties 1))) + (let* ((help (concat "LINK: " + (org-match-string-no-properties 1))) + ;; FIXME: above we should remove the escapes. (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t 'keymap org-mouse-map 'mouse-face 'highlight 'help-echo help)) @@ -2678,20 +2776,23 @@ (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-link t))) + (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) (if (memq 'camel lk) '(org-activate-camels (0 'org-link t))) (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if org-table-limit-column-width '(org-hide-wide-columns (0 nil append))) (list (concat "^\\*+[ \t]*" org-not-done-regexp) - '(1 'org-warning t)) + '(1 'org-todo t)) (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) - (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend)) - (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend)) +; (if em '("\\(\\W\\|^\\)\\(\\*\\w+\\*\\)\\(\\W\\|$\\)" 2 'bold prepend)) +; (if em '("\\(\\W\\|^\\)\\(/\\w+/\\)\\(\\W\\|$\\)" 2 'italic prepend)) +; (if em '("\\(\\W\\|^\\)\\(_\\w+_\\)\\(\\W\\|$\\)" 2 'underline prepend)) + (if em (list org-bold-re 2 ''bold 'prepend)) + (if em (list org-italic-re 2 ''italic 'prepend)) + (if em (list org-underline-re 2 ''underline 'prepend)) (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) @@ -2705,7 +2806,7 @@ '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *|" (1 'org-formula t))) + '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -3070,10 +3171,14 @@ (error (outline-next-heading))) (prog1 (match-string 0) (funcall outline-level))))) - (unless (bolp) (newline)) + (cond + ((and (org-on-heading-p) (bolp) + (save-excursion (backward-char 1) (not (org-invisible-p)))) + (open-line 1)) + ((bolp) nil) + (t (newline))) (insert head) - (if (looking-at "[ \t]*") - (replace-match " ")) + (just-one-space) (run-hooks 'org-insert-heading-hook)))) (defun org-insert-item () @@ -3086,8 +3191,20 @@ (org-at-item-p) t) (error nil))) - (unless (bolp) (newline)) - (insert (match-string 0)) + (let* ((bul (match-string 0)) + (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") + (match-end 0))) + (eowcol (save-excursion (goto-char eow) (current-column)))) + (cond + ((and (org-at-item-p) (<= (point) eow)) + ;; before the bullet + (beginning-of-line 1) + (open-line 1)) + ((<= (point) eow) + (beginning-of-line 1)) + (t (newline))) + (insert bul) + (just-one-space)) (org-maybe-renumber-ordered-list) t)) @@ -5293,7 +5410,8 @@ (completion-ignore-case t) (org-select-this-todo-keyword (if (stringp arg) arg - (and arg (integerp arg) (nth (1- arg) org-todo-keywords)))) + (and arg (integerp arg) (> arg 0) + (nth (1- arg) org-todo-keywords)))) rtn rtnall files file pos) (when (equal arg '(4)) (setq org-select-this-todo-keyword @@ -5893,6 +6011,7 @@ "Return the TODO information for agenda display." (let* ((props (list 'face nil 'done-face 'org-done + 'org-not-done-regexp org-not-done-regexp 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -5933,6 +6052,7 @@ (defun org-agenda-get-timestamps () "Return the date stamp information for agenda display." (let* ((props (list 'face nil + 'org-not-done-regexp org-not-done-regexp 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -5998,6 +6118,7 @@ (defun org-agenda-get-closed () "Return the logged TODO entries for agenda display." (let* ((props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" @@ -6049,6 +6170,7 @@ "Return the deadline information for agenda display." (let* ((wdays org-deadline-warning-days) (props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp 'keymap org-agenda-keymap 'help-echo (format "mouse-2 or RET jump to org file %s" @@ -6104,6 +6226,7 @@ (defun org-agenda-get-scheduled () "Return the scheduled information for agenda display." (let* ((props (list 'face 'org-scheduled-previously + 'org-not-done-regexp org-not-done-regexp 'undone-face 'org-scheduled-previously 'done-face 'org-done 'mouse-face 'highlight @@ -6153,6 +6276,7 @@ (defun org-agenda-get-blocks () "Return the date-range information for agenda display." (let* ((props (list 'face nil + 'org-not-done-regexp org-not-done-regexp 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -6251,7 +6375,6 @@ (file-name-nondirectory buffer-file-name)) ""))) (tag (if tags (nth (1- (length tags)) tags) "")) - ;;(tag (or (nth (1- (or (length tags) 0)) tags) "")) FIXME: rm time ;; needed for the eval of the prefix format (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) (time-of-day (and dotime (org-get-time-of-day ts))) @@ -6389,8 +6512,25 @@ (defun org-finalize-agenda-entries (list) "Sort and concatenate the agenda items." + (setq list (mapcar 'org-agenda-highlight-todo list)) (mapconcat 'identity (sort list 'org-entries-lessp) "\n")) +(defun org-agenda-highlight-todo (x) + (let (re) + (if (eq x 'line) + (save-excursion + (beginning-of-line 1) + (setq re (get-text-property (point) 'org-not-done-regexp)) + (goto-char (+ (point) (get-text-property (point) 'prefix-length))) + (and (looking-at (concat "[ \t]*" re)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-todo)))) + (setq re (get-text-property 0 'org-not-done-regexp x)) + (and re (string-match re x) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-todo) x)) + x))) + (defsubst org-cmp-priority (a b) "Compare the priorities of string A and B." (let ((pa (or (get-text-property 1 'priority a) 0)) @@ -6541,7 +6681,7 @@ (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (org-todo arg) - (forward-char 1) + (and (bolp) (forward-char 1)) (setq newhead (org-get-heading)) (save-excursion (org-back-to-heading) @@ -6581,12 +6721,13 @@ (replace-match new t t) (beginning-of-line 1) (add-text-properties (point-at-bol) (point-at-eol) props) - (if fixface - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'face - (if org-last-todo-state-is-todo - undone-face done-face)))) + (when fixface + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'face + (if org-last-todo-state-is-todo + undone-face done-face))) + (org-agenda-highlight-todo 'line)) (beginning-of-line 1)) (error "Line update did not work"))) (beginning-of-line 0))))) @@ -7306,7 +7447,10 @@ (format "Execute \"%s\" in shell? " (org-add-props cmd nil 'face 'org-warning)))) - (shell-command cmd) + (progn + (message "Executing %s..." cmd) + (shell-command cmd) + (message "Executing %s...done" cmd)) (error "Abort")))) (t @@ -7760,7 +7904,11 @@ (setq cmd 'emacs)))) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) - (setq cmd (format cmd (concat "\"" file "\""))) +; (setq cmd (format cmd (concat "\"" file "\""))) + ;; FIXME: normalize use of quotes + (if (string-match "['\"]%s['\"]" cmd) + (setq cmd (replace-match "'%s'" t t cmd))) + (setq cmd (format cmd file)) (save-window-excursion (shell-command (concat cmd " &")))) ((or (stringp cmd) @@ -8154,12 +8302,16 @@ (complete-file ;; Completing read for file names. (setq file (read-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name ".")))) + (let ((pwd (file-name-as-directory (expand-file-name "."))) + (pwd1 (file-name-as-directory (abbreviate-file-name + (expand-file-name "."))))) (cond ((equal complete-file '(16)) (setq link (org-make-link "file:" (abbreviate-file-name (expand-file-name file))))) + ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) + (setq link (org-make-link "file:" (match-string 1 file)))) ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") (expand-file-name file)) (setq link (org-make-link @@ -8665,7 +8817,7 @@ (> (org-string-width xx) fmax)) (org-add-props xx nil 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (copy-sequence xx))) + (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) (error "Cannot narrow field starting with wide link \"%s\"" @@ -11752,21 +11904,35 @@ ;; FILE link (let* ((filename path) (abs-p (file-name-absolute-p filename)) - (thefile (if abs-p (expand-file-name filename) filename)) - (thefile (save-match-data - (if (string-match ":[0-9]+$" thefile) - (replace-match "" t t thefile) - thefile))) - (file-is-image-p - (save-match-data - (string-match (org-image-file-name-regexp) thefile)))) + thefile file-is-image-p search) + (save-match-data + (if (string-match "::\\(.*\\)" filename) + (setq search (match-string 1 filename) + filename (replace-match "" nil nil filename))) + (setq file-is-image-p + (string-match (org-image-file-name-regexp) filename)) + (setq thefile (if abs-p (expand-file-name filename) filename)) + (when (and org-export-html-link-org-files-as-html + (string-match "\\.org$" thefile)) + (setq thefile (concat (substring thefile 0 + (match-beginning 0)) + ".html")) + (if (and search + ;; make sure this is can be used as target search + (not (string-match "^[0-9]*$" search)) + (not (string-match "^\\*" search)) + (not (string-match "^/.*/$" search))) + (setq thefile (concat thefile "#" + (org-solidify-link-text + (org-link-unescape search))))))) (setq rpl (if (and org-export-html-inline-images file-is-image-p) (concat "<img src=\"" thefile "\"/>") (concat "<a href=\"" thefile "\">" desc "</a>"))))) ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) - (setq rpl (concat "<i><" type ":" path "></i>")))) - ;; FIXME: We get to see the escaped links!!!!! + (setq rpl (concat "<i><" type ":" + (save-match-data (org-link-unescape path)) + "></i>")))) (setq line (replace-match rpl t t line) start (+ start (length rpl)))) ;; TODO items @@ -12111,15 +12277,24 @@ (setq string (replace-match (match-string 1 string) t t string)))) string) +;(defun org-export-html-convert-emphasize (string) +; (let (c (s 0)) +; (while (string-match "\\(\\W\\|^\\)\\([*/_]\\)\\(\\w+\\)\\2\\(\\W\\|$\\)" string s) +; (setq c (cdr (assoc (match-string 2 string) +; '(("*" . "b") ("/" . "i") ("_" . "u")))) +; s (+ (match-end 0) 3) +; string (replace-match +; (concat "\\1<" c ">\\3</" c ">\\4") t nil string))) +; string)) + (defun org-export-html-convert-emphasize (string) - (let (c (s 0)) - (while (string-match "\\(\\W\\|^\\)\\([*/_]\\)\\(\\w+\\)\\2\\(\\W\\|$\\)" string s) - (setq c (cdr (assoc (match-string 2 string) - '(("*" . "b") ("/" . "i") ("_" . "u")))) - s (+ (match-end 0) 3) - string (replace-match - (concat "\\1<" c ">\\3</" c ">\\4") t nil string))) - string)) + (while (string-match org-italic-re string) + (setq string (replace-match "\\1<i>\\3</i>\\4" t nil string))) + (while (string-match org-bold-re string) + (setq string (replace-match "\\1<b>\\3</b>\\4" t nil string))) + (while (string-match org-underline-re string) + (setq string (replace-match "\\1<u>\\3</u>\\4" t nil string))) + string) (defun org-parse-key-lines () "Find the special key lines with the information for exporters."
--- a/lisp/textmodes/tex-mode.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/textmodes/tex-mode.el Fri Apr 21 05:39:14 2006 +0000 @@ -594,20 +594,24 @@ '(face subscript display (raise -0.3)) '(face superscript display (raise +0.3))))) +(defun tex-font-lock-match-suscript (limit) + "Match subscript and superscript patterns up to LIMIT." + (when (re-search-forward "[_^] *\\([^\n\\{}]\\|\ +\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|{[^\\{]*}\\|\\({\\)\\)" limit t) + (when (match-end 3) + (let ((beg (match-beginning 3)) + (end (save-restriction + (narrow-to-region (point-min) limit) + (condition-case nil (scan-lists (point) 1 1) (error nil))))) + (store-match-data (if end + (list (match-beginning 0) end beg end) + (list beg beg beg beg))))) + t)) + (defconst tex-font-lock-keywords-3 (append tex-font-lock-keywords-2 - (eval-when-compile - (let ((general "\\([a-zA-Z@]+\\|[^ \t\n]\\)") - (slash "\\\\") - ;; This is not the same regexp as before: it has a `+' removed. - ;; The + makes the matching faster in the above cases (where we can - ;; exit as soon as the match fails) but would make this matching - ;; degenerate to nasty complexity (because we try to match the - ;; closing brace, which forces trying all matching combinations). - (arg "{\\(?:[^{}\\]\\|\\\\.\\|{[^}]*}\\)*")) - `((,(concat "[_^] *\\([^\n\\{}#]\\|" slash general "\\|#[0-9]\\|" arg "}\\)") - (1 (tex-font-lock-suscript (match-beginning 0)) - append)))))) + '((tex-font-lock-match-suscript + (1 (tex-font-lock-suscript (match-beginning 0)) append)))) "Experimental expressions to highlight in TeX modes.") (defvar tex-font-lock-keywords tex-font-lock-keywords-1
--- a/lisp/tooltip.el Mon Apr 17 08:41:12 2006 +0000 +++ b/lisp/tooltip.el Fri Apr 21 05:39:14 2006 +0000 @@ -47,11 +47,15 @@ ;; would be accompanied by a full redisplay. (define-minor-mode tooltip-mode - "Toggle Tooltip display. -With ARG, turn tooltip mode on if and only if ARG is positive. + "Toggle Tooltip mode. +With ARG, turn Tooltip mode on if and only if ARG is positive. When this minor mode is enabled, Emacs displays help text -in a pop-up window on mouse-over. When it is disabled, -Emacs displays the help text in the echo area instead." +in a pop-up window for buttons and menu items that you put the mouse on. +\(However, if `tooltip-use-echo-area' is non-nil, this and +all pop-up help appears in the echo area.) + +When Tooltip mode is disabled, Emacs displays one line of +the help text in the echo area, and does not make a pop-up window." :global t :init-value (not (or noninteractive emacs-basic-display @@ -142,7 +146,9 @@ :group 'basic-faces) (defcustom tooltip-use-echo-area nil - "Use the echo area instead of tooltip frames for help and GUD tooltips." + "Use the echo area instead of tooltip frames for help and GUD tooltips. +To display multi-line help text in the echo area, set this to t +and enable `tooltip-mode'." :type 'boolean :group 'tooltip)
--- a/lispref/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,19 @@ +2006-04-18 Richard Stallman <rms@gnu.org> + + * tips.texi (Coding Conventions): Explain when the package's + prefix should appear later on (not at the start of the name). + + * searching.texi (String Search): Clarify effect of NOERROR. + + * modes.texi (Imenu): Clarify what special items do. + + * hooks.texi (Standard Hooks): Delete text about old hook names. + +2006-04-17 Romain Francoise <romain@orebokech.com> + + * variables.texi (Local Variables): Update the default value of + `max-specpdl-size'. + 2006-04-15 Michael Olson <mwolson@gnu.org> * processes.texi (Transaction Queues): Mention the new optional @@ -59,8 +75,7 @@ 2006-03-19 Alan Mackenzie <acm@muc.de> - * text.texi (Special Properties): Clarify the definition of - 'fontified. + * text.texi (Special Properties): Clarify `fontified' property. 2006-03-16 Richard Stallman <rms@gnu.org>
--- a/lispref/hooks.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/hooks.texi Fri Apr 21 05:39:14 2006 +0000 @@ -31,11 +31,6 @@ or their values are used). The variables whose names end in @samp{-function} have single functions as their values. -(In older Emacs versions, some normal hooks had names ending in -@samp{-hooks} or @samp{-functions}, and some abnormal hooks had names -ending in @samp{-hook}. We have renamed all of these to conform to -the above conventions.) - @c We need to xref to where each hook is documented or else document @c it here.
--- a/lispref/modes.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/modes.texi Fri Apr 21 05:39:14 2006 +0000 @@ -2174,10 +2174,9 @@ (@var{menu-title} @var{regexp} @var{index} @var{function} @var{arguments}@dots{}) @end example -Like in the previous case, each match for this element creates an -index item. However, if this index item is selected by the user, it -calls @var{function} with arguments consisting of the item name, the -buffer position, and @var{arguments}. +Each match for this element creates an index item, and when the index +item is selected by the user, it calls @var{function} with arguments +consisting of the item name, the buffer position, and @var{arguments}. For Emacs Lisp mode, @code{imenu-generic-expression} could look like this:
--- a/lispref/searching.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/searching.texi Fri Apr 21 05:39:14 2006 +0000 @@ -86,6 +86,10 @@ return the new position of point in that case, but some existing programs may depend on a value of @code{nil}.) +The argument @var{noerror} only affects valid searches which fail to +find a match. Invalid arguments cause errors regardless of +@var{noerror}. + If @var{repeat} is supplied (it must be a positive number), then the search is repeated that many times (each time starting at the end of the previous time's match). If these successive searches succeed, the
--- a/lispref/tips.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/tips.texi Fri Apr 21 05:39:14 2006 +0000 @@ -56,9 +56,13 @@ benefits of a Common Lisp-style package system are considered not to outweigh the costs.} Then take care to begin the names of all global variables, constants, and functions in your program with the chosen -prefix. This helps avoid name conflicts. (Occasionally, for a command -name intended for users to use, it is cleaner if some words come -before the package name prefix.) +prefix. This helps avoid name conflicts. + +Occasionally, for a command name intended for users to use, it is more +convenient if some words come before the package's name prefix. And +constructs that define functions, variables, etc., work better if they +start with @samp{defun} or @samp{defvar}, so put the name prefix later +on in the name. This recommendation applies even to names for traditional Lisp primitives that are not primitives in Emacs Lisp---such as
--- a/lispref/variables.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/lispref/variables.texi Fri Apr 21 05:39:14 2006 +0000 @@ -276,7 +276,7 @@ @code{max-lisp-eval-depth} provides another limit on depth of nesting. @xref{Definition of max-lisp-eval-depth,, Eval}. -The default value is 600. Entry to the Lisp debugger increases the +The default value is 1000. Entry to the Lisp debugger increases the value, if there is little room left, to make sure the debugger itself has room to execute. @end defvar
--- a/make-dist Mon Apr 17 08:41:12 2006 +0000 +++ b/make-dist Fri Apr 21 05:39:14 2006 +0000 @@ -6,7 +6,7 @@ #### be distributed. This means that if you add a file with an odd name, #### you should make sure that this script will include it. -# Copyright (C) 1995, 1997, 1998, 2000, 2001, 2002, 2005 +# Copyright (C) 1995, 1997, 1998, 2000, 2001, 2002, 2005, 2006 # Free Software Foundation, Inc. # # This file is part of GNU Emacs.
--- a/man/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/man/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,3 +1,52 @@ +2006-04-20 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (Spam Statistics Package): Fix typo in @pxref. + (Splitting mail using spam-stat): Fix @xref. + +2006-04-20 Chong Yidong <cyd@stupidchicken.com> + + * gnus.texi (Spam Package): Major revision of the text. Previouly + this node was "Filtering Spam Using The Spam ELisp Package". + +2006-04-20 Carsten Dominik <dominik@science.uva.nl> + + * org.texi: (Time stamps): Better explanation of the purpose of + different time stamps. + (Structure editing, Plain lists): More details on how new items + and headings are inserted. + +2006-04-18 J.D. Smith <jdsmith@as.arizona.edu> + + * misc.texi (Shell Ring): Added notes on saved input when + navigating off the end of the history list. + +2006-04-18 Chong Yidong <cyd@mit.edu> + + * misc.texi (Shell Options): Correct default value of + comint-scroll-show-maximum-output. + +2006-04-18 Carsten Dominik <dominik@science.uva.nl> + + * org.texi: (Formula syntax): Fixed link to Calc Manual. + +2006-04-17 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (Emacsen): Don't support Emacs 20.7 and XEmacs 21.1. + +2006-04-17 Bill Wohler <wohler@newt.com> + + * mh-e.texi (Folders): Updated mh-before-quit-hook and + mh-quit-hook example with code that removes the buffers rather + than just bury them. + +2006-04-18 Nick Roberts <nickrob@snap.net.nz> + + * building.texi (Watch Expressions): Update. + +2006-04-17 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.53. + 2006-04-13 Carsten Dominik <dominik@science.uva.nl> * org.texi: (Updating settings): New section.
--- a/man/building.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/building.texi Fri Apr 21 05:39:14 2006 +0000 @@ -929,20 +929,26 @@ @cindex Watching expressions in GDB @findex gud-watch +@kindex C-x C-a C-w @r{(GUD)} If you want to see how a variable changes each time your program stops, move point into the variable name and click on the watch icon -in the tool bar (@code{gud-watch}). +in the tool bar (@code{gud-watch}) or type @kbd{C-x C-a C-w}. If you +specify a prefix argument, you can enter the variable name in the +minibuffer. Each watch expression is displayed in the speedbar. Complex data types, such as arrays, structures and unions are represented in a tree format. Leaves and simple data types show the name of the expression and its value and, when the speedbar frame is selected, display the type as a tooltip. Higher levels show the name, type and address -value for pointers and just the name and type otherwise. +value for pointers and just the name and type otherwise. Root expressions +also display the frame address as a tooltip to help identify the frame +in which they were defined. To expand or contract a complex data type, click @kbd{Mouse-2} on the tag to the left of the expression. +@kindex D @r{(GDB speedbar)} @findex gdb-var-delete To delete a complex watch expression, move point to the root expression in the speedbar and type @kbd{D} (@code{gdb-var-delete}). @@ -965,9 +971,8 @@ @vindex gdb-use-colon-colon-notation If the variable @code{gdb-use-colon-colon-notation} is non-@code{nil}, Emacs uses the @samp{@var{function}::@var{variable}} -format to display variables in the speedbar. Since this does not work -for variables defined in compound statements, the default value is -@code{nil}. +format. This allows the user to display watch expressions which share +the same variable name. The default value is @code{nil}. @vindex gdb-speedbar-auto-raise To automatically raise the speedbar every time the display of watch
--- a/man/gnus.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/gnus.texi Fri Apr 21 05:39:14 2006 +0000 @@ -799,7 +799,8 @@ * Moderation:: What to do if you're a moderator. * Image Enhancements:: Modern versions of Emacs/XEmacs can display images. * Fuzzy Matching:: What's the big fuzz? -* Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. +* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email. +* Spam Package:: A package for filtering and processing spam. * Other modes:: Interaction with other modes. * Various Various:: Things that are really various. @@ -818,7 +819,8 @@ * X-Face:: Display a funky, teensy black-and-white image. * Face:: Display a funkier, teensier colored image. -* Smileys:: Show all those happy faces the way they were meant to be shown. +* Smileys:: Show all those happy faces the way they were + meant to be shown. * Picons:: How to display pictures of what you're reading. * XVarious:: Other XEmacsy Gnusey variables. @@ -828,28 +830,19 @@ * Anti-Spam Basics:: Simple steps to reduce the amount of spam. * SpamAssassin:: How to use external anti-spam tools. * Hashcash:: Reduce spam by burning CPU time. -* Filtering Spam Using The Spam ELisp Package:: -* Filtering Spam Using Statistics with spam-stat:: - -Filtering Spam Using The Spam ELisp Package - -* Spam ELisp Package Sequence of Events:: -* Spam ELisp Package Filtering of Incoming Mail:: -* Spam ELisp Package Global Variables:: -* Spam ELisp Package Configuration Examples:: -* Blacklists and Whitelists:: -* BBDB Whitelists:: -* Gmane Spam Reporting:: -* Anti-spam Hashcash Payments:: -* Blackholes:: -* Regular Expressions Header Matching:: -* Bogofilter:: -* ifile spam filtering:: -* spam-stat spam filtering:: -* SpamOracle:: -* Extending the Spam ELisp package:: - -Filtering Spam Using Statistics with spam-stat + +Spam Package + +* Spam Package Introduction:: +* Filtering Incoming Mail:: +* Detecting Spam in Groups:: +* Spam and Ham Processors:: +* Spam Package Configuration Examples:: +* Spam Back Ends:: +* Extending the Spam package:: +* Spam Statistics Package:: + +Spam Statistics Package * Creating a spam-stat dictionary:: * Splitting mail using spam-stat:: @@ -20797,7 +20790,8 @@ * Fetching a Group:: Starting Gnus just to read a group. * Image Enhancements:: Modern versions of Emacs/XEmacs can display images. * Fuzzy Matching:: What's the big fuzz? -* Thwarting Email Spam:: A how-to on avoiding unsolicited commercial email. +* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email. +* Spam Package:: A package for filtering and processing spam. * Other modes:: Interaction with other modes. * Various Various:: Things that are really various. @end menu @@ -22479,8 +22473,6 @@ * Anti-Spam Basics:: Simple steps to reduce the amount of spam. * SpamAssassin:: How to use external anti-spam tools. * Hashcash:: Reduce spam by burning CPU time. -* Filtering Spam Using The Spam ELisp Package:: -* Filtering Spam Using Statistics with spam-stat:: @end menu @node The problem of spam @@ -22796,41 +22788,107 @@ customized mail filtering scripts. Improvements in this area would be a useful contribution, however. -@node Filtering Spam Using The Spam ELisp Package -@subsection Filtering Spam Using The Spam ELisp Package +@node Spam Package +@section Spam Package @cindex spam filtering @cindex spam -The idea behind @file{spam.el} is to have a control center for spam detection -and filtering in Gnus. To that end, @file{spam.el} does two things: it -filters new mail, and it analyzes mail known to be spam or ham. -@dfn{Ham} is the name used throughout @file{spam.el} to indicate -non-spam messages. +The Spam package provides Gnus with a centralized mechanism for +detecting and filtering spam. It filters new mail, and processes +messages according to whether they are spam or ham. (@dfn{Ham} is the +name used throughout this manual to indicate non-spam messages.) + +@menu +* Spam Package Introduction:: +* Filtering Incoming Mail:: +* Detecting Spam in Groups:: +* Spam and Ham Processors:: +* Spam Package Configuration Examples:: +* Spam Back Ends:: +* Extending the Spam package:: +* Spam Statistics Package:: +@end menu + +@node Spam Package Introduction +@subsection Spam Package Introduction +@cindex spam filtering +@cindex spam filtering sequence of events +@cindex spam + +You must read this section to understand how the Spam package works. +Do not skip, speed-read, or glance through this section. @cindex spam-initialize -First of all, you @strong{must} run the function -@code{spam-initialize} to autoload @code{spam.el} and to install the -@code{spam.el} hooks. There is one exception: if you use the -@code{spam-use-stat} (@pxref{spam-stat spam filtering}) setting, you -should turn it on before @code{spam-initialize}: - -@example -(setq spam-use-stat t) ;; if needed +@vindex spam-use-stat +To use the Spam package, you @strong{must} first run the function +@code{spam-initialize}: + +@example (spam-initialize) @end example -So, what happens when you load @file{spam.el}? - -First, some hooks will get installed by @code{spam-initialize}. There -are some hooks for @code{spam-stat} so it can save its databases, and -there are hooks so interesting things will happen when you enter and -leave a group. More on the sequence of events later (@pxref{Spam -ELisp Package Sequence of Events}). - -You get the following keyboard commands: - -@table @kbd - +This autoloads @code{spam.el} and installs the various hooks necessary +to let the Spam package do its job. In order to make use of the Spam +package, you have to set up certain group parameters and variables, +which we will describe below. All of the variables controlling the +Spam package can be found in the @samp{spam} customization group. + +There are two ``contact points'' between the Spam package and the rest +of Gnus: checking new mail for spam, and leaving a group. + +Checking new mail for spam is done in one of two ways: while splitting +incoming mail, or when you enter a group. + +The first way, checking for spam while splitting incoming mail, is +suited to mail back ends such as @code{nnml} or @code{nnimap}, where +new mail appears in a single spool file. The Spam package processes +incoming mail, and sends mail considered to be spam to a designated +``spam'' group. @xref{Filtering Incoming Mail}. + +The second way is suited to back ends such as @code{nntp}, which have +no incoming mail spool, or back ends where the server is in charge of +splitting incoming mail. In this case, when you enter a Gnus group, +the unseen or unread messages in that group are checked for spam. +Detected spam messages are marked as spam. @xref{Detecting Spam in +Groups}. + +@cindex spam back ends +In either case, you have to tell the Spam package what method to use +to detect spam messages. There are several methods, or @dfn{spam back +ends} (not to be confused with Gnus back ends!) to choose from: spam +``blacklists'' and ``whitelists'', dictionary-based filters, and so +forth. @xref{Spam Back Ends}. + +In the Gnus summary buffer, messages that have been identified as spam +always appear with a @samp{$} symbol. + +The Spam package divides Gnus groups into three categories: ham +groups, spam groups, and unclassified groups. You should mark each of +the groups you subscribe to as either a ham group or a spam group, +using the @code{spam-contents} group parameter (@pxref{Group +Parameters}). Spam groups have a special property: when you enter a +spam group, all unseen articles are marked as spam. Thus, mail split +into a spam group is automatically marked as spam. + +Identifying spam messages is only half of the Spam package's job. The +second half comes into play whenever you exit a group buffer. At this +point, the Spam package does several things: + +First, it calls @dfn{spam and ham processors} to process the articles +according to whether they are spam or ham. There is a pair of spam +and ham processors associated with each spam back end, and what the +processors do depends on the back end. At present, the main role of +spam and ham processors is for dictionary-based spam filters: they add +the contents of the messages in the group to the filter's dictionary, +to improve its ability to detect future spam. The @code{spam-process} +group parameter specifies what spam processors to use. @xref{Spam and +Ham Processors}. + +If the spam filter failed to mark a spam message, you can mark it +yourself, so that the message is processed as spam when you exit the +group: + +@table @kbd @item M-d @itemx M s x @itemx S x @@ -22838,189 +22896,103 @@ @kindex S x @kindex M s x @findex gnus-summary-mark-as-spam -@code{gnus-summary-mark-as-spam}. - -Mark current article as spam, showing it with the @samp{$} mark. -Whenever you see a spam article, make sure to mark its summary line -with @kbd{M-d} before leaving the group. This is done automatically -for unread articles in @emph{spam} groups. - -@item M s t -@itemx S t -@kindex M s t -@kindex S t -@findex spam-bogofilter-score -@code{spam-bogofilter-score}. - -You must have Bogofilter installed for that command to work properly. - -@xref{Bogofilter}. - -@end table - -Also, when you load @file{spam.el}, you will be able to customize its -variables. Try @code{customize-group} on the @samp{spam} variable -group. - -@menu -* Spam ELisp Package Sequence of Events:: -* Spam ELisp Package Filtering of Incoming Mail:: -* Spam ELisp Package Global Variables:: -* Spam ELisp Package Configuration Examples:: -* Blacklists and Whitelists:: -* BBDB Whitelists:: -* Gmane Spam Reporting:: -* Anti-spam Hashcash Payments:: -* Blackholes:: -* Regular Expressions Header Matching:: -* Bogofilter:: -* ifile spam filtering:: -* spam-stat spam filtering:: -* SpamOracle:: -* Extending the Spam ELisp package:: -@end menu - -@node Spam ELisp Package Sequence of Events -@subsubsection Spam ELisp Package Sequence of Events -@cindex spam filtering -@cindex spam filtering sequence of events -@cindex spam - -You must read this section to understand how @code{spam.el} works. -Do not skip, speed-read, or glance through this section. - -There are two @emph{contact points}, if you will, between -@code{spam.el} and the rest of Gnus: checking new mail for spam, and -leaving a group. - -Getting new mail is done in one of two ways. You can either split -your incoming mail or you can classify new articles as ham or spam -when you enter the group. - -Splitting incoming mail is better suited to mail backends such as -@code{nnml} or @code{nnimap} where new mail appears in a single file -called a @dfn{Spool File}. See @xref{Spam ELisp Package Filtering of -Incoming Mail}. - -For backends such as @code{nntp} there is no incoming mail spool, so -an alternate mechanism must be used. This may also happen for -backends where the server is in charge of splitting incoming mail, and -Gnus does not do further splitting. The @code{spam-autodetect} and -@code{spam-autodetect-methods} group parameters (accessible with -@kbd{G c} and @kbd{G p} as usual), and the corresponding variables -@code{gnus-spam-autodetect-methods} and -@code{gnus-spam-autodetect-methods} (accessible with @kbd{M-x -customize-variable} as usual). - -When @code{spam-autodetect} is used, it hooks into the process of -entering a group. Thus, entering a group with unseen or unread -articles becomes the substitute for checking incoming mail. Whether -only unseen articles or all unread articles will be processed is -determined by the @code{spam-autodetect-recheck-messages}. When set -to @code{t}, unread messages will be rechecked. - -@code{spam-autodetect} grants the user at once more and less control -of spam filtering. The user will have more control over each group's -spam methods, so for instance the @samp{ding} group may have -@code{spam-use-BBDB} as the autodetection method, while the -@samp{suspect} group may have the @code{spam-use-blacklist} and -@code{spam-use-bogofilter} methods enabled. Every article detected to -be spam will be marked with the spam mark @samp{$} and processed on -exit from the group as normal spam. The user has less control over -the @emph{sequence} of checks, as he might with @code{spam-split}. - -When the newly split mail goes into groups, or messages are -autodetected to be ham or spam, those groups must be exited (after -entering, if needed) for further spam processing to happen. It -matters whether the group is considered a ham group, a spam group, or -is unclassified, based on its @code{spam-content} parameter -(@pxref{Spam ELisp Package Global Variables}). Spam groups have the -additional characteristic that, when entered, any unseen or unread -articles (depending on the @code{spam-mark-only-unseen-as-spam} -variable) will be marked as spam. Thus, mail split into a spam group -gets automatically marked as spam when you enter the group. - -So, when you exit a group, the @code{spam-processors} are applied, if -any are set, and the processed mail is moved to the -@code{ham-process-destination} or the @code{spam-process-destination} -depending on the article's classification. If the -@code{ham-process-destination} or the @code{spam-process-destination}, -whichever is appropriate, are @code{nil}, the article is left in the -current group. - -If a spam is found in any group (this can be changed to only non-spam -groups with @code{spam-move-spam-nonspam-groups-only}), it is -processed by the active @code{spam-processors} (@pxref{Spam ELisp -Package Global Variables}) when the group is exited. Furthermore, the -spam is moved to the @code{spam-process-destination} (@pxref{Spam -ELisp Package Global Variables}) for further training or deletion. -You have to load the @code{gnus-registry.el} package and enable the -@code{spam-log-to-registry} variable if you want spam to be processed -no more than once. Thus, spam is detected and processed everywhere, -which is what most people want. If the -@code{spam-process-destination} is @code{nil}, the spam is marked as +@findex gnus-summary-mark-as-spam +Mark current article as spam, showing it with the @samp{$} mark +(@code{gnus-summary-mark-as-spam}). +@end table + +@noindent +Similarly, you can unmark an article if it has been erroneously marked +as spam. @xref{Setting Marks}. + +Normally, a ham message found in a non-ham group is not processed as +ham---the rationale is that it should be moved into a ham group for +further processing (see below). However, you can force these articles +to be processed as ham by setting +@code{spam-process-ham-in-spam-groups} and +@code{spam-process-ham-in-nonham-groups}. + +@vindex gnus-ham-process-destinations +@vindex gnus-spam-process-destinations +The second thing that the Spam package does when you exit a group is +to move ham articles out of spam groups, and spam articles out of ham +groups. Ham in a spam group is moved to the group specified by the +variable @code{gnus-ham-process-destinations}, or the group parameter +@code{ham-process-destination}. Spam in a ham group is moved to the +group specified by the variable @code{gnus-spam-process-destinations}, +or the group parameter @code{spam-process-destination}. If these +variables are not set, the articles are left in their current group. +If an article cannot not be moved (e.g., with a read-only backend such +as @acronym{NNTP}), it is copied. + +If an article is moved to another group, it is processed again when +you visit the new group. Normally, this is not a problem, but if you +want each article to be processed only once, load the +@code{gnus-registry.el} package and set the variable +@code{spam-log-to-registry} to @code{t}. @xref{Spam Package +Configuration Examples}. + +Normally, spam groups ignore @code{gnus-spam-process-destinations}. +However, if you set @code{spam-move-spam-nonspam-groups-only} to +@code{nil}, spam will also be moved out of spam groups, depending on +the @code{spam-process-destination} parameter. + +The final thing the Spam package does is to mark spam articles as expired, which is usually the right thing to do. -If spam can not be moved---because of a read-only backend such as -@acronym{NNTP}, for example, it will be copied. - -If a ham mail is found in a ham group, as determined by the -@code{ham-marks} parameter, it is processed as ham by the active ham -@code{spam-processor} when the group is exited. With the variables -@code{spam-process-ham-in-spam-groups} and -@code{spam-process-ham-in-nonham-groups} the behavior can be further -altered so ham found anywhere can be processed. You have to load the -@code{gnus-registry.el} package and enable the -@code{spam-log-to-registry} variable if you want ham to be processed -no more than once. Thus, ham is detected and processed only when -necessary, which is what most people want. More on this in -@xref{Spam ELisp Package Configuration Examples}. - -If ham can not be moved---because of a read-only backend such as -@acronym{NNTP}, for example, it will be copied. - If all this seems confusing, don't worry. Soon it will be as natural as typing Lisp one-liners on a neural interface@dots{} err, sorry, that's 50 years in the future yet. Just trust us, it's not so bad. -@node Spam ELisp Package Filtering of Incoming Mail -@subsubsection Spam ELisp Package Filtering of Incoming Mail +@node Filtering Incoming Mail +@subsection Filtering Incoming Mail @cindex spam filtering @cindex spam filtering incoming mail @cindex spam -To use the @file{spam.el} facilities for incoming mail filtering, you -must add the following to your fancy split list -@code{nnmail-split-fancy} or @code{nnimap-split-fancy}: +To use the Spam package to filter incoming mail, you must first set up +fancy mail splitting. @xref{Fancy Mail Splitting}. The Spam package +defines a special splitting function that you can add to your fancy +split variable (either @code{nnmail-split-fancy} or +@code{nnimap-split-fancy}, depending on your mail back end): @example (: spam-split) @end example -Note that the fancy split may be called @code{nnmail-split-fancy} or -@code{nnimap-split-fancy}, depending on whether you use the nnmail or -nnimap back ends to retrieve your mail. - -Also, @code{spam-split} will not modify incoming mail in any way. - -The @code{spam-split} function will process incoming mail and send the -mail considered to be spam into the group name given by the variable -@code{spam-split-group}. By default that group name is @samp{spam}, -but you can customize @code{spam-split-group}. Make sure the contents -of @code{spam-split-group} are an @emph{unqualified} group name, for -instance in an @code{nnimap} server @samp{your-server} the value -@samp{spam} will turn out to be @samp{nnimap+your-server:spam}. The -value @samp{nnimap+server:spam}, therefore, is wrong and will -actually give you the group -@samp{nnimap+your-server:nnimap+server:spam} which may or may not -work depending on your server's tolerance for strange group names. - -You can also give @code{spam-split} a parameter, -e.g. @code{spam-use-regex-headers} or @code{"maybe-spam"}. Why is -this useful? - -Take these split rules (with @code{spam-use-regex-headers} and -@code{spam-use-blackholes} set): +@vindex spam-split-group +@noindent +The @code{spam-split} function scans incoming mail according to your +chosen spam back end(s), and sends messages identified as spam to a +spam group. By default, the spam group is a group named @samp{spam}, +but you can change this by customizing @code{spam-split-group}. Make +sure the contents of @code{spam-split-group} are an unqualified group +name. For instance, in an @code{nnimap} server @samp{your-server}, +the value @samp{spam} means @samp{nnimap+your-server:spam}. The value +@samp{nnimap+server:spam} is therefore wrong---it gives the group +@samp{nnimap+your-server:nnimap+server:spam}. + +@code{spam-split} does not modify the contents of messages in any way. + +@vindex nnimap-split-download-body +Note for IMAP users: if you use the @code{spam-check-bogofilter}, +@code{spam-check-ifile}, and @code{spam-check-stat} spam back ends, +you should also set set the variable @code{nnimap-split-download-body} +to @code{t}. These spam back ends are most useful when they can +``scan'' the full message body. By default, the nnimap back end only +retrieves the message headers; @code{nnimap-split-download-body} tells +it to retrieve the message bodies as well. We don't set this by +default because it will slow @acronym{IMAP} down, and that is not an +appropriate decision to make on behalf of the user. @xref{Splitting +in IMAP}. + +You have to specify one or more spam back ends for @code{spam-split} +to use, by setting the @code{spam-use-*} variables. @xref{Spam Back +Ends}. Normally, @code{spam-split} simply uses all the spam back ends +you enabled in this way. However, you can tell @code{spam-split} to +use only some of them. Why this is useful? Suppose you are using the +@code{spam-use-regex-headers} and @code{spam-use-blackholes} spam back +ends, and the following split rule: @example nnimap-split-fancy '(| @@ -23030,21 +23002,23 @@ "mail") @end example -Now, the problem is that you want all ding messages to make it to the -ding folder. But that will let obvious spam (for example, spam -detected by SpamAssassin, and @code{spam-use-regex-headers}) through, -when it's sent to the ding list. On the other hand, some messages to -the ding list are from a mail server in the blackhole list, so the -invocation of @code{spam-split} can't be before the ding rule. - -You can let SpamAssassin headers supersede ding rules, but all other -@code{spam-split} rules (including a second invocation of the -regex-headers check) will be after the ding rule: +@noindent +The problem is that you want all ding messages to make it to the ding +folder. But that will let obvious spam (for example, spam detected by +SpamAssassin, and @code{spam-use-regex-headers}) through, when it's +sent to the ding list. On the other hand, some messages to the ding +list are from a mail server in the blackhole list, so the invocation +of @code{spam-split} can't be before the ding rule. + +The solution is to let SpamAssassin headers supersede ding rules, and +perform the other @code{spam-split} rules (including a second +invocation of the regex-headers check) after the ding rule. This is +done by passing a parameter to @code{spam-split}: @example nnimap-split-fancy '(| - ;; @r{all spam detected by @code{spam-use-regex-headers} goes to @samp{regex-spam}} + ;; @r{spam detected by @code{spam-use-regex-headers} goes to @samp{regex-spam}} (: spam-split "regex-spam" 'spam-use-regex-headers) (any "ding" "ding") ;; @r{all other spam detected by spam-split goes to @code{spam-split-group}} @@ -23053,58 +23027,68 @@ "mail") @end example +@noindent This lets you invoke specific @code{spam-split} checks depending on -your particular needs, and to target the results of those checks to a +your particular needs, and target the results of those checks to a particular spam group. You don't have to throw all mail into all the spam tests. Another reason why this is nice is that messages to mailing lists you have rules for don't have to have resource-intensive blackhole checks performed on them. You could also specify different spam checks for your nnmail split vs. your nnimap split. Go crazy. -You should still have specific checks such as -@code{spam-use-regex-headers} set to @code{t}, even if you -specifically invoke @code{spam-split} with the check. The reason is -that when loading @file{spam.el}, some conditional loading is done -depending on what @code{spam-use-xyz} variables you have set. This -is usually not critical, though. - -@emph{Note for IMAP users} - -The boolean variable @code{nnimap-split-download-body} needs to be -set, if you want to split based on the whole message instead of just -the headers. By default, the nnimap back end will only retrieve the -message headers. If you use @code{spam-check-bogofilter}, -@code{spam-check-ifile}, or @code{spam-check-stat} (the splitters that -can benefit from the full message body), you should set this variable. -It is not set by default because it will slow @acronym{IMAP} down, and -that is not an appropriate decision to make on behalf of the user. - -@xref{Splitting in IMAP}. - -@emph{TODO: spam.el needs to provide a uniform way of training all the -statistical databases. Some have that functionality built-in, others -don't.} - -@node Spam ELisp Package Global Variables -@subsubsection Spam ELisp Package Global Variables +You should set the @code{spam-use-*} variables for whatever spam back +ends you intend to use. The reason is that when loading +@file{spam.el}, some conditional loading is done depending on what +@code{spam-use-xyz} variables you have set. @xref{Spam Back Ends}. + +@c @emph{TODO: spam.el needs to provide a uniform way of training all the +@c statistical databases. Some have that functionality built-in, others +@c don't.} + +@node Detecting Spam in Groups +@subsection Detecting Spam in Groups + +To detect spam when visiting a group, set the group's +@code{spam-autodetect} and @code{spam-autodetect-methods} group +parameters. These are accessible with @kbd{G c} or @kbd{G p}, as +usual (@pxref{Group Parameters}). + +You should set the @code{spam-use-*} variables for whatever spam back +ends you intend to use. The reason is that when loading +@file{spam.el}, some conditional loading is done depending on what +@code{spam-use-xyz} variables you have set. + +By default, only unseen articles are processed for spam. You can +force Gnus to recheck all messages in the group by setting the +variable @code{spam-autodetect-recheck-messages} to @code{t}. + +If you use the @code{spam-autodetect} method of checking for spam, you +can specify different spam detection methods for different groups. +For instance, the @samp{ding} group may have @code{spam-use-BBDB} as +the autodetection method, while the @samp{suspect} group may have the +@code{spam-use-blacklist} and @code{spam-use-bogofilter} methods +enabled. Unlike with @code{spam-split}, you don't have any control +over the @emph{sequence} of checks, but this is probably unimportant. + +@node Spam and Ham Processors +@subsection Spam and Ham Processors @cindex spam filtering @cindex spam filtering variables @cindex spam variables @cindex spam @vindex gnus-spam-process-newsgroups -The concepts of ham processors and spam processors are very important. -Ham processors and spam processors for a group can be set with the -@code{spam-process} group parameter, or the -@code{gnus-spam-process-newsgroups} variable. Ham processors take -mail known to be non-spam (@emph{ham}) and process it in some way so -that later similar mail will also be considered non-spam. Spam -processors take mail known to be spam and process it so similar spam -will be detected later. - -The format of the spam or ham processor entry used to be a symbol, -but now it is a @sc{cons} cell. See the individual spam processor entries -for more information. +Spam and ham processors specify special actions to take when you exit +a group buffer. Spam processors act on spam messages, and ham +processors on ham messages. At present, the main role of these +processors is to update the dictionaries of dictionary-based spam back +ends such as Bogofilter (@pxref{Bogofilter}) and the Spam Statistics +package (@pxref{Spam Statistics Filtering}). + +The spam and ham processors that apply to each group are determined by +the group's@code{spam-process} group parameter. If this group +parameter is not defined, they are determined by the variable +@code{gnus-spam-process-newsgroups}. @vindex gnus-spam-newsgroup-contents Gnus learns from the spam you get. You have to collect your spam in @@ -23258,8 +23242,8 @@ only unseen articles or all unread articles should be checked for spam. It is recommended that you leave it off. -@node Spam ELisp Package Configuration Examples -@subsubsection Spam ELisp Package Configuration Examples +@node Spam Package Configuration Examples +@subsection Spam Package Configuration Examples @cindex spam filtering @cindex spam filtering configuration examples @cindex spam configuration examples @@ -23384,11 +23368,11 @@ Because of the @code{gnus-group-spam-classification-spam} entry, all messages are marked as spam (with @code{$}). When I find a false -positive, I mark the message with some other ham mark (@code{ham-marks}, -@ref{Spam ELisp Package Global Variables}). On group exit, those -messages are copied to both groups, @samp{INBOX} (where I want to have -the article) and @samp{training.ham} (for training bogofilter) and -deleted from the @samp{spam.detected} folder. +positive, I mark the message with some other ham mark +(@code{ham-marks}, @ref{Spam and Ham Processors}). On group exit, +those messages are copied to both groups, @samp{INBOX} (where I want +to have the article) and @samp{training.ham} (for training bogofilter) +and deleted from the @samp{spam.detected} folder. The @code{gnus-article-sort-by-chars} entry simplifies detection of false positives for me. I receive lots of worms (sweN, @dots{}), that all @@ -23424,6 +23408,29 @@ not the same as on news.gmane.org, thus @code{spam-report.el} has to check the @code{X-Report-Spam} header to find the correct number. +@node Spam Back Ends +@subsection Spam Back Ends +@cindex spam back ends + +The spam package offers a variety of back ends for detecting spam. +Each back end defines a set of methods for detecting spam +(@pxref{Filtering Incoming Mail}, @pxref{Detecting Spam in Groups}), +and a pair of spam and ham processors (@pxref{Spam and Ham +Processors}). + +@menu +* Blacklists and Whitelists:: +* BBDB Whitelists:: +* Gmane Spam Reporting:: +* Anti-spam Hashcash Payments:: +* Blackholes:: +* Regular Expressions Header Matching:: +* Bogofilter:: +* ifile spam filtering:: +* Spam Statistics Filtering:: +* SpamOracle:: +@end menu + @node Blacklists and Whitelists @subsubsection Blacklists and Whitelists @cindex spam filtering @@ -23728,6 +23735,15 @@ @end defvar +@table @kbd +@item M s t +@itemx S t +@kindex M s t +@kindex S t +@findex spam-bogofilter-score +Get the Bogofilter spamicity score (@code{spam-bogofilter-score}). +@end table + @defvar spam-use-bogofilter-headers Set this variable if you want @code{spam-split} to use Eric Raymond's @@ -23829,20 +23845,21 @@ should be used. The 1.2.1 version of ifile was used to test this functionality. -@node spam-stat spam filtering -@subsubsection spam-stat spam filtering +@node Spam Statistics Filtering +@subsubsection Spam Statistics Filtering @cindex spam filtering @cindex spam-stat, spam filtering @cindex spam-stat @cindex spam -@xref{Filtering Spam Using Statistics with spam-stat}. +This back end uses the Spam Statistics Emacs Lisp package to perform +statistics-based filtering (@pxref{Spam Statistics Package}). Before +using this, you may want to perform some additional steps to +initialize your Spam Statistics dictionary. @xref{Creating a +spam-stat dictionary}. @defvar spam-use-stat -Enable this variable if you want @code{spam-split} to use -spam-stat.el, an Emacs Lisp statistical analyzer. - @end defvar @defvar gnus-group-spam-exit-processor-stat @@ -23902,18 +23919,17 @@ @xref{Mail Source Specifiers}, (@pxref{SpamAssassin}). This method has the advantage that the user can see the @emph{X-Spam} headers. -The easiest method is to make @file{spam.el} (@pxref{Filtering Spam -Using The Spam ELisp Package}) call SpamOracle. +The easiest method is to make @file{spam.el} (@pxref{Spam Package}) +call SpamOracle. @vindex spam-use-spamoracle To enable SpamOracle usage by @file{spam.el}, set the variable @code{spam-use-spamoracle} to @code{t} and configure the -@code{nnmail-split-fancy} or @code{nnimap-split-fancy} as described in -the section @xref{Filtering Spam Using The Spam ELisp Package}. In -this example the @samp{INBOX} of an nnimap server is filtered using -SpamOracle. Mails recognized as spam mails will be moved to -@code{spam-split-group}, @samp{Junk} in this case. Ham messages stay -in @samp{INBOX}: +@code{nnmail-split-fancy} or @code{nnimap-split-fancy}. @xref{Spam +Package}. In this example the @samp{INBOX} of an nnimap server is +filtered using SpamOracle. Mails recognized as spam mails will be +moved to @code{spam-split-group}, @samp{Junk} in this case. Ham +messages stay in @samp{INBOX}: @example (setq spam-use-spamoracle t @@ -23945,14 +23961,14 @@ SpamOracle employs a statistical algorithm to determine whether a message is spam or ham. In order to get good results, meaning few -false hits or misses, SpamOracle needs training. SpamOracle learns the -characteristics of your spam mails. Using the @emph{add} mode +false hits or misses, SpamOracle needs training. SpamOracle learns +the characteristics of your spam mails. Using the @emph{add} mode (training mode) one has to feed good (ham) and spam mails to -SpamOracle. This can be done by pressing @kbd{|} in the Summary buffer -and pipe the mail to a SpamOracle process or using @file{spam.el}'s -spam- and ham-processors, which is much more convenient. For a -detailed description of spam- and ham-processors, @xref{Filtering Spam -Using The Spam ELisp Package}. +SpamOracle. This can be done by pressing @kbd{|} in the Summary +buffer and pipe the mail to a SpamOracle process or using +@file{spam.el}'s spam- and ham-processors, which is much more +convenient. For a detailed description of spam- and ham-processors, +@xref{Spam Package}. @defvar gnus-group-spam-exit-processor-spamoracle Add this symbol to a group's @code{spam-process} parameter by @@ -24001,8 +24017,8 @@ processed by SpamOracle. The processor sends the messages to SpamOracle as new samples for spam. -@node Extending the Spam ELisp package -@subsubsection Extending the Spam ELisp package +@node Extending the Spam package +@subsection Extending the Spam package @cindex spam filtering @cindex spam elisp package, extending @cindex extending the spam elisp package @@ -24109,9 +24125,8 @@ @end enumerate - -@node Filtering Spam Using Statistics with spam-stat -@subsection Filtering Spam Using Statistics with spam-stat +@node Spam Statistics Package +@subsection Spam Statistics Package @cindex Paul Graham @cindex Graham, Paul @cindex naive Bayesian spam filtering @@ -24138,7 +24153,11 @@ probability of the mail being spam. If this probability is higher than a certain threshold, the mail is considered to be spam. -Gnus supports this kind of filtering. But it needs some setting up. +The Spam Statistics package adds support to Gnus for this kind of +filtering. It can be used as one of the back ends of the Spam package +(@pxref{Spam Package}), or by itself. + +Before using the Spam Statistics package, you need to set it up. First, you need two collections of your mail, one with spam, one with non-spam. Then you need to create a dictionary using these two collections, and save it. And last but not least, you need to use @@ -24224,8 +24243,10 @@ @node Splitting mail using spam-stat @subsubsection Splitting mail using spam-stat -In order to use @code{spam-stat} to split your mail, you need to add the -following to your @file{~/.gnus.el} file: +This section describes how to use the Spam statistics +@emph{independently} of the @xref{Spam Package}. + +First, add the following to your @file{~/.gnus.el} file: @lisp (require 'spam-stat) @@ -24870,16 +24891,17 @@ @itemize @bullet @item -Emacs 20.7 and up. - -@item -XEmacs 21.1 and up. +Emacs 21.1 and up. + +@item +XEmacs 21.4 and up. @end itemize This Gnus version will absolutely not work on any Emacsen older than that. Not reliably, at least. Older versions of Gnus may work on older -Emacs versions. +Emacs versions. Particularly, Gnus 5.10.8 should also work on Emacs +20.7 and XEmacs 21.1. There are some vague differences between Gnus on the various platforms---XEmacs features more graphics (a logo and a toolbar)---but
--- a/man/mh-e.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/mh-e.texi Fri Apr 21 05:39:14 2006 +0000 @@ -11,8 +11,8 @@ @set VERSION 7.93 @c Edition of the manual. It is either empty for the first edition or @c has the form ", nth Edition" (without the quotes). -@set EDITION , 6th Edition -@set UPDATED 2006-04-02 +@set EDITION , 7th Edition +@set UPDATED 2006-04-17 @set UPDATE-MONTH April, 2006 @c Other variables. @@ -3724,33 +3724,36 @@ @findex mh-execute-commands @kindex q @vindex mh-before-quit-hook +@vindex mh-before-quit-hook, example @vindex mh-quit-hook +@vindex mh-quit-hook, example The two hooks @code{mh-before-quit-hook} and @code{mh-quit-hook} are called by @kbd{q}. The former one is called before the quit occurs, so you might use it to perform any MH-E operations; you could perform some query and abort the quit or call @code{mh-execute-commands}, for example. The latter is not run in an MH-E context, so you might use it -to modify the window setup. For example, if the window configuration -was saved as in the example in @ref{Miscellaneous Commands and -Options}, you would also want to set @code{mh-quit-hook} to the -following: - -@c XXX Replace this with my example for killing the mail buffers. - -@vindex mh-quit-hook, example +to modify the window setup. If you find that @kbd{q} buries a lot of +buffers that you would rather remove, you can use both +@code{mh-before-quit-hook} and @code{mh-quit-hook} to accomplish that. @smalllisp @group +(defvar my-mh-folder-buffer-to-delete nil + "Folder buffer that is being quit.") + +(defun my-mh-before-quit-hook () + "Save folder buffer that is to be deleted." + (setq my-mh-folder-buffer-to-delete (current-buffer))) + (defun my-mh-quit-hook () - "Clear window configuration variables as the MH window is gone." - (setq my-mh-screen-saved nil) - (setq my-mh-screen nil) - (if my-normal-screen - (set-window-configuration my-normal-screen)) - (setq my-normal-screen nil)) - -@i{Clean up window setup in mh-quit-hook} + "Kill folder buffer rather than just bury it." + (set-buffer my-mh-folder-buffer-to-delete) + (if (get-buffer mh-show-buffer) + (kill-buffer mh-show-buffer)) + (kill-buffer (current-buffer))) + +@i{Kill MH-Folder buffer instead of burying it} @end group @end smalllisp
--- a/man/misc.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/misc.texi Fri Apr 21 05:39:14 2006 +0000 @@ -825,7 +825,9 @@ When you find the previous input you want, you can resubmit it by typing @key{RET}, or you can edit it first and then resubmit it if you -wish. +wish. Any partial input you were composing before navigating the +history list is restored when you go to the beginning or end of the +history ring. Often it is useful to reexecute several successive shell commands that were previously executed in sequence. To do this, first find and @@ -967,14 +969,14 @@ @vindex comint-scroll-to-bottom-on-input If the variable @code{comint-scroll-to-bottom-on-input} is non-@code{nil}, insertion and yank commands scroll the selected window -to the bottom before inserting. +to the bottom before inserting. The default is @code{nil}. @vindex comint-scroll-show-maximum-output If @code{comint-scroll-show-maximum-output} is non-@code{nil}, then arrival of output when point is at the end tries to place the last line of text at the bottom line of the window, so as to show as much useful -text as possible. (This mimics the scrolling behavior of many -terminals.) The default is @code{nil}. +text as possible. (This mimics the scrolling behavior of most +terminals.) The default is @code{t}. @vindex comint-move-point-for-output By setting @code{comint-move-point-for-output}, you can opt for
--- a/man/org.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/org.texi Fri Apr 21 05:39:14 2006 +0000 @@ -4,7 +4,7 @@ @setfilename ../info/org @settitle Org Mode Manual -@set VERSION 4.23 +@set VERSION 4.25 @set DATE April 2006 @dircategory Emacs @@ -76,13 +76,13 @@ @menu * Introduction:: Getting started -* Document Structure:: A tree works like your brain +* Document structure:: A tree works like your brain * Tables:: Pure magic for quick formatting * Hyperlinks:: Notes in context * TODO items:: Every tree branch can be a TODO item * Timestamps:: Assign date and time to items * Tags:: Tagging headlines and matching sets of tags -* Agenda Views:: Collecting information into views +* Agenda views:: Collecting information into views * Exporting:: Sharing and publishing of notes * Miscellaneous:: All the rest which did not fit elsewhere * Index:: The fast road to specific information @@ -97,7 +97,7 @@ * Installation and activation:: How to install Org-mode * Feedback:: Bug reports, ideas, patches etc. -Document Structure +Document structure * Outlines:: Org-mode is based on outline-mode * Headlines:: How to typeset org-tree headlines @@ -106,7 +106,7 @@ * Structure editing:: Changing sequence and level of headlines * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context -* Plain Lists:: Editing hand-formatted lists +* Plain lists:: Editing hand-formatted lists Tables @@ -163,11 +163,11 @@ * Setting tags:: How to assign tags to a headline * Tag searches:: Searching for combinations of tags -Agenda Views +Agenda views * Agenda files:: Files being searched for agenda information * Agenda dispatcher:: Keyboard access to agenda views -* Weekly/Daily Agenda:: The calendar page with current tasks +* Weekly/Daily agenda:: The calendar page with current tasks * Global TODO list:: All unfinished action items * Matching headline tags:: Structured information with fine-tuned search * Timeline:: Time-sorted view for single file @@ -210,7 +210,7 @@ @end detailmenu @end menu -@node Introduction, Document Structure, Top, Top +@node Introduction, Document structure, Top, Top @chapter Introduction @cindex introduction @@ -339,7 +339,7 @@ @end enumerate @noindent Thank you for helping to improve this mode. -@node Document Structure, Tables, Introduction, Top +@node Document structure, Tables, Introduction, Top @chapter Document Structure @cindex document structure @cindex structure of document @@ -355,10 +355,10 @@ * Structure editing:: Changing sequence and level of headlines * Archiving:: Move done task trees to a different place * Sparse trees:: Matches embedded in context -* Plain Lists:: Editing hand-formatted lists +* Plain lists:: Editing hand-formatted lists @end menu -@node Outlines, Headlines, Document Structure, Document Structure +@node Outlines, Headlines, Document structure, Document structure @section Outlines @cindex outlines @cindex outline-mode @@ -373,7 +373,7 @@ single command @command{org-cycle}, which is bound to the @key{TAB} key. -@node Headlines, Visibility cycling, Outlines, Document Structure +@node Headlines, Visibility cycling, Outlines, Document structure @section Headlines @cindex headlines @cindex outline tree @@ -396,7 +396,7 @@ outline that has whitespace followed by a single star as headline starters. @ref{Clean view} describes a setup to realize this. -@node Visibility cycling, Motion, Headlines, Document Structure +@node Visibility cycling, Motion, Headlines, Document structure @section Visibility cycling @cindex cycling, visibility @cindex visibility cycling @@ -458,7 +458,7 @@ #+STARTUP: showall @end example -@node Motion, Structure editing, Visibility cycling, Document Structure +@node Motion, Structure editing, Visibility cycling, Document structure @section Motion @cindex motion, between headlines @cindex jumping, to headlines @@ -491,7 +491,7 @@ visible. @end table -@node Structure editing, Archiving, Motion, Document Structure +@node Structure editing, Archiving, Motion, Document structure @section Structure editing @cindex structure editing @cindex headline, promotion and demotion @@ -507,9 +507,14 @@ @kindex M-@key{RET} @item M-@key{RET} Insert new heading with same level as current. If the cursor is in a -plain list item, a new item is created. To force creation of a new -headline, use a prefix arg, or first press @key{RET} to get to the -beginning of the next line. +plain list item, a new item is created (@pxref{Plain lists}). To force +creation of a new headline, use a prefix arg, or first press @key{RET} +to get to the beginning of the next line. When this command is used in +the middle of a line, the line is split and the rest of the line becomes +the new headline. If the command is used at the beginning of a +headline, the new headline is created before the current line. It at +the beginning of any other line, the content of that line is made the +new heading. @kindex M-S-@key{RET} @item M-S-@key{RET} Insert new TODO entry with same level as current heading. @@ -559,7 +564,7 @@ inside a table (@pxref{Tables}), the Meta-Cursor keys have different functionality. -@node Archiving, Sparse trees, Structure editing, Document Structure +@node Archiving, Sparse trees, Structure editing, Document structure @section Archiving @cindex archiving @cindex filing subtrees @@ -583,7 +588,7 @@ agenda, archiving to a different file is a good way to keep archived trees from contributing agenda items. -@node Sparse trees, Plain Lists, Archiving, Document Structure +@node Sparse trees, Plain lists, Archiving, Document structure @section Sparse trees @cindex sparse trees @cindex trees, sparse @@ -643,8 +648,8 @@ printed in any desired way. -@node Plain Lists, , Sparse trees, Document Structure -@section Plain Lists +@node Plain lists, , Sparse trees, Document structure +@section Plain lists @cindex plain lists @cindex lists, plain @cindex lists, ordered @@ -699,7 +704,14 @@ completely separated. @kindex M-@key{RET} @item M-@key{RET} -Insert new item at current level. With prefix arg, for a new heading. +Insert new item at current level. With prefix arg, force a new heading +(@pxref{Structure editing}). If this command is used in the middle of a +line, the line is @emph{split} and the rest of the line becomes the new +item. If this command is executed in the @emph{whitespace before a bullet or +number}, the new item is created @emph{before} the current item. If the +command is executed in the white space before the text that is part of +an item but does not contain the bullet, a bullet is added to the +current line. @kindex M-S-@key{up} @kindex M-S-@key{down} @item M-S-@key{up} @@ -722,7 +734,7 @@ Renumber the ordered list at the cursor. @end table -@node Tables, Hyperlinks, Document Structure, Top +@node Tables, Hyperlinks, Document structure, Top @chapter Tables @cindex tables @cindex editing tables @@ -1056,7 +1068,7 @@ @file{calc} package. Note that @file{calc} has the slightly non-standard convention that @samp{/} has lower precedence than @samp{*}, so that @samp{a/b*c} is interpreted as @samp{a/(b*c)}. Before -evaluation by @code{calc-eval} (@pxref{Calling Calc from Your Lisp +evaluation by @code{calc-eval} (@pxref{Calling Calc from Your Programs,calc-eval,Calling calc from Your Lisp Programs,calc,GNU Emacs Calc Manual}), variable substitution takes place: @@ -1414,6 +1426,9 @@ # <<My Target>> @end example +@noindent In HTML export (@pxref{HTML export}), such targets will become +named anchors for direct access through http links. + If no dedicated target exists, Org-mode will search for the words in the link, often removing the need for a dedicated target. In the above example the search would be for @samp{my target}. Links starting with a @@ -1571,9 +1586,10 @@ a file will be inserted and you may use file name completion to select the name of the file. The path to the file is inserted relative to the directory of the current org file, if the linked file is in the current -directory or in a subdirectory of it. Otherwise an absolute path, if -possible with @samp{~/} for your home directory is used. You can force -an absolute path with two @kbd{C-u} prefixes. +directory or in a subdirectory of it, or if the path is written relative +to the current directory using @samp{../}. Otherwise an absolute path +is used, if possible with @samp{~/} for your home directory. You can +force an absolute path with two @kbd{C-u} prefixes. @item C-c C-l @r{with cursor on existing link} When the cursor is on an existing link, @kbd{C-c C-l} allows to edit the @@ -1648,7 +1664,9 @@ @item My Target Search for a link target @samp{<<My Target>>}, or do a text search for @samp{my target}, similar to the search in internal links, see -@ref{Internal links}. +@ref{Internal links}. In HTML export (@pxref{HTML export}), such a file +link will become an html reference to the corresponding named anchor in +the linked file. @item *My Target In an Org-mode file, restrict search to headlines. @item /regexp/ @@ -1821,7 +1839,7 @@ @kindex C-c a t @item C-c a t Show the global TODO list. This collects the TODO items from all -agenda files (@pxref{Agenda Views}) into a single buffer. The buffer is in +agenda files (@pxref{Agenda views}) into a single buffer. The buffer is in @code{agenda-mode}, so there are commands to examine and manipulate the TODO entries directly from that buffer (@pxref{Agenda commands}). @xref{Global TODO list}, for more information. @@ -1847,7 +1865,7 @@ @samp{CLOSED: [timestamp]} will be inserted just after the headline. If you turn the entry back into a TODO item again through further state cycling, that line will be removed again. In the timeline -(@pxref{Timeline}) and in the agenda (@pxref{Weekly/Daily Agenda}), +(@pxref{Timeline}) and in the agenda (@pxref{Weekly/Daily agenda}), you can then use the @kbd{L} key to display the TODO items closed on each day, giving you an overview of what has been done on a day. @@ -1989,7 +2007,7 @@ With its standard setup, Org-mode supports priorities @samp{A}, @samp{B}, and @samp{C}. @samp{A} is the highest priority. An entry without a cookie is treated as priority @samp{B}. Priorities make a -difference only in the agenda (@pxref{Weekly/Daily Agenda}). +difference only in the agenda (@pxref{Weekly/Daily agenda}). @table @kbd @kindex @kbd{C-c ,} @@ -2034,14 +2052,16 @@ special format, either @samp{<2003-09-16 Tue>} or @samp{<2003-09-16 Tue 09:39>}. A time stamp can appear anywhere in the headline or body of an org-tree entry. Its presence allows entries to be shown on specific -dates in the agenda (@pxref{Weekly/Daily Agenda}). We distinguish: +dates in the agenda (@pxref{Weekly/Daily agenda}). We distinguish: @table @var @cindex timestamp @item TIMESTAMP -A simple time stamp just assigns a date/time to an item. In the -timeline and agenda displays, the headline of the entry will be shown -exactly on that date. +A simple time stamp just assigns a date/time to an item. This is just +like writing down an appointment in a paper agenda, or like writing down +an event in a diary, when you want to take not of when something +happened. In the timeline and agenda displays, the headline of an entry +associated with a plain time stamp will be shown exactly on that date. @item TIMERANGE @cindex timerange @@ -2055,6 +2075,21 @@ <2004-08-23 Mon>--<2004-08-26 Thu> @end example +@item SCHEDULED +@cindex SCHEDULED keyword +If a time stamp is preceded by the word @samp{SCHEDULED:}, it means you +are planning to start working on that task on the given date. So this is +not about recording an event, but about planning your work. The +headline will be listed under the given date. In addition, a reminder +that the scheduled date has passed will be present in the compilation +for @emph{today}, until the entry is marked DONE. I.e., the task will +automatically be forwarded until completed. + +@example +*** TODO Call Trillian to ask her out for a date on New Years Eve. + SCHEDULED: <2004-12-25 Sat> +@end example + @item DEADLINE @cindex DEADLINE keyword If a time stamp is preceded by the word @samp{DEADLINE:}, the task @@ -2069,15 +2104,6 @@ The editor in charge is <bbdb:Ford Prefect> DEADLINE: <2004-02-29 Sun> @end example - -@item SCHEDULED -@cindex SCHEDULED keyword -If a time stamp is preceded by the word @samp{SCHEDULED:}, it means -you are planning to start working on that task on the given date. The -headline will be listed under the given date. In addition, a reminder -that the scheduled date has passed will be present in the compilation -for @emph{today}, until the entry is marked DONE. I.e., the -task will automatically be forwarded. @end table @node Creating timestamps, , Time stamps, Timestamps @@ -2120,7 +2146,7 @@ @kindex C-c C-o @item C-c C-o Access the agenda for the date given by the time stamp at point -(@pxref{Weekly/Daily Agenda}). +(@pxref{Weekly/Daily agenda}). @kindex C-c C-d @item C-c C-d @@ -2207,7 +2233,7 @@ Choose date in calendar (only if nothing typed into minibuffer). @end table -@node Tags, Agenda Views, Timestamps, Top +@node Tags, Agenda views, Timestamps, Top @chapter Tags @cindex tags @cindex headline tagging @@ -2311,7 +2337,7 @@ @samp{WORK|LAPTOP&NIGHT} requires that the @samp{:LAPTOP:} lines are also tagged @samp{NIGHT}. -@node Agenda Views, Exporting, Tags, Top +@node Agenda views, Exporting, Tags, Top @chapter Agenda Views @cindex agenda views @@ -2345,14 +2371,14 @@ @menu * Agenda files:: Files being searched for agenda information * Agenda dispatcher:: Keyboard access to agenda views -* Weekly/Daily Agenda:: The calendar page with current tasks +* Weekly/Daily agenda:: The calendar page with current tasks * Global TODO list:: All unfinished action items * Matching headline tags:: Structured information with fine-tuned search * Timeline:: Time-sorted view for single file * Agenda commands:: Remote editing of org trees @end menu -@node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views +@node Agenda files, Agenda dispatcher, Agenda views, Agenda views @section Agenda files The information to be shown is collected from all @emph{agenda files}, @@ -2385,7 +2411,7 @@ The Org menu contains the current list of files and can be used to visit any of them. -@node Agenda dispatcher, Weekly/Daily Agenda, Agenda files, Agenda Views +@node Agenda dispatcher, Weekly/Daily agenda, Agenda files, Agenda views @section The agenda dispatcher @cindex agenda dispatcher @cindex dispatching agenda commands @@ -2400,7 +2426,7 @@ following default commands: @table @kbd @item a -Create the calendar-like agenda (@pxref{Weekly/Daily Agenda}). +Create the calendar-like agenda (@pxref{Weekly/Daily agenda}). @item t / T Create a list of all TODO items (@pxref{Global TODO list}). @item m / M @@ -2438,7 +2464,7 @@ @samp{FIXME}. For more information, look at the documentation string of the variable @code{org-agenda-custom-commands}. -@node Weekly/Daily Agenda, Global TODO list, Agenda dispatcher, Agenda Views +@node Weekly/Daily agenda, Global TODO list, Agenda dispatcher, Agenda views @section The weekly/daily agenda @cindex agenda @@ -2468,7 +2494,7 @@ * Sorting of agenda items:: The order of things @end menu -@node Categories, Time-of-day specifications, Weekly/Daily Agenda, Weekly/Daily Agenda +@node Categories, Time-of-day specifications, Weekly/Daily agenda, Weekly/Daily agenda @subsection Categories @cindex category @@ -2485,7 +2511,7 @@ before the first CATEGORY line). The display in the agenda buffer looks best if the category is not longer than 10 characters. -@node Time-of-day specifications, Calendar/Diary integration, Categories, Weekly/Daily Agenda +@node Time-of-day specifications, Calendar/Diary integration, Categories, Weekly/Daily agenda @subsection Time-of-Day Specifications Org-mode checks each agenda item for a time-of-day specification. The @@ -2533,7 +2559,7 @@ @code{org-agenda-time-grid}. -@node Calendar/Diary integration, Sorting of agenda items, Time-of-day specifications, Weekly/Daily Agenda +@node Calendar/Diary integration, Sorting of agenda items, Time-of-day specifications, Weekly/Daily agenda @subsection Calendar/Diary integration @cindex calendar integration @cindex diary integration @@ -2564,7 +2590,7 @@ calendars, respectively. @kbd{c} can be used to switch back and forth between calendar and agenda. -@node Sorting of agenda items, , Calendar/Diary integration, Weekly/Daily Agenda +@node Sorting of agenda items, , Calendar/Diary integration, Weekly/Daily agenda @subsection Sorting of agenda items @cindex sorting, of agenda items @cindex priorities, of agenda items @@ -2583,7 +2609,7 @@ @code{org-agenda-sorting-strategy}. -@node Global TODO list, Matching headline tags, Weekly/Daily Agenda, Agenda Views +@node Global TODO list, Matching headline tags, Weekly/Daily agenda, Agenda views @section The global TODO list @cindex global TODO list @cindex TODO list, global @@ -2595,7 +2621,7 @@ @kindex C-c a t @item C-c a t Show the global TODO list. This collects the TODO items from all -agenda files (@pxref{Agenda Views}) into a single buffer. The buffer is in +agenda files (@pxref{Agenda views}) into a single buffer. The buffer is in @code{agenda-mode}, so there are commands to examine and manipulate the TODO entries directly from that buffer (@pxref{Agenda commands}). @xref{Global TODO list}, for more information. @@ -2616,7 +2642,7 @@ TODO entry with a single key press. The commands available in the TODO list are described in @ref{Agenda commands}. -@node Matching headline tags, Timeline, Global TODO list, Agenda Views +@node Matching headline tags, Timeline, Global TODO list, Agenda views @section Matching headline tags @cindex matching, of tags @cindex tags view @@ -2643,7 +2669,7 @@ The commands available in the tags list are described in @ref{Agenda commands}. -@node Timeline, Agenda commands, Matching headline tags, Agenda Views +@node Timeline, Agenda commands, Matching headline tags, Agenda views @section Timeline for a single file @cindex single file summary @cindex agenda, for single file @@ -2669,7 +2695,7 @@ The commands available in the timeline buffer are listed in @ref{Agenda commands}. -@node Agenda commands, , Timeline, Agenda Views +@node Agenda commands, , Timeline, Agenda views @section Commands in the agenda buffer @cindex commands, in agenda buffer @@ -2886,7 +2912,7 @@ @end table -@node Exporting, Miscellaneous, Agenda Views, Top +@node Exporting, Miscellaneous, Agenda views, Top @chapter Exporting @cindex exporting @@ -3003,6 +3029,9 @@ current buffer and forces Emacs to re-evaluate the local variables section in the buffer. +@c FIXME: More about header and footer styles +@c FIXME: Talk about links and targets. + @node XML export, iCalendar export, HTML export, Exporting @section XML export @cindex XML export @@ -3114,7 +3143,7 @@ @item Plain lists @samp{-}, @samp{*} or @samp{+} as bullet, or with @samp{1.} or @samp{2)} as enumerator will be recognized and transformed if the -backend supports lists. See @xref{Plain Lists}. +backend supports lists. See @xref{Plain lists}. @cindex underlined text @cindex bold text @@ -3835,6 +3864,8 @@ @item Sacha Chua suggested to copy some linking code from Planner. @item +Kees Dullemond inspired the use of narrowed tabled columns. +@item Christian Egli converted the documentation into TeXInfo format, patched CSS formatting into the HTML exporter, and inspired the agenda. @item
--- a/man/trampver.texi Mon Apr 17 08:41:12 2006 +0000 +++ b/man/trampver.texi Fri Apr 21 05:39:14 2006 +0000 @@ -4,7 +4,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.0.52 +@set trampver 2.0.53 @c Other flags from configuration @set prefix /usr/local
--- a/src/ChangeLog Mon Apr 17 08:41:12 2006 +0000 +++ b/src/ChangeLog Fri Apr 21 05:39:14 2006 +0000 @@ -1,8 +1,66 @@ +2006-04-21 Nick Roberts <nickrob@snap.net.nz> + + * xdisp.c (note_mouse_highlight): Use build_string. + +2006-04-20 Lars Hansen <larsh@soem.dk> + + * textprop.c (Fremove_list_of_text_properties): Ensure + modify_region is called only when buffer is modified and that + signal_after_change is allways called in that case. + + * print.c (PRINTFINISH): Call signal_after_change. + +2006-04-20 Kim F. Storm <storm@cua.dk> + + * xdisp.c (redisplay_window): Fix last change. + + * xdisp.c (redisplay_window): If current window start is not at the + beginning of a line, select a new window start if buffer is modified + and window start is in the modified region, but the first change is + before window start. + +2006-04-18 Richard Stallman <rms@gnu.org> + + * xmenu.c (restore_menu_items, save_menu_items): New fns. + (set_frame_menubar): Use save_menu_items. Save updated vector in + the frame before unwinding it. Don't use unuse_menu_items. Don't + use discard_menu_items. + (digest_single_submenu): Abort if an item is not in a pane. + (init_menu_items): Put the error check at the top. + + * keymap.c (describe_map): Make "shadowed" warning more verbose. + + * window.c (adjust_window_trailing_edge): Correctly distinguish + series vs parallel cases, even when window has no parent. + + * abbrev.c (record_symbol): New function. + (Finsert_abbrev_table_description): Sort the abbrevs alphabetically. + +2006-04-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * image.c (x_create_bitmap_from_data) [MAC_OS]: Don't check return + value of xmalloc. + + * mac.c (mac_coerce_file_name_ptr, mac_coerce_file_name_desc) + (create_apple_event_from_event_ref, xrm_get_preference_database) + (cfstring_create_normalized): Don't check return value of xmalloc. + + * macselect.c (get_scrap_target_type_list, defer_apple_events) + (copy_scrap_flavor_data, mac_handle_service_event): Don't check + return value of xmalloc/xrealloc. + + * macterm.c (XCreateGC, x_per_char_metric, xlfdpat_create) + (init_font_name_table, init_font_name_table, mac_do_list_fonts) + (XLoadQueryFont, mac_store_apple_event): Don't check + return value of xmalloc. + 2006-04-17 Kim F. Storm <storm@cua.dk> * window.c (coordinates_in_window): On the vertical border, calculate the row number measured from the top of the window, not the top of the frame. + (window_loop): Test w->dedicated with !NILP instead of EQ Qt. + (window_scroll_pixel_based): Fix off-by-one bug in 2002-12-23 change. 2006-04-16 Eli Zaretskii <eliz@gnu.org>
--- a/src/abbrev.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/abbrev.c Fri Apr 21 05:39:14 2006 +0000 @@ -537,6 +537,13 @@ Fterpri (stream); } +static void +record_symbol (sym, list) + Lisp_Object sym, list; +{ + XSETCDR (list, Fcons (sym, XCDR (list))); +} + DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description, Sinsert_abbrev_table_description, 1, 2, 0, doc: /* Insert before point a full description of abbrev table named NAME. @@ -552,6 +559,7 @@ Lisp_Object name, readable; { Lisp_Object table; + Lisp_Object symbols; Lisp_Object stream; CHECK_SYMBOL (name); @@ -560,12 +568,22 @@ XSETBUFFER (stream, current_buffer); + symbols = Fcons (Qnil, Qnil); + map_obarray (table, record_symbol, symbols); + symbols = XCDR (symbols); + symbols = Fsort (symbols, Qstring_lessp); + if (!NILP (readable)) { insert_string ("("); Fprin1 (name, stream); insert_string (")\n\n"); - map_obarray (table, describe_abbrev, stream); + while (! NILP (symbols)) + { + describe_abbrev (XCAR (symbols), stream); + symbols = XCDR (symbols); + } + insert_string ("\n\n"); } else @@ -573,7 +591,11 @@ insert_string ("(define-abbrev-table '"); Fprin1 (name, stream); insert_string (" '(\n"); - map_obarray (table, write_abbrev, stream); + while (! NILP (symbols)) + { + write_abbrev (XCAR (symbols), stream); + symbols = XCDR (symbols); + } insert_string (" ))\n\n"); }
--- a/src/eval.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/eval.c Fri Apr 21 05:39:14 2006 +0000 @@ -204,6 +204,7 @@ specpdl_size = 50; specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding)); specpdl_ptr = specpdl; + /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1000; max_lisp_eval_depth = 300;
--- a/src/image.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/image.c Fri Apr 21 05:39:14 2006 +0000 @@ -201,7 +201,7 @@ } else #endif - if (depth == 1) + if (depth == 1) { char *base_addr = GetPixBaseAddr (pixmap); short row_bytes = GetPixRowBytes (pixmap); @@ -444,8 +444,6 @@ id = x_allocate_bitmap_record (f); #ifdef MAC_OS dpyinfo->bitmaps[id - 1].bitmap_data = (char *) xmalloc (height * width); - if (! dpyinfo->bitmaps[id - 1].bitmap_data) - return -1; bcopy (bits, dpyinfo->bitmaps[id - 1].bitmap_data, height * width); #endif /* MAC_OS */
--- a/src/keymap.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/keymap.c Fri Apr 21 05:39:14 2006 +0000 @@ -3391,7 +3391,7 @@ if (vect[i].shadowed) { SET_PT (PT - 1); - insert_string (" (shadowed)"); + insert_string ("\n (that binding is currently shadowed by another mode)"); SET_PT (PT + 1); } }
--- a/src/mac.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/mac.c Fri Apr 21 05:39:14 2006 +0000 @@ -453,15 +453,10 @@ char *buf; buf = xmalloc (data_size + 1); - if (buf) - { - memcpy (buf, data_ptr, data_size); - buf[data_size] = '\0'; - err = posix_pathname_to_fsspec (buf, &fs); - xfree (buf); - } - else - err = memFullErr; + memcpy (buf, data_ptr, data_size); + buf[data_size] = '\0'; + err = posix_pathname_to_fsspec (buf, &fs); + xfree (buf); if (err == noErr) err = AECoercePtr (typeFSS, &fs, sizeof (FSSpec), to_type, result); #endif @@ -489,14 +484,11 @@ { size = AEGetDescDataSize (&desc); buf = xmalloc (size); - if (buf) - { - err = AEGetDescData (&desc, buf, size); - if (err == noErr) - url = CFURLCreateWithBytes (NULL, buf, size, - kCFStringEncodingUTF8, NULL); - xfree (buf); - } + err = AEGetDescData (&desc, buf, size); + if (err == noErr) + url = CFURLCreateWithBytes (NULL, buf, size, + kCFStringEncodingUTF8, NULL); + xfree (buf); AEDisposeDesc (&desc); } } @@ -581,21 +573,16 @@ data_size = GetHandleSize (from_desc->dataHandle); #endif data_ptr = xmalloc (data_size); - if (data_ptr) - { #if TARGET_API_MAC_CARBON - err = AEGetDescData (from_desc, data_ptr, data_size); + err = AEGetDescData (from_desc, data_ptr, data_size); #else - memcpy (data_ptr, *(from_desc->dataHandle), data_size); + memcpy (data_ptr, *(from_desc->dataHandle), data_size); #endif - if (err == noErr) - err = mac_coerce_file_name_ptr (from_type, data_ptr, - data_size, to_type, - handler_refcon, result); - xfree (data_ptr); - } - else - err = memFullErr; + if (err == noErr) + err = mac_coerce_file_name_ptr (from_type, data_ptr, + data_size, to_type, + handler_refcon, result); + xfree (data_ptr); } if (err != noErr) @@ -691,8 +678,6 @@ if (err != noErr) break; buf = xmalloc (size); - if (buf == NULL) - break; err = GetEventParameter (event, names[i], types[i], NULL, size, NULL, buf); if (err == noErr) @@ -1596,8 +1581,6 @@ count = CFSetGetCount (key_set); keys = xmalloc (sizeof (CFStringRef) * count); - if (keys == NULL) - goto out; CFSetGetValues (key_set, (const void **)keys); for (index = 0; index < count; index++) { @@ -4547,11 +4530,8 @@ if (in_text == NULL) { buffer = xmalloc (sizeof (UniChar) * length); - if (buffer) - { - CFStringGetCharacters (str, CFRangeMake (0, length), buffer); - in_text = buffer; - } + CFStringGetCharacters (str, CFRangeMake (0, length), buffer); + in_text = buffer; } if (in_text) @@ -4559,15 +4539,12 @@ while (err == noErr) { out_buf = xmalloc (out_size); - if (out_buf == NULL) - err = mFulErr; - else - err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar), - in_text, - kUnicodeDefaultDirectionMask, - 0, NULL, NULL, NULL, - out_size, &out_read, &out_len, - out_buf); + err = ConvertFromUnicodeToText (uni, length * sizeof (UniChar), + in_text, + kUnicodeDefaultDirectionMask, + 0, NULL, NULL, NULL, + out_size, &out_read, &out_len, + out_buf); if (err == noErr && out_read < length * sizeof (UniChar)) { xfree (out_buf);
--- a/src/macselect.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/macselect.c Fri Apr 21 05:39:14 2006 +0000 @@ -373,14 +373,11 @@ err = GetScrapFlavorCount (scrap, &count); if (err == noErr) flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); - if (flavor_info) + err = GetScrapFlavorInfoList (scrap, &count, flavor_info); + if (err != noErr) { - err = GetScrapFlavorInfoList (scrap, &count, flavor_info); - if (err != noErr) - { - xfree (flavor_info); - flavor_info = NULL; - } + xfree (flavor_info); + flavor_info = NULL; } if (flavor_info == NULL) count = 0; @@ -1021,20 +1018,13 @@ deferred_apple_events.count = 0; deferred_apple_events.buf = xmalloc (sizeof (AppleEvent) * deferred_apple_events.size); - if (deferred_apple_events.buf == NULL) - err = memFullErr; } else if (deferred_apple_events.count == deferred_apple_events.size) { - AppleEvent *newbuf; - deferred_apple_events.size *= 2; - newbuf = xrealloc (deferred_apple_events.buf, - sizeof (AppleEvent) * deferred_apple_events.size); - if (newbuf) - deferred_apple_events.buf = newbuf; - else - err = memFullErr; + deferred_apple_events.buf + = xrealloc (deferred_apple_events.buf, + sizeof (AppleEvent) * deferred_apple_events.size); } } @@ -1192,17 +1182,7 @@ buf = NULL; } else if (size_allocated < size) - { - char *newbuf = xrealloc (buf, size); - - if (newbuf) - buf = newbuf; - else - { - xfree (buf); - buf = NULL; - } - } + buf = xrealloc (buf, size); else break; } @@ -1302,14 +1282,11 @@ err = GetScrapFlavorCount (cur_scrap, &count); if (err == noErr) flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); - if (flavor_info) + err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info); + if (err != noErr) { - err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info); - if (err != noErr) - { - xfree (flavor_info); - flavor_info = NULL; - } + xfree (flavor_info); + flavor_info = NULL; } if (flavor_info == NULL) break;
--- a/src/macterm.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/macterm.c Fri Apr 21 05:39:14 2006 +0000 @@ -1510,11 +1510,8 @@ { GC gc = xmalloc (sizeof (*gc)); - if (gc) - { - bzero (gc, sizeof (*gc)); - XChangeGC (display, gc, mask, xgcv); - } + bzero (gc, sizeof (*gc)); + XChangeGC (display, gc, mask, xgcv); return gc; } @@ -2163,21 +2160,17 @@ if (*row == NULL) { *row = xmalloc (sizeof (XCharStructRow)); - if (*row) - bzero (*row, sizeof (XCharStructRow)); + bzero (*row, sizeof (XCharStructRow)); } - if (*row) + pcm = (*row)->per_char + char2b->byte2; + if (!XCHARSTRUCTROW_CHAR_VALID_P (*row, char2b->byte2)) { - pcm = (*row)->per_char + char2b->byte2; - if (!XCHARSTRUCTROW_CHAR_VALID_P (*row, char2b->byte2)) - { - BLOCK_INPUT; - mac_query_char_extents (font->mac_style, - (char2b->byte1 << 8) + char2b->byte2, - NULL, NULL, pcm, NULL); - UNBLOCK_INPUT; - XCHARSTRUCTROW_SET_CHAR_VALID (*row, char2b->byte2); - } + BLOCK_INPUT; + mac_query_char_extents (font->mac_style, + (char2b->byte1 << 8) + char2b->byte2, + NULL, NULL, pcm, NULL); + UNBLOCK_INPUT; + XCHARSTRUCTROW_SET_CHAR_VALID (*row, char2b->byte2); } } else @@ -6582,12 +6575,7 @@ struct xlfdpat_block *blk; pat = xmalloc (sizeof (struct xlfdpat)); - if (pat == NULL) - goto error; - pat->buf = xmalloc (strlen (pattern) + 1); - if (pat->buf == NULL) - goto error; /* Normalize the pattern string and store it to `pat->buf'. */ nblocks = 0; @@ -6651,8 +6639,6 @@ } pat->blocks = xmalloc (sizeof (struct xlfdpat_block) * nblocks); - if (pat->blocks == NULL) - goto error; /* Divide the normalized pattern into blocks. */ p = pat->buf; @@ -7112,9 +7098,10 @@ Qnil, Qnil, Qnil);; err = ATSUFontCount (&nfonts); if (err == noErr) - font_ids = xmalloc (sizeof (ATSUFontID) * nfonts); - if (font_ids) - err = ATSUGetFontIDs (font_ids, nfonts, NULL); + { + font_ids = xmalloc (sizeof (ATSUFontID) * nfonts); + err = ATSUGetFontIDs (font_ids, nfonts, NULL); + } if (err == noErr) for (i = 0; i < nfonts; i++) { @@ -7124,8 +7111,6 @@ if (err != noErr) continue; name = xmalloc (name_len + 1); - if (name == NULL) - continue; name[name_len] = '\0'; err = ATSUFindFontName (font_ids[i], kFontFamilyName, kFontMacintoshPlatform, kFontNoScript, @@ -7455,8 +7440,6 @@ int former_len = ptr - font_name_table[i]; scaled = xmalloc (strlen (font_name_table[i]) + 20 + 1); - if (scaled == NULL) - continue; memcpy (scaled, font_name_table[i], former_len); sprintf (scaled + former_len, "-%d-%d-72-72-m-%d-%s", @@ -7789,18 +7772,8 @@ font->max_char_or_byte2 = 0xff; font->bounds.rows = xmalloc (sizeof (XCharStructRow *) * 0x100); - if (font->bounds.rows == NULL) - { - mac_unload_font (&one_mac_display_info, font); - return NULL; - } bzero (font->bounds.rows, sizeof (XCharStructRow *) * 0x100); font->bounds.rows[0] = xmalloc (sizeof (XCharStructRow)); - if (font->bounds.rows[0] == NULL) - { - mac_unload_font (&one_mac_display_info, font); - return NULL; - } bzero (font->bounds.rows[0], sizeof (XCharStructRow)); #if USE_CG_TEXT_DRAWING @@ -7822,9 +7795,10 @@ } if (font->cg_font) - font->cg_glyphs = xmalloc (sizeof (CGGlyph) * 0x100); - if (font->cg_glyphs) - bzero (font->cg_glyphs, sizeof (CGGlyph) * 0x100); + { + font->cg_glyphs = xmalloc (sizeof (CGGlyph) * 0x100); + bzero (font->cg_glyphs, sizeof (CGGlyph) * 0x100); + } #endif space_bounds = font->bounds.rows[0]->per_char + 0x20; err = mac_query_char_extents (font->mac_style, 0x20, @@ -7970,11 +7944,6 @@ font->bounds.per_char = xmalloc (sizeof (XCharStruct) * (0xff - 0x20 + 1)); - if (font->bounds.per_char == NULL) - { - mac_unload_font (&one_mac_display_info, font); - return NULL; - } bzero (font->bounds.per_char, sizeof (XCharStruct) * (0xff - 0x20 + 1)); @@ -8979,15 +8948,12 @@ Lisp_Object class, id; const AEDesc *desc; { - OSErr err = noErr; + OSErr err; struct input_event buf; AEDesc *desc_copy; desc_copy = xmalloc (sizeof (AEDesc)); - if (desc_copy == NULL) - err = memFullErr; - else - err = AEDuplicateDesc (desc, desc_copy); + err = AEDuplicateDesc (desc, desc_copy); if (err == noErr) { EVENT_INIT (buf);
--- a/src/print.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/print.c Fri Apr 21 05:39:14 2006 +0000 @@ -276,6 +276,7 @@ else \ insert_1_both (print_buffer, print_buffer_pos, \ print_buffer_pos_byte, 0, 1, 0); \ + signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\ } \ if (free_print_buffer) \ { \
--- a/src/textprop.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/textprop.c Fri Apr 21 05:39:14 2006 +0000 @@ -1602,10 +1602,12 @@ } } - if (BUFFERP (object)) - modify_region (XBUFFER (object), XINT (start), XINT (end)); - - /* We are at the beginning of an interval, with len to scan */ + /* We are at the beginning of an interval, with len to scan. + The flag `modified' records if changes have been made. + When object is a buffer, we must call modify_region before changes are + made and signal_after_change when we are done. + We call modify_region before calling remove_properties iff modified == 0, + and we call signal_after_change before returning iff modified != 0. */ for (;;) { if (i == 0) @@ -1614,10 +1616,20 @@ if (LENGTH (i) >= len) { if (! interval_has_some_properties_list (properties, i)) - return modified ? Qt : Qnil; + if (modified) + { + if (BUFFERP (object)) + signal_after_change (XINT (start), XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; + } + else + return Qnil; if (LENGTH (i) == len) { + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end)); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1629,6 +1641,8 @@ unchanged = i; i = split_interval_left (i, len); copy_properties (unchanged, i); + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end)); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1636,8 +1650,14 @@ return Qt; } + if (interval_has_some_properties_list (properties, i)) + { + if (!modified && BUFFERP (object)) + modify_region (XBUFFER (object), XINT (start), XINT (end)); + remove_properties (Qnil, properties, i, object); + modified = 1; + } len -= LENGTH (i); - modified += remove_properties (Qnil, properties, i, object); i = next_interval (i); } }
--- a/src/window.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/window.c Fri Apr 21 05:39:14 2006 +0000 @@ -662,6 +662,8 @@ { if (!WINDOW_LEFTMOST_P (w) && abs (*x - x0) < grabbable_width) { + /* Convert X and Y to window relative coordinates. + Vertical border is at the left edge of window. */ *x = max (0, *x - x0); *y -= top_y; return ON_VERTICAL_BORDER; @@ -671,6 +673,8 @@ { if (abs (*x - x1) < grabbable_width) { + /* Convert X and Y to window relative coordinates. + Vertical border is at the right edge of window. */ *x = min (x1, *x) - x0; *y -= top_y; return ON_VERTICAL_BORDER; @@ -717,6 +721,8 @@ && !WINDOW_RIGHTMOST_P (w) && (abs (*x - right_x) < grabbable_width)) { + /* Convert X and Y to window relative coordinates. + Vertical border is at the right edge of window. */ *x = min (right_x, *x) - left_x; *y -= top_y; return ON_VERTICAL_BORDER; @@ -2027,7 +2033,7 @@ `obj & 1' means consider only full-width windows. `obj & 2' means consider also dedicated windows. */ if (((XINT (obj) & 1) && !WINDOW_FULL_WIDTH_P (w)) - || (!(XINT (obj) & 2) && EQ (w->dedicated, Qt)) + || (!(XINT (obj) & 2) && !NILP (w->dedicated)) /* Minibuffer windows are always ignored. */ || MINI_WINDOW_P (w)) break; @@ -2082,7 +2088,7 @@ case GET_LARGEST_WINDOW: { /* nil `obj' means to ignore dedicated windows. */ /* Ignore dedicated windows and minibuffers. */ - if (MINI_WINDOW_P (w) || (NILP (obj) && EQ (w->dedicated, Qt))) + if (MINI_WINDOW_P (w) || (NILP (obj) && !NILP (w->dedicated))) break; if (NILP (best_window)) @@ -4269,18 +4275,30 @@ while (1) { + Lisp_Object first_parallel = Qnil; + p = XWINDOW (window); parent = p->parent; - /* Make sure there is a following window. */ - if (NILP (parent) - && (horiz_flag ? 1 - : NILP (XWINDOW (window)->next))) + if (NILP (XWINDOW (window)->next)) { Fset_window_configuration (old_config); error ("No other window following this one"); } + /* See if this level has windows in parallel in the specified + direction. If so, set FIRST_PARALLEL to the first one. */ + if (horiz_flag) + { + if (! NILP (parent) && !NILP (XWINDOW (parent)->vchild)) + first_parallel = XWINDOW (parent)->vchild; + } + else + { + if (! NILP (parent) && !NILP (XWINDOW (parent)->hchild)) + first_parallel = XWINDOW (parent)->hchild; + } + /* Don't make this window too small. */ if (XINT (CURSIZE (window)) + delta < (horiz_flag ? window_min_width : window_min_height)) @@ -4298,12 +4316,11 @@ XINT (CURSIZE (window)) + delta); /* If this window has following siblings in the desired dimension, - make them smaller. + make them smaller, and exit the loop. + (If we reach the top of the tree and can never do this, we will fail and report an error, above.) */ - if (horiz_flag - ? !NILP (XWINDOW (parent)->hchild) - : !NILP (XWINDOW (parent)->vchild)) + if (NILP (first_parallel)) { if (!NILP (XWINDOW (window)->next)) { @@ -4325,9 +4342,7 @@ else /* Here we have a chain of parallel siblings, in the other dimension. Change the size of the other siblings. */ - for (child = (horiz_flag - ? XWINDOW (parent)->vchild - : XWINDOW (parent)->hchild); + for (child = first_parallel; ! NILP (child); child = XWINDOW (child)->next) if (! EQ (child, window)) @@ -4868,7 +4883,7 @@ { if (it.current_y < it.last_visible_y && (it.current_y + it.max_ascent + it.max_descent - >= it.last_visible_y)) + > it.last_visible_y)) { /* The last line was only partially visible, make it fully visible. */
--- a/src/xdisp.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/xdisp.c Fri Apr 21 05:39:14 2006 +0000 @@ -12784,8 +12784,6 @@ /* IT may overshoot PT if text at PT is invisible. */ else if (IT_CHARPOS (it) > PT && CHARPOS (startp) <= PT) w->force_start = Qt; - - } /* Handle case where place to start displaying has been specified, @@ -12955,6 +12953,35 @@ || (XFASTINT (w->last_modified) >= MODIFF && XFASTINT (w->last_overlay_modified) >= OVERLAY_MODIFF))) { + + /* If first window line is a continuation line, and window start + is inside the modified region, but the first change is before + current window start, we must select a new window start.*/ + if (NILP (w->start_at_line_beg)) + { + /* Make sure beg_unchanged and end_unchanged are up to date. + Do it only if buffer has really changed. This may or may + not have been done by try_window_id (see which) already. */ + if (MODIFF > SAVE_MODIFF + /* This seems to happen sometimes after saving a buffer. */ + || BEG_UNCHANGED + END_UNCHANGED > Z_BYTE) + { + if (GPT - BEG < BEG_UNCHANGED) + BEG_UNCHANGED = GPT - BEG; + if (Z - GPT < END_UNCHANGED) + END_UNCHANGED = Z - GPT; + } + + if (CHARPOS (startp) > BEG + BEG_UNCHANGED + && CHARPOS (startp) <= Z - END_UNCHANGED) + { + /* There doesn't seems to be a simple way to find a new + window start that is near the old window start, so + we just recenter. */ + goto recenter; + } + } + #if GLYPH_DEBUG debug_method_add (w, "same window start"); #endif @@ -22535,7 +22562,7 @@ if (part == ON_VERTICAL_BORDER) { cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor; - help_echo_string = make_string ("drag-mouse-1: resize", 20); + help_echo_string = build_string ("drag-mouse-1: resize"); } else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE || part == ON_SCROLL_BAR)
--- a/src/xmenu.c Mon Apr 17 08:41:12 2006 +0000 +++ b/src/xmenu.c Fri Apr 21 05:39:14 2006 +0000 @@ -266,14 +266,15 @@ static void init_menu_items () { + if (!NILP (menu_items_inuse)) + error ("Trying to use a menu from within a menu-entry"); + if (NILP (menu_items)) { menu_items_allocated = 60; menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); } - if (!NILP (menu_items_inuse)) - error ("Trying to use a menu from within a menu-entry"); menu_items_inuse = Qt; menu_items_used = 0; menu_items_n_panes = 0; @@ -310,6 +311,39 @@ xassert (NILP (menu_items_inuse)); } +/* This undoes save_menu_items, and it is called by the specpdl unwind + mechanism. */ + +static Lisp_Object +restore_menu_items (saved) + Lisp_Object saved; +{ + menu_items = XCAR (saved); + menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil); + menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0); + saved = XCDR (saved); + menu_items_used = XINT (XCAR (saved)); + saved = XCDR (saved); + menu_items_n_panes = XINT (XCAR (saved)); + saved = XCDR (saved); + menu_items_submenu_depth = XINT (XCAR (saved)); +} + +/* Push the whole state of menu_items processing onto the specpdl. + It will be restored when the specpdl is unwound. */ + +static void +save_menu_items () +{ + Lisp_Object saved = list4 (!NILP (menu_items_inuse) ? menu_items : Qnil, + make_number (menu_items_used), + make_number (menu_items_n_panes), + make_number (menu_items_submenu_depth)); + record_unwind_protect (restore_menu_items, saved); + menu_items_inuse = Qnil; + menu_items = Qnil; +} + /* Make the menu_items vector twice as large. */ static void @@ -320,6 +354,7 @@ old = menu_items; menu_items_allocated *= 2; + menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, old_size * sizeof (Lisp_Object)); @@ -1728,6 +1763,7 @@ int i; int submenu_depth = 0; widget_value **submenu_stack; + int panes_seen = 0; submenu_stack = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); @@ -1774,6 +1810,8 @@ Lisp_Object pane_name, prefix; char *pane_string; + panes_seen++; + pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; @@ -1821,6 +1859,10 @@ Lisp_Object item_name, enable, descrip, def, type, selected; Lisp_Object help; + /* All items should be contained in panes. */ + if (panes_seen == 0) + abort (); + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); @@ -2046,7 +2088,6 @@ specbind (Qdebug_on_next_call, Qnil); record_unwind_save_match_data (); - record_unwind_protect (unuse_menu_items, Qnil); if (NILP (Voverriding_local_map_menu_flag)) { specbind (Qoverriding_terminal_local_map, Qnil); @@ -2074,6 +2115,8 @@ /* Fill in menu_items with the current menu bar contents. This can evaluate Lisp code. */ + save_menu_items (); + menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); @@ -2133,23 +2176,33 @@ } set_buffer_internal_1 (prev); - unbind_to (specpdl_count, Qnil); /* If there has been no change in the Lisp-level contents of the menu bar, skip redisplaying it. Just exit. */ + /* Compare the new menu items with the ones computed last time. */ for (i = 0; i < previous_menu_items_used; i++) if (menu_items_used == i || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i]))) break; if (i == menu_items_used && i == previous_menu_items_used && i != 0) { + /* The menu items have not changed. Don't bother updating + the menus in any form, since it would be a no-op. */ free_menubar_widget_value_tree (first_wv); discard_menu_items (); - + unbind_to (specpdl_count, Qnil); return; } + /* The menu items are different, so store them in the frame. */ + f->menu_bar_vector = menu_items; + f->menu_bar_items_used = menu_items_used; + + /* This calls restore_menu_items to restore menu_items, etc., + as they were outside. */ + unbind_to (specpdl_count, Qnil); + /* Now GC cannot happen during the lifetime of the widget_value, so it's safe to store data from a Lisp_String. */ wv = first_wv->contents; @@ -2164,9 +2217,6 @@ wv = wv->next; } - f->menu_bar_vector = menu_items; - f->menu_bar_items_used = menu_items_used; - discard_menu_items (); } else {
--- a/update-subdirs Mon Apr 17 08:41:12 2006 +0000 +++ b/update-subdirs Fri Apr 21 05:39:14 2006 +0000 @@ -1,7 +1,7 @@ #!/bin/sh # Write into $1/subdirs.el a list of subdirs of directory $1. -# Copyright (C) 1994,95,97,1999,2001,2004 Free Software Foundation, Inc. +# Copyright (C) 1994,95,97,1999,2001,2004,2006 Free Software Foundation, Inc. # # This file is part of GNU Emacs. #