mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

Merged in changes from CVS trunk.

Browse source 
Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-639
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-640
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-641
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-642
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-643
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-644
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-645
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-646
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-647
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-648
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-649
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-650
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-651
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-652
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-59
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-60
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-61
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-62
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-63
   Update from CVS


git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-263
This commit is contained in:
Karoly Lorentey 2004-10-31 02:05:24 +00:00
commit e0bc17abe6
79 changed files with 1603 additions and 938 deletions
Download patch file Download diff file Expand all files Collapse all files

20
etc/NEWS
View file

@ -98,6 +98,12 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
+++
** `set-auto-mode' now gives the interpreter magic line (if present)
precedence over the file name. Likewise an <?xml or <!DOCTYPE declaration
will give the buffer XML or SGML mode, unless the file name leads to a mode in
`xml-based-modes'.
+++
** New function `looking-back' checks whether a regular expression matches
the text before point. Specifying the LIMIT argument bounds how far
@ -864,6 +870,9 @@ coding system now also encodes characters from most of Emacs's
one-dimensional internal charsets, specifically the ISO-8859 ones.
The utf-16 coding system is affected similarly.
** New variable `utf-translate-cjk-unicode-range' controls which
Unicode characters to translate in `utf-translate-cjk-mode'.
** iso-10646-1 (`Unicode') fonts can be used to display any range of
characters encodable by the utf-8 coding system. Just specify the
fontset appropriately.
@ -2289,6 +2298,11 @@ configuration files.
* Lisp Changes in Emacs 21.4
+++
** An interactive specification may now use the code letter 'U' to get
the up-event that was discarded in case the last key sequence read for a
previous 'k' or 'K' argument was a down-event; otherwise nil is used.
** Function `translate-region' accepts also a char-table as TABLE
argument.
@ -3092,11 +3106,13 @@ KEEP-MARGINS which will preserve the window's current margin, fringe,
and scroll-bar settings if non-nil.
+++
** Renamed file hooks to follow the convention:
** Renamed hooks to better follow the naming convention:
find-file-hooks to find-file-hook,
find-file-not-found-hooks to find-file-not-found-functions,
write-file-hooks to write-file-functions,
write-contents-hooks to write-contents-functions.
write-contents-hooks to write-contents-functions,
x-lost-selection-hooks to x-lost-selection-functions,
x-sent-selection-hooks to x-sent-selection-functions.
Marked local-write-file-hooks as obsolete (use the LOCAL arg of `add-hook').
+++

21
etc/compilation.txt
View file

@ -108,6 +108,24 @@ symbol: epc
Error 24 at (2:progran.f90) : syntax error
* Fortran checker
symbols: ftnchek-file ftnchek-line-file ftnchek-line
File average.f:
Warning in module COMPAV: Variables may be used before set:
SUM used at line 14
SUM set at line 14
Warning near line 16 col 20: integer quotient expr I/J converted to real
Dummy arg W in module SUBA line 8 file arrayclash.f is array
L4 used at line 55 file test/assign.f; never set
Warning near line 10 file arrayclash.f: Module contains no executable
Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit
* IAR Systems C Compiler
symbol: iar
@ -125,7 +143,7 @@ foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
foo.c(5:5) : error EDC0350: Syntax error.
* Ultrix MIPS RISC CC & DEC AXP OSF/1 cc & IRIX 5.2
* Ultrix MIPS RISC CC, DEC AXP OSF/1 cc, IRIX 5.2 & NAG Fortran
symbol: irix
@ -136,6 +154,7 @@ cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah
foo bar: baz.f, line 27: ...
* Java Exception & Valgrind (memory debugger for x86 GNU/Linux)

238
lisp/ChangeLog
View file

@ -1,7 +1,221 @@
2004-10-30 Simon Josefsson <jas@extundo.com>
* progmodes/autoconf.el (autoconf-font-lock-keywords): Recognize
AS_* too.
2004-10-29 Simon Josefsson <jas@extundo.com>
* subr.el (read-passwd): Move back from password.el.
* password.el: Remove, not ready yet.
2004-10-29 Andreas Schwab <schwab@suse.de>
* speedbar.el (speedbar-frame-parameters): Improve customize type.
2004-10-29 Sam Steingold <sds@gnu.org>
* mouse.el (mouse-show-mark): Replace the last occurrence of
x-lost-selection-hooks with x-lost-selection-functions.
2004-10-28 Stefan <monnier@iro.umontreal.ca>
* mouse.el (mouse-show-mark): Adjust to new name and don't assume
x-lost-selection-functions is bound.
* mouse-sel.el (mouse-sel-mode):
* emacs-lisp/lselect.el: Adjust to new names for
x-(lost|sent)-selection-functions.
* subr.el (x-lost-selection-hooks, x-sent-selection-hooks):
New obsolete aliases of x-lost-selection-functions and
x-sent-selection-functions.
2004-10-28 Kim F. Storm <storm@cua.dk>
* imenu.el (imenu-scanning-message): Remove.
(imenu-progress-message): Make it a no-op.
2004-10-28 John Paul Wallington <jpw@gnu.org>
* files.el (set-auto-mode): Call `throw' correctly.
2004-10-28 Juri Linkov <juri@jurta.org>
* info.el (Info-file-list-for-emacs): Add ("Info" . "info")
to search `Info-...' commands in `info' manual.
(Info-goto-emacs-command-node, Info-goto-emacs-key-command-node):
Add 'info-file "emacs" property.
(Info-find-emacs-command-nodes): Fix index line number regexp.
Set real line number (instead of fake 0) in first element of the
returned list.
(Info-goto-emacs-command-node): Use line number of first element
to set point in the first found Info node.
* progmodes/grep.el (grep-regexp-alist): Move match highlighting
code to `grep-mode-font-lock-keywords'.
(grep-mode-font-lock-keywords): Delete grep markers instead
of making them invisible.
2004-10-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* mail/emacsbug.el (report-emacs-bug): Insert x-server-vendor
and x-server-version in bug report.
2004-10-28 Daniel Pfeiffer <occitan@esperanto.org>
* files.el (set-auto-mode-0): New function.
(set-auto-mode): Use it to handle aliased modes and to
be consistent between C-x C-f and C-x C-w.
2004-10-28 Kenichi Handa <handa@m17n.org>
* international/utf-8.el (utf-translate-cjk-charsets): Add
katakana-jisx0201.
* international/subst-jis.el: Add data for JISX0201.
2004-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
* obsolete/hilit19.el (hilit-mode): New function.
Move all the toplevel side-effecting stuff into it, so that loading
hilit19 doesn't mess everything up any more.
2004-10-27 Richard M. Stallman <rms@gnu.org>
* add-log.el (add-change-log-entry): Set up mailing address
and full name later, and don't alter add-log-mailing-address
or add-log-full-name.
* elide-head.el (elide-head): Change error to message.
(elide-head-show): Likewise.
* apropos.el (apropos-macrop): Doc fix.
* mouse.el (mouse-show-mark): Do most processing the same
regardless of transient-mark-mode.
* shadowfile.el (shadow-copy-files): Use interactive-p
only to control whether to print a message.
* tar-mode.el (tar-mode): Use write-contents-functions,
not write-contents-hooks.
* eshell/em-unix.el (eshell-du-sum-directory): Don't use
directory-sep-char.
2004-10-27 Richard M. Stallman <rms@gnu.org>
* strokes.el (strokes-unload-hook): Fix previous change.
* type-break.el (type-break-run-at-time): Always use run-at-time;
forget the alternatives.
(type-break-cancel-function-timers): Always use cancel-function-timers;
forget the alternatives.
* pcomplete.el (pcomplete-entries): Don't use directory-sep-char.
2004-10-27 Kenichi Handa <handa@m17n.org>
* international/subst-jis.el: Use utf-translate-cjk-substitutable-p.
* international/subst-gb2312.el: Likewise.
* international/subst-big5.el: Likewise.
* international/subst-ksc.el: Likewise.
* international/utf-8.el (utf-translate-cjk-unicode-range-string):
New variable.
(utf-translate-cjk-set-unicode-range): New function.
(utf-translate-cjk-unicode-range): Make it customizable.
(utf-8-post-read-conversion):
Use utf-translate-cjk-unicode-range-string.
(ccl-decode-mule-utf-8): Check utf-subst-table-for-decode for more
Unicode ranges.
2004-10-26 Daniel Pfeiffer <occitan@esperanto.org>
* files.el (auto-mode-alist): Add pod, js, xbm and xpm and group
trivial variants to shorten the list.
(xml-based-modes): New var.
(set-auto-mode): Give interpreter-mode-alist or <?xml or <!DOCTYPE
declaration higher priority than auto-mode-alist.
* find-file.el (cc-other-file-alist): Bring it in line with
cc-mode's auto-mode-alist entries and use \' instead of $.
* textmodes/sgml-mode.el (sgml-mode): Fix imenu-generic-expression
and add "Id" and "Name" submenus to it.
* imenu.el (imenu--generic-function): Skip matches in comments.
2004-10-26 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc,full-calc, calc-quit, calc-keypad)
(full-calc-keypad, calc-trail-display): Use an extra argument
instead of `interactive-p'.
* calc/calc-misc.el (calc-other-window): Use an extra argument
instead of `interactive-p'.
* calc/calc-rewr.el (calc-match): Use an extra argument instead of
`interactive-p'.
2004-10-26 Kim F. Storm <storm@cua.dk>
* help.el (describe-key): Describe both down-event and up-event
for a mouse click.
2004-10-26 Richard M. Stallman <rms@gnu.org>
* woman.el (woman): Don't call interactive-p.
* pcomplete.el (pcomplete): Instead of interactive-p,
use an arg set non-nil by the interactive spec.
* menu-bar.el (menu-bar-make-toggle): Instead of interactive-p,
use an arg set non-nil by the interactive spec.
* man.el (Man-cleanup-manpage): Instead of interactive-p,
use an arg set non-nil by the interactive spec.
2004-10-26 Pavel Kobiakov <pk_at_work@yahoo.com>
* progmodes/flymake.el (flymake-split-string):
Use `flymake-split-string-remove-empty-edges' in any case.
2004-10-26 Masatake YAMATO <jet@gyve.org>
* progmodes/flymake.el (flymake-err-line-patterns):
Use `compilation-error-regexp-alist-alist' instead of
`compilation-error-regexp-alist'.
2004-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/tex-mode.el (tex-font-lock-keywords-1): Fix up the spurious
verbatim face on the \ of \end{verbatim}.
2004-10-25 Jay Belanger <belanger@truman.edu>
* calc/calc-incom.el (calc-digit-dots): Inhibit read-only before
erasing minibuffer.
2004-10-25 Simon Josefsson <jas@extundo.com>
* subr.el (read-passwd): Move to net/password.el.
* net/password.el (read-passwd): Add. Autoload it.
2004-10-25 Kai Grossjohann <kai.grossjohann@gmx.net>
* mouse-sel.el (mouse-sel-mode): Specify custom group.
* simple.el (process-file): Fix logic.
2004-10-24 Luc Teirlinck <teirllm@auburn.edu>
* indent.el (set-left-margin, set-right-margin): Delete redundant
code.
* indent.el (set-left-margin, set-right-margin): Delete redundant code.
(increase-right-margin): Remove erroneous call to `interactive-p'.
2004-10-24 Kim F. Storm <storm@cua.dk>
@ -22,24 +236,23 @@
2004-10-24 Masatake YAMATO <jet@gyve.org>
* progmodes/gdb-ui.el (gdb-assembler-font-lock-keywords): Handle
periods and underscores in a function name.
* progmodes/gdb-ui.el (gdb-assembler-font-lock-keywords):
Handle periods and underscores in a function name.
Remove the address fontification.
2004-10-24 Masatake YAMATO <jet@gyve.org>
* progmodes/asm-mode.el (asm-font-lock-keywords): Use
font-lock-variable-name-face for registers.
* progmodes/asm-mode.el (asm-font-lock-keywords):
Use font-lock-variable-name-face for registers.
2004-10-24 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-get-create-buffer): Allow modes to run
kill-all-local-variables.
(gdb-breakpoints-mode, gdb-frames-mode, gdb-threads-mode)
(gdb-registers-mode, gdb-locals-mode, gdb-assembler-mode): Use
kill-all-local-variables and provide mode-hooks.
(gdb-assembler-font-lock-keywords): New font lock keywords
definition.
(gdb-registers-mode, gdb-locals-mode, gdb-assembler-mode):
Use kill-all-local-variables and provide mode-hooks.
(gdb-assembler-font-lock-keywords): New font lock keywords definition.
(gdb-assembler-mode): Use 'gdb-assembler-font-lock-keywords'.
Suggested by Masatake YAMATO <jet@gyve.org>.
@ -84,13 +297,16 @@
2004-10-21 Jay Belanger <belanger@truman.edu>
* calc/calc-aent.el (calc-alg-ent-map, calc-alg-ent-esc-map):
Declared these variables with defvar.
Declare these variables with defvar.
* calc/calc-aent.el (calc-do-alg-entry): Since `calc-alg-ent-map'
is bound, only check to see if it is bound.
2004-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/tex-mode.el (tex-compilation-parse-errors):
Don't output messages.
* calc/calc-help.el (calc-describe-bindings): Fix last change.
2004-10-21 John Paul Wallington <jpw@gnu.org>

36
lisp/add-log.el
View file

@ -471,20 +471,6 @@ Today's date is calculated according to `change-log-time-zone-rule' if
non-nil, otherwise in local time."
(interactive (list current-prefix-arg
(prompt-for-change-log-name)))
(or add-log-full-name
(setq add-log-full-name (user-full-name)))
(or add-log-mailing-address
(setq add-log-mailing-address user-mail-address))
(if whoami
(progn
(setq add-log-full-name (read-input "Full name: " add-log-full-name))
;; Note that some sites have room and phone number fields in
;; full name which look silly when inserted. Rather than do
;; anything about that here, let user give prefix argument so that
;; s/he can edit the full name field in prompter if s/he wants.
(setq add-log-mailing-address
(read-input "Mailing address: " add-log-mailing-address))))
(let* ((defun (add-log-current-defun))
(version (and change-log-version-info-enabled
(change-log-version-number-search)))
@ -495,7 +481,19 @@ non-nil, otherwise in local time."
(file-name (expand-file-name (find-change-log file-name buffer-file)))
;; Set ITEM to the file name to use in the new item.
(item (add-log-file-name buffer-file file-name))
bound)
bound
(full-name (or add-log-full-name (user-full-name)))
(mailing-address (or add-log-mailing-address user-mail-address)))
(if whoami
(progn
(setq full-name (read-input "Full name: " full-name))
;; Note that some sites have room and phone number fields in
;; full name which look silly when inserted. Rather than do
;; anything about that here, let user give prefix argument so that
;; s/he can edit the full name field in prompter if s/he wants.
(setq mailing-address
(read-input "Mailing address: " mailing-address))))
(unless (equal file-name buffer-file-name)
(if (or other-window (window-dedicated-p (selected-window)))
@ -515,11 +513,11 @@ non-nil, otherwise in local time."
;; Advance into first entry if it is usable; else make new one.
(let ((new-entries (mapcar (lambda (addr)
(concat (funcall add-log-time-format)
" " add-log-full-name
" " full-name
" <" addr ">"))
(if (consp add-log-mailing-address)
add-log-mailing-address
(list add-log-mailing-address)))))
(if (consp mailing-address)
mailing-address
(list mailing-address)))))
(if (and (not add-log-always-start-new-record)
(let ((hit nil))
(dolist (entry new-entries hit)

2
lisp/apropos.el
View file

@ -875,7 +875,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(defun apropos-macrop (symbol)
"T if SYMBOL is a Lisp macro."
"Return t if SYMBOL is a Lisp macro."
(and (fboundp symbol)
(consp (setq symbol
(symbol-function symbol)))

3
lisp/calc/calc-incom.el
View file

@ -183,7 +183,8 @@
(if calc-prev-prev-char
(calcDigit-nondigit)
(setq calc-digit-value nil)
(erase-buffer)
(let ((inhibit-read-only t))
(erase-buffer))
(exit-minibuffer)))
;; just ignore extra decimal point, anticipating ".."
(delete-backward-char 1)))

6
lisp/calc/calc-misc.el
View file

@ -130,9 +130,9 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)."
"Now using full screen for Calc"
"Now using partial screen for Calc"))))
(defun calc-other-window ()
(defun calc-other-window (&optional interactive)
"Invoke the Calculator in another window."
(interactive)
(interactive "p")
(if (memq major-mode '(calc-mode calc-trail-mode))
(progn
(other-window 1)
@ -141,7 +141,7 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)."
(if (get-buffer-window "*Calculator*")
(calc-quit)
(let ((win (selected-window)))
(calc nil win (interactive-p))))))
(calc nil win interactive)))))
(defun another-calc ()
"Create another, independent Calculator buffer."

6
lisp/calc/calc-rewr.el
View file

@ -143,15 +143,15 @@
(calc-pop-push-record-list n "rwrt" (list expr)))
(calc-handle-whys)))
(defun calc-match (pat)
(interactive "sPattern: \n")
(defun calc-match (pat &optional interactive)
(interactive "sPattern: \np")
(calc-slow-wrapper
(let (n expr)
(if (or (null pat) (equal pat "") (equal pat "$"))
(setq expr (calc-top-n 2)
pat (calc-top-n 1)
n 2)
(if (interactive-p) (setq calc-previous-alg-entry pat))
(if interactive (setq calc-previous-alg-entry pat))
(setq pat (if (stringp pat) (math-read-expr pat) pat))
(if (eq (car-safe pat) 'error)
(error "Bad format in expression: %s" (nth 1 pat)))

37
lisp/calc/calc.el
View file

@ -1142,7 +1142,7 @@ commands given here will actually operate on the *Calculator* stack."
;;;###autoload
(defun calc (&optional arg full-display interactive)
"The Emacs Calculator. Full documentation is listed under \"calc-mode\"."
(interactive "P")
(interactive "P\ni\np")
(if arg
(unless (eq arg 0)
(calc-extensions)
@ -1188,17 +1188,16 @@ commands given here will actually operate on the *Calculator* stack."
(window-point full-display)
(select-window full-display))
(calc-check-defines)
(when (and calc-said-hello
(or (interactive-p) interactive))
(when (and calc-said-hello interactive)
(sit-for 2)
(message ""))
(setq calc-said-hello t)))))
;;;###autoload
(defun full-calc ()
(defun full-calc (&optional interactive)
"Invoke the Calculator and give it a full-sized window."
(interactive)
(calc nil t (interactive-p)))
(interactive "p")
(calc nil t interactive))
(defun calc-same-interface (arg)
"Invoke the Calculator using the most recent interface (calc or calc-keypad)."
@ -1215,8 +1214,8 @@ commands given here will actually operate on the *Calculator* stack."
(calc arg calc-full-mode t))))))
(defun calc-quit (&optional non-fatal)
(interactive)
(defun calc-quit (&optional non-fatal interactive)
(interactive "i\np")
(and calc-standalone-flag (not non-fatal)
(save-buffers-kill-emacs nil))
(if (and (equal (buffer-name) "*Gnuplot Trail*")
@ -1226,7 +1225,7 @@ commands given here will actually operate on the *Calculator* stack."
(calc-edit-cancel)
(if (eq major-mode 'MacEdit-mode)
(MacEdit-cancel-edit)
(if (and (interactive-p)
(if (and interactive
calc-embedded-info
(eq (current-buffer) (aref calc-embedded-info 0)))
(calc-embedded nil)
@ -1266,22 +1265,22 @@ or a list containing a character position and an error message in string form."
(calc-do-calc-eval str separator args))
;;;###autoload
(defun calc-keypad ()
(defun calc-keypad (&optional interactive)
"Invoke the Calculator in \"visual keypad\" mode.
This is most useful in the X window system.
In this mode, click on the Calc \"buttons\" using the left mouse button.
Or, position the cursor manually and do M-x calc-keypad-press."
(interactive)
(interactive "p")
(calc-extensions)
(calc-do-keypad calc-full-mode (interactive-p)))
(calc-do-keypad calc-full-mode interactive))
;;;###autoload
(defun full-calc-keypad ()
(defun full-calc-keypad (&optional interactive)
"Invoke the Calculator in full-screen \"visual keypad\" mode.
See calc-keypad for details."
(interactive)
(interactive "p")
(calc-extensions)
(calc-do-keypad t (interactive-p)))
(calc-do-keypad t interactive))
(defvar calc-aborted-prefix nil)
@ -1802,8 +1801,8 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
val)
(defun calc-trail-display (flag &optional no-refresh)
(interactive "P")
(defun calc-trail-display (flag &optional no-refresh interactive)
(interactive "P\ni\np")
(let ((win (get-buffer-window (calc-trail-buffer))))
(if (setq calc-display-trail
(not (if flag (memq flag '(nil 0)) win)))
@ -1817,7 +1816,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
(setq overlay-arrow-string calc-trail-overlay
overlay-arrow-position calc-trail-pointer)
(or no-refresh
(if (interactive-p)
(if interactive
(calc-do-refresh)
(calc-refresh))))))
(if win
@ -1825,7 +1824,7 @@ If mouse is pressed in Calc window, push cut buffer contents onto the stack."
(delete-window win)
(calc-wrapper
(or no-refresh
(if (interactive-p)
(if interactive
(calc-do-refresh)
(calc-refresh))))))))
calc-trail-buffer)

4
lisp/elide-head.el
View file

@ -98,7 +98,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
(if rest (setq rest (cdr rest))))
(if (not (and beg end))
(if (interactive-p)
(error "No header found"))
(message "No header found"))
(goto-char beg)
(end-of-line)
(if (overlayp elide-head-overlay)
@ -115,7 +115,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
(overlay-buffer elide-head-overlay))
(delete-overlay elide-head-overlay)
(if (interactive-p)
(error "No header hidden"))))
(message "No header hidden"))))
(provide 'elide-head)

16
lisp/emacs-lisp/lselect.el
View file

@ -1,6 +1,6 @@
;;; lselect.el --- Lucid interface to X Selections
;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
;; Copyright (C) 1990, 1993, 2004 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: emulations
@ -146,7 +146,7 @@ secondary selection instead of the primary selection."
(x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
(defun x-dehilight-selection (selection)
"for use as a value of x-lost-selection-hooks."
"for use as a value of `x-lost-selection-functions'."
(cond ((eq selection 'PRIMARY)
(if primary-selection-extent
(let ((inhibit-quit t))
@ -160,23 +160,23 @@ secondary selection instead of the primary selection."
(setq secondary-selection-extent nil)))))
nil)
(setq x-lost-selection-hooks 'x-dehilight-selection)
(setq x-lost-selection-functions 'x-dehilight-selection)
(defun x-notice-selection-requests (selection type successful)
"for possible use as the value of x-sent-selection-hooks."
"for possible use as the value of `x-sent-selection-functions'."
(if (not successful)
(message "Selection request failed to convert %s to %s"
selection type)
(message "Sent selection %s as %s" selection type)))
(defun x-notice-selection-failures (selection type successful)
"for possible use as the value of x-sent-selection-hooks."
"for possible use as the value of `x-sent-selection-functions'."
(or successful
(message "Selection request failed to convert %s to %s"
selection type)))
;(setq x-sent-selection-hooks 'x-notice-selection-requests)
;(setq x-sent-selection-hooks 'x-notice-selection-failures)
;(setq x-sent-selection-functions 'x-notice-selection-requests)
;(setq x-sent-selection-functions 'x-notice-selection-failures)
;; Random utility functions
@ -232,5 +232,5 @@ the kill ring or the Clipboard."
(provide 'lselect)
;;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556
;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556
;;; lselect.el ends here

3
lisp/emulation/cua-base.el
View file

@ -1,6 +1,7 @@
;;; cua-base.el --- emulate CUA key bindings
;; Copyright (C) 1997,98,99,200,01,02,03,04 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulation convenience cua

2
lisp/eshell/em-unix.el
View file

@ -799,7 +799,7 @@ external command."
(size 0.0))
(while entries
(unless (string-match "\\`\\.\\.?\\'" (caar entries))
(let* ((entry (concat path (char-to-string directory-sep-char)
(let* ((entry (concat path "/"
(caar entries)))
(symlink (and (stringp (cadr (car entries)))
(cadr (car entries)))))

198
lisp/files.el
View file

@ -1645,41 +1645,35 @@ in that case, this function acts as if `enable-local-variables' were t."
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
'(("\\.te?xt\\'" . text-mode)
("\\.tex\\'" . tex-mode)
'(;; do this first, so that .html.pl is Polish html, not Perl
("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
("\\.te?xt\\'" . text-mode)
("\\.[tT]e[xX]\\'" . tex-mode)
("\\.ins\\'" . tex-mode) ;Installation files for TeX packages.
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
("\\.el\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.lisp\\'" . lisp-mode)
("\\.f\\'" . fortran-mode)
("\\.F\\'" . fortran-mode)
("\\.li?sp\\'" . lisp-mode)
("\\.[fF]\\'" . fortran-mode)
("\\.for\\'" . fortran-mode)
("\\.p\\'" . pascal-mode)
("\\.pas\\'" . pascal-mode)
("\\.ad[abs]\\'" . ada-mode)
("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\)\\|al\\)\\'" . perl-mode)
("\\.s?html?\\'" . html-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
("\\.mk\\'" . makefile-mode)
("\\(M\\|m\\|GNUm\\)akefile\\'" . makefile-mode)
("\\([Mm]\\|GNUm\\)akep*file\\'" . makefile-mode)
("\\.am\\'" . makefile-mode) ;For Automake.
;; Less common extensions come here
;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
("\\.te?xi\\'" . texinfo-mode)
("\\.s\\'" . asm-mode)
("\\.S\\'" . asm-mode)
("\\.[sS]\\'" . asm-mode)
("\\.asm\\'" . asm-mode)
("ChangeLog\\'" . change-log-mode)
("change\\.log\\'" . change-log-mode)
("changelo\\'" . change-log-mode)
("ChangeLog\\.[0-9]+\\'" . change-log-mode)
;; for MSDOS and MS-Windows (which are case-insensitive)
("changelog\\'" . change-log-mode)
("changelog\\.[0-9]+\\'" . change-log-mode)
("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
("[cC]hange[lL]og\\.[0-9]+\\'" . change-log-mode)
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
@ -1688,36 +1682,28 @@ in that case, this function acts as if `enable-local-variables' were t."
("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.m?spec\\'" . sh-mode)
("\\.mm\\'" . nroff-mode)
("\\.me\\'" . nroff-mode)
("\\.ms\\'" . nroff-mode)
("\\.m[mes]\\'" . nroff-mode)
("\\.man\\'" . nroff-mode)
("\\.TeX\\'" . tex-mode)
("\\.sty\\'" . latex-mode)
("\\.cls\\'" . latex-mode) ;LaTeX 2e class
("\\.clo\\'" . latex-mode) ;LaTeX 2e class option
("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option
("\\.bbl\\'" . latex-mode)
("\\.bib\\'" . bibtex-mode)
("\\.sql\\'" . sql-mode)
("\\.m4\\'" . m4-mode)
("\\.mc\\'" . m4-mode)
("\\.m[4c]\\'" . m4-mode)
("\\.mf\\'" . metafont-mode)
("\\.mp\\'" . metapost-mode)
("\\.vhdl?\\'" . vhdl-mode)
("\\.article\\'" . text-mode)
("\\.letter\\'" . text-mode)
("\\.tcl\\'" . tcl-mode)
("\\.i?tcl\\'" . tcl-mode)
("\\.exp\\'" . tcl-mode)
("\\.itcl\\'" . tcl-mode)
("\\.itk\\'" . tcl-mode)
("\\.icn\\'" . icon-mode)
("\\.sim\\'" . simula-mode)
("\\.mss\\'" . scribe-mode)
("\\.f90\\'" . f90-mode)
("\\.f95\\'" . f90-mode)
("\\.f9[05]\\'" . f90-mode)
("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode
("\\.pro\\'" . idlwave-mode)
("\\.lsp\\'" . lisp-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
@ -1733,10 +1719,11 @@ in that case, this function acts as if `enable-local-variables' were t."
("\\`/tmp/fol/" . text-mode)
("\\.oak\\'" . scheme-mode)
("\\.sgml?\\'" . sgml-mode)
("\\.xml\\'" . sgml-mode)
("\\.xsl\\'" . sgml-mode)
("\\.x[ms]l\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js\\'" . java-mode) ; javascript-mode would be better
("\\.x[bp]m\\'" . c-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
@ -1760,7 +1747,7 @@ in that case, this function acts as if `enable-local-variables' were t."
;; or .#<file>.<rev>-<rev> or VC's <file>.~<rev>~.
;; Using mode nil rather than `ignore' would let the search continue
;; through this list (with the shortened name) rather than start over.
("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" ignore t)
("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t)
;; The following should come after the ChangeLog pattern
;; for the sake of ChangeLog.1, etc.
;; and after the .scm.[0-9] and CVS' <file>.<rev> patterns too.
@ -1849,12 +1836,20 @@ be interpreted by the interpreter matched by the second group of the
regular expression. The mode is then determined as the mode associated
with that interpreter in `interpreter-mode-alist'.")
(defun set-auto-mode (&optional just-from-file-name)
(defvar xml-based-modes '(html-mode)
"Modes that override an XML declaration.
When `set-auto-mode' sees an <?xml or <!DOCTYPE declaration, that
buffer will be in some XML mode. If `auto-mode-alist' associates
the file with one of the modes in this list, that mode will be
used. Else `xml-mode' or `sgml-mode' is used.")
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
This checks for a -*- mode tag in the buffer's text,
compares the filename against the entries in `auto-mode-alist',
or checks the interpreter that runs this file against
`interpreter-mode-alist'.
This checks for a -*- mode tag in the buffer's text, checks the
interpreter that runs this file against `interpreter-mode-alist',
looks for an <?xml or <!DOCTYPE declaration (see
`xml-based-modes'), or compares the filename against the entries
in `auto-mode-alist'.
It does not check for the `mode:' local variable in the
Local Variables section of the file; for that, use `hack-local-variables'.
@ -1862,14 +1857,16 @@ Local Variables section of the file; for that, use `hack-local-variables'.
If `enable-local-variables' is nil, this function does not check for a
-*- mode tag.
If the optional argument JUST-FROM-FILE-NAME is non-nil,
then we do not set anything but the major mode,
and we don't even do that unless it would come from the file name."
If the optional argument KEEP-MODE-IF-SAME is non-nil, then we
only set the major mode, if that would change it."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let (end done modes)
(let (end done mode modes xml)
;; Find a -*- mode tag
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
;; While we're at this point, check xml for later.
(setq xml (looking-at "<\\?xml \\|<!DOCTYPE"))
(and enable-local-variables
(setq end (set-auto-mode-1))
(if (save-excursion (search-forward ":" end t))
@ -1891,62 +1888,71 @@ and we don't even do that unless it would come from the file name."
(push (intern (concat (downcase (buffer-substring (point) end))
"-mode"))
modes))))
;; If we found modes to use, invoke them now,
;; outside the save-excursion.
(unless just-from-file-name
(dolist (mode (nreverse modes))
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
(setq done t)
(funcall mode))))
;; If we didn't find a mode from a -*- line, try using the file name.
;; If we found modes to use, invoke them now, outside the save-excursion.
(if modes
(catch 'nop
(dolist (mode (nreverse modes))
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
(setq done t)
(or (set-auto-mode-0 mode)
(throw 'nop nil)))))
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
(setq mode (save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2)
""))
;; Map interpreter name to a mode, signalling we're done at the
;; same time.
done (assoc (file-name-nondirectory mode)
interpreter-mode-alist))
;; If we found an interpreter mode to use, invoke it now.
(if done (set-auto-mode-0 (cdr done))))
(if (and (not done) buffer-file-name)
(let ((name buffer-file-name)
(keep-going t))
(let ((name buffer-file-name))
;; Remove backup-suffixes from file name.
(setq name (file-name-sans-versions name))
(while keep-going
(setq keep-going nil)
(let ((alist auto-mode-alist)
(mode nil))
;; Find first matching alist entry.
(let ((case-fold-search
(memq system-type '(vax-vms windows-nt cygwin))))
(while (and (not mode) alist)
(if (string-match (car (car alist)) name)
(if (and (consp (cdr (car alist)))
(nth 2 (car alist)))
(setq mode (car (cdr (car alist)))
name (substring name 0 (match-beginning 0))
keep-going t)
(setq mode (cdr (car alist))
keep-going nil)))
(setq alist (cdr alist))))
(if mode
;; When JUST-FROM-FILE-NAME is set,
;; we are working on behalf of set-visited-file-name.
;; In that case, if the major mode specified is the
;; same one we already have, don't actually reset it.
;; We don't want to lose minor modes such as Font Lock.
(unless (and just-from-file-name (eq mode major-mode))
(funcall mode))
;; If we can't deduce a mode from the file name,
;; look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl",
;; which finds the interpreter anywhere in $PATH.
(let ((interpreter
(save-excursion
(goto-char (point-min))
(if (looking-at auto-mode-interpreter-regexp)
(match-string 2)
"")))
elt)
;; Map interpreter name to a mode.
(setq elt (assoc (file-name-nondirectory interpreter)
interpreter-mode-alist))
(unless just-from-file-name
(if elt
(funcall (cdr elt))))))))))))
(while name
;; Find first matching alist entry.
(let ((case-fold-search
(memq system-type '(vax-vms windows-nt cygwin))))
(if (and (setq mode (assoc-default name auto-mode-alist
'string-match))
(consp mode)
(cadr mode))
(setq mode (car mode)
name (substring name 0 (match-beginning 0)))
(setq name)))
(when mode
(if xml (or (memq mode xml-based-modes)
(setq mode 'xml-mode)))
(set-auto-mode-0 mode)
(setq done t)))))
(and xml
(not done)
(set-auto-mode-0 'xml-mode))))
;; When `keep-mode-if-same' is set, we are working on behalf of
;; set-visited-file-name. In that case, if the major mode specified is the
;; same one we already have, don't actually reset it. We don't want to lose
;; minor modes such as Font Lock.
(defun set-auto-mode-0 (mode)
"Apply MODE and return it.
If `keep-mode-if-same' is non-nil MODE is chased of any aliases and
compared to current major mode. If they are the same, do nothing
and return nil."
(when keep-mode-if-same
(while (symbolp (symbol-function mode))
(setq mode (symbol-function mode)))
(if (eq mode major-mode)
(setq mode)))
(when mode
(funcall mode)
mode))
(defun set-auto-mode-1 ()
@ -2157,7 +2163,7 @@ is specified, returning t if it is specified."
(error "Local variables entry is missing the suffix")))
(forward-line 1))
(goto-char (point-min))
(while (not (eobp))
;; Find the variable name; strip whitespace.
(skip-chars-forward " \t")

30
lisp/find-file.el
View file

@ -57,7 +57,7 @@
;; format above can be changed to include a function to be called when the
;; current file matches the regexp:
;;
;; '(("\\.cc$" cc-function)
;; '(("\\.cc$" cc--function)
;; ("\\.hh$" hh-function))
;;
;; These functions must return a list consisting of the possible names of the
@ -239,22 +239,26 @@ the preceding slash. The star represents all the subdirectories except
:group 'ff)
(defcustom cc-other-file-alist
'(
("\\.cc$" (".hh" ".h"))
("\\.hh$" (".cc" ".C"))
'(("\\.cc\\'" (".hh" ".h"))
("\\.hh\\'" (".cc" ".C"))
("\\.c$" (".h"))
("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))
("\\.c\\'" (".h"))
("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))
("\\.C$" (".H" ".hh" ".h"))
("\\.H$" (".C" ".CC"))
("\\.C\\'" (".H" ".hh" ".h"))
("\\.H\\'" (".C" ".CC"))
("\\.CC$" (".HH" ".H" ".hh" ".h"))
("\\.HH$" (".CC"))
("\\.CC\\'" (".HH" ".H" ".hh" ".h"))
("\\.HH\\'" (".CC"))
("\\.cxx$" (".hh" ".h"))
("\\.cpp$" (".hh" ".h"))
)
("\\.c\\+\\+\\'" (".h++" ".hh" ".h"))
("\\.h\\+\\+\\'" (".c++"))
("\\.cpp\\'" (".hpp" ".hh" ".h"))
("\\.hpp\\'" (".cpp"))
("\\.cxx\\'" (".hxx" ".hh" ".h"))
("\\.hxx\\'" (".cxx")))
"*Alist of extensions to find given the current file's extension.
This list should contain the most used extensions before the others,

36
lisp/gnus/ChangeLog
View file

@ -1,3 +1,39 @@
2004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than
iso-2022-jp even in the Japanese language environment. Suggested
by Jason Rumney <jasonr@gnu.org>.
2004-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-sum.el (gnus-update-summary-mark-positions): Allow users to
use the same characters as the dummy marks; make it free from
getting affected by the language environment.
(gnus-summary-read-group-1): Update mark positions only when the
format spec is updated.
* gnus-spec.el (gnus-update-format-specifications): Return a list
of updated types.
2004-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
* nnspool.el (nnspool-spool-directory): Use news-path if the
news-directory variable is not bound.
* gnus-group.el (gnus-group-line-format-alist): Convert the value
of gnus-tmp-news-method into string if it may be passed to
gnus-correct-length which takes only a string argument.
2004-10-25 Reiner Steib <Reiner.Steib@gmx.de>
* html2text.el (html2text-buffer-head): Removed. Use `goto-char'
instead.
2004-10-24 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-start.el (gnus-convert-old-newsrc): Fixed numeric
comparison on string.
2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-view.el (mm-display-inline-fontify): Inhibit font-lock when

5
lisp/gnus/gnus-group.el
View file

@ -491,7 +491,10 @@ simple manner.")
(?O gnus-tmp-moderated-string ?s)
(?p gnus-tmp-process-marked ?c)
(?s gnus-tmp-news-server ?s)
(?n gnus-tmp-news-method ?s)
(?n ,(if (featurep 'xemacs)
'(symbol-name gnus-tmp-news-method)
'gnus-tmp-news-method)
?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
(?B gnus-tmp-summary-live ?c)

16
lisp/gnus/gnus-spec.el
View file

@ -183,7 +183,8 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
(insert (gnus-pp-to-string spec))))
(defun gnus-update-format-specifications (&optional force &rest types)
"Update all (necessary) format specifications."
"Update all (necessary) format specifications.
Return a list of updated types."
;; Make the indentation array.
;; See whether all the stored info needs to be flushed.
(when (or force
@ -195,13 +196,12 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
(setq gnus-format-specs nil))
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val)
(let (new-format entry type val updated)
(while (setq type (pop types))
;; Jump to the proper buffer to find out the value of the
;; variable, if possible. (It may be buffer-local.)
(save-excursion
(let ((buffer (intern (format "gnus-%s-buffer" type)))
val)
(let ((buffer (intern (format "gnus-%s-buffer" type))))
(when (and (boundp buffer)
(setq val (symbol-value buffer))
(gnus-buffer-exists-p val))
@ -231,10 +231,12 @@ text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
(setcar (cdr entry) val)
(setcar entry new-format))
(push (list type new-format val) gnus-format-specs))
(set (intern (format "gnus-%s-line-format-spec" type)) val)))))
(set (intern (format "gnus-%s-line-format-spec" type)) val)
(push type updated))))
(unless (assq 'version gnus-format-specs)
(push (cons 'version emacs-version) gnus-format-specs)))
(unless (assq 'version gnus-format-specs)
(push (cons 'version emacs-version) gnus-format-specs))
updated))
(defvar gnus-mouse-face-0 'highlight)
(defvar gnus-mouse-face-1 'highlight)

5
lisp/gnus/gnus-start.el
View file

@ -2225,7 +2225,8 @@ If FORCE is non-nil, the .newsrc file is read."
(defun gnus-convert-old-newsrc ()
"Convert old newsrc formats into the current format, if needed."
(let ((fcv (and gnus-newsrc-file-version
(gnus-continuum-version gnus-newsrc-file-version))))
(gnus-continuum-version gnus-newsrc-file-version)))
(gcv (gnus-continuum-version)))
(when fcv
;; A newsrc file was loaded.
(let (prompt-displayed
@ -2259,7 +2260,7 @@ If FORCE is non-nil, the .newsrc file is read."
;; Perform converters to bring older version up to date.
(when (and converters (< fcv (caar converters)))
(while (and converters (< fcv (caar converters))
(<= (caar converters) gnus-version))
(<= (caar converters) gcv))
(let* ((converter-spec (pop converters))
(convert-to (nth 1 converter-spec))
(load-from (nth 2 converter-spec))

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

@ -3225,43 +3225,54 @@ buffer that was in action when the last article was fetched."
(save-excursion
(when (gnus-buffer-exists-p gnus-summary-buffer)
(set-buffer gnus-summary-buffer))
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
(gnus-undownloaded-mark 131)
(spec gnus-summary-line-format-spec)
gnus-visual pos)
(let ((spec gnus-summary-line-format-spec)
pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
(let ((gnus-tmp-unread ?Z)
(gnus-replied-mark ?Z)
(gnus-score-below-mark ?Z)
(gnus-score-over-mark ?Z)
(gnus-undownloaded-mark ?Z)
(gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '(0))
marks)
(insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203")
(while (not (bobp))
(push (buffer-substring (1- (point)) (point)) marks)
(backward-char))
(header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
case-fold-search ignores)
;; Here, all marks are bound to Z.
(gnus-summary-insert-line header
0 nil t gnus-tmp-unread t nil "" nil 1)
(goto-char (point-min))
;; Memorize the positions of the same characters as dummy marks.
(while (re-search-forward "[A-D]" nil t)
(push (point) ignores))
(erase-buffer)
(gnus-summary-insert-line
[0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
0 nil t 128 t nil "" nil 1)
;; We use A-D as dummy marks in order to know column positions
;; where marks should be inserted.
(setq gnus-tmp-unread ?A
gnus-replied-mark ?B
gnus-score-below-mark ?C
gnus-score-over-mark ?C
gnus-undownloaded-mark ?D)
(gnus-summary-insert-line header
0 nil t gnus-tmp-unread t nil "" nil 1)
;; Ignore characters which aren't dummy marks.
(dolist (p ignores)
(delete-region (goto-char (1- p)) p)
(insert ?Z))
(goto-char (point-min))
(setq pos (list (cons 'unread
(and (or (search-forward (nth 0 marks) nil t)
(search-forward (nth 1 marks) nil t))
(and (search-forward "A" nil t)
(- (point) (point-min) 1)))))
(goto-char (point-min))
(push (cons 'replied (and (or (search-forward (nth 2 marks) nil t)
(search-forward (nth 3 marks) nil t))
(push (cons 'replied (and (search-forward "B" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'score (and (or (search-forward (nth 4 marks) nil t)
(search-forward (nth 5 marks) nil t))
(push (cons 'score (and (search-forward "C" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'download (and (or (search-forward (nth 6 marks) nil t)
(search-forward (nth 7 marks) nil t))
(push (cons 'download (and (search-forward "D" nil t)
(- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
@ -3559,9 +3570,11 @@ If NO-DISPLAY, don't generate a summary buffer."
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
(gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions)
(when (memq 'summary (gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy))
;; The format specification for the summary line was updated,
;; so we need to update the mark positions as well.
(gnus-update-summary-mark-positions))
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))

18
lisp/gnus/html2text.el
View file

@ -116,12 +116,6 @@ formatting, and then moved afterward.")
;; <Utility functions>
;;
(defun html2text-buffer-head ()
(if (string= mode-name "Article")
(beginning-of-buffer)
(beginning-of-buffer)
)
)
(defun html2text-replace-string (from-string to-string p1 p2)
(goto-char p1)
@ -432,11 +426,11 @@ formatting, and then moved afterward.")
"This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
fashion, quite close to pure guess-work. It does work in some cases though."
(interactive)
(html2text-buffer-head)
(goto-char (point-min))
(replace-regexp "^<br>$" "")
;; Removing lonely <br> on a single line, if they are left intact we
;; dont have any paragraphs at all.
(html2text-buffer-head)
(goto-char (point-min))
(while (not (eobp))
(let ((p1 (point)))
(forward-paragraph 1)
@ -462,7 +456,7 @@ fashion, quite close to pure guess-work. It does work in some cases though."
See the documentation for that variable."
(interactive)
(dolist (tag tag-list)
(html2text-buffer-head)
(goto-char (point-min))
(while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
(delete-region (match-beginning 0) (match-end 0)))))
@ -472,7 +466,7 @@ See the documentation for that variable."
(dolist (tag-and-function html2text-format-tag-list)
(let ((tag (car tag-and-function))
(function (cdr tag-and-function)))
(html2text-buffer-head)
(goto-char (point-min))
(while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
(point-max) t)
(let ((p1)
@ -497,7 +491,7 @@ See the documentation for that variable."
"See the variable \"html2text-replace-list\" for documentation"
(interactive)
(dolist (e html2text-replace-list)
(html2text-buffer-head)
(goto-char (point-min))
(let ((old-string (car e))
(new-string (cdr e)))
(html2text-replace-string old-string new-string (point-min) (point-max))
@ -511,7 +505,7 @@ See the documentation for that variable."
(dolist (tag-and-function html2text-format-single-element-list)
(let ((tag (car tag-and-function))
(function (cdr tag-and-function)))
(html2text-buffer-head)
(goto-char (point-min))
(while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
(point-max) t)
(let ((p1)

7
lisp/gnus/mm-util.el
View file

@ -302,9 +302,10 @@ Valid elements include:
(if (boundp 'current-language-environment)
(let ((lang (symbol-value 'current-language-environment)))
(cond ((string= lang "Japanese")
;; Japanese users may prefer iso-2022-jp to shift-jis.
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
iso-latin-1 utf-8)))))
;; Japanese users prefer iso-2022-jp to euc-japan or
;; shift_jis, however iso-8859-1 should be used when
;; there are only ASCII text and Latin-1 characters.
'(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
"Preferred coding systems for encoding outgoing messages.
More than one suitable coding system may be found for some text.

5
lisp/gnus/nnspool.el
View file

@ -44,7 +44,10 @@ This is most commonly `inews' or `injnews'.")
"Switches for nnspool-request-post to pass to `inews' for posting news.
If you are using Cnews, you probably should set this variable to nil.")
(defvoo nnspool-spool-directory (file-name-as-directory news-directory)
(defvoo nnspool-spool-directory
(file-name-as-directory (if (boundp 'news-directory)
(symbol-value 'news-directory)
news-path))
"Local news spool directory.")
(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")

15
lisp/help.el
View file

@ -573,14 +573,14 @@ the last key hit are used."
(if (symbolp defn) defn (prin1-to-string defn)))))))))
(defun describe-key (key &optional untranslated)
(defun describe-key (key &optional untranslated up-event)
"Display documentation of the function invoked by KEY.
KEY should be a key sequence--when calling from a program,
pass a string or a vector.
If non-nil UNTRANSLATED is a vector of the untranslated events.
It can also be a number in which case the untranslated events from
the last key hit are used."
(interactive "kDescribe key: \np")
(interactive "kDescribe key: \np\nU")
(if (numberp untranslated)
(setq untranslated (this-single-command-raw-keys)))
(save-excursion
@ -608,6 +608,17 @@ the last key hit are used."
(prin1 defn)
(princ "\n which is ")
(describe-function-1 defn)
(when up-event
(let ((defn (or (string-key-binding up-event) (key-binding up-event))))
(unless (or (null defn) (integerp defn) (equal defn 'undefined))
(princ "\n\n-------------- up event ---------------\n\n")
(princ (key-description up-event))
(if (windowp window)
(princ " at that spot"))
(princ " runs the command ")
(prin1 defn)
(princ "\n which is ")
(describe-function-1 defn))))
(print-help-return-message)))))))

100
lisp/imenu.el
View file

@ -62,6 +62,8 @@
;;; Code:
(require 'newcomment)
(eval-when-compile (require 'cl))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -159,16 +161,17 @@ element should come before the second. The arguments are cons cells;
:type 'integer
:group 'imenu)
(defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
"*Progress message during the index scanning of the buffer.
If non-nil, user gets a message during the scanning of the buffer.
Relevant only if the mode-specific function that creates the buffer
index use `imenu-progress-message', and not useful if that is fast, in
which case you might as well set this to nil."
:type '(choice string
(const :tag "None" nil))
:group 'imenu)
;; No longer used. KFS 2004-10-27
;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
;; "*Progress message during the index scanning of the buffer.
;; If non-nil, user gets a message during the scanning of the buffer.
;;
;; Relevant only if the mode-specific function that creates the buffer
;; index use `imenu-progress-message', and not useful if that is fast, in
;; which case you might as well set this to nil."
;; :type '(choice string
;; (const :tag "None" nil))
;; :group 'imenu)
(defcustom imenu-space-replacement "."
"*The replacement string for spaces in index names.
@ -298,16 +301,22 @@ The function in this variable is called when selecting a normal index-item.")
;; is calculated.
;; PREVPOS is the variable in which we store the last position displayed.
(defmacro imenu-progress-message (prevpos &optional relpos reverse)
`(and
imenu-scanning-message
(let ((pos ,(if relpos
relpos
`(imenu--relative-position ,reverse))))
(if ,(if relpos t
`(> pos (+ 5 ,prevpos)))
(progn
(message imenu-scanning-message pos)
(setq ,prevpos pos))))))
;; Made obsolete/empty, as computers are now faster than the eye, and
;; it had problems updating the messages correctly, and could shadow
;; more important messages/prompts in the minibuffer. KFS 2004-10-27.
;; `(and
;; imenu-scanning-message
;; (let ((pos ,(if relpos
;; relpos
;; `(imenu--relative-position ,reverse))))
;; (if ,(if relpos t
;; `(> pos (+ 5 ,prevpos)))
;; (progn
;; (message imenu-scanning-message pos)
;; (setq ,prevpos pos)))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -763,7 +772,7 @@ the alist look like:
(INDEX-NAME . INDEX-POSITION)
or like:
(INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
They may also be nested index alists like:
They may also be nested index alists like:
(INDEX-NAME . INDEX-ALIST)
depending on PATTERNS."
@ -796,32 +805,37 @@ depending on PATTERNS."
(regexp (nth 1 pat))
(index (nth 2 pat))
(function (nth 3 pat))
(rest (nthcdr 4 pat)))
(rest (nthcdr 4 pat))
cs)
;; Go backwards for convenience of adding items in order.
(goto-char (point-max))
(while (re-search-backward regexp nil t)
(imenu-progress-message prev-pos nil t)
(goto-char (match-end index))
(setq beg (match-beginning index))
;; Add this sort of submenu only when we've found an
;; item for it, avoiding empty, duff menus.
(unless (assoc menu-title index-alist)
(push (list menu-title) index-alist))
(if imenu-use-markers
(setq beg (copy-marker beg)))
(let ((item
(if function
(nconc (list (match-string-no-properties index)
beg function)
rest)
(cons (match-string-no-properties index)
beg)))
;; This is the desired submenu,
;; starting with its title (or nil).
(menu (assoc menu-title index-alist)))
;; Insert the item unless it is already present.
(unless (member item (cdr menu))
(setcdr menu
(cons item (cdr menu))))))))
(if (setq cs (save-match-data (comment-beginning)))
(goto-char cs) ; skip this one, it's in a comment
(goto-char beg)
(imenu-progress-message prev-pos nil t)
;; Add this sort of submenu only when we've found an
;; item for it, avoiding empty, duff menus.
(unless (assoc menu-title index-alist)
(push (list menu-title) index-alist))
(if imenu-use-markers
(setq beg (copy-marker beg)))
(let ((item
(if function
(nconc (list (match-string-no-properties index)
beg function)
rest)
(cons (match-string-no-properties index)
beg)))
;; This is the desired submenu,
;; starting with its title (or nil).
(menu (assoc menu-title index-alist)))
;; Insert the item unless it is already present.
(unless (member item (cdr menu))
(setcdr menu
(cons item (cdr menu)))))))))
(set-syntax-table old-table)))
(imenu-progress-message prev-pos 100 t)
;; Sort each submenu by position.

31
lisp/info.el
View file

@ -1980,7 +1980,7 @@ Because of ambiguities, this should be concatenated with something like
(if (match-beginning 5)
(string-to-number (match-string 5))
(buffer-substring (match-beginning 0) (1- (match-beginning 1)))))
;;; Comment out the next line to use names of cross-references:
;;; Uncomment next line to use names of cross-references in non-index nodes:
;;; (setq Info-point-loc
;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
)
@ -3214,7 +3214,7 @@ Allowed only if variable `Info-enable-edit' is non-nil."
(message "Tags may have changed. Use Info-tagify if necessary")))
(defvar Info-file-list-for-emacs
'("ediff" "eudc" "forms" "gnus" "info" ("mh" . "mh-e")
'("ediff" "eudc" "forms" "gnus" "info" ("Info" . "info") ("mh" . "mh-e")
"sc" "message" ("dired" . "dired-x") "viper" "vip" "idlwave"
("c" . "ccmode") ("c++" . "ccmode") ("objc" . "ccmode")
("java" . "ccmode") ("idl" . "ccmode") ("pike" . "ccmode")
@ -3245,11 +3245,13 @@ The `info-file' property of COMMAND says which Info manual to search.
If COMMAND has no property, the variable `Info-file-list-for-emacs'
defines heuristics for which Info manual to try.
The locations are of the format used in `Info-history', i.e.
\(FILENAME NODENAME BUFFERPOS\)."
(let ((where '())
\(FILENAME NODENAME BUFFERPOS\), where BUFFERPOS is the line number
in the first element of the returned list (which is treated specially in
`Info-goto-emacs-command-node'), and 0 for the rest elements of a list."
(let ((where '()) line-number
(cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command))
"\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\."
"\\([ \t]*(line[ \t]*[0-9]*)\\)?$"))
"\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?"))
(info-file "emacs")) ;default
;; Determine which info file this command is documented in.
(if (get command 'info-file)
@ -3288,11 +3290,17 @@ The locations are of the format used in `Info-history', i.e.
(cons (list Info-current-file
(match-string-no-properties 2)
0)
where)))
where))
(setq line-number (and (match-beginning 3)
(string-to-number (match-string 3)))))
(and (setq nodes (cdr nodes) node (car nodes))))
(Info-goto-node node)))
where))
(if (and line-number where)
(cons (list (nth 0 (car where)) (nth 1 (car where)) line-number)
(cdr where))
where)))
;;;###autoload (put 'Info-goto-emacs-command-node 'info-file "emacs")
;;;###autoload
(defun Info-goto-emacs-command-node (command)
"Go to the Info node in the Emacs manual for command COMMAND.
@ -3316,9 +3324,11 @@ COMMAND must be a symbol or string."
;; Bind Info-history to nil, to prevent the last Index node
;; visited by Info-find-emacs-command-nodes from being
;; pushed onto the history.
(let ((Info-history nil) (Info-history-list nil))
(Info-find-node (car (car where))
(car (cdr (car where)))))
(let ((Info-history nil) (Info-history-list nil)
(line-number (nth 2 (car where))))
(Info-find-node (nth 0 (car where)) (nth 1 (car where)))
(if (and (integerp line-number) (> line-number 0))
(forward-line (1- line-number))))
(if (> num-matches 1)
(progn
;; (car where) will be pushed onto Info-history
@ -3332,6 +3342,7 @@ COMMAND must be a symbol or string."
(if (> num-matches 2) "them" "it")))))
(error "Couldn't find documentation for %s" command))))
;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file "emacs")
;;;###autoload
(defun Info-goto-emacs-key-command-node (key)
"Go to the node in the Emacs manual which describes the command bound to KEY.

6
lisp/international/subst-big5.el
View file

@ -32,9 +32,9 @@
(lambda (pair)
(let ((unicode (car pair))
(char (cadr pair)))
(if (or (and (>= unicode #x2e80) (<= unicode #xd7a3))
(and (>= unicode #xff00) (<= unicode #xffef)))
(puthash unicode char ucs-unicode-to-mule-cjk))
;; exclude non-supporting components from decode table
(if (utf-translate-cjk-substitutable-p unicode)
(puthash unicode char ucs-unicode-to-mule-cjk))
(puthash char unicode ucs-mule-cjk-to-unicode)))
'((#xa7 ?”)
(#xaf ?÷)

6
lisp/international/subst-gb2312.el
View file

@ -32,9 +32,9 @@
(lambda (pair)
(let ((unicode (car pair))
(char (cadr pair)))
(if (or (and (>= unicode #x2e80) (<= unicode #xd7a3))
(and (>= unicode #xff00) (<= unicode #xffef)))
(puthash unicode char ucs-unicode-to-mule-cjk))
;; exclude non-supporting components from decode table
(if (utf-translate-cjk-substitutable-p unicode)
(puthash unicode char ucs-unicode-to-mule-cjk))
(puthash char unicode ucs-mule-cjk-to-unicode)))
'((#xa4 ?¡è)
(#xa7 ?¡ì)

78
lisp/international/subst-jis.el
View file

@ -45,11 +45,11 @@
(mapc
(lambda (pair)
(let ((unicode (car pair))
(char (cadr pair)))
;; exclude non-CJK components from decode table
(if (or (and (>= unicode #x2e80) (<= unicode #xd7a3))
(and (>= unicode #xff00) (<= unicode #xffef)))
(puthash unicode char ucs-unicode-to-mule-cjk))
(char (cadr pair))
(tail utf-translate-cjk-unicode-range))
;; exclude non-supporting components from decode table
(if (utf-translate-cjk-substitutable-p unicode)
(puthash unicode char ucs-unicode-to-mule-cjk))
(puthash char unicode ucs-mule-cjk-to-unicode)))
'(
;; jisx0208
@ -13001,7 +13001,73 @@
(#x9fa2 ?<3F>íá)
(#x9fa3 ?<3F>íâ)
(#x9fa5 ?<3F>íã)
(#xff5e ?<3F>¢·)))
(#xff5e ?<3F>¢·)
;; jisx0201
(#xFF61 ?Ž¡)
(#xFF62 ?\Ž¢)
(#xFF63 ?\Ž£)
(#xFF64 ?Ž¤)
(#xFF65 ?Ž¥)
(#xFF66 ?Ž¦)
(#xFF67 ?Ž§)
(#xFF68 ?Ž¨)
(#xFF69 ?Ž©)
(#xFF6A ?Žª)
(#xFF6B ?Ž«)
(#xFF6C ?Ž¬)
(#xFF6D ?Ž­)
(#xFF6E ?Ž®)
(#xFF6F ?Ž¯)
(#xFF70 ?Ž°)
(#xFF71 ?Ž±)
(#xFF72 ?Ž²)
(#xFF73 ?Ž³)
(#xFF74 ?Ž´)
(#xFF75 ?Žµ)
(#xFF76 ?Ž)
(#xFF77 ?Ž·)
(#xFF78 ?Ž¸)
(#xFF79 ?Ž¹)
(#xFF7A ?Žº)
(#xFF7B ?Ž»)
(#xFF7C ?Ž¼)
(#xFF7D ?Ž½)
(#xFF7E ?Ž¾)
(#xFF7F ?Ž¿)
(#xFF80 ?ŽÀ)
(#xFF81 ?ŽÁ)
(#xFF82 ?ŽÂ)
(#xFF83 ?ŽÃ)
(#xFF84 ?ŽÄ)
(#xFF85 ?ŽÅ)
(#xFF86 ?ŽÆ)
(#xFF87 ?ŽÇ)
(#xFF88 ?ŽÈ)
(#xFF89 ?ŽÉ)
(#xFF8A ?ŽÊ)
(#xFF8B ?ŽË)
(#xFF8C ?ŽÌ)
(#xFF8D ?ŽÍ)
(#xFF8E ?ŽÎ)
(#xFF8F ?ŽÏ)
(#xFF90 ?ŽÐ)
(#xFF91 ?ŽÑ)
(#xFF92 ?ŽÒ)
(#xFF93 ?ŽÓ)
(#xFF94 ?ŽÔ)
(#xFF95 ?ŽÕ)
(#xFF96 ?ŽÖ)
(#xFF97 ?Ž×)
(#xFF98 ?ŽØ)
(#xFF99 ?ŽÙ)
(#xFF9A ?ŽÚ)
(#xFF9B ?ŽÛ)
(#xFF9C ?ŽÜ)
(#xFF9D ?ŽÝ)
(#xFF9E ?ŽÞ)
(#xFF9F ?Žß)
))
;;; arch-tag: 7f320453-b293-4159-af5e-6f0bab03048c
;;; subst-jis.el ends here

6
lisp/international/subst-ksc.el
View file

@ -31,9 +31,9 @@
(lambda (pair)
(let ((unicode (car pair))
(char (cadr pair)))
(if (or (and (>= unicode #x2e80) (<= unicode #xd7a3))
(and (>= unicode #xff00) (<= unicode #xffef)))
(puthash unicode char ucs-unicode-to-mule-cjk))
;; exclude non-supporting components from decode table
(if (utf-translate-cjk-substitutable-p unicode)
(puthash unicode char ucs-unicode-to-mule-cjk))
(puthash char unicode ucs-mule-cjk-to-unicode)))
'((#xa1 ?¢®)
(#xa4 ?¢´)

153
lisp/international/utf-8.el
View file

@ -194,13 +194,88 @@ Setting this variable outside customize has no effect."
(defconst utf-translate-cjk-charsets '(chinese-gb2312
chinese-big5-1 chinese-big5-2
japanese-jisx0208 japanese-jisx0212
katakana-jisx0201
korean-ksc5601)
"List of charsets supported by `utf-translate-cjk-mode'.")
(defconst utf-translate-cjk-unicode-range
'((#x2e80 . #xd7a3)
(#xff00 . #xffef))
"List of Unicode code ranges supported by `utf-translate-cjk-mode'.")
(defvar utf-translate-cjk-lang-env nil
"Language environment in which tables for `utf-translate-cjk-mode' is loaded.
The value nil means that the tables are not yet loaded.")
(defvar utf-translate-cjk-unicode-range)
;; String generated from utf-translate-cjk-unicode-range. It is
;; suitable for an argument to skip-chars-forward.
(defvar utf-translate-cjk-unicode-range-string nil)
(defun utf-translate-cjk-set-unicode-range (range)
(setq utf-translate-cjk-unicode-range range)
(setq utf-translate-cjk-unicode-range-string
(let ((decode-char-no-trans
#'(lambda (x)
(cond ((< x #x100) (make-char 'latin-iso8859-1 x))
((< x #x2500)
(setq x (- x #x100))
(make-char 'mule-unicode-0100-24ff
(+ (/ x 96) 32) (+ (% x 96) 32)))
((< x #x3400)
(setq x (- x #x2500))
(make-char 'mule-unicode-2500-33ff
(+ (/ x 96) 32) (+ (% x 96) 32)))
(t
(setq x (- x #xe000))
(make-char 'mule-unicode-e000-ffff
(+ (/ x 96) 32) (+ (% x 96) 32))))))
ranges from to)
(dolist (elt range)
(setq from (max #xA0 (car elt)) to (min #xffff (cdr elt)))
(if (and (>= to #x3400) (< to #xE000))
(setq to #x33FF))
(cond ((< from #x100)
(if (>= to #xE000)
(setq ranges (cons (cons #xE000 to) ranges)
to #x33FF))
(if (>= to #x2500)
(setq ranges (cons (cons #x2500 to) ranges)
to #x24FF))
(if (>= to #x100)
(setq ranges (cons (cons #x100 to) ranges)
to #xFF)))
((< from #x2500)
(if (>= to #xE000)
(setq ranges (cons (cons #xE000 to) ranges)
to #x33FF))
(if (>= to #x2500)
(setq ranges (cons (cons #x2500 to) ranges)
to #x24FF)))
((< from #x3400)
(if (>= to #xE000)
(setq ranges (cons (cons #xE000 to) ranges)
to #x33FF))))
(if (<= from to)
(setq ranges (cons (cons from to) ranges))))
(mapconcat #'(lambda (x)
(format "%c-%c"
(funcall decode-char-no-trans (car x))
(funcall decode-char-no-trans (cdr x))))
ranges "")))
;; These forces loading and settting tables for
;; utf-translate-cjk-mode.
(setq utf-translate-cjk-lang-env nil
ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)))
(defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3)
(#xff00 . #xffef))
"List of Unicode code ranges supported by `utf-translate-cjk-mode'.
Setting this variable directly does not take effect;
use either \\[customize] or the function
`utf-translate-cjk-set-unicode-range'."
:version "21.4"
:type '(repeat (cons integer integer))
:set (lambda (symbol value)
(utf-translate-cjk-set-unicode-range value))
:group 'mule)
;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
(defsubst utf-translate-cjk-substitutable-p (code-point)
@ -213,10 +288,6 @@ Setting this variable outside customize has no effect."
(setq elt nil)))
elt))
(defvar utf-translate-cjk-lang-env nil
"Language environment in which tables for `utf-translate-cjk-mode' is loaded.
The value nil means that the tables are not yet loaded.")
(defun utf-translate-cjk-load-tables ()
"Load tables for `utf-translate-cjk-mode'."
;; Fixme: Allow the use of the CJK charsets to be
@ -425,25 +496,32 @@ by the above coding systems, you can customize the user option
;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
((r1 &= #x3F)
(r1 |= ((r0 & #x1F) << 6))
;; Now r2 holds scalar value. We don't have to check
;; Now r1 holds scalar value. We don't have to check
;; `overlong sequence' because r0 >= 0xC2.
(if (r1 >= 256)
;; mule-unicode-0100-24ff (< 0800)
((r0 = ,(charset-id 'mule-unicode-0100-24ff))
(r1 -= #x0100)
(r2 = (((r1 / 96) + 32) << 7))
(r1 %= 96)
(r1 += (r2 + 32))
(translate-character
utf-translation-table-for-decode r0 r1)
((r0 = r1)
(lookup-integer utf-subst-table-for-decode r0 r1)
(if (r7 == 0)
((r0 = ,(charset-id 'mule-unicode-0100-24ff))
(r1 -= #x0100)
(r2 = (((r1 / 96) + 32) << 7))
(r1 %= 96)
(r1 += (r2 + 32))
(translate-character
utf-translation-table-for-decode r0 r1)))
(write-multibyte-character r0 r1)
(read r0)
(repeat))
(if (r1 >= 160)
;; latin-iso8859-1
((r1 -= 128)
(write-multibyte-character r6 r1)
((r0 = r1)
(lookup-integer utf-subst-table-for-decode r0 r1)
(if (r7 == 0)
((r1 -= 128)
(write-multibyte-character r6 r1))
((write-multibyte-character r0 r1)))
(read r0)
(repeat))
;; eight-bit-control
@ -482,13 +560,16 @@ by the above coding systems, you can customize the user option
(if (r3 < #x2500)
;; mule-unicode-0100-24ff (>= 0800)
((r0 = ,(charset-id 'mule-unicode-0100-24ff))
(r3 -= #x0100)
(r3 //= 96)
(r1 = (r7 + 32))
(r1 += ((r3 + 32) << 7))
(translate-character
utf-translation-table-for-decode r0 r1)
((r0 = r3)
(lookup-integer utf-subst-table-for-decode r0 r1)
(if (r7 == 0)
((r0 = ,(charset-id 'mule-unicode-0100-24ff))
(r3 -= #x0100)
(r3 //= 96)
(r1 = (r7 + 32))
(r1 += ((r3 + 32) << 7))
(translate-character
utf-translation-table-for-decode r0 r1)))
(write-multibyte-character r0 r1)
(read r0)
(repeat)))
@ -874,17 +955,17 @@ Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
hash-table ch)
(set-buffer-multibyte t)
(when utf-translate-cjk-mode
(if (not utf-translate-cjk-lang-env)
;; Check these characters:
;; "U+2e80-U+33ff", "U+ff00-U+ffef"
;; We may have to translate them to CJK charsets.
(let ((range2 "$,29@(B-$,2G$,3r`(B-$,3u/(B"))
(skip-chars-forward (concat range range2))
(unless (eobp)
(utf-translate-cjk-load-tables)
(setq range (concat range range2)))
(setq hash-table (get 'utf-subst-table-for-decode
'translation-hash-table)))))
(unless utf-translate-cjk-lang-env
;; Check these characters in utf-translate-cjk-range.
;; We may have to translate them to CJK charsets.
(skip-chars-forward
(concat range utf-translate-cjk-unicode-range-string))
(unless (eobp)
(utf-translate-cjk-load-tables)
(setq range
(concat range utf-translate-cjk-unicode-range-string)))
(setq hash-table (get 'utf-subst-table-for-decode
'translation-hash-table))))
(while (and (skip-chars-forward range)
(not (eobp)))
(setq ch (following-char))

3
lisp/mail/emacsbug.el
View file

@ -128,6 +128,9 @@ usually do not have translators to read other languages for them.\n\n")
(insert "\n\n\n")
(insert "In " (emacs-version) "\n")
(if (fboundp 'x-server-vendor)
(insert "Distributor `" (x-server-vendor) "', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n"))
(if (and system-configuration-options
(not (equal system-configuration-options "")))
(insert "configured using `configure "

11
lisp/man.el
View file

@ -893,12 +893,15 @@ header file(#include <foo.h>) and files in FILES"
'Man-target-string (match-string target-pos)
)))))
(defun Man-cleanup-manpage ()
"Remove overstriking and underlining from the current buffer."
(interactive)
(defun Man-cleanup-manpage (&optional interactive)
"Remove overstriking and underlining from the current buffer.
Normally skip any jobs that should have been done by the sed script,
but when called interactively, do those jobs even if the sed
script would have done them."
(interactive "p")
(message "Please wait: cleaning up the %s man page..."
Man-arguments)
(if (or (interactive-p) (not Man-sed-script))
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
(while (search-forward "_\b" nil t) (backward-delete-char 2))

10
lisp/menu-bar.el
View file

@ -596,10 +596,12 @@ PROPS are additional properties."
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
`(progn
(defun ,name ()
(defun ,name (&optional interactively)
,(concat "Toggle whether to " (downcase (substring help 0 1))
(substring help 1) ".")
(interactive)
(substring help 1) ".\
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
(interactive "p")
(if ,(if body `(progn . ,body)
`(progn
(custom-load-symbol ',variable)
@ -612,7 +614,7 @@ PROPS are additional properties."
;; a variable is set interactively, as the purpose is to mark it as
;; a candidate for "Save Options", and we do not want to save options
;; the user have already set explicitly in his init file.
(if (interactive-p) (customize-mark-as-set ',variable)))
(if interactively (customize-mark-as-set ',variable)))
'(menu-item ,doc ,name
:help ,help
:button (:toggle . (and (default-boundp ',variable)

10
lisp/mouse-sel.el
View file

@ -1,6 +1,7 @@
;;; mouse-sel.el --- multi-click selection support for Emacs 19
;; Copyright (C) 1993,1994,1995,2001,2002 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1994, 1995, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
@ -240,9 +241,10 @@ to the kill ring. Pressing mouse-1 or mouse-3 kills it.
& mouse-3, but operate on the X secondary selection rather than the
primary selection and region."
:global t
:group 'mouse-sel
(if mouse-sel-mode
(progn
(add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
(add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
(when mouse-sel-default-bindings
;; Save original bindings and replace them with new ones.
(setq mouse-sel-original-bindings
@ -262,7 +264,7 @@ primary selection and region."
interprogram-paste-function nil))))
;; Restore original bindings
(remove-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
(remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
(dolist (binding mouse-sel-original-bindings)
(global-set-key (car binding) (cdr binding)))
;; Restore the old values of these variables,
@ -711,5 +713,5 @@ If `mouse-yank-at-point' is non-nil, insert at point instead."
(provide 'mouse-sel)
;;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
;; arch-tag: 86e6c73f-deaa-48d3-a24e-c565fda1f7d7
;;; mouse-sel.el ends here

98
lisp/mouse.el
View file

@ -1025,54 +1025,56 @@ If MODE is 2 then do the same for lines."
"List of keys which shall cause the mouse region to be deleted.")
(defun mouse-show-mark ()
(if transient-mark-mode
(delete-overlay mouse-drag-overlay)
(let ((inhibit-quit t)
(echo-keystrokes 0)
event events key ignore
x-lost-selection-hooks)
(add-hook 'x-lost-selection-hooks
(lambda (seltype)
(if (eq seltype 'PRIMARY)
(progn (setq ignore t)
(throw 'mouse-show-mark t)))))
(move-overlay mouse-drag-overlay (point) (mark t))
(catch 'mouse-show-mark
;; In this loop, execute scroll bar and switch-frame events.
;; Also ignore down-events that are undefined.
(while (progn (setq event (read-event))
(setq events (append events (list event)))
(setq key (apply 'vector events))
(or (and (consp event)
(eq (car event) 'switch-frame))
(and (consp event)
(eq (posn-point (event-end event))
'vertical-scroll-bar))
(and (memq 'down (event-modifiers event))
(not (key-binding key))
(not (mouse-undouble-last-event events))
(not (member key mouse-region-delete-keys)))))
(and (consp event)
(or (eq (car event) 'switch-frame)
(eq (posn-point (event-end event))
'vertical-scroll-bar))
(let ((keys (vector 'vertical-scroll-bar event)))
(and (key-binding keys)
(progn
(call-interactively (key-binding keys)
nil keys)
(setq events nil)))))))
;; If we lost the selection, just turn off the highlighting.
(if ignore
nil
;; For certain special keys, delete the region.
(if (member key mouse-region-delete-keys)
(delete-region (overlay-start mouse-drag-overlay)
(overlay-end mouse-drag-overlay))
;; Otherwise, unread the key so it gets executed normally.
(setq unread-command-events
(nconc events unread-command-events))))
(setq quit-flag nil)
(let ((inhibit-quit t)
(echo-keystrokes 0)
event events key ignore
(x-lost-selection-functions
(when (boundp 'x-lost-selection-functions)
(copy-sequence x-lost-selection-functions))))
(add-hook 'x-lost-selection-functions
(lambda (seltype)
(when (eq seltype 'PRIMARY)
(setq ignore t)
(throw 'mouse-show-mark t))))
(if transient-mark-mode
(delete-overlay mouse-drag-overlay)
(move-overlay mouse-drag-overlay (point) (mark t)))
(catch 'mouse-show-mark
;; In this loop, execute scroll bar and switch-frame events.
;; Also ignore down-events that are undefined.
(while (progn (setq event (read-event))
(setq events (append events (list event)))
(setq key (apply 'vector events))
(or (and (consp event)
(eq (car event) 'switch-frame))
(and (consp event)
(eq (posn-point (event-end event))
'vertical-scroll-bar))
(and (memq 'down (event-modifiers event))
(not (key-binding key))
(not (mouse-undouble-last-event events))
(not (member key mouse-region-delete-keys)))))
(and (consp event)
(or (eq (car event) 'switch-frame)
(eq (posn-point (event-end event))
'vertical-scroll-bar))
(let ((keys (vector 'vertical-scroll-bar event)))
(and (key-binding keys)
(progn
(call-interactively (key-binding keys)
nil keys)
(setq events nil)))))))
;; If we lost the selection, just turn off the highlighting.
(unless ignore
;; For certain special keys, delete the region.
(if (member key mouse-region-delete-keys)
(delete-region (overlay-start mouse-drag-overlay)
(overlay-end mouse-drag-overlay))
;; Otherwise, unread the key so it gets executed normally.
(setq unread-command-events
(nconc events unread-command-events))))
(setq quit-flag nil)
(unless transient-mark-mode
(delete-overlay mouse-drag-overlay))))
(defun mouse-set-mark (click)

128
lisp/net/password.el
View file

@ -1,128 +0,0 @@
;;; password.el --- Read passwords from user, possibly using a password cache.
;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Created: 2003-12-21
;; Keywords: password cache passphrase key
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just
;; a rip-off.
;;
;; (password-read "Password? " "test")
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
;; (password-cache-add "test" "foo")
;; => nil
;; Note the previous two can be replaced with:
;; (password-read-and-add "Password? " "test")
;; ;; Minibuffer prompt for password.
;; => "foo"
;; ;; "foo" is now cached with key "test"
;; (password-read "Password? " "test")
;; ;; No minibuffer prompt
;; => "foo"
;;
;; (password-read "Password? " "test")
;; ;; No minibuffer prompt
;; => "foo"
;;
;; ;; Wait `password-cache-expiry' seconds.
;;
;; (password-read "Password? " "test")
;; ;; Minibuffer prompt for password is back.
;; => "foo"
;;; Code:
(when (featurep 'xemacs)
(require 'run-at-time))
(eval-when-compile
(require 'cl))
(defcustom password-cache t
"Whether to cache passwords."
:group 'password
:type 'boolean)
(defcustom password-cache-expiry 16
"How many seconds passwords are cached, or nil to disable expiring.
Whether passwords are cached at all is controlled by `password-cache'."
:group 'password
:type '(choice (const :tag "Never" nil)
(integer :tag "Seconds")))
(defvar password-data (make-vector 7 0))
(defun password-read (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
KEY indicate the purpose of the password, so the cache can
separate passwords. The cache is not used if KEY is nil. It is
typically a string.
The variable `password-cache' control whether the cache is used."
(or (and password-cache
key
(symbol-value (intern-soft key password-data)))
(read-passwd prompt)))
(defun password-read-and-add (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
Then store the password in the cache. Uses `password-read' and
`password-cache-add'."
(let ((password (password-read prompt key)))
(when (and password key)
(password-cache-add key password))
password))
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run be a timer setup from `password-cache-add',
but can be invoked at any time to forcefully remove passwords
from the cache. This may be useful when it has been detected
that a password is invalid, so that `password-read' query the
user again."
(let ((password (symbol-value (intern-soft key password-data))))
(when password
(fillarray password ?_)
(unintern key password-data))))
(defun password-cache-add (key password)
"Add password to cache.
The password is removed by a timer after `password-cache-expiry'
seconds."
(set (intern key password-data) password)
(when password-cache-expiry
(run-at-time password-cache-expiry nil
#'password-cache-remove
key))
nil)
(provide 'password)
;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
;;; password.el ends here

92
lisp/obsolete/hilit19.el
View file

@ -1,6 +1,6 @@
;;; hilit19.el --- customizable highlighting for Emacs 19
;; Copyright (c) 1993, 1994, 2001 Free Software Foundation, Inc.
;; Copyright (c) 1993, 1994, 2001, 2004 Free Software Foundation, Inc.
;; Author: Jonathan Stigelman <stig@hackvan.com>
;; Maintainer: FSF
@ -397,8 +397,6 @@ See the hilit-lookup-face-create documentation for valid face names.")
If hilit19 is dumped into emacs at your site, you may have to set this in
your init file.")
(eval-when-compile (setq byte-optimize t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Use this to report bugs:
@ -945,47 +943,61 @@ the entire buffer is forced."
;; Initialization.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(and (not hilit-inhibit-rebinding)
(progn
(substitute-key-definition 'yank 'hilit-yank
(current-global-map))
(substitute-key-definition 'yank-pop 'hilit-yank-pop
(current-global-map))
(substitute-key-definition 'recenter 'hilit-recenter
(current-global-map))))
(define-minor-mode hilit-mode
"Obsolete minor mode. Use `global-font-lock-mode' instead."
:global t
(global-set-key [?\C-\S-l] 'hilit-repaint-command)
(unless (and hilit-inhibit-rebinding hilit-mode)
(substitute-key-definition
(if hilit-mode 'yank 'hilit-yank)
(if hilit-mode 'hilit-yank 'yank)
(current-global-map))
(substitute-key-definition
(if hilit-mode 'yank-pop 'hilit-yank-pop)
(if hilit-mode 'hilit-yank-pop 'yank-pop)
(current-global-map))
(substitute-key-definition
(if hilit-mode 'recenter 'hilit-recenter)
(if hilit-mode 'hilit-recenter 'recenter)
(current-global-map)))
(add-hook 'find-file-hook 'hilit-find-file-hook t)
(if hilit-mode
(global-set-key [?\C-\S-l] 'hilit-repaint-command)
(global-unset-key [?\C-\S-l]))
(if hilit-mode
(add-hook 'find-file-hook 'hilit-find-file-hook t)
(remove-hook 'find-file-hook 'hilit-find-file-hook))
(unless (and hilit-inhibit-hooks hilit-mode)
(condition-case c
(progn
;; BUFFER highlights...
(mapcar (lambda (hook)
(if hilit-mode
(add-hook hook 'hilit-rehighlight-buffer-quietly)
(remove-hook hook 'hilit-rehighlight-buffer-quietly)))
'(
Info-selection-hook
;; runs too early vm-summary-mode-hooks
vm-summary-pointer-hook
vm-preview-message-hook
vm-show-message-hook
rmail-show-message-hook
mail-setup-hook
mh-show-mode-hook
dired-after-readin-hook
))
)
(error (message "Error loading highlight hooks: %s" c)
(ding) (sit-for 1)))))
(eval-when-compile (require 'gnus)) ; no compilation gripes
(and (not hilit-inhibit-hooks)
(condition-case c
(progn
;; BUFFER highlights...
(mapcar (function
(lambda (hook)
(add-hook hook 'hilit-rehighlight-buffer-quietly)))
'(
Info-selection-hook
;; runs too early vm-summary-mode-hooks
vm-summary-pointer-hook
vm-preview-message-hook
vm-show-message-hook
rmail-show-message-hook
mail-setup-hook
mh-show-mode-hook
dired-after-readin-hook
))
)
(error (message "Error loading highlight hooks: %s" c)
(ding) (sit-for 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Default patterns for various modes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1510,5 +1522,5 @@ number of backslashes."
(provide 'hilit19)
;;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d
;; arch-tag: db99739a-4837-41ee-ad02-3baced8ae71d
;;; hilit19.el ends here

14
lisp/pcomplete.el
View file

@ -150,7 +150,7 @@ This mirrors the optional behavior of tcsh."
:type 'boolean
:group 'pcomplete)
(defcustom pcomplete-suffix-list (list directory-sep-char ?:)
(defcustom pcomplete-suffix-list (list ?/ ?:)
"*A list of characters which constitute a proper suffix."
:type '(repeat character)
:group 'pcomplete)
@ -347,12 +347,12 @@ modified to be an empty string, or the desired separation string."
;;; User Functions:
;;;###autoload
(defun pcomplete ()
(defun pcomplete (&optional interactively)
"Support extensible programmable completion.
To use this function, just bind the TAB key to it, or add it to your
completion functions list (it should occur fairly early in the list)."
(interactive)
(if (and (interactive-p)
(interactive "p")
(if (and interactively
pcomplete-cycle-completions
pcomplete-current-completions
(memq last-command '(pcomplete
@ -740,7 +740,7 @@ component, `default-directory' is used as the basis for completion."
(function
(lambda (file)
(if (eq (aref file (1- (length file)))
directory-sep-char)
?/)
(and pcomplete-dir-ignore
(string-match pcomplete-dir-ignore file))
(and pcomplete-file-ignore
@ -757,11 +757,11 @@ component, `default-directory' is used as the basis for completion."
;; since . is earlier in the ASCII alphabet than
;; /
(let ((left (if (eq (aref l (1- (length l)))
directory-sep-char)
?/)
(substring l 0 (1- (length l)))
l))
(right (if (eq (aref r (1- (length r)))
directory-sep-char)
?/)
(substring r 0 (1- (length r)))
r)))
(if above-cutoff

4
lisp/progmodes/autoconf.el
View file

@ -1,6 +1,6 @@
;;; autoconf.el --- mode for editing Autoconf configure.in files
;; Copyright (C) 2000, 2003 Free Software Foundation, Inc.
;; Copyright (C) 2000, 2003, 2004 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages
@ -49,7 +49,7 @@
"AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\(\\sw+\\)")
(defvar autoconf-font-lock-keywords
`(("A[CHM]_\\sw+" . font-lock-keyword-face)
`(("A[CHMS]_\\sw+" . font-lock-keyword-face)
(,autoconf-definition-regexp
3 font-lock-function-name-face)
;; Are any other M4 keywords really appropriate for configure.in,

14
lisp/progmodes/compile.el
View file

@ -181,6 +181,16 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(epc
"^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
(ftnchek-file
"^File \\(.+\\.f\\):$"
1 nil nil 0)
(ftnchek-line-file
"\\(^Warning .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)? file \\(.+\\.f\\)"
4 2 3 (1) nil (1 'default nil t))
(ftnchek-line
"\\(?:^\\(Warning\\) .* \\)?line \\([0-9]+\\)\\(?: col \\([0-9]+\\)\\)?"
nil 2 3 (1) nil (1 (compilation-face '(1)) nil t))
(iar
"^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
1 2 nil (3))
@ -191,8 +201,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; fixme: should be `mips'
(irix
"^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
"^[-[:alnum:]_/ ]+: \\(?:\\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*: \\)?\
\\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
(java
"^\\(?:[ \t]+at \\|==[0-9]+== +\\(?:at\\|b\\(y\\)\\)\\).+(\\([^()\n]+\\):\\([0-9]+\\))$" 2 3 nil (1))

5
lisp/progmodes/flymake.el
View file

@ -94,7 +94,7 @@
(defun flymake-split-string(str pattern)
(cond
((equal flymake-emacs 'xemacs) (flymake-split-string-remove-empty-edges str pattern))
(t (split-string str pattern))
(t (flymake-split-string-remove-empty-edges str pattern))
)
)
@ -1243,7 +1243,8 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re
(" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)"
2 4 nil 5)
)
compilation-error-regexp-alist)
;; compilation-error-regexp-alist)
(mapcar (lambda (x) (cdr x)) compilation-error-regexp-alist-alist))
"patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)"
)
;(defcustom flymake-err-line-patterns

128
lisp/progmodes/gdb-ui.el
View file

@ -25,28 +25,28 @@
;;; Commentary:
;; This mode acts as a graphical user interface to GDB. You can interact with
;; This mode acts as a graphical user interface to GDB. You can interact with
;; GDB through the GUD buffer in the usual way, but there are also further
;; buffers which control the execution and describe the state of your program.
;; It separates the input/output of your program from that of GDB, if
;; required, and watches expressions in the speedbar. It also uses features of
;; required, and watches expressions in the speedbar. It also uses features of
;; Emacs 21 such as the fringe/display margin for breakpoints, and the toolbar
;; (see the GDB Graphical Interface section in the Emacs info manual).
;; Start the debugger with M-x gdba.
;; This file has evolved from gdba.el from GDB 5.0 written by Tom Lord and Jim
;; Kingdon and uses GDB's annotation interface. You don't need to know about
;; Kingdon and uses GDB's annotation interface. You don't need to know about
;; annotations to use this mode as a debugger, but if you are interested
;; developing the mode itself, then see the Annotations section in the GDB
;; info manual.
;;
;; GDB developers plan to make the annotation interface obsolete. A new
;; GDB developers plan to make the annotation interface obsolete. A new
;; interface called GDB/MI (machine interface) has been designed to replace
;; it. Some GDB/MI commands are used in this file through the CLI command
;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
;; it. Some GDB/MI commands are used in this file through the CLI command
;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included in the
;; GDB repository for future releases (6.2 onwards) that uses GDB/MI as the
;; primary interface to GDB. It is still under development and is part of a
;; primary interface to GDB. It is still under development and is part of a
;; process to migrate Emacs from annotations to GDB/MI.
;;
;; Known Bugs:
@ -63,7 +63,7 @@
(defvar gdb-current-language nil)
(defvar gdb-view-source t "Non-nil means that source code can be viewed.")
(defvar gdb-selected-view 'source "Code type that user wishes to view.")
(defvar gdb-var-list nil "List of variables in watch window")
(defvar gdb-var-list nil "List of variables in watch window.")
(defvar gdb-var-changed nil "Non-nil means that gdb-var-list has changed.")
(defvar gdb-buffer-type nil)
(defvar gdb-overlay-arrow-position nil)
@ -85,12 +85,12 @@ other with the source file with the main routine of the inferior.
If `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear unless
`gdb-use-inferior-io-buffer' is nil when the source buffer
occupies the full width of the frame. Keybindings are given in
occupies the full width of the frame. Keybindings are given in
relevant buffer.
Watch expressions appear in the speedbar/slowbar.
The following interactive lisp functions help control operation :
The following commands help control operation :
`gdb-many-windows' - Toggle the number of windows gdb uses.
`gdb-restore-windows' - To restore the window layout.
@ -120,8 +120,7 @@ detailed description of this mode.
RET gdb-frames-select | SPC gdb-toggle-breakpoint
| RET gdb-goto-breakpoint
| d gdb-delete-breakpoint
---------------------------------------------------------------------
"
---------------------------------------------------------------------"
;;
(interactive (list (gud-query-cmdline 'gdba)))
;;
@ -210,8 +209,7 @@ detailed description of this mode.
(run-hooks 'gdba-mode-hook))
(defcustom gdb-use-colon-colon-notation nil
"Non-nil means use FUNCTION::VARIABLE format to display variables in the
speedbar."
"If non-nil use FUN::VAR format to display variables in the speedbar." ;
:type 'boolean
:group 'gud)
@ -376,7 +374,7 @@ speedbar."
(setq gdb-var-changed t))))))
(defun gdb-edit-value (text token indent)
"Assign a value to a variable displayed in the speedbar"
"Assign a value to a variable displayed in the speedbar."
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
(varnum (cadr var)) (value))
(setq value (read-string "New value: "))
@ -389,8 +387,8 @@ speedbar."
'ignore))))
(defcustom gdb-show-changed-values t
"Non-nil means use font-lock-warning-face to display values that have
recently changed in the speedbar."
"If non-nil highlight values that have recently changed in the speedbar.
The highlighting is done with `font-lock-warning-face'."
:type 'boolean
:group 'gud)
@ -422,23 +420,23 @@ INDENT is the current indentation depth."
"The disposition of the output of the current gdb command.
Possible values are these symbols:
user -- gdb output should be copied to the GUD buffer
for the user to see.
`user' -- gdb output should be copied to the GUD buffer
for the user to see.
inferior -- gdb output should be copied to the inferior-io buffer
`inferior' -- gdb output should be copied to the inferior-io buffer
pre-emacs -- output should be ignored util the post-prompt
annotation is received. Then the output-sink
becomes:...
emacs -- output should be collected in the partial-output-buffer
for subsequent processing by a command. This is the
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.
post-emacs -- ignore output until the prompt annotation is
received, then go to USER disposition.
`pre-emacs' -- output should be ignored util the post-prompt
annotation is received. Then the output-sink
becomes:...
`emacs' -- output should be collected in the partial-output-buffer
for subsequent processing by a command. This is the
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.
`post-emacs' -- ignore output until the prompt annotation is
received, then go to USER disposition.
gdba (gdb-ui.el) uses all five values, gdbmi (gdb-mi.el) only two
(user and emacs).")
\(`user' and `emacs').")
(defvar gdb-current-item nil
"The most recent command item sent to gdb.")
@ -619,7 +617,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
(defun gdb-send (proc string)
"A comint send filter for gdb.
This filter may simply queue output for a later time."
This filter may simply queue input for a later time."
(if gud-running
(process-send-string proc (concat string "\n"))
(gdb-enqueue-input (concat string "\n"))))
@ -705,25 +703,25 @@ This filter may simply queue output for a later time."
(setq gdb-current-item item)
(with-current-buffer gud-comint-buffer
(if (eq gud-minor-mode 'gdba)
(progn
(if (stringp item)
(progn
(setq gdb-output-sink 'user)
(process-send-string (get-buffer-process gud-comint-buffer) item))
(if (stringp item)
(progn
(gdb-clear-partial-output)
(setq gdb-output-sink 'pre-emacs)
(process-send-string (get-buffer-process gud-comint-buffer)
(car item)))))
; case: eq gud-minor-mode 'gdbmi
(setq gdb-output-sink 'user)
(process-send-string (get-buffer-process gud-comint-buffer) item))
(progn
(gdb-clear-partial-output)
(setq gdb-output-sink 'pre-emacs)
(process-send-string (get-buffer-process gud-comint-buffer)
(car item))))
;; case: eq gud-minor-mode 'gdbmi
(gdb-clear-partial-output)
(setq gdb-output-sink 'emacs)
(process-send-string (get-buffer-process gud-comint-buffer)
(car item)))))
(car item)))))
(defun gdb-pre-prompt (ignored)
"An annotation handler for `pre-prompt'. This terminates the collection of
output from a previous command if that happens to be in effect."
"An annotation handler for `pre-prompt'.
This terminates the collection of output from a previous command if that
happens to be in effect."
(let ((sink gdb-output-sink))
(cond
((eq sink 'user) t)
@ -761,8 +759,9 @@ This sends the next command (if any) to gdb."
(setq gdb-prompting t))
(defun gdb-starting (ignored)
"An annotation handler for `starting'. This says that I/O for the
subprocess is now the program being debugged, not GDB."
"An annotation handler for `starting'.
This says that I/O for the subprocess is now the program being debugged,
not GDB."
(let ((sink gdb-output-sink))
(cond
((eq sink 'user)
@ -773,8 +772,9 @@ subprocess is now the program being debugged, not GDB."
(t (error "Unexpected `starting' annotation")))))
(defun gdb-stopping (ignored)
"An annotation handler for `exited' and other annotations which say that I/O
for the subprocess is now GDB, not the program being debugged."
"An annotation handler for `exited' and other annotations.
They say that I/O for the subprocess is now GDB, not the program
being debugged."
(if gdb-use-inferior-io-buffer
(let ((sink gdb-output-sink))
(cond
@ -792,8 +792,9 @@ for the subprocess is now GDB, not the program being debugged."
(t (error "Unexpected frame-begin annotation (%S)" sink)))))
(defun gdb-stopped (ignored)
"An annotation handler for `stopped'. It is just like gdb-stopping, except
that if we already set the output sink to 'user in gdb-stopping, that is fine."
"An annotation handler for `stopped'.
It is just like `gdb-stopping', except that if we already set the output
sink to `user' in `gdb-stopping', that is fine."
(setq gud-running nil)
(let ((sink gdb-output-sink))
(cond
@ -803,8 +804,9 @@ that if we already set the output sink to 'user in gdb-stopping, that is fine."
(t (error "Unexpected stopped annotation")))))
(defun gdb-post-prompt (ignored)
"An annotation handler for `post-prompt'. This begins the collection of
output from the current command if that happens to be appropriate."
"An annotation handler for `post-prompt'.
This begins the collection of output from the current command if that
happens to be appropriate."
(if (not gdb-pending-triggers)
(progn
(gdb-get-current-frame)
@ -832,7 +834,7 @@ output from the current command if that happens to be appropriate."
(error "Phase error in gdb-post-prompt (got %s)" sink)))))
(defun gud-gdba-marker-filter (string)
"A gud marker filter for gdb. Handle a burst of output from GDB."
"A gud marker filter for gdb. Handle a burst of output from GDB."
(if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
;; Recall the left over gud-marker-acc from last time
(setq gud-marker-acc (concat gud-marker-acc string))
@ -1065,10 +1067,10 @@ static char *magick[] = {
"PBM data used for disabled breakpoint icon.")
(defvar breakpoint-enabled-icon nil
"Icon for enabled breakpoint in display margin")
"Icon for enabled breakpoint in display margin.")
(defvar breakpoint-disabled-icon nil
"Icon for disabled breakpoint in display margin")
"Icon for disabled breakpoint in display margin.")
;; Bitmap for breakpoint in fringe
(define-fringe-bitmap 'breakpoint
@ -1133,7 +1135,7 @@ static char *magick[] = {
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
(defun gdb-mouse-toggle-breakpoint (event)
"Toggle breakpoint in left fringe/margin with mouse click"
"Toggle breakpoint in left fringe/margin with mouse click."
(interactive "e")
(mouse-minibuffer-check event)
(let ((posn (event-end event)))
@ -1718,11 +1720,11 @@ static char *magick[] = {
(other-window 1))
(defcustom gdb-many-windows nil
"Nil (the default value) means just pop up the GUD buffer
unless `gdb-show-main' is t. In this case it starts with two
windows: one displaying the GUD buffer and the other with the
source file with the main routine of the inferior. Non-nil means
display the layout shown for `gdba'."
"Nil means just pop up the GUD buffer unless `gdb-show-main' is t.
In this case it starts with two windows: one displaying the GUD
buffer and the other with the source file with the main routine
of the inferior. Non-nil means display the layout shown for
`gdba'."
:type 'boolean
:group 'gud)
@ -1760,8 +1762,8 @@ This arrangement depends on the value of `gdb-many-windows'."
(other-window 1)))
(defun gdb-reset ()
"Exit a debugging session cleanly by killing the gdb buffers and resetting
the source buffers."
"Exit a debugging session cleanly.
Kills the gdb buffers and resets the source buffers."
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer

28
lisp/progmodes/grep.el
View file

@ -1,7 +1,7 @@
;;; grep.el --- run compiler as inferior of Emacs, parse error messages
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999, 2001, 02, 2004
;; Free Software Foundation, Inc.
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2001, 2002, 2004 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
@ -252,21 +252,12 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
\\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6))
("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
1 2
;; Calculate column positions (beg . end) of first grep match on a line
((lambda ()
(setq compilation-error-screen-columns nil)
(- (match-beginning 5) (match-end 3) 8))
.
(lambda () (- (match-end 5) (match-end 3) 8)))
nil nil
(4 (list 'face nil 'invisible t 'intangible t))
(5 (list 'face compilation-column-face))
(6 (list 'face nil 'invisible t 'intangible t))
;; highlight other matches on the same line
("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
nil nil
(1 (list 'face nil 'invisible t 'intangible t))
(2 (list 'face compilation-column-face) t)
(3 (list 'face nil 'invisible t 'intangible t))))
(lambda () (- (match-end 5) (match-end 3) 8))))
("^Binary file \\(.+\\) matches$" 1 nil nil 1))
"Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
@ -294,7 +285,16 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
("^Grep \\(exited abnormally\\) with code \\([0-9]+\\).*"
(0 '(face nil message nil help-echo nil mouse-face nil) t)
(1 compilation-warning-face)
(2 compilation-line-face)))
(2 compilation-line-face))
;; Highlight grep matches and delete markers
("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)"
(2 compilation-column-face)
((lambda (p))
(progn
;; Delete markers with `replace-match' because it updates
;; the match-data, whereas `delete-region' would render it obsolete.
(replace-match "" t t nil 3)
(replace-match "" t t nil 1)))))
"Additional things to highlight in grep output.
This gets tacked on the end of the generated expressions.")

5
lisp/shadowfile.el
View file

@ -518,8 +518,9 @@ Pending copies are stored in variable `shadow-files-to-copy', and in
`shadow-save-buffers-kill-emacs', so it is not usually necessary to
call it manually."
(interactive "P")
(if (and (not shadow-files-to-copy) (interactive-p))
(message "No files need to be shadowed.")
(if (not shadow-files-to-copy)
(if (interactive-p)
(message "No files need to be shadowed."))
(save-excursion
(map-y-or-n-p (function
(lambda (pair)

14
lisp/simple.el
View file

@ -1901,13 +1901,13 @@ value passed."
(if fh (apply fh 'process-file program infile buffer display args)
(when infile (setq lc (file-local-copy infile)))
(setq stderr-file (when (and (consp buffer) (stringp (cadr buffer)))
(make-temp-file "emacs"))))
(prog1
(apply 'call-process program
(or lc infile)
(if stderr-file (list (car buffer) stderr-file) buffer)
display args)
(when stderr-file (copy-file stderr-file (cadr buffer))))
(make-temp-file "emacs")))
(prog1
(apply 'call-process program
(or lc infile)
(if stderr-file (list (car buffer) stderr-file) buffer)
display args)
(when stderr-file (copy-file stderr-file (cadr buffer)))))
(when stderr-file (delete-file stderr-file))
(when lc (delete-file lc)))))

4
lisp/speedbar.el
View file

@ -354,7 +354,9 @@ Any parameter supported by a frame may be added. The parameter `height'
will be initialized to the height of the frame speedbar is
attached to and added to this list before the new frame is initialized."
:group 'speedbar
:type '(repeat (sexp :tag "Parameter:")))
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value"))))
;; These values by Hrvoje Niksic <hniksic@srce.hr>
(defcustom speedbar-frame-plist

2
lisp/strokes.el
View file

@ -1746,7 +1746,7 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
(strokes-mode -1)
(remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes))
(add-hooks 'strokes-unload-hook 'strokes-unload-hook)
(add-hook 'strokes-unload-hook 'strokes-unload-hook)
(run-hooks 'strokes-load-hook)
(provide 'strokes)

4
lisp/subr.el
View file

@ -817,6 +817,10 @@ is converted into a string by expressing it in decimal."
(make-obsolete-variable 'post-command-idle-delay
"use timers instead, with `run-with-idle-timer'." "before 19.34")
(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "21.4")
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "21.4")
;;;; Alternate names for functions - these are not being phased out.

2
lisp/tar-mode.el
View file

@ -578,7 +578,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
;; Prevent loss of data when saving the file.
(set (make-local-variable 'file-precious-flag) t)
(auto-save-mode 0)
(set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file))
(set (make-local-variable 'write-contents-functions) '(tar-mode-write-file))
(widen)
(if (and (boundp 'tar-header-offset) tar-header-offset)
(narrow-to-region (point-min) (byte-to-position tar-header-offset))

20
lisp/textmodes/sgml-mode.el
View file

@ -453,10 +453,22 @@ Do \\[describe-key] on the following bindings to discover what they do.
;; recognized.
(set (make-local-variable 'comment-start-skip) "\\(?:<!\\)?--[ \t]*")
(set (make-local-variable 'comment-end-skip) "[ \t]*--\\([ \t\n]*>\\)?")
;; This definition probably is not useful in derived modes.
(set (make-local-variable 'imenu-generic-expression)
(concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
sgml-name-re "\\)")))
;; This definition has an HTML leaning but probably fits well for other modes.
(setq imenu-generic-expression
`((nil
,(concat "<!\\(element\\|entity\\)[ \t\n]+%?[ \t\n]*\\("
sgml-name-re "\\)")
2)
("Id"
,(concat "<[^>]+[ \t\n]+[Ii][Dd]=\\(['\"]"
(if sgml-xml-mode "" "?")
"\\)\\(" sgml-name-re "\\)\\1")
2)
("Name"
,(concat "<[^>]+[ \t\n]+[Nn][Aa][Mm][Ee]=\\(['\"]"
(if sgml-xml-mode "" "?")
"\\)\\(" sgml-name-re "\\)\\1")
2))))
;; Some programs (such as Glade 2) generate XML which has
;; -*- mode: xml -*-.

6
lisp/textmodes/tex-mode.el
View file

@ -468,6 +468,10 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
(arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
(list
;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be
;; highlighted as tex-verbatim-face. Let's undo that.
;; This is ugly and brittle :-( --Stef
'("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t))
;; display $$ math $$
;; We only mark the match between $$ and $$ because the $$ delimiters
;; themselves have already been marked (along with $..$) by syntactic
@ -619,6 +623,8 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; 2 - font-lock considers the preceding \n as being part of the
;; preceding line, so things gets screwed every time the previous
;; line is re-font-locked on its own.
;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim
;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef
(,(concat "^\\(\\\\\\)end *{" verbs "}\\(.?\\)") (1 "|") (3 "<"))
;; ("^\\(\\\\\\)begin *{comment}" 1 "< b")
;; ("^\\\\end *{comment}.*\\(\n\\)" 1 "> b")

35
lisp/type-break.el
View file

@ -1005,8 +1005,8 @@ FRAC should be the inverse of the fractional value; for example, a value of
(setcar type-break-keystroke-threshold lower)
(setcdr type-break-keystroke-threshold upper)
(if (interactive-p)
(message "min threshold: %d\tmax threshold: %d" lower upper)
type-break-keystroke-threshold)))
(message "min threshold: %d\tmax threshold: %d" lower upper))
type-break-keystroke-threshold))
;;; misc functions
@ -1103,37 +1103,12 @@ With optional non-nil ALL, force redisplay of all mode-lines."
(defun type-break-run-at-time (time repeat function)
(condition-case nil (or (require 'timer) (require 'itimer)) (error nil))
(cond ((fboundp 'run-at-time)
(run-at-time time repeat function))
((fboundp 'start-timer)
(let ((name (if (symbolp function)
(symbol-name function)
"type-break")))
(start-timer name function time repeat)))
((fboundp 'start-itimer)
(let ((name (if (symbolp function)
(symbol-name function)
"type-break")))
(start-itimer name function time repeat)))))
(run-at-time time repeat function))
(defvar timer-dont-exit)
(defun type-break-cancel-function-timers (function)
(cond ((fboundp 'cancel-function-timers)
(let ((timer-dont-exit t))
(cancel-function-timers function)))
((fboundp 'delete-timer)
(let ((list timer-list))
(while list
(and (eq (funcall 'timer-function (car list)) function)
(delete-timer (car list)))
(setq list (cdr list)))))
((fboundp 'delete-itimer)
(with-no-warnings
(let ((list itimer-list))
(while list
(and (eq (funcall 'itimer-function (car list)) function)
(delete-itimer (car list)))
(setq list (cdr list))))))))
(let ((timer-dont-exit t))
(cancel-function-timers function)))
;;; Demo wrappers

2
lisp/woman.el
View file

@ -1132,7 +1132,7 @@ Used non-interactively, arguments are optional: if given then TOPIC
should be a topic string and non-nil RE-CACHE forces re-caching."
(interactive (list nil current-prefix-arg))
;; The following test is for non-interactive calls via gnudoit etc.
(if (or (interactive-p) (not (stringp topic)) (string-match "\\S " topic))
(if (or (not (stringp topic)) (string-match "\\S " topic))
(let ((file-name (woman-file-name topic re-cache)))
(if file-name
(woman-find-file file-name)

29
lispref/ChangeLog
View file

@ -1,3 +1,32 @@
2004-10-29 Simon Josefsson <jas@extundo.com>
* minibuf.texi (Reading a Password): Revert.
2004-10-28 Richard M. Stallman <rms@gnu.org>
* frames.texi (Display Feature Testing): Explain about "vendor".
2004-10-27 Richard M. Stallman <rms@gnu.org>
* commands.texi (Interactive Codes): `N' uses numeric prefix,
not raw. Clarify `n'.
(Interactive Call): Rewrite interactive-p, focusing on when
and how to use it.
(Misc Events): Clarify previous change.
* advice.texi (Simple Advice): Clarify what job the example does.
(Around-Advice): Clarify ad-do-it.
(Activation of Advice): An option of ad-default-compilation-action
is `never', not `nil'.
2004-10-26 Kim F. Storm <storm@cua.dk>
* commands.texi (Interactive Codes): Add U code letter.
2004-10-25 Simon Josefsson <jas@extundo.com>
* minibuf.texi (Reading a Password): Add.
2004-10-24 Jason Rumney <jasonr@gnu.org>
* commands.texi (Misc Events): Remove mouse-wheel. Add wheel-up

18
lispref/advice.texi
View file

@ -51,7 +51,8 @@ is @code{nil}.)
Suppose you wanted to add a similar feature to @code{previous-line},
which would insert a new line at the beginning of the buffer for the
command to move to. How could you do this?
command to move to (when @code{next-line-add-newlines} is
non-@code{nil}). How could you do this?
You could do it by redefining the whole function, but that is not
modular. The advice feature provides a cleaner alternative: you can
@ -273,9 +274,9 @@ Its effect is to make sure that case is ignored in
searches when the original definition of @code{foo} is run.
@defvar ad-do-it
This is not really a variable, but it is somewhat used like one
in around-advice. It specifies the place to run the function's
original definition and other ``earlier'' around-advice.
This is not really a variable, rather a place-holder that looks like a
variable. You use it in around-advice to specify the place to run the
function's original definition and other ``earlier'' around-advice.
@end defvar
If the around-advice does not use @code{ad-do-it}, then it does not run
@ -360,10 +361,9 @@ advice.
This command activates all the advice defined for @var{function}.
@end deffn
To activate advice for a function whose advice is already active is not
a no-op. It is a useful operation which puts into effect any changes in
that function's advice since the previous activation of advice for that
function.
Activating advice does nothing if @var{function}'s advice is already
active. But if there is new advice, added since the previous time you
activated advice for @var{function}, it activates the new advice.
@deffn Command ad-deactivate function
This command deactivates the advice for @var{function}.
@ -430,7 +430,7 @@ This variable controls whether to compile the combined definition
that results from activating advice for a function.
A value of @code{always} specifies to compile unconditionally.
A value of @code{nil} specifies never compile the advice.
A value of @code{never} specifies never compile the advice.
A value of @code{maybe} specifies to compile if the byte-compiler is
already loaded. A value of @code{like-original} specifies to compile

78
lispref/commands.texi
View file

@ -360,6 +360,9 @@ until a command (or undefined command) is found in the current key
maps. The key sequence argument is represented as a string or vector.
The cursor does not move into the echo area. Prompt.
If the key sequence is a down-event, the following up-event is discarded,
but can be read via the @code{U} code character.
This kind of input is used by commands such as @code{describe-key} and
@code{global-set-key}.
@ -379,15 +382,14 @@ method, and returned as a string (@pxref{Input Methods,,, emacs, The GNU
Emacs Manual}). Prompt.
@item n
A number read with the minibuffer. If the input is not a number, the
user is asked to try again. The prefix argument, if any, is not used.
A number, read with the minibuffer. If the input is not a number, the
user has to try again. @samp{n} never uses the prefix argument.
Prompt.
@item N
@cindex raw prefix argument usage
The numeric prefix argument; but if there is no prefix argument, read a
number as with @kbd{n}. Requires a number. @xref{Prefix Command
Arguments}. Prompt.
The numeric prefix argument; but if there is no prefix argument, read
a number as with @kbd{n}. The value is always a number. @xref{Prefix
Command Arguments}. Prompt.
@item p
@cindex numeric prefix argument usage
@ -395,6 +397,7 @@ The numeric prefix argument. (Note that this @samp{p} is lower case.)
No I/O.
@item P
@cindex raw prefix argument usage
The raw prefix argument. (Note that this @samp{P} is upper case.) No
I/O.
@ -416,6 +419,11 @@ character terminates the input. (Use @kbd{C-q} to include whitespace in
the string.) Other characters that normally terminate a symbol (e.g.,
parentheses and brackets) do not do so here. Prompt.
@item U
A key sequence or nil. May be used after a @code{k} or @code{K}
argument to get the up-event that was discarded in case the key
sequence read for that argument was a down-event. No I/O.
@item v
A variable declared to be a user option (i.e., satisfying the
predicate @code{user-variable-p}). This reads the variable using
@ -605,25 +613,23 @@ part of the prompt.
@end deffn
@defun interactive-p
This function returns @code{t} if the containing function (the one whose
code includes the call to @code{interactive-p}) was called
interactively, with the function @code{call-interactively}. (It makes
no difference whether @code{call-interactively} was called from Lisp or
directly from the editor command loop.) If the containing function was
called by Lisp evaluation (or with @code{apply} or @code{funcall}), then
it was not called interactively.
This function returns @code{t} if the containing function (the one
whose code includes the call to @code{interactive-p}) was called in
direct response to user input. This means that it was called with the
function @code{call-interactively}, and that a keyboard macro is
not running.
If the containing function was called by Lisp evaluation (or with
@code{apply} or @code{funcall}), then it was not called interactively.
@end defun
The most common use of @code{interactive-p} is for deciding whether to
print an informative message. As a special exception,
@code{interactive-p} returns @code{nil} whenever a keyboard macro is
being run. This is to suppress the informative messages and speed
execution of the macro.
For example:
The most common use of @code{interactive-p} is for deciding whether
to give the user additional visual feedback (such as by printing an
informative message). For example:
@example
@group
;; @r{Here's the usual way to use @code{interactive-p}.}
(defun foo ()
(interactive)
(when (interactive-p)
@ -632,6 +638,7 @@ execution of the macro.
@end group
@group
;; @r{This function is just to illustrate the behavior.}
(defun bar ()
(interactive)
(setq foobar (list (foo) (interactive-p))))
@ -645,7 +652,7 @@ execution of the macro.
@group
;; @r{Type @kbd{M-x bar}.}
;; @r{This does not print anything.}
;; @r{This does not display a message.}
@end group
@group
@ -654,10 +661,11 @@ foobar
@end group
@end example
The other way to do this sort of job is to make the command take an
argument @code{print-message} which should be non-@code{nil} in an
interactive call, and use the @code{interactive} spec to make sure it is
non-@code{nil}. Here's how:
If you want to test @emph{only} whether the function was called
using @code{call-interactively}, add an optional argument
@code{print-message} which should be non-@code{nil} in an interactive
call, and use the @code{interactive} spec to make sure it is
non-@code{nil}. Here's an example:
@example
(defun foo (&optional print-message)
@ -667,10 +675,9 @@ non-@code{nil}. Here's how:
@end example
@noindent
Defined in this way, the function does display the message when
called from a keyboard macro.
The numeric prefix argument, provided by @samp{p}, is never @code{nil}.
Defined in this way, the function does display the message when called
from a keyboard macro. We use @code{"p"} because the numeric prefix
argument is never @code{nil}.
@node Command Loop Info
@comment node-name, next, previous, up
@ -1505,16 +1512,17 @@ frame has already been made visible, Emacs has no work to do.
@cindex @code{wheel-down} event
@item (wheel-up @var{position})
@item (wheel-down @var{position})
This kind of event is generated by moving a wheel on a mouse. Its
effect is typically a kind of scroll or zoom.
These kinds of event are generated by moving a mouse wheel. Their
usual meaning is a kind of scroll or zoom.
The element @var{position} is a list describing the position of the
event, in the same format as used in a mouse-click event.
This kind of event is generated only on some kinds of systems. On
other systems, mouse-4 and mouse-5 may be used instead. For portable
code, the variables @code{mouse-wheel-up-event} and
@code{mouse-wheel-down-event} defined in @file{mwheel.el} can be used.
This kind of event is generated only on some kinds of systems. On some
systems, @code{mouse-4} and @code{mouse-5} are used instead. For
portable code, use the variables @code{mouse-wheel-up-event} and
@code{mouse-wheel-down-event} defined in @file{mwheel.el} to determine
what event types to expect for the mouse wheel.
@cindex @code{drag-n-drop} event
@item (drag-n-drop @var{position} @var{files})

12
lispref/frames.texi
View file

@ -1980,12 +1980,18 @@ about X displays.
@defun x-server-version &optional display
This function returns the list of version numbers of the X server
running the display. The value is a list of three integers: the major
and minor version numbers, and the vendor-specific release number.
and minor version numbers of the X protocol, and the
distributor-specific release number of the X server software itself.
@end defun
@defun x-server-vendor &optional display
This function returns the ``vendor'' that provided the X server software
(as a string).
This function returns the ``vendor'' that provided the X server
software (as a string). Really this means whoever distributes the X
server.
When the developers of X labelled software distributors as
``vendors'', they showed their false assumption that no system could
ever be developed and distributed noncommercially.
@end defun
@ignore

4
nt/INSTALL
View file

@ -54,7 +54,9 @@
In addition, using 4NT as your shell is known to fail the build process,
at least for 4NT version 3.01. Use cmd.exe, the default NT shell,
instead.
instead. MSYS sh.exe also appears to cause various problems. If you have
MSYS installed, try "make SHELL=cmd.exe" to force the use of cmd.exe
instead of sh.exe.
sh exists no sh

101
src/ChangeLog
View file

@ -1,3 +1,74 @@
2004-10-28 Will <will@glozer.net>
* macterm.c: allow user to assign key modifiers to the Mac Option
key via a 'mac-option-modifier' variable.
2004-10-28 Stefan <monnier@iro.umontreal.ca>
* xselect.c (Vx_lost_selection_functions, Vx_sent_selection_functions):
Rename from Vx_lost_selection_hooks and Vx_sent_selection_hooks.
(x_handle_selection_request, x_handle_selection_clear)
(x_clear_frame_selections, syms_of_xselect): Adjust accordingly.
2004-10-28 Richard M. Stallman <rms@gnu.org>
* w32fns.c (Fx_server_vendor, Fx_server_version): Doc fixes.
* xfns.c (Fx_server_vendor, Fx_server_version): Doc fixes.
2004-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
* syntax.c (scan_sexps_forward): Give precedence to a 2-char
comment-starter over a 1-char one.
2004-10-27 Richard M. Stallman <rms@gnu.org>
* xdisp.c (get_next_display_element): In mode lines,
treat newline and tab like other control characters.
* editfns.c (Fmessage): Doc fix.
* indent.c (vmotion): When moving up, check the newline before.
Make prevline an int, not a Lisp_Object.
2004-10-27 Kim F. Storm <storm@cua.dk>
* editfns.c (Fformat): Allocate discarded table with SAFE_ALLOCA.
Only allocate info and discarded tables once.
* lisp.h (USE_SAFE_ALLOCA): Add and init sa_must_free integer.
(SAFE_ALLOCA, SAFE_ALLOCA_LISP): Increment it when malloc is used.
(SAFE_FREE): Test it to determine if we need to unwind to free.
Remove size arg. All users changed.
(SAFE_FREE_LISP) Remove. All users changed to use SAFE_FREE.
2004-10-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* gtkutil.c: Put empty line between comment and function body.
(xg_destroy_widgets): Rename from remove_from_container.
Just destroy all widgets in list. Argument wcont removed.
(xg_update_menubar, xg_update_submenu): Call xg_destroy_widgets
instead of remove_from_container.
(xg_display_close, xg_create_tool_bar, update_frame_tool_bar)
(free_frame_tool_bar): Add comment.
* xfns.c (xic_create_xfontset): Check that FRAME_XIC_BASE_FONTNAME
is not NULL before strcmp.
2004-10-26 Kim F. Storm <storm@cua.dk>
* callint.c (Fcall_interactively): Add 'U' code to get the
up-event discarded by a previous 'k' or 'K' argument.
2004-10-26 David Kastrup <dak@gnu.org>
* buffer.c (syms_of_buffer): Fix a few typos.
2004-10-26 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* xsmfns.c: Put empty line between comment and function body.
Use two spaces before comment end.
2004-10-25 Kenichi Handa <handa@m17n.org>
* fontset.c (fontset_pattern_regexp): Optimize for the case that
@ -21,17 +92,17 @@
2004-10-21 K,Aa(Broly L$,1 q(Brentey <lorentey@elte.hu>
* xterm.h (x_output): New member `xic_base_fontname'.
(FRAME_XIC_BASE_FONTNAME): New macro.
(xic_free_xfontset): Declare.
* xterm.h (x_output): New member `xic_base_fontname'.
(FRAME_XIC_BASE_FONTNAME): New macro.
(xic_free_xfontset): Declare.
* xfns.c (xic_create_xfontset): Share fontsets between frames
based on base_fontname.
(xic_free_xfontset): New function.
(free_frame_xic): Use it.
(xic_set_xfontset): Ditto.
* xfns.c (xic_create_xfontset): Share fontsets between frames
based on base_fontname.
(xic_free_xfontset): New function.
(free_frame_xic): Use it.
(xic_set_xfontset): Ditto.
* xterm.c (xim_destroy_callback): Ditto.
* xterm.c (xim_destroy_callback): Ditto.
2004-10-20 B. Anyos <banyos@freemail.hu> (tiny change)
@ -75,10 +146,10 @@
* gtkutil.h (xg_update_scrollbar_pos): Remove arguments real_left
and canon_width.
(xg_frame_cleared): Removed.
(xg_frame_cleared): Remove.
* gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose,
xg_find_top_left_in_fixed): Removed.
* gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose)
(xg_find_top_left_in_fixed): Remove.
(xg_create_scroll_bar): Put an event box widget between
the scroll bar widget and the edit widget.
(xg_show_scroll_bar): Show the parent widget (the event box).
@ -87,11 +158,11 @@
Move the parent (the event box) widget inside the fixed widget.
Move window clear to xterm.c.
* gtkutil.h (xg_frame_cleared): Removed.
* gtkutil.h (xg_frame_cleared): Remove.
* xterm.c (x_clear_frame): Remove call to xg_frame_cleared
(x_scroll_bar_create, XTset_vertical_scroll_bar): Remove
arguments left and width to xg_update_scrollbar_pos.
(x_scroll_bar_create, XTset_vertical_scroll_bar):
Remove arguments left and width to xg_update_scrollbar_pos.
(XTset_vertical_scroll_bar): Do x_clear_area for USE_GTK also.
2004-10-19 Kenichi Handa <handa@m17n.org>

12
src/ChangeLog.8
View file

@ -6,25 +6,25 @@
1999-12-31 William M. Perry <wmperry@aventail.com>
* xfns.c (jpeg_format): Added the :data keyword
* xfns.c (jpeg_format): Add the :data keyword
(jpeg_image_p): JPEG is valid with :file _or_ :data
(jpeg_memory_src): Defined new JPEG image source to read from a
(jpeg_memory_src): Define new JPEG image source to read from a
memory buffer.
(jpeg_load): Pay attention to the :data keyword if specified.
Instantiates a jpeg_memory_src instead of jpeg_stdio_src if found.
(png_format): Added the :data keyword
(png_format): Add the :data keyword
(png_image_p): PNG is valid with :file _or_ :data
(png_read_from_memory): New PNG read function to read from a
memory buffer.
(png_load): Pay attention to the :data keyword if specified.
Use png_set_read_fn() instead of png_init_io() if specified.
(tiff_format): Added the :data keyword for TIFF images.
(tiff_format): Add the :data keyword for TIFF images.
(tiff_image_p): TIFF is valid with :file _or_ :data
(tiff_read_from_memory): Defined new TIFF I/O functions to read
(tiff_read_from_memory): Define new TIFF I/O functions to read
from a memory buffer.
(tiff_load): Pay attention to the :data keyword if specified.
Uses TIFFClientOpen() instead of TIFFOpen() if specified.
(gif_format): Added the :data keyword
(gif_format): Add the :data keyword
(gif_image_p): GIF is valid with :file _or_ :data
(gif_read_from_memory): New GIF input function to read from a
memory buffer.

12
src/buffer.c
View file

@ -5812,21 +5812,21 @@ If the value of the variable is t, undo information is not recorded. */);
doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly.
Normally, the line-motion functions work by scanning the buffer for
newlines. Columnar operations (like move-to-column and
compute-motion) also work by scanning the buffer, summing character
newlines. Columnar operations (like `move-to-column' and
`compute-motion') also work by scanning the buffer, summing character
widths as they go. This works well for ordinary text, but if the
buffer's lines are very long (say, more than 500 characters), these
motion functions will take longer to execute. Emacs may also take
longer to update the display.
If cache-long-line-scans is non-nil, these motion functions cache the
If `cache-long-line-scans' is non-nil, these motion functions cache the
results of their scans, and consult the cache to avoid rescanning
regions of the buffer until the text is modified. The caches are most
beneficial when they prevent the most searching---that is, when the
buffer contains long lines and large regions of characters with the
same, fixed screen width.
When cache-long-line-scans is non-nil, processing short lines will
When `cache-long-line-scans' is non-nil, processing short lines will
become slightly slower (because of the overhead of consulting the
cache), and the caches will use memory roughly proportional to the
number of newlines and characters whose screen width varies.
@ -5906,8 +5906,8 @@ Values are interpreted as follows:
hollow display a hollow box cursor
bar display a vertical bar cursor with default width
(bar . WIDTH) display a vertical bar cursor with width WIDTH
hbar display a horisontal bar cursor with default width
(hbar . WIDTH) display a horisontal bar cursor with width WIDTH
hbar display a horizontal bar cursor with default width
(hbar . WIDTH) display a horizontal bar cursor with width WIDTH
ANYTHING ELSE display a hollow box cursor.
When the buffer is displayed in a nonselected window,

23
src/callint.c
View file

@ -110,6 +110,7 @@ P -- Prefix arg in raw form. Does not do I/O.
r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
s -- Any string. Does not inherit the current input method.
S -- Any symbol.
U -- Mouse up event discarded by a previous k or K argument.
v -- Variable name: symbol that is user-variable-p.
x -- Lisp expression read but not evaluated.
X -- Lisp expression read and evaluated.
@ -268,6 +269,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
Lisp_Object specs;
Lisp_Object filter_specs;
Lisp_Object teml;
Lisp_Object up_event;
Lisp_Object enable;
int speccount = SPECPDL_INDEX ();
@ -289,7 +291,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
char prompt1[100];
char *tem1;
int arg_from_tty = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int key_count;
int record_then_fail = 0;
@ -328,6 +330,9 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
The feature is not fully implemented. */
filter_specs = Qnil;
/* If k or K discard an up-event, save it here so it can be retrieved with U */
up_event = Qnil;
/* Decode the kind of function. Either handle it and return,
or go to `lose' if not interactive, or go to `retry'
to specify a different function, or set either STRING or SPECS. */
@ -499,7 +504,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
varies[i] = 0;
}
GCPRO4 (prefix_arg, function, *args, *visargs);
GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
gcpro3.nvars = (count + 1);
gcpro4.nvars = (count + 1);
@ -628,7 +633,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
/* Ignore first element, which is the base key. */
tem2 = Fmemq (intern ("down"), Fcdr (teml));
if (! NILP (tem2))
Fread_event (Qnil, Qnil);
up_event = Fread_event (Qnil, Qnil);
}
}
break;
@ -656,11 +661,21 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
/* Ignore first element, which is the base key. */
tem2 = Fmemq (intern ("down"), Fcdr (teml));
if (! NILP (tem2))
Fread_event (Qnil, Qnil);
up_event = Fread_event (Qnil, Qnil);
}
}
break;
case 'U': /* Up event from last k or K */
if (!NILP (up_event))
{
args[i] = Fmake_vector (make_number (1), up_event);
up_event = Qnil;
teml = args[i];
visargs[i] = Fkey_description (teml, Qnil);
}
break;
case 'e': /* The invoking event. */
if (next_event >= key_count)
error ("%s must be bound to an event with parameters",

2
src/casefiddle.c
View file

@ -137,7 +137,7 @@ casify_object (flag, obj)
}
obj = make_multibyte_string (buf, SCHARS (obj),
j_byte);
SAFE_FREE (bufsize);
SAFE_FREE ();
}
return obj;
}

2
src/charset.c
View file

@ -1673,7 +1673,7 @@ usage: (string &rest CHARACTERS) */)
}
ret = make_string_from_bytes (buf, n, p - buf);
SAFE_FREE (bufsize);
SAFE_FREE ();
return ret;
}

4
src/data.c
View file

@ -2165,7 +2165,7 @@ bool-vector. IDX starts at 0. */)
p1 = SDATA (array) + idxval_byte;
bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
nbytes - (idxval_byte + prev_bytes));
SAFE_FREE (nbytes);
SAFE_FREE ();
clear_string_char_byte_cache ();
}
while (new_bytes--)
@ -2206,7 +2206,7 @@ bool-vector. IDX starts at 0. */)
*p1++ = *p0++;
bcopy (str + idxval_byte + prev_bytes, p1,
nbytes - (idxval_byte + prev_bytes));
SAFE_FREE (nbytes);
SAFE_FREE ();
clear_string_char_byte_cache ();
}
}

29
src/editfns.c
View file

@ -2775,7 +2775,7 @@ It returns the number of characters changed. */)
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
end_pos = XINT (end);
end_pos = XINT (end);
modify_region (current_buffer, pos, XINT (end));
cnt = 0;
@ -3049,11 +3049,14 @@ static int message_length;
DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
doc: /* Print a one-line message at the bottom of the screen.
The message also goes into the `*Messages*' buffer.
\(In keyboard macros, that's all it does.)
The first argument is a format control string, and the rest are data
to be formatted under control of the string. See `format' for details.
If the first argument is nil, clear any existing message; let the
minibuffer contents show.
If the first argument is nil, the function clears any existing message;
this lets the minibuffer contents show. See also `current-message'.
usage: (message STRING &rest ARGS) */)
(nargs, args)
@ -3268,7 +3271,7 @@ usage: (format STRING &rest OBJECTS) */)
/* discarded[I] is 1 if byte I of the format
string was not copied into the output.
It is 2 if byte I was not the first byte of its character. */
char *discarded;
char *discarded = 0;
/* Each element records, for one argument,
the start and end bytepos in the output string,
@ -3319,11 +3322,13 @@ usage: (format STRING &rest OBJECTS) */)
{
int nbytes = (nargs+1) * sizeof *info;
int i;
info = (struct info *) alloca (nbytes);
if (!info)
info = (struct info *) alloca (nbytes);
bzero (info, nbytes);
for (i = 0; i <= nargs; i++)
info[i].start = -1;
discarded = (char *) alloca (SBYTES (args[0]));
if (!discarded)
SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
bzero (discarded, SBYTES (args[0]));
}
@ -3684,7 +3689,7 @@ usage: (format STRING &rest OBJECTS) */)
val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If we allocated BUF with malloc, free it too. */
SAFE_FREE (total);
SAFE_FREE ();
/* If the format string has text properties, or any of the string
arguments has text properties, set up text properties of the
@ -4056,7 +4061,7 @@ Transposing beyond buffer boundaries is an error. */)
bcopy (start2_addr, temp, len2_byte);
bcopy (start1_addr, start1_addr + len2_byte, len1_byte);
bcopy (temp, start1_addr, len2_byte);
SAFE_FREE (len2_byte);
SAFE_FREE ();
}
else
/* First region not smaller than second. */
@ -4069,7 +4074,7 @@ Transposing beyond buffer boundaries is an error. */)
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start1_addr + len2_byte, len1_byte);
SAFE_FREE (len1_byte);
SAFE_FREE ();
}
graft_intervals_into_buffer (tmp_interval1, start1 + len2,
len1, current_buffer, 0);
@ -4105,7 +4110,7 @@ Transposing beyond buffer boundaries is an error. */)
bcopy (start1_addr, temp, len1_byte);
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (temp, start2_addr, len1_byte);
SAFE_FREE (len1_byte);
SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, start2,
len1, current_buffer, 0);
@ -4134,7 +4139,7 @@ Transposing beyond buffer boundaries is an error. */)
bcopy (start1_addr, start1_addr + len_mid + len2_byte, len1_byte);
safe_bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
bcopy (temp, start1_addr, len2_byte);
SAFE_FREE (len2_byte);
SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 0);
@ -4165,7 +4170,7 @@ Transposing beyond buffer boundaries is an error. */)
bcopy (start2_addr, start1_addr, len2_byte);
bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
bcopy (temp, start1_addr + len2_byte + len_mid, len1_byte);
SAFE_FREE (len1_byte);
SAFE_FREE ();
graft_intervals_into_buffer (tmp_interval1, end2 - len1,
len1, current_buffer, 0);

24
src/fns.c
View file

@ -1012,7 +1012,7 @@ string_make_multibyte (string)
0, 1);
ret = make_multibyte_string (buf, SCHARS (string), nbytes);
SAFE_FREE (nbytes);
SAFE_FREE ();
return ret;
}
@ -1046,7 +1046,7 @@ string_to_multibyte (string)
str_to_multibyte (buf, nbytes, SBYTES (string));
ret = make_multibyte_string (buf, SCHARS (string), nbytes);
SAFE_FREE (nbytes);
SAFE_FREE ();
return ret;
}
@ -1073,7 +1073,7 @@ string_make_unibyte (string)
1, 0);
ret = make_unibyte_string (buf, nchars);
SAFE_FREE (nchars);
SAFE_FREE ();
return ret;
}
@ -3030,7 +3030,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
args[i] = separator;
ret = Fconcat (nargs, args);
SAFE_FREE_LISP (nargs);
SAFE_FREE ();
return ret;
}
@ -3056,7 +3056,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
mapcar1 (leni, args, function, sequence);
ret = Flist (leni, args);
SAFE_FREE_LISP (leni);
SAFE_FREE ();
return ret;
}
@ -3763,7 +3763,7 @@ into shorter lines. */)
if (encoded_length < 0)
{
/* The encoding wasn't possible. */
SAFE_FREE (allength);
SAFE_FREE ();
error ("Multibyte character in data for base64 encoding");
}
@ -3771,7 +3771,7 @@ into shorter lines. */)
and delete the old. (Insert first in order to preserve markers.) */
SET_PT_BOTH (XFASTINT (beg), ibeg);
insert (encoded, encoded_length);
SAFE_FREE (allength);
SAFE_FREE ();
del_range_byte (ibeg + encoded_length, iend + encoded_length, 1);
/* If point was outside of the region, restore it exactly; else just
@ -3820,12 +3820,12 @@ into shorter lines. */)
if (encoded_length < 0)
{
/* The encoding wasn't possible. */
SAFE_FREE (allength);
SAFE_FREE ();
error ("Multibyte character in data for base64 encoding");
}
encoded_string = make_unibyte_string (encoded, encoded_length);
SAFE_FREE (allength);
SAFE_FREE ();
return encoded_string;
}
@ -3962,7 +3962,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
if (decoded_length < 0)
{
/* The decoding wasn't possible. */
SAFE_FREE (allength);
SAFE_FREE ();
error ("Invalid base64 data");
}
@ -3970,7 +3970,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
and delete the old. (Insert first in order to preserve markers.) */
TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
SAFE_FREE (allength);
SAFE_FREE ();
/* Delete the original text. */
del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
@ -4014,7 +4014,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
else
decoded_string = Qnil;
SAFE_FREE (length);
SAFE_FREE ();
if (!STRINGP (decoded_string))
error ("Invalid base64 data");

105
src/gtkutil.c
View file

@ -48,6 +48,7 @@ Boston, MA 02111-1307, USA. */
#ifdef HAVE_GTK_MULTIDISPLAY
/* Return the GdkDisplay that corresponds to the X display DPY. */
static GdkDisplay *
xg_get_gdk_display (dpy)
Display *dpy;
@ -58,6 +59,7 @@ xg_get_gdk_display (dpy)
/* When the GTK widget W is to be created on a display for F that
is not the default display, set the display for W.
W can be a GtkMenu or a GtkWindow widget. */
static void
xg_set_screen (w, f)
GtkWidget *w;
@ -80,6 +82,7 @@ xg_set_screen (w, f)
/* Make some defines so we can use the GTK 2.2 functions when
compiling with GTK 2.0. */
#define xg_set_screen(w, f)
#define gdk_xid_table_lookup_for_display(dpy, w) gdk_xid_table_lookup (w)
#define gdk_pixmap_foreign_new_for_display(dpy, p) gdk_pixmap_foreign_new (p)
@ -95,6 +98,7 @@ xg_set_screen (w, f)
Returns non-zero if display could be opened, zero if display could not
be opened, and less than zero if the GTK version doesn't support
multipe displays. */
int
xg_display_open (display_name, dpy)
char *display_name;
@ -115,6 +119,8 @@ xg_display_open (display_name, dpy)
}
/* Close display DPY. */
void
xg_display_close (Display *dpy)
{
@ -176,6 +182,7 @@ static int malloc_cpt;
widget_value_free_list or by malloc:ing a new one.
Return a pointer to the allocated structure. */
widget_value *
malloc_widget_value ()
{
@ -197,6 +204,7 @@ malloc_widget_value ()
/* This is analogous to free. It frees only what was allocated
by malloc_widget_value, and no substructures. */
void
free_widget_value (wv)
widget_value *wv;
@ -221,6 +229,7 @@ free_widget_value (wv)
/* Create and return the cursor to be used for popup menus and
scroll bars on display DPY. */
GdkCursor *
xg_create_default_cursor (dpy)
Display *dpy;
@ -239,6 +248,7 @@ xg_create_default_cursor (dpy)
WIDGET is used to find the GdkColormap to use for the GdkPixbuf.
If OLD_WIDGET is NULL, a new widget is constructed and returned.
If OLD_WIDGET is not NULL, that widget is modified. */
static GtkWidget *
xg_get_image_for_pixmap (f, img, widget, old_widget)
FRAME_PTR f;
@ -373,6 +383,7 @@ xg_get_image_for_pixmap (f, img, widget, old_widget)
/* Set CURSOR on W and all widgets W contain. We must do like this
for scroll bars and menu because they create widgets internally,
and it is those widgets that are visible. */
static void
xg_set_cursor (w, cursor)
GtkWidget *w;
@ -400,6 +411,7 @@ xg_set_cursor (w, cursor)
has expired by calling the GTK event loop.
Also, when a menu is active, it has a small timeout before it
pops down the sub menu under it. */
static void
xg_process_timeouts (timer)
struct atimer *timer;
@ -415,6 +427,7 @@ xg_process_timeouts (timer)
/* Start the xg_timer with an interval of 0.1 seconds, if not already started.
xg_process_timeouts is called when the timer expires. The timer
started is continuous, i.e. runs until xg_stop_timer is called. */
static void
xg_start_timer ()
{
@ -430,6 +443,7 @@ xg_start_timer ()
}
/* Stop the xg_timer if started. */
static void
xg_stop_timer ()
{
@ -441,6 +455,7 @@ xg_stop_timer ()
}
/* Insert NODE into linked LIST. */
static void
xg_list_insert (xg_list_node *list, xg_list_node *node)
{
@ -453,6 +468,7 @@ xg_list_insert (xg_list_node *list, xg_list_node *node)
}
/* Remove NODE from linked LIST. */
static void
xg_list_remove (xg_list_node *list, xg_list_node *node)
{
@ -473,6 +489,7 @@ xg_list_remove (xg_list_node *list, xg_list_node *node)
utf8 or NULL, just return STR.
If not, a new string is allocated and the caller must free the result
with g_free. */
static char *
get_utf8_string (str)
char *str;
@ -496,6 +513,7 @@ get_utf8_string (str)
only way to get geometry position right if the user explicitly
asked for a position when starting Emacs.
F is the frame we shall set geometry for. */
static void
xg_set_geometry (f)
FRAME_PTR f;
@ -529,6 +547,7 @@ xg_set_geometry (f)
/* Resize the outer window of frame F after chainging the height.
This happend when the menu bar or the tool bar is added or removed.
COLUMNS/ROWS is the size the edit area shall have after the resize. */
static void
xg_resize_outer_widget (f, columns, rows)
FRAME_PTR f;
@ -555,6 +574,7 @@ xg_resize_outer_widget (f, columns, rows)
manually.
F is the frame to resize.
PIXELWIDTH, PIXELHEIGHT is the new size in pixels. */
void
xg_resize_widgets (f, pixelwidth, pixelheight)
FRAME_PTR f;
@ -591,6 +611,7 @@ xg_resize_widgets (f, pixelwidth, pixelheight)
/* Update our widget size to be COLS/ROWS characters for frame F. */
void
xg_frame_set_char_size (f, cols, rows)
FRAME_PTR f;
@ -630,6 +651,7 @@ xg_frame_set_char_size (f, cols, rows)
X Window that aren't accessible.
Return 0 if no widget match WDESC. */
GtkWidget *
xg_win_to_widget (dpy, wdesc)
Display *dpy;
@ -655,6 +677,7 @@ xg_win_to_widget (dpy, wdesc)
/* Fill in the GdkColor C so that it represents PIXEL.
W is the widget that color will be used for. Used to find colormap. */
static void
xg_pix_to_gcolor (w, pixel, c)
GtkWidget *w;
@ -667,6 +690,7 @@ xg_pix_to_gcolor (w, pixel, c)
/* Create and set up the GTK widgets for frame F.
Return 0 if creation failed, non-zero otherwise. */
int
xg_create_frame_widgets (f)
FRAME_PTR f;
@ -802,6 +826,7 @@ xg_create_frame_widgets (f)
that the window now has.
If USER_POSITION is nonzero, we set the User Position
flag (this is useful when FLAGS is 0). */
void
x_wm_set_size_hint (f, flags, user_position)
FRAME_PTR f;
@ -900,6 +925,7 @@ x_wm_set_size_hint (f, flags, user_position)
keep the GTK and X colors in sync.
F is the frame to change,
BG is the pixel value to change to. */
void
xg_set_background_color (f, bg)
FRAME_PTR f;
@ -923,6 +949,7 @@ xg_set_background_color (f, bg)
***********************************************************************/
/* Return the dialog title to use for a dialog of type KEY.
This is the encoding used by lwlib. We use the same for GTK. */
static char *
get_dialog_title (char key)
{
@ -963,6 +990,7 @@ get_dialog_title (char key)
user_data is NULL (not used).
Returns TRUE to end propagation of event. */
static gboolean
dialog_delete_callback (w, event, user_data)
GtkWidget *w;
@ -979,6 +1007,7 @@ dialog_delete_callback (w, event, user_data)
DEACTIVATE_CB is the callback to use when the dialog pops down.
Returns the GTK dialog widget. */
static GtkWidget *
create_dialog (wv, select_cb, deactivate_cb)
widget_value *wv;
@ -1101,6 +1130,7 @@ enum
a file dialog.
W is the file dialog widget,
ARG points to an integer where we record what has happend. */
static void
xg_file_sel_ok (w, arg)
GtkWidget *w;
@ -1113,6 +1143,7 @@ xg_file_sel_ok (w, arg)
a file dialog.
W is the file dialog widget,
ARG points to an integer where we record what has happend. */
static void
xg_file_sel_cancel (w, arg)
GtkWidget *w;
@ -1127,6 +1158,7 @@ xg_file_sel_cancel (w, arg)
the dialog is popped down, but the dialog widget is not destroyed.
W is the file dialog widget,
ARG points to an integer where we record what has happend. */
static void
xg_file_sel_destroy (w, arg)
GtkWidget *w;
@ -1144,6 +1176,7 @@ xg_file_sel_destroy (w, arg)
Returns a file name or NULL if no file was selected.
The returned string must be freed by the caller. */
char *
xg_get_file_name (f, prompt, default_filename, mustmatch_p)
FRAME_PTR f;
@ -1234,6 +1267,7 @@ static xg_list_node xg_menu_item_cb_list;
Returns CL_DATA if CL_DATA is not NULL, or a pointer to a newly
allocated xg_menu_cb_data if CL_DATA is NULL. */
static xg_menu_cb_data *
make_cl_data (cl_data, f, highlight_cb)
xg_menu_cb_data *cl_data;
@ -1267,6 +1301,7 @@ make_cl_data (cl_data, f, highlight_cb)
HIGHLIGHT_CB could change, there is no check that the same
function is given when modifying a menu bar as was given when
creating the menu bar. */
static void
update_cl_data (cl_data, f, highlight_cb)
xg_menu_cb_data *cl_data;
@ -1284,6 +1319,7 @@ update_cl_data (cl_data, f, highlight_cb)
/* Decrease reference count for CL_DATA.
If reference count is zero, free CL_DATA. */
static void
unref_cl_data (cl_data)
xg_menu_cb_data *cl_data;
@ -1300,6 +1336,7 @@ unref_cl_data (cl_data)
}
/* Function that marks all lisp data during GC. */
void
xg_mark_data ()
{
@ -1321,6 +1358,7 @@ xg_mark_data ()
/* Callback called when a menu item is destroyed. Used to free data.
W is the widget that is being destroyed (not used).
CLIENT_DATA points to the xg_menu_item_cb_data associated with the W. */
static void
menuitem_destroy_callback (w, client_data)
GtkWidget *w;
@ -1340,6 +1378,7 @@ menuitem_destroy_callback (w, client_data)
CLIENT_DATA points to the xg_menu_item_cb_data associated with the W.
Returns FALSE to tell GTK to keep processing this event. */
static gboolean
menuitem_highlight_callback (w, event, client_data)
GtkWidget *w;
@ -1364,6 +1403,7 @@ menuitem_highlight_callback (w, event, client_data)
/* Callback called when a menu is destroyed. Used to free data.
W is the widget that is being destroyed (not used).
CLIENT_DATA points to the xg_menu_cb_data associated with W. */
static void
menu_destroy_callback (w, client_data)
GtkWidget *w;
@ -1379,6 +1419,7 @@ menu_destroy_callback (w, client_data)
W is the widget that does the grab (not used).
UNGRAB_P is TRUE if this is an ungrab, FALSE if it is a grab.
CLIENT_DATA is NULL (not used). */
static void
menu_grab_callback (GtkWidget *widget,
gboolean ungrab_p,
@ -1398,6 +1439,7 @@ menu_grab_callback (GtkWidget *widget,
must be non-NULL) and can be inserted into a menu item.
Returns the GtkHBox. */
static GtkWidget *
make_widget_for_menu_item (utf8_label, utf8_key)
char *utf8_label;
@ -1437,6 +1479,7 @@ make_widget_for_menu_item (utf8_label, utf8_key)
Unfortunately, keys don't line up as nicely as in Motif,
but the MacOS X version doesn't either, so I guess that is OK. */
static GtkWidget *
make_menu_item (utf8_label, utf8_key, item, group)
char *utf8_label;
@ -1486,6 +1529,7 @@ make_menu_item (utf8_label, utf8_key, item, group)
/* Return non-zero if LABEL specifies a separator (GTK only has one
separator type) */
static int
xg_separator_p (char *label)
{
@ -1534,6 +1578,7 @@ xg_separator_p (char *label)
static int xg_detached_menus;
/* Returns non-zero if there are detached menus. */
int
xg_have_tear_offs ()
{
@ -1544,6 +1589,7 @@ xg_have_tear_offs ()
decrease the xg_detached_menus count.
WIDGET is the top level window that is removed (the parent of the menu).
CLIENT_DATA is not used. */
static void
tearoff_remove (widget, client_data)
GtkWidget *widget;
@ -1556,6 +1602,7 @@ tearoff_remove (widget, client_data)
xg_detached_menus count.
WIDGET is the GtkTearoffMenuItem.
CLIENT_DATA is not used. */
static void
tearoff_activate (widget, client_data)
GtkWidget *widget;
@ -1585,6 +1632,7 @@ tearoff_activate (widget, client_data)
in the group. On exit, *GROUP contains the radio item group.
Returns the created GtkWidget. */
static GtkWidget *
xg_create_one_menuitem (item, f, select_cb, highlight_cb, cl_data, group)
widget_value *item;
@ -1802,6 +1850,7 @@ create_menus (data, f, select_cb, deactivate_cb, highlight_cb,
HIGHLIGHT_CB is the callback to call when entering/leaving menu items.
Returns the widget created. */
GtkWidget *
xg_create_widget (type, name, f, val,
select_cb, deactivate_cb, highlight_cb)
@ -1859,6 +1908,7 @@ xg_create_widget (type, name, f, val,
}
/* Return the label for menu item WITEM. */
static const char *
xg_get_menu_item_label (witem)
GtkMenuItem *witem;
@ -1868,6 +1918,7 @@ xg_get_menu_item_label (witem)
}
/* Return non-zero if the menu item WITEM has the text LABEL. */
static int
xg_item_label_same_p (witem, label)
GtkMenuItem *witem;
@ -1887,10 +1938,10 @@ xg_item_label_same_p (witem, label)
return is_same;
}
/* Remove widgets in LIST from container WCONT. */
/* Destroy widgets in LIST. */
static void
remove_from_container (wcont, list)
GtkWidget *wcont;
xg_destroy_widgets (list)
GList *list;
{
GList *iter;
@ -1899,15 +1950,7 @@ remove_from_container (wcont, list)
{
GtkWidget *w = GTK_WIDGET (iter->data);
/* Add a ref to w so we can explicitly destroy it later. */
gtk_widget_ref (w);
gtk_container_remove (GTK_CONTAINER (wcont), w);
/* If there is a menu under this widget that has been detached,
there is a reference to it, and just removing w from the
container does not destroy the submenu. By explicitly
destroying w we make sure the submenu is destroyed, thus
removing the detached window also if there was one. */
/* Destroying the widget will remove it from the container it is in. */
gtk_widget_destroy (w);
}
}
@ -1923,6 +1966,7 @@ remove_from_container (wcont, list)
CL_DATA points to the callback data to be used for this menu bar.
This function calls itself to walk through the menu bar names. */
static void
xg_update_menubar (menubar, f, list, iter, pos, val,
select_cb, highlight_cb, cl_data)
@ -1941,7 +1985,7 @@ xg_update_menubar (menubar, f, list, iter, pos, val,
else if (iter && ! val)
{
/* Item(s) have been removed. Remove all remaining items. */
remove_from_container (menubar, iter);
xg_destroy_widgets (iter);
/* All updated. */
val = 0;
@ -2095,6 +2139,7 @@ xg_update_menubar (menubar, f, list, iter, pos, val,
SELECT_CB is the callback to use when a menu item is selected.
HIGHLIGHT_CB is the callback to call when entering/leaving menu items.
CL_DATA is the data to set in the widget for menu invokation. */
static void
xg_update_menu_item (val, w, select_cb, highlight_cb, cl_data)
widget_value *val;
@ -2229,6 +2274,7 @@ xg_update_menu_item (val, w, select_cb, highlight_cb, cl_data)
}
/* Update the toggle menu item W so it corresponds to VAL. */
static void
xg_update_toggle_item (val, w)
widget_value *val;
@ -2238,6 +2284,7 @@ xg_update_toggle_item (val, w)
}
/* Update the radio menu item W so it corresponds to VAL. */
static void
xg_update_radio_item (val, w)
widget_value *val;
@ -2367,8 +2414,8 @@ xg_update_submenu (submenu, f, val,
{
/* If we are adding new menu items below, we must remove from
first radio button so that radio groups become correct. */
if (cur && first_radio) remove_from_container (submenu, first_radio);
else remove_from_container (submenu, iter);
if (cur && first_radio) xg_destroy_widgets (first_radio);
else xg_destroy_widgets (iter);
}
if (cur)
@ -2400,6 +2447,7 @@ xg_update_submenu (submenu, f, val,
SELECT_CB is the callback to use when a menu item is selected.
DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore.
HIGHLIGHT_CB is the callback to call when entering/leaving menu items. */
void
xg_modify_menubar_widgets (menubar, f, val, deep_p,
select_cb, deactivate_cb, highlight_cb)
@ -2544,12 +2592,14 @@ free_frame_menubar (f)
/* Setting scroll bar values invokes the callback. Use this variable
to indicate that callback should do nothing. */
int xg_ignore_gtk_scrollbar;
/* SET_SCROLL_BAR_X_WINDOW assumes the second argument fits in
32 bits. But we want to store pointers, and they may be larger
than 32 bits. Keep a mapping from integer index to widget pointers
to get around the 32 bit limitation. */
static struct
{
GtkWidget **widgets;
@ -2558,9 +2608,11 @@ static struct
} id_to_widget;
/* Grow this much every time we need to allocate more */
#define ID_TO_WIDGET_INCR 32
/* Store the widget pointer W in id_to_widget and return the integer index. */
static int
xg_store_widget_in_map (w)
GtkWidget *w;
@ -2599,6 +2651,7 @@ xg_store_widget_in_map (w)
/* Remove pointer at IDX from id_to_widget.
Called when scroll bar is destroyed. */
static void
xg_remove_widget_from_map (idx)
int idx;
@ -2611,6 +2664,7 @@ xg_remove_widget_from_map (idx)
}
/* Get the widget pointer at IDX from id_to_widget. */
static GtkWidget *
xg_get_widget_from_map (idx)
int idx;
@ -2623,6 +2677,7 @@ xg_get_widget_from_map (idx)
/* Return the scrollbar id for X Window WID on display DPY.
Return -1 if WID not in id_to_widget. */
int
xg_get_scroll_id_for_window (dpy, wid)
Display *dpy;
@ -2646,6 +2701,7 @@ xg_get_scroll_id_for_window (dpy, wid)
/* Callback invoked when scroll bar WIDGET is destroyed.
DATA is the index into id_to_widget for WIDGET.
We free pointer to last scroll bar values here and remove the index. */
static void
xg_gtk_scroll_destroy (widget, data)
GtkWidget *widget;
@ -2668,6 +2724,7 @@ xg_gtk_scroll_destroy (widget, data)
Returns FALSE to tell GTK that it shall continue propagate the event
to widgets. */
static gboolean
scroll_bar_button_cb (widget, event, user_data)
GtkWidget *widget;
@ -2692,6 +2749,7 @@ scroll_bar_button_cb (widget, event, user_data)
bar changes.
SCROLL_BAR_NAME is the name we use for the scroll bar. Can be used
to set resources for the widget. */
void
xg_create_scroll_bar (f, bar, scroll_callback, scroll_bar_name)
FRAME_PTR f;
@ -2753,6 +2811,7 @@ xg_create_scroll_bar (f, bar, scroll_callback, scroll_bar_name)
}
/* Make the scroll bar represented by SCROLLBAR_ID visible. */
void
xg_show_scroll_bar (scrollbar_id)
int scrollbar_id;
@ -2763,6 +2822,7 @@ xg_show_scroll_bar (scrollbar_id)
}
/* Remove the scroll bar represented by SCROLLBAR_ID from the frame F. */
void
xg_remove_scroll_bar (f, scrollbar_id)
FRAME_PTR f;
@ -2782,6 +2842,7 @@ xg_remove_scroll_bar (f, scrollbar_id)
in frame F.
TOP/LEFT are the new pixel positions where the bar shall appear.
WIDTH, HEIGHT is the size in pixels the bar shall have. */
void
xg_update_scrollbar_pos (f, scrollbar_id, top, left, width, height)
FRAME_PTR f;
@ -2810,6 +2871,7 @@ xg_update_scrollbar_pos (f, scrollbar_id, top, left, width, height)
/* Set the thumb size and position of scroll bar BAR. We are currently
displaying PORTION out of a whole WHOLE, and our position POSITION. */
void
xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole)
struct scroll_bar *bar;
@ -2902,6 +2964,7 @@ xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole)
W is the button widget in the tool bar that got pressed,
CLIENT_DATA is an integer that is the index of the button in the
tool bar. 0 is the first button. */
static void
xg_tool_bar_callback (w, client_data)
GtkWidget *w;
@ -2938,6 +3001,7 @@ xg_tool_bar_callback (w, client_data)
WBOX is the handle box widget that enables detach/attach of the tool bar.
W is the tool bar widget.
CLIENT_DATA is a pointer to the frame the tool bar belongs to. */
static void
xg_tool_bar_detach_callback (wbox, w, client_data)
GtkHandleBox *wbox;
@ -2966,6 +3030,7 @@ xg_tool_bar_detach_callback (wbox, w, client_data)
WBOX is the handle box widget that enables detach/attach of the tool bar.
W is the tool bar widget.
CLIENT_DATA is a pointer to the frame the tool bar belongs to. */
static void
xg_tool_bar_attach_callback (wbox, w, client_data)
GtkHandleBox *wbox;
@ -2995,6 +3060,7 @@ xg_tool_bar_attach_callback (wbox, w, client_data)
tool bar. 0 is the first button.
Returns FALSE to tell GTK to keep processing this event. */
static gboolean
xg_tool_bar_help_callback (w, event, client_data)
GtkWidget *w;
@ -3040,6 +3106,7 @@ xg_tool_bar_help_callback (w, event, client_data)
CLIENT_DATA is unused.
Returns FALSE to tell GTK to keep processing this event. */
static gboolean
xg_tool_bar_item_expose_callback (w, event, client_data)
GtkWidget *w;
@ -3070,6 +3137,7 @@ xg_tool_bar_item_expose_callback (w, event, client_data)
CLIENT_DATA is pointing to the frame for this tool bar.
Returns FALSE to tell GTK to keep processing this event. */
static gboolean
xg_tool_bar_expose_callback (w, event, client_data)
GtkWidget *w;
@ -3080,6 +3148,8 @@ xg_tool_bar_expose_callback (w, event, client_data)
return FALSE;
}
/* Create a tool bar for frame F. */
static void
xg_create_tool_bar (f)
FRAME_PTR f;
@ -3133,6 +3203,8 @@ xg_create_tool_bar (f)
SET_FRAME_GARBAGED (f);
}
/* Update the tool bar for frame F. Add new buttons and remove old. */
void
update_frame_tool_bar (f)
FRAME_PTR f;
@ -3300,6 +3372,9 @@ update_frame_tool_bar (f)
UNBLOCK_INPUT;
}
/* Deallocate all resources for the tool bar on frame F.
Remove the tool bar. */
void
free_frame_tool_bar (f)
FRAME_PTR f;

53
src/indent.c
View file

@ -1885,7 +1885,7 @@ vmotion (from, vtarget, w)
struct position pos;
/* vpos is cumulative vertical position, changed as from is changed */
register int vpos = 0;
Lisp_Object prevline;
int prevline;
register int first;
int from_byte;
int lmargin = hscroll > 0 ? 1 - hscroll : 0;
@ -1919,23 +1919,21 @@ vmotion (from, vtarget, w)
{
Lisp_Object propval;
XSETFASTINT (prevline, find_next_newline_no_quit (from - 1, -1));
while (XFASTINT (prevline) > BEGV
prevline = find_next_newline_no_quit (from - 1, -1);
while (prevline > BEGV
&& ((selective > 0
&& indented_beyond_p (XFASTINT (prevline),
CHAR_TO_BYTE (XFASTINT (prevline)),
&& indented_beyond_p (prevline,
CHAR_TO_BYTE (prevline),
(double) selective)) /* iftc */
/* watch out for newlines with `invisible' property */
|| (propval = Fget_char_property (prevline,
/* Watch out for newlines with `invisible' property.
When moving upward, check the newline before. */
|| (propval = Fget_char_property (make_number (prevline - 1),
Qinvisible,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
XSETFASTINT (prevline,
find_next_newline_no_quit (XFASTINT (prevline) - 1,
-1));
pos = *compute_motion (XFASTINT (prevline), 0,
lmargin + (XFASTINT (prevline) == BEG
? start_hpos : 0),
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
lmargin + (prevline == BEG ? start_hpos : 0),
0,
from,
/* Don't care for VPOS... */
@ -1946,12 +1944,11 @@ vmotion (from, vtarget, w)
/* This compensates for start_hpos
so that a tab as first character
still occupies 8 columns. */
(XFASTINT (prevline) == BEG
? -start_hpos : 0),
(prevline == BEG ? -start_hpos : 0),
w);
vpos -= pos.vpos;
first = 0;
from = XFASTINT (prevline);
from = prevline;
}
/* If we made exactly the desired vertical distance,
@ -1979,21 +1976,21 @@ vmotion (from, vtarget, w)
{
Lisp_Object propval;
XSETFASTINT (prevline, find_next_newline_no_quit (from, -1));
while (XFASTINT (prevline) > BEGV
prevline = find_next_newline_no_quit (from, -1);
while (prevline > BEGV
&& ((selective > 0
&& indented_beyond_p (XFASTINT (prevline),
CHAR_TO_BYTE (XFASTINT (prevline)),
&& indented_beyond_p (prevline,
CHAR_TO_BYTE (prevline),
(double) selective)) /* iftc */
/* watch out for newlines with `invisible' property */
|| (propval = Fget_char_property (prevline, Qinvisible,
/* Watch out for newlines with `invisible' property.
When moving downward, check the newline after. */
|| (propval = Fget_char_property (make_number (prevline),
Qinvisible,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
XSETFASTINT (prevline,
find_next_newline_no_quit (XFASTINT (prevline) - 1,
-1));
pos = *compute_motion (XFASTINT (prevline), 0,
lmargin + (XFASTINT (prevline) == BEG
prevline = find_next_newline_no_quit (prevline - 1, -1);
pos = *compute_motion (prevline, 0,
lmargin + (prevline == BEG
? start_hpos : 0),
0,
from,
@ -2002,7 +1999,7 @@ vmotion (from, vtarget, w)
/* ... nor HPOS. */
1 << (BITS_PER_SHORT - 1),
-1, hscroll,
(XFASTINT (prevline) == BEG ? -start_hpos : 0),
(prevline == BEG ? -start_hpos : 0),
w);
did_motion = 1;
}

17
src/lisp.h
View file

@ -3265,7 +3265,7 @@ extern Lisp_Object Vdirectory_sep_char;
extern Lisp_Object safe_alloca_unwind (Lisp_Object);
#define USE_SAFE_ALLOCA \
int sa_count = SPECPDL_INDEX ()
int sa_count = SPECPDL_INDEX (), sa_must_free = 0
/* SAFE_ALLOCA allocates a simple buffer. */
@ -3276,6 +3276,7 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
else \
{ \
buf = (type) xmalloc (size); \
sa_must_free++; \
record_unwind_protect (safe_alloca_unwind, \
make_save_value (buf, 0)); \
} \
@ -3283,10 +3284,12 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
/* SAFE_FREE frees xmalloced memory and enables GC as needed. */
#define SAFE_FREE(size) \
#define SAFE_FREE() \
do { \
if ((size) >= MAX_ALLOCA) \
if (sa_must_free) { \
sa_must_free = 0; \
unbind_to (sa_count, Qnil); \
} \
} while (0)
@ -3303,17 +3306,11 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object);
buf = (Lisp_Object *) xmalloc (size_); \
arg_ = make_save_value (buf, nelt); \
XSAVE_VALUE (arg_)->dogc = 1; \
sa_must_free++; \
record_unwind_protect (safe_alloca_unwind, arg_); \
} \
} while (0)
#define SAFE_FREE_LISP(nelt) \
do { \
if (((nelt) * sizeof (Lisp_Object)) >= MAX_ALLOCA) \
unbind_to (sa_count, Qnil); \
} while (0)
#endif /* EMACS_LISP_H */

40
src/macterm.c
View file

@ -228,6 +228,10 @@ extern int errno;
extern int extra_keyboard_modifiers;
/* The keysyms to use for the various modifiers. */
static Lisp_Object Qalt, Qhyper, Qsuper, Qmodifier_value;
static Lisp_Object Qvendor_specific_keysyms;
#if 0
@ -6988,6 +6992,9 @@ Lisp_Object Qreverse;
/* True if using command key as meta key. */
Lisp_Object Vmac_command_key_is_meta;
/* Modifier associated with the option key, or nil for normal behavior. */
Lisp_Object Vmac_option_modifier;
/* True if the ctrl and meta keys should be reversed. */
Lisp_Object Vmac_reverse_ctrl_meta;
@ -7069,6 +7076,12 @@ mac_to_emacs_modifiers (EventModifiers mods)
result |= meta_modifier;
if (NILP (Vmac_command_key_is_meta) && (mods & macAltKey))
result |= alt_modifier;
if (!NILP (Vmac_option_modifier) && (mods & optionKey)) {
Lisp_Object val = Fget(Vmac_option_modifier, Qmodifier_value);
if (!NILP(val))
result |= XUINT(val);
}
return result;
}
@ -8549,7 +8562,18 @@ XTread_socket (sd, expected, hold_quit)
unsigned long some_state = 0;
inev.code = KeyTranslate (kchr_ptr, new_keycode,
&some_state) & 0xff;
}
} else if (!NILP(Vmac_option_modifier) && (er.modifiers & optionKey))
{
/* When using the option key as an emacs modifier, convert
the pressed key code back to one without the Mac option
modifier applied. */
int new_modifiers = er.modifiers & ~optionKey;
int new_keycode = keycode | new_modifiers;
Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache);
unsigned long some_state = 0;
inev.code = KeyTranslate (kchr_ptr, new_keycode,
&some_state) & 0xff;
}
else
inev.code = er.message & charCodeMask;
inev.kind = ASCII_KEYSTROKE_EVENT;
@ -9249,6 +9273,14 @@ syms_of_macterm ()
x_error_message_string = Qnil;
#endif
Qmodifier_value = intern ("modifier-value");
Qalt = intern ("alt");
Fput (Qalt, Qmodifier_value, make_number (alt_modifier));
Qhyper = intern ("hyper");
Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier));
Qsuper = intern ("super");
Fput (Qsuper, Qmodifier_value, make_number (super_modifier));
Fprovide (intern ("mac-carbon"), Qnil);
staticpro (&Qreverse);
@ -9305,6 +9337,12 @@ to 4.1, set this to nil. */);
Otherwise the option key is used. */);
Vmac_command_key_is_meta = Qt;
DEFVAR_LISP ("mac-option-modifier", &Vmac_option_modifier,
doc: /* Modifier to use for the Mac alt/option key. The value can
be alt, hyper, or super for the respective modifier. If the value is
nil then the key will act as the normal Mac option modifier. */);
Vmac_option_modifier = Qnil;
DEFVAR_LISP ("mac-reverse-ctrl-meta", &Vmac_reverse_ctrl_meta,
doc: /* Non-nil means that the control and meta keys are reversed. This is
useful for non-standard keyboard layouts. */);

2
src/search.c
View file

@ -554,7 +554,7 @@ newline_cache_on_off (buf)
direction indicated by COUNT.
If we find COUNT instances, set *SHORTAGE to zero, and return the
position after the COUNTth match. Note that for reverse motion
position past the COUNTth match. Note that for reverse motion
this is not the same as the usual convention for Emacs motion commands.
If we don't find COUNT instances before reaching END, set *SHORTAGE

44
src/syntax.c
View file

@ -2799,12 +2799,23 @@ do { prev_from = from; \
INC_FROM;
code = prev_from_syntax & 0xff;
if (code == Scomment)
if (from < end
&& SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
&& (c1 = FETCH_CHAR (from_byte),
SYNTAX_COMSTART_SECOND (c1)))
/* Duplicate code to avoid a complex if-expression
which causes trouble for the SGI compiler. */
{
state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
1 : -1);
/* Record the comment style we have entered so that only
the comment-end sequence of the same style actually
terminates the comment section. */
state.comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
state.incomment = comnested ? 1 : -1;
state.comstr_start = prev_from;
INC_FROM;
code = Scomment;
}
else if (code == Scomment_fence)
{
@ -2816,24 +2827,13 @@ do { prev_from = from; \
state.comstr_start = prev_from;
code = Scomment;
}
else if (from < end)
if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax))
if (c1 = FETCH_CHAR (from_byte),
SYNTAX_COMSTART_SECOND (c1))
/* Duplicate code to avoid a complex if-expression
which causes trouble for the SGI compiler. */
{
/* Record the comment style we have entered so that only
the comment-end sequence of the same style actually
terminates the comment section. */
state.comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
state.incomment = comnested ? 1 : -1;
state.comstr_start = prev_from;
INC_FROM;
code = Scomment;
}
else if (code == Scomment)
{
state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax);
state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
1 : -1);
state.comstr_start = prev_from;
}
if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
continue;

4
src/w32fns.c
View file

@ -6398,7 +6398,7 @@ If omitted or nil, that stands for the selected frame's display. */)
}
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
doc: /* Returns the vendor ID string of the W32 system (Microsoft).
doc: /* Returns the "vendor ID" string of the W32 system (Microsoft).
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display. */)
@ -6411,7 +6411,7 @@ If omitted or nil, that stands for the selected frame's display. */)
DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
doc: /* Returns the version numbers of the server of DISPLAY.
The value is a list of three integers: the major and minor
version numbers, and the vendor-specific release
version numbers of the X Protocol in use, and the distributor-specific release
number. See also the function `x-server-vendor'.
The optional argument DISPLAY specifies which display to ask about.

4
src/xdisp.c
View file

@ -4890,6 +4890,8 @@ get_next_display_element (it)
translated to octal form. */
else if ((it->c < ' '
&& (it->area != TEXT_AREA
/* In mode line, treat \n, \t like other crl chars. */
|| (it->glyph_row && it->glyph_row->mode_line_p)
|| (it->c != '\n' && it->c != '\t')))
|| (it->multibyte_p
? ((it->c >= 127
@ -6364,7 +6366,7 @@ add_to_log (format, arg1, arg2)
bcopy (SDATA (msg), buffer, len);
message_dolog (buffer, len - 1, 1, 0);
SAFE_FREE (len);
SAFE_FREE ();
UNGCPRO;
}

7
src/xfns.c
View file

@ -1970,6 +1970,7 @@ xic_create_xfontset (f, base_fontname)
struct frame *cf = XFRAME (frame);
if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
&& FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
&& FRAME_XIC_BASE_FONTNAME (cf)
&& !strcmp (FRAME_XIC_BASE_FONTNAME (cf), base_fontname))
{
xfs = FRAME_XIC_FONTSET (cf);
@ -3513,7 +3514,9 @@ If omitted or nil, that stands for the selected frame's display. */)
}
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
doc: /* Returns the vendor ID string of the X server of display DISPLAY.
doc: /* Returns the "vendor ID" string of the X server of display DISPLAY.
\(Labelling every distributor as a "vendor" embodies the false assumption
that operating systems cannot be developed and distributed noncommercially.)
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display. */)
@ -3530,7 +3533,7 @@ If omitted or nil, that stands for the selected frame's display. */)
DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
doc: /* Returns the version numbers of the X server of display DISPLAY.
The value is a list of three integers: the major and minor
version numbers of the X Protocol in use, and the vendor-specific release
version numbers of the X Protocol in use, and the distributor-specific release
number. See also the function `x-server-vendor'.
The optional argument DISPLAY specifies which display to ask about.

20
src/xselect.c
View file

@ -108,8 +108,8 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#endif
static Lisp_Object Vx_lost_selection_hooks;
static Lisp_Object Vx_sent_selection_hooks;
static Lisp_Object Vx_lost_selection_functions;
static Lisp_Object Vx_sent_selection_functions;
/* Coding system for communicating with other X clients via cutbuffer,
selection, and clipboard. */
static Lisp_Object Vselection_coding_system;
@ -864,7 +864,7 @@ x_handle_selection_request (event)
/* Let random lisp code notice that the selection has been asked for. */
{
Lisp_Object rest;
rest = Vx_sent_selection_hooks;
rest = Vx_sent_selection_functions;
if (!EQ (rest, Qunbound))
for (; CONSP (rest); rest = Fcdr (rest))
call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
@ -947,7 +947,7 @@ x_handle_selection_clear (event)
{
Lisp_Object rest;
rest = Vx_lost_selection_hooks;
rest = Vx_lost_selection_functions;
if (!EQ (rest, Qunbound))
{
for (; CONSP (rest); rest = Fcdr (rest))
@ -980,7 +980,7 @@ x_clear_frame_selections (f)
/* Let random Lisp code notice that the selection has been stolen. */
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_hooks;
hooks = Vx_lost_selection_functions;
selection_symbol = Fcar (Fcar (Vselection_alist));
if (!EQ (hooks, Qunbound))
@ -1004,7 +1004,7 @@ x_clear_frame_selections (f)
/* Let random Lisp code notice that the selection has been stolen. */
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_hooks;
hooks = Vx_lost_selection_functions;
selection_symbol = Fcar (Fcar (XCDR (rest)));
if (!EQ (hooks, Qunbound))
@ -2731,15 +2731,15 @@ means that a side-effect was executed,
and there is no meaningful selection value. */);
Vselection_converter_alist = Qnil;
DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
doc: /* A list of functions to be called when Emacs loses an X selection.
\(This happens when some other X client makes its own selection
or when a Lisp program explicitly clears the selection.)
The functions are called with one argument, the selection type
\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
Vx_lost_selection_hooks = Qnil;
Vx_lost_selection_functions = Qnil;
DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
doc: /* A list of functions to be called when Emacs answers a selection request.
The functions are called with four arguments:
- the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
@ -2751,7 +2751,7 @@ including being asked for a selection that we no longer own, or being asked
to convert into a type that we don't know about or that is inappropriate.
This hook doesn't let you change the behavior of Emacs's selection replies,
it merely informs you that they have happened. */);
Vx_sent_selection_hooks = Qnil;
Vx_sent_selection_functions = Qnil;
DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
doc: /* Coding system for communicating with other X clients.

82
src/xsmfns.c
View file

@ -74,33 +74,35 @@ static int ice_fd = -1;
static int doing_interact = False;
/* The session manager object for the session manager connection */
/* The session manager object for the session manager connection. */
static SmcConn smc_conn;
/* The client session id for this session */
/* The client session id for this session. */
static char *client_id;
/* The full path name to the Emacs program */
/* The full path name to the Emacs program. */
static char *emacs_program;
/* The client session id for this session as a lisp object. */
/* The client session id for this session as a lisp object. */
Lisp_Object Vx_session_id;
/* The id we had the previous session. This is only available if we
have been started by the session manager with SMID_OPT. */
have been started by the session manager with SMID_OPT. */
Lisp_Object Vx_session_previous_id;
/* The option we tell the session manager to start Emacs with when
restarting Emacs. The client_id is appended. */
restarting Emacs. The client_id is appended. */
#define SMID_OPT "--smid="
/* The option to start Emacs without the splash screen when
restarting Emacs. */
restarting Emacs. */
#define NOSPLASH_OPT "--no-splash"
@ -108,6 +110,7 @@ Lisp_Object Vx_session_previous_id;
/* Handle any messages from the session manager. If no connection is
open to a session manager, just return 0.
Otherwise returns 1 if SAVE_SESSION_EVENT is stored in buffer BUFP. */
int
x_session_check_input (bufp)
struct input_event *bufp;
@ -126,7 +129,7 @@ x_session_check_input (bufp)
/* Reset this so wo can check kind after callbacks have been called by
IceProcessMessages. The smc_interact_CB sets the kind to
SAVE_SESSION_EVENT, but we don't know beforehand if that callback
will be called. */
will be called. */
emacs_event.kind = NO_EVENT;
if (select (ice_fd+1, &read_fds,
@ -143,7 +146,7 @@ x_session_check_input (bufp)
/* Check if smc_interact_CB was called and we shall generate a
SAVE_SESSION_EVENT. */
SAVE_SESSION_EVENT. */
if (emacs_event.kind == NO_EVENT)
return 0;
@ -151,7 +154,8 @@ x_session_check_input (bufp)
return 1;
}
/* Return non-zero if we have a connection to a session manager.*/
/* Return non-zero if we have a connection to a session manager. */
int
x_session_have_connection ()
{
@ -160,7 +164,8 @@ x_session_have_connection ()
/* This is called when the session manager says it is OK to interact with the
user. Here we set the kind to SAVE_SESSION_EVENT so an event is generated.
Then lisp code can interact with the user. */
Then lisp code can interact with the user. */
static void
smc_interact_CB (smcConn, clientData)
SmcConn smcConn;
@ -176,7 +181,8 @@ smc_interact_CB (smcConn, clientData)
are started in the correct directory.
If this is a shutdown and we can request to interact with the user,
we do so, because we don't know what the lisp code might do. */
we do so, because we don't know what the lisp code might do. */
static void
smc_save_yourself_CB (smcConn,
clientData,
@ -203,7 +209,7 @@ smc_save_yourself_CB (smcConn,
char cwd[MAXPATHLEN+1];
char *smid_opt;
/* How to start a new instance of Emacs */
/* How to start a new instance of Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = SmCloneCommand;
props[props_idx]->type = SmLISTofARRAY8;
@ -213,7 +219,7 @@ smc_save_yourself_CB (smcConn,
props[props_idx]->vals[0].value = emacs_program;
++props_idx;
/* The name of the program */
/* The name of the program. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = SmProgram;
props[props_idx]->type = SmARRAY8;
@ -223,11 +229,11 @@ smc_save_yourself_CB (smcConn,
props[props_idx]->vals[0].value = SDATA (Vinvocation_name);
++props_idx;
/* How to restart Emacs (i.e.: /path/to/emacs --smid=xxxx --no-splash). */
/* How to restart Emacs (i.e.: /path/to/emacs --smid=xxxx --no-splash). */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = SmRestartCommand;
props[props_idx]->type = SmLISTofARRAY8;
props[props_idx]->num_vals = 3; /* /path/to/emacs, --smid=xxx --no-splash */
props[props_idx]->num_vals = 3; /* /path/to/emacs, --smid=xxx --no-splash */
props[props_idx]->vals = &values[val_idx];
props[props_idx]->vals[0].length = strlen (emacs_program);
props[props_idx]->vals[0].value = emacs_program;
@ -244,7 +250,7 @@ smc_save_yourself_CB (smcConn,
val_idx += 3;
++props_idx;
/* User id */
/* User id. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->name = SmUserID;
props[props_idx]->type = SmARRAY8;
@ -254,7 +260,7 @@ smc_save_yourself_CB (smcConn,
props[props_idx]->vals[0].value = SDATA (Vuser_login_name);
++props_idx;
/* The current directory property, not mandatory */
/* The current directory property, not mandatory. */
#ifdef HAVE_GETCWD
if (getcwd (cwd, MAXPATHLEN+1) != 0)
#else
@ -276,18 +282,19 @@ smc_save_yourself_CB (smcConn,
xfree (smid_opt);
/* See if we maybe shall interact with the user. */
/* See if we maybe shall interact with the user. */
if (interactStyle != SmInteractStyleAny
|| ! shutdown
|| saveType == SmSaveLocal
|| ! SmcInteractRequest (smcConn, SmDialogNormal, smc_interact_CB, 0))
{
/* No interaction, we are done saving ourself. */
/* No interaction, we are done saving ourself. */
SmcSaveYourselfDone (smcConn, True);
}
}
/* According to the SM specification, this shall close the connection */
/* According to the SM specification, this shall close the connection. */
static void
smc_die_CB (smcConn, clientData)
SmcConn smcConn;
@ -301,7 +308,8 @@ smc_die_CB (smcConn, clientData)
According to the SM specification, we should not interact with the
user between smc_save_yourself_CB is called and until smc_save_complete_CB
is called. It seems like a lot of job to implement this and it doesn't
even seem necessary. */
even seem necessary. */
static void
smc_save_complete_CB (smcConn, clientData)
SmcConn smcConn;
@ -319,7 +327,8 @@ smc_shutdown_cancelled_CB (smcConn, clientData)
}
/* Error handlers for SM and ICE. We don't want to exit Emacs just
because there is some error in the session management. */
because there is some error in the session management. */
static void
smc_error_handler (smcConn,
swap,
@ -336,7 +345,7 @@ smc_error_handler (smcConn,
int severity;
SmPointer values;
{
/* Empty */
/* Empty */
}
static void
@ -355,7 +364,7 @@ ice_error_handler (iceConn,
int severity;
IcePointer values;
{
/* Empty */
/* Empty */
}
@ -363,12 +372,13 @@ static void
ice_io_error_handler (iceConn)
IceConn iceConn;
{
/* Connection probably gone. */
/* Connection probably gone. */
ice_fd = -1;
}
/* This is called when the ICE connection is created or closed. The SM library
uses ICE as it transport protocol. */
uses ICE as it transport protocol. */
static void
ice_conn_watch_CB (iceConn, clientData, opening, watchData)
IceConn iceConn;
@ -401,6 +411,7 @@ ice_conn_watch_CB (iceConn, clientData, opening, watchData)
}
/* Create the client leader window. */
static void
create_client_leader_window (dpyinfo, client_id)
struct x_display_info *dpyinfo;
@ -427,7 +438,8 @@ create_client_leader_window (dpyinfo, client_id)
dpyinfo->client_leader_window = w;
}
/* Try to open a connection to the session manager. */
/* Try to open a connection to the session manager. */
void
x_session_initialize (dpyinfo)
struct x_display_info *dpyinfo;
@ -439,17 +451,17 @@ x_session_initialize (dpyinfo)
int name_len = 0;
/* Check if we where started by the session manager. If so, we will
have a previous id. */
have a previous id. */
if (! EQ (Vx_session_previous_id, Qnil) && STRINGP (Vx_session_previous_id))
previous_id = SDATA (Vx_session_previous_id);
/* Construct the path to the Emacs program. */
/* Construct the path to the Emacs program. */
if (! EQ (Vinvocation_directory, Qnil))
name_len += strlen (SDATA (Vinvocation_directory));
name_len += strlen (SDATA (Vinvocation_name));
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
not very large */
emacs_program = xmalloc (name_len + 1);
emacs_program[0] = '\0';
@ -458,7 +470,7 @@ x_session_initialize (dpyinfo)
strcat (emacs_program, SDATA (Vinvocation_name));
/* The SM protocol says all callbacks are mandatory, so set up all
here and in the mask passed to SmcOpenConnection */
here and in the mask passed to SmcOpenConnection. */
callbacks.save_yourself.callback = smc_save_yourself_CB;
callbacks.save_yourself.client_data = 0;
callbacks.die.callback = smc_die_CB;
@ -468,17 +480,17 @@ x_session_initialize (dpyinfo)
callbacks.shutdown_cancelled.callback = smc_shutdown_cancelled_CB;
callbacks.shutdown_cancelled.client_data = 0;
/* Set error handlers. */
/* Set error handlers. */
SmcSetErrorHandler (smc_error_handler);
IceSetErrorHandler (ice_error_handler);
IceSetIOErrorHandler (ice_io_error_handler);
/* Install callback for when connection status changes. */
/* Install callback for when connection status changes. */
IceAddConnectionWatch (ice_conn_watch_CB, 0);
/* Open the connection to the session manager. A failure is not
critical, it usually means that no session manager is running.
The errorstring is here for debugging. */
The errorstring is here for debugging. */
smc_conn = SmcOpenConnection (NULL, NULL, 1, 0,
(SmcSaveYourselfProcMask|
SmcDieProcMask|