mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-23 18:47:57 +00:00
Code Issues Releases Activity

Merge from emacs--rel--22

Browse Source 
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
This commit is contained in:
Miles Bader 2007-08-27 04:00:19 +00:00
commit 7f22a76506
35 changed files with 665 additions and 521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README
View File

@ -76,7 +76,7 @@ There are several subdirectories:
`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.

14
admin/FOR-RELEASE
View File

@ -38,6 +38,13 @@ to the hack introduced on 2005-07-01 to fix some other Cleartype problem.
** 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 @@ won't lose on USG or HPUX systems.
* 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.

2
etc/ChangeLog
View File

@ -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>

10
etc/NEWS.22
View File

@ -41,6 +41,8 @@ below. Emacs tries to warn you about these through `bad-packages-alist'.
* 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 @@ in to make it use the scrollbars from the system theme.
* 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.

27
etc/README
View File

@ -10,8 +10,35 @@ for Emacs functions and variables.
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.

6
lib-src/ChangeLog
View File

@ -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.

13
lib-src/Makefile.in
View File

@ -268,18 +268,21 @@ BASE_CFLAGS = C_SWITCH_SYSTEM C_SWITCH_MACHINE -DHAVE_CONFIG_H \
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:

53
lisp/ChangeLog
View File

@ -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.

178
lisp/dframe.el
View File

@ -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 @@ Local to those buffers, as a function called that created it.")
'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 @@ Local to those buffers, as a function called that created it.")
;; 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 @@ Local to those buffers, as a function called that created it.")
;; 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 @@ CREATE-HOOK are hooks to run after creating a frame."
(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 @@ CREATE-HOOK are hooks to run after creating a frame."
;; 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 @@ CREATE-HOOK are hooks to run after creating a frame."
(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 @@ CREATE-HOOK are hooks to run after creating a frame."
(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 @@ LOCATION can be one of 'random, 'left-right, or 'top-bottom."
(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."
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 @@ If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer."
(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 @@ If NULL-ON-ERROR is a symbol, set it to nil if we cannot create a timer."
(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 @@ Evaluates all cached timer functions in sequence."
;; 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 @@ BUFFER and POSITION are optional because XEmacs doesn't use them."
(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 @@ redirected into a window on the attached frame."
(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 @@ This hack overrides it so that the right thing happens in the main
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))

9
lisp/emacs-lisp/backquote.el
View File

@ -85,10 +85,10 @@ For example (backquote-list* 'a 'b 'c) => (a b . c)"
(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 @@ Vectors work just like lists. Nested backquotes are permitted."
(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))))

6
lisp/emacs-lisp/byte-opt.el
View File

@ -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))

21
lisp/emacs-lisp/bytecomp.el
View File

@ -1010,8 +1010,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(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 @@ recompile every `.el' file that already has a `.elc' file."
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 @@ The value is non-nil if there were no errors, nil if errors."
(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 @@ The value is non-nil if there were no errors, nil if errors."
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 @@ With argument, insert value in current buffer after the form."
(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)

8
lisp/emacs-lisp/edebug.el
View File

@ -1507,7 +1507,7 @@ expressions; a `progn' form will be returned enclosing these forms."
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 @@ expressions; a `progn' form will be returned enclosing these forms."
((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 @@ expressions; a `progn' form will be returned enclosing these forms."
(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.

22
lisp/gnus/ChangeLog
View File

@ -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>

35
lisp/gnus/gnus-salt.el
View File

@ -134,11 +134,10 @@ It accepts the same format specs that `gnus-summary-line-format' does."
(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 @@ Two predefined functions are available:
(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 @@ Two predefined functions are available:
(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 @@ Two predefined functions are available:
"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 @@ Two predefined functions are available:
(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 @@ Two predefined functions are available:
(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 @@ Two predefined functions are available:
(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 @@ Two predefined functions are available:
(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 @@ The following commands are available:
(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)))

28
lisp/gnus/hex-util.el
View File

@ -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

9
lisp/gnus/mml.el
View File

@ -404,7 +404,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(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 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(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

153
lisp/gnus/sha1.el
View File

@ -123,93 +123,93 @@ If this variable is set to nil, use internal function only."
(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 @@ hash of a portion of OBJECT.
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

134
lisp/net/browse-url.el
View File

@ -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 @@ regexp should probably be \".\" to specify a default browser."
(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 @@ system, given vroot.h from the same directory, with cc flags
: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 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time
;;;###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 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
;;;###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 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time
(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 @@ functionality is not available there."
: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 @@ window."
: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 @@ commands reverses the effect of this variable. Requires Netscape version
: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 @@ address to an HTTP URL:
\"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 @@ address to an HTTP URL:
: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 @@ file rather than displaying a cached copy."
: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 @@ enabled. The port number should be set in `browse-url-CCI-port'."
(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 @@ highlighting, assuming the normal default for showing the cursor."
: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 @@ down (this *won't* always work)."
: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 @@ interactively. Turn the filename into a URL with function
(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))))))
@ -1170,6 +1166,20 @@ used instead of `browse-url-new-window-flag'."
browse-url-epiphany-program
(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'.
@ -1257,8 +1267,7 @@ Default to the URL around or before point. Runs the program in the
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 @@ used instead of `browse-url-new-window-flag'."
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 @@ Default to the URL around or before point."
(provide 'browse-url)
;;; arch-tag: d2079573-5c06-4097-9598-f550fba19430
;; arch-tag: d2079573-5c06-4097-9598-f550fba19430
;;; browse-url.el ends here

21
lisp/net/socks.el
View File

@ -263,10 +263,9 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(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 @@ version.")
(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 @@ version.")
(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 @@ version.")
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))))

2
lisp/pcvs.el
View File

@ -1904,7 +1904,7 @@ With prefix argument, prompt for cvs flags."
(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)

232
lisp/progmodes/ada-mode.el
View File

@ -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.
;; 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.
;; 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 @@ This variable defines several rules to use to align different lines.")
"\\(\\(\\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 @@ If you use ada-xref.el:
;; 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 @@ If you use ada-xref.el:
;; 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 @@ If you use ada-xref.el:
;; 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 @@ Returns a cons cell of begin and end of match data or nil, if not found.
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 @@ Moves to 'begin' if in a declarative part."
(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 @@ Moves to 'begin' if in a declarative part."
;; 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 @@ Moves to 'begin' if in a declarative part."
;; 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 @@ This function typically is to be hooked into `ff-file-created-hook'."
;;; provide ourselves
(provide 'ada-mode)
;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
;;; ada-mode.el ends here

80
lisp/progmodes/cperl-mode.el
View File

@ -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 @@ or as help on variables `cperl-tips', `cperl-problems',
;; 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 @@ indentation and initial hashes. Behaves usually outside of comment."
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 @@ indentation and initial hashes. Behaves usually outside of comment."
(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 @@ indentation and initial hashes. Behaves usually outside of comment."
(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]*("

25
lisp/simple.el
View File

@ -3639,7 +3639,7 @@ Outline mode sets this."
: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 @@ Outline mode sets this."
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 @@ Outline mode sets this."
(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 @@ Outline mode sets this."
(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 @@ Outline mode sets this."
(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 @@ Outline mode sets this."
;; 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 @@ Outline mode sets this."
(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 @@ and `current-column' to be able to ignore invisible text."
(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 @@ and `current-column' to be able to ignore invisible text."
;; 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 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(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 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
;; 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))

2
lisp/textmodes/texinfmt.el
View File

@ -3250,7 +3250,7 @@ Default is to leave paragraph indentation as is."
;; 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))

8
lisp/uniquify.el
View File

@ -235,6 +235,14 @@ this rationalization."
(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

2
lisp/vc.el
View File

@ -3411,7 +3411,7 @@ revision."
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)

7
lispref/ChangeLog
View File

@ -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>

4
lispref/display.texi
View File

@ -3649,9 +3649,7 @@ This variable is ignored if the image libraries are statically linked
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

2
lispref/macros.texi
View File

@ -365,7 +365,7 @@ whitespace between the @samp{`}, @samp{,} or @samp{,@@} and the
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

5
man/ChangeLog
View File

@ -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>

4
man/message.texi
View File

@ -821,11 +821,11 @@ doesn't have to do anything to make the @acronym{MIME} happen---Message will
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

22
src/ChangeLog
View File

@ -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.

38
src/lread.c
View File

@ -193,6 +193,7 @@ static file_offset prev_saved_doc_string_position;
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 @@ load_error_handler (data)
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 @@ Return t if the file exists and loads successfully. */)
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 @@ Return t if the file exists and loads successfully. */)
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 @@ readevalloop_1 (old)
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 @@ read1 (readcharfun, pch, first_in_list)
case '`':
if (first_in_list)
goto default_label;
{
Vold_style_backquotes = Qt;
goto default_label;
}
else
{
Lisp_Object value;
@ -2478,7 +2497,10 @@ read1 (readcharfun, pch, first_in_list)
return Fcons (comma_type, Fcons (value, Qnil));
}
else
goto default_label;
{
Vold_style_backquotes = Qt;
goto default_label;
}
case '?':
{
@ -4191,6 +4213,12 @@ to load. See also `load-dangerous-libraries'. */);
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;

2
src/w32reg.c
View File

@ -41,7 +41,7 @@ Boston, MA 02110-1301, USA. */
"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: