Mercurial > emacs
changeset 83455:8438f5473d99
Merged from miles@gnu.org--gnu-2005 (patch 174-181, 685-690)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-685
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-686
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-687
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-688
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-689
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-690
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-174
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-175
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-176
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-177
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-178
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-179
Update from CVS: texi/gnus.texi (RSS): Addition.
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-180
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-181
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-495
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Thu, 12 Jan 2006 11:20:02 +0000 |
| parents | 845a93c68e9a (current diff) 6f5da26b0df1 (diff) |
| children | de425e4eb0bc |
| files | lisp/ChangeLog lisp/files.el lisp/ldefs-boot.el lisp/mh-e/ChangeLog lisp/mh-e/mh-index.el lisp/net/rcirc.el lisp/progmodes/tcl.el lisp/startup.el lisp/url/url-privacy.el lisp/url/url-vars.el lisp/url/url.el man/ChangeLog src/.gdbinit src/fileio.c |
| diffstat | 62 files changed, 1853 insertions(+), 1289 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Wed Jan 11 14:51:51 2006 +0000 +++ b/etc/NEWS Thu Jan 12 11:20:02 2006 +0000 @@ -184,7 +184,7 @@ `inhibit-splash-screen'). +++ -** The default is now to use an bitmap as the icon, so the command-line options +** The default is now to use a bitmap as the icon, so the command-line options --icon-type, -i has been replaced with options --no-bitmap-icon, -nbi to turn the bitmap icon off. @@ -572,7 +572,7 @@ +++ *** In processing a local variables list, Emacs strips the prefix and -suffix are from every line before processing all the lines. +suffix from every line before processing all the lines. +++ *** find-file-read-only visits multiple files in read-only mode, @@ -731,7 +731,7 @@ `auto-hscroll-mode'. The old name is still available as an alias. --- -*** Moving or scrolling through images (and other lines) taller that +*** Moving or scrolling through images (and other lines) taller than the window now works sensibly, by automatically adjusting the window's vscroll property. @@ -1197,7 +1197,7 @@ +++ *** New command `Buffer-menu-toggle-files-only' toggles display of file -buffers only in the Buffer Menu. It is bound to `T' in Buffer Menu +buffers only in the Buffer Menu. It is bound to T in Buffer Menu mode. +++ @@ -1290,7 +1290,7 @@ +++ *** The new command `comint-insert-previous-argument' in comint-derived -modes (shell-mode etc) inserts arguments from previous command lines, +modes (shell-mode, etc.) inserts arguments from previous command lines, like bash's `ESC .' binding. It is bound by default to `C-c .', but otherwise behaves quite similarly to the bash version. @@ -2388,6 +2388,7 @@ --- ** Reftex mode changes + +++ *** Changes to RefTeX's table of contents @@ -2505,7 +2506,8 @@ point (bound to C-c C-l and mouse-2, RET on clickable fields). *** The new command `bibtex-entry-update' (bound to C-c C-u) updates -an existing BibTeX entry. +an existing BibTeX entry by inserting fields that may occur but are not +present. *** New `bibtex-entry-format' option `required-fields', enabled by default. @@ -2586,45 +2588,45 @@ --- ** GUD mode improvements for jdb: -*** Search for source files using jdb classpath and class - information. Fast startup since there is no need to scan all - source files up front. There is also no need to create and maintain - lists of source directories to scan. Look at `gud-jdb-use-classpath' - and `gud-jdb-classpath' customization variables documentation. +*** Search for source files using jdb classpath and class information. +Fast startup since there is no need to scan all source files up front. +There is also no need to create and maintain lists of source +directories to scan. Look at `gud-jdb-use-classpath' and +`gud-jdb-classpath' customization variables documentation. *** Supports the standard breakpoint (gud-break, gud-clear) - set/clear operations from java source files under the classpath, stack - traversal (gud-up, gud-down), and run until current stack finish - (gud-finish). +set/clear operations from Java source files under the classpath, stack +traversal (gud-up, gud-down), and run until current stack finish +(gud-finish). *** Supports new jdb (Java 1.2 and later) in addition to oldjdb - (Java 1.1 jdb). +(Java 1.1 jdb). *** The previous method of searching for source files has been - preserved in case someone still wants/needs to use it. - Set `gud-jdb-use-classpath' to nil. - - Added Customization Variables - -*** `gud-jdb-command-name'. What command line to use to invoke jdb. - -*** `gud-jdb-use-classpath'. Allows selection of java source file searching - method: set to t for new method, nil to scan `gud-jdb-directories' for - java sources (previous method). - -*** `gud-jdb-directories'. List of directories to scan and search for java - classes using the original gud-jdb method (if `gud-jdb-use-classpath' - is nil). - - Minor Improvements - -*** The STARTTLS wrapper (starttls.el) can now use GNUTLS +preserved in case someone still wants/needs to use it. +Set `gud-jdb-use-classpath' to nil. + +*** Added Customization Variables + +**** `gud-jdb-command-name'. What command line to use to invoke jdb. + +**** `gud-jdb-use-classpath'. Allows selection of java source file searching +method: set to t for new method, nil to scan `gud-jdb-directories' for +java sources (previous method). + +**** `gud-jdb-directories'. List of directories to scan and search for Java +classes using the original gud-jdb method (if `gud-jdb-use-classpath' +is nil). + +*** Minor Improvements + +**** The STARTTLS wrapper (starttls.el) can now use GNUTLS instead of the OpenSSL based `starttls' tool. For backwards compatibility, it prefers `starttls', but you can toggle `starttls-use-gnutls' to switch to GNUTLS (or simply remove the `starttls' tool). -*** Do not allow debugger output history variable to grow without bounds. +**** Do not allow debugger output history variable to grow without bounds. ** Auto-Revert changes: @@ -2665,7 +2667,7 @@ --- ** recentf changes. -The recent file list is now automatically cleanup when recentf mode is +The recent file list is now automatically cleaned up when recentf mode is enabled. The new option `recentf-auto-cleanup' controls when to do automatic cleanup. @@ -2791,7 +2793,7 @@ The escaped character sequence \a, \b, \d, \e, \f, \n, \r, \t, \v, respectively, stand for the ASCII characters BEL, BS, DEL, ESC, FF, NL, -CR, TAB, VT, +CR, TAB, VT. **** Regular expressions can be bound to a given language. @@ -3540,7 +3542,7 @@ It returns nil if the given Lisp form can't possibly do anything dangerous; otherwise it returns a reason why the form might be unsafe -(calls unknown function, alters global variable, etc). +(calls unknown function, alters global variable, etc.). +++ *** New macro `eval-at-startup' specifies expressions to @@ -3696,7 +3698,7 @@ It defaults to 1. +++ -*** New function `mouse-on-link-p' test if a position is in a clickable link. +*** New function `mouse-on-link-p' tests if a position is in a clickable link. This is the function used by the new `mouse-1-click-follows-link' functionality. @@ -3854,7 +3856,7 @@ *** The function `frame-or-buffer-changed-p' now lets you maintain various status records in parallel. -It take a variable (a symbol) as argument. If the variable is non-nil, +It takes a variable (a symbol) as argument. If the variable is non-nil, then its value should be a vector installed previously by `frame-or-buffer-changed-p'. If the frame names, buffer names, buffer order, or their read-only or modified flags have changed, since the @@ -3945,7 +3947,7 @@ +++ *** Functions `match-data' and `set-match-data' now have an optional argument `reseat'. When non-nil, all markers in the match data list -passed to these function will be reseated to point to nowhere. +passed to these functions will be reseated to point to nowhere. +++ *** The default value of `sentence-end' is now defined using the new @@ -4081,7 +4083,7 @@ +++ *** The new hook `before-save-hook' is invoked by `basic-save-buffer' before saving buffers. This allows packages to perform various final -tasks, for example; it can be used by the copyright package to make +tasks. For example, it can be used by the copyright package to make sure saved files have the current year in any copyright headers. +++ @@ -4100,7 +4102,7 @@ One advantage of using this function is that the list of suffixes in `exec-suffixes' is OS-dependant, so this function will find -executables without polluting Lisp code with OS dependancies. +executables without polluting Lisp code with OS dependencies. --- *** The precedence of file name handlers has been changed. @@ -4182,7 +4184,7 @@ `read-file-name' function. +++ -*** The new function `read-directory-name' for reading a directory name. +*** The new function `read-directory-name' is for reading a directory name. It is like `read-file-name' except that the defaulting works better for directories, and completion inside it shows only directories. @@ -4385,7 +4387,7 @@ very poor performance. This behavior can be remedied to some extent by setting the new variable `process-adaptive-read-buffering' to a non-nil value (the default), as it will automatically delay reading -from such processes, to allowing them to produce more output before +from such processes, allowing them to produce more output before emacs tries to read it. *** The new function `call-process-shell-command'. @@ -4559,7 +4561,7 @@ fringe bitmaps, as well as change the built-in fringe bitmaps. To change a built-in bitmap, do (require 'fringe) and use the symbol -identifing the bitmap such as `left-truncation or `continued-line'. +identifing the bitmap such as `left-truncation' or `continued-line'. *** New function `destroy-fringe-bitmap' deletes a fringe bitmap or restores a built-in one to its default value. @@ -4595,7 +4597,7 @@ The actual default fringe widths for the frame may deviate from the specified widths, since the combined fringe widths must match an integral number of columns. The extra width is distributed evenly -between the left and right fringe. For force a specific fringe width, +between the left and right fringe. To force a specific fringe width, specify the width as a negative integer (if both widths are negative, only the left fringe gets the specified width). @@ -4719,7 +4721,7 @@ *** Enhancements to stretch display properties The display property stretch specification form `(space PROPS)', where -PROPS is a property list now allows pixel based width and height +PROPS is a property list, now allows pixel based width and height specifications, as well as enhanced horizontal text alignment. The value of these properties can now be a (primitive) expression @@ -5044,7 +5046,7 @@ *** `set-auto-mode' now gives the interpreter magic line (if present) precedence over the file name. Likewise an `<?xml' or `<!DOCTYPE' declaration will give the buffer XML or SGML mode, based on the new -var `magic-mode-alist'. +variable `magic-mode-alist'. +++ *** Use the new function `run-mode-hooks' to run the major mode's mode hook. @@ -5351,7 +5353,7 @@ In each case the old name remains as an alias for the moment. +++ -*** local-write-file-hooks is marked obsolete +*** Variable `local-write-file-hooks' is marked obsolete. Use the LOCAL arg of `add-hook'. @@ -11627,7 +11629,7 @@ *** The net-utils package makes some common networking features available in Emacs. Some of these functions are wrappers around -system utilities (ping, nslookup, etc); others are implementations of +system utilities (ping, nslookup, etc.); others are implementations of simple protocols (finger, whois) in Emacs Lisp. There are also functions to make simple connections to TCP/IP ports for debugging and the like. @@ -11646,7 +11648,7 @@ samba-generic-mode: Samba configuration files fvwm-generic-mode: For fvwm initialization files x-resource-generic-mode: For X resource files - hosts-generic-mode: For hosts files (.rhosts, /etc/hosts, etc) + hosts-generic-mode: For hosts files (.rhosts, /etc/hosts, etc.) mailagent-rules-generic-mode: For mailagent .rules files javascript-generic-mode: For JavaScript files vrml-generic-mode: For VRML files
--- a/lisp/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,136 @@ +2006-01-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/tcl.el (tcl-indent-command): Use indent-for-tab-command. + (tcl-indent-line): Return `noindent' if inside a string. + + * progmodes/flymake.el (flymake-split-string): Remove more than one + empty string at beg/end of the result. + (flymake-find-buildfile, flymake-find-possible-master-files): + Use expand-file-name. + (flymake-fix-file-name): Don't replace \ with / and don't remove ./ + since expand-file-name does it for us. Use directory-file-name. + (flymake-ler-get-full-file, flymake-ler-get-file, flymake-ler-get-line) + (flymake-ler-get-type, flymake-ler-get-text) + (flymake-ler-make-ler): Remove. Replace by defstruct. Update callers. + (flymake-current-line-no): Remove spurious interactive spec. + (flymake-delete-temp-directory): Remove unused var `slash-pos'. + (flymake-check-include): Remove arg inc-path merged into inc-name. + (flymake-check-patch-master-file-buffer): Fit in 80 columns. + Arg regexp-list replaced by a simple regexp. + (flymake-master-make-header-init, flymake-master-tex-init): + Correspondingly replace regexp-list with a regexp. Fix regexp. + +2006-01-10 Simon Josefsson <jas@extundo.com> + + * mail/smtpmail.el (smtpmail-try-auth-methods): Add comment + describing AUTH PLAIN fix. + +2006-01-10 Thien-Thi Nguyen <ttn@gnu.org> + + * mail/emacsbug.el (report-emacs-bug-text-prompt): Delete var. + (report-emacs-bug): Don't record initial prompt text. + Instead, add text properties to prompting text. + (report-emacs-bug-hook): Delete prompting text. + +2006-01-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/flymake.el (flymake-find-buildfile): Remove invariant arg + `dirs'. Adjust callers. + +2006-01-09 John Paul Wallington <jpw@gnu.org> + + * cus-edit.el (custom-comment) <defface>: Add TTY definitions. + +2006-01-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * reveal.el (reveal-open-new-overlays): New extracted fun. + (reveal-close-old-overlays): Idem. Check overlays's liveness before + using them. Simplify the code. + (reveal-post-command): Use them. Fix up obsolete windows in + reveal-open-spots. + + * progmodes/flymake.el: Use `require' rather than autoload for + XEmacs's overlays. + (flymake-get-common-file-prefix, flymake-build-relative-filename): + Delete. Use file-relative-name instead. + (flymake-get-syntax-check-program-args, flymake-perl-init): + Simplify the resulting code. + + * log-view.el (log-view-file-re, log-view-message-re): Add support + for DaRCS output. + +2006-01-09 Alex Schroeder <alex@gnu.org> + + * mail/rmail.el (rmail-reply-regexp): Also ignore mailing list + identifiers sometimes added in square brackets at the beginning of + subject lines. + +2006-01-07 Richard M. Stallman <rms@gnu.org> + + * cus-edit.el (Custom-set, Custom-save): Doc fix. + (Custom-reset-current, Custom-reset-saved): Change question text. + (Custom-reset-standard): Likewise. + (custom-variable-reset-saved): Doc fix. + +2006-01-07 Eli Zaretskii <eliz@gnu.org> + + * startup.el (init-file-user): Doc fix. + +2006-01-07 Alex Schroeder <alex@gnu.org> + + * mail/rmail.el (rmail-current-subject): New function. + (rmail-current-subject-regexp): New function. + (rmail-next-same-subject): Use it. + + * mail/rmailsum.el (rmail-summary-by-topic): + Use rmail-current-subject and rmail-current-subject-regexp. + (rmail-summary-next-same-subject): Ditto. + + * net/rcirc.el (rcirc-send-input): No longer check whether the + process is open, since not all commands need an open process. + (rcirc-send-string): Check whether the process is open before + sending anything. + (rcirc-ignore-list): New option. + (rcirc-ignore-list-automatic): New variable. + (rcirc-print): Take rcirc-ignore-list into account. + (rcirc-cmd-ignore): New command. + (rcirc-ignore-update-automatic): New function. + (rcirc-handler-PART, rcirc-handler-QUIT): Use it to maintain the + list if ignored nicks. + (rcirc-handler-NICK): Ditto, and also ignore the new nick. + +2006-01-06 David Reitter <david.reitter@gmail.com> + + * mail/emacsbug.el (report-emacs-bug): Let explanations correctly + reflect the address to which the report will be sent. + +2006-01-06 Eli Zaretskii <eliz@gnu.org> + + * progmodes/ld-script.el (auto-mode-alist): Recognize linker + scripts whose file-name extensions are "\.x[bdsru]?[cn]?$". + +2006-01-01 Michael Ernst <mernst@alum.mit.edu> (tiny changes) + + * textmodes/tildify.el: Fix typos (misspellings) in the commentary. + + * emacs-lisp/find-func.el (find-definition-noselect): Fix typo in + the doc string: "functoin" => "function". + ldefs-boot.el: Likewise. + + * textmodes/bibtex.el (bibtex-validate-globally): Fix typo in a + message text: "Duplicat" => "Duplicate". + +2006-01-06 Sven Joachim <svenjoac@gmx.de> (tiny change) + + * files.el (basic-save-buffer-2): If backing-up failed, reset + buffer-backed-up to nil. + +2006-01-06 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gdb-script-skip-to-head) + (gdb-script-calculate-indentation): Indent for breakpoint command + lists also. + 2006-01-05 Bill Wohler <wohler@newt.com> * Makefile.in (compile-always): Add mh-autoloads dependency.
--- a/lisp/cus-edit.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/cus-edit.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,7 +1,7 @@ ;;; cus-edit.el --- tools for customizing Emacs and Lisp packages ;; ;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: FSF @@ -744,7 +744,7 @@ "Customization widgets in the current buffer.") (defun Custom-set () - "Set changes in all modified options." + "Set the current value of all edited settings in the buffer." (interactive) (if (y-or-n-p "Set all values according to this buffer? ") (let ((children custom-options)) @@ -755,7 +755,9 @@ (message "Aborted"))) (defun Custom-save () - "Set all modified group members and save them." + "Set all edited settings, then save all settings that have been set. +If a setting was edited and set before, this saves it. +If a setting was merely edited before, this sets it then saves it." (interactive) (if (yes-or-no-p "Save all settings in this buffer? ") (let ((children custom-options)) @@ -786,9 +788,9 @@ (funcall answer)))) (defun Custom-reset-current (&rest ignore) - "Reset all modified group members to their current value." + "Reset all edited settings in the buffer to show their current values." (interactive) - (if (y-or-n-p "Reset buffer to show current settings? ") + (if (y-or-n-p "Reset all settings' buffer text to show current values? ") (let ((children custom-options)) (mapc (lambda (widget) (if (memq (widget-get widget :custom-state) @@ -798,9 +800,10 @@ (message "Aborted"))) (defun Custom-reset-saved (&rest ignore) - "Reset all modified or set group members to their saved value." + "Reset all edited or set settings in the buffer to their saved value. +This also shows the saved values in the buffer." (interactive) - (if (y-or-n-p "Reset all settings to saved values? ") + (if (y-or-n-p "Reset all settings (current values and buffer text) to saved values? ") (let ((children custom-options)) (mapc (lambda (widget) (if (memq (widget-get widget :custom-state) @@ -819,7 +822,7 @@ (if (or (and (= 1 (length children)) (memq (widget-type (car children)) '(custom-variable custom-face))) - (yes-or-no-p "Erase all customizations in this buffer? ")) + (yes-or-no-p "Erase all customizations for settings in this buffer? ")) (mapc (lambda (widget) (and (if (widget-get widget :custom-standard-value) (widget-apply widget :custom-standard-value) @@ -2263,14 +2266,17 @@ ;;; The `custom-comment' Widget. ;; like the editable field -(defface custom-comment '((((class grayscale color) +(defface custom-comment '((((type tty)) + :background "yellow3" + :foreground "black") + (((class grayscale color) (background light)) - (:background "gray85")) + :background "gray85") (((class grayscale color) (background dark)) - (:background "dim gray")) + :background "dim gray") (t - (:slant italic))) + :slant italic)) "Face used for comments on variables or faces" :version "21.1" :group 'custom-faces) @@ -2783,6 +2789,7 @@ (defun custom-variable-reset-saved (widget) "Restore the saved value for the variable being edited by WIDGET. +This also updates the buffer to show that value. The value that was current before this operation becomes the backup value, so you can get it again." (let* ((symbol (widget-value widget))
--- a/lisp/emacs-lisp/find-func.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/emacs-lisp/find-func.el Thu Jan 12 11:20:02 2006 +0000 @@ -413,7 +413,7 @@ (defun find-definition-noselect (symbol type &optional file) "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL. TYPE says what type of definition: nil for a function, -`defvar' or `defface' for a variable or face. This functoin +`defvar' or `defface' for a variable or face. This function does not switch to the buffer or display it. The library where SYMBOL is defined is searched for in FILE or
--- a/lisp/files.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/files.el Thu Jan 12 11:20:02 2006 +0000 @@ -3470,7 +3470,9 @@ ;; If we get an error writing the new file, and we made ;; the backup by renaming, undo the backing-up. (and setmodes (not success) - (rename-file (cdr setmodes) buffer-file-name)))))) + (progn + (rename-file (cdr setmodes) buffer-file-name t) + (setq buffer-backed-up nil))))))) setmodes)) (defun diff-buffer-with-file (&optional buffer)
--- a/lisp/gnus/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,84 @@ +2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable. + (nnrss-request-article): Render text/plain parts as HTML. + + * gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow + the buffer. + +2006-01-08 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-cus.el (gnus-group-parameters): Sync posting-style with + custom definition of `gnus-posting-styles'. + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind + print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>. + +2006-01-05 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-group.el (gnus-useful-groups): Use Gmane for ding. Use + nntp for bug archive. + +2006-01-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-request-article): Fix the way to fill text/plain + parts. + (nnrss-normalize-date): New function converts ISO 8601 date into + RFC822 style. Suggested by Mark Plaksin <happy@mcplaksin.org>. + (nnrss-check-group): Use it. + +2006-01-03 Rodrigo Ventura <yoda@isr.ist.utl.pt> (tiny change) + + * gnus-xmas.el (gnus-xmas-group-startup-message): Typo + gnus-splash-face -> gnus-splash. Fixes starting from a TTY in + XEmacs. + +2006-01-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-work-articles): Remove useless `min'. + + * nnrss.el (nnrss-fetch): Make it fail gracefully when it can't + fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>. + (nnrss-insert-w3): Ditto. + +2005-12-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-request-article): Fix last change; fill + text/plain parts. + +2005-12-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnrss.el (nnrss-request-article): Replace <br />s with newlines + in text/plain part. + (nnrss-check-group): Don't add excessive newline to dc:subject. + +2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-delete-text-of-type): Enable it to + remove MIME buttons associated with multipart/alternative parts. + (gnus-mime-display-alternative): Tag buttons using `article-type' + text property. + + * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons + associated with multipart/alternative parts. + +2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change) + + * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the + article. + +2005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dns.el (query-dns): Make sure we check the buffer size before + removing tcp headers. + +2006-01-08 Chong Yidong <cyd@stupidchicken.com> + + * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) + (spam-group-spam-marks): Delete functions. + (spam-list-articles): Just call spam-group-ham-marks directly. + (spam-group-ham-marks): Simplify. + 2005-12-16 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-signature-separator): Fix custom type.
--- a/lisp/gnus/dns.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/dns.el Thu Jan 12 11:20:02 2006 +0000 @@ -343,7 +343,8 @@ (decf times step)) (ignore-errors (delete-process process)) - (when tcp-p + (when (and tcp-p + (>= (buffer-size) 2)) (goto-char (point-min)) (delete-region (point) (+ (point) 2))) (unless (zerop (buffer-size))
--- a/lisp/gnus/gnus-art.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-art.el Thu Jan 12 11:20:02 2006 +0000 @@ -1632,10 +1632,24 @@ "Delete text of TYPE in the current buffer." (save-excursion (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'article-type type)) - (delete-region - b (or (text-property-not-all b (point-max) 'article-type type) - (point-max))))))) + (if (eq type 'multipart) + ;; Remove MIME buttons associated with multipart/alternative parts. + (progn + (goto-char b) + (while (if (get-text-property (point) 'gnus-part) + (setq b (point)) + (when (setq b (next-single-property-change (point) + 'gnus-part)) + (goto-char b) + t)) + (end-of-line) + (skip-chars-forward "\n") + (when (eq (get-text-property b 'article-type) 'multipart) + (delete-region b (point))))) + (while (setq b (text-property-any b (point-max) 'article-type type)) + (delete-region + b (or (text-property-not-all b (point-max) 'article-type type) + (point-max)))))))) (defun gnus-article-delete-invisible-text () "Delete all invisible text in the current buffer." @@ -2500,19 +2514,17 @@ (defun gnus-article-wash-html-with-w3m () "Wash the current buffer with emacs-w3m." (mm-setup-w3m) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) - w3m-force-redisplay) - (w3m-region (point-min) (point-max))) - (when (and mm-inline-text-html-with-w3m-keymap - (boundp 'w3m-minor-mode-map) - w3m-minor-mode-map) - (add-text-properties - (point-min) (point-max) - (list 'keymap w3m-minor-mode-map - ;; Put the mark meaning this part was rendered by emacs-w3m. - 'mm-inline-text-html-with-w3m t))))) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) + w3m-force-redisplay) + (w3m-region (point-min) (point-max))) + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) + (add-text-properties + (point-min) (point-max) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t)))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. @@ -4956,7 +4968,7 @@ ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id - gnus-data ,handle)) + article-type multipart)) (widget-convert-button 'link from (point) :action 'gnus-widget-press-button :button-keymap gnus-widget-button-keymap)
--- a/lisp/gnus/gnus-cus.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-cus.el Thu Jan 12 11:20:02 2006 +0000 @@ -235,8 +235,11 @@ (const signature-file) (const organization) (const address) + (const x-face-file) (const name) - (const body)) + (const body) + (symbol) + (string :tag "Header")) (string :format "%v")))) "post style. See `gnus-posting-styles'."))
--- a/lisp/gnus/gnus-group.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-group.el Thu Jan 12 11:20:02 2006 +0000 @@ -284,14 +284,15 @@ :type 'hook) (defcustom gnus-useful-groups - '(("(ding) mailing list mirrored at sunsite.auc.dk" - "emacs.ding" - (nntp "sunsite.auc.dk" - (nntp-address "sunsite.auc.dk"))) - ("gnus-bug archive" - "gnus-bug" - (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/")) - ("Gnus help group" + '(("(ding) mailing list mirrored at gmane.org" + "gmane.emacs.gnus.general" + (nntp "Gmane" + (nntp-address "news.gmane.org"))) + ("Gnus bug archive" + "gnus.gnus-bug" + (nntp "news.gnus.org" + (nntp-address "news.gnus.org"))) + ("Local Gnus help group" "gnus-help" (nndoc "gnus-help" (nndoc-article-type mbox)
--- a/lisp/gnus/gnus-msg.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-msg.el Thu Jan 12 11:20:02 2006 +0000 @@ -844,6 +844,7 @@ (delete-region (point) (point-max)) (insert yank-string)) (gnus-article-delete-text-of-type 'annotation) + (gnus-article-delete-text-of-type 'multipart) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (gnus-remove-text-with-property 'gnus-decoration)
--- a/lisp/gnus/gnus-start.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-start.el Thu Jan 12 11:20:02 2006 +0000 @@ -2818,6 +2818,7 @@ (print-escape-nonascii t) (print-length nil) (print-level nil) + (print-circle nil) (print-escape-newlines t) (gnus-killed-list (if (and gnus-save-killed-list
--- a/lisp/gnus/gnus-sum.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/gnus-sum.el Thu Jan 12 11:20:02 2006 +0000 @@ -6114,7 +6114,7 @@ (let ((max (max (point) (mark))) articles article) (save-excursion - (goto-char (min (min (point) (mark)))) + (goto-char (min (point) (mark))) (while (and (push (setq article (gnus-summary-article-number)) articles)
--- a/lisp/gnus/nnrss.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/nnrss.el Thu Jan 12 11:20:02 2006 +0000 @@ -87,9 +87,14 @@ (defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252)) "Alist of encodings and those supersets. The cdr of each element is used to decode data if it is available when -the car is what the data specify as the encoding. Or, the car is used +the car is what the data specify as the encoding. Or, the car is used for decoding when the cdr that the data specify is not available.") +(defvar nnrss-wash-html-in-text-plain-parts nil + "*Non-nil means render text in text/plain parts as HTML. +The function specified by the `mm-text-html-renderer' variable will be +used to render text. If it is nil, text will simply be folded.") + (nnoo-define-basics nnrss) ;;; Interface functions @@ -169,6 +174,10 @@ (deffoo nnrss-close-group (group &optional server) t) +(eval-when-compile + (defvar mm-text-html-renderer) + (defvar mm-text-html-washer-alist)) + (deffoo nnrss-request-article (article &optional group server buffer) (setq group (nnrss-decode-group-name group)) (when (stringp article) @@ -191,10 +200,7 @@ (if (nth 5 e) (insert "Date: " (nnrss-format-string (nth 5 e)) "\n")) (let ((header (buffer-string)) - (text (if (nth 6 e) - (mapconcat 'identity - (delete "" (split-string (nth 6 e) "\n+")) - " "))) + (text (nth 6 e)) (link (nth 2 e)) (enclosure (nth 7 e)) (comments (nth 8 e)) @@ -205,14 +211,55 @@ (cons '("Newsgroups" . utf-8) rfc2047-header-encoding-alist) rfc2047-header-encoding-alist)) - rfc2047-encode-encoded-words body) + rfc2047-encode-encoded-words body fn) (when (or text link enclosure comments) (insert "\n") (insert "<#multipart type=alternative>\n" "<#part type=\"text/plain\">\n") (setq body (point)) (when text - (insert text "\n") + (insert text) + (goto-char body) + (if (and nnrss-wash-html-in-text-plain-parts + (progn + (require 'mm-view) + (setq fn (or (cdr (assq mm-text-html-renderer + mm-text-html-washer-alist)) + mm-text-html-renderer)))) + (progn + (narrow-to-region body (point-max)) + (if (functionp fn) + (funcall fn) + (apply (car fn) (cdr fn))) + (widen) + (goto-char body) + (re-search-forward "[^\t\n ]" nil t) + (beginning-of-line) + (delete-region body (point)) + (goto-char (point-max)) + (skip-chars-backward "\t\n ") + (end-of-line) + (delete-region (point) (point-max)) + (insert "\n")) + (while (re-search-forward "\n+" nil t) + (replace-match " ")) + (goto-char body) + ;; See `nnrss-check-group', which inserts "<br /><br />". + (when (search-forward "<br /><br />" nil t) + (if (eobp) + (replace-match "\n") + (replace-match "\n\n"))) + (unless (eobp) + (let ((fill-column default-fill-column) + (window (get-buffer-window nntp-server-buffer))) + (when window + (setq fill-column + (max 1 (/ (* (window-width window) 7) 8)))) + (fill-region (point) (point-max)) + (goto-char (point-max)) + ;; XEmacs version of `fill-region' inserts newline. + (unless (bolp) + (insert "\n"))))) (when (or link enclosure) (insert "\n"))) (when link @@ -362,7 +409,11 @@ ;; FIXME: shouldn't binding `coding-system-for-read' be moved ;; to `mm-url-insert'? (let ((coding-system-for-read 'binary)) - (mm-url-insert url))) + (condition-case err + (mm-url-insert url) + (error (if (or debug-on-quit debug-on-error) + (signal (car err) (cdr err)) + (message "nnrss: Failed to fetch %s" url)))))) (nnheader-remove-cr-followed-by-lf) ;; Decode text according to the encoding attribute. (when (setq cs (nnrss-get-encoding)) @@ -414,6 +465,74 @@ (unless (assoc (car elem) nnrss-group-alist) (insert (prin1-to-string (car elem)) " 0 1 y\n"))))) +(eval-and-compile (autoload 'timezone-parse-date "timezone")) + +(defun nnrss-normalize-date (date) + "Return a date string of DATE in the RFC822 style. +This function handles the ISO 8601 date format described in +<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style +which RSS 2.0 allows." + (let (case-fold-search vector year month day time zone cts) + (cond ((null date)) + ;; RFC822 + ((string-match " [0-9]+ " date) + (setq vector (timezone-parse-date date) + year (string-to-number (aref vector 0))) + (when (>= year 1969) + (setq month (string-to-number (aref vector 1)) + day (string-to-number (aref vector 2))) + (unless (>= (length (setq time (aref vector 3))) 3) + (setq time "00:00:00")) + (when (and (setq zone (aref vector 4)) + (not (string-match "\\`[A-Z+-]" zone))) + (setq zone nil)))) + ;; ISO 8601 + ((string-match + (eval-when-compile + (concat + ;; 1. year + "\\(199[0-9]\\|20[0-9][0-9]\\)" + "\\(-" + ;; 3. month + "\\([01][0-9]\\)" + "\\(-" + ;; 5. day + "\\([0-3][0-9]\\)" + "\\)?\\)?\\(T" + ;; 7. hh:mm + "\\([012][0-9]:[0-5][0-9]\\)" + "\\(" + ;; 9. :ss + "\\(:[0-5][0-9]\\)" + "\\(\\.[0-9]+\\)?\\)?\\)?" + ;; 13+14,15,16. zone + "\\(\\(\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)" + "\\|\\([+-][012][0-9][0-5][0-9]\\)" + "\\|\\(Z\\)\\)?")) + date) + (setq year (string-to-number (match-string 1 date)) + month (string-to-number (or (match-string 3 date) "1")) + day (string-to-number (or (match-string 5 date) "1")) + time (if (match-beginning 9) + (substring date (match-beginning 7) (match-end 9)) + (concat (or (match-string 7 date) "00:00") ":00")) + zone (cond ((match-beginning 13) + (concat (match-string 13 date) + (match-string 14 date))) + ((match-beginning 16) ;; Z + "+0000") + (t ;; nil if zone is not provided. + (match-string 15 date)))))) + (if month + (progn + (setq cts (current-time-string (encode-time 0 0 0 day month year))) + (format "%s, %02d %s %04d %s%s" + (substring cts 0 3) day (substring cts 4 7) year time + (if zone + (concat " " zone) + ""))) + (message-make-date)))) + ;;; data functions (defun nnrss-read-server-data (server) @@ -497,7 +616,11 @@ (defun nnrss-insert-w3 (url) (mm-with-unibyte-current-buffer - (mm-url-insert url))) + (condition-case err + (mm-url-insert url) + (error (if (or debug-on-quit debug-on-error) + (signal (car err) (cdr err)) + (message "nnrss: Failed to fetch %s" url)))))) (defun nnrss-decode-entities-string (string) (if string @@ -532,7 +655,7 @@ ;;; Snarf functions (defun nnrss-check-group (group server) - (let (file xml subject url extra changed author date + (let (file xml subject url extra changed author date feed-subject enclosure comments rss-ns rdf-ns content-ns dc-ns) (if (and nnrss-use-local (file-exists-p (setq file (expand-file-name @@ -575,12 +698,14 @@ (setq extra (or extra (nnrss-node-text content-ns 'encoded item) (nnrss-node-text rss-ns 'description item))) + (if (setq feed-subject (nnrss-node-text dc-ns 'subject item)) + (setq extra (concat feed-subject "<br /><br />" extra))) (setq author (or (nnrss-node-text rss-ns 'author item) (nnrss-node-text dc-ns 'creator item) (nnrss-node-text dc-ns 'contributor item))) - (setq date (or (nnrss-node-text dc-ns 'date item) - (nnrss-node-text rss-ns 'pubDate item) - (message-make-date))) + (setq date (nnrss-normalize-date + (or (nnrss-node-text dc-ns 'date item) + (nnrss-node-text rss-ns 'pubDate item)))) (setq comments (nnrss-node-text rss-ns 'comments item)) (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item))) (let ((url (cdr (assq 'url enclosure)))
--- a/lisp/gnus/spam.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/gnus/spam.el Thu Jan 12 11:20:02 2006 +0000 @@ -467,28 +467,14 @@ "Logical exclusive `or'." (and (or a b) (not (and a b)))) -(defun spam-group-ham-mark-p (group mark &optional spam) - (when (stringp group) - (let* ((marks (spam-group-ham-marks group spam)) - (marks (if (symbolp mark) - marks - (mapcar 'symbol-value marks)))) - (memq mark marks)))) - -(defun spam-group-spam-mark-p (group mark) - (spam-group-ham-mark-p group mark t)) - (defun spam-group-ham-marks (group &optional spam) (when (stringp group) - (let* ((marks (if spam - (gnus-parameter-spam-marks group) - (gnus-parameter-ham-marks group))) - (marks (car marks)) - (marks (if (listp (car marks)) (car marks) marks))) - marks))) - -(defun spam-group-spam-marks (group) - (spam-group-ham-marks group t)) + (let ((marks (car (if spam + (gnus-parameter-spam-marks group) + (gnus-parameter-ham-marks group))))) + (if (listp (car marks)) + (car marks) + marks)))) (defun spam-group-spam-contents-p (group) (if (stringp group) @@ -1050,23 +1036,12 @@ (nth 2 flist)))) (defun spam-list-articles (articles classification) - (let ((mark-check (if (eq classification 'spam) - 'spam-group-spam-mark-p - 'spam-group-ham-mark-p)) - list mark-cache-yes mark-cache-no) + (let ((marks (mapcar 'eval (spam-group-ham-marks gnus-newsgroup-name + (eq classification 'spam)))) + list) (dolist (article articles) - (let ((mark (gnus-summary-article-mark article))) - (unless (memq mark mark-cache-no) - (if (memq mark mark-cache-yes) - (push article list) - ;; else, we have to actually check the mark - (if (funcall mark-check - gnus-newsgroup-name - mark) - (progn - (push article list) - (push mark mark-cache-yes)) - (push mark mark-cache-no)))))) + (if (memq (gnus-summary-article-mark article) marks) + (push article list))) list)) (defun spam-register-routine (classification
--- a/lisp/ldefs-boot.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/ldefs-boot.el Thu Jan 12 11:20:02 2006 +0000 @@ -10311,7 +10311,7 @@ (autoload (quote find-definition-noselect) "find-func" "\ Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL. TYPE says what type of definition: nil for a function, -`defvar' or `defface' for a variable or face. This functoin +`defvar' or `defface' for a variable or face. This function does not switch to the buffer or display it. The library where SYMBOL is defined is searched for in FILE or
--- a/lisp/log-view.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/log-view.el Thu Jan 12 11:20:02 2006 +0000 @@ -27,7 +27,7 @@ ;; Major mode to browse revision log histories. ;; Currently supports the format output by: -;; RCS, SCCS, CVS, Subversion. +;; RCS, SCCS, CVS, Subversion, and DaRCS. ;; Examples of log output: @@ -50,6 +50,22 @@ ;;;; Subversion: +;;;; Darcs: + +;; Changes to darcsum.el: +;; +;; Mon Nov 28 15:19:38 GMT 2005 Dave Love <fx@gnu.org> +;; * Abstract process startup into darcsum-start-process. Use TERM=dumb. +;; TERM=dumb avoids escape characters, at least, for any old darcs that +;; doesn't understand DARCS_DONT_COLOR & al. +;; +;; Thu Nov 24 15:20:45 GMT 2005 Dave Love <fx@gnu.org> +;; * darcsum-mode-related changes. +;; Don't call font-lock-mode (unnecessary) or use-local-map (redundant). +;; Use mode-class 'special. Add :group. +;; Add trailing-whitespace option to mode hook and fix +;; darcsum-display-changeset not to use trailing whitespace. + ;;; Todo: ;; - add ability to modify a log-entry (via cvs-mode-admin ;-) @@ -114,13 +130,22 @@ (defconst log-view-file-re (concat "^\\(?:Working file: \\(.+\\)" ;RCS and CVS. - "\\|SCCS/s\\.\\(.+\\):" ;SCCS. + "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(.+\\):" ;SCCS and Darcs. "\\)\n")) ;Include the \n for font-lock reasons. (defconst log-view-message-re (concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS. "\\|r\\([0-9]+\\) | .* | .*" ; Subversion. "\\|D \\([.0-9]+\\) .*" ; SCCS. + ;; Darcs doesn't have revision names. VC-darcs uses patch names + ;; instead. Darcs patch names are hashcodes, which do not appear + ;; in the log output :-(, but darcs accepts any prefix of the log + ;; message as a patch name, so we match the first line of the log + ;; message. + ;; First loosely match the date format. + (concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]" + ;;Email of user and finally Msg, used as revision name. + " .*@.*\n\\(?: \\* \\(.*\\)\\)?") "\\)$")) (defconst log-view-font-lock-keywords
--- a/lisp/mail/emacsbug.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mail/emacsbug.el Thu Jan 12 11:20:02 2006 +0000 @@ -56,9 +56,6 @@ (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of bug report.") -(defvar report-emacs-bug-text-prompt nil - "The automatically-created initial prompt of bug report.") - (defcustom report-emacs-bug-no-confirmation nil "*If non-nil, suppress the confirmations asked for the sake of novice users." :group 'emacsbug @@ -78,15 +75,20 @@ (interactive (reverse (list (recent-keys) (read-string "Bug Subject: ")))) ;; If there are four numbers in emacs-version, this is a pretest ;; version. - (let ((pretest-p (string-match "\\..*\\..*\\." emacs-version)) + (let* ((pretest-p (string-match "\\..*\\..*\\." emacs-version)) (from-buffer (current-buffer)) - user-point prompt-beg-point message-end-point) + (reporting-address (if pretest-p + report-emacs-bug-pretest-address + report-emacs-bug-address)) + ;; Put these properties on semantically-void text. + (prompt-properties '(field emacsbug-prompt + intangible but-helpful + rear-nonsticky t)) + user-point message-end-point) (setq message-end-point (with-current-buffer (get-buffer-create "*Messages*") (point-max-marker))) - (compose-mail (if pretest-p - report-emacs-bug-pretest-address - report-emacs-bug-address) + (compose-mail reporting-address topic) ;; The rest of this does not execute ;; if the user was asked to confirm and said no. @@ -97,33 +99,30 @@ (delete-region (point) (point-max)) (insert signature) (backward-char (length signature))) - (setq prompt-beg-point (point)) (unless report-emacs-bug-no-explanations ;; Insert warnings for novice users. - (insert "This bug report will be sent to the Free Software Foundation,\n") - (let ((pos (point))) - (insert "not to your local site managers!") - (put-text-property pos (point) 'face 'highlight)) - (insert "\nPlease write in ") + (when (string-match "@gnu\\.org^" reporting-address) + (insert "This bug report will be sent to the Free Software Foundation,\n") + (let ((pos (point))) + (insert "not to your local site managers!") + (put-text-property pos (point) 'face 'highlight))) + (insert "\nPlease write in ") (let ((pos (point))) (insert "English") (put-text-property pos (point) 'face 'highlight)) (insert " if possible, because the Emacs maintainers usually do not have translators to read other languages for them.\n\n") (insert (format "Your bug report will be posted to the %s mailing list" - (if pretest-p - report-emacs-bug-pretest-address - report-emacs-bug-address))) + reporting-address)) (if pretest-p (insert ".\n\n") (insert ",\nand to the gnu.emacs.bug news group.\n\n"))) (insert "Please describe exactly what actions triggered the bug\n" - "and the precise symptoms of the bug:") - (setq report-emacs-bug-text-prompt - (buffer-substring prompt-beg-point (point))) + "and the precise symptoms of the bug:\n\n") + (add-text-properties (point) (save-excursion (mail-text) (point)) + prompt-properties) - (insert "\n\n") (setq user-point (point)) (insert "\n\n") @@ -135,6 +134,7 @@ (if (file-readable-p debug-file) (insert "If you would like to further debug the crash, please read the file\n" debug-file " for instructions.\n"))) + (add-text-properties (1+ user-point) (point) prompt-properties) (insert "\n\nIn " (emacs-version) "\n") (if (fboundp 'x-server-vendor) @@ -274,8 +274,10 @@ ;; Unclutter (mail-text) - (if (looking-at report-emacs-bug-text-prompt) - (replace-match "Symptoms:")))) + (let ((pos (1- (point)))) + (while (setq pos (text-property-any pos (point-max) + 'field 'emacsbug-prompt)) + (delete-region pos (field-end (1+ pos))))))) (provide 'emacsbug)
--- a/lisp/mail/rmail.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mail/rmail.el Thu Jan 12 11:20:02 2006 +0000 @@ -447,8 +447,10 @@ "String to prepend to Subject line when replying to a message.") ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:". -;; This pattern should catch all the common variants. -(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*" +;; This pattern should catch all the common variants. The pattern +;; also ignores mailing list identifiers sometimes added in square +;; brackets at the beginning of subject lines. +(defvar rmail-reply-regexp "\\`\\(\\[.+?\\] \\)?\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*" "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") (defcustom rmail-display-summary nil @@ -3143,30 +3145,52 @@ ;; (rmail-show-message found)) found)) -(defun rmail-next-same-subject (n) - "Go to the next mail message having the same subject header. -With prefix argument N, do this N times. -If N is negative, go backwards instead." - (interactive "p") - (let ((subject (mail-fetch-field "Subject")) - (forward (> n 0)) - (i rmail-current-message) - (case-fold-search t) - search-regexp found) +(defun rmail-current-subject () + "Return the current subject. +The subject is stripped of leading and trailing whitespace, and +of typical reply prefixes such as Re:." + (let ((subject (or (mail-fetch-field "Subject") ""))) (if (string-match "\\`[ \t]+" subject) (setq subject (substring subject (match-end 0)))) - (if (string-match "\\`\\(Re:[ \t]*\\)+" subject) + (if (string-match rmail-reply-regexp subject) (setq subject (substring subject (match-end 0)))) (if (string-match "[ \t]+\\'" subject) (setq subject (substring subject 0 (match-beginning 0)))) + subject)) + +(defun rmail-current-subject-regexp () + "Return a regular expression matching the current subject. +The regular expression matches the subject header line of +messages about the same subject. The subject itself is stripped +of leading and trailing whitespace, of typical reply prefixes +such as Re: and whitespace within the subject is replaced by a +regular expression matching whitespace in general in order to +take into account that subject header lines may include newlines +and more whitespace. The returned regular expressions contains +`rmail-reply-regexp' and ends with a newline." + (let ((subject (rmail-current-subject))) ;; If Subject is long, mailers will break it into several lines at ;; arbitrary places, so replace whitespace with a regexp that will ;; match any sequence of spaces, TABs, and newlines. (setq subject (regexp-quote subject)) (setq subject (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t)) - (setq search-regexp (concat "^Subject: *\\(Re:[ \t]*\\)*" - subject "[ \t]*\n")) + (concat "^Subject: " + (if (string= "\\`" (substring rmail-reply-regexp 0 2)) + (substring rmail-reply-regexp 2) + rmail-reply-regexp) + subject "[ \t]*\n"))) + +(defun rmail-next-same-subject (n) + "Go to the next mail message having the same subject header. +With prefix argument N, do this N times. +If N is negative, go backwards instead." + (interactive "p") + (let ((search-regexp (rmail-current-subject-regexp)) + (forward (> n 0)) + (i rmail-current-message) + (case-fold-search t) + found) (save-excursion (save-restriction (widen)
--- a/lisp/mail/rmailsum.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mail/rmailsum.el Thu Jan 12 11:20:02 2006 +0000 @@ -132,7 +132,15 @@ but if WHOLE-MESSAGE is non-nil (prefix arg given), look in the whole message. SUBJECT is a string of regexps separated by commas." - (interactive "sTopics to summarize by: \nP") + (interactive + (let* ((subject (with-current-buffer rmail-buffer + (rmail-current-subject))) + (subject-re (with-current-buffer rmail-buffer + (rmail-current-subject-regexp))) + (prompt (concat "Topics to summarize by (regexp" + (if subject ", default current subject" "") + "): "))) + (list (read-string prompt nil nil subject) current-prefix-arg))) (rmail-new-summary (concat "about " subject) (list 'rmail-summary-by-topic subject whole-message) @@ -568,17 +576,11 @@ With prefix argument N, do this N times. If N is negative, go backwards." (interactive "p") - (let (subject search-regexp i found - (forward (> n 0))) - (save-excursion - (set-buffer rmail-buffer) - (setq subject (mail-fetch-field "Subject")) - (setq i rmail-current-message)) - (if (string-match "Re:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq search-regexp (concat "^Subject: *\\(Re: *\\)?" - (regexp-quote subject) - "\n")) + (let ((forward (> n 0)) + search-regexp i found) + (with-current-buffer rmail-buffer + (setq search-regexp (rmail-current-subject-regexp) + i rmail-current-message)) (save-excursion (while (and (/= n 0) (if forward
--- a/lisp/mail/smtpmail.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mail/smtpmail.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,6 +1,6 @@ ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail -;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 +;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2006 ;; Free Software Foundation, Inc. ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp> @@ -560,6 +560,11 @@ (>= (car ret) 400)) (throw 'done nil))) ((eq mech 'plain) + ;; We used to send an empty initial request, and wait for an + ;; empty response, and then send the password, but this + ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this + ;; is not sent if the server did not advertise AUTH PLAIN in + ;; the EHLO response. See RFC 2554 for more info. (smtpmail-send-command process (concat "AUTH PLAIN " (base64-encode-string
--- a/lisp/mh-e/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,149 @@ +2006-01-10 Bill Wohler <wohler@newt.com> + + * mh-index.el (mh-index-search): Checking mh-find-path-run is + unnecessary. + + * mh-init.el (mh-sys-path): Co-locate with mh-variants, which uses + it. + (mh-variants): Note variable isn't meant to be accessed directly; + use function mh-variants instead. + (mh-variant-info, mh-variant-mh-info, mh-variant-mu-mh-info) + (mh-variant-nmh-info): Co-locate next to mh-variants, which uses + them. Updated to use mh-file-command-p which is more accurrate + than file-executable-p which returns t for directories. + (mh-file-command-p): Move here from mh-utils, since + mh-variant-*-info are the only functions to use it. + (mh-variant-set, mh-variant-set-variant, mh-variant-p): Use + function mh-variants instead of variable. More robust. + (mh-find-path-run): Move here from mh-utils.el. Mention that + checking this variable is unnecessary. + (mh-find-path): Move here from mh-utils.el. With the advent of MH + variants and an mhparam command that doesn't work if there isn't + an MH profile, we can't get libdir for running install-mh. So + don't bother. If there's an issue with the environment, direct the + user to install MH and run install-mh (closes SF #835192). Don't + read ~/.mh_profile directly. Use mh-profile-component which uses + mhparam (closes SF #1016027). + + * mh-utils.el (mh-get-profile-field): Rename to + mh-profile-component-value. Add colon to search removing + unnecessary addition of colon to field in mh-profile-component. + (mh-profile-component): Modify call to mh-profile-component-value + accordingly. Move next to mh-profile-component-value. + (mh-find-path-run, mh-find-path, mh-file-command-p): Move to + mh-init.el. It makes sense that code that is only run once per + session (more or less) is in mh-init.el rather than cluttering + mh-utils.el. + (mh-no-install, mh-install): Delete. + + * mh-customize.el (mh-folder-msg-number): + * mh-mime.el (mh-file-mime-type): Removed trailing whitespace. + +2006-01-09 Bill Wohler <wohler@newt.com> + + * mh-init.el (mh-variant-mu-mh-info, mh-variant-nmh-info): Applied + patch from Satyaki from SF #1016027. + + * mh-e.el (mh-rescan-folder): Try to keep cursor at current + message, even if cur sequence is no longer present (closes SF + #1207247). + + * mh-comp.el: Use ";; Shush compiler." comment consistently per + Mark's suggestion. + (mh-letter-mode): Derive from mail-mode and delete code copied + from mail-mode (closes SF #1385571). Mention mail-mode-hook in + docstring. + (mh-fill-paragraph-function): Delete. Handled by mail-mode. + (mh-to-field-choices): For consistency with mail-mode, add "a" for + "Mail-Reply-To:", "l" for "Mail-Followup-To:", and "r" for + "Reply-To:". Change "r" to "m" for "From:" (closes SF #1400139). + (mh-to-fcc): Move setting of folder argument to interactive + argument as is the norm. + (mh-letter-complete-function-alist): Add mail-reply-to. + (mh-letter-mode-map): Add keys for mh-to-field (Mail-Reply-To, + Mail-Followup-To, Reply-To, From). + + * mh-customize.el: Use ";; Forward definition." consistently. + Comment declaration to remind programmer to update forward + definition if default changes. + + * mh-funcs.el: + * mh-inc.el: + * mh-init.el: + * mh-mime.el: + * mh-seq.el: + * mh-utils.el: Use ";; Shush compiler." comment consistently per + Mark's suggestion. + +2006-01-08 Bill Wohler <wohler@newt.com> + + Removed code that was marked as Emacs 20 compatible that was + easily found showing how important it is to document such + things (closes SF #1359240). Feel free to nuke any other Emacs 20 + peculiarities that you find. Wrapped code for shushing compiler + with (eval-when-compile), sometimes moving the defvars closer to + where they were used. + + * mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string + instead of mh-replace-in-string as mh-replace-in-string was + replaced by a more appropriate defsubst in mh-xemacs.el. + + * mh-comp.el: Require cleanup, wrap compiler-shushing defvars with + eval-when-compile. + (mh-file-is-vcard-p): Removed redundant test. + + * mh-customize.el: Require cleanup, wrap compiler-shushing defvars + with eval-when-compile. + (mh-adaptive-cmd-note-flag, mh-invisible-header-fields) + (mh-invisible-header-fields-default): Add forward definitions. + (mh-invisible-header-fields-default): Alphabetize. + + * mh-e.el: Require cleanup, wrap compiler-shushing defvars with + eval-when-compile. + (mh-thread-scan-line-map-stack, tool-bar-mode): Delete unused + variables. + (mh-colors-available-p): Just call display-color-cells. It's on + all supported Emacsen (and defaliased on XEmacs). + + * mh-funcs.el: + * mh-inc.el: + * mh-init.el: Wrap compiler-shushing defvars with + eval-when-compile. + + * mh-identity.el: Don't need (mh-require-cl). + + * mh-index.el: Don't need to load executable any more. + + * mh-mime.el: Wrap compiler-shushing defvars with + eval-when-compile. + (mh-have-file-command): Initialize variable to 'undefined. Add + docstring. Update function of same name accordingly. Also don't + need to load executable any more. + (mh-mime-content-types): Delete. + (mh-minibuffer-read-type): Prompt user for type if + mh-file-mime-type returns application/octet-stream. Assume we have + mailcap-mime-types. + (mh-mime-display): Update error message. + + * mh-seq.el: Require cleanup, and wrap compiler-shushing defvars + with eval-when-compile. + + * mh-utils.el: Require cleanup, and wrap compiler-shushing defvars + with eval-when-compile. + (mh-clean-msg-header): Don't set after-change-functions to nil. + (mh-replace-in-string): Remove. Create defsubst in mh-xemacs.el + instead. + +2006-01-07 Bill Wohler <wohler@newt.com> + + * mh-customize.el: Updated Faces documentation in header. + (mh-invisible-header-fields-internal): Add X-Lumos-SenderID, + X-Return-Path-Hint, and X-Roving-* from Roving ConstantContact. + + * mh-mime.el (mh-mml-tag-present-p): Update regexp to handle <mml> + tags inserted by Gnus gnus-summary-mail-forward (closes SF + #1399307). + 2006-01-03 Mark D. Baushke <mdb@gnu.org> * mh-e.el (mh-delete-a-msg): Fix whitespace nit.
--- a/lisp/mh-e/mh-alias.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-alias.el Thu Jan 12 11:20:02 2006 +0000 @@ -132,10 +132,10 @@ (setq res (match-string 1 res))) ;; Replace "&" with capitalized username (if (string-match "&" res) - (setq res (mh-replace-in-string "&" (capitalize username) res))) + (setq res (replace-regexp-in-string "&" (capitalize username) res))) ;; Remove " character (if (string-match "\"" res) - (setq res (mh-replace-in-string "\"" "" res))) + (setq res (replace-regexp-in-string "\"" "" res))) ;; If empty string, use username instead (if (string-equal "" res) (setq res username))
--- a/lisp/mh-e/mh-comp.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-comp.el Thu Jan 12 11:20:02 2006 +0000 @@ -35,24 +35,17 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) -(require 'mh-e) + +(require 'easymenu) (require 'gnus-util) -(require 'easymenu) +(require 'mh-e) (require 'mh-gnus) + (eval-when (compile load eval) (ignore-errors (require 'mailabbrev))) -;; Shush the byte-compiler -(defvar adaptive-fill-first-line-regexp) -(defvar font-lock-defaults) -(defvar mark-active) -(defvar sendmail-coding-system) -(defvar mh-identity-list) -(defvar mh-identity-default) -(defvar mh-mml-mode-default) -(defvar mh-identity-menu) + - ;;; Autoloads (autoload 'mail-mode-fill-paragraph "sendmail") @@ -165,9 +158,16 @@ "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>. Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") -(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:") - ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:") - ("d" . "Dcc:")) +(defvar mh-to-field-choices '(("a" . "Mail-Reply-To:") + ("b" . "Bcc:") + ("c" . "Cc:") + ("d" . "Dcc:") + ("f" . "Fcc:") + ("l" . "Mail-Followup-To:") + ("m" . "From:") + ("r" . "Reply-To:") + ("s" . "Subject:") + ("t" . "To:")) "Alist of (final-character . field-name) choices for `mh-to-field'.") (defvar mh-letter-mode-map (copy-keymap text-mode-map) @@ -946,27 +946,15 @@ The substitutions described in `substitute-command-keys' are performed as well.") -;;;###mh-autoload -(defun mh-fill-paragraph-function (arg) - "Fill paragraph at or after point. -Prefix ARG means justify as well. This function enables -`fill-paragraph' to work better in MH-Letter mode (see -`mh-letter-mode')." - (interactive "P") - (let ((fill-paragraph-function) (fill-prefix)) - (if (mh-in-header-p) - (mail-mode-fill-paragraph arg) - (fill-paragraph arg)))) - -;; Avoid compiler warnings in XEmacs and Emacs 20 +;; Shush compiler. (eval-when-compile - (defvar tool-bar-mode) + (defvar adaptive-fill-first-line-regexp) (defvar tool-bar-map)) (defvar mh-letter-buttons-init-flag nil) ;;;###autoload -(define-derived-mode mh-letter-mode text-mode "MH-Letter" +(define-derived-mode mh-letter-mode mail-mode "MH-Letter" "Mode for composing letters in MH-E\\<mh-letter-mode-map>. When you have finished composing, type \\[mh-send-letter] to send @@ -981,8 +969,9 @@ Options that control this mode can be changed with \\[customize-group]; specify the \"mh-compose\" group. -When a message is composed, the hooks `text-mode-hook' and -`mh-letter-mode-hook' are run. +When a message is composed, the hooks `text-mode-hook', +`mail-mode-hook', and `mh-letter-mode-hook' are run (in that +order). \\{mh-letter-mode-map}" (mh-find-path) @@ -1009,32 +998,6 @@ (setq buffer-invisibility-spec '((vanish . t) t)) (set (make-local-variable 'line-move-ignore-invisible) t) - ;; From sendmail.el for proper paragraph fill - ;; sendmail.el also sets a normal-auto-fill-function (not done here) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'mh-fill-paragraph-function) - (make-local-variable 'adaptive-fill-regexp) - (setq adaptive-fill-regexp - (concat adaptive-fill-regexp - "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) - (make-local-variable 'adaptive-fill-first-line-regexp) - (setq adaptive-fill-first-line-regexp - (concat adaptive-fill-first-line-regexp - "\\|[ \t]*[-[:alnum:]]*>+[ \t]*")) - ;; `-- ' precedes the signature. `-----' appears at the start of the - ;; lines that delimit forwarded messages. - ;; Lines containing just >= 3 dashes, perhaps after whitespace, - ;; are also sometimes used and should be separators. - (setq paragraph-start (concat (regexp-quote mail-header-separator) - "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$" - "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" - "-- $\\|---+$\\|" - page-delimiter)) - (setq paragraph-separate paragraph-start) - ;; --- End of code from sendmail.el --- - ;; Enable undo since a show-mode buffer might have been reused. (buffer-enable-undo) (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map) @@ -1151,17 +1114,15 @@ This command will prompt you for the FOLDER name in which to file a copy of the draft." - (interactive) - (or folder - (setq folder (mh-prompt-for-folder - "Fcc" - (or (and mh-default-folder-for-message-function - (save-excursion - (goto-char (point-min)) - (funcall - mh-default-folder-for-message-function))) - "") - t))) + (interactive (list (mh-prompt-for-folder + "Fcc" + (or (and mh-default-folder-for-message-function + (save-excursion + (goto-char (point-min)) + (funcall + mh-default-folder-for-message-function))) + "") + t))) (let ((last-input-char ?\C-f)) (expand-abbrev) (save-excursion @@ -1177,8 +1138,7 @@ (file-exists-p file) (or (and (not (mh-have-file-command)) (not (null (string-match "\.vcf$" file)))) - (and (mh-have-file-command) - (string-equal "text/x-vcard" (mh-file-mime-type file))))))) + (string-equal "text/x-vcard" (mh-file-mime-type file)))))) ;;;###mh-autoload (defun mh-insert-signature (&optional file) @@ -1469,6 +1429,9 @@ unless (eq charset 'ascii) return nil finally return t)) +;; Shush compiler. +(eval-when-compile (defvar sendmail-coding-system)) + ;;;###mh-autoload (defun mh-send-letter (&optional arg) "Save draft and send message. @@ -1857,12 +1820,13 @@ (mh-complete-word folder choices beg end))) (defvar mh-letter-complete-function-alist - '((cc . mh-alias-letter-expand-alias) - (bcc . mh-alias-letter-expand-alias) + '((bcc . mh-alias-letter-expand-alias) + (cc . mh-alias-letter-expand-alias) (dcc . mh-alias-letter-expand-alias) (fcc . mh-folder-expand-at-point) (from . mh-alias-letter-expand-alias) (mail-followup-to . mh-alias-letter-expand-alias) + (mail-reply-to . mh-alias-letter-expand-alias) (reply-to . mh-alias-letter-expand-alias) (to . mh-alias-letter-expand-alias)) "Alist of header fields and completion functions to use.") @@ -2128,17 +2092,23 @@ "\C-c\C-c" mh-send-letter "\C-c\C-d" mh-insert-identity "\C-c\C-e" mh-mh-to-mime + "\C-c\C-f\C-a" mh-to-field "\C-c\C-f\C-b" mh-to-field "\C-c\C-f\C-c" mh-to-field "\C-c\C-f\C-d" mh-to-field "\C-c\C-f\C-f" mh-to-fcc + "\C-c\C-f\C-l" mh-to-field + "\C-c\C-f\C-m" mh-to-field "\C-c\C-f\C-r" mh-to-field "\C-c\C-f\C-s" mh-to-field "\C-c\C-f\C-t" mh-to-field + "\C-c\C-fa" mh-to-field "\C-c\C-fb" mh-to-field "\C-c\C-fc" mh-to-field "\C-c\C-fd" mh-to-field "\C-c\C-ff" mh-to-fcc + "\C-c\C-fl" mh-to-field + "\C-c\C-fm" mh-to-field "\C-c\C-fr" mh-to-field "\C-c\C-fs" mh-to-field "\C-c\C-ft" mh-to-field
--- a/lisp/mh-e/mh-customize.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-customize.el Thu Jan 12 11:20:02 2006 +0000 @@ -54,10 +54,10 @@ ;; ;; 4. Faces ;; -;; Create a new face group if necessary; in this case, add the group -;; associated with the manual node in which the faces are described to the -;; faces' group definition. Since the face groups appear last, the face -;; groups will appear at the end of these other groups. +;; All faces must be placed in the mh-faces group; in addition, add the +;; group associated with the manual node in which the face is described. +;; Since the mh-faces group appears near the end of this file, the faces +;; will appear at the end of these other groups. ;; ;;; Change Log: @@ -67,21 +67,17 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) -(require 'mh-loaddefs) (eval-and-compile (defvar mh-xemacs-flag (featurep 'xemacs) - "Non-nil means the current Emacs is XEmacs.")) - -(when mh-xemacs-flag - (require 'mh-xemacs)) - -;; XXX: Functions autoloaded from the following files are used to initialize -;; customizable variables. They are require'd here, since otherwise the -;; corresponding .elc would be loaded at compile time. -(eval-when-compile + "Non-nil means the current Emacs is XEmacs.") + (when mh-xemacs-flag + (require 'mh-xemacs))) + +(eval-and-compile + (require 'mh-identity) (require 'mh-init) - (require 'mh-identity)) + (require 'mh-loaddefs)) ;; For compiler warnings... (eval-when-compile @@ -1031,7 +1027,7 @@ ;;; Scan Line Formats (:group 'mh-scan-line-formats) -;; Forward definition to avoid compiler and runtime error. +;; Forward definition. (defvar mh-scan-format-file t) (defun mh-adaptive-cmd-note-flag-check (symbol value) @@ -1045,6 +1041,9 @@ "is set to \"Use MH-E scan Format\"") (set-default symbol value))) +;; Forward definition. +(defvar mh-adaptive-cmd-note-flag) + (defun mh-scan-format-file-check (symbol value) "Check if desired setting is legal. Throw an error if user tries to set `mh-scan-format-file' to @@ -1073,6 +1072,7 @@ :group 'mh-scan-line-formats :set 'mh-adaptive-cmd-note-flag-check) +;; Update forward definition above if default changes. (defcustom mh-scan-format-file t "Specifies the format file to pass to the scan program. @@ -1513,11 +1513,11 @@ "X-Listprocessor-" ; ListProc(tm) by CREN "X-Listserver:" ; Unknown mailing list managers "X-Loop:" ; Unknown mailing list managers + "X-Lumos-SenderID:" ; Roving ConstantContact "X-MAIL-INFO:" ; NetZero "X-MHE-Checksum" ; Checksum added during index search "X-MIME-Autoconverted:" ; sendmail "X-MIMETrack:" - "X-Mms-" ; T-Mobile pictures "X-MS-" ; MS Outlook "X-MailScanner" ; ListProc(tm) by CREN "X-Mailing-List:" ; Unknown mailing list managers @@ -1526,6 +1526,7 @@ "X-Message-Id" "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX "X-MimeOLE:" ; MS Outlook + "X-Mms-" ; T-Mobile pictures "X-Mozilla-Status:" ; Netscape/Mozilla "X-Msmail-" ; MS Outlook "X-NAI-Spam-" ; Network Associates Inc. SpamKiller @@ -1548,6 +1549,8 @@ "X-Received-Date:" "X-Received:" "X-Request-" + "X-Return-Path-Hint:" ; Roving ConstantContact + "X-Roving-*" ; Roving ConstantContact "X-SBClass:" ; Spam "X-SBNote:" ; Spam "X-SBPass:" ; Spam @@ -1570,8 +1573,8 @@ "X-UNTD-" ; NetZero "X-USANET-" ; usa.net "X-UserInfo1:" + "X-VSMLoop:" ; NTMail "X-Virus-Scanned" ; amavisd-new - "X-VSMLoop:" ; NTMail "X-Vms-To:" "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways @@ -1595,6 +1598,10 @@ hidden that you wish to display, and add extra entries to hide in `mh-invisible-header-fields'.") +;; Forward definition. +(defvar mh-invisible-header-fields) +(defvar mh-invisible-header-fields-default nil) + (defun mh-invisible-headers () "Make or remake the variable `mh-invisible-header-fields-compiled'. Done using `mh-invisible-header-fields-internal' as input, from @@ -1620,23 +1627,6 @@ (regexp-opt fields t)))) (setq mh-invisible-header-fields-compiled nil)))) -(defcustom mh-invisible-header-fields-default nil - "*List of hidden header fields. - -The header fields listed in this option are hidden, although you -can check off any field that you would like to see. - -Header fields that you would like to hide that aren't listed can -be added to the option `mh-invisible-header-fields'. - -See also `mh-clean-message-header-flag'." - :type `(set ,@(mapcar (lambda (x) `(const ,x)) - mh-invisible-header-fields-internal)) - :set (lambda (symbol value) - (set-default symbol value) - (mh-invisible-headers)) - :group 'mh-show) - (defcustom mh-invisible-header-fields nil "*Additional header fields to hide. @@ -1657,6 +1647,24 @@ (mh-invisible-headers)) :group 'mh-show) +;; Update forward definition above if default changes. +(defcustom mh-invisible-header-fields-default nil + "*List of hidden header fields. + +The header fields listed in this option are hidden, although you +can check off any field that you would like to see. + +Header fields that you would like to hide that aren't listed can +be added to the option `mh-invisible-header-fields'. + +See also `mh-clean-message-header-flag'." + :type `(set ,@(mapcar (lambda (x) `(const ,x)) + mh-invisible-header-fields-internal)) + :set (lambda (symbol value) + (set-default symbol value) + (mh-invisible-headers)) + :group 'mh-show) + (defcustom mh-lpr-command-format "lpr -J '%s'" "*Command used to print\\<mh-folder-mode-map>. @@ -2543,7 +2551,7 @@ (:foreground "snow3")) (((class color)) (:foreground "cyan")))) - + "Message number face." :group 'mh-faces :group 'mh-folder) @@ -2884,7 +2892,6 @@ (((class color)) (:foreground "cyan"))))) - ;; Local Variables: ;; indent-tabs-mode: nil ;; sentence-end-double-space: nil
--- a/lisp/mh-e/mh-e.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-e.el Thu Jan 12 11:20:02 2006 +0000 @@ -51,7 +51,9 @@ ;; MH-E is an Emacs interface to the MH mail system. -;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4. +;; MH-E is supported in GNU Emacs 21 and 22 as well as XEmacs 21 +;; (except for versions 21.5.9-21.5.16), with MH 6.8.4 on, nmh 1.0.4 +;; on, and GNU mailutils 0.4 on. ;; Mailing Lists: ;; mh-e-users@lists.sourceforge.net @@ -87,17 +89,11 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) -(require 'mh-utils) -(require 'mh-init) -(require 'mh-inc) -(require 'mh-seq) -(require 'gnus-util) + (require 'easymenu) - -;; Shush the byte-compiler -(eval-when-compile - (defvar font-lock-auto-fontify) - (defvar font-lock-defaults)) +(require 'gnus-util) +(require 'mh-seq) +(require 'mh-utils) (defconst mh-version "7.85+cvs" "Version number of MH-E.") @@ -1184,8 +1180,6 @@ (when (consp part-index) (setq part-index (car part-index))) (mh-folder-mime-action part-index #'mh-mime-save-part nil)) -(defvar mh-thread-scan-line-map-stack) - (defun mh-reset-threads-and-narrowing () "Reset all variables pertaining to threads and narrowing. Also removes all content from the folder buffer." @@ -1214,8 +1208,13 @@ mh-interpret-number-as-range-flag) nil))) (setq mh-next-direction 'forward) - (let ((threaded-flag (memq 'unthread mh-view-ops))) + (let ((threaded-flag (memq 'unthread mh-view-ops)) + (msg-num (mh-get-msg-num nil))) (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending) + ;; If there isn't a cur sequence, mh-scan-folder goes to the first message. + ;; Try to stay where we were. + (if (null (car (mh-seq-to-msgs 'cur))) + (mh-goto-msg msg-num t t)) (cond (threaded-flag (mh-toggle-threads)) (mh-index-data (mh-index-insert-folder-headers))))) @@ -1299,7 +1298,6 @@ (if (not (mh-outstanding-commands-p)) (mh-set-folder-modified-p nil))) - (defun mh-folder-line-matches-show-buffer-p () "Return t if the message under point in folder-mode is in the show buffer. Return nil in any other circumstance (no message under point, no @@ -1480,7 +1478,6 @@ (setq mh-previous-window-config config))) nil) - (defun mh-update-sequences () "Flush MH-E's state out to MH. @@ -1759,13 +1756,7 @@ onward while the latter is used in previous versions and XEmacs." (if (boundp 'write-file-functions) ''write-file-functions ;Emacs 21.4 - ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs - -;; Avoid compiler warnings in non-bleeding edge versions of Emacs. -(eval-when-compile - (defvar tool-bar-mode) - (defvar tool-bar-map) - (defvar desktop-save-buffer)) ;Emacs 21.4 + ''local-write-file-hooks)) ;XEmacs ;; Register mh-folder-mode as supporting which-function-mode... (load "which-func" t t) @@ -1773,6 +1764,11 @@ (not (member 'mh-folder-mode which-func-modes))) (push 'mh-folder-mode which-func-modes)) +;; Shush compiler. +(eval-when-compile + (defvar desktop-save-buffer) + (defvar font-lock-auto-fontify)) + (defvar mh-folder-buttons-init-flag nil) ;; Autoload cookie needed by desktop.el @@ -1913,10 +1909,7 @@ (defun mh-colors-available-p () "Check if colors are available in the Emacs being used." (or mh-xemacs-flag - (let ((color-cells - (or (ignore-errors (mh-funcall-if-exists display-color-cells)) - (ignore-errors (mh-funcall-if-exists - x-display-color-cells))))) + (let ((color-cells (display-color-cells))) (and (numberp color-cells) (>= color-cells 8))))) (defun mh-colors-in-use-p () @@ -2272,7 +2265,6 @@ (mh-remove-sequence-notation msg nil t)) (clrhash mh-sequence-notation-history))) - (defun mh-goto-cur-msg (&optional minimal-changes-flag) "Position the cursor at the current message. When optional argument MINIMAL-CHANGES-FLAG is non-nil, the
--- a/lisp/mh-e/mh-funcs.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-funcs.el Thu Jan 12 11:20:02 2006 +0000 @@ -149,8 +149,8 @@ (re-search-forward "^rmf: " (point-max) t)) (display-buffer mh-temp-buffer))) -;; Avoid compiler warning... -(defvar view-exit-action) +;; Shush compiler. +(eval-when-compile (defvar view-exit-action)) ;;;###mh-autoload (defun mh-list-folders ()
--- a/lisp/mh-e/mh-identity.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-identity.el Thu Jan 12 11:20:02 2006 +0000 @@ -40,7 +40,7 @@ ;;; Code: (eval-when-compile (require 'mh-acros)) -(mh-require-cl) + (require 'mh-comp) (autoload 'mml-insert-tag "mml")
--- a/lisp/mh-e/mh-inc.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-inc.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,6 +1,6 @@ ;;; mh-inc.el --- MH-E "inc" and separate mail spool handling ;; -;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -73,8 +73,8 @@ (char-to-string key) "] inc " folder " folder\n")))) -;; Avoid compiler warning -(defvar mh-inc-spool-list) +;; Shush compiler. +(eval-when-compile (defvar mh-inc-spool-list)) (defun mh-inc-spool-make () "Make all commands and defines keys for contents of `mh-inc-spool-list'."
--- a/lisp/mh-e/mh-index.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-index.el Thu Jan 12 11:20:02 2006 +0000 @@ -45,6 +45,7 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) + (require 'mh-e) (require 'mh-mime) (require 'mh-pick) @@ -52,7 +53,6 @@ (autoload 'gnus-local-map-property "gnus-util") (autoload 'gnus-eval-format "gnus-spec") (autoload 'widget-convert-button "wid-edit") -(autoload 'executable-find "executable") ;; Support different indexing programs (defvar mh-indexer-choices @@ -443,7 +443,7 @@ (interactive (list current-prefix-arg (progn - (unless mh-find-path-run (mh-find-path)) + (mh-find-path) (or (and current-prefix-arg mh-index-sequence-search-flag) (and current-prefix-arg (car mh-index-previous-search)) (mh-prompt-for-folder "Search" "+" nil "all" t)))
--- a/lisp/mh-e/mh-init.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-init.el Thu Jan 12 11:20:02 2006 +0000 @@ -29,7 +29,7 @@ ;; Sets up the MH variant (currently nmh, MH, or GNU mailutils). ;; ;; Users may customize `mh-variant' to switch between available variants. -;; Available MH variants are described in the variable `mh-variants'. +;; Available MH variants are returned by the function `mh-variants'. ;; Developers may check which variant is currently in use with the ;; variable `mh-variant-in-use' or the function `mh-variant-p'. ;; @@ -43,8 +43,21 @@ (mh-require-cl) (require 'mh-utils) -;; Avoid compiler warnings. -(eval-when-compile (defvar image-load-path)) +(defvar mh-sys-path + '("/usr/local/nmh/bin" ; nmh default + "/usr/local/bin/mh/" + "/usr/local/mh/" + "/usr/bin/mh/" ; Ultrix 4.2, Linux + "/usr/new/mh/" ; Ultrix < 4.2 + "/usr/contrib/mh/bin/" ; BSDI + "/usr/pkg/bin/" ; NetBSD + "/usr/local/bin/" + "/usr/local/bin/mu-mh/" ; GNU mailutils - default + "/usr/bin/mu-mh/") ; GNU mailutils - packaged + "List of directories to search for variants of the MH variant. +The list `exec-path' is searched in addition to this list. +There's no need for users to modify this list. Instead add extra +directories to the customizable variable `mh-path'.") ;; Set for local environment: ;; mh-progs and mh-lib used to be set in paths.el, which tried to @@ -75,7 +88,8 @@ (defvar mh-variants nil "List describing known MH variants. -Created by the function `mh-variants'") +Do not access this variable directly as it may not have yet been initialized. +Use the function `mh-variants' instead.") ;;;###mh-autoload (defun mh-variants () @@ -98,106 +112,15 @@ (add-to-list 'mh-variants variant))))) mh-variants))) -(defvar mh-variant-in-use nil - "The MH variant currently in use; a string with variant and version number. -This differs from `mh-variant' when the latter is set to -\"autodetect\".") - -;;;###mh-autoload -(defun mh-variant-set (variant) - "Set the MH variant to VARIANT. -Sets `mh-progs', `mh-lib', `mh-lib-progs' and -`mh-flists-present-flag'. -If the VARIANT is \"autodetect\", then first try nmh, then MH and -finally GNU mailutils." - (interactive - (list (completing-read - "MH Variant: " - (mapcar (lambda (x) (list (car x))) (mh-variants)) - nil t))) - (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants)))) - (cond - ((eq variant 'none)) - ((eq variant 'autodetect) +(defun mh-variant-info (dir) + "Return MH variant found in DIR, or nil if none present." + (save-excursion + (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) + (set-buffer tmp-buffer) (cond - ((mh-variant-set-variant 'nmh) - (message "%s installed as MH variant" mh-variant-in-use)) - ((mh-variant-set-variant 'mh) - (message "%s installed as MH variant" mh-variant-in-use)) - ((mh-variant-set-variant 'mu-mh) - (message "%s installed as MH variant" mh-variant-in-use)) - (t - (message "No MH variant found on the system")))) - ((member variant valid-list) - (when (not (mh-variant-set-variant variant)) - (message "Warning: %s variant not found. Autodetecting..." variant) - (mh-variant-set 'autodetect))) - (t - (message "Unknown variant; use %s" - (mapconcat '(lambda (x) (format "%s" (car x))) - mh-variants " or ")))))) - -(defun mh-variant-set-variant (variant) - "Setup the system variables for the MH variant named VARIANT. -If VARIANT is a string, use that key in the variable `mh-variants'. -If VARIANT is a symbol, select the first entry that matches that -variant." - (cond - ((stringp variant) ;e.g. "nmh 1.1-RC1" - (when (assoc variant mh-variants) - (let* ((alist (cdr (assoc variant mh-variants))) - (lib-progs (cadr (assoc 'mh-lib-progs alist))) - (lib (cadr (assoc 'mh-lib alist))) - (progs (cadr (assoc 'mh-progs alist))) - (flists (cadr (assoc 'flists alist)))) - ;;(set-default mh-variant variant) - (setq mh-x-mailer-string nil - mh-flists-present-flag flists - mh-lib-progs lib-progs - mh-lib lib - mh-progs progs - mh-variant-in-use variant)))) - ((symbolp variant) ;e.g. 'nmh (pick the first match) - (loop for variant-list in mh-variants - when (eq variant (cadr (assoc 'variant (cdr variant-list)))) - return (let* ((version (car variant-list)) - (alist (cdr variant-list)) - (lib-progs (cadr (assoc 'mh-lib-progs alist))) - (lib (cadr (assoc 'mh-lib alist))) - (progs (cadr (assoc 'mh-progs alist))) - (flists (cadr (assoc 'flists alist)))) - ;;(set-default mh-variant flavor) - (setq mh-x-mailer-string nil - mh-flists-present-flag flists - mh-lib-progs lib-progs - mh-lib lib - mh-progs progs - mh-variant-in-use version) - t))))) - -;;;###mh-autoload -(defun mh-variant-p (&rest variants) - "Return t if variant is any of VARIANTS. -Currently known variants are 'MH, 'nmh, and 'mu-mh." - (let ((variant-in-use - (cadr (assoc 'variant (assoc mh-variant-in-use mh-variants))))) - (not (null (member variant-in-use variants))))) - -(defvar mh-sys-path - '("/usr/local/nmh/bin" ; nmh default - "/usr/local/bin/mh/" - "/usr/local/mh/" - "/usr/bin/mh/" ; Ultrix 4.2, Linux - "/usr/new/mh/" ; Ultrix < 4.2 - "/usr/contrib/mh/bin/" ; BSDI - "/usr/pkg/bin/" ; NetBSD - "/usr/local/bin/" - "/usr/local/bin/mu-mh/" ; GNU mailutils - default - "/usr/bin/mu-mh/") ; GNU mailutils - packaged - "List of directories to search for variants of the MH variant. -The list `exec-path' is searched in addition to this list. -There's no need for users to modify this list. Instead add extra -directories to the customizable variable `mh-path'.") + ((mh-variant-mh-info dir)) + ((mh-variant-nmh-info dir)) + ((mh-variant-mu-mh-info dir)))))) (defun mh-variant-mh-info (dir) "Return info for MH variant in DIR assuming a temporary buffer is setup." @@ -212,7 +135,7 @@ ;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO] ;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF] (let ((mhparam (expand-file-name "mhparam" dir))) - (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (when (mh-file-command-p mhparam) (erase-buffer) (call-process mhparam nil '(t nil) nil "-help") (goto-char (point-min)) @@ -236,70 +159,206 @@ ;; 'mhparam -version' output: ;; mhparam (GNU mailutils 0.3.2) (let ((mhparam (expand-file-name "mhparam" dir))) - (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (when (mh-file-command-p mhparam) (erase-buffer) (call-process mhparam nil '(t nil) nil "-version") (goto-char (point-min)) (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))" nil t) - (let ((version (match-string 1))) - (erase-buffer) - (call-process mhparam nil '(t nil) nil "libdir" "etcdir") - (goto-char (point-min)) - (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t) - (let ((libdir (match-string 1))) - (goto-char (point-min)) - (when (search-forward-regexp - "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t) - (let ((etcdir (match-string 1)) - (flists (file-exists-p (expand-file-name "flists" dir)))) - `(,version - (variant mu-mh) - (mh-lib-progs ,libdir) - (mh-lib ,etcdir) - (mh-progs ,dir) - (flists ,flists))))))))))) + (let ((version (match-string 1)) + (mh-progs dir)) + `(,version + (variant mu-mh) + (mh-lib-progs ,(mh-profile-component "libdir")) + (mh-lib ,(mh-profile-component "etcdir")) + (mh-progs ,dir) + (flists ,(file-exists-p + (expand-file-name "flists" dir))))))))) (defun mh-variant-nmh-info (dir) "Return info for nmh variant in DIR assuming a temporary buffer is setup." ;; `mhparam -version' outputs: ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003] (let ((mhparam (expand-file-name "mhparam" dir))) - (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (when (mh-file-command-p mhparam) (erase-buffer) (call-process mhparam nil '(t nil) nil "-version") (goto-char (point-min)) (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t) - (let ((version (format "nmh %s" (match-string 1)))) - (erase-buffer) - (call-process mhparam nil '(t nil) nil "libdir" "etcdir") - (goto-char (point-min)) - (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t) - (let ((libdir (match-string 1))) - (goto-char (point-min)) - (when (search-forward-regexp - "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t) - (let ((etcdir (match-string 1)) - (flists (file-exists-p (expand-file-name "flists" dir)))) - `(,version - (variant nmh) - (mh-lib-progs ,libdir) - (mh-lib ,etcdir) - (mh-progs ,dir) - (flists ,flists))))))))))) + (let ((version (format "nmh %s" (match-string 1))) + (mh-progs dir)) + `(,version + (variant nmh) + (mh-lib-progs ,(mh-profile-component "libdir")) + (mh-lib ,(mh-profile-component "etcdir")) + (mh-progs ,dir) + (flists ,(file-exists-p + (expand-file-name "flists" dir))))))))) + +(defun mh-file-command-p (file) + "Return t if file FILE is the name of a executable regular file." + (and (file-regular-p file) (file-executable-p file))) + +(defvar mh-variant-in-use nil + "The MH variant currently in use; a string with variant and version number. +This differs from `mh-variant' when the latter is set to +\"autodetect\".") -(defun mh-variant-info (dir) - "Return MH variant found in DIR, or nil if none present." - (save-excursion - (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) - (set-buffer tmp-buffer) +;;;###mh-autoload +(defun mh-variant-set (variant) + "Set the MH variant to VARIANT. +Sets `mh-progs', `mh-lib', `mh-lib-progs' and +`mh-flists-present-flag'. +If the VARIANT is \"autodetect\", then first try nmh, then MH and +finally GNU mailutils." + (interactive + (list (completing-read + "MH variant: " + (mapcar (lambda (x) (list (car x))) (mh-variants)) + nil t))) + (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants)))) + (cond + ((eq variant 'none)) + ((eq variant 'autodetect) (cond - ((mh-variant-mh-info dir)) - ((mh-variant-nmh-info dir)) - ((mh-variant-mu-mh-info dir)))))) + ((mh-variant-set-variant 'nmh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mu-mh) + (message "%s installed as MH variant" mh-variant-in-use)) + (t + (message "No MH variant found on the system")))) + ((member variant valid-list) + (when (not (mh-variant-set-variant variant)) + (message "Warning: %s variant not found. Autodetecting..." variant) + (mh-variant-set 'autodetect))) + (t + (message "Unknown variant; use %s" + (mapconcat '(lambda (x) (format "%s" (car x))) + (mh-variants) " or ")))))) + +(defun mh-variant-set-variant (variant) + "Setup the system variables for the MH variant named VARIANT. +If VARIANT is a string, use that key in the alist returned by the +function `mh-variants'. +If VARIANT is a symbol, select the first entry that matches that +variant." + (cond + ((stringp variant) ;e.g. "nmh 1.1-RC1" + (when (assoc variant (mh-variants)) + (let* ((alist (cdr (assoc variant (mh-variants)))) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant variant) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use variant)))) + ((symbolp variant) ;e.g. 'nmh (pick the first match) + (loop for variant-list in (mh-variants) + when (eq variant (cadr (assoc 'variant (cdr variant-list)))) + return (let* ((version (car variant-list)) + (alist (cdr variant-list)) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant flavor) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use version) + t))))) + +;;;###mh-autoload +(defun mh-variant-p (&rest variants) + "Return t if variant is any of VARIANTS. +Currently known variants are 'MH, 'nmh, and 'mu-mh." + (let ((variant-in-use + (cadr (assoc 'variant (assoc mh-variant-in-use (mh-variants)))))) + (not (null (member variant-in-use variants))))) +;;; Read MH Profile + +(defvar mh-find-path-run nil + "Non-nil if `mh-find-path' has been run already. +Do not access this variable; `mh-find-path' already uses it to +avoid running more than once.") + +(defun mh-find-path () + "Set variables from user's MH profile. + +This function sets `mh-user-path' from your \"Path:\" MH profile +component (but defaults to \"Mail\" if one isn't present), +`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from +\"Unseen-Sequence:\", `mh-previous-seq' from +\"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults +to \"+inbox\"). + +The hook `mh-find-path-hook' is run after these variables have +been set. This hook can be used the change the value of these +variables if you need to run with different values between MH and +MH-E." + (unless mh-find-path-run + ;; Sanity checks. + (if (and (getenv "MH") + (not (file-readable-p (getenv "MH")))) + (error "MH environment variable contains unreadable file %s" + (getenv "MH"))) + (if (null (mh-variants)) + (error "Install MH and run install-mh before running MH-E")) + (let ((profile "~/.mh_profile")) + (if (not (file-readable-p profile)) + (error "Run install-mh before running MH-E"))) + ;; Read MH profile. + (setq mh-user-path (mh-profile-component "Path")) + (if (not mh-user-path) + (setq mh-user-path "Mail")) + (setq mh-user-path + (file-name-as-directory + (expand-file-name mh-user-path (expand-file-name "~")))) + (unless mh-x-image-cache-directory + (setq mh-x-image-cache-directory + (expand-file-name ".mhe-x-image-cache" mh-user-path))) + (setq mh-draft-folder (mh-profile-component "Draft-Folder")) + (if mh-draft-folder + (progn + (if (not (mh-folder-name-p mh-draft-folder)) + (setq mh-draft-folder (format "+%s" mh-draft-folder))) + (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) + (error + "Draft folder \"%s\" not found; create it and try again" + (mh-expand-file-name mh-draft-folder))))) + (setq mh-inbox (mh-profile-component "Inbox")) + (cond ((not mh-inbox) + (setq mh-inbox "+inbox")) + ((not (mh-folder-name-p mh-inbox)) + (setq mh-inbox (format "+%s" mh-inbox)))) + (setq mh-unseen-seq (mh-profile-component "Unseen-Sequence")) + (if mh-unseen-seq + (setq mh-unseen-seq (intern mh-unseen-seq)) + (setq mh-unseen-seq 'unseen)) ;old MH default? + (setq mh-previous-seq (mh-profile-component "Previous-Sequence")) + (if mh-previous-seq + (setq mh-previous-seq (intern mh-previous-seq))) + (run-hooks 'mh-find-path-hook) + (mh-collect-folder-names) + (setq mh-find-path-run t))) + + + +;; Shush compiler. +(eval-when-compile (defvar image-load-path)) + (defvar mh-image-load-path-called-flag nil) ;;;###mh-autoload @@ -328,6 +387,8 @@ +;;; Support routines for mh-customize.el + (defvar mh-min-colors-defined-flag (and (not mh-xemacs-flag) (>= emacs-major-version 22)) "Non-nil means defface supports min-colors display requirement.")
--- a/lisp/mh-e/mh-mime.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-mime.el Thu Jan 12 11:20:02 2006 +0000 @@ -38,8 +38,9 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) + +(require 'gnus-util) (require 'mh-comp) -(require 'gnus-util) (require 'mh-gnus) (autoload 'article-emphasize "gnus-art") @@ -102,14 +103,14 @@ (let ((range)) (if (null messages) - (setq messages "")) + (setq messages "")) (setq range (mh-translate-range folder messages)) (if (null range) - (error "No messages in specified range")) + (error "No messages in specified range")) (dolist (message range) (if (equal mh-compose-insertion 'mml) - (mh-mml-forward-message description folder (format "%s" message)) - (mh-mh-forward-message description folder (format "%s" message)))))) + (mh-mml-forward-message description folder (format "%s" message)) + (mh-mh-forward-message description folder (format "%s" message)))))) ;; To do: ;; paragraph code should not fill # lines if MIME enabled. @@ -132,16 +133,16 @@ "/[-.+a-zA-Z0-9]+") "Regexp matching valid media types used in MIME attachment compositions.") -;; Just defvar the variable to avoid compiler warning... This doesn't bind -;; the variable, so things should work exactly as before. -(defvar mh-have-file-command) +(defvar mh-have-file-command 'undefined + "Cached value of `mh-have-file-command'. +Do not reference this variable directly as it might not have been +initialized. Always use the command `mh-have-file-command'.") ;;;###mh-autoload (defun mh-have-file-command () "Return t if 'file' command is on the system. 'file -i' is used to get MIME type of composition insertion." - (when (not (boundp 'mh-have-file-command)) - (load "executable" t t) ; executable-find not autoloaded in emacs20 + (when (eq mh-have-file-command 'undefined) (setq mh-have-file-command (and (fboundp 'executable-find) (executable-find "file") ; file command exists @@ -183,9 +184,10 @@ Returns nil if file command not on system." (cond ((not (mh-have-file-command)) - nil) ;No file command, exit now. - ((not (and (file-exists-p filename)(file-readable-p filename))) - nil) + nil) ;no file command, exit now + ((not (and (file-exists-p filename) + (file-readable-p filename))) + nil) ;no file or not readable, ditto (t (save-excursion (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) @@ -200,36 +202,6 @@ (mh-file-mime-type-substitute (match-string 0) filename))) (kill-buffer tmp-buffer))))))) -(defvar mh-mime-content-types - '(("application/mac-binhex40") ("application/msword") - ("application/octet-stream") ("application/pdf") ("application/pgp-keys") - ("application/pgp-signature") ("application/pkcs7-signature") - ("application/postscript") ("application/rtf") - ("application/vnd.ms-excel") ("application/vnd.ms-powerpoint") - ("application/vnd.ms-project") ("application/vnd.ms-tnef") - ("application/wordperfect5.1") ("application/wordperfect6.0") - ("application/zip") - - ("audio/basic") ("audio/mpeg") - - ("image/gif") ("image/jpeg") ("image/png") - - ("message/delivery-status") - ("message/external-body") ("message/partial") ("message/rfc822") - - ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers") - ("text/richtext") ("text/x-vcard") ("text/xml") - - ("video/mpeg") ("video/quicktime")) - "Valid MIME content types for Emacs 20. -Obsolete; use `mailcap-mime-types'. - -See also \\[mh-mh-to-mime].") - -;; Delete mh-minibuffer-read-type and mh-mime-content-types and use -;; mml-minibuffer-read-type when Emacs20 is no longer supported unless we -;; think (mh-file-mime-type) is better than (mm-default-file-encoding). - (defun mh-minibuffer-read-type (filename &optional default) "Return the content type associated with the given FILENAME. If the \"file\" command exists and recognizes the given file, @@ -239,14 +211,14 @@ Optional argument DEFAULT is returned if a type isn't entered." (mailcap-parse-mimetypes) (let* ((default (or default - (mm-default-file-encoding filename) - "application/octet-stream")) - (type (or (mh-file-mime-type filename) + (mm-default-file-encoding filename) + "application/octet-stream")) + (probed-type (mh-file-mime-type filename)) + (type (or (and (not (equal probed-type "application/octet-stream")) + probed-type) (completing-read (format "Content type (default %s): " default) - (if (fboundp 'mailcap-mime-types) - (mapcar 'list (mailcap-mime-types)) - mh-mime-content-types))))) + (mapcar 'list (mailcap-mime-types)))))) (if (not (equal type "")) type default))) @@ -619,7 +591,8 @@ (mml-insert-empty-tag 'part 'type type 'filename file 'disposition dispos 'description description))) -(defvar mh-identity-pgg-default-user-id) +;; Shush compiler. +(eval-when-compile (defvar mh-identity-pgg-default-user-id)) (defun mh-secure-message (method mode &optional identity) "Add tag to encrypt or sign message. @@ -693,7 +666,9 @@ (save-excursion (goto-char (point-min)) (re-search-forward - "\\(<#part\\(.\\|\n\\)*>[ \n\t]*<#/part>\\|^<#secure.+>$\\)" + (concat + "\\(<#\\(mml\\|part\\)\\(.\\|\n\\)*>[ \n\t]*<#/\\(mml\\|part\\)>\\|" + "^<#secure.+>$\\)") nil t))) @@ -967,8 +942,7 @@ (mh-mime-display-part handles)) (t (mh-signature-highlight)))) (error - (message "Please report this error:\n %s" - (error-message-string err)) + (message "Could not display body: %s" (error-message-string err)) (delete-region (point-min) (point-max)) (insert raw-message-data)))))) @@ -1440,10 +1414,10 @@ (mh-mime-display-security handle) (goto-char point)))) -;; These variables should already be initialized in mm-decode.el if we have a -;; recent enough Gnus. The defvars are here to avoid compiler warnings. -(defvar mm-verify-function-alist nil) -(defvar mm-decrypt-function-alist nil) +;; Shush compiler. +(eval-when-compile + (defvar mm-verify-function-alist nil) + (defvar mm-decrypt-function-alist nil)) (defvar pressed-details)
--- a/lisp/mh-e/mh-seq.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-seq.el Thu Jan 12 11:20:02 2006 +0000 @@ -73,11 +73,9 @@ (eval-when-compile (require 'mh-acros)) (mh-require-cl) + (require 'mh-e) -;; Shush the byte-compiler -(defvar tool-bar-mode) - ;;; Data structures (used in message threading)... @@ -171,8 +169,8 @@ (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) (apply #'mh-speed-flists t folders-changed)))) -;; Avoid compiler warnings -(defvar view-exit-action) +;; Shush compiler. +(eval-when-compile (defvar view-exit-action)) ;;;###mh-autoload (defun mh-list-sequences () @@ -239,8 +237,10 @@ (mh-list-to-string (mh-seq-containing-msg message t)) " ")))) -;; Avoid compiler warning -(defvar tool-bar-map) +;; Shush compiler +(eval-when-compile + (defvar tool-bar-map) + (defvar tool-bar-mode)) (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
--- a/lisp/mh-e/mh-utils.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/mh-e/mh-utils.el Thu Jan 12 11:20:02 2006 +0000 @@ -33,34 +33,29 @@ ;;; Code: -(defvar recursive-load-depth-limit) (eval-and-compile + (defvar recursive-load-depth-limit) (if (and (boundp 'recursive-load-depth-limit) (integerp recursive-load-depth-limit) - (> 50 recursive-load-depth-limit)) + (< recursive-load-depth-limit 50)) (setq recursive-load-depth-limit 50))) (eval-when-compile (require 'mh-acros)) (mh-require-cl) -(require 'gnus-util) + (require 'font-lock) -(require 'mouse) -(load "tool-bar" t t) -(require 'mh-loaddefs) +(require 'gnus-util) (require 'mh-customize) (require 'mh-inc) +(require 'mouse) +(require 'sendmail) -(load "mm-decode" t t) ; Non-fatal dependency -(load "mm-view" t t) ; Non-fatal dependency -(load "vcard" t t) ; Non-fatal dependency -(load "hl-line" t t) ; Non-fatal dependency -(load "executable" t t) ; Non-fatal dependency on - ; executable-find - -;; Shush the byte-compiler -(defvar font-lock-auto-fontify) -(defvar font-lock-defaults) -(defvar mark-active) +;; Non-fatal dependencies +(load "hl-line" t t) +(load "mm-decode" t t) +(load "mm-view" t t) +(load "tool-bar" t t) +(load "vcard" t t) @@ -69,7 +64,6 @@ (autoload 'gnus-article-highlight-citation "gnus-cite") (autoload 'message-fetch-field "message") (autoload 'message-tokenize-header "message") -(require 'sendmail) (unless (fboundp 'make-hash-table) (autoload 'make-hash-table "cl")) @@ -469,13 +463,12 @@ (t nil)))) -;; Needed to help shush the byte-compiler. +;; Shush compiler. (if mh-xemacs-flag - (progn - (eval-and-compile - (require 'gnus) - (require 'gnus-art) - (require 'gnus-cite)))) + (eval-and-compile + (require 'gnus) + (require 'gnus-art) + (require 'gnus-cite))) (defun mh-gnus-article-highlight-citation () "Highlight cited text in current buffer using Gnus." @@ -751,7 +744,6 @@ (unlock-buffer) (setq buffer-file-name nil)) - (defun mh-get-msg-num (error-if-no-message) "Return the message number of the displayed message. If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if @@ -774,7 +766,6 @@ (and (> (length name) 0) (eq (aref name 0) ?+)))) - (defun mh-expand-file-name (filename &optional default) "Expand FILENAME like `expand-file-name', but also handle MH folder names. Any filename that starts with '+' is treated as a folder name. @@ -783,7 +774,6 @@ (expand-file-name (substring filename 1) mh-user-path) (expand-file-name filename default))) - (defun mh-msg-filename (msg &optional folder) "Return the file name of MSG in FOLDER (default current folder)." (expand-file-name (int-to-string msg) @@ -1134,14 +1124,11 @@ "--" ["Quit MH-E" mh-quit t])) - ;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-show-mode 'mode-class 'special) -;; Avoid compiler warnings in XEmacs and Emacs 20 -(eval-when-compile - (defvar tool-bar-mode) - (defvar tool-bar-map)) +;; Shush compiler. +(eval-when-compile (defvar font-lock-auto-fontify)) (define-derived-mode mh-show-mode text-mode "MH-Show" "Major mode for showing messages in MH-E.\\<mh-show-mode-map> @@ -1877,9 +1864,7 @@ ;; XXX Note that MH-E no longer supports the `mh-visible-headers' ;; variable, so this function could be trimmed of this feature too." (let ((case-fold-search t) - (buffer-read-only nil) - (after-change-functions nil)) ;Work around emacs-20 font-lock bug - ;causing an endless loop. + (buffer-read-only nil)) (save-restriction (goto-char start) (if (search-forward "\n\n" nil 'move) @@ -1965,12 +1950,18 @@ (or dont-show (not return-value) (mh-maybe-show number)) return-value)) -(defun mh-get-profile-field (field) - "Find and return the value of FIELD in the current buffer. -Returns nil if the field is not in the buffer." +(defun mh-profile-component (component) + "Return COMPONENT value from mhparam, or nil if unset." + (save-excursion + (mh-exec-cmd-quiet nil "mhparam" "-components" component) + (mh-profile-component-value component))) + +(defun mh-profile-component-value (component) + "Find and return the value of COMPONENT in the current buffer. +Returns nil if the component is not in the buffer." (let ((case-fold-search t)) (goto-char (point-min)) - (cond ((not (re-search-forward (format "^%s" field) nil t)) nil) + (cond ((not (re-search-forward (format "^%s:" component) nil t)) nil) ((looking-at "[\t ]*$") nil) (t (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) @@ -1978,99 +1969,6 @@ (end-of-line) (buffer-substring start (point))))))) -(defvar mh-find-path-run nil - "Non-nil if `mh-find-path' has been run already.") - -(defun mh-find-path () - "Set variables from user's MH profile. - -This function sets `mh-user-path' from your \"Path:\" MH profile -component (but defaults to \"Mail\" if one isn't present), -`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from -\"Unseen-Sequence:\", `mh-previous-seq' from -\"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults -to \"+inbox\"). - -The hook `mh-find-path-hook' is run after these variables have -been set. This hook can be used the change the value of these -variables if you need to run with different values between MH and -MH-E." - (mh-variants) - (unless mh-find-path-run - (setq mh-find-path-run t) - (save-excursion - ;; Be sure profile is fully expanded before switching buffers - (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) - (set-buffer (get-buffer-create mh-temp-buffer)) - (setq buffer-offer-save nil) ;for people who set default to t - (erase-buffer) - (condition-case err - (insert-file-contents profile) - (file-error - (mh-install profile err))) - (setq mh-user-path (mh-get-profile-field "Path:")) - (if (not mh-user-path) - (setq mh-user-path "Mail")) - (setq mh-user-path - (file-name-as-directory - (expand-file-name mh-user-path (expand-file-name "~")))) - (unless mh-x-image-cache-directory - (setq mh-x-image-cache-directory - (expand-file-name ".mhe-x-image-cache" mh-user-path))) - (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) - (if mh-draft-folder - (progn - (if (not (mh-folder-name-p mh-draft-folder)) - (setq mh-draft-folder (format "+%s" mh-draft-folder))) - (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) - (error - "Draft folder \"%s\" not found. Create it and try again" - (mh-expand-file-name mh-draft-folder))))) - (setq mh-inbox (mh-get-profile-field "Inbox:")) - (cond ((not mh-inbox) - (setq mh-inbox "+inbox")) - ((not (mh-folder-name-p mh-inbox)) - (setq mh-inbox (format "+%s" mh-inbox)))) - (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) - (if mh-unseen-seq - (setq mh-unseen-seq (intern mh-unseen-seq)) - (setq mh-unseen-seq 'unseen)) ;old MH default? - (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) - (if mh-previous-seq - (setq mh-previous-seq (intern mh-previous-seq))) - (run-hooks 'mh-find-path-hook) - (mh-collect-folder-names))))) - -(defun mh-file-command-p (file) - "Return t if file FILE is the name of a executable regular file." - (and (file-regular-p file) (file-executable-p file))) - -(defvar mh-no-install nil) ;do not run install-mh - -(defun mh-install (profile error-val) - "Initialize the MH environment. -This is called if we fail to read the PROFILE file. ERROR-VAL is -the error that made this call necessary." - (if (or (getenv "MH") - (file-exists-p profile) - mh-no-install) - (signal (car error-val) - (list (format "Cannot read MH profile \"%s\"" profile) - (car (cdr (cdr error-val)))))) - ;; The "install-mh" command will output a short note which - ;; mh-exec-cmd will display to the user. - ;; The MH 5 version of install-mh might try prompt the user - ;; for information, which would fail here. - (mh-exec-cmd (expand-file-name "install-mh" mh-lib-progs) "-auto") - ;; now try again to read the profile file - (erase-buffer) - (condition-case err - (insert-file-contents profile) - (file-error - (signal (car err) ;re-signal with more specific msg - (list (format "Cannot read MH profile \"%s\"" profile) - (car (cdr (cdr err)))))))) - (defun mh-set-folder-modified-p (flag) "Mark current folder as modified or unmodified according to FLAG." (set-buffer-modified-p flag)) @@ -2350,8 +2248,11 @@ (remhash nil mh-sub-folders-cache)))) (defvar mh-folder-hist nil) -(defvar mh-speed-folder-map) -(defvar mh-speed-flists-cache) + +;; Shush compiler. +(eval-when-compile + (defvar mh-speed-folder-map) + (defvar mh-speed-flists-cache)) (defvar mh-allow-root-folder-flag nil "Non-nil means \"+\" is an acceptable folder name. @@ -2606,11 +2507,8 @@ (mh-handle-process-error command value) value))) -(defun mh-profile-component (component) - "Return COMPONENT value from mhparam, or nil if unset." - (save-excursion - (mh-exec-cmd-quiet nil "mhparam" "-components" component) - (mh-get-profile-field (concat component ":")))) +;; Shush compiler. +(eval-when-compile (defvar mark-active)) (defun mh-exchange-point-and-mark-preserving-active-mark () "Put the mark where point is now, and point where the mark is now. @@ -2689,31 +2587,13 @@ new-list)) (defun mh-replace-string (old new) - "Replace all occurrences of OLD with NEW in the current buffer." + "Replace all occurrences of OLD with NEW in the current buffer. +Ignores case when searching for OLD." (goto-char (point-min)) (let ((case-fold-search t)) (while (search-forward old nil t) (replace-match new t t)))) -(defun mh-replace-in-string (regexp newtext string) - "Replace REGEXP with NEWTEXT everywhere in STRING and return result. -NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. - -The function body was copied from `dired-replace-in-string' in -dired.el. -Emacs21 has `replace-regexp-in-string' while XEmacs has -`replace-in-string'. -Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 -and above has `gnus-replace-in-string'. We should use that when we -decide to not support older versions of Gnus." - (let ((result "") (start 0) mb me) - (while (string-match regexp string start) - (setq mb (match-beginning 0) - me (match-end 0) - result (concat result (substring string start mb) newtext) - start me)) - (concat result (substring string start)))) - (provide 'mh-utils) ;; Local Variables:
--- a/lisp/net/rcirc.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/net/rcirc.el Thu Jan 12 11:20:02 2006 +0000 @@ -181,6 +181,18 @@ :initialize 'custom-initialize-default :group 'rcirc) +(defcustom rcirc-ignore-list () + "List of ignored nicks. +Use /ignore to list them, use /ignore NICK to add or remove a nick." + :type '(repeat string) + :group 'rcirc) + +(defvar rcirc-ignore-list-automatic () + "List of ignored nicks added to `rcirc-ignore-list' because of renaming. +When an ignored person renames, their nick is added to both lists. +Nicks will be removed from the automatic list on follow-up renamings or +parts.") + (defcustom rcirc-print-hooks nil "Hook run after text is printed. Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." @@ -192,6 +204,14 @@ (defvar rcirc-nick-table nil) +(defvar rcirc-nick-syntax-table + (let ((table (make-syntax-table text-mode-syntax-table))) + (mapc (lambda (c) (modify-syntax-entry c "w" table)) + "[]\\`_^{|}-") + (modify-syntax-entry ?' "_" table) + table) + "Syntax table which includes all nick characters as word constituents.") + ;; each process has an alist of (target . buffer) pairs (defvar rcirc-buffer-alist nil) @@ -434,6 +454,9 @@ (let ((string (concat (encode-coding-string string buffer-file-coding-system) "\n"))) + (unless (eq (process-status rcirc-process) 'open) + (error "Network connection to %s is not open" + (process-name rcirc-process))) (rcirc-debug process string) (process-send-string process string))) @@ -734,62 +757,59 @@ (defun rcirc-send-input () "Send input to target associated with the current buffer." (interactive) - (if (not (eq (process-status rcirc-process) 'open)) - (error "Network connection to %s is not open" - (process-name rcirc-process)) - (if (< (point) rcirc-prompt-end-marker) - ;; copy the line down to the input area - (progn - (forward-line 0) - (let ((start (if (eq (point) (point-min)) - (point) - (if (get-text-property (1- (point)) 'hard) - (point) - (previous-single-property-change (point) 'hard)))) - (end (next-single-property-change (1+ (point)) 'hard))) - (goto-char (point-max)) - (insert (replace-regexp-in-string - "\n\\s-+" " " - (buffer-substring-no-properties start end))))) - ;; process input - (goto-char (point-max)) - (let ((target (rcirc-buffer-target)) - (start rcirc-prompt-end-marker)) - (when (not (equal 0 (- (point) start))) - ;; delete a trailing newline - (when (eq (point) (point-at-bol)) - (delete-backward-char 1)) - (let ((input (buffer-substring-no-properties - rcirc-prompt-end-marker (point)))) - ;; process a /cmd - (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input) - (let* ((command (match-string 1 input)) - (fun (intern-soft (concat "rcirc-cmd-" command))) - (args (match-string 2 input))) - (newline) - (with-current-buffer (current-buffer) - (delete-region rcirc-prompt-end-marker (point)) - (if (string= command "me") - (rcirc-print rcirc-process (rcirc-nick rcirc-process) - "ACTION" (current-buffer) args) - (rcirc-print rcirc-process (rcirc-nick rcirc-process) - "COMMAND" (current-buffer) input)) - (set-marker rcirc-prompt-end-marker (point)) - (if (fboundp fun) - (funcall fun args rcirc-process target) - (rcirc-send-string rcirc-process - (concat command " " args))))) - ;; send message to server - (if (not rcirc-target) - (message "Not joined") - (delete-region rcirc-prompt-end-marker (point)) - (mapc (lambda (message) - (rcirc-send-message rcirc-process target message)) - (split-string input "\n")))) - ;; add to input-ring - (save-excursion - (ring-insert rcirc-input-ring input) - (setq rcirc-input-ring-index 0)))))))) + (if (< (point) rcirc-prompt-end-marker) + ;; copy the line down to the input area + (progn + (forward-line 0) + (let ((start (if (eq (point) (point-min)) + (point) + (if (get-text-property (1- (point)) 'hard) + (point) + (previous-single-property-change (point) 'hard)))) + (end (next-single-property-change (1+ (point)) 'hard))) + (goto-char (point-max)) + (insert (replace-regexp-in-string + "\n\\s-+" " " + (buffer-substring-no-properties start end))))) + ;; process input + (goto-char (point-max)) + (let ((target (rcirc-buffer-target)) + (start rcirc-prompt-end-marker)) + (when (not (equal 0 (- (point) start))) + ;; delete a trailing newline + (when (eq (point) (point-at-bol)) + (delete-backward-char 1)) + (let ((input (buffer-substring-no-properties + rcirc-prompt-end-marker (point)))) + ;; process a /cmd + (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" input) + (let* ((command (match-string 1 input)) + (fun (intern-soft (concat "rcirc-cmd-" command))) + (args (match-string 2 input))) + (newline) + (with-current-buffer (current-buffer) + (delete-region rcirc-prompt-end-marker (point)) + (if (string= command "me") + (rcirc-print rcirc-process (rcirc-nick rcirc-process) + "ACTION" (current-buffer) args) + (rcirc-print rcirc-process (rcirc-nick rcirc-process) + "COMMAND" (current-buffer) input)) + (set-marker rcirc-prompt-end-marker (point)) + (if (fboundp fun) + (funcall fun args rcirc-process target) + (rcirc-send-string rcirc-process + (concat command " " args))))) + ;; send message to server + (if (not rcirc-target) + (message "Not joined") + (delete-region rcirc-prompt-end-marker (point)) + (mapc (lambda (message) + (rcirc-send-message rcirc-process target message)) + (split-string input "\n")))) + ;; add to input-ring + (save-excursion + (ring-insert rcirc-input-ring input) + (setq rcirc-input-ring-index 0))))))) (defvar rcirc-parent-buffer nil) (defvar rcirc-window-configuration nil) @@ -906,120 +926,124 @@ "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, record activity." - (let* ((buffer (cond ((bufferp target) - target) - ((not target) - (rcirc-get-any-buffer process)) - ((not (rcirc-channel-p target)) - (rcirc-get-buffer-create process - (rcirc-user-nick sender))) - ((or (rcirc-get-buffer process target) - (rcirc-get-any-buffer process))))) - (inhibit-read-only t)) - (with-current-buffer buffer - (let ((moving (= (point) rcirc-prompt-end-marker)) - (old-point (point-marker)) - (fill-start (marker-position rcirc-prompt-start-marker))) + (unless (or (member (rcirc-user-nick sender) rcirc-ignore-list) + (member (with-syntax-table rcirc-nick-syntax-table + (when (string-match "^\\([^/]\\w*\\)[:,]" text) + (match-string 1 text))) rcirc-ignore-list)) + (let* ((buffer (cond ((bufferp target) + target) + ((not target) + (rcirc-get-any-buffer process)) + ((not (rcirc-channel-p target)) + (rcirc-get-buffer-create process + (rcirc-user-nick sender))) + ((or (rcirc-get-buffer process target) + (rcirc-get-any-buffer process))))) + (inhibit-read-only t)) + (with-current-buffer buffer + (let ((moving (= (point) rcirc-prompt-end-marker)) + (old-point (point-marker)) + (fill-start (marker-position rcirc-prompt-start-marker))) - (unless (string= sender (rcirc-nick process)) - ;; only decode text from other senders, not ours - (setq text (decode-coding-string (or text "") - buffer-file-coding-system)) - ;; mark the line with overlay arrow - (unless (or (marker-position overlay-arrow-position) - (get-buffer-window (current-buffer))) - (set-marker overlay-arrow-position - (marker-position rcirc-prompt-start-marker)))) + (unless (string= sender (rcirc-nick process)) + ;; only decode text from other senders, not ours + (setq text (decode-coding-string (or text "") + buffer-file-coding-system)) + ;; mark the line with overlay arrow + (unless (or (marker-position overlay-arrow-position) + (get-buffer-window (current-buffer))) + (set-marker overlay-arrow-position + (marker-position rcirc-prompt-start-marker)))) - ;; temporarily set the marker insertion-type because - ;; insert-before-markers results in hidden text in new buffers - (goto-char rcirc-prompt-start-marker) - (set-marker-insertion-type rcirc-prompt-start-marker t) - (set-marker-insertion-type rcirc-prompt-end-marker t) - (insert - (rcirc-format-response-string process sender response target text) - (propertize "\n" 'hard t)) - (set-marker-insertion-type rcirc-prompt-start-marker nil) - (set-marker-insertion-type rcirc-prompt-end-marker nil) + ;; temporarily set the marker insertion-type because + ;; insert-before-markers results in hidden text in new buffers + (goto-char rcirc-prompt-start-marker) + (set-marker-insertion-type rcirc-prompt-start-marker t) + (set-marker-insertion-type rcirc-prompt-end-marker t) + (insert + (rcirc-format-response-string process sender response target text) + (propertize "\n" 'hard t)) + (set-marker-insertion-type rcirc-prompt-start-marker nil) + (set-marker-insertion-type rcirc-prompt-end-marker nil) - ;; fill the text we just inserted, maybe - (when (and rcirc-fill-flag - (not (string= response "372"))) ;/motd - (let ((fill-prefix - (or rcirc-fill-prefix - (make-string - (+ (if rcirc-time-format - (length (format-time-string - rcirc-time-format)) - 0) - (cond ((or (string= response "PRIVMSG") - (string= response "NOTICE")) - (+ (length (rcirc-user-nick sender)) - 2)) ; <> - ((string= response "ACTION") - (+ (length (rcirc-user-nick sender)) - 1)) ; [ - (t 3)) ; *** - 1) - ? ))) - (fill-column (cond ((eq rcirc-fill-column 'frame-width) - (1- (frame-width))) - (rcirc-fill-column - rcirc-fill-column) - (t fill-column)))) - (fill-region fill-start rcirc-prompt-start-marker 'left t))) + ;; fill the text we just inserted, maybe + (when (and rcirc-fill-flag + (not (string= response "372"))) ;/motd + (let ((fill-prefix + (or rcirc-fill-prefix + (make-string + (+ (if rcirc-time-format + (length (format-time-string + rcirc-time-format)) + 0) + (cond ((or (string= response "PRIVMSG") + (string= response "NOTICE")) + (+ (length (rcirc-user-nick sender)) + 2)) ; <> + ((string= response "ACTION") + (+ (length (rcirc-user-nick sender)) + 1)) ; [ + (t 3)) ; *** + 1) + ? ))) + (fill-column (cond ((eq rcirc-fill-column 'frame-width) + (1- (frame-width))) + (rcirc-fill-column + rcirc-fill-column) + (t fill-column)))) + (fill-region fill-start rcirc-prompt-start-marker 'left t))) - ;; set inserted text to be read-only - (when rcirc-read-only-flag - (put-text-property rcirc-prompt-start-marker fill-start 'read-only t) - (let ((inhibit-read-only t)) - (put-text-property rcirc-prompt-start-marker fill-start - 'front-sticky t) - (put-text-property (1- (point)) (point) 'rear-nonsticky t))) + ;; set inserted text to be read-only + (when rcirc-read-only-flag + (put-text-property rcirc-prompt-start-marker fill-start 'read-only t) + (let ((inhibit-read-only t)) + (put-text-property rcirc-prompt-start-marker fill-start + 'front-sticky t) + (put-text-property (1- (point)) (point) 'rear-nonsticky t))) - ;; truncate buffer if it is very long - (save-excursion - (when (and rcirc-buffer-maximum-lines - (> rcirc-buffer-maximum-lines 0) - (= (forward-line (- rcirc-buffer-maximum-lines)) 0)) - (delete-region (point-min) (point)))) + ;; truncate buffer if it is very long + (save-excursion + (when (and rcirc-buffer-maximum-lines + (> rcirc-buffer-maximum-lines 0) + (= (forward-line (- rcirc-buffer-maximum-lines)) 0)) + (delete-region (point-min) (point)))) - ;; set the window point for buffers show in windows - (walk-windows (lambda (w) - (unless (eq (selected-window) w) - (when (and (eq (current-buffer) - (window-buffer w)) - (>= (window-point w) - rcirc-prompt-end-marker)) - (set-window-point w (point-max))))) - nil t) + ;; set the window point for buffers show in windows + (walk-windows (lambda (w) + (unless (eq (selected-window) w) + (when (and (eq (current-buffer) + (window-buffer w)) + (>= (window-point w) + rcirc-prompt-end-marker)) + (set-window-point w (point-max))))) + nil t) - ;; restore the point - (goto-char (if moving rcirc-prompt-end-marker old-point)) + ;; restore the point + (goto-char (if moving rcirc-prompt-end-marker old-point)) - ;; flush undo (can we do something smarter here?) - (buffer-disable-undo) - (buffer-enable-undo)) + ;; flush undo (can we do something smarter here?) + (buffer-disable-undo) + (buffer-enable-undo)) - ;; record modeline activity - (when activity - (let ((nick-match - (string-match (concat "\\b" - (regexp-quote (rcirc-nick process)) - "\\b") - text))) - (when (or (not rcirc-ignore-buffer-activity-flag) - ;; always notice when our nick is mentioned, even - ;; if ignoring channel activity - nick-match) - (rcirc-record-activity - (current-buffer) - (when (or nick-match (not (rcirc-channel-p rcirc-target))) - 'nick))))) + ;; record modeline activity + (when activity + (let ((nick-match + (string-match (concat "\\b" + (regexp-quote (rcirc-nick process)) + "\\b") + text))) + (when (or (not rcirc-ignore-buffer-activity-flag) + ;; always notice when our nick is mentioned, even + ;; if ignoring channel activity + nick-match) + (rcirc-record-activity + (current-buffer) + (when (or nick-match (not (rcirc-channel-p rcirc-target))) + 'nick))))) - (sit-for 0) ; displayed text before hook - (run-hook-with-args 'rcirc-print-hooks - process sender response target text)))) + (sit-for 0) ; displayed text before hook + (run-hook-with-args 'rcirc-print-hooks + process sender response target text))))) (defun rcirc-startup-channels (server) "Return the list of startup channels for server." @@ -1101,6 +1125,15 @@ rcirc-nick-table) (mapcar (lambda (x) (car x)) (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))) + +(defun rcirc-ignore-update-automatic (nick) + "Remove NICK from `rcirc-ignore-list' +if NICK is also on `rcirc-ignore-list-automatic'." + (when (member nick rcirc-ignore-list-automatic) + (setq rcirc-ignore-list-automatic + (delete nick rcirc-ignore-list-automatic) + rcirc-ignore-list + (delete nick rcirc-ignore-list)))) ;;; activity tracking (or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist) @@ -1448,6 +1481,26 @@ (defun rcirc-cmd-me (args &optional process target) (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" target args))) + +(defun-rcirc-command ignore (nick) + "Manage the ignore list. +Ignore NICK, unignore NICK if already ignored, or list ignored +nicks when no NICK is given. When listing ignored nicks, the +ones added to the list automatically are marked with an asterix." + (interactive "sToggle ignoring of nick: ") + (if (string= "" nick) + (rcirc-print process (rcirc-nick process) "NOTICE" target + (mapconcat + (lambda (nick) + (concat nick + (if (member nick rcirc-ignore-list-automatic) + "*" ""))) + rcirc-ignore-list " ")) + (if (member nick rcirc-ignore-list) + (setq rcirc-ignore-list (delete nick rcirc-ignore-list)) + (setq rcirc-ignore-list (cons nick rcirc-ignore-list))))) + + (defun rcirc-message-leader (sender face) "Return a string with SENDER propertized with FACE." @@ -1502,14 +1555,6 @@ (funcall function (match-beginning 0) (match-end 0) string))) string) -(defvar rcirc-nick-syntax-table - (let ((table (make-syntax-table text-mode-syntax-table))) - (mapc (lambda (c) (modify-syntax-entry c "w" table)) - "[]\\`_^{|}-") - (modify-syntax-entry ?' "_" table) - table) - "Syntax table which includes all nick characters as word constituents.") - (defun rcirc-mangle-text (process text) "Return TEXT with properties added based on various patterns." ;; ^B @@ -1650,6 +1695,7 @@ (setq rcirc-target nil)))))) (defun rcirc-handler-PART (process sender args text) + (rcirc-ignore-update-automatic (rcirc-user-nick sender)) (rcirc-handler-PART-or-KICK process "PART" (car args) sender (rcirc-user-nick sender) (cadr args))) @@ -1659,6 +1705,7 @@ (caddr args))) (defun rcirc-handler-QUIT (process sender args text) + (rcirc-ignore-update-automatic (rcirc-user-nick sender)) (let ((nick (rcirc-user-nick sender))) (mapc (lambda (channel) (rcirc-print process sender "QUIT" channel (apply 'concat args))) @@ -1675,6 +1722,11 @@ (let* ((old-nick (rcirc-user-nick sender)) (new-nick (car args)) (channels (rcirc-nick-channels process old-nick))) + ;; update list of ignored nicks + (rcirc-ignore-update-automatic old-nick) + (when (member old-nick rcirc-ignore-list) + (add-to-list 'rcirc-ignore-list new-nick) + (add-to-list 'rcirc-ignore-list-automatic new-nick)) ;; print message to nick's channels (dolist (target channels) (rcirc-print process sender "NICK" target new-nick))
--- a/lisp/progmodes/flymake.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/progmodes/flymake.el Thu Jan 12 11:20:02 2006 +0000 @@ -30,8 +30,16 @@ ;; checks using the external syntax check tool (for C/C++ this ;; is usually the compiler) +;;; Bugs/todo: + +;; - Only uses "Makefile", not "makefile" or "GNUmakefile" +;; (from http://bugs.debian.org/337339). + ;;; Code: +(eval-when-compile (require 'cl)) +(if (featurep 'xemacs) (require 'overlay)) + (defvar flymake-is-running nil "If t, flymake syntax check process is running for the current buffer.") (make-variable-buffer-local 'flymake-is-running) @@ -60,17 +68,6 @@ "Same as `flymake-err-info', effective when a syntax check is in progress.") (make-variable-buffer-local 'flymake-new-err-info) -;;;; [[ Xemacs overlay compatibility -(if (featurep 'xemacs) (progn -(autoload 'make-overlay "overlay" "Overlay compatibility kit." t) -(autoload 'overlayp "overlay" "Overlay compatibility kit." t) -(autoload 'overlays-in "overlay" "Overlay compatibility kit." t) -(autoload 'delete-overlay "overlay" "Overlay compatibility kit." t) -(autoload 'overlay-put "overlay" "Overlay compatibility kit." t) -(autoload 'overlay-get "overlay" "Overlay compatibility kit." t) -)) -;;;; ]] - ;;;; [[ cross-emacs compatibility routines (defsubst flymake-makehash (&optional test) (if (fboundp 'make-hash-table) @@ -100,11 +97,10 @@ "Split STR into a list of substrings bounded by PATTERN. Zero-length substrings at the beginning and end of the list are omitted." (let ((split (split-string str pattern))) - (if (and (> (length split) 0) (= 0 (length (elt split 0)))) - (setq split (cdr split))) - (if (and (> (length split) 0) (= 0 (length (elt split (1- (length split)))))) - (setq split (nreverse (cdr (nreverse split))))) - split)))) + (while (equal (car split) "") (setq split (cdr split))) + (setq split (nreverse split)) + (while (equal (car split) "") (setq split (cdr split))) + (nreverse split))))) (defalias 'flymake-get-temp-dir (if (fboundp 'temp-directory) @@ -320,40 +316,35 @@ (defun flymake-clear-buildfile-cache () (clrhash flymake-find-buildfile-cache)) -(defun flymake-find-buildfile (buildfile-name source-dir-name dirs) +(defun flymake-find-buildfile (buildfile-name source-dir-name) "Find buildfile starting from current directory. Buildfile includes Makefile, build.xml etc. Return its file name if found, or nil if not found." - (if (flymake-get-buildfile-from-cache source-dir-name) - (progn - (flymake-get-buildfile-from-cache source-dir-name)) - (let* ((buildfile-dir nil) - (buildfile nil) - (found nil)) - (while (and (not found) dirs) - (setq buildfile-dir (concat source-dir-name (car dirs))) - (setq buildfile (concat buildfile-dir "/" buildfile-name)) - (when (file-exists-p buildfile) - (setq found t)) - (setq dirs (cdr dirs))) - (if found - (progn - (flymake-log 3 "found buildfile at %s/%s" buildfile-dir buildfile-name) - (flymake-add-buildfile-to-cache source-dir-name buildfile-dir) - buildfile-dir) - (progn - (flymake-log 3 "buildfile for %s not found" source-dir-name) - nil))))) + (or (flymake-get-buildfile-from-cache source-dir-name) + (let* ((dirs flymake-buildfile-dirs) + (buildfile-dir nil) + (found nil)) + (while (and (not found) dirs) + (setq buildfile-dir (concat source-dir-name (car dirs))) + (when (file-exists-p (expand-file-name buildfile-name buildfile-dir)) + (setq found t)) + (setq dirs (cdr dirs))) + (if found + (progn + (flymake-log 3 "found buildfile at %s/%s" buildfile-dir buildfile-name) + (flymake-add-buildfile-to-cache source-dir-name buildfile-dir) + buildfile-dir) + (progn + (flymake-log 3 "buildfile for %s not found" source-dir-name) + nil))))) (defun flymake-fix-file-name (name) "Replace all occurences of '\' with '/'." (when name - (let* ((new-name (flymake-replace-regexp-in-string "[\\]" "/" (expand-file-name name))) - (last-char (elt new-name (1- (length new-name))))) - (setq new-name (flymake-replace-regexp-in-string "\\./" "" new-name)) - (if (equal "/" (char-to-string last-char)) - (setq new-name (substring new-name 0 (1- (length new-name))))) - new-name))) + (setq name (expand-file-name name)) + (setq name (abbreviate-file-name name)) + (setq name (directory-file-name name)) + name)) (defun flymake-same-files (file-name-one file-name-two) "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. @@ -361,43 +352,6 @@ (equal (flymake-fix-file-name file-name-one) (flymake-fix-file-name file-name-two))) -(defun flymake-get-common-file-prefix (string-one string-two) - "Return common prefix for two file names STRING-ONE and STRING-TWO." - (setq string-one (file-name-as-directory string-one)) - (setq string-two (file-name-as-directory string-two)) - (let ((n (compare-strings string-one nil nil string-two nil nil))) - (if (eq n t) string-one - (setq n (abs (1+ n))) - (file-name-directory (substring string-one 0 n))))) - -(defun flymake-build-relative-filename (from-dir to-dir) - "Return rel: FROM-DIR/rel == TO-DIR." - ;; FIXME: Why not use `file-relative-name'? - (if (not (equal (elt from-dir 0) (elt to-dir 0))) - (error "First chars in file names %s, %s must be equal (same drive)" - from-dir to-dir) - (let* ((from (file-name-as-directory (flymake-fix-file-name from-dir))) - (to (file-name-as-directory (flymake-fix-file-name to-dir))) - (prefix (flymake-get-common-file-prefix from to)) - (from-suffix (substring from (length prefix))) - (up-count (length (flymake-split-string from-suffix "[/]"))) - (to-suffix (substring to (length prefix))) - (idx 0) - (rel nil)) - (if (and (> (length to-suffix) 0) (equal "/" (char-to-string (elt to-suffix 0)))) - (setq to-suffix (substring to-suffix 1))) - - (while (< idx up-count) - (if (> (length rel) 0) - (setq rel (concat rel "/"))) - (setq rel (concat rel "..")) - (setq idx (1+ idx))) - (if (> (length rel) 0) - (setq rel (concat rel "/"))) - (if (> (length to-suffix) 0) - (setq rel (concat rel to-suffix))) - (or rel "./")))) - (defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") "Dirs where to look for master files." :group 'flymake @@ -421,8 +375,7 @@ (done nil)) (while (and (not done) dirs) - (let* ((dir (concat (flymake-fix-file-name (file-name-directory file-name)) - "/" (car dirs))) + (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) (masks masks)) (while (and (file-exists-p dir) (not done) masks) (let* ((mask (car masks)) @@ -458,53 +411,58 @@ :group 'flymake :type 'integer) -(defun flymake-check-patch-master-file-buffer (master-file-temp-buffer - master-file-name patched-master-file-name - source-file-name patched-source-file-name - include-dirs regexp-list) +(defun flymake-check-patch-master-file-buffer + (master-file-temp-buffer + master-file-name patched-master-file-name + source-file-name patched-source-file-name + include-dirs regexp) "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. For .cpp master file this means it includes SOURCE-FILE-NAME (.h). If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME instead of SOURCE-FILE-NAME. Whether a buffer for MATER-FILE-NAME exists, use it as a source instead of reading master file from disk." - (let* ((found nil) - (regexp (format (nth 0 regexp-list) ; "[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" - (file-name-nondirectory source-file-name))) - (path-idx (nth 1 regexp-list)) - (name-idx (nth 2 regexp-list)) - (inc-path nil) + (let* ((source-file-nondir (file-name-nondirectory source-file-name)) + (found nil) (inc-name nil) (search-limit flymake-check-file-limit)) - (save-excursion - (unwind-protect - (progn - (set-buffer master-file-temp-buffer) - (when (> search-limit (point-max)) - (setq search-limit (point-max))) - (flymake-log 3 "checking %s against regexp %s" master-file-name regexp) - (goto-char (point-min)) - (while (and (< (point) search-limit) (re-search-forward regexp search-limit t)) - (let* ((match-beg (match-beginning name-idx)) - (match-end (match-end name-idx))) + (setq regexp + (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" + (regexp-quote source-file-nondir))) + (unwind-protect + (with-current-buffer master-file-temp-buffer + (when (> search-limit (point-max)) + (setq search-limit (point-max))) + (flymake-log 3 "checking %s against regexp %s" + master-file-name regexp) + (goto-char (point-min)) + (while (and (< (point) search-limit) + (re-search-forward regexp search-limit t)) + (let ((match-beg (match-beginning 1)) + (match-end (match-end 1))) - (flymake-log 3 "found possible match for %s" (file-name-nondirectory source-file-name)) - (setq inc-path (match-string path-idx)) - (setq inc-name (match-string name-idx)) - (when (string= inc-name (file-name-nondirectory source-file-name)) - (flymake-log 3 "inc-path=%s inc-name=%s" inc-path inc-name) - (when (flymake-check-include source-file-name inc-path inc-name include-dirs) - (setq found t) - ;; replace-match is not used here as it fails in - ;; XEmacs with 'last match not a buffer' error as - ;; check-includes calls replace-in-string - (flymake-replace-region match-beg match-end - (file-name-nondirectory patched-source-file-name)))) - (forward-line 1))) - (when found - (flymake-save-buffer-in-file patched-master-file-name))) - ;;+(flymake-log 3 "killing buffer %s" (buffer-name master-file-temp-buffer)) - (kill-buffer master-file-temp-buffer))) + (flymake-log 3 "found possible match for %s" source-file-nondir) + (setq inc-name (match-string 1)) + (when (eq t (compare-strings + source-file-nondir nil nil + inc-name (- (length inc-name) + (length source-file-nondir)) nil)) + (flymake-log 3 "inc-name=%s" inc-name) + (when (flymake-check-include source-file-name inc-name + include-dirs) + (setq found t) + ;; replace-match is not used here as it fails in + ;; XEmacs with 'last match not a buffer' error as + ;; check-includes calls replace-in-string + (flymake-replace-region + match-beg match-end + (file-name-nondirectory patched-source-file-name)))) + (forward-line 1))) + (when found + (flymake-save-buffer-in-file patched-master-file-name))) + ;;+(flymake-log 3 "killing buffer %s" + ;; (buffer-name master-file-temp-buffer)) + (kill-buffer master-file-temp-buffer)) ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) (when found (flymake-log 2 "found master file %s" master-file-name)) @@ -533,23 +491,19 @@ (insert-buffer-substring buffer) (current-buffer))) -(defun flymake-check-include (source-file-name inc-path inc-name include-dirs) +(defun flymake-check-include (source-file-name inc-name include-dirs) "Check if SOURCE-FILE-NAME can be found in include path. -Return t if it can be found via include path using INC-PATH and INC-NAME." - (if (file-name-absolute-p inc-path) - (flymake-same-files source-file-name (concat inc-path "/" inc-name)) - (let* ((file-name nil) - (found nil)) - (while (and (not found) include-dirs) - (setq file-name (concat (file-name-directory source-file-name) - "/" (car include-dirs))) - (if (> (length inc-path) 0) - (setq file-name (concat file-name "/" inc-path))) - (setq file-name (concat file-name "/" inc-name)) - (when (flymake-same-files source-file-name file-name) - (setq found t)) - (setq include-dirs (cdr include-dirs))) - found))) +Return t if it can be found via include path using INC-NAME." + (if (file-name-absolute-p inc-name) + (flymake-same-files source-file-name inc-name) + (while (and include-dirs + (not (flymake-same-files + source-file-name + (concat (file-name-directory source-file-name) + "/" (car include-dirs) + "/" inc-name)))) + (setq include-dirs (cdr include-dirs))) + include-dirs)) (defun flymake-find-buffer-for-file (file-name) "Check if there exists a buffer visiting FILE-NAME. @@ -558,7 +512,7 @@ (if buffer-name (get-buffer buffer-name)))) -(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp-list) +(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) "Save SOURCE-FILE-NAME with a different name. Find master file, patch and save it." (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) @@ -583,7 +537,7 @@ source-file-name patched-source-file-name (funcall get-incl-dirs-f (file-name-directory master-file-name)) - include-regexp-list)) + include-regexp)) (setq idx (1+ idx))) (if found (list master-file-name patched-master-file-name) @@ -708,45 +662,31 @@ (defun flymake-er-get-line-err-info-list (err-info) (nth 1 err-info)) -;; getters/setters for line-err-info: (file, line, type, text). -(defun flymake-ler-make-ler (file line type text &optional full-file) - (list file line type text full-file)) - -(defun flymake-ler-get-file (line-err-info) - (nth 0 line-err-info)) - -(defun flymake-ler-get-line (line-err-info) - (nth 1 line-err-info)) - -(defun flymake-ler-get-type (line-err-info) - (nth 2 line-err-info)) - -(defun flymake-ler-get-text (line-err-info) - (nth 3 line-err-info)) - -(defun flymake-ler-get-full-file (line-err-info) - (nth 4 line-err-info)) +(defstruct (flymake-ler + (:constructor nil) + (:constructor flymake-ler-make-ler (file line type text &optional full-file))) + file line type text full-file) (defun flymake-ler-set-file (line-err-info file) (flymake-ler-make-ler file - (flymake-ler-get-line line-err-info) - (flymake-ler-get-type line-err-info) - (flymake-ler-get-text line-err-info) - (flymake-ler-get-full-file line-err-info))) + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) (defun flymake-ler-set-full-file (line-err-info full-file) - (flymake-ler-make-ler (flymake-ler-get-file line-err-info) - (flymake-ler-get-line line-err-info) - (flymake-ler-get-type line-err-info) - (flymake-ler-get-text line-err-info) + (flymake-ler-make-ler (flymake-ler-file line-err-info) + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) full-file)) (defun flymake-ler-set-line (line-err-info line) - (flymake-ler-make-ler (flymake-ler-get-file line-err-info) + (flymake-ler-make-ler (flymake-ler-file line-err-info) line - (flymake-ler-get-type line-err-info) - (flymake-ler-get-text line-err-info) - (flymake-ler-get-full-file line-err-info))) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) (defun flymake-get-line-err-count (line-err-info-list type) "Return number of errors of specified TYPE. @@ -756,7 +696,7 @@ (err-count 0)) (while (< idx count) - (when (equal type (flymake-ler-get-type (nth idx line-err-info-list))) + (when (equal type (flymake-ler-type (nth idx line-err-info-list))) (setq err-count (1+ err-count))) (setq idx (1+ idx))) err-count)) @@ -855,7 +795,7 @@ (line-end (flymake-line-end-position)) (beg line-beg) (end line-end) - (tooltip-text (flymake-ler-get-text (nth 0 line-err-info-list))) + (tooltip-text (flymake-ler-text (nth 0 line-err-info-list))) (face nil)) (goto-char line-beg) @@ -898,7 +838,7 @@ (setq line-err-info (flymake-parse-line (nth idx lines))) (when line-err-info (setq real-file-name (funcall get-real-file-name-f - (flymake-ler-get-file line-err-info))) + (flymake-ler-file line-err-info))) (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) (if (flymake-same-files real-file-name source-file-name) @@ -1030,12 +970,12 @@ '(nil 0))) (defun flymake-line-err-info-is-less-or-equal (line-one line-two) - (or (string< (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) - (and (string= (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) - (not (flymake-ler-get-file line-one)) (flymake-ler-get-file line-two)) - (and (string= (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) - (or (and (flymake-ler-get-file line-one) (flymake-ler-get-file line-two)) - (and (not (flymake-ler-get-file line-one)) (not (flymake-ler-get-file line-two))))))) + (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) + (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) (defun flymake-add-line-err-info (line-err-info-list line-err-info) "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. @@ -1058,7 +998,7 @@ Returns the updated value of ERR-INFO-LIST. For the format of ERR-INFO-LIST, see `flymake-err-info'. For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." - (let* ((line-no (if (flymake-ler-get-file line-err-info) 1 (flymake-ler-get-line line-err-info))) + (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) (info-and-pos (flymake-find-err-info err-info-list line-no)) (exists (car info-and-pos)) (pos (nth 1 info-and-pos)) @@ -1094,7 +1034,7 @@ (inc-count (length inc-lines))) (while (> inc-count 0) (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) - (setq inc-dirs (cons (flymake-replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))) + (push (flymake-replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) (setq inc-count (1- inc-count))))) (flymake-add-project-include-dirs-to-cache basedir inc-dirs) inc-dirs))) @@ -1248,11 +1188,12 @@ (defun flymake-on-timer-event (buffer) "Start a syntax check for buffer BUFFER if necessary." - (when (bufferp buffer) + (when (buffer-live-p buffer) (with-current-buffer buffer (when (and (not flymake-is-running) flymake-last-change-time - (> (flymake-float-time) (+ flymake-no-changes-timeout flymake-last-change-time))) + (> (- (flymake-float-time) flymake-last-change-time) + flymake-no-changes-timeout)) (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") @@ -1260,10 +1201,7 @@ (defun flymake-current-line-no () "Return number of current line in current buffer." - (interactive) - (let ((beg (point-min)) - (end (if (= (point) (point-max)) (point) (1+ (point))))) - (count-lines beg end))) + (count-lines (point-min) (if (eobp) (point) (1+ (point))))) (defun flymake-count-lines () "Return number of lines in buffer BUFFER." @@ -1291,10 +1229,10 @@ (let* ((count (length line-err-info-list)) (menu-item-text nil)) (while (> count 0) - (setq menu-item-text (flymake-ler-get-text (nth (1- count) line-err-info-list))) - (let* ((file (flymake-ler-get-file (nth (1- count) line-err-info-list))) - (full-file (flymake-ler-get-full-file (nth (1- count) line-err-info-list))) - (line (flymake-ler-get-line (nth (1- count) line-err-info-list)))) + (setq menu-item-text (flymake-ler-text (nth (1- count) line-err-info-list))) + (let* ((file (flymake-ler-file (nth (1- count) line-err-info-list))) + (full-file (flymake-ler-full-file (nth (1- count) line-err-info-list))) + (line (flymake-ler-line (nth (1- count) line-err-info-list)))) (if file (setq menu-item-text (concat menu-item-text " - " file "(" (format "%d" line) ")"))) (setq menu-items (cons (list menu-item-text @@ -1549,8 +1487,7 @@ (defun flymake-delete-temp-directory (dir-name) "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." (let* ((temp-dir (flymake-get-temp-dir)) - (suffix (substring dir-name (1+ (length temp-dir)))) - (slash-pos nil)) + (suffix (substring dir-name (1+ (length temp-dir))))) (while (> (length suffix) 0) (setq suffix (directory-file-name suffix)) @@ -1653,8 +1590,7 @@ "Find buildfile, store its dir in buffer data and return its dir, if found." (let* ((buildfile-dir (flymake-find-buildfile buildfile-name - (file-name-directory source-file-name) - flymake-buildfile-dirs))) + (file-name-directory source-file-name)))) (if buildfile-dir (setq flymake-base-dir buildfile-dir) (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) @@ -1662,14 +1598,14 @@ "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name))))) -(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp-list) +(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) "Find master file (or buffer), create it's copy along with a copy of the source file." (let* ((source-file-name buffer-file-name) (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) (master-and-temp-master (flymake-create-master-file source-file-name temp-source-file-name get-incl-dirs-f create-temp-f - master-file-masks include-regexp-list))) + master-file-masks include-regexp))) (if (not master-and-temp-master) (progn @@ -1686,16 +1622,14 @@ ;;;; make-specific init-cleanup routines (defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) "Create a command line for syntax check using GET-CMD-LINE-F." - (let* ((my-base-dir base-dir) - (my-source source-file-name)) - - (when use-relative-base-dir - (setq my-base-dir (flymake-build-relative-filename (file-name-directory source-file-name) base-dir))) - - (when use-relative-source - (setq my-source (concat (flymake-build-relative-filename base-dir (file-name-directory source-file-name)) - (file-name-nondirectory source-file-name)))) - (funcall get-cmd-line-f my-source my-base-dir))) + (funcall get-cmd-line-f + (if use-relative-source + (file-relative-name source-file-name base-dir) + source-file-name) + (if use-relative-base-dir + (file-relative-name base-dir + (file-name-directory source-file-name)) + base-dir))) (defun flymake-get-make-cmdline (source base-dir) (list "make" @@ -1729,12 +1663,12 @@ (defun flymake-simple-make-init () (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) -(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp-list) +(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) "Create make command line for a source file checked via master file compilation." (let* ((make-args nil) (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy get-incl-dirs-f 'flymake-create-temp-inplace - master-file-masks include-regexp-list))) + master-file-masks include-regexp))) (when temp-master-file-name (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) (if buildfile-dir @@ -1743,13 +1677,13 @@ make-args)) (defun flymake-find-make-buildfile (source-dir) - (flymake-find-buildfile "Makefile" source-dir flymake-buildfile-dirs)) + (flymake-find-buildfile "Makefile" source-dir)) ;;;; .h/make specific (defun flymake-master-make-header-init () (flymake-master-make-init 'flymake-get-include-dirs '("\\.cpp\\'" "\\.c\\'") - '("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2))) + "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) ;;;; .java/make specific (defun flymake-simple-make-java-init () @@ -1769,10 +1703,9 @@ (defun flymake-perl-init () (let* ((temp-file (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)) - (local-file (concat (flymake-build-relative-filename - (file-name-directory buffer-file-name) - (file-name-directory temp-file)) - (file-name-nondirectory temp-file)))) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) (list "perl" (list "-wc " local-file)))) ;;;; tex-specific init-cleanup routines @@ -1787,7 +1720,7 @@ (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace '("\\.tex\\'") - '("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2)))) + "[ \t]*\\input[ \t]*{\\(.*%s\\)}"))) (when temp-master-file-name (flymake-get-tex-args temp-master-file-name))))
--- a/lisp/progmodes/gud.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/progmodes/gud.el Thu Jan 12 11:20:02 2006 +0000 @@ -3139,7 +3139,7 @@ (defun gdb-script-skip-to-head () "We're just in front of an `end' and we need to go to its head." - (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\)\\>" nil 'move) + (while (and (re-search-backward "^\\s-*\\(\\(end\\)\\|define\\|document\\|if\\|while\\|commands\\)\\>" nil 'move) (match-end 2)) (gdb-script-skip-to-head))) @@ -3158,7 +3158,7 @@ (forward-line 0) (skip-chars-forward " \t") (+ (current-indentation) - (if (looking-at "\\(if\\|while\\|define\\|else\\)\\>") + (if (looking-at "\\(if\\|while\\|define\\|else\\|commands\\)\\>") gdb-script-basic-indent 0))))) (defun gdb-script-indent-line ()
--- a/lisp/progmodes/ld-script.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/progmodes/ld-script.el Thu Jan 12 11:20:02 2006 +0000 @@ -126,6 +126,8 @@ ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ld[s]?\\(\\.in\\)?$" . ld-script-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.x[bdsru]?[cn]?$" . ld-script-mode)) ;;;###autoload (define-derived-mode ld-script-mode nil "LD-Script"
--- a/lisp/progmodes/tcl.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/progmodes/tcl.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,6 +1,6 @@ ;;; tcl.el --- Tcl code editing commands for Emacs -;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +;; Copyright (C) 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -682,16 +682,9 @@ 5. Create an empty comment. 6. Move backward to start of comment, indenting if necessary." (interactive "p") - (cond - ((not tcl-tab-always-indent) - ;; Indent if in indentation area, otherwise insert TAB. - (if (<= (current-column) (current-indentation)) - (tcl-indent-line) - (insert-tab arg))) - ((eq tcl-tab-always-indent t) - ;; Always indent. - (tcl-indent-line)) - (t + (if (memq tcl-tab-always-indent '(nil t)) + (let ((tab-always-indent tcl-tab-always-indent)) + (call-interactively 'indent-for-tab-command)) ;; "Perl-mode" style TAB command. (let* ((ipoint (point)) (eolpoint (progn @@ -730,7 +723,7 @@ ;; Go to start of comment. We don't leave point where it is ;; because we want to skip comment-start-skip. (tcl-indent-line) - (indent-for-comment))))))) + (indent-for-comment)))))) (defun tcl-indent-line () "Indent current line as Tcl code. @@ -739,29 +732,28 @@ beg shift-amt (case-fold-search nil) (pos (- (point-max) (point)))) - (beginning-of-line) - (setq beg (point)) - (cond ((eq indent nil) - (setq indent (current-indentation))) - (t - (skip-chars-forward " \t") - (if (listp indent) (setq indent (car indent))) - (cond ((= (following-char) ?}) - (setq indent (- indent tcl-indent-level))) - ((= (following-char) ?\]) - (setq indent (- indent 1)))))) - (skip-chars-forward " \t") - (setq shift-amt (- indent (current-column))) - (if (zerop shift-amt) - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) - (delete-region beg (point)) - (indent-to indent) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))) - shift-amt)) + (if (null indent) + 'noindent + (beginning-of-line) + (setq beg (point)) + (skip-chars-forward " \t") + (if (listp indent) (setq indent (car indent))) + (cond ((= (following-char) ?}) + (setq indent (- indent tcl-indent-level))) + ((= (following-char) ?\]) + (setq indent (- indent 1)))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt))) (defun tcl-figure-type () "Determine type of sexp at point.
--- a/lisp/reveal.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/reveal.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,7 +1,7 @@ ;;; reveal.el --- Automatically reveal hidden text at point ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: outlines @@ -75,99 +75,109 @@ ;; - we only refresh spots in the current window. ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? (with-local-quit - (condition-case err - (let ((old-ols (delq nil - (mapcar - (lambda (x) - ;; We refresh any spot in the current window as - ;; well as any spots associated with a dead - ;; window or a window which does not show this - ;; buffer any more. - (if (or (eq (car x) (selected-window)) - (not (window-live-p (car x))) - (not (eq (window-buffer (car x)) - (current-buffer)))) - (cdr x))) - reveal-open-spots))) - (repeat t)) - ;; Open new overlays. - (while repeat - (setq repeat nil) - (dolist (ol (nconc (when (and reveal-around-mark mark-active) - (overlays-at (mark))) - (overlays-at (point)))) - (setq old-ols (delq ol old-ols)) - (let ((inv (overlay-get ol 'invisible)) open) - (when (and inv - ;; There's an `invisible' property. Make sure it's - ;; actually invisible, and ellipsised. - (and (consp buffer-invisibility-spec) - (cdr (assq inv buffer-invisibility-spec))) - (or (setq open - (or (overlay-get ol 'reveal-toggle-invisible) - (and (symbolp inv) - (get inv 'reveal-toggle-invisible)) - (overlay-get ol 'isearch-open-invisible-temporary))) - (overlay-get ol 'isearch-open-invisible) - (and (consp buffer-invisibility-spec) - (cdr (assq inv buffer-invisibility-spec)))) - (overlay-put ol 'reveal-invisible inv)) - (push (cons (selected-window) ol) reveal-open-spots) - (if (null open) - (progn ;; (debug) - (overlay-put ol 'invisible nil)) - ;; Use the provided opening function and repeat (since the - ;; opening function might have hidden a subpart around point). - (setq repeat t) - (condition-case err - (funcall open ol nil) - (error (message "!!Reveal-show (funcall %s %s nil): %s !!" - open ol err) - ;; Let's default to a meaningful behavior to avoid - ;; getting stuck in an infinite loop. - (setq repeat nil) - (overlay-put ol 'invisible nil)))))))) - ;; Close old overlays. - (if (not (eq reveal-last-tick - (setq reveal-last-tick (buffer-modified-tick)))) - ;; The buffer was modified since last command: let's refrain from - ;; closing any overlay because it tends to behave poorly when - ;; inserting text at the end of an overlay (basically the overlay - ;; should be rear-advance when it's open, but things like - ;; outline-minor-mode make it non-rear-advance because it's - ;; a better choice when it's closed). - nil - ;; The last command was only a point motion or some such - ;; non-buffer-modifying command. Let's close whatever can be closed. - (dolist (ol old-ols) - (if (and (>= (point) (save-excursion - (goto-char (overlay-start ol)) - (line-beginning-position 1))) - (<= (point) (save-excursion - (goto-char (overlay-end ol)) - (line-beginning-position 2))) - ;; If the application has moved the overlay to some other - ;; buffer, we'd better reset the buffer to its - ;; original state. - (eq (current-buffer) (overlay-buffer ol))) - ;; Still near the overlay: keep it open. - nil - ;; Really close it. - (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) - (if (or open - (and (setq inv (overlay-get ol 'reveal-invisible)) - (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))))) - (condition-case err - (funcall open ol t) - (error (message "!!Reveal-hide (funcall %s %s t): %s !!" - open ol err))) - (overlay-put ol 'invisible inv)) - ;; Remove the olverlay from the list of open spots. - (setq reveal-open-spots - (delq (rassoc ol reveal-open-spots) - reveal-open-spots))))))) - (error (message "Reveal: %s" err))))) + (condition-case err + (let ((old-ols + (delq nil + (mapcar + (lambda (x) + ;; We refresh any spot in the current window as well + ;; as any spots associated with a dead window or + ;; a window which does not show this buffer any more. + (cond + ((eq (car x) (selected-window)) (cdr x)) + ((not (eq (window-buffer (car x)) (current-buffer))) + ;; Adopt this since it's owned by a window that's + ;; either not live or at least not showing this + ;; buffer any more. + (setcar x (selected-window)) + (cdr x)))) + reveal-open-spots)))) + (setq old-ols (reveal-open-new-overlays old-ols)) + (reveal-close-old-overlays old-ols)) + (error (message "Reveal: %s" err))))) + +(defun reveal-open-new-overlays (old-ols) + (let ((repeat t)) + (while repeat + (setq repeat nil) + (dolist (ol (nconc (when (and reveal-around-mark mark-active) + (overlays-at (mark))) + (overlays-at (point)))) + (setq old-ols (delq ol old-ols)) + (let ((inv (overlay-get ol 'invisible)) open) + (when (and inv + ;; There's an `invisible' property. Make sure it's + ;; actually invisible, and ellipsised. + (and (consp buffer-invisibility-spec) + (cdr (assq inv buffer-invisibility-spec))) + (or (setq open + (or (overlay-get ol 'reveal-toggle-invisible) + (and (symbolp inv) + (get inv 'reveal-toggle-invisible)) + (overlay-get ol 'isearch-open-invisible-temporary))) + (overlay-get ol 'isearch-open-invisible) + (and (consp buffer-invisibility-spec) + (cdr (assq inv buffer-invisibility-spec)))) + (overlay-put ol 'reveal-invisible inv)) + (push (cons (selected-window) ol) reveal-open-spots) + (if (null open) + (overlay-put ol 'invisible nil) + ;; Use the provided opening function and repeat (since the + ;; opening function might have hidden a subpart around point). + (setq repeat t) + (condition-case err + (funcall open ol nil) + (error (message "!!Reveal-show (funcall %s %s nil): %s !!" + open ol err) + ;; Let's default to a meaningful behavior to avoid + ;; getting stuck in an infinite loop. + (setq repeat nil) + (overlay-put ol 'invisible nil))))))))) + old-ols) + +(defun reveal-close-old-overlays (old-ols) + (if (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick)))) + ;; The buffer was modified since last command: let's refrain from + ;; closing any overlay because it tends to behave poorly when + ;; inserting text at the end of an overlay (basically the overlay + ;; should be rear-advance when it's open, but things like + ;; outline-minor-mode make it non-rear-advance because it's + ;; a better choice when it's closed). + nil + ;; The last command was only a point motion or some such + ;; non-buffer-modifying command. Let's close whatever can be closed. + (dolist (ol old-ols) + (if (and (overlay-start ol) ;Check it's still live. + (>= (point) (save-excursion + (goto-char (overlay-start ol)) + (line-beginning-position 1))) + (<= (point) (save-excursion + (goto-char (overlay-end ol)) + (line-beginning-position 2))) + ;; If the application has moved the overlay to some other + ;; buffer, we'd better reset the buffer to its + ;; original state. + (eq (current-buffer) (overlay-buffer ol))) + ;; Still near the overlay: keep it open. + nil + ;; Really close it. + (let* ((inv (overlay-get ol 'reveal-invisible)) + (open (or (overlay-get ol 'reveal-toggle-invisible) + (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary)))) + (if (and (overlay-start ol) ;Check it's still live. + open) + (condition-case err + (funcall open ol t) + (error (message "!!Reveal-hide (funcall %s %s t): %s !!" + open ol err))) + (overlay-put ol 'invisible inv)) + ;; Remove the overlay from the list of open spots. + (overlay-put ol 'reveal-invisible nil) + (setq reveal-open-spots + (delq (rassoc ol reveal-open-spots) + reveal-open-spots))))))) (defvar reveal-mode-map (let ((map (make-sparse-keymap)))
--- a/lisp/startup.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/startup.el Thu Jan 12 11:20:02 2006 +0000 @@ -209,9 +209,10 @@ The value is nil if `-q' or `--no-init-file' was specified, meaning do not load any init file. -Otherwise, the value may be the null string, meaning use the init file -for the user that originally logged in, or it may be a -string containing a user's name meaning use that person's init file. +Otherwise, the value may be an empty string, meaning +use the init file for the user who originally logged in, +or it may be a string containing a user's name meaning +use that person's init file. In either of the latter cases, `(concat \"~\" init-file-user \"/\")' evaluates to the name of the directory where the `.emacs' file was
--- a/lisp/textmodes/bibtex.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/textmodes/bibtex.el Thu Jan 12 11:20:02 2006 +0000 @@ -3539,7 +3539,7 @@ (dolist (key (cdr (assq buffer buffer-key-list))) (when (assoc-string key current-keys) (bibtex-find-entry key) - (push (format "%s:%d: Duplicat key `%s' in %s\n" + (push (format "%s:%d: Duplicate key `%s' in %s\n" (buffer-file-name) (bibtex-current-line) key (abbreviate-file-name (buffer-file-name buffer))) error-list))))))
--- a/lisp/textmodes/tildify.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/textmodes/tildify.el Thu Jan 12 11:20:02 2006 +0000 @@ -29,7 +29,7 @@ ;; This package can be typically used for adding forgotten tildes in TeX ;; sources or adding ` ' sequences in SGML (e.g. HTML) texts. ;; -;; For example, the Czech ortography requires avoiding one letter +;; For example, the Czech orthography requires avoiding one letter ;; prepositions at line endings. So they should be connected with the ;; following words by a tilde. Some users forget to do this all the ;; time. The purpose of this program is to check the text and suggest @@ -43,7 +43,7 @@ ;; The default variable settings are suited for Czech, so do not try to ;; understand them if you are not familiar with Czech grammar and spelling. ;; -;; The algorithm was inspired by Petr Ol¹įk's program `vlna'. Abbilities of +;; The algorithm was inspired by Petr Ol¹įk's program `vlna'. Abilities of ;; `tildify.el' are a little limited; if you have improvement suggestions, let ;; me know.
--- a/lisp/url/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/url/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,10 @@ +2006-01-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * url.el (url-retrieve-synchronously): Adjust the workaround so as not + to stop in the middle of a redirection. + + * url-vars.el (url-privacy-level): Add setter. + 2006-01-05 Stefan Monnier <monnier@iro.umontreal.ca> * url-history.el (url-history-hash-table): Initialize in declaration.
--- a/lisp/url/url-privacy.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/url/url-privacy.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,7 +1,7 @@ ;;; url-privacy.el --- Global history tracking for URL package ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -33,6 +33,7 @@ ;;;###autoload (defun url-setup-privacy-info () + "Setup variables that expose info about you and your system." (interactive) (setq url-system-type (cond @@ -72,13 +73,11 @@ (and (listp url-privacy-level) (memq 'os url-privacy-level))) nil) - ((boundp 'system-configuration) - system-configuration) - ((boundp 'system-type) - (symbol-name system-type)) + ((boundp 'system-configuration) system-configuration) + ((boundp 'system-type) (symbol-name system-type)) (t nil)))) (provide 'url-privacy) -;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d +;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d ;;; url-privacy.el ends here
--- a/lisp/url/url-vars.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/url/url-vars.el Thu Jan 12 11:20:02 2006 +0000 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005 Free Software Foundation, Inc. +;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -112,9 +112,8 @@ :type 'string :group 'url-file) -;; Fixme: this should have a setter which calls url-setup-privacy-info. (defcustom url-privacy-level '(email) - "*How private you want your requests to be. + "How private you want your requests to be. HTTP has header fields for various information about the user, including operating system information, email addresses, the last page you visited, etc. This variable controls how much of this information is sent. @@ -144,6 +143,8 @@ This variable controls several other variables and is _NOT_ automatically updated. Call the function `url-setup-privacy-info' after modifying this variable." + :initialize 'custom-initialize-default + :set (lambda (sym val) (set-default sym val) (url-setup-privacy-info)) :type '(radio (const :tag "None (you believe in the basic goodness of humanity)" :value none) (const :tag "Low (do not reveal last location)" @@ -278,7 +279,7 @@ (defvar url-package-version nil "Version number of package using URL.") -(defvar url-package-name nil "Version number of package using URL.") +(defvar url-package-name nil "Name of package using URL.") (defvar url-system-type nil "What type of system we are on.")
--- a/lisp/url/url.el Wed Jan 11 14:51:51 2006 +0000 +++ b/lisp/url/url.el Thu Jan 12 11:20:02 2006 +0000 @@ -190,11 +190,14 @@ "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) (if (and proc (memq (process-status proc) - '(closed exit signal failed))) + '(closed exit signal failed)) + ;; Make sure another process hasn't been started, as can + ;; happen with http redirections. + (eq proc (or (get-buffer-process asynch-buffer) proc))) ;; FIXME: It's not clear whether url-retrieve's callback is ;; guaranteed to be called or not. It seems that url-http ;; decides sometimes consciously not to call it, so it's not - ;; clear that it's a bug, but even if we need to decide how + ;; clear that it's a bug, but even then we need to decide how ;; url-http can then warn us that the download has completed. ;; In the mean time, we use this here workaround. (setq retrieval-done t)
--- a/lispref/display.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/lispref/display.texi Thu Jan 12 11:20:02 2006 +0000 @@ -1099,7 +1099,7 @@ beginning and end. It also has properties that you can examine and set; these affect the display of the text within the overlay. -An overlays uses markers to record its beginning and end; thus, +An overlay uses markers to record its beginning and end; thus, editing the text of the buffer adjusts the beginning and end of each overlay so that it stays with the text. When you create the overlay, you can specify whether text inserted at the beginning should be @@ -1737,7 +1737,7 @@ different kinds of terminals. It should be an alist whose elements have the form @code{(@var{display} @var{atts})}. Each element's @sc{car}, @var{display}, specifies a class of terminals. (The first -element, if it s @sc{car} is @code{default}, is special---it specifies +element, if its @sc{car} is @code{default}, is special---it specifies defaults for the remaining elements). The element's @sc{cadr}, @var{atts}, is a list of face attributes and their values; it specifies what the face should look like on that kind of terminal. @@ -4258,8 +4258,8 @@ For convenience, there are two sorts of button-creation functions, those that add button properties to an existing region of a buffer, -called @code{make-...button}, and those also insert the button text, -called @code{insert-...button}. +called @code{make-...button}, and those that also insert the button +text, called @code{insert-...button}. The button-creation functions all take the @code{&rest} argument @var{properties}, which should be a sequence of @var{property value}
--- a/lispref/keymaps.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/lispref/keymaps.texi Thu Jan 12 11:20:02 2006 +0000 @@ -569,7 +569,7 @@ text or overlay property. If that is non-@code{nil}, it is the first keymap to be processed, in normal circumstances. - However, there are also special ways for program can to substitute + However, there are also special ways for programs to substitute other keymaps for some of those. The variable @code{overriding-local-map}, if non-@code{nil}, specifies a keymap that replaces all the usual active keymaps except the global keymap.
--- a/lispref/modes.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/lispref/modes.texi Thu Jan 12 11:20:02 2006 +0000 @@ -1423,7 +1423,7 @@ @end defmac The initial value must be @code{nil} except in cases where (1) the -mode is preloaded in Emacs, or (2) it is painless to for loading to +mode is preloaded in Emacs, or (2) it is painless for loading to enable the mode even though the user did not request it. For instance, if the mode has no effect unless something else is enabled, and will always be loaded by that time, enabling it by default is @@ -2254,7 +2254,7 @@ finds the next ``definition'' to put in the buffer index, scanning backward in the buffer from point. It should return @code{nil} if it doesn't find another ``definition'' before point. Otherwise it should -leave point at the place it finds a ``definition,'' and return any +leave point at the place it finds a ``definition'' and return any non-@code{nil} value. Setting this variable makes it buffer-local in the current buffer.
--- a/lispref/positions.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/lispref/positions.texi Thu Jan 12 11:20:02 2006 +0000 @@ -417,7 +417,7 @@ @defun line-number-at-pos &optional pos @cindex line number This function returns the line number in the current buffer -corresponding the buffer position @var{pos}. If @var{pos} is @code{nil} +corresponding to the buffer position @var{pos}. If @var{pos} is @code{nil} or omitted, the current buffer position is used. @end defun
--- a/lispref/text.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/lispref/text.texi Thu Jan 12 11:20:02 2006 +0000 @@ -2714,7 +2714,7 @@ @defun remove-list-of-text-properties start end list-of-properties &optional object Like @code{remove-text-properties} except that -@var{list-of-properties} is a list property names only, not an +@var{list-of-properties} is a list of property names only, not an alternating list of property names and values. @end defun
--- a/man/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/man/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,39 @@ +2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (RSS): Document nnrss-wash-html-in-text-plain-parts. + +2006-01-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (RSS): Addition. + +2005-12-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Summary Post Commands): Fix function bound to `S O p'. + +2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-mime.texi (Display Customization): Add setting example to + mm-discouraged-alternatives. + +2006-01-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * flymake.texi (Obtaining Flymake): Remove chapter since Emacs's + version is the canonical version. + +2006-01-08 Alex Schroeder <alex@gnu.org> + + * pgg.texi (Caching passphrase): Rewording. + +2006-01-06 Eli Zaretskii <eliz@gnu.org> + + * flymake.texi (Obtaining Flymake): Update Flymake's CVS + repository URL. + +2006-01-06 Carsten Dominik <dominik@science.uva.nl> + + * org.texi: Removed the accidentally re-added empty line in the + direntry. + 2006-01-05 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * macos.texi (Mac International): Undo last change.
--- a/man/emacs-mime.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/man/emacs-mime.texi Thu Jan 12 11:20:02 2006 +0000 @@ -323,10 +323,28 @@ @end lisp Adding @code{"image/.*"} might also be useful. Spammers use it as the -prefered part of @samp{multipart/alternative} messages. See also +prefered part of @samp{multipart/alternative} messages, and you might +not notice there are other parts. See also @code{gnus-buttonized-mime-types} (@pxref{MIME Commands, ,MIME Commands, gnus, Gnus Manual}), to which adding @code{"multipart/alternative"} enables you to choose manually one of two types those mails include. +For example, you can set those variables like: + +@lisp +(setq gnus-buttonized-mime-types + '("multipart/alternative" "multipart/signed") + mm-discouraged-alternatives + '("text/html" "image/.*")) +@end lisp + +In this case, Gnus will display radio buttons for such a kind of spam +message as follows: + +@example +1. (*) multipart/alternative ( ) image/gif + +2. (*) text/plain ( ) text/html +@end example @item mm-inline-large-images @vindex mm-inline-large-images
--- a/man/flymake.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/man/flymake.texi Thu Jan 12 11:20:02 2006 +0000 @@ -11,7 +11,7 @@ This manual is for GNU Flymake (version @value{VERSION}, @value{UPDATED}), which is a universal on-the-fly syntax checker for GNU Emacs. -Copyright @copyright{} 2004, 2005 Free Software Foundation, Inc. +Copyright @copyright{} 2004, 2005, 2006 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -55,7 +55,6 @@ @menu * Overview of Flymake:: -* Obtaining Flymake:: * Installing Flymake:: * Using Flymake:: * Configuring Flymake:: @@ -104,16 +103,6 @@ extended to support new syntax check tools and error message patterns. @xref{Configuring Flymake}. -@node Obtaining Flymake -@chapter Obtaining Flymake -@cindex Getting Flymake - -Release versions of Flymake can be downloaded from -@* @url{https://sourceforge.net/project/showfiles.php?group_id=77501}. -You can also try current version available via CVS at @url{https://}. - -Flymake's homepage is at @url{http://flymake.sourceforge.net}. - @node Installing Flymake @chapter Installing @cindex Installing Flymake
--- a/man/gnus.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/man/gnus.texi Thu Jan 12 11:20:02 2006 +0000 @@ -5491,7 +5491,7 @@ @cindex digests @cindex making digests Digest the current series and forward the result to a newsgroup -(@code{gnus-uu-digest-mail-forward}). This command uses the +(@code{gnus-uu-digest-post-forward}). This command uses the process/prefix convention. @item S u @@ -15886,6 +15886,10 @@ XEmacs and want to use non-@acronym{ASCII} group names, you should set the value for the @code{nnmail-pathname-coding-system} variable properly. +The @code{nnrss} back end generates @samp{multipart/alternative} +@acronym{MIME} articles in which each contains a @samp{text/plain} part +and a @samp{text/html} part. + @cindex OPML You can also use the following commands to import and export your subscriptions from a file in @acronym{OPML} format (Outline Processor @@ -15923,6 +15927,15 @@ the feeds from local files in @code{nnrss-directory}. You can use the command @code{nnrss-generate-download-script} to generate a download script using @command{wget}. + +@item nnrss-wash-html-in-text-plain-parts +Non-@code{nil} means that @code{nnrss} renders text in @samp{text/plain} +parts as @acronym{HTML}. The function specified by the +@code{mm-text-html-renderer} variable (@pxref{Display Customization, +,Display Customization, emacs-mime, The Emacs MIME Manual}) will be used +to render text. If it is @code{nil}, which is the default, text will +simply be folded. Leave it @code{nil} if you prefer to see +@samp{text/html} parts. @end table The following code may be helpful, if you want to show the description in @@ -15940,6 +15953,7 @@ The following code may be useful to open an nnrss url directly from the summary buffer. + @lisp (require 'browse-url) @@ -15962,6 +15976,31 @@ (add-to-list 'nnmail-extra-headers nnrss-url-field) @end lisp +Even if you have added @code{"text/html"} to the +@code{mm-discouraged-alternatives} variable (@pxref{Display +Customization, ,Display Customization, emacs-mime, The Emacs MIME +Manual}) since you don't want to see @acronym{HTML} parts, it might be +more useful especially in @code{nnrss} groups to display +@samp{text/html} parts. Here's an example of setting +@code{mm-discouraged-alternatives} as a group parameter (@pxref{Group +Parameters}) in order to display @samp{text/html} parts only in +@code{nnrss} groups: + +@lisp +;; @r{Set the default value of @code{mm-discouraged-alternatives}.} +(eval-after-load "gnus-sum" + '(add-to-list + 'gnus-newsgroup-variables + '(mm-discouraged-alternatives + . '("text/html" "image/.*")))) + +;; @r{Display @samp{text/html} parts in @code{nnrss} groups.} +(add-to-list + 'gnus-parameters + '("\\`nnrss:" (mm-discouraged-alternatives nil))) +@end lisp + + @node Customizing W3 @subsection Customizing W3 @cindex W3
--- a/man/org.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/man/org.texi Thu Jan 12 11:20:02 2006 +0000 @@ -10,7 +10,6 @@ @dircategory Emacs @direntry * Org Mode: (org). outline-based notes management and organizer - @end direntry @c Version and Contact Info
--- a/man/pgg.texi Wed Jan 11 14:51:51 2006 +0000 +++ b/man/pgg.texi Thu Jan 12 11:20:02 2006 +0000 @@ -225,8 +225,9 @@ @defvar pgg-cache-passphrase If non-@code{nil}, store passphrases. The default value of this -variable is @code{t}. If you were worry about security issue, however, -you could stop caching with setting it @code{nil}. +variable is @code{t}. If you are worried about security issues, +however, you could stop the caching of passphrases by setting this +variable to @code{nil}. @end defvar @defvar pgg-passphrase-cache-expiry
--- a/src/.gdbinit Wed Jan 11 14:51:51 2006 +0000 +++ b/src/.gdbinit Thu Jan 12 11:20:02 2006 +0000 @@ -1,4 +1,4 @@ -# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004, 2005 +# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998, 2000, 01, 2004, 2005, 2006 # Free Software Foundation, Inc. # # This file is part of GNU Emacs.
--- a/src/ChangeLog Wed Jan 11 14:51:51 2006 +0000 +++ b/src/ChangeLog Thu Jan 12 11:20:02 2006 +0000 @@ -1,3 +1,17 @@ +2006-01-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * fileio.c (Fexpand_file_name): Remove redundant tests. + Fix elimination of // so that it doesn't prevent elimination of an + immediately following /. or /.. + +2006-01-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * gtkutil.c (xg_toggle_notify_cb): New function. + (xg_toggle_visibility_cb): Move setting of x_gtk_show_hidden_files to + xg_toggle_notify_cb. + (xg_get_file_with_chooser): Add callback to xg_toggle_notify_cb when + parameter value changes so the toggle button gets updated. + 2006-01-06 Nick Roberts <nickrob@snap.net.nz> * .gdbinit: Fix typo.
--- a/src/fileio.c Wed Jan 11 14:51:51 2006 +0000 +++ b/src/fileio.c Thu Jan 12 11:20:02 2006 +0000 @@ -1,7 +1,7 @@ /* File IO for GNU Emacs. Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1646,8 +1646,7 @@ { *o++ = *p++; } - else if (IS_DIRECTORY_SEP (p[0]) - && p[1] == '.' + else if (p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) { @@ -1657,7 +1656,7 @@ *o++ = *p; p += 2; } - else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' + else if (p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. Turned off on DOS_NT systems because they have no "superroot" and because this causes us to produce @@ -1677,14 +1676,9 @@ ++o; p += 3; } - else if (p > target - && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) - { - /* Collapse multiple `/' in a row. */ - *o++ = *p++; - while (IS_DIRECTORY_SEP (*p)) - ++p; - } + else if (p > target && IS_DIRECTORY_SEP (p[1])) + /* Collapse multiple `/' in a row. */ + p++; else { *o++ = *p++;
--- a/src/gtkutil.c Wed Jan 11 14:51:51 2006 +0000 +++ b/src/gtkutil.c Thu Jan 12 11:20:02 2006 +0000 @@ -1220,6 +1220,9 @@ return gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (w)); } +/* Callback called when the "Show hidden files" toggle is pressed. + WIDGET is the toggle widget, DATA is the file chooser dialog. */ + static void xg_toggle_visibility_cb (widget, data) GtkWidget *widget; @@ -1227,10 +1230,47 @@ { GtkFileChooser *dialog = GTK_FILE_CHOOSER (data); gboolean visible; - extern int x_gtk_show_hidden_files; g_object_get (G_OBJECT (dialog), "show-hidden", &visible, NULL); g_object_set (G_OBJECT (dialog), "show-hidden", !visible, NULL); - x_gtk_show_hidden_files = !visible; +} + + +/* Callback called when a property changes in a file chooser. + GOBJECT is the file chooser dialog, ARG1 describes the property. + USER_DATA is the toggle widget in the file chooser dialog. + We use this to update the "Show hidden files" toggle when the user + changes that property by right clicking in the file list. */ + +static void +xg_toggle_notify_cb (gobject, arg1, user_data) + GObject *gobject; + GParamSpec *arg1; + gpointer user_data; +{ + extern int x_gtk_show_hidden_files; + + if (strcmp (arg1->name, "show-hidden") == 0) + { + GtkFileChooser *dialog = GTK_FILE_CHOOSER (gobject); + GtkWidget *wtoggle = GTK_WIDGET (user_data); + gboolean visible, toggle_on; + + g_object_get (G_OBJECT (gobject), "show-hidden", &visible, NULL); + toggle_on = gtk_toggle_button_get_active (GTK_TOGGLE_BUTTON (wtoggle)); + + if (!!visible != !!toggle_on) + { + g_signal_handlers_block_by_func (G_OBJECT (wtoggle), + G_CALLBACK (xg_toggle_visibility_cb), + gobject); + gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (wtoggle), visible); + g_signal_handlers_unblock_by_func + (G_OBJECT (wtoggle), + G_CALLBACK (xg_toggle_visibility_cb), + gobject); + } + x_gtk_show_hidden_files = visible; + } } /* Read a file name from the user using a file chooser dialog. @@ -1283,7 +1323,9 @@ } gtk_widget_show (wtoggle); g_signal_connect (G_OBJECT (wtoggle), "clicked", - G_CALLBACK (xg_toggle_visibility_cb), G_OBJECT(filewin)); + G_CALLBACK (xg_toggle_visibility_cb), filewin); + g_signal_connect (G_OBJECT (filewin), "notify", + G_CALLBACK (xg_toggle_notify_cb), wtoggle); message[0] = '\0'; if (action != GTK_FILE_CHOOSER_ACTION_SAVE)