Mercurial > emacs
changeset 82907:92ccd83174e6
Merge from emacs--rel--22
Patches applied:
* emacs--rel--22 (patch 97-100)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 246-247)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-860
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Mon, 27 Aug 2007 04:00:19 +0000 |
| parents | 69b183268e31 (current diff) 24374b4e3454 (diff) |
| children | 31119bf4489e |
| files | README admin/FOR-RELEASE etc/ChangeLog etc/NEWS.22 etc/README lib-src/ChangeLog lisp/ChangeLog lisp/dframe.el lisp/emacs-lisp/byte-opt.el lisp/emacs-lisp/bytecomp.el lisp/emacs-lisp/edebug.el lisp/gnus/ChangeLog lisp/gnus/mml.el lisp/net/socks.el lisp/pcvs.el lisp/progmodes/cperl-mode.el lisp/simple.el lisp/textmodes/texinfmt.el lisp/uniquify.el lisp/vc.el lispref/ChangeLog lispref/display.texi man/ChangeLog man/message.texi src/ChangeLog src/lread.c |
| diffstat | 35 files changed, 666 insertions(+), 522 deletions(-) [+] |
line wrap: on
line diff
--- a/README Mon Aug 27 03:36:34 2007 +0000 +++ b/README Mon Aug 27 04:00:19 2007 +0000 @@ -76,7 +76,7 @@ `man' holds the source code for the Emacs Manual. If you modify the manual sources, you will need the `makeinfo' program to produce an updated manual. `makeinfo' is part of the GNU Texinfo - package; you need version 4.2 or later of Texinfo. + package; you need version 4.6 or later of Texinfo. `lispref' holds the source code for the Emacs Lisp reference manual. `lispintro' holds the source code for the Introduction to Programming in Emacs Lisp manual.
--- a/admin/FOR-RELEASE Mon Aug 27 03:36:34 2007 +0000 +++ b/admin/FOR-RELEASE Mon Aug 27 04:00:19 2007 +0000 @@ -38,6 +38,13 @@ ** henman@it.to-be.co.jp 09 Aug 2006: ispell.el problem on Cygwin. (Did we decide that is unreproducible?) +** set-frame-size for frame without minibuffer loses mode line +Probably a Windows only bug. Reported by Drew Adams on bug-gnu-emacs on +2007-08-07. It seems that the bug manifests itself only if resizing the +frame makes the menu bar wrap before. On 2007-08-16 Glenn Morris +reported on emacs-devel that he was not able to reproduce the bug on a +GNU/Linux system. + * BUGS NB the definitive copy of this file for Emacs 22 is on the @@ -52,14 +59,9 @@ * FIXES FOR EMACS 22.3 -Here we list small fixes that arrived too late for Emacs 22.2, but +Here we list any small fixes that arrived too late for Emacs 22.2, but that should be installed on the release branch after 22.2 is released. -** bojohan+news@dd.chalmers.se, 1 Aug: n_schumacher@web.de: modification hooks called only once in -Fix is on the trunk: 2007-08-13 change to insdel.c by Stefan Monnier. -http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00457.html - - * DOCUMENTATION ** Check the Emacs Tutorial.
--- a/etc/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/etc/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -56,7 +56,7 @@ (\versionyear): update to 2007. (\copyrightnotice): modified or unmodified ok. (Simple Customization): don't use goto-line, since now it's bound. - Also, use now-preferred (kbd ...) syntax. +^ Also, use now-preferred (kbd ...) syntax. 2007-08-22 Michael Albinus <michael.albinus@gmx.de>
--- a/etc/NEWS.22 Mon Aug 27 03:36:34 2007 +0000 +++ b/etc/NEWS.22 Mon Aug 27 04:00:19 2007 +0000 @@ -41,6 +41,8 @@ * Changes in Emacs 22.2 +** `browse-url-emacs' loads a URL into an Emacs buffer. Handy for *.el URLs. + ** `bad-packages-alist' will warn about external packages that are known to cause problems in this version of Emacs. @@ -79,6 +81,14 @@ * Lisp Changes in Emacs 22.2. +** The function invisible-p returns non-nil if the character + after a specified position is invisible. + ++++ +** inhibit-modification-hooks is bound to t while running modification hooks. +As a happy consequence, after-change-functions and before-change-functions +are not bound to nil any more while running an (after|before)-change-function. + ** New function `window-full-width-p' returns t if a window is as wide as its frame.
--- a/etc/README Mon Aug 27 03:36:34 2007 +0000 +++ b/etc/README Mon Aug 27 04:00:19 2007 +0000 @@ -10,8 +10,35 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES +The files splash.xpm, splash8.xpm contain copyright and license +information, but it is reproduced here for convenience. + +Files: splash.pbm, splash.xpm, splash8.xpm, gnus.pbm, gnus-logo.eps + Author: Luis Fernandes <elf@ee.ryerson.ca> + Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 + Free Software Foundation, Inc. + License: GNU General Public License version 3 or later (see COPYING) + File: emacs.icon Author: Sun Microsystems, Inc Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) + + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA.
--- a/lib-src/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/lib-src/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -1,3 +1,9 @@ +2007-08-25 Eli Zaretskii <eliz@gnu.org> + + * Makefile.in (rcs2log, rcs-checkin, grep-changelog, vcdiff): + Prepend "-" to the command, in case srcdir=. and file is copied + into itself. + 2007-07-25 Glenn Morris <rgm@gnu.org> * Relicense all FSF files to GPLv3 or later.
--- a/lib-src/Makefile.in Mon Aug 27 03:36:34 2007 +0000 +++ b/lib-src/Makefile.in Mon Aug 27 04:00:19 2007 +0000 @@ -268,18 +268,21 @@ all: ${DONT_INSTALL} ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} /* These targets copy the scripts into the build directory -so that they can be run from there in an uninstalled Emacs. */ +so that they can be run from there in an uninstalled Emacs. +The "-" is prepended because some versions of cp barf when +srcdir is the current directory, and thus the file will be +copied into itself. */ rcs2log: $(srcdir)/rcs2log - cp -p $(srcdir)/rcs2log rcs2log + -cp -p $(srcdir)/rcs2log rcs2log rcs-checkin: $(srcdir)/rcs-checkin - cp -p $(srcdir)/rcs-checkin rcs-checkin + -cp -p $(srcdir)/rcs-checkin rcs-checkin grep-changelog: $(srcdir)/grep-changelog - cp -p $(srcdir)/grep-changelog grep-changelog + -cp -p $(srcdir)/grep-changelog grep-changelog vcdiff: $(srcdir)/vcdiff - cp -p $(srcdir)/vcdiff vcdiff + -cp -p $(srcdir)/vcdiff vcdiff #ifdef MOVEMAIL_NEEDS_BLESSING blessmail:
--- a/lisp/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -1,3 +1,56 @@ +2007-08-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * uniquify.el (uniquify-rationalize-file-buffer-names): Check liveness + of buffers in uniquify-managed. + + * simple.el (invisible-p): Rename from text-invisible-p. + Update callers. + +2007-08-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cperl-mode.el (defcustom, x-color-defined-p, cperl-is-face) + (cperl-is-face, cperl-force-face, cperl-etags-snarf-tag, cperl-mode) + (cperl-etags-snarf-tag, cperl-etags-goto-tag-location, cperl-init-faces) + (cperl-etags-goto-tag-location): Use new style backquotes. + + * net/browse-url.el: Remove spurious * in custom docstrings. + (browse-url-filename-alist): Use new-style backquote. + + * emacs-lisp/backquote.el (backquote-unquote-symbol) + (backquote-splice-symbol): Clarify they're not new-style unquotes. + + * emacs-lisp/edebug.el (edebug-list-form, edebug-match-symbol, \,) + (\,@): Backslash the , and ,@ which are not new-style unquotes. + + * textmodes/texinfmt.el (\,): Clarify it's not a new-style unquote. + + * net/socks.el (socks-username/password-auth-filter): + Remove unused vars `state' and `desired-len'. + (socks-parse-services, socks-nslookup-host): Use with-current-buffer. + (socks-wait-for-state-change): Use new-style backquotes. + + * pcvs.el (cvs-mode-status): Fix long-standing typo. + + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Check old-style + backquotes after each `read' rather than once per buffer. + + * dframe.el: Remove spurious * in custom docstrings. + (dframe-xemacsp): Remove, use (featurep 'xemacs) instead. + (dframe-xemacs20p): Remove, inline at the sole use point. + (defface): Don't defvar the face, don't use old-style backquote. + (defcustom): Don't use old-style backquote. + (dframe-frame-parameter, dframe-mouse-event-p): + Make it obvious that it's always defined. + (dframe-popup-kludge): New function to replace + dframe-xemacs-popup-kludge and dframe-xemacs-popup-kludge. + (dframe-frame-mode, dframe-set-timer-internal) + (dframe-mouse-set-point): Remove use of with-no-warnings from + XEmacs-specific code. + (dframe-set-timer-internal): Fix very old bug with + post-command-idle-hook. + + * emacs-lisp/byte-opt.el (byte-optimize-featurep): Handle `sxemacs'. + 2007-08-27 Thien-Thi Nguyen <ttn@gnuvola.org> * emacs-lisp/avl-tree.el: New file.
--- a/lisp/dframe.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/dframe.el Mon Aug 27 04:00:19 2007 +0000 @@ -114,10 +114,6 @@ (defvar x-pointer-top-left-arrow) ;;; Code: -(defvar dframe-xemacsp (string-match "XEmacs" emacs-version) - "Non-nil if we are running in the XEmacs environment.") -(defvar dframe-xemacs20p (and dframe-xemacsp - (>= emacs-major-version 20))) ;; From custom web page for compatibility between versions of custom ;; with help from ptype@dera.gov.uk (Proto Type) @@ -138,25 +134,23 @@ (if (boundp 'defface) nil (defmacro defface (var values doc &rest args) - (` (progn - (defvar (, var) (quote (, var))) - ;; To make colors for your faces you need to set your .Xdefaults - ;; or set them up ahead of time in your .emacs file. - (make-face (, var)) - )))) + ;; To make colors for your faces you need to set your .Xdefaults + ;; or set them up ahead of time in your .emacs file. + `(make-face ,var) + )) (if (boundp 'defcustom) nil (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc))))))) + `(defvar ,var ,value ,doc))))) ;;; Compatibility functions ;; -(defun dframe-frame-parameter (frame parameter) - "Return FRAME's PARAMETER value." - (if (fboundp 'frame-parameter) - (frame-parameter frame parameter) - (cdr (assoc parameter (frame-parameters frame))))) ; XEmacs +(defalias 'dframe-frame-parameter + (if (fboundp 'frame-parameter) 'frame-parameter + (lambda (frame parameter) + "Return FRAME's PARAMETER value." + (cdr (assoc parameter (frame-parameters frame)))))) ;;; Variables @@ -176,26 +170,26 @@ "Non-nil means that timers are available for this Emacs.") (defcustom dframe-update-speed - (if dframe-xemacsp - (if dframe-xemacs20p + (if (featurep 'xemacs) + (if (>= emacs-major-version 20) 2 ; 1 is too obrusive in XEmacs 5) ; when no idleness, need long delay 1) - "*Idle time in seconds needed before dframe will update itself. + "Idle time in seconds needed before dframe will update itself. Updates occur to allow dframe to display directory information relevant to the buffer you are currently editing." :group 'dframe :type 'integer) (defcustom dframe-activity-change-focus-flag nil - "*Non-nil means the selected frame will change based on activity. + "Non-nil means the selected frame will change based on activity. Thus, if a file is selected for edit, the buffer will appear in the selected frame and the focus will change to that frame." :group 'dframe :type 'boolean) (defcustom dframe-after-select-attached-frame-hook nil - "*Hook run after dframe has selected the attached frame." + "Hook run after dframe has selected the attached frame." :group 'dframe :type 'hook) @@ -247,7 +241,7 @@ 'dframe-switch-buffer-attached-frame map global-map) - (if dframe-xemacsp + (if (featurep 'xemacs) (progn ;; mouse bindings so we can manipulate the items on each line (define-key map 'button2 'dframe-click) @@ -255,7 +249,7 @@ ;; Info doc fix from Bob Weiner (if (featurep 'infodoc) nil - (define-key map 'button3 'dframe-xemacs-popup-kludge)) + (define-key map 'button3 'dframe-popup-kludge)) ) ;; mouse bindings so we can manipulate the items on each line @@ -267,13 +261,13 @@ ;; This adds a small unecessary visual effect ;;(define-key map [down-mouse-2] 'dframe-quick-mouse) - (define-key map [down-mouse-3] 'dframe-emacs-popup-kludge) + (define-key map [down-mouse-3] 'dframe-popup-kludge) ;; This lets the user scroll as if we had a scrollbar... well maybe not (define-key map [mode-line mouse-2] 'dframe-mouse-hscroll) ;; another handy place users might click to get our menu. (define-key map [mode-line down-mouse-1] - 'dframe-emacs-popup-kludge) + 'dframe-popup-kludge) ;; We can't switch buffers with the buffer mouse menu. Lets hack it. (define-key map [C-down-mouse-1] 'dframe-hack-buffer-menu) @@ -325,14 +319,12 @@ (run-hooks 'popup-hook) ;; Updated the buffer passed in to contain all the hacks needed ;; to make it work well in a dedicated window. - (save-excursion - (set-buffer (symbol-value buffer-var)) + (with-current-buffer (symbol-value buffer-var) ;; Declare this buffer a dedicated frame (setq dframe-controlled local-mode-fn) - (if dframe-xemacsp - ;; Hack the XEmacs mouse-motion handler - (with-no-warnings + (if (featurep 'xemacs) + (progn ;; Hack the XEmacs mouse-motion handler (set (make-local-variable 'mouse-motion-handler) 'dframe-track-mouse-xemacs) @@ -353,7 +345,7 @@ ;; Enable mouse tracking in emacs (if dframe-track-mouse-function (set (make-local-variable 'track-mouse) t))) ;this could be messy. -;;;; DISABLED: This causes problems for users with multiple frames. +;;;; DISABLED: This causes problems for users with multiple frames. ;;;; ;; Set this up special just for the passed in buffer ;;;; ;; Terminal minibuffer stuff does not require this. ;;;; (if (and (or (assoc 'minibuffer parameters) @@ -402,7 +394,7 @@ (if (frame-live-p (symbol-value frame-var)) (raise-frame (symbol-value frame-var)) (set frame-var - (if dframe-xemacsp + (if (featurep 'xemacs) ;; Only guess height if it is not specified. (if (member 'height parameters) (make-frame parameters) @@ -458,7 +450,7 @@ (defun dframe-reposition-frame (new-frame parent-frame location) "Move NEW-FRAME to be relative to PARENT-FRAME. LOCATION can be one of 'random, 'left, 'right, 'left-right, or 'top-bottom." - (if dframe-xemacsp + (if (featurep 'xemacs) (dframe-reposition-frame-xemacs new-frame parent-frame location) (dframe-reposition-frame-emacs new-frame parent-frame location))) @@ -568,13 +560,13 @@ (defun dframe-detach (frame-var cache-var buffer-var) "Detatch the frame in symbol FRAME-VAR. CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'" - (save-excursion - (set-buffer (symbol-value buffer-var)) + (with-current-buffer (symbol-value buffer-var) (rename-buffer (buffer-name) t) (let ((oldframe (symbol-value frame-var))) (set buffer-var nil) (set frame-var nil) (set cache-var nil) + ;; FIXME: Looks very suspicious. Luckily this function is unused. (make-variable-buffer-local frame-var) (set frame-var oldframe) ))) @@ -785,18 +777,16 @@ If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer." (cond ;; XEmacs - (dframe-xemacsp - (with-no-warnings + ((featurep 'xemacs) (if dframe-timer (progn (delete-itimer dframe-timer) (setq dframe-timer nil))) (if timeout - (if (and dframe-xemacsp - (or (>= emacs-major-version 21) - (and (= emacs-major-version 20) - (> emacs-minor-version 0)) - (and (= emacs-major-version 19) - (>= emacs-minor-version 15)))) + (if (or (>= emacs-major-version 21) + (and (= emacs-major-version 20) + (> emacs-minor-version 0)) + (and (= emacs-major-version 19) + (>= emacs-minor-version 15))) (setq dframe-timer (start-itimer "dframe" 'dframe-timer-fn timeout @@ -805,7 +795,7 @@ (setq dframe-timer (start-itimer "dframe" 'dframe-timer-fn timeout - nil)))))) + nil))))) ;; Post 19.31 Emacs ((fboundp 'run-with-idle-timer) (if dframe-timer @@ -815,7 +805,7 @@ (setq dframe-timer (run-with-idle-timer timeout t 'dframe-timer-fn)))) ;; Emacs 19.30 (Thanks twice: ptype@dra.hmg.gb) - ((fboundp 'post-command-idle-hook) + ((boundp 'post-command-idle-hook) (if timeout (add-hook 'post-command-idle-hook 'dframe-timer-fn) (remove-hook 'post-command-idle-hook 'dframe-timer-fn))) @@ -849,57 +839,58 @@ ;; opposed to where the point happens to be.) We attain this by ;; temporarily moving the point to that place. ;; Hrvoje Niksic <hniksic@srce.hr> -(with-no-warnings -(defun dframe-xemacs-popup-kludge (event) - "Pop up a menu related to the clicked on item. +(defalias 'dframe-popup-kludge + (if (featurep 'xemacs) + (lambda (event) ; XEmacs. + "Pop up a menu related to the clicked on item. Must be bound to EVENT." - (interactive "e") - (save-excursion - (if dframe-pass-event-to-popup-mode-menu - (popup-mode-menu event) - (goto-char (event-closest-point event)) - (beginning-of-line) - (forward-char (min 5 (- (save-excursion (end-of-line) (point)) - (save-excursion (beginning-of-line) (point))))) - (popup-mode-menu)) - ;; Wait for menu to bail out. `popup-mode-menu' (and other popup - ;; menu functions) return immediately. - (let (new) - (while (not (misc-user-event-p (setq new (next-event)))) - (dispatch-event new)) - (dispatch-event new)))) -);with-no-warnings + (interactive "e") + (save-excursion + (if dframe-pass-event-to-popup-mode-menu + (popup-mode-menu event) + (goto-char (event-closest-point event)) + (beginning-of-line) + (forward-char (min 5 (- (save-excursion (end-of-line) (point)) + (save-excursion (beginning-of-line) (point))))) + (popup-mode-menu)) + ;; Wait for menu to bail out. `popup-mode-menu' (and other popup + ;; menu functions) return immediately. + (let (new) + (while (not (misc-user-event-p (setq new (next-event)))) + (dispatch-event new)) + (dispatch-event new)))) -(defun dframe-emacs-popup-kludge (e) - "Pop up a menu related to the clicked on item. + (lambda (e) ; Emacs. + "Pop up a menu related to the clicked on item. Must be bound to event E." - (interactive "e") - (save-excursion - (mouse-set-point e) - ;; This gets the cursor where the user can see it. - (if (not (bolp)) (forward-char -1)) - (sit-for 0) - (if (< emacs-major-version 20) - (mouse-major-mode-menu e) - (mouse-major-mode-menu e nil)))) + (interactive "e") + (save-excursion + (mouse-set-point e) + ;; This gets the cursor where the user can see it. + (if (not (bolp)) (forward-char -1)) + (sit-for 0) + (if (< emacs-major-version 20) + (mouse-major-mode-menu e) + (mouse-major-mode-menu e nil)))))) ;;; Interactive user functions for the mouse ;; -(defun dframe-mouse-event-p (event) - "Return t if the event is a mouse related event." - (if (fboundp 'button-press-event-p) - (button-press-event-p event) ; XEmacs - (if (and (listp event) - (member (event-basic-type event) - '(mouse-1 mouse-2 mouse-3))) - t - nil))) +(defalias 'dframe-mouse-event-p + (if (featurep 'xemacs) + 'button-press-event-p + (lambda (event) + "Return t if the event is a mouse related event." + (if (and (listp event) + (member (event-basic-type event) + '(mouse-1 mouse-2 mouse-3))) + t + nil)))) (defun dframe-track-mouse (event) "For motion EVENT, display info about the current line." (interactive "e") (when (and dframe-track-mouse-function - (or dframe-xemacsp ;; XEmacs always safe? + (or (featurep 'xemacs) ;; XEmacs always safe? (windowp (posn-window (event-end event))) ; Sometimes ; there is no window to jump into. )) @@ -929,19 +920,18 @@ (defun dframe-mouse-set-point (e) "Set POINT based on event E. Handles clicking on images in XEmacs." - (if (save-excursion - (save-window-excursion - (mouse-set-point e) - (and (fboundp 'event-over-glyph-p) (event-over-glyph-p e)))) + (if (and (featurep 'xemacs) + (save-excursion + (save-window-excursion + (mouse-set-point e) + (event-over-glyph-p e)))) ;; We are in XEmacs, and clicked on a picture - (with-no-warnings (let ((ext (event-glyph-extent e))) ;; This position is back inside the extent where the ;; junk we pushed into the property list lives. (if (extent-end-position ext) (goto-char (1- (extent-end-position ext))) (mouse-set-point e))) - );with-no-warnings ;; We are not in XEmacs, OR we didn't click on a picture. (mouse-set-point e))) @@ -1000,7 +990,7 @@ (pop-to-buffer buffer nil) (other-window -1) ;; Fix for using this hook on some platforms: Bob Weiner - (cond ((not dframe-xemacsp) + (cond ((not (featurep 'xemacs)) (run-hooks 'temp-buffer-show-hook)) ((fboundp 'run-hook-with-args) (run-hook-with-args 'temp-buffer-show-hook buffer)) @@ -1015,8 +1005,8 @@ Emacs frame, not in the dedicated frame. Argument E is the event causing this activity." (interactive "e") - (let ((fn (lookup-key global-map (if dframe-xemacsp - '(control button1) + (let ((fn (lookup-key global-map (if (featurep 'xemacs) + '(control button1) [C-down-mouse-1]))) (oldbuff (current-buffer)) (newbuff nil))
--- a/lisp/emacs-lisp/backquote.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/emacs-lisp/backquote.el Mon Aug 27 04:00:19 2007 +0000 @@ -85,10 +85,10 @@ (defconst backquote-backquote-symbol '\` "Symbol used to represent a backquote or nested backquote.") -(defconst backquote-unquote-symbol ', +(defconst backquote-unquote-symbol '\, "Symbol used to represent an unquote inside a backquote.") -(defconst backquote-splice-symbol ',@ +(defconst backquote-splice-symbol '\,@ "Symbol used to represent a splice inside a backquote.") ;;;###autoload @@ -121,9 +121,8 @@ (defun backquote-delay-process (s level) "Process a (un|back|splice)quote inside a backquote. This simply recurses through the body." - (let ((exp (backquote-listify (list (backquote-process (nth 1 s) level) - (cons 0 (list 'quote (car s)))) - '(0)))) + (let ((exp (backquote-listify (list (cons 0 (list 'quote (car s)))) + (backquote-process (cdr s) level)))) (if (eq (car-safe exp) 'quote) (cons 0 (list 'quote s)) (cons 1 exp))))
--- a/lisp/emacs-lisp/byte-opt.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/emacs-lisp/byte-opt.el Mon Aug 27 04:00:19 2007 +0000 @@ -1146,9 +1146,9 @@ (put 'featurep 'byte-optimizer 'byte-optimize-featurep) (defun byte-optimize-featurep (form) - ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can - ;; safely optimize away this test. - (if (equal '((quote xemacs)) (cdr-safe form)) + ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we + ;; can safely optimize away this test. + (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs))) nil form))
--- a/lisp/emacs-lisp/bytecomp.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Mon Aug 27 04:00:19 2007 +0000 @@ -1010,8 +1010,7 @@ (defun byte-compile-log-file () (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) (not noninteractive) - (save-excursion - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (goto-char (point-max)) (let* ((inhibit-read-only t) (dir (and byte-compile-current-file @@ -1548,8 +1547,7 @@ nil (save-some-buffers) (force-mode-line-update)) - (save-current-buffer - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (setq default-directory (expand-file-name directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode) @@ -1651,7 +1649,7 @@ (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) + (with-current-buffer b (save-buffer))))) ;; Force logging of the file name for each file compiled. (setq byte-compile-last-logged-file nil) @@ -1661,9 +1659,8 @@ byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) - (save-excursion - (setq input-buffer (get-buffer-create " *Compiler Input*")) - (set-buffer input-buffer) + (with-current-buffer + (setq input-buffer (get-buffer-create " *Compiler Input*")) (erase-buffer) (setq buffer-file-coding-system nil) ;; Always compile an Emacs Lisp file as multibyte @@ -1864,7 +1861,13 @@ (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let ((form (read inbuffer))) + (let* ((old-style-backquotes nil) + (form (read inbuffer))) + ;; Warn about the use of old-style backquotes. + (when old-style-backquotes + (byte-compile-warn "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual.")) (byte-compile-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending)
--- a/lisp/emacs-lisp/edebug.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/emacs-lisp/edebug.el Mon Aug 27 04:00:19 2007 +0000 @@ -1507,7 +1507,7 @@ head (edebug-move-cursor cursor)))))) ((consp head) - (if (eq (car head) ',) + (if (eq (car head) '\,) ;; The head of a form should normally be a symbol or a lambda ;; expression but it can also be an unquote form to be filled ;; before evaluation. We evaluate the arguments anyway, on the @@ -1664,7 +1664,7 @@ ((fboundp symbol) ; is it a predicate? (let ((sexp (edebug-top-element-required cursor "Expected" symbol))) ;; Special case for edebug-`. - (if (and (listp sexp) (eq (car sexp) ',)) + (if (and (listp sexp) (eq (car sexp) '\,)) (edebug-match cursor '(("," def-form))) (if (not (funcall symbol sexp)) (edebug-no-match cursor symbol "failed")) @@ -2102,8 +2102,8 @@ (def-edebug-spec edebug-\` (def-form)) ;; Assume immediate quote in unquotes mean backquote at next higher level. -(def-edebug-spec , (&or ("quote" edebug-\`) def-form)) -(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped. +(def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) +(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. &or ("quote" edebug-\`) def-form)) ;; New byte compiler.
--- a/lisp/gnus/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/gnus/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -1,3 +1,21 @@ +2007-08-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer. + (mml-generate-mime-1): Don't encode body if it is specified to be in + raw form; don't make buffer be unibyte when inserting multibyte string. + +2007-08-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * sha1.el: Fix up comment style. + (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1, sha1-S5, sha1-S30) + (sha1-OP, sha1-add-to-H): Use new-style backquotes. + + * hex-util.el: Fix up comment style. + (hex-char-to-num, num-to-hex-char): Use new-style backquotes. + + * gnus-salt.el: Use with-current-buffer. + (gnus-pick-setup-message): Fix long-standing typo. + 2007-08-17 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-summary-command-nosave) @@ -11,8 +29,8 @@ according to gnus-maximum-newsgroup. * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles) - (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Limit - the range of articles according to gnus-maximum-newsgroup. + (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): + Limit the range of articles according to gnus-maximum-newsgroup. 2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
--- a/lisp/gnus/gnus-salt.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/gnus/gnus-salt.el Mon Aug 27 04:00:19 2007 +0000 @@ -134,11 +134,10 @@ (defun gnus-pick-setup-message () "Make Message do the right thing on exit." (when (and (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer gnus-pick-mode)) (message-add-action - '(gnus-configure-windows ,gnus-current-window-configuration t) + `(gnus-configure-windows ,gnus-current-window-configuration t) 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) @@ -524,8 +523,7 @@ (interactive (list (gnus-tree-article-number))) (let ((buf (current-buffer))) (when article - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-summary-goto-article article)) (select-window (get-buffer-window buf))))) @@ -576,8 +574,7 @@ (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." - (save-excursion - (set-buffer (gnus-get-buffer-create gnus-tree-buffer)) + (with-current-buffer (gnus-get-buffer-create gnus-tree-buffer) (unless (eq major-mode 'gnus-tree-mode) (gnus-tree-mode)) (current-buffer))) @@ -662,8 +659,7 @@ "Highlight current line according to `gnus-summary-highlight'." (let ((list gnus-summary-highlight) face) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) @@ -690,8 +686,7 @@ (defun gnus-generate-tree (thread) "Generate a thread tree for THREAD." - (save-excursion - (set-buffer (gnus-get-tree-buffer)) + (with-current-buffer (gnus-get-tree-buffer) (let ((buffer-read-only nil) (gnus-tmp-indent 0)) (erase-buffer) @@ -814,14 +809,12 @@ (defun gnus-possibly-generate-tree (article &optional force) "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (save-excursion - (set-buffer gnus-summary-buffer) + (when (with-current-buffer gnus-summary-buffer (and gnus-use-trees gnus-show-threads (vectorp (gnus-summary-article-header article)))) (save-excursion - (let ((top (save-excursion - (set-buffer gnus-summary-buffer) + (let ((top (with-current-buffer gnus-summary-buffer (gnus-cut-thread (gnus-remove-thread (mail-header-id @@ -843,8 +836,7 @@ (defun gnus-tree-perhaps-minimize () (when (and gnus-tree-minimize-window (get-buffer gnus-tree-buffer)) - (save-excursion - (set-buffer gnus-tree-buffer) + (with-current-buffer gnus-tree-buffer (gnus-tree-minimize)))) (defun gnus-highlight-selected-tree (article) @@ -871,14 +863,12 @@ (gnus-horizontal-recenter) (select-window selected)))) ;; If we remove this save-excursion, it updates the wrong mode lines?!? - (save-excursion - (set-buffer gnus-tree-buffer) + (with-current-buffer gnus-tree-buffer (gnus-set-mode-line 'tree)) (set-buffer buf))) (defun gnus-tree-highlight-article (article face) - (save-excursion - (set-buffer (gnus-get-tree-buffer)) + (with-current-buffer (gnus-get-tree-buffer) (let (region) (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) @@ -1013,8 +1003,7 @@ (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) (if (get-buffer buffer) () - (save-excursion - (set-buffer (gnus-get-buffer-create buffer)) + (with-current-buffer (gnus-get-buffer-create buffer) (gnus-carpal-mode) (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type)))
--- a/lisp/gnus/hex-util.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/gnus/hex-util.el Mon Aug 27 04:00:19 2007 +0000 @@ -29,14 +29,14 @@ (eval-when-compile (defmacro hex-char-to-num (chr) - (` (let ((chr (, chr))) - (cond - ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) - ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) - ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) - (t (error "Invalid hexadecimal digit `%c'" chr)))))) + `(let ((chr ,chr)) + (cond + ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) + ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) + ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) + (t (error "Invalid hexadecimal digit `%c'" chr))))) (defmacro num-to-hex-char (num) - (` (aref "0123456789abcdef" (, num))))) + `(aref "0123456789abcdef" ,num))) (defun decode-hex-string (string) "Decode hexadecimal STRING to octet string." @@ -44,9 +44,9 @@ (dst (make-string (/ len 2) 0)) (idx 0)(pos 0)) (while (< pos len) -;;; logior and lsh are not byte-coded. -;;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4) -;;; (hex-char-to-num (aref string (1+ pos))))) + ;; logior and lsh are not byte-coded. + ;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4) + ;; (hex-char-to-num (aref string (1+ pos))))) (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16) (hex-char-to-num (aref string (1+ pos))))) (setq idx (1+ idx) @@ -59,11 +59,11 @@ (dst (make-string (* len 2) 0)) (idx 0)(pos 0)) (while (< pos len) -;;; logand and lsh are not byte-coded. -;;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15))) + ;; logand and lsh are not byte-coded. + ;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15))) (aset dst idx (num-to-hex-char (/ (aref string pos) 16))) (setq idx (1+ idx)) -;;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15))) + ;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15))) (aset dst idx (num-to-hex-char (% (aref string pos) 16))) (setq idx (1+ idx) pos (1+ pos))) @@ -71,5 +71,5 @@ (provide 'hex-util) -;;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859 +;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859 ;;; hex-util.el ends here
--- a/lisp/gnus/mml.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/gnus/mml.el Mon Aug 27 04:00:19 2007 +0000 @@ -404,7 +404,7 @@ (mml-multipart-number mml-multipart-number)) (if (not cont) nil - (with-temp-buffer + (mm-with-multibyte-buffer (if (and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont)) @@ -516,14 +516,13 @@ (progn (mm-enable-multibyte) (insert contents) - (setq charset (mm-encode-body))) + (unless raw + (setq charset (mm-encode-body)))) (insert contents))))) (setq encoding (mm-encode-buffer type) coded (mm-string-as-multibyte (buffer-string)))) (mml-insert-mime-headers cont type charset encoding nil) - (insert "\n") - (mm-with-unibyte-current-buffer - (insert coded))))) + (insert "\n" coded)))) ((eq (car cont) 'external) (insert "Content-Type: message/external-body") (let ((parameters (mml-parameter-string
--- a/lisp/gnus/sha1.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/gnus/sha1.el Mon Aug 27 04:00:19 2007 +0000 @@ -123,93 +123,93 @@ (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16) (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16) -;;; original definition of sha1-F0. -;;; (defmacro sha1-F0 (B C D) -;;; (` (logior (logand (, B) (, C)) -;;; (logand (lognot (, B)) (, D))))) -;;; a little optimization from GnuPG/cipher/sha1.c. + ;; original definition of sha1-F0. + ;; (defmacro sha1-F0 (B C D) + ;; (` (logior (logand (, B) (, C)) + ;; (logand (lognot (, B)) (, D))))) + ;; a little optimization from GnuPG/cipher/sha1.c. (defmacro sha1-F0 (B C D) - (` (logxor (, D) (logand (, B) (logxor (, C) (, D)))))) + `(logxor ,D (logand ,B (logxor ,C ,D)))) (defmacro sha1-F1 (B C D) - (` (logxor (, B) (, C) (, D)))) -;;; original definition of sha1-F2. -;;; (defmacro sha1-F2 (B C D) -;;; (` (logior (logand (, B) (, C)) -;;; (logand (, B) (, D)) -;;; (logand (, C) (, D))))) -;;; a little optimization from GnuPG/cipher/sha1.c. + `(logxor ,B ,C ,D)) + ;; original definition of sha1-F2. + ;; (defmacro sha1-F2 (B C D) + ;; (` (logior (logand (, B) (, C)) + ;; (logand (, B) (, D)) + ;; (logand (, C) (, D))))) + ;; a little optimization from GnuPG/cipher/sha1.c. (defmacro sha1-F2 (B C D) - (` (logior (logand (, B) (, C)) - (logand (, D) (logior (, B) (, C)))))) + `(logior (logand ,B ,C) + (logand ,D (logior ,B ,C)))) (defmacro sha1-F3 (B C D) - (` (logxor (, B) (, C) (, D)))) + `(logxor ,B ,C ,D)) (defmacro sha1-S1 (W-high W-low) - (` (let ((W-high (, W-high)) - (W-low (, W-low))) + `(let ((W-high ,W-high) + (W-low ,W-low)) (setq S1W-high (+ (% (* W-high 2) 65536) - (/ W-low (, (/ 65536 2))))) - (setq S1W-low (+ (/ W-high (, (/ 65536 2))) - (% (* W-low 2) 65536)))))) + (/ W-low ,(/ 65536 2)))) + (setq S1W-low (+ (/ W-high ,(/ 65536 2)) + (% (* W-low 2) 65536))))) (defmacro sha1-S5 (A-high A-low) - (` (progn - (setq S5A-high (+ (% (* (, A-high) 32) 65536) - (/ (, A-low) (, (/ 65536 32))))) - (setq S5A-low (+ (/ (, A-high) (, (/ 65536 32))) - (% (* (, A-low) 32) 65536)))))) + `(progn + (setq S5A-high (+ (% (* ,A-high 32) 65536) + (/ ,A-low ,(/ 65536 32)))) + (setq S5A-low (+ (/ ,A-high ,(/ 65536 32)) + (% (* ,A-low 32) 65536))))) (defmacro sha1-S30 (B-high B-low) - (` (progn - (setq S30B-high (+ (/ (, B-high) 4) - (* (% (, B-low) 4) (, (/ 65536 4))))) - (setq S30B-low (+ (/ (, B-low) 4) - (* (% (, B-high) 4) (, (/ 65536 4)))))))) + `(progn + (setq S30B-high (+ (/ ,B-high 4) + (* (% ,B-low 4) ,(/ 65536 4)))) + (setq S30B-low (+ (/ ,B-low 4) + (* (% ,B-high 4) ,(/ 65536 4)))))) (defmacro sha1-OP (round) - (` (progn - (sha1-S5 sha1-A-high sha1-A-low) - (sha1-S30 sha1-B-high sha1-B-low) - (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round))) - sha1-B-low sha1-C-low sha1-D-low) - sha1-E-low - (, (symbol-value - (intern (format "sha1-K%d-low" round)))) - (aref block-low idx) - (progn - (setq sha1-E-low sha1-D-low) - (setq sha1-D-low sha1-C-low) - (setq sha1-C-low S30B-low) - (setq sha1-B-low sha1-A-low) - S5A-low))) - (setq carry (/ sha1-A-low 65536)) - (setq sha1-A-low (% sha1-A-low 65536)) - (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round))) - sha1-B-high sha1-C-high sha1-D-high) - sha1-E-high - (, (symbol-value - (intern (format "sha1-K%d-high" round)))) - (aref block-high idx) - (progn - (setq sha1-E-high sha1-D-high) - (setq sha1-D-high sha1-C-high) - (setq sha1-C-high S30B-high) - (setq sha1-B-high sha1-A-high) - S5A-high) - carry) - 65536))))) + `(progn + (sha1-S5 sha1-A-high sha1-A-low) + (sha1-S30 sha1-B-high sha1-B-low) + (setq sha1-A-low (+ (,(intern (format "sha1-F%d" round)) + sha1-B-low sha1-C-low sha1-D-low) + sha1-E-low + ,(symbol-value + (intern (format "sha1-K%d-low" round))) + (aref block-low idx) + (progn + (setq sha1-E-low sha1-D-low) + (setq sha1-D-low sha1-C-low) + (setq sha1-C-low S30B-low) + (setq sha1-B-low sha1-A-low) + S5A-low))) + (setq carry (/ sha1-A-low 65536)) + (setq sha1-A-low (% sha1-A-low 65536)) + (setq sha1-A-high (% (+ (,(intern (format "sha1-F%d" round)) + sha1-B-high sha1-C-high sha1-D-high) + sha1-E-high + ,(symbol-value + (intern (format "sha1-K%d-high" round))) + (aref block-high idx) + (progn + (setq sha1-E-high sha1-D-high) + (setq sha1-D-high sha1-C-high) + (setq sha1-C-high S30B-high) + (setq sha1-B-high sha1-A-high) + S5A-high) + carry) + 65536)))) (defmacro sha1-add-to-H (H X) - (` (progn - (setq (, (intern (format "sha1-%s-low" H))) - (+ (, (intern (format "sha1-%s-low" H))) - (, (intern (format "sha1-%s-low" X))))) - (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536)) - (setq (, (intern (format "sha1-%s-low" H))) - (% (, (intern (format "sha1-%s-low" H))) 65536)) - (setq (, (intern (format "sha1-%s-high" H))) - (% (+ (, (intern (format "sha1-%s-high" H))) - (, (intern (format "sha1-%s-high" X))) - carry) - 65536))))) + `(progn + (setq ,(intern (format "sha1-%s-low" H)) + (+ ,(intern (format "sha1-%s-low" H)) + ,(intern (format "sha1-%s-low" X)))) + (setq carry (/ ,(intern (format "sha1-%s-low" H)) 65536)) + (setq ,(intern (format "sha1-%s-low" H)) + (% ,(intern (format "sha1-%s-low" H)) 65536)) + (setq ,(intern (format "sha1-%s-high" H)) + (% (+ ,(intern (format "sha1-%s-high" H)) + ,(intern (format "sha1-%s-high" X)) + carry) + 65536)))) ) ;;; buffers (H0 H1 H2 H3 H4). @@ -433,11 +433,10 @@ If BINARY is non-nil, return a string in binary form." (if (stringp object) (sha1-string object binary) - (save-excursion - (set-buffer object) + (with-current-buffer object (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) (provide 'sha1) -;;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 +;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 ;;; sha1.el ends here
--- a/lisp/net/browse-url.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/net/browse-url.el Mon Aug 27 04:00:19 2007 +0000 @@ -235,7 +235,7 @@ 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) (t 'browse-url-default-browser)) - "*Function to display the current buffer in a WWW browser. + "Function to display the current buffer in a WWW browser. This is used by the `browse-url-at-point', `browse-url-at-mouse', and `browse-url-of-file' commands. @@ -281,7 +281,7 @@ (defcustom browse-url-netscape-program "netscape" ;; Info about netscape-remote from Karl Berry. - "*The name by which to invoke Netscape. + "The name by which to invoke Netscape. The free program `netscape-remote' from <URL:http://home.netscape.com/newsref/std/remote.c> is said to start @@ -292,34 +292,34 @@ :group 'browse-url) (defcustom browse-url-netscape-arguments nil - "*A list of strings to pass to Netscape as arguments." + "A list of strings to pass to Netscape as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments - "*A list of strings to pass to Netscape when it starts up. + "A list of strings to pass to Netscape when it starts up. Defaults to the value of `browse-url-netscape-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-browser-display nil - "*The X display for running the browser, if not same as Emacs'." + "The X display for running the browser, if not same as Emacs'." :type '(choice string (const :tag "Default" nil)) :group 'browse-url) (defcustom browse-url-mozilla-program "mozilla" - "*The name by which to invoke Mozilla." + "The name by which to invoke Mozilla." :type 'string :group 'browse-url) (defcustom browse-url-mozilla-arguments nil - "*A list of strings to pass to Mozilla as arguments." + "A list of strings to pass to Mozilla as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-mozilla-startup-arguments browse-url-mozilla-arguments - "*A list of strings to pass to Mozilla when it starts up. + "A list of strings to pass to Mozilla when it starts up. Defaults to the value of `browse-url-mozilla-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument")) @@ -327,17 +327,17 @@ ;;;###autoload (defcustom browse-url-firefox-program "firefox" - "*The name by which to invoke Firefox." + "The name by which to invoke Firefox." :type 'string :group 'browse-url) (defcustom browse-url-firefox-arguments nil - "*A list of strings to pass to Firefox as arguments." + "A list of strings to pass to Firefox as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-firefox-startup-arguments browse-url-firefox-arguments - "*A list of strings to pass to Firefox when it starts up. + "A list of strings to pass to Firefox when it starts up. Defaults to the value of `browse-url-firefox-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument")) @@ -345,34 +345,34 @@ ;;;###autoload (defcustom browse-url-galeon-program "galeon" - "*The name by which to invoke Galeon." + "The name by which to invoke Galeon." :type 'string :group 'browse-url) (defcustom browse-url-galeon-arguments nil - "*A list of strings to pass to Galeon as arguments." + "A list of strings to pass to Galeon as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments - "*A list of strings to pass to Galeon when it starts up. + "A list of strings to pass to Galeon when it starts up. Defaults to the value of `browse-url-galeon-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-epiphany-program "epiphany" - "*The name by which to invoke Epiphany." + "The name by which to invoke Epiphany." :type 'string :group 'browse-url) (defcustom browse-url-epiphany-arguments nil - "*A list of strings to pass to Epiphany as arguments." + "A list of strings to pass to Epiphany as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-epiphany-startup-arguments browse-url-epiphany-arguments - "*A list of strings to pass to Epiphany when it starts up. + "A list of strings to pass to Epiphany when it starts up. Defaults to the value of `browse-url-epiphany-arguments' at the time `browse-url' is loaded." :type '(repeat (string :tag "Argument")) @@ -382,20 +382,20 @@ (defvar browse-url-gnome-moz-program "gnome-moz-remote") (defcustom browse-url-gnome-moz-arguments '() - "*A list of strings passed to the GNOME mozilla viewer as arguments." + "A list of strings passed to the GNOME mozilla viewer as arguments." :version "21.1" :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-mozilla-new-window-is-tab nil - "*Whether to open up new windows in a tab or a new window. + "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if `browse-url-mozilla' is asked to open it in a new window." :type 'boolean :group 'browse-url) (defcustom browse-url-firefox-new-window-is-tab nil - "*Whether to open up new windows in a tab or a new window. + "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if `browse-url-firefox' is asked to open it in a new window. @@ -405,21 +405,21 @@ :group 'browse-url) (defcustom browse-url-galeon-new-window-is-tab nil - "*Whether to open up new windows in a tab or a new window. + "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if `browse-url-galeon' is asked to open it in a new window." :type 'boolean :group 'browse-url) (defcustom browse-url-epiphany-new-window-is-tab nil - "*Whether to open up new windows in a tab or a new window. + "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if `browse-url-epiphany' is asked to open it in a new window." :type 'boolean :group 'browse-url) (defcustom browse-url-netscape-new-window-is-tab nil - "*Whether to open up new windows in a tab or a new window. + "Whether to open up new windows in a tab or a new window. If non-nil, then open the URL in a new tab rather than a new window if `browse-url-netscape' is asked to open it in a new window." @@ -427,7 +427,7 @@ :group 'browse-url) (defcustom browse-url-new-window-flag nil - "*If non-nil, always open a new browser window with appropriate browsers. + "If non-nil, always open a new browser window with appropriate browsers. Passing an interactive argument to \\[browse-url], or specific browser commands reverses the effect of this variable. Requires Netscape version 1.1N or later or XMosaic version 2.5 or later if using those browsers." @@ -435,33 +435,32 @@ :group 'browse-url) (defcustom browse-url-mosaic-program "xmosaic" - "*The name by which to invoke Mosaic (or mMosaic)." + "The name by which to invoke Mosaic (or mMosaic)." :type 'string :version "20.3" :group 'browse-url) (defcustom browse-url-mosaic-arguments nil - "*A list of strings to pass to Mosaic as arguments." + "A list of strings to pass to Mosaic as arguments." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-mosaic-pidfile "~/.mosaicpid" - "*The name of the pidfile created by Mosaic." + "The name of the pidfile created by Mosaic." :type 'string :group 'browse-url) (defcustom browse-url-filename-alist - (\` ; Backquote syntax won't work. - (("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/") + `(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/") ;; The above loses the username to avoid the browser prompting for ;; it in anonymous cases. If it's not anonymous the next regexp ;; applies. ("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/") - (,@ (if (memq system-type '(windows-nt ms-dos cygwin)) - '(("^\\([a-zA-Z]:\\)[\\/]" . "file:\\1/") - ("^[\\/][\\/]+" . "file://")))) - ("^/+" . "file:/"))) - "*An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'. + ,@(if (memq system-type '(windows-nt ms-dos cygwin)) + '(("^\\([a-zA-Z]:\\)[\\/]" . "file:\\1/") + ("^[\\/][\\/]+" . "file://"))) + ("^/+" . "file:/")) + "An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'. Any substring of a filename matching one of the REGEXPs is replaced by the corresponding STRING using `replace-match', not treating STRING literally. All pairs are applied in the order given. The default @@ -476,8 +475,7 @@ \"http://www.acme.co.uk/\") (\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\") (\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\") - (\"^/+\" . \"file:/\"))) -" + (\"^/+\" . \"file:/\")))" :type '(repeat (cons :format "%v" (regexp :tag "Regexp") (string :tag "Replacement"))) @@ -485,13 +483,13 @@ :group 'browse-url) (defcustom browse-url-save-file nil - "*If non-nil, save the buffer before displaying its file. + "If non-nil, save the buffer before displaying its file. Used by the `browse-url-of-file' command." :type 'boolean :group 'browse-url) (defcustom browse-url-of-file-hook nil - "*Run after `browse-url-of-file' has asked a browser to load a file. + "Run after `browse-url-of-file' has asked a browser to load a file. Set this to `browse-url-netscape-reload' to force Netscape to load the file rather than displaying a cached copy." @@ -500,14 +498,14 @@ :group 'browse-url) (defcustom browse-url-CCI-port 3003 - "*Port to access XMosaic via CCI. + "Port to access XMosaic via CCI. This can be any number between 1024 and 65535 but must correspond to the value set in the browser." :type 'integer :group 'browse-url) (defcustom browse-url-CCI-host "localhost" - "*Host to access XMosaic via CCI. + "Host to access XMosaic via CCI. This should be the host name of the machine running XMosaic with CCI enabled. The port number should be set in `browse-url-CCI-port'." :type 'string @@ -517,20 +515,20 @@ (make-variable-buffer-local 'browse-url-temp-file-name) (defcustom browse-url-xterm-program "xterm" - "*The name of the terminal emulator used by `browse-url-lynx-xterm'. + "The name of the terminal emulator used by `browse-url-lynx-xterm'. This might, for instance, be a separate color version of xterm." :type 'string :group 'browse-url) (defcustom browse-url-xterm-args nil - "*A list of strings defining options for `browse-url-xterm-program'. + "A list of strings defining options for `browse-url-xterm-program'. These might set its size, for instance." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-lynx-emacs-args (and (not window-system) '("-show_cursor")) - "*A list of strings defining options for Lynx in an Emacs buffer. + "A list of strings defining options for Lynx in an Emacs buffer. The default is none in a window system, otherwise `-show_cursor' to indicate the position of the current link in the absence of @@ -540,44 +538,43 @@ :group 'browse-url) (defcustom browse-url-gnudoit-program "gnudoit" - "*The name of the `gnudoit' program used by `browse-url-w3-gnudoit'." + "The name of the `gnudoit' program used by `browse-url-w3-gnudoit'." :type 'string :group 'browse-url) (defcustom browse-url-gnudoit-args '("-q") - "*A list of strings defining options for `browse-url-gnudoit-program'. + "A list of strings defining options for `browse-url-gnudoit-program'. These might set the port, for instance." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-generic-program nil - "*The name of the browser program used by `browse-url-generic'." + "The name of the browser program used by `browse-url-generic'." :type '(choice string (const :tag "None" nil)) :group 'browse-url) (defcustom browse-url-generic-args nil - "*A list of strings defining options for `browse-url-generic-program'." + "A list of strings defining options for `browse-url-generic-program'." :type '(repeat (string :tag "Argument")) :group 'browse-url) (defcustom browse-url-temp-dir temporary-file-directory - "*The name of a directory for browse-url's temporary files. + "The name of a directory for browse-url's temporary files. Such files are generated by functions like `browse-url-of-region'. You might want to set this to somewhere with restricted read permissions for privacy's sake." :type 'string :group 'browse-url) -(defcustom browse-url-netscape-version - 3 - "*The version of Netscape you are using. +(defcustom browse-url-netscape-version 3 + "The version of Netscape you are using. This affects how URL reloading is done; the mechanism changed incompatibly at version 4." :type 'number :group 'browse-url) (defcustom browse-url-lynx-input-field 'avoid - "*Action on selecting an existing Lynx buffer at an input field. + "Action on selecting an existing Lynx buffer at an input field. What to do when sending a new URL to an existing Lynx buffer in Emacs if the Lynx cursor is on an input field (in which case the `g' command would be entered as data). Such fields are recognized by the @@ -591,23 +588,23 @@ :group 'browse-url) (defcustom browse-url-lynx-input-attempts 10 - "*How many times to try to move down from a series of lynx input fields." + "How many times to try to move down from a series of lynx input fields." :type 'integer :group 'browse-url) (defcustom browse-url-lynx-input-delay 0.2 - "*How many seconds to wait for lynx between moves down from an input field." + "How many seconds to wait for lynx between moves down from an input field." :type 'number :group 'browse-url) (defcustom browse-url-kde-program "kfmclient" - "*The name by which to invoke the KDE web browser." + "The name by which to invoke the KDE web browser." :type 'string :version "21.1" :group 'browse-url) (defcustom browse-url-kde-args '("openURL") - "*A list of strings defining options for `browse-url-kde-program'." + "A list of strings defining options for `browse-url-kde-program'." :type '(repeat (string :tag "Argument")) :group 'browse-url) @@ -669,8 +666,7 @@ (error "Current buffer has no file")) (let ((buf (get-file-buffer file))) (if buf - (save-excursion - (set-buffer buf) + (with-current-buffer buf (cond ((not (buffer-modified-p))) (browse-url-save-file (save-buffer)) (t (message "%s modified since last save" file)))))) @@ -1171,6 +1167,20 @@ (append browse-url-epiphany-startup-arguments (list url)))))) ;;;###autoload +(defun browse-url-emacs (url &optional new-window) + "Ask Emacs to load URL into a buffer and show it in another window." + (interactive (browse-url-interactive-arg "URL: ")) + (require 'url-handlers) + (let ((file-name-handler-alist + (cons (cons url-handler-regexp 'url-file-handler) + file-name-handler-alist))) + ;; Ignore `new-window': with all other browsers the URL is always shown + ;; in another window than the current Emacs one since it's shown in + ;; another application's window. + ;; (if new-window (find-file-other-window url) (find-file url)) + (find-file-other-window url))) + +;;;###autoload (defun browse-url-gnome-moz (url &optional new-window) "Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'. Default to the URL around or before point. The strings in variable @@ -1257,8 +1267,7 @@ variable `browse-url-grail'." (interactive (browse-url-interactive-arg "Grail URL: ")) (message "Sending URL to Grail...") - (save-excursion - (set-buffer (get-buffer-create " *Shell Command Output*")) + (with-current-buffer (get-buffer-create " *Shell Command Output*") (erase-buffer) ;; don't worry about this failing. (if (browse-url-maybe-new-window new-window) @@ -1428,8 +1437,7 @@ Default to the URL around or before point." (interactive (browse-url-interactive-arg "MMM URL: ")) (message "Sending URL to MMM...") - (save-excursion - (set-buffer (get-buffer-create " *Shell Command Output*")) + (with-current-buffer (get-buffer-create " *Shell Command Output*") (erase-buffer) ;; mmm_remote just SEGVs if the file isn't there... (if (or (file-exists-p (expand-file-name "~/.mmm_remote")) @@ -1507,5 +1515,5 @@ (provide 'browse-url) -;;; arch-tag: d2079573-5c06-4097-9598-f550fba19430 +;; arch-tag: d2079573-5c06-4097-9598-f550fba19430 ;;; browse-url.el ends here
--- a/lisp/net/socks.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/net/socks.el Mon Aug 27 04:00:19 2007 +0000 @@ -263,10 +263,9 @@ (defconst socks-state-connected 4) (defmacro socks-wait-for-state-change (proc htable cur-state) - (` - (while (and (= (gethash 'state (, htable)) (, cur-state)) - (memq (process-status (, proc)) '(run open))) - (accept-process-output (, proc) socks-timeout)))) + `(while (and (= (gethash 'state ,htable) ,cur-state) + (memq (process-status ,proc) '(run open))) + (accept-process-output ,proc socks-timeout))) (defun socks-filter (proc string) (let ((info (gethash proc socks-connections)) @@ -493,10 +492,9 @@ (if (not (and (file-exists-p socks-services-file) (file-readable-p socks-services-file))) (error "Could not find services file: %s" socks-services-file)) - (save-excursion - (clrhash socks-tcp-services) - (clrhash socks-udp-services) - (set-buffer (get-buffer-create " *socks-tmp*")) + (clrhash socks-tcp-services) + (clrhash socks-udp-services) + (with-current-buffer (get-buffer-create " *socks-tmp*") (erase-buffer) (insert-file-contents socks-services-file) ;; Nuke comments @@ -566,10 +564,8 @@ (defconst socks-username/password-auth-version 1) (defun socks-username/password-auth-filter (proc str) - (let ((info (gethash proc socks-connections)) - state desired-len) + (let ((info (gethash proc socks-connections))) (or info (error "socks-filter called on non-SOCKS connection %S" proc)) - (setq state (gethash 'state info)) (puthash 'scratch (concat (gethash 'scratch info) str) info) (if (< (length (gethash 'scratch info)) 2) nil @@ -629,8 +625,7 @@ socks-nslookup-program host)) (res host)) (set-process-query-on-exit-flag proc nil) - (save-excursion - (set-buffer (process-buffer proc)) + (with-current-buffer (process-buffer proc) (while (progn (accept-process-output proc) (memq (process-status proc) '(run open))))
--- a/lisp/pcvs.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/pcvs.el Mon Aug 27 04:00:19 2007 +0000 @@ -1904,7 +1904,7 @@ (interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags"))) (cvs-mode-do "status" flags nil :dont-change-disc t :show t :postproc (when (eq cvs-auto-remove-handled 'status) - '((with-current-buffer ,(current-buffer) + `((with-current-buffer ,(current-buffer) (cvs-mode-remove-handled)))))) (defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags)
--- a/lisp/progmodes/ada-mode.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/progmodes/ada-mode.el Mon Aug 27 04:00:19 2007 +0000 @@ -27,103 +27,103 @@ ;; Boston, MA 02110-1301, USA. ;;; Commentary: -;;; This mode is a major mode for editing Ada code. This is a major -;;; rewrite of the file packaged with Emacs-20. The Ada mode is -;;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el -;;; and ada-stmt.el. Only this file (ada-mode.el) is completely -;;; independent from the GNU Ada compiler GNAT, distributed by Ada -;;; Core Technologies. All the other files rely heavily on features -;;; provided only by GNAT. -;;; -;;; Note: this mode will not work with Emacs 19. If you are on a VMS -;;; system, where the latest version of Emacs is 19.28, you will need -;;; another file, called ada-vms.el, that provides some required -;;; functions. +;; This mode is a major mode for editing Ada code. This is a major +;; rewrite of the file packaged with Emacs-20. The Ada mode is +;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el +;; and ada-stmt.el. Only this file (ada-mode.el) is completely +;; independent from the GNU Ada compiler GNAT, distributed by Ada +;; Core Technologies. All the other files rely heavily on features +;; provided only by GNAT. +;; +;; Note: this mode will not work with Emacs 19. If you are on a VMS +;; system, where the latest version of Emacs is 19.28, you will need +;; another file, called ada-vms.el, that provides some required +;; functions. ;;; Usage: -;;; Emacs should enter Ada mode automatically when you load an Ada file. -;;; By default, the valid extensions for Ada files are .ads, .adb or .ada -;;; If the ada-mode does not start automatically, then simply type the -;;; following command : -;;; M-x ada-mode -;;; -;;; By default, ada-mode is configured to take full advantage of the GNAT -;;; compiler (the menus will include the cross-referencing features,...). -;;; If you are using another compiler, you might want to set the following -;;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it -;;; won't work) : -;;; (setq ada-which-compiler 'generic) -;;; -;;; This mode requires find-file.el to be present on your system. +;; Emacs should enter Ada mode automatically when you load an Ada file. +;; By default, the valid extensions for Ada files are .ads, .adb or .ada +;; If the ada-mode does not start automatically, then simply type the +;; following command : +;; M-x ada-mode +;; +;; By default, ada-mode is configured to take full advantage of the GNAT +;; compiler (the menus will include the cross-referencing features,...). +;; If you are using another compiler, you might want to set the following +;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it +;; won't work) : +;; (setq ada-which-compiler 'generic) +;; +;; This mode requires find-file.el to be present on your system. ;;; History: -;;; The first Ada mode for GNU Emacs was written by V. Broman in -;;; 1985. He based his work on the already existing Modula-2 mode. -;;; This was distributed as ada.el in versions of Emacs prior to 19.29. -;;; -;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of -;;; several files with support for dired commands and other nice -;;; things. It is currently available from the PAL -;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. -;;; -;;; The probably very first Ada mode (called electric-ada.el) was -;;; written by Steven D. Litvintchouk and Steven M. Rosen for the -;;; Gosling Emacs. L. Slater based his development on ada.el and -;;; electric-ada.el. -;;; -;;; A complete rewrite by M. Heritsch and R. Ebert has been done. -;;; Some ideas from the Ada mode mailing list have been -;;; added. Some of the functionality of L. Slater's mode has not -;;; (yet) been recoded in this new mode. Perhaps you prefer sticking -;;; to his version. -;;; -;;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core -;;; Technologies. +;; The first Ada mode for GNU Emacs was written by V. Broman in +;; 1985. He based his work on the already existing Modula-2 mode. +;; This was distributed as ada.el in versions of Emacs prior to 19.29. +;; +;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of +;; several files with support for dired commands and other nice +;; things. It is currently available from the PAL +;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z. +;; +;; The probably very first Ada mode (called electric-ada.el) was +;; written by Steven D. Litvintchouk and Steven M. Rosen for the +;; Gosling Emacs. L. Slater based his development on ada.el and +;; electric-ada.el. +;; +;; A complete rewrite by M. Heritsch and R. Ebert has been done. +;; Some ideas from the Ada mode mailing list have been +;; added. Some of the functionality of L. Slater's mode has not +;; (yet) been recoded in this new mode. Perhaps you prefer sticking +;; to his version. +;; +;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core +;; Technologies. ;;; Credits: -;;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so -;;; many patches included in this package. -;;; Christian Egli <Christian.Egli@hcsd.hac.com>: -;;; ada-imenu-generic-expression -;;; Many thanks also to the following persons that have contributed -;;; to the ada-mode -;;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular, -;;; woodruff@stc.llnl.gov (John Woodruff) -;;; jj@ddci.dk (Jesper Joergensen) -;;; gse@ocsystems.com (Scott Evans) -;;; comar@gnat.com (Cyrille Comar) -;;; stephen.leake@gsfc.nasa.gov (Stephen Leake) -;;; robin-reply@reagans.org -;;; and others for their valuable hints. +;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so +;; many patches included in this package. +;; Christian Egli <Christian.Egli@hcsd.hac.com>: +;; ada-imenu-generic-expression +;; Many thanks also to the following persons that have contributed +;; to the ada-mode +;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular, +;; woodruff@stc.llnl.gov (John Woodruff) +;; jj@ddci.dk (Jesper Joergensen) +;; gse@ocsystems.com (Scott Evans) +;; comar@gnat.com (Cyrille Comar) +;; stephen.leake@gsfc.nasa.gov (Stephen Leake) +;; robin-reply@reagans.org +;; and others for their valuable hints. ;;; Code: -;;; Note: Every function in this package is compiler-independent. -;;; The names start with ada- -;;; The variables that the user can edit can all be modified through -;;; the customize mode. They are sorted in alphabetical order in this -;;; file. - -;;; Supported packages. -;;; This package supports a number of other Emacs modes. These other modes -;;; should be loaded before the ada-mode, which will then setup some variables -;;; to improve the support for Ada code. -;;; Here is the list of these modes: -;;; `which-function-mode': Display the name of the subprogram the cursor is -;;; in in the mode line. -;;; `outline-mode': Provides the capability to collapse or expand the code -;;; for specific language constructs, for instance if you want to hide the -;;; code corresponding to a subprogram -;;; `align': This mode is now provided with Emacs 21, but can also be -;;; installed manually for older versions of Emacs. It provides the -;;; capability to automatically realign the selected region (for instance -;;; all ':=', ':' and '--' will be aligned on top of each other. -;;; `imenu': Provides a menu with the list of entities defined in the current -;;; buffer, and an easy way to jump to any of them -;;; `speedbar': Provides a separate file browser, and the capability for each -;;; file to see the list of entities defined in it and to jump to them -;;; easily -;;; `abbrev-mode': Provides the capability to define abbreviations, which -;;; are automatically expanded when you type them. See the Emacs manual. +;; Note: Every function in this package is compiler-independent. +;; The names start with ada- +;; The variables that the user can edit can all be modified through +;; the customize mode. They are sorted in alphabetical order in this +;; file. + +;; Supported packages. +;; This package supports a number of other Emacs modes. These other modes +;; should be loaded before the ada-mode, which will then setup some variables +;; to improve the support for Ada code. +;; Here is the list of these modes: +;; `which-function-mode': Display the name of the subprogram the cursor is +;; in in the mode line. +;; `outline-mode': Provides the capability to collapse or expand the code +;; for specific language constructs, for instance if you want to hide the +;; code corresponding to a subprogram +;; `align': This mode is now provided with Emacs 21, but can also be +;; installed manually for older versions of Emacs. It provides the +;; capability to automatically realign the selected region (for instance +;; all ':=', ':' and '--' will be aligned on top of each other. +;; `imenu': Provides a menu with the list of entities defined in the current +;; buffer, and an easy way to jump to any of them +;; `speedbar': Provides a separate file browser, and the capability for each +;; file to see the list of entities defined in it and to jump to them +;; easily +;; `abbrev-mode': Provides the capability to define abbreviations, which +;; are automatically expanded when you type them. See the Emacs manual. (require 'find-file nil t) (require 'align nil t) @@ -134,18 +134,6 @@ (defvar ispell-check-comments) (defvar skeleton-further-elements) -(eval-and-compile - (defun ada-check-emacs-version (major minor &optional is-xemacs) - "Return t if Emacs's version is greater or equal to MAJOR.MINOR. -If IS-XEMACS is non-nil, check for XEmacs instead of Emacs." - (let ((xemacs-running (or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version)))) - (and (or (and is-xemacs xemacs-running) - (not (or is-xemacs xemacs-running))) - (or (> emacs-major-version major) - (and (= emacs-major-version major) - (>= emacs-minor-version minor))))))) - (defun ada-mode-version () "Return Ada mode version." (interactive) @@ -612,7 +600,7 @@ "\\(\\(\\sw\\|[_.]\\)+\\)" "\\)") "Regexp matching Ada subprogram start. -The actual start is at (match-beginning 4). The name is in (match-string 5).") +The actual start is at (match-beginning 4). The name is in (match-string 5).") (defconst ada-name-regexp "\\([a-zA-Z][a-zA-Z0-9_.']*[a-zA-Z0-9]\\)" @@ -1192,13 +1180,9 @@ ;; the comment and the text. We do not want any, this is already ;; included in comment-start (unless (featurep 'xemacs) - (progn - (if (ada-check-emacs-version 20 3) - (progn - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'comment-padding) 0))) - (set (make-local-variable 'parse-sexp-lookup-properties) t) - )) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'comment-padding) 0) + (set (make-local-variable 'parse-sexp-lookup-properties) t)) (set 'case-fold-search t) (if (boundp 'imenu-case-fold-search) @@ -1227,6 +1211,7 @@ ;; We need to set some properties for XEmacs, and define some variables ;; for Emacs + ;; FIXME: The Emacs code should work just fine under XEmacs AFAIK. --Stef (if (featurep 'xemacs) ;; XEmacs (put 'ada-mode 'font-lock-defaults @@ -1414,10 +1399,9 @@ ;; transient-mark-mode and mark-active are not defined in XEmacs (defun ada-region-selected () "Return t if a region has been selected by the user and is still active." - (or (and (featurep 'xemacs) (funcall (symbol-function 'region-active-p))) - (and (not (featurep 'xemacs)) - (symbol-value 'transient-mark-mode) - (symbol-value 'mark-active)))) + (if (featurep 'xemacs) + (region-active-p) + (and transient-mark-mode mark-active))) ;;----------------------------------------------------------------- @@ -4041,7 +4025,7 @@ If BACKWARD is non-nil, search backward; search forward otherwise. The search stops at pos LIMIT. If PARAMLISTS is nil, ignore parameter lists. -The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized +The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized in case we are searching for a constant string. Point is moved at the beginning of the SEARCH-RE." (let (found @@ -4562,9 +4546,7 @@ (define-key ada-mode-map "\t" 'ada-tab) (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current) (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region) - (if (featurep 'xemacs) - (define-key ada-mode-map '(shift tab) 'ada-untab) - (define-key ada-mode-map [(shift tab)] 'ada-untab)) + (define-key ada-mode-map [(shift tab)] 'ada-untab) (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist) ;; We don't want to make meta-characters case-specific. @@ -4587,9 +4569,9 @@ ;; On XEmacs, you can easily specify whether DEL should deletes ;; one character forward or one character backward. Take this into ;; account - (if (boundp 'delete-key-deletes-forward) - (define-key ada-mode-map [backspace] 'backward-delete-char-untabify) - (define-key ada-mode-map "\177" 'backward-delete-char-untabify)) + (define-key ada-mode-map + (if (boundp 'delete-key-deletes-forward) [backspace] "\177") + 'backward-delete-char-untabify) ;; Make body (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body) @@ -4601,12 +4583,10 @@ ;; The following keys are bound to functions defined in ada-xref.el or ;; ada-prj,el., However, RMS rightly thinks that the code should be shared, ;; and activated only if the right compiler is used - (if (featurep 'xemacs) - (progn - (define-key ada-mode-map '(shift button3) 'ada-point-and-xref) - (define-key ada-mode-map '(control tab) 'ada-complete-identifier)) - (define-key ada-mode-map [C-tab] 'ada-complete-identifier) - (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref)) + + (define-key ada-mode-map (if (featurep 'xemacs) '(shift button3) [S-mouse-3]) + 'ada-point-and-xref) + (define-key ada-mode-map [(control tab)] 'ada-complete-identifier) (define-key ada-mode-map "\C-co" 'ff-find-other-file) (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame) @@ -5570,5 +5550,5 @@ ;;; provide ourselves (provide 'ada-mode) -;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270 +;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270 ;;; ada-mode.el ends here
--- a/lisp/progmodes/cperl-mode.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/progmodes/cperl-mode.el Mon Aug 27 04:00:19 2007 +0000 @@ -96,7 +96,7 @@ nil)) (or (fboundp 'custom-declare-variable) (defmacro defcustom (name val doc &rest arr) - (` (defvar (, name) (, val) (, doc))))) + `(defvar ,name ,val ,doc))) (or (and (fboundp 'custom-declare-variable) (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work (defmacro defface (&rest arr) @@ -104,52 +104,52 @@ ;; Avoid warning (tmp definitions) (or (fboundp 'x-color-defined-p) (defmacro x-color-defined-p (col) - (cond ((fboundp 'color-defined-p) (` (color-defined-p (, col)))) + (cond ((fboundp 'color-defined-p) `(color-defined-p ,col)) ;; XEmacs >= 19.12 - ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col)))) + ((fboundp 'valid-color-name-p) `(valid-color-name-p ,col)) ;; XEmacs 19.11 - ((fboundp 'x-valid-color-name-p) (` (x-valid-color-name-p (, col)))) + ((fboundp 'x-valid-color-name-p) `(x-valid-color-name-p ,col)) (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) - (` (find-face (, arg)))) + `(find-face ,arg)) (;;(and (fboundp 'face-list) ;; (face-list)) (fboundp 'face-list) - (` (member (, arg) (and (fboundp 'face-list) - (face-list))))) + `(member ,arg (and (fboundp 'face-list) + (face-list)))) (t - (` (boundp (, arg)))))) + `(boundp ,arg)))) (defmacro cperl-make-face (arg descr) ; Takes unquoted arg (cond ((fboundp 'make-face) - (` (make-face (quote (, arg))))) + `(make-face (quote ,arg))) (t - (` (defvar (, arg) (quote (, arg)) (, descr)))))) + `(defvar ,arg (quote ,arg) ,descr)))) (defmacro cperl-force-face (arg descr) ; Takes unquoted arg - (` (progn - (or (cperl-is-face (quote (, arg))) - (cperl-make-face (, arg) (, descr))) - (or (boundp (quote (, arg))) ; We use unquoted variants too - (defvar (, arg) (quote (, arg)) (, descr)))))) + `(progn + (or (cperl-is-face (quote ,arg)) + (cperl-make-face ,arg ,descr)) + (or (boundp (quote ,arg)) ; We use unquoted variants too + (defvar ,arg (quote ,arg) ,descr)))) (if cperl-xemacs-p (defmacro cperl-etags-snarf-tag (file line) - (` (progn - (beginning-of-line 2) - (list (, file) (, line))))) + `(progn + (beginning-of-line 2) + (list ,file ,line))) (defmacro cperl-etags-snarf-tag (file line) - (` (etags-snarf-tag)))) + `(etags-snarf-tag))) (if cperl-xemacs-p (defmacro cperl-etags-goto-tag-location (elt) - (`;;(progn - ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0))) - ;; (set-buffer (get-file-buffer (elt (, elt) 0))) - ;; Probably will not work due to some save-excursion??? - ;; Or save-file-position? - ;; (message "Did I get to line %s?" (elt (, elt) 1)) - (goto-line (string-to-int (elt (, elt) 1))))) + ;;(progn + ;; (switch-to-buffer (get-file-buffer (elt ,elt 0))) + ;; (set-buffer (get-file-buffer (elt ,elt 0))) + ;; Probably will not work due to some save-excursion??? + ;; Or save-file-position? + ;; (message "Did I get to line %s?" (elt ,elt 1)) + `(goto-line (string-to-int (elt ,elt 1)))) ;;) (defmacro cperl-etags-goto-tag-location (elt) - (` (etags-goto-tag-location (, elt)))))) + `(etags-goto-tag-location ,elt)))) (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version)) @@ -1794,8 +1794,8 @@ ;; This one is obsolete... (make-local-variable 'vc-header-alist) (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning - (` ((SCCS (, (car cperl-vc-sccs-header))) - (RCS (, (car cperl-vc-rcs-header))))))) + `((SCCS ,(car cperl-vc-sccs-header)) + (RCS ,(car cperl-vc-rcs-header))))) (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x (make-local-variable 'compilation-error-regexp-alist-alist) (set 'compilation-error-regexp-alist-alist @@ -5957,25 +5957,25 @@ nil t))) ; local variables, multiple (font-lock-anchored ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var - (` ((, (concat "\\<\\(my\\|local\\|our\\)" + `(,(concat "\\<\\(my\\|local\\|our\\)" cperl-maybe-white-and-comment-rex "\\((" cperl-maybe-white-and-comment-rex - "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")) - (5 (, (if cperl-font-lock-multiline + "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)") + (5 ,(if cperl-font-lock-multiline 'font-lock-variable-name-face '(progn (setq cperl-font-lock-multiline-start (match-beginning 0)) - 'font-lock-variable-name-face)))) - ((, (concat "\\=" + 'font-lock-variable-name-face))) + (,(concat "\\=" cperl-maybe-white-and-comment-rex "," cperl-maybe-white-and-comment-rex - "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)")) + "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)") ;; Bug in font-lock: limit is used not only to limit ;; searches, but to set the "extend window for ;; facification" property. Thus we need to minimize. - (, (if cperl-font-lock-multiline + ,(if cperl-font-lock-multiline '(if (match-beginning 3) (save-excursion (goto-char (match-beginning 3)) @@ -5989,8 +5989,8 @@ (forward-char -2)) ; disable continued expr '(if (match-beginning 3) (point-max) ; No limit for continuation - (forward-char -2)))) ; disable continued expr - (, (if cperl-font-lock-multiline + (forward-char -2))) ; disable continued expr + ,(if cperl-font-lock-multiline nil '(progn ; Do at end ;; "my" may be already fontified (POD), @@ -6003,8 +6003,8 @@ (put-text-property (1+ cperl-font-lock-multiline-start) (point) 'syntax-type 'multiline)) - (setq cperl-font-lock-multiline-start nil)))) - (3 font-lock-variable-name-face))))) + (setq cperl-font-lock-multiline-start nil))) + (3 font-lock-variable-name-face)))) (t '("^[ \t{}]*\\(my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" 3 font-lock-variable-name-face))) '("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
--- a/lisp/simple.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/simple.el Mon Aug 27 04:00:19 2007 +0000 @@ -3639,7 +3639,7 @@ :type 'boolean :group 'editing-basics) -(defun line-move-invisible-p (pos) +(defun invisible-p (pos) "Return non-nil if the character after POS is currently invisible." (let ((prop (get-char-property pos 'invisible))) @@ -3647,6 +3647,7 @@ prop (or (memq prop buffer-invisibility-spec) (assq prop buffer-invisibility-spec))))) +(define-obsolete-function-alias 'line-move-invisible-p 'invisible-p) ;; Returns non-nil if partial move was done. (defun line-move-partial (arg noerror to-end) @@ -3767,7 +3768,7 @@ (while (and (> arg 0) (not done)) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. - (while (and (not (eobp)) (line-move-invisible-p (point))) + (while (and (not (eobp)) (invisible-p (point))) (goto-char (next-char-property-change (point)))) ;; Move a line. ;; We don't use `end-of-line', since we want to escape @@ -3785,7 +3786,7 @@ (setq done t))) ((and (> arg 1) ;; Use vertical-motion for last move (not (integerp selective-display)) - (not (line-move-invisible-p (point)))) + (not (invisible-p (point)))) ;; We avoid vertical-motion when possible ;; because that has to fontify. (forward-line 1)) @@ -3814,7 +3815,7 @@ (setq done t))) ((and (< arg -1) ;; Use vertical-motion for last move (not (integerp selective-display)) - (not (line-move-invisible-p (1- (point))))) + (not (invisible-p (1- (point))))) (forward-line -1)) ((zerop (vertical-motion -1)) (if (not noerror) @@ -3826,7 +3827,7 @@ ;; if our target is the middle of this line. (or (zerop (or goal-column temporary-goal-column)) (< arg 0)) - (not (bobp)) (line-move-invisible-p (1- (point)))) + (not (bobp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point)))))))) ;; This is the value the function returns. (= arg 0)) @@ -3858,7 +3859,7 @@ (save-excursion ;; Like end-of-line but ignores fields. (skip-chars-forward "^\n") - (while (and (not (eobp)) (line-move-invisible-p (point))) + (while (and (not (eobp)) (invisible-p (point))) (goto-char (next-char-property-change (point))) (skip-chars-forward "^\n")) (point)))) @@ -3941,13 +3942,13 @@ (move-to-column col)) (when (and line-move-ignore-invisible - (not (bolp)) (line-move-invisible-p (1- (point)))) + (not (bolp)) (invisible-p (1- (point)))) (let ((normal-location (point)) (normal-column (current-column))) ;; If the following character is currently invisible, ;; skip all characters with that same `invisible' property value. (while (and (not (eobp)) - (line-move-invisible-p (point))) + (invisible-p (point))) (goto-char (next-char-property-change (point)))) ;; Have we advanced to a larger column position? (if (> (current-column) normal-column) @@ -3960,7 +3961,7 @@ ;; but with a more reasonable buffer position. (goto-char normal-location) (let ((line-beg (save-excursion (beginning-of-line) (point)))) - (while (and (not (bolp)) (line-move-invisible-p (1- (point)))) + (while (and (not (bolp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point) line-beg)))))))) (defun move-end-of-line (arg) @@ -3981,7 +3982,7 @@ (and (line-move arg t) (not (bobp)) (progn - (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) + (while (and (not (bobp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point)))) (backward-char 1))) (point))))) @@ -4017,13 +4018,13 @@ ;; Move to beginning-of-line, ignoring fields and invisibles. (skip-chars-backward "^\n") - (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) + (while (and (not (bobp)) (invisible-p (1- (point)))) (goto-char (previous-char-property-change (point))) (skip-chars-backward "^\n")) (setq start (point)) ;; Now find first visible char in the line - (while (and (not (eobp)) (line-move-invisible-p (point))) + (while (and (not (eobp)) (invisible-p (point))) (goto-char (next-char-property-change (point)))) (setq first-vis (point))
--- a/lisp/textmodes/texinfmt.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/textmodes/texinfmt.el Mon Aug 27 04:00:19 2007 +0000 @@ -3250,7 +3250,7 @@ ;; Take arguments ;; @,{c} ==> c, cedilla accent -(put ', 'texinfo-format 'texinfo-format-cedilla-accent) +(put '\, 'texinfo-format 'texinfo-format-cedilla-accent) (defun texinfo-format-cedilla-accent () (insert (texinfo-parse-arg-discard) ",") (goto-char texinfo-command-start))
--- a/lisp/uniquify.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/uniquify.el Mon Aug 27 04:00:19 2007 +0000 @@ -235,6 +235,14 @@ (with-current-buffer (uniquify-item-buffer (car items)) (setq uniquify-managed nil)) (setq items nil))) + ;; In case we missed some calls to kill-buffer, there may be dead + ;; buffers in uniquify-managed, so filter them out. + (setq items + (delq nil (mapcar + (lambda (item) + (if (buffer-live-p (uniquify-item-buffer item)) + item)) + items))) (setq fix-list (append fix-list items)))) ;; selects buffers whose names may need changing, and others that ;; may conflict, then bring conflicting names together
--- a/lisp/vc.el Mon Aug 27 03:36:34 2007 +0000 +++ b/lisp/vc.el Mon Aug 27 04:00:19 2007 +0000 @@ -3411,7 +3411,7 @@ vc-annotate-parent-display-mode buf) (goto-line (min oldline (progn (goto-char (point-max)) - (previous-line) + (forward-line -1) (line-number-at-pos))) buf))))) (defun vc-annotate-compcar (threshold a-list)
--- a/lispref/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/lispref/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -1,3 +1,7 @@ +2007-08-25 Richard Stallman <rms@gnu.org> + + * display.texi (Images): Delete redundant @findex. + 2007-08-16 Richard Stallman <rms@gnu.org> * processes.texi (Asynchronous Processes): Clarify @@ -138,8 +142,7 @@ 2007-06-01 Stefan Monnier <monnier@iro.umontreal.ca> - * text.texi (Special Properties): Correct meaning of fontified - face. + * text.texi (Special Properties): Correct meaning of fontified face. 2007-05-30 Richard Stallman <rms@gnu.org>
--- a/lispref/display.texi Mon Aug 27 03:36:34 2007 +0000 +++ b/lispref/display.texi Mon Aug 27 04:00:19 2007 +0000 @@ -3649,9 +3649,7 @@ into Emacs. @end defvar -@defun image-type-available-p type -@findex image-type-available-p - +@defun image-type-available-p type This function returns non-@code{nil} if image type @var{type} is available, i.e., if images of this type can be loaded and displayed in Emacs. @var{type} should be one of the types contained in
--- a/lispref/macros.texi Mon Aug 27 03:36:34 2007 +0000 +++ b/lispref/macros.texi Mon Aug 27 04:00:19 2007 +0000 @@ -365,7 +365,7 @@ following expression. This syntax is still accepted, for compatibility with old Emacs -versions, but we recommend not using it in new programs. +versions, but support for it will soon disappear. @node Problems with Macros @section Common Problems Using Macros
--- a/man/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/man/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -1,10 +1,13 @@ +2007-08-24 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change) + + * message.texi (MIME): Replace mml-attach with mml-attach-file. + 2007-08-22 Carsten Dominik <dominik@science.uva.nl> * org.texi (Adding hyperlink types): New section. (Embedded LaTeX): Chapter updated because of LaTeX export. (LaTeX export): New section. (Using links out): New section. - 2007-08-22 Glenn Morris <rgm@gnu.org>
--- a/man/message.texi Mon Aug 27 03:36:34 2007 +0000 +++ b/man/message.texi Mon Aug 27 04:00:19 2007 +0000 @@ -821,11 +821,11 @@ automatically add the @code{Content-Type} and @code{Content-Transfer-Encoding} headers. -@findex mml-attach +@findex mml-attach-file @kindex C-c C-a The most typical thing users want to use the multipart things in @acronym{MIME} for is to add ``attachments'' to mail they send out. -This can be done with the @kbd{C-c C-a} command (@kbd{M-x mml-attach}), +This can be done with the @kbd{C-c C-a} command (@kbd{M-x mml-attach-file}), which will prompt for a file name and a @acronym{MIME} type. @vindex mml-dnd-protocol-alist
--- a/src/ChangeLog Mon Aug 27 03:36:34 2007 +0000 +++ b/src/ChangeLog Mon Aug 27 04:00:19 2007 +0000 @@ -68,6 +68,28 @@ (svg_type): New static `image_type' struct. (librsvg/rsvg.h): Include it. +2007-08-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * lread.c (load_warn_old_style_backquotes): Fix up array size typo. + +2007-08-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * lread.c (Qold_style_backquotes): New var. + (syms_of_lread): Init and staticpro it. + (load_warn_old_style_backquotes): New fun. + (Fload): Use them to warn about old style backquotes. + (end_of_file_error, Fload): Remove unused vars. + + * lisp.h (Fclear_face_cache, Fx_send_client_event): Declare. + + * lread.c (Vold_style_backquotes): New var. + (syms_of_lread): Init and export it to Elisp. + (read1): Set it when we find an old-style (back)quote. + +2007-08-22 Jason Rumney <jasonr@gnu.org> + + * w32reg.c (SYSTEM_DEFAULT_RESOURCES): Add missing NULL terminator. + 2007-08-22 Katsumi Yamaoka <yamaoka@jpl.org> * puresize.h (BASE_PURESIZE): Increase to 1140000.
--- a/src/lread.c Mon Aug 27 03:36:34 2007 +0000 +++ b/src/lread.c Mon Aug 27 04:00:19 2007 +0000 @@ -193,6 +193,7 @@ Fread initializes this to zero, so we need not specbind it or worry about what happens to it when there is an error. */ static int new_backquote_flag; +static Lisp_Object Vold_style_backquotes, Qold_style_backquotes; /* A list of file names for files being loaded in Fload. Used to check for recursive loads. */ @@ -698,6 +699,20 @@ return Qnil; } +static Lisp_Object +load_warn_old_style_backquotes (file) + Lisp_Object file; +{ + if (!NILP (Vold_style_backquotes)) + { + Lisp_Object args[2]; + args[0] = build_string ("!! File %s uses old-style backquotes !!"); + args[1] = file; + Fmessage (2, args); + } + return Qnil; +} + DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, doc: /* Return the suffixes that `load' should try if a suffix is \ required. @@ -762,7 +777,6 @@ register FILE *stream; register int fd = -1; int count = SPECPDL_INDEX (); - Lisp_Object temp; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object found, efound, hist_file_name; /* 1 means we printed the ".el is newer" message. */ @@ -896,6 +910,10 @@ tmp)) : found) ; + /* Check fore the presence of old-style quotes and warn about them. */ + specbind (Qold_style_backquotes, Qnil); + record_unwind_protect (load_warn_old_style_backquotes, file); + if (!bcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)) /* Load .elc files directly, but not when they are @@ -1381,8 +1399,6 @@ static void end_of_file_error () { - Lisp_Object data; - if (STRINGP (Vload_file_name)) xsignal1 (Qend_of_file, Vload_file_name); @@ -2443,7 +2459,10 @@ case '`': if (first_in_list) - goto default_label; + { + Vold_style_backquotes = Qt; + goto default_label; + } else { Lisp_Object value; @@ -2478,7 +2497,10 @@ return Fcons (comma_type, Fcons (value, Qnil)); } else - goto default_label; + { + Vold_style_backquotes = Qt; + goto default_label; + } case '?': { @@ -4191,6 +4213,12 @@ doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); Veval_buffer_list = Qnil; + DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes, + doc: /* Set to non-nil when `read' encounters an old-style backquote. */); + Vold_style_backquotes = Qnil; + Qold_style_backquotes = intern ("old-style-backquotes"); + staticpro (&Qold_style_backquotes); + /* Vsource_directory was initialized in init_lread. */ load_descriptor_list = Qnil;
--- a/src/w32reg.c Mon Aug 27 03:36:34 2007 +0000 +++ b/src/w32reg.c Mon Aug 27 04:00:19 2007 +0000 @@ -41,7 +41,7 @@ "emacs.tool-bar.attributeBackground:SystemButtonFace\0" \ "emacs.menu.attributeForeground:SystemMenuText\0" \ "emacs.menu.attributeBackground:SystemMenu\0" \ - "emacs.scroll-bar.attributeForeground:SystemScrollbar" + "emacs.scroll-bar.attributeForeground:SystemScrollbar\0" /* Other possibilities for default faces: