Mercurial > hg > xemacs-beta
changeset 86:364816949b59 r20-0b93
Import from CVS: tag r20-0b93
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:08:31 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:09:02 2007 +0200 @@ -1,4 +1,9 @@ -*- indented-text -*- +to 20.0 beta93 +-- tm-7.101 +-- w3-3.0.51 +-- Miscellaneous bug fixes + to 20.0 beta92 -- Miscellaneous bug fixes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/mrb.xpm Mon Aug 13 09:09:02 2007 +0200 @@ -0,0 +1,56 @@ +/* XPM */ +/*****************************************************************************/ +/** This pixmap is kindly offered by Ion Cionca - 1992 - **/ +/** Swiss Federal Institute of Technology **/ +/** Central Computing Service **/ +/*****************************************************************************/ +static char * image_name [] = { +/**/ +"64 38 8 1", +/**/ +" s mask c black", +". c gray70", +"X c gray85", +"o c gray50", +"O c #4000bf", +"+ c darkolivegreen", +"@ c white", +"# c black", +" ", +" OOO ", +" OOOOO ........................... ", +" OO OOO .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ", +" O OOO OOO .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXoo ", +" OOO OOO OOO .XX+++++++++++++++++++++++XXXXoo ", +" O OOO OOO OOO .XX++++++++++++++++++++++++XXXooo ", +" OOO OOO OOO OOO.XX++@@+@++@+@@@@++@+++++++XXXooo ", +" O OOO OOO OOO O OXX++++++++++++++++++++++++XXXoooo ", +" OOO OOO OOO OOO OOOX++@@@@+@@+@@@+++++++++++XXXoooo ", +" OOO O OOO OOO O OOOXO++++++++++++++++++++++++XXXooooo ", +" OOO OOO OOO OO OOO.OOO+@@@@@@@@@@+@@@@@++++++XXXooooo ", +" OOO OOO OOOOO OOO OOO++++++++++++++++++++++++XXXooooo ", +" OOO OOO OOO OOO OOO OOOXOOO@@+@@@@+@@++@@@++++++XXXooooo ", +" OOO OOO OOOOO OOO OOOXOOOOO++++++++++++++++++++XXXooooo ", +" OO OOO OOO OO OO OOO.OOO+OO++++++++++++++++++++XXXooooo ", +" OOOOO OOO OOO OOOOO OOO+OOO++++++++++++++++++++XXXooooo ", +" OOO OOO OOO OOO OOO OOOXOOO@@@+@+@@@+@++++++++++XXXooooo ", +" OOO OOO OOOOO OOOXOOO++++++++++++++++++++++XXXooooo ", +" OOO OOO OO OOO OOO.OOO+@+@@@@++++++++++++++++XXXooooo ", +" O OOO O OOO OOO O OOOX++++++++++++++++++++++XXXXoooo ", +" OOO OOO OOO OOO OOOXXXXXXXXXXXXXXXXXXXXXXXXXXXXooo ", +" O O OOO OOO OOO O.XXXXXXXXXXXXXXXXXXXXXXXXXXXooo ", +" OOO OOO OOO OOO ooooooooooooooooooooooooo...oo ", +" OOO OOO OOO O ..........................ooo ", +" OOO OOO OOO oooooooooooooooooooooooooooooo ", +" OOO OOO O oXXXXXXXXXXXXXXXXXXXXXXXXXXXoooo.. .. ", +" OOO OO oXXXXXXXXXXXXXXXXXX#######XXoooo . .", +" OOOOO oooooooooooooooooooooooooooXXXooo . ", +" OOO oXXXXXXXXXXXXXXXXXXXXXXXXXXooooo . ", +" oXXXXXXXXXXXXXXXXXXXXXXXXXXoo oooooo ", +" oXX@@@@@@@@@@@@@@@@@@@XXXXXoo ooooo...o ", +" oXXXXXXXXXXXXXXXXXXXXXXXXXXoo ooXXXoo..o ", +" oXX@@@@@@@@@@@@@@@@@@@@XXXXoo oXXXXX..o ", +" oXXXXXXXXXXXXXXXXXXXXXXXXXXoo o.....oo ", +" oooooooooooooooooooooooooooo ooooooo ", +" ", +" "};
--- a/lib-src/tm-au Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-au Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,23 @@ #!/bin/sh - # -# $Id: tm-au,v 1.4 1997/01/23 05:29:22 steve Exp $ +# $Id: tm-au,v 1.5 1997/01/30 02:22:29 steve Exp $ # +# Copyright 1994,1995,1996,1997 Free Software Foundation, Inc. + +# This program 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. +# +# This program 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. PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH @@ -22,15 +38,14 @@ echo "$2; $3 ->" tmdecode $3 $1 $filename if [ "$AUDIOSERVER" = "" ]; then - case "`uname`" in - IRIX ) sfplay $filename ;; - OSF1 ) decsound -play $filename ;; - * ) cat $filename > /dev/audio ;; - esac + if [ `uname` = "IRIX" ]; then + sfplay $filename + else + cat $filename > /dev/audio + fi else - autool -v 40 $filename + autool -v 40 $filename fi - trap 'rm -f $filename' 0 1 2 3 13 15 ;; "extract")
--- a/lib-src/tm-file Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-file Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,23 @@ #!/bin/sh - # -# $Id: tm-file,v 1.3 1997/01/11 20:13:51 steve Exp $ +# $Id: tm-file,v 1.4 1997/01/30 02:22:30 steve Exp $ # +# Copyright 1994,1995,1996,1997 Free Software Foundation, Inc. + +# This program 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. +# +# This program 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. PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH
--- a/lib-src/tm-html Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-html Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,23 @@ #!/bin/sh # -# $Id: tm-html,v 1.3 1997/01/11 20:13:51 steve Exp $ +# $Id: tm-html,v 1.4 1997/01/30 02:22:30 steve Exp $ # +# Copyright 1994,1995,1996,1997 Free Software Foundation, Inc. + +# This program 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. +# +# This program 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. PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH
--- a/lib-src/tm-image Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-image Mon Aug 13 09:09:02 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-image,v 1.3 1997/01/11 20:13:51 steve Exp $ +# $Id: tm-image,v 1.4 1997/01/30 02:22:30 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc.
--- a/lib-src/tm-mpeg Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-mpeg Mon Aug 13 09:09:02 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-mpeg,v 1.3 1997/01/11 20:13:51 steve Exp $ +# $Id: tm-mpeg,v 1.4 1997/01/30 02:22:30 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc.
--- a/lib-src/tm-plain Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-plain Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,23 @@ #!/bin/sh - # -# $Id: tm-plain,v 1.3 1997/01/11 20:13:52 steve Exp $ +# $Id: tm-plain,v 1.4 1997/01/30 02:22:30 steve Exp $ # +# Copyright 1994,1995,1996,1997 Free Software Foundation, Inc. + +# This program 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. +# +# This program 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. PATH=${PATH:-/usr/bin:/bin}:`dirname $0 2>/dev/null`; export PATH
--- a/lib-src/tm-ps Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tm-ps Mon Aug 13 09:09:02 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tm-ps,v 1.3 1997/01/11 20:13:52 steve Exp $ +# $Id: tm-ps,v 1.4 1997/01/30 02:22:30 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc.
--- a/lib-src/tmdecode Mon Aug 13 09:08:31 2007 +0200 +++ b/lib-src/tmdecode Mon Aug 13 09:09:02 2007 +0200 @@ -1,6 +1,6 @@ #!/bin/sh - # -# $Id: tmdecode,v 1.3 1997/01/11 20:13:52 steve Exp $ +# $Id: tmdecode,v 1.4 1997/01/30 02:22:30 steve Exp $ # # Copyright 1994, 1995, 1996 Free Software Foundation, Inc.
--- a/lisp/ChangeLog Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:09:02 2007 +0200 @@ -1,3 +1,34 @@ +Mon Jan 27 21:45:17 1997 Tomasz J. Cholewo <tjchol01@mecca.spd.louisville.edu> + + * dired/ange-ftp.el (ange-ftp-write-region): Changes for jka-compr. + + * packages/jka-compr.el (jka-compr-write-region): Convert to 20.0 + write-region interface. + +Mon Jan 27 19:09:28 1997 Steven L Baur <steve@altair.xemacs.org> + + * prim/about.el (about-xemacs): Updated to reflect change of + management. + +Mon Jan 27 13:25:17 1997 William M. Perry <wmperry@aventail.com> + + * packages/man.el (Manual-entry-switches): Don't default to -s. + +Sun Jan 26 16:27:49 1997 Steven L Baur <steve@altair.xemacs.org> + + * bytecomp/byte-optimize.el (byte-compile-inline-expand): + Correctly refresh the pointer to a symbol being autoloaded prior + to inline. + +Sun Jan 26 13:57:22 1997 Bob Weiner <weiner@infodock.com> + + * prim/about.el (about-xemacs-xref): Update bio. + +Sat Jan 25 22:58:15 1997 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el (default-menubar): Update ps-paper-type options + for new ps-print.el. + Thu Jan 23 01:40:53 1997 Steven L Baur <steve@altair.xemacs.org> * psgml/psgml-html.el (html-mode): Set up friendlier syntax
--- a/lisp/bytecomp/byte-optimize.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/bytecomp/byte-optimize.el Mon Aug 13 09:09:02 2007 +0200 @@ -273,7 +273,10 @@ form) ;; else (if (and (consp fn) (eq (car fn) 'autoload)) - (load (nth 1 fn))) + (progn + (load (nth 1 fn)) + (setq fn (or (cdr (assq name byte-compile-function-environment)) + (and (fboundp name) (symbol-function name)))))) (if (and (consp fn) (eq (car fn) 'autoload)) (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name)) (if (symbolp fn)
--- a/lisp/cl/cl-extra.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/cl/cl-extra.el Mon Aug 13 09:09:02 2007 +0200 @@ -928,4 +928,6 @@ (run-hooks 'cl-extra-load-hook) +(provide 'cl-extra) + ;;; cl-extra.el ends here
--- a/lisp/dired/ange-ftp.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/dired/ange-ftp.el Mon Aug 13 09:09:02 2007 +0200 @@ -408,7 +408,7 @@ ;;; 1. Umask problems: ;;; Be warned that files created by using ange-ftp will take account of the ;;; umask of the ftp daemon process rather than the umask of the creating -;;; user. This is particulary important when logging in as the root user. +;;; user. This is particularly important when logging in as the root user. ;;; The way that I tighten up the ftp daemon's umask under HP-UX is to make ;;; sure that the umask is changed to 027 before I spawn /etc/inetd. I ;;; suspect that there is something similar on other systems. @@ -643,7 +643,7 @@ ;;; which the writers of this program believe could never happen. However, ;;; being realists they have put calls to 'error in the program at these ;;; points. These errors provide a code, which is an integer, greater than 1. -;;; To aid debugging. the error codes, and the functions in which they reside +;;; To aid debugging the error codes, and the functions in which they reside ;;; are listed below. ;;; ;;; 1: See ange-ftp-ls @@ -2960,8 +2960,9 @@ (ange-ftp-save-match-data (string-match ange-ftp-binary-file-name-regexp file))) +;;; 20.0-b92 change (see jka-compr) (defun ange-ftp-write-region (start end filename &optional append visit - lockname) + lockname coding-system) "Documented as original." (interactive "r\nFWrite region to file: ") (setq filename (expand-file-name filename)) @@ -2981,7 +2982,7 @@ (mod-p (buffer-modified-p))) (unwind-protect (ange-ftp-real-write-region start end temp nil - visit lockname) + visit lockname coding-system) ;; cleanup forms (setq buffer-file-name filename) (if (fboundp 'compute-buffer-file-truename) @@ -3017,7 +3018,7 @@ (set-buffer-modified-p nil))) (ange-ftp-message "Wrote %s" abbr) (ange-ftp-add-file-entry filename)) - (ange-ftp-real-write-region start end filename append visit lockname)))) + (ange-ftp-real-write-region start end filename append visit lockname coding-system)))) (defun ange-ftp-insert-file-contents (filename &optional visit beg end replace) "Documented as original."
--- a/lisp/mu/latex-math-symbol.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/mu/latex-math-symbol.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,11 +1,11 @@ ;;; latex-math-symbol.el --- LaTeX math symbol decoder -;; Copyright (C) 1996 MORIOKA Tomohiko +;; Copyright (C) 1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1996/7/1 ;; Version: -;; $Id: latex-math-symbol.el,v 1.2 1996/12/28 21:02:58 steve Exp $ +;; $Id: latex-math-symbol.el,v 1.3 1997/01/30 02:22:35 steve Exp $ ;; Keywords: LaTeX, math, mule ;; This file is part of MU (Message Utilities). @@ -21,8 +21,8 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; 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: @@ -39,30 +39,110 @@ ;;; Code: (defvar latex-math-symbol-table-alist - '(("\\pi" . "$B&P(B") + '(("\\alpha" . ",Fa(B") + ("\\beta" . ",Fb(B") + ("\\gamma" . ",Fc(B")("\\Gamma" . "$B&#(B") + ("\\delta" . ",Fd(B")("\\Delta" . "$B&$(B") + ("\\epsilon" . ",Fe(B")("\\varepsilon" . "$B&E(B") + ("\\zeta" . ",Ff(B") + ("\\eta" . ",Fg(B") + ("\\theta" . ",Fh(B")("\\Theta" . "$B&((B") + ("\\iota" . ",Fi(B") + ("\\kappa" . ",Fj(B") + ("\\lambda" . ",Fk(B")("\\Lambda" . "$B&+(B") + ("\\mu" . ",Fl(B") + ("\\nu" . ",Fm(B") + ("\\xi" . ",Fn(B")("\\Xi" . "$B&.(B") + ("\\pi" . ",Fp(B")("\\Pi" . "$B&0(B") + ("\\rho" . ",Fq(B") + ("\\sigma" . ",Fs(B")("\\Sigma" . "$B&2(B") + ("\\varsigma" . ",Fr(B") + ("\\tau" . ",Ft(B") + ("\\upsilon" . ",Fu(B")("\\Upsilon" . "$B&4(B") + ("\\phi" . "$B&U(B")("\\Phi" . "$B&5(B") + ("\\varphi" . ",Fv(B") + ("\\chi" . ",Fw(B") + ("\\psi" . ",Fx(B")("\\Psi" . "$B&7(B") + ("\\omega" . ",Fy(B")("\\Omega" . "$B&8(B") ("\\{" . "$B!P(B")("\\}" . "$B!Q(B") + ("\\langle\\!\\langle" . "$B!T(B")("\\rangle\\!\\rangle" . "$B!U(B") + ("\\langle" . "$B!R(B")("\\rangle" . "$B!S(B") + ("\\cdots" . "$B!D(B") + + ("\\ln" . "$(G"L(B") + ("\\log" . "$(G"K(B") + + ("\\pm" . "$B!^(B") ("\\cdot" . "$B!&(B") - ("\\times" . "$B!_(B") + ("\\times" . "$B!_(B")("\\ast" . "$B!v(B") + ("\\star" . "$B!z(B") + ("\\bullet" . "$B!&(B") + ("\\div" . "$B!`(B") ("\\cap" . "$B"A(B")("\\cup" . "$B"@(B") + ("\\lhd" . "$(C"7(B")("\\rhd" . "$(C"9(B") + ("\\bigcirc" . "$B"~(B") + ("\\vee" . "$B"K(B")("\\lor" . "$B"K(B") + ("\\wedge" . "$B"J(B")("\\land" . "$B"J(B") + ("\\oplus" . "$(G"S(B") + ("\\odot" . "$(G"T(B") + ("\\dagger" . "$B"w(B")("\\ddagger" . "$B"x(B") ("\\leq" . "$(C!B(B")("\\geq" . "$(C!C(B") ("\\le" . "$(C!B(B")("\\ge" . "$(C!C(B") + ("\\ll" . "$B"c(B")("\\gg" . "$B"d(B") ("\\subseteq" . "$B"<(B")("\\supseteq" . "$B"=(B") ("\\subset" . "$B">(B")("\\supset" . "$B"?(B") - ("\\in" . "$B":(B")("\\ni" . "$B";(B") - ("\\mid" . "$B!C(B") + ("\\in" . "$B":(B") + ("\\ni" . "$B";(B")("\\owns" . "$B";(B") + ("\\frown" . "$B"^(B") + ("\\mid" . "$B!C(B")("\\parallel" . "$B!B(B") + ("\\sim" . "$B!A(B") + ("\\equiv" . "$B"a(B") + ("\\approx" . "$A!V(B") + ("\\not=" . "$B!b(B") ("\\neq" . "$B!b(B")("\\ne" . "$B!b(B") + ("\\perp" . "$B"](B") + ("\\triangleup" . "$B"$(B") ("\\forall" . "$B"O(B") + ("\\hbar" . ",C1(B")("\\imath" . ",C9(B") + ("\\ell" . "$(C'$(B") + ("\\partial" . "$B"_(B") + ("\\infty" . "$B!g(B") + ("\\smallint" . "$B"i(B") + ("\\P" . "$B"y(B") + ("\\prime" . "$B!l(B") + ("\\nabla" . "$B"`(B") + ("\\top" . "$(D0#(B")("\\bot" . "$(D0"(B") + ("\\vert" . "$B!C(B")("\\Vert" . "$B!B(B") + ("\\angle" . "$B"\(B") + ("\\triangle" . "$B"$(B") + ("\\backslash" . "$B!@(B") + ("\\S" . "$B!x(B") + ("\\forall" . "$B"O(B") + ("\\exists" . "$B"P(B") + ("\\neg" . "$B"L(B")("\\lnot" . "$B"L(B") + ("\\flat" . "$B"u(B")("\\sharp" . "$B"t(B") + ("\\clubsuit" . "$(C"@(B") + ("\\diamondsuit" . "$B!~(B") + ("\\heartsuit" . "$(C"=(B") + ("\\spadesuit" . "$(C"<(B") + ("\\leftarrow" . "$B"+(B")("\\rightarrow" . "$B"*(B") ("\\gets" . "$B"+(B")("\\to" . "$B"*(B") - ("^1" . ",A9(B") - ("^2" . ",A2(B") - ("^3" . ",A3(B") + ("^1" . ",A9(B")("^{1}" . ",A9(B") + ("^2" . ",A2(B")("^{2}" . ",A2(B") + ("^3" . ",A3(B")("^{3}" . ",A3(B") + ("^4" . "$(C)y(B")("^{4}" . "$(C)y(B") + ("^n" . "$(C)z(B")("^{n}" . "$(C)z(B") + ("_1" . "$(C){(B")("_{1}" . "$(C){(B") + ("_2" . "$(C)|(B")("_{2}" . "$(C)|(B") + ("_3" . "$(C)}(B")("_{3}" . "$(C)}(B") + ("_4" . "$(C)~(B")("_{4}" . "$(C)~(B") )) (defun latex-math-decode-region (beg end) @@ -70,12 +150,19 @@ (save-restriction (narrow-to-region beg end) (let ((rest latex-math-symbol-table-alist) + (case-fold-search nil) cell) (while rest (setq cell (car rest)) (goto-char beg) - (while (search-forward (car cell) nil t) - (replace-match (cdr cell)) + (while (re-search-forward + (concat "\\(" + (regexp-quote (car cell)) + "\\)\\([^a-zA-Z]\\|$\\)") + nil t) + (delete-region (match-beginning 1)(match-end 1)) + (goto-char (match-beginning 0)) + (insert (cdr cell)) ) (setq rest (cdr rest)) ))))
--- a/lisp/mu/mu-cite.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/mu/mu-cite.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,15 +1,15 @@ ;;; mu-cite.el --- yet another citation tool for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; MINOURA Makoto <minoura@netlaputa.or.jp> ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; Keywords: mail, news, citation -;; This file is part of tl (Tiny Library). +;; This file is part of MU (Message Utilities). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -54,7 +54,7 @@ ;;; (defconst mu-cite/RCS-ID - "$Id: mu-cite.el,v 1.2 1996/12/28 21:02:58 steve Exp $") + "$Id: mu-cite.el,v 1.3 1997/01/30 02:22:36 steve Exp $") (defconst mu-cite/version (get-version-string mu-cite/RCS-ID)) @@ -390,45 +390,71 @@ ;;; @ message editing utilities ;;; + +(defvar citation-mark-chars ">}|" + "*String of characters for citation delimiter. [mu-cite.el]") -(defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*" - "*Regexp to match the citation prefix.") +(defun detect-paragraph-cited-prefix () + (save-excursion + (goto-char (point-min)) + (let ((i 0) + (prefix + (buffer-substring + (progn (beginning-of-line)(point)) + (progn (end-of-line)(point)) + )) + str ret) + (while (and (= (forward-line) 0) + (setq str (buffer-substring + (progn (beginning-of-line)(point)) + (progn (end-of-line)(point)))) + (setq ret (string-compare-from-top prefix str)) + ) + (setq prefix (second ret)) + (setq i (1+ i)) + ) + (cond ((> i 1) prefix) + ((> i 0) + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point) + (+ (point)(length prefix))) + (goto-char (point-max)) + (if (re-search-backward + (concat "[" citation-mark-chars "]") nil t) + (progn + (goto-char (match-end 0)) + (if (looking-at "[ \t]+") + (goto-char (match-end 0)) + ) + (buffer-substring (point-min)(point)) + ) + prefix))) + ((progn + (goto-char (point-max)) + (re-search-backward (concat "[" citation-mark-chars "]") + nil t) + ) + (goto-char (match-end 0)) + (if (looking-at "[ \t]+") + (goto-char (match-end 0)) + ) + (buffer-substring (point-min)(point)) + ) + (t "")) + ))) (defun fill-cited-region (beg end) (interactive "*r") (save-excursion (save-restriction (goto-char end) - (while (not (eolp)) - (backward-char) - ) - (setq end (point)) + (and (search-backward "\n" nil t) + (setq end (match-end 0)) + ) (narrow-to-region beg end) - (goto-char (point-min)) - (let* ((fill-prefix - (let* ((str1 (buffer-substring - (progn (beginning-of-line)(point)) - (progn (end-of-line)(point)) - )) - (str2 (let ((p0 (point))) - (forward-line) - (if (> (count-lines p0 (point)) 0) - (buffer-substring - (progn (beginning-of-line)(point)) - (progn (end-of-line)(point)) - )))) - (ret (string-compare-from-top str1 str2)) - ) - (if ret - (let ((prefix (nth 1 ret))) - (if (string-match cited-prefix-regexp prefix) - (substring prefix 0 (match-end 0)) - prefix)) - (goto-char (point-min)) - (if (re-search-forward cited-prefix-regexp nil t) - (buffer-substring (match-beginning 0) (match-end 0)) - )))) - (pat (concat "\n" fill-prefix)) + (let* ((fill-prefix (detect-paragraph-cited-prefix)) + (pat (concat fill-prefix "\n")) ) (goto-char (point-min)) (while (search-forward pat nil t) @@ -450,8 +476,6 @@ (fill-region (point-min) (point-max)) )))) -(defvar citation-mark-chars ">}|") - (defun compress-cited-prefix () (interactive) (save-excursion
--- a/lisp/mule/european-hooks.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/mule/european-hooks.el Mon Aug 13 09:09:02 2007 +0200 @@ -91,8 +91,8 @@ (define-language-environment 'european "European (for Latin-1 through Latin-5)" (lambda () - ;(set-coding-category-system 'iso-8-designate 'iso-8859-1) - ;(set-coding-priority-list '(iso-8-designate iso-8-1)) + (set-coding-category-system 'iso-8-designate 'iso-8859-1) + (set-coding-priority-list '(iso-8-designate iso-8-1)) (set-default-file-coding-system 'binary) ; iso-8859-1 ;;(setq locale-coding-system 'binary) ; iso-8859-1 (setq process-input-coding-system 'binary) ; iso-8859-1
--- a/lisp/mule/mule-coding.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/mule/mule-coding.el Mon Aug 13 09:09:02 2007 +0200 @@ -256,7 +256,7 @@ ;; so that the remaining Lisp files can contain extended characters. ;; (They will be in ISO-7 format) -(set-coding-priority-list '(iso-8-2 shift-jis iso-8-designate iso-8-1 big5 +(set-coding-priority-list '(iso-8-2 iso-8-designate iso-8-1 iso-7 iso-lock-shift no-conversion)) (set-coding-category-system 'iso-7 'iso-2022-7)
--- a/lisp/mule/mule-files.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/mule/mule-files.el Mon Aug 13 09:09:02 2007 +0200 @@ -55,6 +55,7 @@ '(("\\.el$" . iso-2022-8) ("\\.info$" . iso-2022-8) ("ChangeLog$" . iso-2022-8) + ("\\.texi$" . iso-2022-8) ("\\.\\(gz\\|Z\\)$" . binary) ("/spool/mail/.*$" . convert-mbox-coding-system)) "Alist specifying the coding system used for particular files.
--- a/lisp/packages/jka-compr.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/packages/jka-compr.el Mon Aug 13 09:09:02 2007 +0200 @@ -65,7 +65,7 @@ ;; APPLICATION NOTES: ;; ;; crypt++ -;; jka-compr can coexist with crpyt++ if you take all the decompression +;; jka-compr can coexist with crypt++ if you take all the decompression ;; entries out of the crypt-encoding-list. Clearly problems will arise if ;; you have two programs trying to compress/decompress files. jka-compr ;; will not "work with" crypt++ in the following sense: you won't be able to @@ -366,8 +366,10 @@ (delete-file temp) (error nil))) - -(defun jka-compr-write-region (start end file &optional append visit) +;;; 20.0-b92 change +;;; Now receives both `lockname' and `codesys' from Fwrite_region_internal +;;; what makes it compatible with write-region +(defun jka-compr-write-region (start end file &optional append visit lockname coding-system) (let* ((filename (expand-file-name file)) (visit-file (if (stringp visit) (expand-file-name visit) filename)) (info (jka-compr-get-compression-info visit-file))) @@ -406,7 +408,7 @@ (message "%s %s..." compress-message base-name)) (jka-compr-run-real-handler 'write-region - (list start end temp-file t 'dont)) + (list start end temp-file t 'dont lockname coding-system)) (jka-compr-call-process compress-program (concat compress-message @@ -420,7 +422,7 @@ (jka-compr-run-real-handler 'write-region (list (point-min) (point-max) filename - (and append can-append) 'dont)) + (and append can-append) 'dont lockname coding-system)) (erase-buffer) (set-buffer cbuf) @@ -447,7 +449,7 @@ nil) (jka-compr-run-real-handler 'write-region - (list start end filename append visit))))) + (list start end filename append visit lockname coding-system))))) (defun jka-compr-insert-file-contents (file &optional visit beg end replace)
--- a/lisp/packages/man.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 09:09:02 2007 +0200 @@ -575,7 +575,7 @@ (error (buffer-substring (point) (progn (end-of-line) (point)))))) nil) -(defvar Manual-entry-switches '("-s") +(defvar Manual-entry-switches nil "Switches for `manual-entry' including switch for section (at the end).") (defvar Manual-apropos-switches nil "Additional switches for `Manpage-apropos' excluding switch `-k'.")
--- a/lisp/prim/about.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; about.el --- the About The Authors page (shameless self promotion). ;;; -;; Copyright (c) 1995, 1996 XEmacs Advocacy Organization. +;; Copyright (c) 1995, 1996, 1997 XEmacs Advocacy Organization. ;; This file is part of XEmacs. @@ -37,6 +37,7 @@ ;;; and Chuck Thompson <cthomp@xemacs.org> ;;; More hacking for 19.12 by Chuck Thompson and Ben Wing. ;;; 19.13 and 19.14 updating done by Chuck Thompson. +;;; 19.15 and 20.0 updating done by Steve Baur. (require 'browse-url) (defvar about-xref-map (let ((map (make-sparse-keymap))) @@ -77,7 +78,7 @@ (view-mode nil 'kill-buffer) ;; assume the new view-less (let* ((buffer-read-only nil) (emacs-short-version (concat emacs-major-version "." emacs-minor-version)) - (emacs-about-version (format "version %s; June 1996" emacs-short-version)) + (emacs-about-version (format "version %s; February 1997" emacs-short-version)) (indent-tabs-mode t) ) (erase-buffer) @@ -126,11 +127,16 @@ (insert "XEmacs is the result of the time and effort of many people. The developers responsible for the " emacs-short-version " release are: + * ") (about-xref "Steve Baur" 'steve "Find out more about Steve Baur") (insert " <steve@altair.xemacs.org> + * ") (about-xref "Martin Buchholz" 'mrb "Find out more about Martin Buchholz") (insert " <mrb@eng.sun.com> * ") (about-xref "Chuck Thompson" 'cthomp "Find out more about Chuck Thompson") (insert " <cthomp@xemacs.org> * ") (about-xref "Ben Wing" 'wing "Find out more about Ben Wing") (insert " <wing@xemacs.org> * ") (about-xref "And many other contributors..." 'others "Read about the legion of XEmacs hackers") (insert " + Chuck Thompson was Mr. XEmacs from 19.11 through 19.14. Ben Wing + was crucial to each of those releases. + Jamie Zawinski was Mr. Lucid Emacs from 19.0 through 19.10, the last release actually named Lucid Emacs. Richard Mlynarik was crucial to most of those releases. @@ -149,7 +155,7 @@ (toggle-read-only 0) (let ((rest (if who-to-load (list who-to-load) - '(cthomp wing stig jwz mly vladimir baw piper bw wmperry))) + '(steve mrb cthomp wing stig jwz mly vladimir baw piper bw wmperry))) (got-error nil)) (while rest (let* ((who (car rest)) @@ -199,7 +205,7 @@ (goto-char (point-max)) (insert "\n ") - (let ((rest '(cthomp wing stig linebreak jwz mly vladimir linebreak baw piper bw linebreak wmperry)) + (let ((rest '(steve mrb cthomp wing stig linebreak jwz mly vladimir linebreak baw piper bw linebreak wmperry)) (got-error nil)) (while rest (if (eq (car rest) 'linebreak) @@ -280,6 +286,8 @@ ((eq xref 'bw) "About Bob Weiner") ((eq xref 'piper) "About Andy Piper") ((eq xref 'stig) "About Jonathan Stigelman") + ((eq xref 'steve) "About Steve Baur") + ((eq xref 'mrb) "About Martin Buchholz") ((eq xref 'others) "About Everyone") ((eq xref 'features) "New XEmacs Features") ((eq xref 'history) "XEmacs History") @@ -514,6 +522,38 @@ (about-xref "here" prev-page "Return to previous page") (insert " to go back to the previous page.\n") ) + ((eq xref 'steve) + (about-face "Steve Baur" 'bold) + (insert " <steve@altair.xemacs.org> + + Steve took over the maintenance of XEmacs in November of 1996 + (it seemed like a good idea at the time ...). In real life he is a + network administrator and Unix systems programmer for Miranova + Systems, Inc. + + Steve's main contributions to XEmacs have been reviving the FAQ, + testing and integrating patches, tracking down and fixing bugs, and + answering hundreds of questions on Usenet.") + + (insert "\n\n\tClick ") + (about-xref "here" prev-page "Return to previous page") + (insert " to go back to the previous page.\n") + ) + ((eq xref 'mrb) + (about-face "Martin Buchholz" 'bold) + (insert " <mrb@eng.sun.com> + + Martin Buchholz <Martin.Buchholz@sun.com> + Technical lead for XEmacs at DevPro (formerly SunPro), a + division of Sun Microsystems. Martin used to do XEmacs as a + `hobby' while at IBM, and was crazy enough to try to do it + for a living at Sun. Martin is currently working mostly on + Internationalization.") + + (insert "\n\n\tClick ") + (about-xref "here" prev-page "Return to previous page") + (insert " to go back to the previous page.\n") + ) ((eq xref 'cthomp) (about-face "Chuck Thompson" 'bold) (insert " <cthomp@xemacs.org> @@ -626,13 +666,15 @@ ((eq xref 'bw) (about-face "Bob Weiner" 'bold) - (insert " <weiner@mot.com> + (insert " <weiner@infodock.com> Author of the Hyperbole everyday information management hypertext system and the OO-Browser multi-language code browser. He also designed the InfoDock integrated tool framework for software engineers. It runs atop XEmacs and is - available from \"/anonymous@ftp.xemacs.org:pub/infodock\". + available from his firm, InfoDock Associates, which offers custom + development and support packages for corporate users of XEmacs, + GNU Emacs and InfoDock. See \"http://www.infodock.com>\". His interests include user interfaces, information management, CASE tools, communications and enterprise integration.") @@ -674,18 +716,14 @@ ((eq xref 'wmperry) (about-face "William Perry" 'bold) - (insert " <wmperry@spry.com> + (insert " <wmperry@aventail.com> - Author of Emacs-w3, the builtin web browser that comes with XEmacs, - and various additions to the C code (e.g. the database support, - the PNG support, some of the GIF/JPEG support, the strikethru - face attribute support). + Author of Emacs-w3, the builtin web browser that comes with XEmacs, + and various additions to the C code (e.g. the database support, + the PNG support, some of the GIF/JPEG support, the strikethru + face attribute support). - He is currently working on adding really cool stylesheets to the - web, which will stress the new capabilities of XEmacs to the limit. - - He only gets paid for working on an HTTP server for Spry, but will - hack emacs for beer.") + He is currently working at Aventail, Corp. on SOCKS v5 servers.") (insert "\n\n\tClick ") (about-xref "here" prev-page "Return to previous page") @@ -705,13 +743,6 @@ These are some of the contributors; we have no doubt forgotten someone; we apologize! You can see some of our faces further below. - Martin Buchholz <Martin.Buchholz@sun.com> - Technical lead for XEmacs at DevPro (formerly SunPro), a - division of Sun Microsystems. Martin used to do XEmacs as a - `hobby' while at IBM, and was crazy enough to try to do it - for a living at Sun. Martin is currently working mostly on - Internationalization. - ") (about-xref "Vladimir Ivanovic" 'vladimir "Find out more about Vladimir Ivanovic") (insert " <vladimir@mri.com> Former technical lead for XEmacs at Sun Microsystems. He is now with Microtec Research Inc., working on embedded systems @@ -734,23 +765,22 @@ Created the prototype for the toolbars. Has been the first to make use of many of the new XEmacs graphics features. - ") (about-xref "Bob Weiner" 'bw "Find out more about Bob Weiner") (insert " <weiner@mot.com> + ") (about-xref "Bob Weiner" 'bw "Find out more about Bob Weiner") (insert " <weiner@infodock.com> Author of the Hyperbole everyday information management hypertext system and the OO-Browser multi-language code browser. He also designed the InfoDock integrated tool framework for software engineers. It runs atop XEmacs and is - available from \"/anonymous@ftp.xemacs.org:pub/infodock\". + available from his firm, InfoDock Associates, which offers custom + development and support packages for corporate users of XEmacs, + GNU Emacs and InfoDock. See \"http://www.infodock.com>\". His interests include user interfaces, information management, - CASE tools, communications and enterprise integration. + CASE tools, communications and enterprise integration. - ") (about-xref "William Perry" 'wmperry "Find out more about Bill Perry") (insert " <wmperry@spry.com> - Author of W3, a package for browsing the World Wide Web - which is included in the standard XEmacs distribution. - Although W3 runs on all versions of Emacs, Bill has been - quick to take advantage of the unique features of XEmacs - (such as embedded images and windows). Thus, the XEmacs - version of W3 is significantly more powerful than versions - running in other Emacs variants. + ") (about-xref "William Perry" 'wmperry "Find out more about Bill Perry") (insert " <wmperry@aventail.com> + Author of Emacs-w3, the builtin web browser that comes with XEmacs, + and various additions to the C code (e.g. the database support, + the PNG support, some of the GIF/JPEG support, the strikethru + face attribute support). Kyle Jones <kyle@crystal.wonderworks.com> Author of VM (View Mail), a mail-reading package that is @@ -815,9 +845,9 @@ Mark Allender <allender@vnet.IBM.COM> Butch Anton <butch@zaphod.uchicago.edu> Fred Appelman <Fred.Appelman@cv.ruu.nl> + Erik \"The Pope\" Arneson <lazarus@mind.net> Tor Arntsen <tor@spacetec.no> Mike Battaglia <mbattagl@dsccc.com> - Steven L Baur <steve@miranova.com> Neal Becker <neal@ctd.comsat.com> Paul Bibilo <peb@delcam.com> Jan Borchers <job@tk.uni-linz.ac.at> @@ -833,16 +863,23 @@ Philippe Charton <charton@lmd.ens.fr> Peter Cheng <peter.cheng@sun.com> Jin S. Choi <jin@atype.com> + Tomasz J. Cholewo <tjchol01@mecca.spd.louisville.edu> Serenella Ciongoli <czs00@ladybug.oes.amdahl.com> Richard Cognot <cognot@ensg.u-nancy.fr> Andy Cohen <cohen@andy.bu.edu> + Andrew J Cosgriff <ajc@bing.wattle.id.au> + Nick J. Crabtree <nickc@scopic.com> Christopher Davis <ckd@kei.com> + Soren Dayton <csdayton@cs.uchicago.edu> Michael Diers <mdiers@logware.de> William G. Dubuque <wgd@martigny.ai.mit.edu> Samuel J. Eaton <samuele@cogs.susx.ac.uk> Carl Edman <cedman@Princeton.EDU> Dave Edmondson <davided@sco.com> + Jonathan Edwards <edwards@intranet.com> Eric Eide <eeide@asylum.cs.utah.edu> + EKR <ekr@terisa.com> + Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> David Fletcher <frodo@tsunami.com> Paul Flinders <ptf@delcam.co.uk> Jered J Floyd <jered@mit.edu> @@ -850,6 +887,7 @@ Benjamin Fried <bf@morgan.com> Barry Friedman <friedman@bnr.ca> Lew Gaiter III <lew@StarFire.com> + Itay Gat <itay@cs.huji.ac.il> Tim Geisler <Tim.Geisler@informatik.uni-muenchen.de> Dave Gillespie <daveg@synaptics.com> Christian F. Goetze <cg@bigbook.com> @@ -863,6 +901,7 @@ Magnus Hammerin <magnush@epact.se> ChangGil Han <cghan@phys401.phys.pusan.ac.kr> Derek Harding <dharding@lssec.bt.co.uk> + Michael Harnois <mharnois@sbt.net> John Haxby <J.Haxby@isode.com> Jareth \"JHod\" Hein <jhod@po.iijnet.or.jp> Benedikt Heinen <beh@icemark.thenet.ch> @@ -875,12 +914,19 @@ Robin Jeffries <robin.jeffries@sun.com> Philip Johnson <johnson@uhics.ics.Hawaii.Edu> J. Kean Johnston <jkj@paradigm-sa.com> + Andreas Kaempf <andreas@sccon.com> Doug Keller <dkeller@vnet.ibm.com> + Hunter Kelly <retnuh@corona> Gregor Kennedy <gregork@dadd.ti.com> Michael Kifer <kifer@cs.sunysb.edu> Yasuhiko Kiuchi <kiuchi@dsp.ksp.fujixerox.co.jp> + Greg Klanderman <greg@alphatech.com> + Valdis Kletnieks <Valdis.Kletnieks@vt.edu> + Jens Krinke <krinke@ips.cs.tu-bs.de> + Mats Larsson <Mats.Larsson@uab.ericsson.se> Jens Lautenbacher <jens@lemcbed.lem.uni-karlsruhe.de> Simon Leinen <simon@instrumatic.ch> + Carsten Leonhardt <leo@arioch.tng.oche.de> James LewisMoss <moss@cs.sc.edu> Mats Lidell <mats.lidell@contactor.se> Matt Liggett <mliggett@seven.ucs.indiana.edu> @@ -888,42 +934,52 @@ Robert Lipe <robertl@arnet.com> Damon Lipparelli <lipp@aa.net> Hamish Macdonald <hamish@bnr.ca> - Ian MacKinnon <imac@rd.abs.alcatel.co.uk> + Ian MacKinnon <imackinnon@telia.co.uk> Patrick MacRoberts <macro@hpcobr30.cup.hp.com> Tonny Madsen <Tonny.Madsen@netman.dk> Ketil Z Malde <ketil@ii.uib.no> Steve March <smarch@quaver.urbana.mcd.mot.com> + Pekka Marjola <pema@iki.fi> Simon Marshall <Simon.Marshall@mail.esrin.esa.it> Dave Mason <dmason@plg.uwaterloo.ca> Jaye Mathisen <mrcpu@cdsnet.net> Michael Meissner <meissner@osf.org> David M. Meyer <meyer@ns.uoregon.edu> Brad Miller <bmiller@cs.umn.edu> + Jeff Miller <jmiller@bay1.bayserve.net> + David Moore <dmoore@UCSD.EDU> John Morey <jmorey@crl.com> Rob Mori <rob.mori@sun.com> Heiko Muenkel <muenkel@tnt.uni-hannover.de> Arup Mukherjee <arup+@cs.cmu.edu> Colas Nahaboo <Colas.Nahaboo@sophia.inria.fr> Lynn D. Newton <lynn@ives.phx.mcd.mot.com> + Casey Nielson <knielson@joule.elee.calpoly.edu> Georg Nikodym <Georg.Nikodym@canada.sun.com> + Hrvoje Niksic <hniksic@srce.hr> Andy Norman <ange@hplb.hpl.hp.com> Joseph J. Nuspl Jr. <nuspl@cc.purdue.edu> Kim Nyberg <kny@tekla.fi> David Ofelt <ofelt@getalife.Stanford.EDU> + Tore Olsen <toreo@colargol.idb.hist.no> Greg Onufer <Greg.Onufer@eng.sun.com> Achim Oppelt <aoppelt@theorie3.physik.uni-erlangen.de> Sudeep Kumar Palat <palat@idt.unit.no> Marc Paquette <Marc.Paquette@Softimage.com> Jens-U H Petersen <petersen@kurims.kyoto-u.ac.jp> + Joel Peterson <tarzan@aosi.com> Thomas A. Peterson <tap@src.honeywell.com> Peter Pezaris <pez@dwwc.com> Tibor Polgar <tlp00@eng.amdahl.com> + Frederic Poncin <fp@info.ucl.ac.be> E. Rehmi Post <rehmi@asylum.sf.ca.us> + Colin Rafferty <craffert@spspme.ml.com> Paul M Reilly <pmr@pajato.com> Jack Repenning <jackr@sgi.com> Daniel Rich <drich@cisco.com> Roland Rieke <rol@darmstadt.gmd.de> Russell Ritchie <ritchier@msc.ie> + Roland <rol@darmstadt.gmd.de> Mike Russell <mjruss@rchland.vnet.ibm.com> Jan Sandquist <etxquist@iqa.ericsson.se> Marty Sasaki <sasaki@spdcc.com> @@ -933,7 +989,9 @@ Cotton Seed <cottons@cybercom.net> Axel Seibert <seiberta@informatik.tu-muenchen.de> Odd-Magne Sekkingstad <oddms@ii.uib.no> + Vinnie Shelton <shelton@icd.teradyne.com> John Shen <zfs60@cas.org> + Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp> Jeffrey Sparkes <jsparkes@bnr.ca> Michael Sperber <sperber@informatik.uni-tuebingen.de> Manoj Srivastava <srivasta@pilgrim.umass.edu> @@ -944,6 +1002,7 @@ Morioka Tomohiko <morioka@jaist.ac.jp> Raymond L. Toy <toy@rtp.ericsson.se> John Turner <turner@xdiv.lanl.gov> + Juan E. Villacis <jvillaci@cs.indiana.edu> Vladimir Vukicevic <vladimir@intrepid.com> Peter Ware <ware@cis.ohio-state.edu> Yoav Weiss <yoav@zeus.datasrv.co.il>
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:09:02 2007 +0200 @@ -3659,7 +3659,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.5 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.6 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4956,7 +4956,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.5 $ +vhdl-mode $Revision: 1.6 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the @@ -8375,12 +8375,15 @@ --[[text/plain]] This is also a plain text. But, it is explicitly specified as is. - --[[text/plain; charset=ISO-2022-JP]] - ... Japanese text here ... - --[[text/richtext]] - <center>This is a richtext.</center> - --[[image/gif][base64]]^M...image encoded in base64 here... - --[[audio/basic][base64]]^M...audio encoded in base64 here... + --[[text/plain; charset=ISO-8859-1]] + This is also a plain text. But charset is specified as + iso-8859-1. + + ¡Hola! Buenos días. ¿Cómo está usted? + --[[text/enriched]] + This is a <bold>enriched text</bold>. + --[[image/gif][base64]]...image encoded in base64 here... + --[[audio/basic][base64]]...audio encoded in base64 here... User customizable variables (not documented all of them): mime-prefix @@ -9250,6 +9253,12 @@ ;;;*** +;;;### (autoloads nil "timezone" "utils/timezone.el") + +(define-error 'invalid-date "Invalid date string") + +;;;*** + ;;;### (autoloads (tq-create) "tq" "utils/tq.el") (autoload 'tq-create "tq" "\
--- a/lisp/prim/faces.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 09:09:02 2007 +0200 @@ -12,7 +12,7 @@ ;; pre Lucid-Emacs 19.0. ;; ;; face implementation #2 (used one face object per frame per face) -;; authored by Jamie Zawinkski for 19.9. +;; authored by Jamie Zawinski for 19.9. ;; ;; face implementation #3 (use one face object per face) originally ;; authored for 19.12 by Chuck Thompson <cthomp@cs.uiuc.edu>, @@ -119,7 +119,7 @@ See `set-face-property' for the built-in property-names." - (or (facep face) (setq face (get-face face))) + (setq face (get-face face)) (let ((value (get face property))) (if (and locale (or (memq property built-in-face-specifiers) @@ -135,15 +135,15 @@ ;; locale was specified, put a specifier there. ;; If there was already a value there, convert it to a ;; specifier with the value as its 'global instantiator. - (if (not (specifierp specifier)) - (let ((new-specifier (make-specifier 'generic))) - (if (or (not (null specifier)) - ;; make sure the nil returned from `get' wasn't - ;; actually the value of the property - (null (get face property t))) - (add-spec-to-specifier new-specifier specifier)) - (setq specifier new-specifier) - (put face property specifier))))) + (unless (specifierp specifier) + (let ((new-specifier (make-specifier 'generic))) + (if (or (not (null specifier)) + ;; make sure the nil returned from `get' wasn't + ;; actually the value of the property + (null (get face property t))) + (add-spec-to-specifier new-specifier specifier)) + (setq specifier new-specifier) + (put face property specifier))))) (defun face-property-instance (face property &optional domain default no-fallback) @@ -189,7 +189,7 @@ Optional arguments DEFAULT and NO-FALLBACK are the same as in `specifier-instance'." - (or (facep face) (setq face (get-face face))) + (setq face (get-face face)) (let ((value (get face property))) (if (specifierp value) (setq value (specifier-instance value domain default no-fallback))) @@ -208,7 +208,7 @@ See also `specifier-matching-instance' for a fuller description of the matching process." - (or (facep face) (setq face (get-face face))) + (setq face (get-face face)) (let ((value (get face property))) (if (specifierp value) (setq value (specifier-matching-instance value matchspec domain @@ -320,7 +320,7 @@ the other built-in properties, and cannot contain locale-specific values." - (or (facep face) (setq face (get-face face))) + (setq face (get-face face)) (if (memq property built-in-face-specifiers) (set-specifier (get face property) value locale tag-set how-to-add) @@ -351,21 +351,21 @@ This makes FACE inherit all its display properties from 'default. WARNING: Be absolutely sure you want to do this!!! It is a dangerous operation and is not undoable." - (mapcar #'(lambda (x) + (mapcar (lambda (x) (remove-specifier (face-property face x))) - built-in-face-specifiers) + built-in-face-specifiers) nil) (defun set-face-parent (face parent &optional locale tag-set how-to-add) "Set the parent of FACE to PARENT, for all properties. This makes all properties of FACE inherit from PARENT." (setq parent (get-face parent)) - (mapcar #'(lambda (x) + (mapcar (lambda (x) (set-face-property face x (vector parent) locale tag-set how-to-add)) - (delq 'display-table - (delq 'background-pixmap - (copy-sequence built-in-face-specifiers)))) + (delq 'display-table + (delq 'background-pixmap + (copy-sequence built-in-face-specifiers)))) (set-face-background-pixmap face (vector 'inherit ':face parent) locale tag-set how-to-add) nil) @@ -767,8 +767,8 @@ ;; this is easy. (let* ((inst (face-property-instance face property locale)) (name (and inst (funcall func inst (dfw-device locale))))) - (if name - (add-spec-to-specifier sp name locale))) + (when name + (add-spec-to-specifier sp name locale))) ;; otherwise, map over all specifications ... ;; but first, some further kludging: ;; (1) if we're frobbing the global property, make sure @@ -790,30 +790,29 @@ (error "Property must have a specification in locale %S" locale)) (map-specifier sp - #'(lambda (sp locale inst-list func) - (let* ((device (dfw-device locale)) - ;; if a device can be derived from the locale, - ;; call frob-face-property-1 for that device. - ;; Otherwise map frob-face-property-1 over each device. - (result - (if device - (list (frob-face-property-1 sp device inst-list func)) - (mapcar #'(lambda (device) - (frob-face-property-1 sp device - inst-list func)) - (device-list)))) - new-result) - ;; remove duplicates and nils from the obtained list of - ;; instantiators. - (mapcar #'(lambda (arg) - (if (and arg (not (member arg new-result))) - (setq new-result (cons arg new-result)))) - result) - ;; add back in. - (add-spec-list-to-specifier sp - (list (cons locale new-result))) - ;; tell map-specifier to keep going. - nil)) + (lambda (sp locale inst-list func) + (let* ((device (dfw-device locale)) + ;; if a device can be derived from the locale, + ;; call frob-face-property-1 for that device. + ;; Otherwise map frob-face-property-1 over each device. + (result + (if device + (list (frob-face-property-1 sp device inst-list func)) + (mapcar (lambda (device) + (frob-face-property-1 sp device + inst-list func)) + (device-list)))) + new-result) + ;; remove duplicates and nils from the obtained list of + ;; instantiators. + (mapcar (lambda (arg) + (when (and arg (not (member arg new-result))) + (setq new-result (cons arg new-result)))) + result) + ;; add back in. + (add-spec-list-to-specifier sp (list (cons locale new-result))) + ;; tell map-specifier to keep going. + nil)) locale func)))) @@ -915,13 +914,13 @@ (interactive (list (read-face-name "Make which face bold: "))) (frob-face-font-2 face locale 'default 'bold - #'(lambda () - ;; handle TTY specific entries - (if (featurep 'tty) - (set-face-highlight-p face t locale 'tty))) - #'(lambda () - ;; handle X specific entries - (frob-face-property face 'font 'x-make-font-bold locale)) + (lambda () + ;; handle TTY specific entries + (when (featurep 'tty) + (set-face-highlight-p face t locale 'tty))) + (lambda () + ;; handle X specific entries + (frob-face-property face 'font 'x-make-font-bold locale)) '(([default] . [bold]) ([bold] . t) ([italic] . [bold-italic]) @@ -936,13 +935,13 @@ (interactive (list (read-face-name "Make which face italic: "))) (frob-face-font-2 face locale 'default 'italic - #'(lambda () - ;; handle TTY specific entries - (if (featurep 'tty) - (set-face-underline-p face t locale 'tty))) - #'(lambda () - ;; handle X specific entries - (frob-face-property face 'font 'x-make-font-italic locale)) + (lambda () + ;; handle TTY specific entries + (when (featurep 'tty) + (set-face-underline-p face t locale 'tty))) + (lambda () + ;; handle X specific entries + (frob-face-property face 'font 'x-make-font-italic locale)) '(([default] . [italic]) ([bold] . [bold-italic]) ([italic] . t) @@ -957,15 +956,14 @@ (interactive (list (read-face-name "Make which face bold-italic: "))) (frob-face-font-2 face locale 'default 'bold-italic - #'(lambda () - ;; handle TTY specific entries - (if (featurep 'tty) - (progn - (set-face-highlight-p face t locale 'tty) - (set-face-underline-p face t locale 'tty)))) - #'(lambda () - ;; handle X specific entries - (frob-face-property face 'font 'x-make-font-bold-italic locale)) + (lambda () + ;; handle TTY specific entries + (when (featurep 'tty) + (set-face-highlight-p face t locale 'tty) + (set-face-underline-p face t locale 'tty))) + (lambda () + ;; handle X specific entries + (frob-face-property face 'font 'x-make-font-bold-italic locale)) '(([default] . [italic]) ([bold] . [bold-italic]) ([italic] . [bold-italic]) @@ -980,13 +978,13 @@ (interactive (list (read-face-name "Make which face non-bold: "))) (frob-face-font-2 face locale 'bold 'default - #'(lambda () - ;; handle TTY specific entries - (if (featurep 'tty) - (set-face-highlight-p face nil locale 'tty))) - #'(lambda () - ;; handle X specific entries - (frob-face-property face 'font 'x-make-font-unbold locale)) + (lambda () + ;; handle TTY specific entries + (when (featurep 'tty) + (set-face-highlight-p face nil locale 'tty))) + (lambda () + ;; handle X specific entries + (frob-face-property face 'font 'x-make-font-unbold locale)) '(([default] . t) ([bold] . [default]) ([italic] . t) @@ -1001,13 +999,13 @@ (interactive (list (read-face-name "Make which face non-italic: "))) (frob-face-font-2 face locale 'italic 'default - #'(lambda () - ;; handle TTY specific entries - (if (featurep 'tty) - (set-face-underline-p face nil locale 'tty))) - #'(lambda () - ;; handle X specific entries - (frob-face-property face 'font 'x-make-font-unitalic locale)) + (lambda () + ;; handle TTY specific entries + (when (featurep 'tty) + (set-face-underline-p face nil locale 'tty))) + (lambda () + ;; handle X specific entries + (frob-face-property face 'font 'x-make-font-unitalic locale)) '(([default] . t) ([bold] . t) ([italic] . [default]) @@ -1097,10 +1095,8 @@ (defun init-device-faces (device) ;; First, add any device-local face resources. - (let ((faces (face-list))) - (while faces - (init-face-from-resources (car faces) device) - (setq faces (cdr faces)))) + (loop for face in (face-list) do + (init-face-from-resources face device)) ;; Then do any device-specific initialization. (cond ((eq 'x (device-type device)) (x-init-device-faces device)) @@ -1110,10 +1106,8 @@ (defun init-frame-faces (frame) ;; First, add any frame-local face resources. - (let ((faces (face-list))) - (while faces - (init-face-from-resources (car faces) frame) - (setq faces (cdr faces)))) + (loop for face in (face-list) do + (init-face-from-resources face frame)) ;; Then do any frame-specific initialization. (cond ((eq 'x (frame-type frame)) (x-init-frame-faces frame)) @@ -1128,33 +1122,28 @@ (defun init-global-faces () ;; Look for global face resources. - (let ((faces (face-list))) - (while faces - (init-face-from-resources (car faces) 'global) - (setq faces (cdr faces)))) + (loop for face in (face-list) do + (init-face-from-resources face 'global)) ;; Further X frobbing. (x-init-global-faces) ;; for bold and the like, make the global specification be bold etc. ;; if the user didn't already specify a value. These will also be ;; frobbed further in init-other-random-faces. - (or (face-font 'bold 'global) - (make-face-bold 'bold 'global)) + (unless (face-font 'bold 'global) + (make-face-bold 'bold 'global)) + ;; + (unless (face-font 'italic 'global) + (make-face-italic 'italic 'global)) ;; - (or (face-font 'italic 'global) - (make-face-italic 'italic 'global)) - ;; - (or (face-font 'bold-italic 'global) - (make-face-bold-italic 'bold-italic 'global)) + (unless (face-font 'bold-italic 'global) + (make-face-bold-italic 'bold-italic 'global) + (unless (face-font 'bold-italic 'global) + (copy-face 'bold 'bold-italic) + (make-face-italic 'bold-italic))) - (if (not (face-font 'bold-italic 'global)) - (progn - (copy-face 'bold 'bold-italic) - (make-face-italic 'bold-italic))) - - (if (face-equal 'bold 'bold-italic) - (progn - (copy-face 'italic 'bold-italic) - (make-face-bold 'bold-italic))) + (when (face-equal 'bold 'bold-italic) + (copy-face 'italic 'bold-italic) + (make-face-bold 'bold-italic)) ;; ;; Nothing more to be done for X or TTY's? ) @@ -1198,206 +1187,190 @@ ;; try to make 'bold look different from the default on this device. ;; If that doesn't work at all, then issue a warning. - (or (face-differs-from-default-p 'bold device) - (make-face-bold 'bold device)) - (or (face-differs-from-default-p 'bold device) - (make-face-unbold 'bold device)) - (or (face-differs-from-default-p 'bold device) - ;; otherwise the luser specified one of the bogus font names - (face-complain-about-font 'bold device)) + (unless (face-differs-from-default-p 'bold device) + (make-face-bold 'bold device) + (unless (face-differs-from-default-p 'bold device) + (make-face-unbold 'bold device) + (unless (face-differs-from-default-p 'bold device) + ;; the luser specified one of the bogus font names + (face-complain-about-font 'bold device)))) - ;; similar for italic. - (or (face-differs-from-default-p 'italic device) - (make-face-italic 'italic device)) - (or (face-differs-from-default-p 'italic device) - (progn - (make-face-bold 'italic device) ; bold if possible, then complain - (face-complain-about-font 'italic device))) + ;; Similar for italic. + ;; It's unreasonable to expect to be able to make a font italic all + ;; the time. For many languages, italic is an alien concept. + ;; Basically, because italic is not a globally meaningful concept, + ;; the use of the italic face should really be oboleted. + + ;; In a Solaris Japanese environment, there just aren't any italic + ;; fonts - period. CDE recognizes this reality, and fonts + ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come + ;; in italic versions. So we first try to make the font bold before + ;; complaining. + (unless (face-differs-from-default-p 'italic device) + (make-face-italic 'italic device) + (unless (face-differs-from-default-p 'italic device) + (make-face-bold 'italic device) + (unless (face-differs-from-default-p 'italic device) + (face-complain-about-font 'italic device)))) ;; similar for bold-italic. - (or (face-differs-from-default-p 'bold-italic device) - (make-face-bold-italic 'bold-italic device)) - ;; if we couldn't get a bold-italic version, try just bold. - (or (face-differs-from-default-p 'bold-italic device) - (make-face-bold-italic 'bold-italic device)) - ;; if we couldn't get bold or bold-italic, then that's probably because - ;; the default font is bold, so make the `bold-italic' face be unbold. - (or (face-differs-from-default-p 'bold-italic device) - (progn + (unless (face-differs-from-default-p 'bold-italic device) + (make-face-bold-italic 'bold-italic device) + ;; if we couldn't get a bold-italic version, try just bold. + (unless (face-differs-from-default-p 'bold-italic device) + (make-face-bold-italic 'bold-italic device) + ;; if we couldn't get bold or bold-italic, then that's probably because + ;; the default font is bold, so make the `bold-italic' face be unbold. + (unless (face-differs-from-default-p 'bold-italic device) (make-face-unbold 'bold-italic device) - (make-face-italic 'bold-italic device))) - (or (face-differs-from-default-p 'bold-italic device) - (progn - ;; if that didn't work, try italic (can this ever happen? what the hell.) (make-face-italic 'bold-italic device) - ;; then bitch and moan. - (face-complain-about-font 'bold-italic device))) + (unless (face-differs-from-default-p 'bold-italic device) + ;; if that didn't work, try plain italic + ;; (can this ever happen? what the hell.) + (make-face-italic 'bold-italic device) + (unless (face-differs-from-default-p 'bold-italic device) + ;; then bitch and moan. + (face-complain-about-font 'bold-italic device)))))) - ;; first time through, set the text-cursor colors if not already - ;; specified. - (if (and (not (face-background 'text-cursor 'global)) - (face-property-equal 'text-cursor 'default 'background device)) - (set-face-background 'text-cursor [default foreground] 'global - nil 'append)) - (if (and (not (face-foreground 'text-cursor 'global)) - (face-property-equal 'text-cursor 'default 'foreground device)) - (set-face-foreground 'text-cursor [default background] 'global - nil 'append)) + ;; Set the text-cursor colors unless already specified. + (when (and (not (face-background 'text-cursor 'global)) + (face-property-equal 'text-cursor 'default 'background device)) + (set-face-background 'text-cursor [default foreground] 'global + nil 'append)) + (when (and (not (face-foreground 'text-cursor 'global)) + (face-property-equal 'text-cursor 'default 'foreground device)) + (set-face-foreground 'text-cursor [default background] 'global + nil 'append)) - ;; first time through, set the secondary-selection color if it's not already - ;; specified. - (if (and (not (face-differs-from-default-p 'highlight device)) - (not (face-background 'highlight 'global))) - (progn - ;; some older servers don't recognize "darkseagreen2" - (set-face-background 'highlight - '((color . "darkseagreen2") - (color . "green")) - 'global nil 'append) - (set-face-background 'highlight "gray53" 'global 'grayscale 'append))) - (if (and (not (face-differs-from-default-p 'highlight device)) - (not (face-background-pixmap 'highlight 'global))) - (progn - (set-face-background-pixmap 'highlight [nothing] 'global 'color - 'append) - (set-face-background-pixmap 'highlight [nothing] 'global 'grayscale - 'append) - (set-face-background-pixmap 'highlight "gray1" 'global 'mono 'append))) + ;; Set the secondary-selection color unless already specified. + (unless (or (face-differs-from-default-p 'highlight device) + (face-background 'highlight 'global)) + ;; some older servers don't recognize "darkseagreen2" + (set-face-background 'highlight + '((color . "darkseagreen2") + (color . "green")) + 'global nil 'append) + (set-face-background 'highlight "gray53" 'global 'grayscale 'append)) + (unless (or (face-differs-from-default-p 'highlight device) + (face-background-pixmap 'highlight 'global)) + (set-face-background-pixmap 'highlight [nothing] 'global 'color 'append) + (set-face-background-pixmap 'highlight [nothing] 'global 'grayscale 'append) + (set-face-background-pixmap 'highlight "gray1" 'global 'mono 'append)) ;; if the highlight face isn't distinguished on this device, ;; at least try inverting it. - (or (face-differs-from-default-p 'highlight device) - (invert-face 'highlight device)) + (unless (face-differs-from-default-p 'highlight device) + (invert-face 'highlight device)) ;; first time through, set the zmacs-region color if it's not already ;; specified. - (if (and (not (face-differs-from-default-p 'zmacs-region device)) - (not (face-background 'zmacs-region 'global))) - (progn - (set-face-background 'zmacs-region "gray" 'global 'color) - (set-face-background 'zmacs-region "gray80" 'global 'grayscale))) - (if (and (not (face-differs-from-default-p 'zmacs-region device)) - (not (face-background-pixmap 'zmacs-region 'global))) - (progn - (set-face-background-pixmap 'zmacs-region [nothing] 'global 'color) - (set-face-background-pixmap 'zmacs-region [nothing] 'global 'grayscale) - (set-face-background-pixmap 'zmacs-region "gray3" 'global 'mono))) + (unless (or (face-differs-from-default-p 'zmacs-region device) + (face-background 'zmacs-region 'global)) + (set-face-background 'zmacs-region "gray" 'global 'color) + (set-face-background 'zmacs-region "gray80" 'global 'grayscale)) + (unless (or (face-differs-from-default-p 'zmacs-region device) + (face-background-pixmap 'zmacs-region 'global)) + (set-face-background-pixmap 'zmacs-region [nothing] 'global 'color) + (set-face-background-pixmap 'zmacs-region [nothing] 'global 'grayscale) + (set-face-background-pixmap 'zmacs-region "gray3" 'global 'mono)) ;; if the zmacs-region face isn't distinguished on this device, ;; at least try inverting it. - (or (face-differs-from-default-p 'zmacs-region device) - (invert-face 'zmacs-region device)) + (unless (face-differs-from-default-p 'zmacs-region device) + (invert-face 'zmacs-region device)) ;; first time through, set the list-mode-item-selected color if it's ;; not already specified. - (if (and (not (face-differs-from-default-p 'list-mode-item-selected device)) - (not (face-background 'list-mode-item-selected 'global))) - (progn - (set-face-background 'list-mode-item-selected "gray68" 'global 'color) - (set-face-background 'list-mode-item-selected "gray68" 'global - 'grayscale) - (if (not (face-foreground 'list-mode-item-selected 'global)) - (progn - (set-face-background 'list-mode-item-selected - [default foreground] 'global '(mono x)) - (set-face-foreground 'list-mode-item-selected - [default background] 'global '(mono x)))))) + (unless (or (face-differs-from-default-p 'list-mode-item-selected device) + (face-background 'list-mode-item-selected 'global)) + (set-face-background 'list-mode-item-selected "gray68" 'global 'color) + (set-face-background 'list-mode-item-selected "gray68" 'global 'grayscale) + (unless (face-foreground 'list-mode-item-selected 'global) + (set-face-background 'list-mode-item-selected + [default foreground] 'global '(mono x)) + (set-face-foreground 'list-mode-item-selected + [default background] 'global '(mono x)))) ;; if the list-mode-item-selected face isn't distinguished on this device, ;; at least try inverting it. - (or (face-differs-from-default-p 'list-mode-item-selected device) - (invert-face 'list-mode-item-selected device)) + (unless (face-differs-from-default-p 'list-mode-item-selected device) + (invert-face 'list-mode-item-selected device)) - ;; first time through, set the primary-selection color if it's not already - ;; specified. - (if (and (not (face-differs-from-default-p 'primary-selection device)) - (not (face-background 'primary-selection 'global))) - (progn - (set-face-background 'primary-selection "gray" 'global 'color) - (set-face-background 'primary-selection "gray80" 'global 'grayscale))) - (if (and (not (face-differs-from-default-p 'secondary-selection device)) - (not (face-background-pixmap 'primary-selection 'global))) - (set-face-background-pixmap 'primary-selection "gray3" 'global 'mono)) - ;; if the primary-selection face isn't distinguished on this device, + ;; Set the primary-selection color unless already specified. + (unless (or (face-differs-from-default-p 'primary-selection device) + (face-background 'primary-selection 'global)) + (set-face-background 'primary-selection "gray" 'global 'color) + (set-face-background 'primary-selection "gray80" 'global 'grayscale)) + (unless (or (face-differs-from-default-p 'secondary-selection device) + (face-background-pixmap 'primary-selection 'global)) + (set-face-background-pixmap 'primary-selection "gray3" 'global 'mono)) + ;; If the primary-selection face isn't distinguished on this device, ;; at least try inverting it. - (or (face-differs-from-default-p 'primary-selection device) - (invert-face 'primary-selection device)) + (unless (face-differs-from-default-p 'primary-selection device) + (invert-face 'primary-selection device)) - ;; first time through, set the secondary-selection color if it's not already - ;; specified. - (if (and (not (face-differs-from-default-p 'secondary-selection device)) - (not (face-background 'secondary-selection 'global))) - (progn - (set-face-background 'secondary-selection - '((color . "paleturquoise") - (color . "green")) - 'global) - (set-face-background 'secondary-selection "gray53" 'global - 'grayscale))) - (if (and (not (face-differs-from-default-p 'secondary-selection device)) - (not (face-background-pixmap 'secondary-selection 'global))) - (set-face-background-pixmap 'secondary-selection "gray1" 'global 'mono)) - ;; if the secondary-selection face isn't distinguished on this device, + ;; Set the secondary-selection color unless already specified. + (unless (or (face-differs-from-default-p 'secondary-selection device) + (face-background 'secondary-selection 'global)) + (set-face-background 'secondary-selection + '((color . "paleturquoise") + (color . "green")) + 'global) + (set-face-background 'secondary-selection "gray53" 'global + 'grayscale)) + (unless (or (face-differs-from-default-p 'secondary-selection device) + (face-background-pixmap 'secondary-selection 'global)) + (set-face-background-pixmap 'secondary-selection "gray1" 'global 'mono)) + ;; If the secondary-selection face isn't distinguished on this device, ;; at least try inverting it. - (or (face-differs-from-default-p 'secondary-selection device) - (invert-face 'secondary-selection device)) + (unless (face-differs-from-default-p 'secondary-selection device) + (invert-face 'secondary-selection device)) - ;; set the isearch color if it's not already specified. - (if (not (face-differs-from-default-p 'isearch device)) - (or (face-background 'isearch 'global) - ;; TTY's and some older X servers don't recognize "paleturquoise" - (set-face-background 'isearch - '((color . "paleturquoise") - (color . "green")) - 'global))) + ;; Set the isearch color if unless already specified. + (unless (or (face-differs-from-default-p 'isearch device) + (face-background 'isearch 'global)) + ;; TTY's and some older X servers don't recognize "paleturquoise" + (set-face-background 'isearch + '((color . "paleturquoise") + (color . "green")) + 'global)) ;; if the isearch face isn't distinguished (e.g. we're not on a color ;; display), at least try making it bold. - (or (face-differs-from-default-p 'isearch device) - (set-face-font 'isearch [bold])) + (unless (face-differs-from-default-p 'isearch device) + (set-face-font 'isearch [bold])) - ;; set the modeline face colors/fonts if not already specified. + ;; Set the modeline face colors/fonts unless already specified. ;; modeline-buffer-id: - (if (not (face-differs-from-default-p 'modeline-buffer-id device)) - (let ((fg (face-foreground 'modeline-buffer-id 'global)) - (font (face-font 'modeline-buffer-id 'global))) - (and (featurep 'x) - (or fg - (set-face-foreground 'modeline-buffer-id "blue" 'global - '(color x)))) - (if font - nil - (if (featurep 'x) - (progn - (set-face-font 'modeline-buffer-id [bold-italic] nil '(mono x)) - (set-face-font 'modeline-buffer-id [bold-italic] nil - '(grayscale x)))) - (if (featurep 'tty) - (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty))))) + (unless (face-differs-from-default-p 'modeline-buffer-id device) + (let ((fg (face-foreground 'modeline-buffer-id 'global)) + (font (face-font 'modeline-buffer-id 'global))) + (when (and (null fg) (featurep 'x)) + (set-face-foreground 'modeline-buffer-id "blue" 'global '(color x))) + (unless font + (when (featurep 'x) + (set-face-font 'modeline-buffer-id [bold-italic] nil '(mono x)) + (set-face-font 'modeline-buffer-id [bold-italic] nil '(grayscale x))) + (when (featurep 'tty) + (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty))))) (set-face-parent 'modeline-buffer-id 'modeline nil nil 'append) ;; modeline-mousable: - (if (not (face-differs-from-default-p 'modeline-mousable device)) - (let ((fg (face-foreground 'modeline-mousable 'global)) - (font (face-font 'modeline-mousable 'global))) - (and (featurep 'x) - (or fg - (set-face-foreground 'modeline-mousable "red" 'global - '(color x)))) - (if font - nil - (if (featurep 'x) - (progn - (set-face-font 'modeline-mousable [bold] nil '(mono x)) - (set-face-font 'modeline-mousable [bold] nil - '(grayscale x))))))) + (unless (face-differs-from-default-p 'modeline-mousable device) + (let ((fg (face-foreground 'modeline-mousable 'global)) + (font (face-font 'modeline-mousable 'global))) + (when (and (null fg) (featurep 'x)) + (set-face-foreground 'modeline-mousable "red" 'global '(color x))) + (unless font + (when (featurep 'x) + (set-face-font 'modeline-mousable [bold] nil '(mono x)) + (set-face-font 'modeline-mousable [bold] nil '(grayscale x)))))) (set-face-parent 'modeline-mousable 'modeline nil nil 'append) ;; modeline-mousable-minor-mode: - (if (not (face-differs-from-default-p 'modeline-mousable-minor-mode device)) - (let ((fg (face-foreground 'modeline-mousable-minor-mode 'global))) - (and (featurep 'x) - (or fg - (set-face-foreground 'modeline-mousable-minor-mode - '(((color x) . "green4") - ((color x) . "green")) 'global))))) + (unless (face-differs-from-default-p 'modeline-mousable-minor-mode device) + (let ((fg (face-foreground 'modeline-mousable-minor-mode 'global))) + (when (and (null fg) (featurep 'x)) + (set-face-foreground 'modeline-mousable-minor-mode + '(((color x) . "green4") + ((color x) . "green")) 'global)))) (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil nil 'append) ) @@ -1423,51 +1396,27 @@ (make-face 'primary-selection) (make-face 'secondary-selection) -(make-face 'red "red text") -(set-face-foreground 'red "red" nil 'color) -(make-face 'green "green text") -(set-face-foreground 'green "green" nil 'color) -(make-face 'blue "blue text") -(set-face-foreground 'blue "blue" nil 'color) -(make-face 'yellow "yellow text") -(set-face-foreground 'yellow "yellow" nil 'color) +(loop for color in '("red" "green" "blue" "yellow") do + (make-face (intern color) (concat color " text")) + (set-face-foreground (intern color) color nil 'color)) -;; ;; Make some useful faces. This happens very early, before creating ;; the first non-stream device. We initialize the tty global values here. ;; We cannot initialize the X global values here because they depend ;; on having already resourced the global face specs, which happens ;; when the first X device is created. -;; -(if (featurep 'tty) - (set-face-reverse-p 'modeline t 'global 'tty)) (set-face-background-pixmap 'modeline [nothing]) -;; -(if (featurep 'tty) - (set-face-highlight-p 'highlight t 'global 'tty)) -;; -(if (featurep 'tty) - (set-face-reverse-p 'text-cursor t 'global 'tty)) -;; -(if (featurep 'tty) - (set-face-highlight-p 'bold t 'global 'tty)) -;; -(if (featurep 'tty) - (set-face-underline-p 'italic t 'global 'tty)) -;; -(if (featurep 'tty) - (progn - (set-face-highlight-p 'bold-italic t 'global 'tty) - (set-face-underline-p 'bold-italic t 'global 'tty))) -;; -(if (featurep 'tty) - (set-face-reverse-p 'zmacs-region t 'global 'tty)) -;; -(if (featurep 'tty) - (set-face-reverse-p 'list-mode-item-selected t 'global 'tty)) -;; -(if (featurep 'tty) - (set-face-reverse-p 'isearch t 'global 'tty)) -;;; faces.el ends here +(when (featurep 'tty) + (set-face-highlight-p 'bold t 'global 'tty) + (set-face-underline-p 'italic t 'global 'tty) + (set-face-highlight-p 'bold-italic t 'global 'tty) + (set-face-underline-p 'bold-italic t 'global 'tty) + (set-face-highlight-p 'highlight t 'global 'tty) + (set-face-reverse-p 'text-cursor t 'global 'tty) + (set-face-reverse-p 'modeline t 'global 'tty) + (set-face-reverse-p 'zmacs-region t 'global 'tty) + (set-face-reverse-p 'list-mode-item-selected t 'global 'tty) + (set-face-reverse-p 'isearch t 'global 'tty) + )
--- a/lisp/prim/files-nomule.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/prim/files-nomule.el Mon Aug 13 09:09:02 2007 +0200 @@ -20,7 +20,7 @@ ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34 (files.el). +;;; Synched up with: FSF 19.34 (files.el). (Is it? Please check) ;;; Commentary: @@ -46,7 +46,7 @@ and (2) it puts less data in the undo list." (insert-file-contents-internal filename visit beg end replace nil nil)) -(defun write-region (start end filename &optional append visit lockname) +(defun write-region (start end filename &optional append visit lockname coding-system) "Write current region into specified file. When called from a program, takes three arguments: START, END and FILENAME. START and END are buffer positions. @@ -63,7 +63,12 @@ The optional sixth arg LOCKNAME, if non-nil, specifies the name to use for locking and unlocking, overriding FILENAME and VISIT. Kludgy feature: if START is a string, then that string is written -to the file, instead of any buffer contents, and END is ignored." +to the file, instead of any buffer contents, and END is ignored. +Optional seventh argument CODING-SYSTEM is meaningful only if support + for Mule is present in XEmacs and specifies the coding system + used to encode the text when it is written out, and defaults to + the value of `file-coding-system' in the current buffer. When Mule + support is not present, the CODING-SYSTEM argument is ignored." (interactive "r\nFWrite region to file: ") (write-region-internal start end filename append visit lockname nil))
--- a/lisp/psgml/ChangeLog Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/psgml/ChangeLog Mon Aug 13 09:09:02 2007 +0200 @@ -1,3 +1,7 @@ +Mon Jan 27 13:12:41 1997 Jin S. Choi <jsc@atype.com> + + * psgml.el: Fix location of CATALOG in `sgml-validate-command'. + Thu Jan 16 18:23:51 1997 Steven L Baur <steve@miranova.com> * psgml.el: Use newer interface form of nsgmls.
--- a/lisp/psgml/psgml.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/psgml/psgml.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,5 +1,5 @@ ;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 1.4 1997/01/26 00:21:43 steve Exp $ +;; $Id: psgml.el,v 1.5 1997/01/30 02:22:44 steve Exp $ ;; Copyright (C) 1993, 1994, 1995, 1996 Lennart Staflin ;; Copyright (C) 1992 Free Software Foundation, Inc. @@ -443,8 +443,8 @@ ;;; The -s option suppresses output. (defvar sgml-validate-command (concat "nsgmls -s -m " - data-directory - "CATALOG %s %s") + sgml-data-directory + "/CATALOG %s %s") "*The shell command to validate an SGML document. This is a `format' control string that by default should contain two
--- a/lisp/rmail/rmail.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/rmail/rmail.el Mon Aug 13 09:09:02 2007 +0200 @@ -193,6 +193,104 @@ (set-buffer rmail-summary-buffer) (progn (,@ body)))) (rmail-maybe-display-summary)))) + + +;;; 1996/12/9 by MORIOKA Tomohiko <morioka@jaist.ac.jp> + +;;; @ for mule and MIME +;;; + +(require 'tm-view) + +(defconst rmail-support-mime t) +(defvar rmail-show-mime t) +(defvar rmail-show-mime-method (function rmail-show-mime-message)) + +(defun rmail-show-all-header () + (rmail-maybe-set-message-counters) + (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (forward-line 1) + (if (= (following-char) ?1) + (progn + (delete-char 1) + (insert ?0) + (forward-line 1) + (let ((case-fold-search t)) + (while (looking-at "Summary-Line:\\|Mail-From:") + (forward-line 1))) + (insert "*** EOOH ***\n") + (forward-char -1) + (search-forward "\n*** EOOH ***\n") + (forward-line -1) + (let ((temp (point))) + (and (search-forward "\n\n" nil t) + (delete-region temp (point)))) + (goto-char (point-min)) + (search-forward "\n*** EOOH ***\n") + (narrow-to-region (point) (point-max))) + ))) + +(defun rmail-show-mime-message () + (rmail-show-all-header) + (let ((abuf (current-buffer)) + (buf-name (format "*Preview-%s [%d/%d]*" + (buffer-name) + rmail-current-message rmail-total-messages)) + buf win) + (if (and mime::article/preview-buffer + (setq buf (get-buffer mime::article/preview-buffer)) + ) + (progn + (save-excursion + (set-buffer buf) + (rename-buffer buf-name) + ) + (if (setq win (get-buffer-window buf)) + (progn + (delete-window (get-buffer-window abuf)) + (set-window-buffer win abuf) + (set-buffer abuf) + )) + )) + (setq win (get-buffer-window abuf)) + (save-window-excursion + (mime/viewer-mode nil nil nil nil buf-name rmail-mode-map) + (or buf + (setq buf (current-buffer)) + ) + ) + (set-window-buffer win buf) + )) + +(set-alist 'mime-viewer/code-converter-alist + 'rmail-mode + (function mime-charset/decode-buffer)) + +(set-alist 'mime-viewer/quitting-method-alist + 'rmail-mode + (function rmail-quit) + ) + +(set-alist 'mime-viewer/over-to-previous-method-alist + 'rmail-mode + (function + (lambda () + (rmail-previous-undeleted-message 1) + ))) + +(set-alist 'mime-viewer/over-to-next-method-alist + 'rmail-mode + (function + (lambda () + (rmail-next-undeleted-message 1) + ))) + +(set-alist 'mime-viewer/show-summary-method + 'rmail-mode + (function rmail-summary)) + ;;;; *** Rmail Mode *** @@ -633,7 +731,16 @@ (defun rmail-quit () "Quit out of RMAIL." (interactive) - (rmail-expunge-and-save) + (if (eq major-mode 'mime/viewer-mode) + (let ((buf mime::preview/article-buffer) + (pbuf (current-buffer)) + ) + (switch-to-buffer buf) + (bury-buffer pbuf) + )) + (let (rmail-show-mime) + (rmail-expunge-and-save) + ) ;; Don't switch to the summary buffer even if it was recently visible. (if (rmail-summary-exists) (bury-buffer rmail-summary-buffer)) @@ -843,30 +950,33 @@ ;; At first, read the file without converting coding-system. (setq size (nth 1 (let (file-coding-system-for-read) (insert-file-contents tofile)))) + ;; 1996/12/9 by MORIOKA Tomohiko <morioka@jaist.ac.jp> + ;; Don't code-convert for RMAIL file ;; Then, convert the contents if necessary. - (if (> size 0) - (cond - ((looking-at "^From ") - ;; New mails. Since the contents may be a mixture - ;; of various coding-systems, we must decode one - ;; mail by one. - (while (null (eobp)) - (let ((from (point))) - (re-search-forward "^From " nil 'mv) - (rmail-decode-coding-system from (point))))) - ((looking-at "BABYL OPTIONS:\\|\^L") - ;; Babyl format, i.e. not a new mail. We had better - ;; not to convert large region at once. - (while (null (eobp)) - (let ((max-size (* 1024 1024)) - (from (point))) - (goto-char (+ from max-size)) - (re-search-forward "\^_" nil 'mv) - (rmail-decode-coding-system from (point))))) - (t - ;; Perhaps, MMDF format. Since I don't know how to - ;; deal with it, convert all data at once. - (rmail-decode-coding-system (point) (point-max)))))) + ;; (if (> size 0) + ;; (cond + ;; ((looking-at "^From ") + ;; ;; New mails. Since the contents may be a mixture + ;; ;; of various coding-systems, we must decode one + ;; ;; mail by one. + ;; (while (null (eobp)) + ;; (let ((from (point))) + ;; (re-search-forward "^From " nil 'mv) + ;; (rmail-decode-coding-system from (point))))) + ;; ((looking-at "BABYL OPTIONS:\\|\^L") + ;; ;; Babyl format, i.e. not a new mail. We had better + ;; ;; not to convert large region at once. + ;; (while (null (eobp)) + ;; (let ((max-size (* 1024 1024)) + ;; (from (point))) + ;; (goto-char (+ from max-size)) + ;; (re-search-forward "\^_" nil 'mv) + ;; (rmail-decode-coding-system from (point))))) + ;; (t + ;; ;; Perhaps, MMDF format. Since I don't know how to + ;; ;; deal with it, convert all data at once. + ;; (rmail-decode-coding-system (point) (point-max))))) + ) (goto-char (point-max)) (or (= (preceding-char) ?\n) (zerop size) @@ -876,34 +986,34 @@ (setq files (cdr files))) delete-files)) -(if (not (featurep 'mule)) nil - -(defvar mail-coding-system '*junet*) - -(defun rmail-decode-coding-system (from to) - (let (coding-system) - ;; At first, detect the coding-system of the region and set it to - ;; `coding-sytem'. - (let ((detected-coding-system (code-detect-region from to)) - (coding (get-code mail-coding-system))) - (if (listp detected-coding-system) - ;; Something other than ASCII was found. If a coding-system - ;; of which information is same as `mail-coding-system' is - ;; in the list of detected coding-systems, use it, else use - ;; the coding-system of the highest priority in the list. - (let ((l detected-coding-system)) - (while (and l - (null (eq (get-code (car l)) coding))) - (setq l (cdr l))) - (setq coding-system (car (or l detected-coding-system)))))) - ;; Then, decode the region. - (if coding-system - (save-restriction - (narrow-to-region from to) - (code-convert from to coding-system '*internal*) - (goto-char (point-max)))))) - -) ; (featurep 'mule) +;; (if (not (featurep 'mule)) nil +;; +;; (defvar mail-coding-system '*junet*) +;; +;; (defun rmail-decode-coding-system (from to) +;; (let (coding-system) +;; ;; At first, detect the coding-system of the region and set it to +;; ;; `coding-sytem'. +;; (let ((detected-coding-system (code-detect-region from to)) +;; (coding (get-code mail-coding-system))) +;; (if (listp detected-coding-system) +;; ;; Something other than ASCII was found. If a coding-system +;; ;; of which information is same as `mail-coding-system' is +;; ;; in the list of detected coding-systems, use it, else use +;; ;; the coding-system of the highest priority in the list. +;; (let ((l detected-coding-system)) +;; (while (and l +;; (null (eq (get-code (car l)) coding))) +;; (setq l (cdr l))) +;; (setq coding-system (car (or l detected-coding-system)))))) +;; ;; Then, decode the region. +;; (if coding-system +;; (save-restriction +;; (narrow-to-region from to) +;; (code-convert from to coding-system '*internal*) +;; (goto-char (point-max)))))) +;; +;; ) ; (featurep 'mule) ;; the rmail-break-forwarded-messages feature is not implemented (defun rmail-convert-to-babyl-format () @@ -1184,35 +1294,43 @@ ;; ATTR is the name of the attribute, as a string. ;; MSGNUM is message number to change; nil means current message. (defun rmail-set-attribute (attr state &optional msgnum) - (let ((omax (point-max-marker)) - (omin (point-min-marker)) - (buffer-read-only nil)) - (or msgnum (setq msgnum rmail-current-message)) - (if (> msgnum 0) - (unwind-protect - (save-excursion - (widen) - (goto-char (+ 3 (rmail-msgbeg msgnum))) - (let ((curstate - (not - (null (search-backward (concat ", " attr ",") - (prog1 (point) (end-of-line)) t))))) - (or (eq curstate (not (not state))) - (if curstate - (delete-region (point) (1- (match-end 0))) - (beginning-of-line) - (forward-char 2) - (insert " " attr ",")))) - (if (string= attr "deleted") - (rmail-set-message-deleted-p msgnum state))) - ;; Note: we don't use save-restriction because that does not work right - ;; if changes are made outside the saved restriction - ;; before that restriction is restored. - (narrow-to-region omin omax) - (set-marker omin nil) - (set-marker omax nil) - (if (= msgnum rmail-current-message) - (rmail-display-labels)))))) + (let ((the-buf (current-buffer))) + (if (eq major-mode 'mime/viewer-mode) + (switch-to-buffer mime::preview/article-buffer) + ) + (let ((omax (point-max-marker)) + (omin (point-min-marker)) + (buffer-read-only nil)) + (or msgnum (setq msgnum rmail-current-message)) + (if (> msgnum 0) + (unwind-protect + (save-excursion + (widen) + (goto-char (+ 3 (rmail-msgbeg msgnum))) + (let ((curstate + (not + (null (search-backward (concat ", " attr ",") + (prog1 (point) + (end-of-line)) t))))) + (or (eq curstate (not (not state))) + (if curstate + (delete-region (point) (1- (match-end 0))) + (beginning-of-line) + (forward-char 2) + (insert " " attr ",")))) + (if (string= attr "deleted") + (rmail-set-message-deleted-p msgnum state))) + ;; Note: we don't use save-restriction + ;; because that does not work right + ;; if changes are made outside the saved restriction + ;; before that restriction is restored. + (narrow-to-region omin omax) + (set-marker omin nil) + (set-marker omax nil) + (if (= msgnum rmail-current-message) + (rmail-display-labels))))) + (switch-to-buffer the-buf) + )) ;; Return t if the attributes/keywords line of msg number MSG ;; contains a match for the regexp LABELS. @@ -1358,6 +1476,9 @@ "Show message number N (prefix argument), counting from start of file. If summary buffer is currently displayed, update current message there also." (interactive "p") + (if (eq major-mode 'mime/viewer-mode) + (switch-to-buffer mime::preview/article-buffer) + ) (rmail-maybe-set-message-counters) (widen) (if (zerop rmail-total-messages) @@ -1389,6 +1510,9 @@ (narrow-to-region (point) end)) (goto-char (point-min)) (rmail-display-labels) + (if rmail-show-mime + (funcall rmail-show-mime-method) + ) (run-hooks 'rmail-show-message-hook) ;; If there is a summary buffer, try to move to this message ;; in that buffer. But don't complain if this message @@ -1404,6 +1528,9 @@ "Show following message whether deleted or not. With prefix arg N, moves forward N messages, or backward if N is negative." (interactive "p") + (if (eq major-mode 'mime/viewer-mode) + (switch-to-buffer mime::preview/article-buffer) + ) (rmail-maybe-set-message-counters) (rmail-show-message (+ rmail-current-message n))) @@ -1411,7 +1538,7 @@ "Show previous message whether deleted or not. With prefix arg N, moves backward N messages, or forward if N is negative." (interactive "p") - (rmail-next-message (- n))) + (rmail-next-message (- n))) (defun rmail-next-undeleted-message (n) "Show following non-deleted message. @@ -1420,25 +1547,30 @@ Returns t if a new message is being shown, nil otherwise." (interactive "p") - (rmail-maybe-set-message-counters) - (let ((lastwin rmail-current-message) - (current rmail-current-message)) - (while (and (> n 0) (< current rmail-total-messages)) - (setq current (1+ current)) - (if (not (rmail-message-deleted-p current)) - (setq lastwin current n (1- n)))) - (while (and (< n 0) (> current 1)) - (setq current (1- current)) - (if (not (rmail-message-deleted-p current)) - (setq lastwin current n (1+ n)))) - (if (/= lastwin rmail-current-message) - (progn (rmail-show-message lastwin) - t) - (if (< n 0) - (message "No previous nondeleted message")) - (if (> n 0) - (message "No following nondeleted message")) - nil))) + (let ((the-buf (current-buffer))) + (if (eq major-mode 'mime/viewer-mode) + (switch-to-buffer mime::preview/article-buffer) + ) + (rmail-maybe-set-message-counters) + (let ((lastwin rmail-current-message) + (current rmail-current-message)) + (while (and (> n 0) (< current rmail-total-messages)) + (setq current (1+ current)) + (if (not (rmail-message-deleted-p current)) + (setq lastwin current n (1- n)))) + (while (and (< n 0) (> current 1)) + (setq current (1- current)) + (if (not (rmail-message-deleted-p current)) + (setq lastwin current n (1+ n)))) + (if (/= lastwin rmail-current-message) + (progn (rmail-show-message lastwin) + t) + (if (< n 0) + (message "No previous nondeleted message")) + (if (> n 0) + (message "No following nondeleted message")) + (switch-to-buffer the-buf) + nil)))) (defun rmail-previous-undeleted-message (n) "Show previous non-deleted message. @@ -1743,7 +1875,12 @@ (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) (rmail-show-message (if (zerop rmail-current-message) 1 nil)) - (forward-char opoint)))) + ;; 1996/12/9 by MORIOKA Tomohiko <morioka@jaist.ac.jp> + ;; to avoid error but it is quit bad way + (if (> (+ (point) opoint)(point-max)) + (goto-char (point-max)) + (forward-char opoint) + )))) (defun rmail-expunge () "Erase deleted messages from Rmail file and summary buffer."
--- a/lisp/rmail/rmailout.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/rmail/rmailout.el Mon Aug 13 09:09:02 2007 +0200 @@ -62,12 +62,14 @@ ;; If not suggestions, use same file as last time. (or answer rmail-last-rmail-file)))) (list (setq rmail-last-rmail-file - (read-file-name - (concat "Output message to Rmail file: (default " - (file-name-nondirectory default-file) - ") ") - (file-name-directory default-file) - default-file)) + (if default-file + (read-file-name + (concat "Output message to Rmail file: (default " + (file-name-nondirectory default-file) + ") ") + (file-name-directory default-file) + default-file) + (read-file-name "Output message to Rmail file: "))) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) (setq file-name
--- a/lisp/rmail/rmailsum.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/rmail/rmailsum.el Mon Aug 13 09:09:02 2007 +0200 @@ -141,6 +141,13 @@ For each message, FUNCTION is applied to the message number and ARGS... and if the result is non-nil, that message is included. nil for FUNCTION means all messages." + (if (eq major-mode 'mime/viewer-mode) + (let ((buf mime::preview/article-buffer) + (pbuf (current-buffer)) + ) + (switch-to-buffer buf) + (bury-buffer pbuf) + )) (message "Computing summary lines...") (let (sumbuf mesg was-in-summary) (save-excursion
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/tl/char-table.el Mon Aug 13 09:09:02 2007 +0200 @@ -0,0 +1,152 @@ +;;; char-table.el --- display table of charset + +;; Copyright (C) 1996,1997 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: $Id: char-table.el,v 1.1 1997/01/30 02:27:29 steve Exp $ +;; Keywords: character, Emacs/mule + +;; This file is not part of tl (Tiny Library). + +;; This program 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. + +;; This program 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. + +;;; Code: + +(require 'char-util) + +(defun char-position-to-string (charset r l &optional plane) + (char-to-string + (if plane + (make-character charset plane (row-line-to-char r l)) + (make-character charset (row-line-to-char r l)) + ))) + +(defun char-table-1 (charset r l plane) + (let ((str (char-position-to-string charset r l plane))) + (concat + (let ((i 0) + (len (- 3 (string-columns str))) + (dest "")) + (while (< i len) + (setq dest (concat dest " ")) + (setq i (1+ i)) + ) + dest) str))) + +(defun show-94-table (charset &optional plane ofs) + (if (null ofs) + (setq ofs 0) + ) + (princ "======================================================\n") + (princ (format + "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n" + (or plane 0))) + (princ "-----+------------------------------------------------\n") + (let ((j 2)) + (princ (format "%2x%x : " (or plane 0) (* (+ j ofs) 16))) + (let ((k 1)) + (while (< k 16) + (princ (char-table-1 charset j k plane)) + (setq k (+ k 1)) + ) + (princ "\n") + ) + (setq j 3) + (while (< j 7) + (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) + (let ((k 0)) + (while (< k 16) + (princ (char-table-1 charset j k plane)) + (setq k (+ k 1)) + ) + (princ "\n") + ) + (setq j (+ j 1)) + ) + (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) + (let ((k 0)) + (while (< k 15) + (princ (char-table-1 charset j k plane)) + (setq k (+ k 1)) + ) + (princ "\n") + ) + )) + +(defun show-96-table (charset &optional plane ofs) + (if (null ofs) + (setq ofs 0) + ) + (princ "======================================================\n") + (princ (format + "[%3x]: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F\n" + (or plane 0))) + (princ "-----+------------------------------------------------\n") + (let ((j 2)) + (while (< j 8) + (princ (format "%2x%x :" (or plane 0) (* (+ j ofs) 16))) + (let ((k 0)) + (while (< k 16) + (princ (char-table-1 charset j k plane)) + (setq k (+ k 1)) + ) + (princ "\n") + ) + (setq j (1+ j)) + ))) + +(defun show-94x94-table (charset) + (let ((i 33)) + (while (< i 127) + (show-94-table charset i) + (setq i (1+ i)) + ))) + +(defun show-96x96-table (charset) + (let ((i 32)) + (while (< i 128) + (show-96-table charset i) + (setq i (1+ i)) + ))) + +(defun show-char-table (charset) + (let ((cc (charset-chars charset)) + (cd (charset-dimension charset)) + ) + (cond ((= cd 1) + (cond ((= cc 94) + (show-94-table charset) + ) + ((= cc 96) + (show-96-table charset) + )) + ) + ((= cd 2) + (cond ((= cc 94) + (show-94x94-table charset) + ) + ((= cc 96) + (show-96x96-table charset) + )) + )))) + + +;;; @ end +;;; + +(provide 'char-table) + +;;; char-table.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/tl/char-util.el Mon Aug 13 09:09:02 2007 +0200 @@ -0,0 +1,94 @@ +;;; char-util.el --- character utility + +;; Copyright (C) 1996,1997 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: $Id: char-util.el,v 1.1 1997/01/30 02:27:29 steve Exp $ +;; Keywords: character, Emacs/mule + +;; This file is not part of tl (Tiny Library). + +;; This program 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. + +;; This program 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. + +;;; Code: + +(defun row-line-to-char (r l) + (int-char (+ (* r 16) l)) + ) + +(defun row-line-to-string (r l) + (char-to-string (row-line-to-char r l)) + ) + +(defun print-row-line (r l) + (interactive (and (looking-at "\\([0-9]+\\)/\\([0-9]+\\)") + (list (string-to-number + (buffer-substring (match-beginning 1) + (match-end 1))) + (string-to-number + (buffer-substring (match-beginning 2) + (match-end 2))) + ))) + (message (row-line-to-string r l)) + ) + +(defun char-to-row-line-form (chr) + (setq chr (char-int chr)) + (format "%d/%d" (/ chr 16)(mod chr 16)) + ) + +(defun char-to-byte-list (chr) + (let ((rest (mapcar (function identity) + (char-to-string chr)) + )) + (if (cdr rest) + (cons (car rest) + (mapcar (lambda (byte) + (logand byte 127) + ) + (cdr rest))) + (cons 'ascii rest) + ))) + +(defun char-to-row-cell-form (chr) + (let ((cl (char-to-byte-list chr))) + (if (= (length cl) 2) + (char-to-row-line-form (nth 1 cl)) + (format "%02d-%02d" (- (nth 1 cl) 32)(- (nth 2 cl) 32)) + ))) + +(defun show-char-info (char) + (interactive (list (char-after (point)))) + (let ((cl (char-to-byte-list char))) + (message (format "%s: %s %s" + (charset-description (car cl)) + (mapconcat (lambda (byte) + (format "%02x" byte) + ) + (cdr cl) "") + (if (= (length cl) 2) + (char-to-row-line-form (nth 1 cl)) + (format "%02d-%02d" (- (nth 1 cl) 32)(- (nth 2 cl) 32)) + ) + )))) + + +;;; @ end +;;; + +(provide 'char-util) + +;;; char-util.el ends here
--- a/lisp/tl/emu-x20.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tl/emu-x20.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,13 +1,12 @@ ;;; emu-x20.el --- emu API implementation for XEmacs 20 with mule -;; Copyright (C) 1995 Free Software Foundation, Inc. -;; Copyright (C) 1994,1995,1996 MORIOKA Tomohiko +;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Id: emu-x20.el,v 1.2 1997/01/23 05:29:40 steve Exp $ +;; Version: $Id: emu-x20.el,v 1.3 1997/01/30 02:22:46 steve Exp $ ;; Keywords: emulation, compatibility, Mule, XEmacs -;; This file is part of tl (Tiny Library). +;; This file is part of XEmacs. ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -36,28 +35,6 @@ ))) -;;; @ graphic character set -;;; - -(defalias 'charset-description 'charset-doc-string) - -(defalias 'find-charset-string 'charsets-in-string) -(defalias 'find-charset-region 'charsets-in-region) - -(defun find-non-ascii-charset-string (string) - "Return a list of charsets in the STRING except ascii. -\[emu-x20.el; Mule emulating function]" - (delq 'ascii (charsets-in-string string)) - ) - -(defun find-non-ascii-charset-region (start end) - "Return a list of charsets except ascii -in the region between START and END. -\[emu-x20.el; Mule emulating function]" - (delq 'ascii (charsets-in-region start end)) - ) - - ;;; @ coding-system ;;; @@ -96,30 +73,42 @@ ((ascii greek-iso8859-7) . iso-8859-7) ((ascii hebrew-iso8859-8) . iso-8859-8) ((ascii latin-iso8859-9) . iso-8859-9) - ((ascii japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) + ((ascii latin-jisx0201 + japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) ((ascii korean-ksc5601) . euc-kr) - ((ascii chinese-big5-1 chinese-big5-2) . big5) - ((ascii japanese-jisx0208-1978 chinese-gb - japanese-jisx0208 korean-ksc5601 - japanese-jisx0212 latin-iso8859-1 - greek-iso8859-7) . iso-2022-jp-2) - ((ascii japanese-jisx0208-1978 chinese-gb2312 - japanese-jisx0208 korean-ksc5601 - japanese-jisx0212 + ((ascii chinese-gb2312) . cn-gb-2312) + ((ascii chinese-big5-1 chinese-big5-2) . cn-big5) + ((ascii latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2) + ((ascii latin-iso8859-1 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 + chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1) + ((ascii latin-iso8859-1 latin-iso8859-2 + cyrillic-iso8859-5 greek-iso8859-7 + latin-jisx0201 japanese-jisx0208-1978 + chinese-gb2312 japanese-jisx0208 + korean-ksc5601 japanese-jisx0212 chinese-cns11643-1 chinese-cns11643-2 - latin-iso8859-1 greek-iso8859-7) . iso-2022-int-1) + chinese-cns11643-3 chinese-cns11643-4 + chinese-cns11643-5 chinese-cns11643-6 + chinese-cns11643-7) . iso-2022-int-1) )) -(defvar default-mime-charset 'iso-2022-int-1) +(defvar default-mime-charset 'x-ctext) (defvar mime-charset-coding-system-alist - '((iso-8859-1 . ctext) - (gb2312 . euc-china) - (koi8-r . koi8) - (iso-2022-jp-2 . iso-2022-ss2-7) - (x-iso-2022-jp-2 . iso-2022-ss2-7) - (shift_jis . sjis) - (x-shiftjis . sjis) + '((iso-8859-1 . ctext) + (x-ctext . ctext) + (hz-gb-2312 . hz) + (cn-gb-2312 . euc-china) + (gb2312 . euc-china) + (cn-big5 . big5) + (koi8-r . koi8) + (iso-2022-jp-2 . iso-2022-ss2-7) )) (defun mime-charset-to-coding-system (charset) @@ -170,24 +159,24 @@ ;;; @ character ;;; -;(defun char-bytes (chr) 1) +;; (defun char-bytes (chr) 1) -;(defun char-length (character) -; "Return number of elements a CHARACTER occupies in a string or buffer. -;\[emu-x20.el]" -; 1) +;; (defun char-length (character) +;; "Return number of elements a CHARACTER occupies in a string or buffer. +;; \[emu-x20.el]" +;; 1) -;(defun char-columns (character) -; "Return number of columns a CHARACTER occupies when displayed. -;\[emu-x20.el]" -; (charset-columns (char-charset character)) -; ) +;; (defun char-columns (character) +;; "Return number of columns a CHARACTER occupies when displayed. +;; \[emu-x20.el]" +;; (charset-columns (char-charset character)) +;; ) ;;; @@ Mule emulating aliases ;;; ;;; You should not use them. -;(defalias 'char-width 'char-columns) +;;(defalias 'char-width 'char-columns) (defalias 'char-leading-char 'char-charset) @@ -206,34 +195,34 @@ ;;; @ string ;;; -;(defun string-columns (string) -; "Return number of columns STRING occupies when displayed. -;\[emu-x20.el]" -; (let ((col 0) -; (len (length string)) -; (i 0)) -; (while (< i len) -; (setq col (+ col (char-columns (aref string i)))) -; (setq i (1+ i)) -; ) -; col)) +;; (defun string-columns (string) +;; "Return number of columns STRING occupies when displayed. +;; \[emu-x20.el]" +;; (let ((col 0) +;; (len (length string)) +;; (i 0)) +;; (while (< i len) +;; (setq col (+ col (char-columns (aref string i)))) +;; (setq i (1+ i)) +;; ) +;; col)) -;(defalias 'string-width 'string-columns) +;;(defalias 'string-width 'string-columns) (defun string-to-int-list (str) (mapcar #'char-int str) ) -;(defalias 'sref 'aref) +;;(defalias 'sref 'aref) -;(defun truncate-string (str width &optional start-column) -; "Truncate STR to fit in WIDTH columns. -;Optional non-nil arg START-COLUMN specifies the starting column. -;\[emu-x20.el; Mule 2.3 emulating function]" -; (or start-column -; (setq start-column 0)) -; (substring str start-column width) -; ) +;; (defun truncate-string (str width &optional start-column) +;; "Truncate STR to fit in WIDTH columns. +;; Optional non-nil arg START-COLUMN specifies the starting column. +;; \[emu-x20.el; Mule 2.3 emulating function]" +;; (or start-column +;; (setq start-column 0)) +;; (substring str start-column width) +;; ) ;;; @ end
--- a/lisp/tl/emu.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tl/emu.el Mon Aug 13 09:09:02 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Id: emu.el,v 1.2 1997/01/03 03:10:29 steve Exp $ +;; Version: $Id: emu.el,v 1.3 1997/01/30 02:22:46 steve Exp $ ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs ;; This file is part of emu. @@ -141,9 +141,8 @@ ;;; @ EMACS 19.29 emulation ;;; -; XEmacs: this causes a strange message at DOC file generation time. -;(defvar path-separator ":" -; "Character used to separate concatenated paths.") +(defvar path-separator ":" + "Character used to separate concatenated paths.") (defun-maybe buffer-substring-no-properties (beg end) "Return the text from BEG to END, without text properties, as a string.
--- a/lisp/tl/file-detect.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tl/file-detect.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,10 +1,10 @@ ;;; file-detect.el --- Emacs Lisp file detection utility -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Version: -;; $Id: file-detect.el,v 1.2 1996/12/28 21:03:09 steve Exp $ +;; $Id: file-detect.el,v 1.3 1997/01/30 02:22:46 steve Exp $ ;; Keywords: install, module ;; This file is part of tl (Tiny Library). @@ -65,6 +65,18 @@ )) ))) +(defun add-latest-path (pattern &optional all-paths) + "Add latest path matched by PATTERN to `load-path' +if it exists under `default-load-path' directories +and it does not exist in `load-path'. + +If optional argument ALL-PATHS is specified, it is searched from all +of load-path instead of default-load-path. [file-detect.el]" + (let ((path (get-latest-path pattern all-paths))) + (if path + (add-to-list 'load-path path) + ))) + (defun get-latest-path (pat &optional all-paths) "Return latest directory in default-load-path which is matched to regexp PAT.
--- a/lisp/tl/tl-str.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tl/tl-str.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,10 +1,9 @@ ;;; tl-str.el --- Emacs Lisp Library module about string -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: -;; $Id: tl-str.el,v 1.2 1997/01/23 05:29:41 steve Exp $ +;; Version: $Id: tl-str.el,v 1.3 1997/01/30 02:22:47 steve Exp $ ;; Keywords: string ;; This file is part of tl (Tiny Library). @@ -207,7 +206,8 @@ filename)) (autoload 'replace-as-filename "filename" - "Return safety filename from STRING. [filename.el]") + "Return safety filename from STRING.") + ;;; @ symbol ;;;
--- a/lisp/tm/mime-setup.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tm/mime-setup.el Mon Aug 13 09:09:02 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Version: -;; $Id: mime-setup.el,v 1.3 1997/01/03 03:10:30 steve Exp $ +;; $Id: mime-setup.el,v 1.4 1997/01/30 02:22:47 steve Exp $ ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word ;; This file is part of tm (Tools for MIME). @@ -28,8 +28,8 @@ (require 'tm-setup) -;(autoload 'mime/editor-mode "tm-edit" -; "Minor mode for editing MIME message." t) +(autoload 'mime/editor-mode "tm-edit" + "Minor mode for editing MIME message." t) (autoload 'mime/decode-message-header "tm-ew-d" "Decode MIME encoded-words in message header." t)
--- a/lisp/tm/tm-def.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tm/tm-def.el Mon Aug 13 09:09:02 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Id: tm-def.el,v 1.2 1996/12/28 21:03:13 steve Exp $ +;; Version: $Id: tm-def.el,v 1.3 1997/01/30 02:22:47 steve Exp $ ;; Keywords: mail, news, MIME, multimedia, definition ;; This file is part of tm (Tools for MIME). @@ -111,6 +111,9 @@ (defvar tm:mouse-face 'highlight "Face used for MIME-preview buffer mouse highlighting. [tm-def.el]") +(defvar tm:warning-face nil + "Face used for invalid encoded-word.") + (defun tm:add-button (from to func &optional data) "Create a button between FROM and TO with callback FUNC and data DATA." (and tm:button-face @@ -183,7 +186,7 @@ ;;; @@ Base64 ;;; -(defconst base64-token-regexp "[A-Za-z0-9+/=]") +(defconst base64-token-regexp "[A-Za-z0-9+/]") (defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") (defconst mime/B-encoded-text-regexp
--- a/lisp/tm/tm-edit.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tm/tm-edit.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,12 +1,12 @@ ;;; tm-edit.el --- Simple MIME Composer for GNU Emacs -;; Copyright (C) 1993 .. 1996 Free Software Foundation, Inc. +;; Copyright (C) 1993,1994,1995,1996,1997 Free Software Foundation, Inc. ;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1994/08/21 renamed from mime.el -;; Version: $Revision: 1.5 $ +;; Version: $Revision: 1.6 $ ;; Keywords: mail, news, MIME, multimedia, multilingual ;; This file is part of tm (Tools for MIME). @@ -41,8 +41,8 @@ ;; resulted in RFC 1468 (ISO-2022-JP charset for MIME). In order to ;; enable multilingual capability in single text message in MIME, ;; charset of multilingual text written in Mule is declared as either -;; `ISO-2022-JP-2' [RFC 1554] or `ISO-2022-INT-1'. Mule is required -;; for reading the such messages. +;; `ISO-2022-JP-2' [RFC 1554]. Mule is required for reading the such +;; messages. ;; This MIME composer can work with Mail mode, mh-e letter Mode, and ;; News mode. First of all, you need the following autoload @@ -96,6 +96,7 @@ ;; This is also a plain text. But, it is explicitly specified as is. ;; ;;--[[text/plain; charset=ISO-2022-JP]] +;; $(B$3$l$O(B charset $(B$r(B ISO-2022-JP $(B$K;XDj$7$?F|K\8l$N(B plain $(B%F%-%9%H$G$9(B. ;; ;;--[[text/richtext]] ;; <center>This is a richtext.</center> @@ -119,7 +120,7 @@ ;;; (defconst mime-editor/RCS-ID - "$Id: tm-edit.el,v 1.5 1997/01/23 05:29:42 steve Exp $") + "$Id: tm-edit.el,v 1.6 1997/01/30 02:22:48 steve Exp $") (defconst mime-editor/version (get-version-string mime-editor/RCS-ID)) @@ -740,12 +741,15 @@ --[[text/plain]] This is also a plain text. But, it is explicitly specified as is. - --[[text/plain; charset=ISO-2022-JP]] - ... Japanese text here ... - --[[text/richtext]] - <center>This is a richtext.</center> - --[[image/gif][base64]]^M...image encoded in base64 here... - --[[audio/basic][base64]]^M...audio encoded in base64 here... + --[[text/plain; charset=ISO-8859-1]] + This is also a plain text. But charset is specified as + iso-8859-1. + + ¡Hola! Buenos días. ¿Cómo está usted? + --[[text/enriched]] + This is a <bold>enriched text</bold>. + --[[image/gif][base64]]...image encoded in base64 here... + --[[audio/basic][base64]]...audio encoded in base64 here... User customizable variables (not documented all of them): mime-prefix
--- a/lisp/tm/tm-ew-d.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/tm/tm-ew-d.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,6 +1,6 @@ ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -9,7 +9,7 @@ ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. ;; Renamed: 1993/06/03 to tiny-mime.el. ;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder) -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of tm (Tools for MIME). @@ -42,7 +42,7 @@ ;;; (defconst tm-ew-d/RCS-ID - "$Id: tm-ew-d.el,v 1.2 1997/01/11 20:14:11 steve Exp $") + "$Id: tm-ew-d.el,v 1.3 1997/01/30 02:22:48 steve Exp $") (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID)) @@ -123,10 +123,13 @@ (mime/unfolding) ) (goto-char (point-min)) - (while (re-search-forward "\\?=\\(\n*\\s +\\)+=\\?" nil t) - (replace-match "?==?") + (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" mime/encoded-word-regexp "\\)") + nil t) + (replace-match "\\1\\6") + (goto-char (point-min)) ) - (goto-char (point-min)) (let (charset encoding text) (while (re-search-forward mime/encoded-word-regexp nil t) (insert (mime/decode-encoded-word @@ -195,8 +198,13 @@ )) (condition-case err (mime/decode-encoded-text charset encoding text must-unfold) - (error nil)) - )) + (error + (and (tl:add-text-properties 0 (length word) + (and tm:warning-face + (list 'face tm:warning-face)) + word) + word))) + )) word)) @@ -217,24 +225,31 @@ (let ((cs (mime-charset-to-coding-system charset))) (if cs (let ((dest - (cond ((and (string-equal "B" encoding) - (string-match mime/B-encoded-text-regexp string)) - (base64-decode-string string)) - ((and (string-equal "Q" encoding) - (string-match mime/Q-encoded-text-regexp string)) - (q-encoding-decode-string string)) - (t (message "Invalid encoded-word %s" encoding) - nil)))) + (cond + ((string-equal "B" encoding) + (if (and (string-match mime/B-encoded-text-regexp string) + (string-equal string (match-string 0 string))) + (base64-decode-string string) + (error "Invalid encoded-text %s" string))) + ((string-equal "Q" encoding) + (if (and (string-match mime/Q-encoded-text-regexp string) + (string-equal string (match-string 0 string))) + (q-encoding-decode-string string) + (error "Invalid encoded-text %s" string))) + (t + (error "Invalid encoding %s" encoding) + ))) + ) (if dest (progn (setq dest (decode-coding-string dest cs)) (if must-unfold (mapconcat (function (lambda (chr) - (if (eq chr ?\n) - "" - (char-to-string chr) - ) + (cond + ((eq chr ?\n) "") + ((eq chr ?\t) " ") + (t (char-to-string chr))) )) (std11-unfold-string dest) "")
--- a/lisp/utils/timezone.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/utils/timezone.el Mon Aug 13 09:09:02 2007 +0200 @@ -129,6 +129,9 @@ "Make time string from HOUR, MINUTE, and SECOND." (format "%02d:%02d:%02d" hour minute second)) +;;;###autoload +(define-error 'invalid-date "Invalid date string") + (defun timezone-parse-date (date) "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. 19 is prepended to year if necessary. Timezone may be nil if nothing. @@ -140,6 +143,8 @@ (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] (7) Mon, 6 Jul 16:47:20 T 1992 [MET]" + (condition-case nil + (progn ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) @@ -219,7 +224,10 @@ (if year (vector year month day time zone) (vector "0" "0" "0" "0" nil)) - )) + ) + ) + (t (signal 'invalid-date (list date)))) +) (defun timezone-parse-time (time) "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
--- a/lisp/version.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:09:02 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.0" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta92)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta93)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/w3/ChangeLog Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:09:02 2007 +0200 @@ -1,3 +1,50 @@ +Sun Jan 26 16:50:09 1997 William M. Perry <wmperry@aventail.com> + +* w3-forms.el (w3-form-create-text): Now uses the real text entry widgets + provided by 'widget' - still can't do this for password fields yet + though. + +* Synch'd up to Widget 1.20 + +Sat Jan 25 13:38:12 1997 William M. Perry <wmperry@aventail.com> + +* url.el (url-expand-file-name): Now strips out spaces as well as + newlines/carriage returns. More fixes for that bastardized microsoft + home page. + +* url-http.el (url-create-mime-request): Make sure that we retrieve the + cookies for the real URL we are retrieving when going through a proxy. + Now the psychotic crap that is the microsoft home page should be + successfully retrieved if going through an HTTP proxy. + +* url-cookie.el (url-cookie-handle-set-cookie): Attempt to deal with + idiotic microsoft home page that sends out set-cookie headers that look + like MC1=ID=abc, and expects two cookies MC1='' and ID='abc' *sigh* + +* w3-forms.el, w3-display.el: Form elements now keep all their attributes + with them. Will be useful when we start allowing scripting. + (w3-form-create-custom): Rudimentary patches to allow embedding 'custom' + widgets into the buffer. Interesting. + +* w3-forms.el (w3-form-determine-size): New function to calculate how big + a form field will be - option lists should look much better now. + +Thu Jan 23 08:48:59 1997 William M. Perry <wmperry@aventail.com> + +* Synch'ed up to custom 1.19 + +* url-parse.el: document extra slots of url-generic-parse-url + +Thu Jan 23 08:34:34 1997 Joe Wells <jbw@cs.bu.edu> + +* url-file.el (url-file): Patch to tell ange-ftp and/or efs the password + in a file/ftp URL so that you won't be prompted for the password, even + if one was specified in the URL + +* url-parse.el (url-generic-parse-url): Fixed bug where specifying a + username and password in the URL would downcase the username and + password as well as the hostname. + Wed Jan 22 08:28:13 1997 William M. Perry <wmperry@aventail.com> * Emacs-W3 3.0.50 released
--- a/lisp/w3/url-cookie.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/url-cookie.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-cookie.el --- Netscape Cookie support ;; Author: wmperry -;; Created: 1997/01/16 22:34:30 -;; Version: 1.9 +;; Created: 1997/01/26 00:40:23 +;; Version: 1.10 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -335,10 +335,17 @@ nil) ((url-cookie-host-can-set-p url-current-server domain) ;; Cookie is accepted by the user, and passes our security checks - (while rest - (url-cookie-store (car (car rest)) (cdr (car rest)) - expires domain path secure) - (setq rest (cdr rest)))) + (let ((cur nil)) + (while rest + (setq cur (pop rest)) + ;; Oh gross, this is for microsoft & netscape. + ;; Fuck them fuck them fuchk them fuck them. + (if (string-match "^\\([^=]+\\)=\\(.*\\)" (cdr cur)) + (setq rest (cons (cons (match-string 1 (cdr cur)) + (match-string 2 (cdr cur))) rest) + cur (cons (car cur) ""))) + (url-cookie-store (car cur) (cdr cur) + expires domain path secure)))) (t (url-warn 'url (format (concat "%s tried to set a cookie for domain %s\n"
--- a/lisp/w3/url-file.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/url-file.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-file.el --- File retrieval code ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.8 +;; Created: 1997/01/24 14:32:50 +;; Version: 1.9 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -194,6 +194,7 @@ ;; Find a file (let* ((urlobj (url-generic-parse-url url)) (user (url-user urlobj)) + (pass (url-password urlobj)) (site (url-host urlobj)) (file (url-unhex-string (url-filename urlobj))) (dest (url-target urlobj)) @@ -211,6 +212,14 @@ (setq y (1+ y))))) (url-clear-tmp-buffer) + (and user pass + (cond + ((featurep 'ange-ftp) + (ange-ftp-set-passwd site user pass)) + ((or (featurep 'efs) (featurep 'efs-auto)) + (efs-set-passwd site user pass)) + (t + nil))) (cond ((file-directory-p filename) (if url-use-hypertext-dired
--- a/lisp/w3/url-http.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/url-http.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-http.el --- HTTP Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/01/15 15:55:48 -;; Version: 1.10 +;; Created: 1997/01/26 03:56:59 +;; Version: 1.11 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -133,8 +133,10 @@ (let ((url-basic-auth-storage url-proxy-basic-authentication)) (url-get-authentication url nil 'any nil)))) - (host (or (and (boundp 'proxy-info) - (url-host (url-generic-parse-url proxy-info))) + (proxy-obj (if (boundp 'proxy-info) + (url-generic-parse-url proxy-info))) + (real-fname (if proxy-obj (url-filename proxy-obj) fname)) + (host (or (and proxy-obj (url-host proxy-obj)) url-current-server)) (auth (if (cdr-safe (assoc "Authorization" url-request-extra-headers)) nil @@ -195,8 +197,8 @@ url-mime-accept-string (url-http-user-agent-string) (or auth "") - (url-cookie-generate-header-lines url-current-server - fname + (url-cookie-generate-header-lines host + real-fname (string-match "https" url-current-type)) (or proxy-auth "")
--- a/lisp/w3/url-parse.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/url-parse.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-parse.el --- Uniform Resource Locator parser ;; Author: wmperry -;; Created: 1997/01/10 00:13:05 -;; Version: 1.4 +;; Created: 1997/01/23 16:48:58 +;; Version: 1.6 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -108,7 +108,8 @@ (defun url-generic-parse-url (url) "Return a vector of the parts of URL. -Format is [protocol username password hostname portnumber file reference]" +Format is: +[proto username password hostname portnumber file reference attributes fullp]" (cond ((null url) (make-vector 9 nil)) @@ -152,7 +153,6 @@ (forward-char 2) (setq save-pos (point)) (skip-chars-forward "^/") - (downcase-region save-pos (point)) (setq host (buffer-substring save-pos (point))) (if (string-match "^\\([^@]+\\)@" host) (setq user (url-match host 1) @@ -165,7 +165,8 @@ host (substring host 0 (match-beginning 0)))) (if (string-match ":$" host) (setq host (substring host 0 (match-beginning 0)))) - (setq save-pos (point)))) + (setq host (downcase host) + save-pos (point)))) ;; Now check for references (setq save-pos (point)) (skip-chars-forward "^#")
--- a/lisp/w3/url.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/01/19 01:12:24 -;; Version: 1.46 +;; Created: 1997/01/26 04:24:41 +;; Version: 1.47 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/01/19 01:12:24|1.46|Location Undetermined +;;; 1997/01/26 04:24:41|1.47|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1339,7 +1339,7 @@ path components followed by `..' are removed, along with the `..' itself." (if url (setq url (mapconcat (function (lambda (x) - (if (memq x '(?\n ?\r)) + (if (memq x '(? ?\n ?\r)) "" (char-to-string x)))) (url-strip-leading-spaces
--- a/lisp/w3/w3-display.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/01/21 19:45:13 -;; Version: 1.110 +;; Created: 1997/01/26 00:16:07 +;; Version: 1.112 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1414,6 +1414,38 @@ (push (list 'tr nil (pop rows)) items)) items)) +(defun w3-display-normalize-form-info (args) + (let* ((plist (alist-to-plist args)) + (type (intern (downcase + (or (plist-get plist 'type) "text")))) + (name (plist-get plist 'name)) + (value (or (plist-get plist 'value) "")) + (size (if (plist-get plist 'size) + (string-to-int (plist-get plist 'size)))) + (maxlength (if (plist-get plist 'maxlength) + (string-to-int + (plist-get plist 'maxlength)))) + (default value) + (checked (assq 'checked args))) + (if (memq type '(checkbox radio)) (setq default checked)) + (if (and (eq type 'checkbox) (string= value "")) + (setq value "on")) + (if (and (not (memq type '(submit reset button))) + (not name)) + (setq name (symbol-name type))) + (while (and name (string-match "[\r\n]+" name)) + (setq name (concat (substring name 0 (match-beginning 0)) + (substring name (match-end 0) nil)))) + (setq plist (plist-put plist 'type type) + plist (plist-put plist 'name name) + plist (plist-put plist 'value value) + plist (plist-put plist 'size size) + plist (plist-put plist 'default default) + plist (plist-put plist 'internal-form-number w3-current-form-number) + plist (plist-put plist 'action w3-display-form-id) + plist (plist-put plist 'maxlength maxlength)) + plist)) + (defun w3-display-node (node &optional nofaces) (let ( (content-stack (list (list node))) @@ -1762,77 +1794,34 @@ nil ; checked (car w3-active-faces))) (input - (let* ( - (type (intern (downcase (or (w3-get-attribute 'type) - "text")))) - (name (w3-get-attribute 'name)) - (value (or (w3-get-attribute 'value) "")) - (size (if (w3-get-attribute 'size) - (string-to-int (w3-get-attribute 'size)))) - (maxlength (cdr (assoc 'maxlength args))) - (default value) - (action w3-display-form-id) - (options) - (id (w3-get-attribute 'id)) - (checked (assq 'checked args))) - (if (and (string-match "^[ \t\n\r]+$" value) - (not (eq type 'hidden))) - (setq value "")) - (if maxlength (setq maxlength (string-to-int maxlength))) - (if (and name (string-match "[\r\n]" name)) - (setq name (mapconcat (function - (lambda (x) - (if (memq x '(?\r ?\n)) - "" - (char-to-string x)))) - name ""))) - (if (memq type '(checkbox radio)) (setq default checked)) - (if (and (eq type 'checkbox) (string= value "")) - (setq value "on")) - (w3-form-add-element type name - value size maxlength default action - options w3-current-form-number id checked - (car w3-active-faces)) - ) + (w3-form-add-element + (w3-display-normalize-form-info args) + (car w3-active-faces)) (w3-handle-empty-tag) ) (select - (let* ( - (name (w3-get-attribute 'name)) - (size (string-to-int (or (w3-get-attribute 'size) - "20"))) - (maxlength (cdr (assq 'maxlength args))) - (value nil) + (let* ((plist (w3-display-normalize-form-info args)) (tmp nil) - (action w3-display-form-id) - (options) - (id (w3-get-attribute 'id)) (multiple (assq 'multiple args)) - (checked (assq 'checked args))) - (if maxlength (setq maxlength (string-to-int maxlength))) - (if (and name (string-match "[\r\n]" name)) - (setq name (mapconcat (function - (lambda (x) - (if (memq x '(?\r ?\n)) - "" - (char-to-string x)))) - name ""))) - (setq options - (mapcar - (function - (lambda (n) - (setq tmp (w3-normalize-spaces - (apply 'concat (nth 2 n))) - tmp (cons tmp - (or - (cdr-safe (assq 'value (nth 1 n))) - tmp))) - (if (assq 'selected (nth 1 n)) - (setq value (car tmp))) - tmp)) - (nth 2 node))) + (value nil) + (name (plist-get plist 'name)) + (options (mapcar + (function + (lambda (n) + (setq tmp (w3-normalize-spaces + (apply 'concat (nth 2 n))) + tmp (cons tmp + (or + (cdr-safe + (assq 'value (nth 1 n))) + tmp))) + (if (assq 'selected (nth 1 n)) + (setq value (car tmp))) + tmp)) + (nth 2 node)))) (if (not value) (setq value (caar options))) + (setq plist (plist-put plist 'value value)) (if multiple (progn (setq options @@ -1849,43 +1838,21 @@ options)) (setq node (list 'p nil options)) (w3-handle-content node)) - (w3-form-add-element 'option - name value size maxlength value - action options - w3-current-form-number id nil - (car w3-active-faces)) + (setq plist (plist-put plist 'type 'option) + plist (plist-put plist 'options options)) + (w3-form-add-element plist (car w3-active-faces)) ;; This should really not be necessary, but some versions ;; of the widget library leave point _BEFORE_ the menu ;; widget instead of after. (goto-char (point-max)) (w3-handle-empty-tag)))) (textarea - (let* ( - (name (w3-get-attribute 'name)) - (size (string-to-int (or (w3-get-attribute 'size) - "22"))) - (maxlength (cdr (assq 'maxlength args))) + (let* ((plist (w3-display-normalize-form-info args)) (value (w3-normalize-spaces - (apply 'concat (nth 2 node)))) - (default value) - (tmp nil) - (action w3-display-form-id) - (options) - (id (w3-get-attribute 'id)) - (checked (assq 'checked args))) - (if maxlength (setq maxlength (string-to-int maxlength))) - (if (and name (string-match "[\r\n]" name)) - (setq name (mapconcat (function - (lambda (x) - (if (memq x '(?\r ?\n)) - "" - (char-to-string x)))) - name ""))) - (w3-form-add-element 'multiline name - value size maxlength value action - options w3-current-form-number id nil - (car w3-active-faces)) - ) + (apply 'concat (nth 2 node))))) + (setq plist (plist-put plist 'type 'multiline) + plist (plist-put plist 'value value)) + (w3-form-add-element plist (car w3-active-faces))) (w3-handle-empty-tag) ) (style
--- a/lisp/w3/w3-forms.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/01/21 19:45:55 -;; Version: 1.48 +;; Created: 1997/01/27 00:57:39 +;; Version: 1.51 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -39,11 +39,13 @@ (define-widget-keywords :emacspeak-help :w3-form-data) (defvar w3-form-keymap (copy-keymap global-map)) +(define-key w3-form-keymap "\r" 'w3-form-maybe-submit-by-keypress) +(define-key w3-form-keymap "\n" 'w3-form-maybe-submit-by-keypress) (define-key w3-form-keymap "\t" 'w3-widget-forward) (define-key w3-form-keymap [(shift tab)] 'w3-widget-backward) ;; A form entry area is a vector -;; [ type name default-value value maxlength options widget] +;; [ type name default-value value maxlength options widget plist] ;; Where: ;; type = symbol defining what type of form entry area it is ;; (ie: file, radio) @@ -59,6 +61,7 @@ (defsubst w3-form-element-options (obj) (aref obj 6)) (defsubst w3-form-element-action (obj) (aref obj 7)) (defsubst w3-form-element-widget (obj) (aref obj 8)) +(defsubst w3-form-element-plist (obj) (aref obj 9)) (defsubst w3-form-element-set-type (obj val) (aset obj 0 val)) (defsubst w3-form-element-set-name (obj val) (aset obj 1 val)) @@ -69,34 +72,43 @@ (defsubst w3-form-element-set-options (obj val) (aset obj 6 val)) (defsubst w3-form-element-set-action (obj val) (aset obj 7 val)) (defsubst w3-form-element-set-widget (obj val) (aset obj 8 val)) +(defsubst w3-form-element-set-plist (obj val) (aset obj 9 val)) -;; The main function - this adds a single widget to the form -(defun w3-form-add-element (type name value size maxlength default - action options number id checked - face) - (let* ((name (or name (case type - ((submit reset) nil) - (otherwise (symbol-name type))))) - (el (vector type - name - default - value - size - maxlength - options - action nil)) - (size (case type - (checkbox 3) - (radio 4) - ((reset submit) - (+ 2 (length (or value (symbol-name type))))) - (multiline 21) - (hidden nil) - (file (+ 6 (or size 20))) - ((float int) (or size 20)) - (otherwise (or size 22)))) +(defun w3-form-determine-size (el size) + (case (w3-form-element-type el) + (checkbox 3) + (radio 4) + ((reset submit) (+ 2 (length (or (w3-form-element-value el) + (symbol-name + (w3-form-element-type el)))))) + (multiline 21) + (hidden nil) + (file (or size 26)) + ((float text int) (or size 20)) + (option + (or size + (length (caar (sort (w3-form-element-options el) + (function + (lambda (x y) + (>= (length (car x)) (length (car y)))))))))) + (otherwise (or size 22)))) + +;;###autoload +(defun w3-form-add-element (plist face) + (let* ((action (plist-get plist 'action)) + (el (vector (plist-get plist 'type) + (plist-get plist 'name) + (plist-get plist 'default) + (plist-get plist 'value) + (plist-get plist 'size) + (plist-get plist 'maxlength) + (plist-get plist 'options) + action + nil + plist)) + (size (w3-form-determine-size el (plist-get plist 'size))) (node (assoc action w3-form-elements))) - (if (eq type 'hidden) + (if (eq (plist-get plist 'type) 'hidden) (if node (setcdr node (cons el (cdr node))) (setq w3-form-elements (cons (cons action (list el)) @@ -188,6 +200,28 @@ (put 'image 'w3-widget-creation-function 'w3-form-create-image) (put 'int 'w3-widget-creation-function 'w3-form-create-integer) (put 'float 'w3-widget-creation-function 'w3-form-create-float) +(put 'custom 'w3-widget-creation-function 'w3-form-create-custom) +(put 'text 'w3-widget-creation-function 'w3-form-create-text) + +;; Custom support. +(defvar w3-custom-options nil) +(make-variable-buffer-local 'w3-custom-options) + +(defun w3-form-create-custom (el face) + (require 'custom-edit) + (let* ((name (w3-form-element-name el)) + (var-name (w3-form-element-value el)) + (type (plist-get (w3-form-element-plist el) 'custom-type)) + (widget (widget-create (cond ((string-equal type "variable") + 'custom-variable) + ((string-equal type "face") + 'custom-face) + ((string-equal type "group") + 'custom-group) + (t 'item)) (intern var-name)))) + (custom-magic-reset widget) + (push widget w3-custom-options) + widget)) (defun w3-form-create-checkbox (el face) (widget-create 'checkbox @@ -297,20 +331,20 @@ options))) (defun w3-form-create-option-list (el face) - (let ((widget (apply 'widget-create 'menu-choice + (let* ((size (w3-form-determine-size el nil)) + (widget (apply 'widget-create 'menu-choice :value (w3-form-element-value el) :ignore-case t :tag "Choose" :format "%v" - :size (w3-form-element-size el) + :size size :value-face face (mapcar (function (lambda (x) (list 'choice-item :format "%[%t%]" :emacspeak-help 'w3-form-summarize-field - :tag (mule-truncate-string (car x) - (w3-form-element-size el) ? ) + :tag (mule-truncate-string (car x) size ? ) :value (car x)))) (w3-form-element-options el))))) (widget-value-set widget (w3-form-element-value el)) @@ -344,6 +378,14 @@ :w3-form-data el (w3-form-element-value el))) +(defun w3-form-create-text (el face) + (widget-create 'editable-field + :keymap w3-form-keymap + :size (w3-form-element-size el) + :value-face face + :w3-form-data el + (w3-form-element-value el))) + (defun w3-form-default-widget-creator (el face) (widget-create 'link :notify 'w3-form-default-button-callback @@ -484,6 +526,12 @@ ) +(defun w3-form-maybe-submit-by-keypress () + (interactive) + (let ((widget (widget-at (point)))) + (if widget + (w3-form-possibly-submit widget)))) + (defun w3-form-possibly-submit (widget &rest ignore) (let* ((formobj (widget-get widget :w3-form-data)) (ident (w3-form-element-action formobj)) @@ -587,7 +635,8 @@ (file (widget-value-set widget deft)) (otherwise - (widget-value-set widget deft))))))) + (widget-value-set widget deft)))) + (widget-setup)))) (defun w3-form-encode-helper (formobjs) (let ( @@ -600,6 +649,7 @@ formobjs (cdr formobjs) temp (case type (reset nil) + (button nil) (image (if (and (eq submit-button-data formobj) (w3-form-element-name formobj))
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:09:02 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/01/23 00:27:58 -;; Version: 1.74 +;; Created: 1997/01/27 00:59:34 +;; Version: 1.75 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,7 @@ ;;; Variable definitions for w3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst w3-version-number - (let ((x "p3.0.50")) + (let ((x "p3.0.51")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -38,7 +38,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/01/23 00:27:58")) +(defconst w3-version-date (let ((x "1997/01/27 00:59:34")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/widget-edit.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/widget-edit.el Mon Aug 13 09:09:02 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.18 +;; Version: 1.20 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -58,14 +58,23 @@ ;;; Compatibility. -(or (fboundp 'event-point) - ;; XEmacs function missing in Emacs. - (defun event-point (event) - "Return the character position of the given mouse-motion, button-press, +(unless (fboundp 'event-point) + ;; XEmacs function missing in Emacs. + (defun event-point (event) + "Return the character position of the given mouse-motion, button-press, or button-release event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." - (posn-point (event-start event)))) + (posn-point (event-start event)))) + +(unless (fboundp 'error-message-string) + ;; Emacs function missing in XEmacs. + (defun error-message-string (obj) + "Convert an error value to an error message." + (let ((buf (get-buffer-create " *error-message*"))) + (erase-buffer buf) + (display-error obj buf) + (buffer-string buf)))) ;;; Customization. @@ -77,7 +86,7 @@ :prefix "widget-" :group 'emacs) -(defface widget-documentation-faces '((((class color) +(defface widget-documentation-face '((((class color) (background dark)) (:foreground "lime green")) (((class color) @@ -240,7 +249,8 @@ (defun widget-specify-field-update (widget from to) ;; Specify editable button for WIDGET between FROM and TO. - (let ((map (widget-get widget :keymap)) + (let ((map (or (widget-get widget :keymap) + widget-keymap)) (face (or (widget-get widget :value-face) 'widget-field-face))) (set-text-properties from to (list 'field widget @@ -249,7 +259,10 @@ 'local-map map 'face face)) (unless (widget-get widget :size) - (put-text-property to (1+ to) 'face face)))) + (add-text-properties to (1+ to) (list 'field widget + 'face face + 'local-map map + 'keymap map))))) (defun widget-specify-button (widget from to) ;; Specify button for WIDGET between FROM and TO. @@ -260,6 +273,14 @@ 'end-open t 'face face)))) +(defun widget-specify-sample (widget from to) + ;; Specify sample for WIDGET between FROM and TO. + (let ((face (widget-apply widget :sample-face-get))) + (when face + (add-text-properties from to (list 'start-open t + 'end-open t + 'face face))))) + (defun widget-specify-doc (widget from to) ;; Specify documentation for WIDGET between FROM and TO. (add-text-properties from to (list 'widget-doc widget @@ -678,6 +699,7 @@ :offset 0 :format-handler 'widget-default-format-handler :button-face-get 'widget-default-button-face-get + :sample-face-get 'widget-default-sample-face-get :delete 'widget-default-delete :value-set 'widget-default-value-set :value-inline 'widget-default-value-inline @@ -693,6 +715,7 @@ (tag (widget-get widget :tag)) (doc (widget-get widget :doc)) button-begin button-end + sample-begin sample-end doc-begin doc-end value-pos) (insert (widget-get widget :format)) @@ -707,6 +730,10 @@ (setq button-begin (point))) ((eq escape ?\]) (setq button-end (point))) + ((eq escape ?\{) + (setq sample-begin (point))) + ((eq escape ?\}) + (setq sample-end (point))) ((eq escape ?n) (when (widget-get widget :indent) (insert "\n") @@ -730,9 +757,11 @@ (setq value-pos (point)))) (t (widget-apply widget :format-handler escape))))) - ;; Specify button and doc, and insert value. + ;; Specify button, sample, and doc, and insert value. (and button-begin button-end (widget-specify-button widget button-begin button-end)) + (and sample-begin sample-end + (widget-specify-sample widget sample-begin sample-end)) (and doc-begin doc-end (widget-specify-doc widget doc-begin doc-end)) (when value-pos @@ -791,6 +820,10 @@ ;; Use :button-face or widget-button-face (or (widget-get widget :button-face) 'widget-button-face)) +(defun widget-default-sample-face-get (widget) + ;; Use :sample-face. + (widget-get widget :sample-face)) + (defun widget-default-delete (widget) ;; Remove widget from the buffer. (let ((from (widget-get widget :from)) @@ -1849,14 +1882,6 @@ (concat "\n" pp) pp))) -(if (not (fboundp 'error-message-string)) - (defun error-message-string (obj) - "Convert an error value to an error message." - (let ((buf (get-buffer-create " *error-message*"))) - (erase-buffer buf) - (display-error obj buf) - (buffer-string buf)))) - (defun widget-sexp-validate (widget) ;; Valid if we can read the string and there is no junk left after it. (save-excursion @@ -1895,7 +1920,7 @@ :tag "Character" :value 0 :size 1 - :format "%t: %v\n" + :format "%{%t%}: %v\n" :type-error "This field should contain a character" :value-to-internal (lambda (widget value) (if (integerp value) @@ -1921,12 +1946,12 @@ (define-widget 'list 'group "A lisp list." :tag "List" - :format "%t:\n%v") + :format "%{%t%}:\n%v") (define-widget 'vector 'group "A lisp vector." :tag "Vector" - :format "%t:\n%v" + :format "%{%t%}:\n%v" :match 'widget-vector-match :value-to-internal (lambda (widget value) (append value nil)) :value-to-external (lambda (widget value) (apply 'vector value))) @@ -1939,7 +1964,7 @@ (define-widget 'cons 'group "A cons-cell." :tag "Cons-cell" - :format "%t:\n%v" + :format "%{%t%}:\n%v" :match 'widget-cons-match :value-to-internal (lambda (widget value) (list (car value) (cdr value))) @@ -1959,22 +1984,22 @@ (define-widget 'radio 'radio-button-choice "A union of several sexp types." :tag "Choice" - :format "%t:\n%v") + :format "%{%t%}:\n%v") (define-widget 'repeat 'editable-list "A variable length homogeneous list." :tag "Repeat" - :format "%t:\n%v%i\n") + :format "%{%t%}:\n%v%i\n") (define-widget 'set 'checklist "A list of members from a fixed set." :tag "Set" - :format "%t:\n%v") + :format "%{%t%}:\n%v") (define-widget 'boolean 'toggle "To be nil or non-nil, that is the question." :tag "Boolean" - :format "%t: %v") + :format "%{%t%}: %v") ;;; The `color' Widget.
--- a/lisp/w3/widget.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/w3/widget.el Mon Aug 13 09:09:02 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.18 +;; Version: 1.20 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -27,7 +27,8 @@ (set (car keywords) (car keywords))) (setq keywords (cdr keywords))))))) -(define-widget-keywords :case-fold :widget-doc +(define-widget-keywords :sample-face :sample-face-get :case-fold + :widget-doc :create :convert-widget :format :value-create :offset :extra-offset :tag :doc :from :to :args :value :value-from :value-to :action :value-set :value-delete :match :parent :delete :menu-tag-get
--- a/lisp/x11/x-font-menu.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/x11/x-font-menu.el Mon Aug 13 09:09:02 2007 +0200 @@ -2,9 +2,11 @@ ;; Copyright (C) 1994 Free Software Foundation, Inc. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. +;; Copyright (C) 1997 Sun Microsystems ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Restructured by: Jonathan Stigelman <Stig@hackvan.com> +;; Mule-ized by: Martin Buchholz ;; This file is part of XEmacs. @@ -62,9 +64,9 @@ ;;; `reset-device-font-menus' to rebuild the menus from all currently ;;; available fonts. ;;; -;;; There is knowledge here about the regexp match numbers in `x-font-regexp', -;;; `x-font-regexp-foundry-and-family', and -;;; `x-font-regexp-registry-and-encoding' defined in x-faces.el. +;;; There is knowledge here about the regexp match numbers in +;;; `x-font-regexp' and `x-font-regexp-foundry-and-family' defined in +;;; x-faces.el. ;;; ;;; There are at least three kinds of fonts under X11r5: ;;; @@ -97,7 +99,7 @@ ;;; (font-properties (face-font 'default)) ;;; - The values of the following variables after making a selection: ;;; font-menu-preferred-resolution -;;; font-menu-preferred-registry +;;; font-menu-registry-encoding ;;; ;;; There is a common misconception that "*-courier-medium-r-*-11-*", also ;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1", @@ -105,6 +107,21 @@ ;;; which is an 8-point font (the number after -11- is the size in tenths ;;; of points). So if you expect to be seeing an "11" entry in the "Size" ;;; menu and are not, this may be why. +;;; +;;; In the real world (aka Solaris), one has to deal with fonts that +;;; appear to be medium-i but are really light-r, and fonts that +;;; resolve to different resolutions depending on the charset: +;;; +;;; (font-instance-truename +;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*")) +;;; ==> +;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0" +;;; +;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*") +;;; ==> +;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1" +;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" +;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") ;;; Code: @@ -126,10 +143,13 @@ ;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) (defvar device-fonts-cache nil) -(defconst font-menu-preferred-registry nil) -(defconst font-menu-preferred-resolution nil) +(defvar font-menu-registry-encoding nil + "Registry and encoding to use with font menu fonts.") -(defconst fonts-menu-junk-families +(defvar font-menu-preferred-resolution "*-*" + "Preferred horizontal and vertical font menu resolution (e.g. \"75-75\").") + +(defvar fonts-menu-junk-families (purecopy (mapconcat #'identity @@ -143,6 +163,11 @@ "\\|")) "A regexp matching font families which are uninteresting (e.g. cursor fonts).") +(eval-when-compile + (defsubst device-fonts-cache () + (or (cdr (assq (selected-device) device-fonts-cache)) + (reset-device-font-menus (selected-device))))) + (defun hack-font-truename (fn) "Filter the output of `font-instance-truename' to deal with Japanese fontsets." (if (string-match "," (font-instance-truename fn)) @@ -161,8 +186,8 @@ (fset 'install-font-menus 'reset-device-font-menus) (make-obsolete 'install-font-menus 'reset-device-font-menus) -(defvar x-font-regexp-ja nil - "This is used to filter out fonts that don't work in the locale. +(defvar x-font-regexp-ascii nil + "This is used to filter out font families that can't display ASCII text. It must be set at run-time.") (defun vassoc (key valist) @@ -191,30 +216,20 @@ (not (or device (setq device (selected-device)))) (not (eq (device-type device) 'x))) nil - (if (and (getenv "LANG") - (string-match "^\\(ja\\|japanese\\)$" - (getenv "LANG"))) - ;; #### - this is questionable behavior left over from the I18N4 code. - (setq x-font-regexp-ja "jisx[^-]*-[^-]*$" - font-menu-preferred-registry '("*" . "*") - font-menu-preferred-resolution '("*" . "*"))) - (let ((all-fonts nil) - (case-fold-search t) - name family size weight entry monospaced-p - dev-cache - (cache nil) - (families nil) - (sizes nil) - (weights nil)) - (cond ((stringp debug) ; kludge - (setq all-fonts (split-string debug "\n"))) - (t - (setq all-fonts - (or debug - (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))))) - (while (setq name (pop all-fonts)) - (when (and (or (not x-font-regexp-ja) - (string-match x-font-regexp-ja name)) + (unless x-font-regexp-ascii + (setq x-font-regexp-ascii (if (fboundp 'charset-registry) + (charset-registry 'ascii) + "iso8859-1"))) + (setq font-menu-registry-encoding + (if (featurep 'mule) "*-*" "iso8859-1")) + (let ((case-fold-search t) + family size weight entry monospaced-p + dev-cache cache families sizes weights) + (dolist (name (cond ((null debug) ; debugging kludge + (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device)) + ((stringp debug) (split-string debug "\n")) + (t debug))) + (when (and (string-match x-font-regexp-ascii name) (string-match x-font-regexp name)) (setq weight (capitalize (match-string 1 name)) size (string-to-int (match-string 6 name))) @@ -229,18 +244,12 @@ (car (setq cache (cons (vector family nil nil t) cache))))) - (or (member family families) - (setq families (cons family families))) - (or (member weight weights) - (setq weights (cons weight weights))) - (or (member weight (aref entry 1)) - (aset entry 1 (cons weight (aref entry 1)))) - (or (member size sizes) - (setq sizes (cons size sizes))) - (or (member size (aref entry 2)) - (aset entry 2 (cons size (aref entry 2)))) - (aset entry 3 (and (aref entry 3) monospaced-p)) - ))) + (or (member family families) (push family families)) + (or (member weight weights) (push weight weights)) + (or (member size sizes) (push size sizes)) + (or (member weight (aref entry 1)) (push weight (aref entry 1))) + (or (member size (aref entry 2)) (push size (aref entry 2))) + (aset entry 3 (and (aref entry 3) monospaced-p))))) ;; ;; Hack scalable fonts. ;; Some fonts come only in scalable versions (the only size is 0) @@ -267,181 +276,178 @@ (setq sizes (delq 0 sizes)))) (setq families (sort families 'string-lessp) - weights (sort weights 'string-lessp) - sizes (sort sizes '<)) + weights (sort weights 'string-lessp) + sizes (sort sizes '<)) - (let ((rest cache)) - (while rest - (aset (car rest) 1 (sort (aref (car rest) 1) 'string-lessp)) - (aset (car rest) 2 (sort (aref (car rest) 2) '<)) - (setq rest (cdr rest)))) + (dolist (entry cache) + (aset entry 1 (sort (aref entry 1) 'string-lessp)) + (aset entry 2 (sort (aref entry 2) '<))) (message "Getting list of fonts from server... done.") (setq dev-cache (assq device device-fonts-cache)) (or dev-cache (setq dev-cache (car (push (list device) device-fonts-cache)))) - (setcdr dev-cache - (vector - cache - (mapcar #'(lambda (x) - (vector x - (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) - families) - (mapcar #'(lambda (x) - (vector (if (/= 0 (% x 10)) - ;; works with no LISP_FLOAT_TYPE - (concat (int-to-string (/ x 10)) "." - (int-to-string (% x 10))) - (int-to-string (/ x 10))) - (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) - sizes) - (mapcar #'(lambda (x) - (vector x - (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) - weights))) + (setcdr + dev-cache + (vector + cache + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font x nil nil) + ':style 'radio ':active nil ':selected nil)) + families) + (mapcar (lambda (x) + (vector (if (/= 0 (% x 10)) + ;; works with no LISP_FLOAT_TYPE + (concat (int-to-string (/ x 10)) "." + (int-to-string (% x 10))) + (int-to-string (/ x 10))) + (list 'font-menu-set-font nil nil x) + ':style 'radio ':active nil ':selected nil)) + sizes) + (mapcar (lambda (x) + (vector x + (list 'font-menu-set-font nil x nil) + ':style 'radio ':active nil ':selected nil)) + weights))) (cdr dev-cache)))) -(defsubst font-menu-truename (face) - (hack-font-truename - (if (featurep 'mule) - (face-font-instance face nil 'ascii) - (face-font-instance face)))) +;; Extract font information from a face. We examine both the +;; user-specified font name and the canonical (`true') font name. +;; These can appear to have totally different properties. +;; For examples, see the prolog above. -;;; Extract a font family from a face. -;;; Use the user-specified one if possible. -;;; If the user didn't specify one (with "*", for example) -;;; get the truename and use the guaranteed family from that. -(defun font-menu-family (face) - (let ((dcache (cdr (assq (selected-device) device-fonts-cache))) - (name (font-instance-name (face-font-instance face))) - (family nil)) +;; We use the user-specified one if possible, else use the truename. +;; If the user didn't specify one (with "-dt-*-*", for example) +;; get the truename and use the possibly suboptimal data from that. +(defun* font-menu-font-data (face dcache) + (let* ((case-fold-search t) + (domain (if font-menu-this-frame-only-p + (selected-frame) + (selected-device))) + (name (font-instance-name (face-font-instance face domain))) + (truename (font-instance-truename + (face-font-instance face domain + (if (featurep 'mule) 'ascii)))) + family size weight entry slant) (when (string-match x-font-regexp-foundry-and-family name) - (setq family (capitalize (match-string 1 name)))) - (when (not (and family (vassoc family (aref dcache 0)))) - (setq name (font-menu-truename face)) - (string-match x-font-regexp-foundry-and-family name) - (setq family (capitalize (match-string 1 name)))) - family)) + (setq family (capitalize (match-string 1 name))) + (setq entry (vassoc family (aref dcache 0)))) + (when (and (null entry) + (string-match x-font-regexp-foundry-and-family truename)) + (setq family (capitalize (match-string 1 truename))) + (setq entry (vassoc family (aref dcache 0)))) + (when (null entry) + (return-from font-menu-font-data (make-vector 5 nil))) + + (when (string-match x-font-regexp name) + (setq weight (capitalize (match-string 1 name))) + (setq size (string-to-int (match-string 6 name)))) + + (when (string-match x-font-regexp truename) + (when (not (member weight (aref entry 1))) + (setq weight (capitalize (match-string 1 truename)))) + (when (not (member size (aref entry 2))) + (setq size (string-to-int (match-string 6 truename)))) + (setq slant (capitalize (match-string 2 truename)))) + + (vector entry family size weight slant))) ;;;###autoload (defun font-menu-family-constructor (ignored) - ;; by Stig@hackvan.com - (if (not (eq 'x (device-type (selected-device)))) - '(["Cannot parse current font" ding nil]) - (let* ((dcache (cdr (assq (selected-device) device-fonts-cache))) - (name (font-menu-truename 'default)) - (case-fold-search t) - family weight size ; parsed from current font - entry ; font cache entry + (catch 'menu + (unless (eq 'x (device-type (selected-device))) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + (size (aref font-data 2)) + (weight (aref font-data 3)) f) - (or dcache - (setq dcache (reset-device-font-menus (selected-device)))) - (if (not (string-match x-font-regexp name)) - ;; couldn't parse current font - '(["Cannot parse current font" ding nil]) - (setq weight (capitalize (match-string 1 name))) - (setq size (string-to-number (match-string 6 name))) - (setq family (font-menu-family 'default)) - (setq entry (vassoc family (aref dcache 0))) - (mapcar #'(lambda (item) - ;; - ;; Items on the Font menu are enabled iff that font - ;; exists in the same size and weight as the current - ;; font (scalable fonts exist in every size). Only the - ;; current font is marked as selected. - ;; - (setq f (aref item 0) - entry (vassoc f (aref dcache 0))) - (if (and (member weight (aref entry 1)) - (or (member size (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2))))) - (enable-menu-item item) - (disable-menu-item item)) - (if (equal family f) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 1))) - ))) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Font menu are enabled iff that font exists in + ;; the same size and weight as the current font (scalable fonts + ;; exist in every size). Only the current font is marked as + ;; selected. + (mapcar + (lambda (item) + (setq f (aref item 0) + entry (vassoc f (aref dcache 0))) + (if (and (member weight (aref entry 1)) + (or (member size (aref entry 2)) + (and (not font-menu-ignore-scaled-fonts) + (member 0 (aref entry 2))))) + (enable-menu-item item) + (disable-menu-item item)) + (if (string-equal family f) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 1))))) ;;;###autoload (defun font-menu-size-constructor (ignored) - ;; by Stig@hackvan.com - (if (not (eq 'x (device-type (selected-device)))) - '(["Cannot parse current font" ding nil]) - (let ((dcache (cdr (assq (selected-device) device-fonts-cache))) - (name (font-menu-truename 'default)) - (case-fold-search t) - family size ; parsed from current font - entry ; font cache entry - s) - (or dcache - (setq dcache (reset-device-font-menus (selected-device)))) - (if (not (string-match x-font-regexp name)) - ;; couldn't parse current font - '(["Cannot parse current font" ding nil]) - (setq size (string-to-number (match-string 6 name))) - (setq family (font-menu-family 'default)) - (setq entry (vassoc family (aref dcache 0))) - (mapcar - (lambda (item) - ;; - ;; Items on the Size menu are enabled iff current font has - ;; that size. Only the size of the current font is - ;; selected. (If the current font comes in size 0, it is - ;; scalable, and thus has every size.) - ;; - (setq s (nth 3 (aref item 1))) - (if (or (member s (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2)))) - (enable-menu-item item) - (disable-menu-item item)) - (if (eq size s) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 2))) - ))) + (catch 'menu + (unless (eq 'x (device-type (selected-device))) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + (size (aref font-data 2)) + ;;(weight (aref font-data 3)) + s) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Size menu are enabled iff current font has + ;; that size. Only the size of the current font is selected. + ;; (If the current font comes in size 0, it is scalable, and + ;; thus has every size.) + (mapcar + (lambda (item) + (setq s (nth 3 (aref item 1))) + (if (or (member s (aref entry 2)) + (and (not font-menu-ignore-scaled-fonts) + (member 0 (aref entry 2)))) + (enable-menu-item item) + (disable-menu-item item)) + (if (eq size s) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 2))))) ;;;###autoload (defun font-menu-weight-constructor (ignored) - ;; by Stig@hackvan.com - (if (not (eq 'x (device-type (selected-device)))) - '(["Cannot parse current font" ding nil]) - (let ((dcache (cdr (assq (selected-device) device-fonts-cache))) - (name (font-menu-truename 'default)) - (case-fold-search t) - family weight ; parsed from current font - entry ; font cache entry - w) - (or dcache - (setq dcache (reset-device-font-menus (selected-device)))) - (if (not (string-match x-font-regexp name)) - ;; couldn't parse current font - '(["Cannot parse current font" ding nil]) - (setq weight (capitalize (match-string 1 name))) - (setq family (font-menu-family 'default)) - (setq entry (vassoc family (aref dcache 0))) - (mapcar #'(lambda (item) - ;; Items on the Weight menu are enabled iff current font - ;; has that weight. Only the weight of the current font - ;; is selected. - (setq w (aref item 0)) - (if (member w (aref entry 1)) - (enable-menu-item item) - (disable-menu-item item)) - (if (equal weight w) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 3))) - ))) + (catch 'menu + (unless (eq 'x (device-type (selected-device))) + (throw 'menu '(["Cannot parse current font" ding nil]))) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (entry (aref font-data 0)) + (family (aref font-data 1)) + ;;(size (aref font-data 2)) + (weight (aref font-data 3)) + w) + (unless family + (throw 'menu '(["Cannot parse current font" ding nil]))) + ;; Items on the Weight menu are enabled iff current font + ;; has that weight. Only the weight of the current font + ;; is selected. + (mapcar + (lambda (item) + (setq w (aref item 0)) + (if (member w (aref entry 1)) + (enable-menu-item item) + (disable-menu-item item)) + (if (string-equal weight w) + (select-toggle-menu-item item) + (deselect-toggle-menu-item item)) + item) + (aref dcache 3))))) ;;; Changing font sizes @@ -450,35 +456,31 @@ ;; This is what gets run when an item is selected from any of the three ;; fonts menus. It needs to be rather clever. ;; (size is measured in 10ths of points.) - (let ((faces (delq 'default (face-list))) - (default-name (font-menu-truename 'default)) - (case-fold-search t) - new-default-face-font - from-family from-weight from-size) - ;; - ;; First, parse out the default face's font. - ;; - (setq from-family (font-menu-family 'default)) - (or (string-match x-font-regexp default-name) - (signal 'error (list "couldn't parse font name" default-name))) - (setq from-weight (capitalize (match-string 1 default-name))) - (setq from-size (match-string 6 default-name)) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data 'default dcache)) + (from-family (aref font-data 1)) + (from-size (aref font-data 2)) + (from-weight (aref font-data 3)) + (from-slant (aref font-data 4)) + new-default-face-font) + (unless from-family + (signal 'error '("couldn't parse font name for default face"))) (setq new-default-face-font (font-menu-load-font (or family from-family) (or weight from-weight) (or size from-size) - default-name)) - (while faces - (cond ((face-font-instance (car faces)) - (message "Changing font of `%s'..." (car faces)) - (condition-case c - (font-menu-change-face (car faces) - from-family from-weight from-size - family weight size) - (error - (display-error c nil) - (sit-for 1))))) - (setq faces (cdr faces))) + from-slant + font-menu-preferred-resolution)) + (dolist (face (delq 'default (face-list))) + (when (face-font-instance face) + (message "Changing font of `%s'..." face) + (condition-case c + (font-menu-change-face face + from-family from-weight from-size + family weight size) + (error + (display-error c nil) + (sit-for 1))))) ;; Set the default face's font after hacking the other faces, so that ;; the frame size doesn't change until we are all done. @@ -492,146 +494,58 @@ from-family from-weight from-size to-family to-weight to-size) (or (symbolp face) (signal 'wrong-type-argument (list 'symbolp face))) - (let* ((name (font-menu-truename face)) - (case-fold-search t) - face-family - face-weight - face-size) - ;; First, parse out the face's font. - (or (string-match x-font-regexp-foundry-and-family name) - (signal 'error (list "couldn't parse font name" name))) - (setq face-family (capitalize (match-string 1 name))) - (or (string-match x-font-regexp name) - (signal 'error (list "couldn't parse font name" name))) - (setq face-weight (match-string 1 name)) - (setq face-size (match-string 6 name)) + (let* ((dcache (device-fonts-cache)) + (font-data (font-menu-font-data face dcache)) + (face-family (aref font-data 1)) + (face-size (aref font-data 2)) + (face-weight (aref font-data 3)) + (face-slant (aref font-data 4))) + + (or face-family + (signal 'error (list "couldn't parse font name for face" face))) ;; If this face matches the old default face in the attribute we ;; are changing, then change it to the new attribute along that ;; dimension. Also, the face must have its own global attribute. ;; If its value is inherited, we don't touch it. If any of this ;; is not true, we leave it alone. - (if (and (face-font face 'global) - (cond - (to-family (equal face-family from-family)) - (to-weight (equal face-weight from-weight)) - (to-size (equal face-size from-size)))) - (set-face-font face - (font-menu-load-font (or to-family face-family) - (or to-weight face-weight) - (or to-size face-size) - name) - (and font-menu-this-frame-only-p - (selected-frame))) - nil))) - - -(defun font-menu-load-font (family weight size from-font) - (and (numberp size) (setq size (int-to-string size))) - (let ((case-fold-search t) - slant other-slant - registry encoding resx resy) - (or (string-match x-font-regexp-registry-and-encoding from-font) - (signal 'error (list "couldn't parse font name" from-font))) - (setq registry (match-string 1 from-font) - encoding (match-string 2 from-font)) + (when (and (face-font face 'global) + (cond + (to-family (string-equal face-family from-family)) + (to-weight (string-equal face-weight from-weight)) + (to-size (= face-size from-size)))) + (set-face-font face + (font-menu-load-font (or to-family face-family) + (or to-weight face-weight) + (or to-size face-size) + face-slant + font-menu-preferred-resolution) + (and font-menu-this-frame-only-p + (selected-frame)))))) - (or (string-match x-font-regexp from-font) - (signal 'error (list "couldn't parse font name" from-font))) - (setq slant (capitalize (match-string 2 from-font)) - resx (match-string 7 from-font) - resy (match-string 8 from-font)) - (setq other-slant (cond ((equal slant "O") "I") ; oh, bite me. - ((equal slant "I") "O") - (t nil))) - ;; - ;; Remember these values for the first font we switch away from - ;; (the original default font). - ;; - (or font-menu-preferred-resolution - (setq font-menu-preferred-resolution (cons resx resy))) - (or font-menu-preferred-registry - (setq font-menu-preferred-registry (cons registry encoding))) - ;; - ;; Now we know all the interesting properties of the font we want. - ;; Let's see what we can actually *get*. - ;; - (or ;; First try the default resolution, registry, and encoding. - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" size - "-" (car font-menu-preferred-resolution) - "-" (cdr font-menu-preferred-resolution) - "-*-*-" - (car font-menu-preferred-registry) "-" - (cdr font-menu-preferred-registry)) - nil t) - ;; Then try that in the other slant. - (and other-slant - (make-font-instance - (concat "-*-" family "-" weight "-" other-slant - "-*-*-*-" size - "-" (car font-menu-preferred-resolution) - "-" (cdr font-menu-preferred-resolution) - "-*-*-" - (car font-menu-preferred-registry) "-" - (cdr font-menu-preferred-registry)) - nil t)) - ;; Then try the default resolution and registry, any encoding. - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" size - "-" (car font-menu-preferred-resolution) - "-" (cdr font-menu-preferred-resolution) - "-*-*-" - (car font-menu-preferred-registry) "-*") - nil t) - ;; Then try that in the other slant. - (and other-slant - (make-font-instance - (concat "-*-" family "-" weight "-" other-slant - "-*-*-*-" size - "-" (car font-menu-preferred-resolution) - "-" (cdr font-menu-preferred-resolution) - "-*-*-" - (car font-menu-preferred-registry) "-*") - nil t)) - ;; Then try the default registry and encoding, any resolution. - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" size - "-*-*-*-*-" - (car font-menu-preferred-registry) "-" - (cdr font-menu-preferred-registry)) - nil t) - ;; Then try that in the other slant. - (and other-slant - (make-font-instance - (concat "-*-" family "-" weight "-" other-slant - "-*-*-*-" size - "-*-*-*-*-" - (car font-menu-preferred-registry) "-" - (cdr font-menu-preferred-registry)) - nil t)) - ;; Then try the default registry, any encoding or resolution. - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" size - "-*-*-*-*-" - (car font-menu-preferred-registry) "-*") - nil t) - ;; Then try that in the other slant. - (and other-slant - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" - size "-*-*-*-*-" - (car font-menu-preferred-registry) "-*") - nil t)) - ;; Then try anything in the same slant, and error if it fails... - (and other-slant - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" - size "-*-*-*-*-*-*"))) - (make-font-instance - (concat "-*-" family "-" weight "-" (or other-slant slant) - "-*-*-*-" size "-*-*-*-*-*-*")) - ))) +(defun font-menu-load-font (family weight size slant resolution) + "Try to load a font with the requested properties. +The weight, slant and resolution are only hints." + (when (integerp size) (setq size (int-to-string size))) + (let (font) + (catch 'got-font + (dolist (weight (list weight "*")) + (dolist (slant + (cond ((string-equal slant "O") '("O" "I" "*")) + ((string-equal slant "I") '("I" "O" "*")) + ((string-equal slant "*") '("*")) + (t (list slant "*")))) + (dolist (resolution + (if (string-equal resolution "*-*") + (list resolution) + (list resolution "*-*"))) + (when (setq font + (make-font-instance + (concat "-*-" family "-" weight "-" slant "-*-*-*-" + size "-" resolution "-*-*-" + font-menu-registry-encoding) + nil t)) + (throw 'got-font font)))))))) (defun flush-device-fonts-cache (device) ;; by Stig@hackvan.com
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:08:31 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:09:02 2007 +0200 @@ -189,17 +189,53 @@ :style toggle :selected ps-print-color-p] ("Pretty-Print Paper Size" ["Letter" - (setq ps-paper-type 'ps-letter) + (setq ps-paper-type 'letter) + :style radio + :selected (eq ps-paper-type 'letter)] + ["Letter-small" + (setq ps-paper-type 'letter-small) + :style radio + :selected (eq ps-paper-type 'letter-small)] + ["Legal" + (setq ps-paper-type 'legal) :style radio - :selected (eq ps-paper-type 'ps-letter)] - ["Legal" - (setq ps-paper-type 'ps-legal) + :selected (eq ps-paper-type 'legal)] + ["Statement" + (setq ps-paper-type 'statement) + :style radio + :selected (eq ps-paper-type 'statement)] + ["Executive" + (setq ps-paper-type 'executive) + :style radio + :selected (eq ps-paper-type 'executive)] + ["Tabloid" + (setq ps-paper-type 'tabloid) :style radio - :selected (eq ps-paper-type 'ps-legal)] + :selected (eq ps-paper-type 'tabloid)] + ["Ledger" + (setq ps-paper-type 'ledger) + :style radio + :selected (eq ps-paper-type 'ledger)] + ["A3" + (setq ps-paper-type 'a3) + :style radio + :selected (eq ps-paper-type 'a3)] ["A4" - (setq ps-paper-type 'ps-a4) + (setq ps-paper-type 'a4) + :style radio + :selected (eq ps-paper-type 'a4)] + ["A4small" + (setq ps-paper-type 'a4small) :style radio - :selected (eq ps-paper-type 'ps-a4)] + :selected (eq ps-paper-type 'a4small)] + ["B4" + (setq ps-paper-type 'b4) + :style radio + :selected (eq ps-paper-type 'b4)] + ["B5" + (setq ps-paper-type 'b5) + :style radio + :selected (eq ps-paper-type 'b5)] ) ) ("\"Other Window\" Location"
--- a/man/ChangeLog Mon Aug 13 09:08:31 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 09:09:02 2007 +0200 @@ -1,3 +1,9 @@ +Mon Jan 27 22:28:48 1997 Bob Weiner <weiner@infodock.com> + + * xemacs-faq.texi (Q1.0.14): infodock.com has hardcopies of the + XEmacs manual available. + (Q4.6.1): Updated Infodock Information. + Sat Dec 28 11:08:07 1996 Martin Buchholz <mrb@Eng.Sun.COM> * vhdl-mode.texi: Correct typo in email address.
--- a/man/tm/tm-en.sgml Mon Aug 13 09:08:31 2007 +0200 +++ b/man/tm/tm-en.sgml Mon Aug 13 09:09:02 2007 +0200 @@ -1,5 +1,5 @@ <!doctype sinfo system> -<!-- $Id: tm-en.sgml,v 1.2 1996/12/28 21:03:29 steve Exp $ --> +<!-- $Id: tm-en.sgml,v 1.3 1997/01/30 02:22:57 steve Exp $ --> <head> <title>tm 7.100 Manual (English Version) <author>MORIOKA Tomohiko <mail>morioka@jaist.ac.jp</mail> @@ -36,6 +36,7 @@ <li><a file="gnus-mime-en">tm-MUA for Gnus</a> <li><a file="tm-gnus-en">tm-MUA for GNUS</a> <li><a file="tm-mh-e-en">tm-MUA for mh-e</a> +<li><a file="tm-vm-en">tm-MUA for VM</a> <li><a file="tm-view-en">mime/viewer-mode</a> <li><a file="tm-edit-en">mime/editor-mode</a> </ul> @@ -1315,7 +1316,7 @@ for <a file="mh-e">mh-e</a> <li><a file="tm-gnus_en"><concept>tm-gnus</concept></a> for GNUS <li><a file="gnus-mime-en"><concept>gnus-mime</concept></a> for Gnus -<li><a file="tm-vm_en"><concept>tm-vm</concept></a> for VM +<li><a file="tm-vm-en"><concept>tm-vm</concept></a> for VM <li><concept>tm-rmail</concept> for RMAIL </ul>
--- a/man/tm/tm-en.texi Mon Aug 13 09:08:31 2007 +0200 +++ b/man/tm/tm-en.texi Mon Aug 13 09:09:02 2007 +0200 @@ -51,6 +51,8 @@ @item tm-MUA for mh-e (@ref{(tm-mh-e-en)}) @item +tm-MUA for VM (@ref{(tm-vm-en)}) +@item mime/viewer-mode (@ref{(tm-view-en)}) @item mime/editor-mode (@ref{(tm-edit-en)}) @@ -1866,7 +1868,7 @@ @item @strong{gnus-mime} (@ref{(gnus-mime-en)}) for Gnus @item -@strong{tm-vm} (@ref{(tm-vm_en)}) for VM +@strong{tm-vm} (@ref{(tm-vm-en)}) for VM @item @strong{tm-rmail} for RMAIL @end itemize
--- a/man/tm/tm-ja.sgml Mon Aug 13 09:08:31 2007 +0200 +++ b/man/tm/tm-ja.sgml Mon Aug 13 09:09:02 2007 +0200 @@ -1,5 +1,5 @@ <!doctype sinfo system> -<!-- $Id: tm-ja.sgml,v 1.2 1996/12/28 21:03:30 steve Exp $ --> +<!-- $Id: tm-ja.sgml,v 1.3 1997/01/30 02:22:58 steve Exp $ --> <head> <title>tm 7.100 Manual$B!JF|K\8lHG!K(B <author>$B<i2,(B $BCNI'(B <mail>morioka@jaist.ac.jp</mail> @@ -38,6 +38,7 @@ <li><a file="gnus-mime-ja">tm-MUA for Gnus</a> <li><a file="tm-gnus-ja">tm-MUA for GNUS</a> <li><a file="tm-mh-e-ja">tm-MUA for mh-e</a> +<li><a file="tm-vm-en">tm-MUA for VM</a> <li><a file="tm-view-ja">mime/viewer-mode</a> <li><a file="tm-edit-ja">mime/editor-mode</a> </ul> @@ -1367,10 +1368,11 @@ <concept>tm $BBg@9$j(B package</concept> $B$K$O(B <ul> -<li><a file="mh-e">mh-e</a> $BMQ$N(B <concept>tm-mh-e</concept> -<li>GNUS $BMQ$N(B <concept>tm-gnus</concept> +<li><a file="mh-e">mh-e</a> $BMQ$N(B + <a file="tm-mh-e-en"><concept>tm-mh-e</concept></a> +<li>GNUS $BMQ$N(B <a file="tm-gnus-ja"><concept>tm-gnus</concept></a> <li>Gnus $BMQ$N(B <a file="gnus-mime-ja"><concept>gnus-mime</concept></a> -<li>VM $BMQ$N(B <concept>tm-vm</concept> +<li>VM $BMQ$N(B <a file="tm-vm-en"><concept>tm-vm</concept></a> <li>RMAIL $BMQ$N(B <concept>tm-rmail</concept> </ul>
--- a/man/tm/tm-ja.texi Mon Aug 13 09:08:31 2007 +0200 +++ b/man/tm/tm-ja.texi Mon Aug 13 09:09:02 2007 +0200 @@ -52,6 +52,8 @@ @item tm-MUA for mh-e (@ref{(tm-mh-e-ja)}) @item +tm-MUA for VM (@ref{(tm-vm-en)}) +@item mime/viewer-mode (@ref{(tm-view-ja)}) @item mime/editor-mode (@ref{(tm-edit-ja)}) @@ -1881,13 +1883,14 @@ @itemize @bullet @item -mh-e (@ref{(mh-e)}) $BMQ$N(B @strong{tm-mh-e} +mh-e (@ref{(mh-e)}) $BMQ$N(B + @strong{tm-mh-e} (@ref{(tm-mh-e-en)}) @item -GNUS $BMQ$N(B @strong{tm-gnus} +GNUS $BMQ$N(B @strong{tm-gnus} (@ref{(tm-gnus-ja)}) @item Gnus $BMQ$N(B @strong{gnus-mime} (@ref{(gnus-mime-ja)}) @item -VM $BMQ$N(B @strong{tm-vm} +VM $BMQ$N(B @strong{tm-vm} (@ref{(tm-vm-en)}) @item RMAIL $BMQ$N(B @strong{tm-rmail} @end itemize
--- a/man/xemacs-faq.texi Mon Aug 13 09:08:31 2007 +0200 +++ b/man/xemacs-faq.texi Mon Aug 13 09:09:02 2007 +0200 @@ -83,6 +83,7 @@ * Q1.0.11:: Is there a port of XEmacs to the Macintosh? * Q1.0.12:: Is there a port of XEmacs to NextStep? * Q1.0.13:: Is there a port of XEmacs to OS/2? +* Q1.0.14:: Where can I get a printed copy of the XEmacs users manual? Policies: * Q1.1.1:: What is the FAQ editorial policy? @@ -299,11 +300,24 @@ port of GNU Emacs to NeXTstep and expressed interest in doing the XEmacs port, but never went any farther. -@node Q1.0.13, Q1.1.1, Q1.0.12, Introduction +@node Q1.0.13, Q1.0.14, Q1.0.12, Introduction @section Is there a port of XEmacs to OS/2? No, and there is no news of anyone working on it. +@node Q1.0.14, Q1.1.1, Q1.0.13, Introduction +@section Where can I obtain a printed copy of the XEmacs users manual? + +InfoDock Associates, a firm specializing in Emacs-related support and +development, will be maintaining the XEmacs user manual. The firm plans +to begin publishing printed copies of the manual in March 1997. + +@example + Web: http://www.xemacs.com + E-mail: <info@xemacs.com> + Tel: +1 408 243 3300 +@end example + @node Q1.1.1, Q1.1.2, Q1.0.13, Introduction @section What is the FAQ editorial policy? @@ -3696,19 +3710,17 @@ @node Q4.6.1, Q4.7.1, Q4.5.1, Subsystems @section What is Infodock? -NB: the information in this section is quite dated. - InfoDock is an integrated productivity toolset, mainly aimed at -technical people. It is built atop the XEmacs variant of GNU Emacs and -so has all of the power of Emacs, but with an easier to use and more -comprehensive menu-based user interface. The next section describes how -it differs from XEmacs and GNU Emacs from the Free Software Foundation. - -The quickest way to get a feel for InfoDock is to browse the InfoDock -Manual, especially the section on tools. This will help you decide -whether or not to download InfoDock for local use. This manual is -available in gzipped Postscript form, alongside the InfoDock -distribution. (See below for FTP retrieval instructions.) +technical people. It is developed and supported by InfoDock +Associates, a firm that offers custom support and development +for InfoDock, XEmacs and GNU Emacs. (http://www.infodock.com, +<info@infodock.com>, +1 408 243 3300). + +InfoDock is built atop the XEmacs variant of GNU Emacs and so has all of +the power of Emacs, but with an easier to use and more comprehensive +menu-based user interface. The bottom portion of this text describes +how it differs from XEmacs and GNU Emacs from the Free Software +Foundation. InfoDock is aimed at people who want a free, turn-key productivity environment. Although InfoDock is customizable, it is not intended for @@ -3718,11 +3730,11 @@ pre-customized environment in one package, which they need not touch more than once or twice a year to update to new revisions. -InfoDock is pre-built for SPARCstations running SunOS V4 or V5 -(Solaris). It is intended for use on a color display, although most -features will work on monochrome monitors. Simply unpack InfoDock -according to the instructions in the ID-INSTALL file and you are ready -to run. +InfoDock is pre-built for SPARC SunOS/Solaris systems, PA-RISC HP-UX, +and Intel Linux systems. It is intended for use on a color display, +although most features will work on monochrome monitors. Simply unpack +InfoDock according to the instructions in the ID-INSTALL file and you +are ready to run. The InfoDock Manual is concise, yet sufficient as a user guide for users who have never used an Emacs-type editor before. For users who are @@ -3730,41 +3742,32 @@ Emacs Manual. InfoDock menus are much more extensive and more mature than standard -Emacs menus. Each menu offers a @code{Manual} item which displays +Emacs menus. Each menu offers a @samp{Manual} item which displays documentation associated with the menu's functions. - -Three types of menubars are provided: - + +@noindent +Four types of menubars are provided: @enumerate @item An extensive menubar providing access to global InfoDock commands. - @item Mode-specific menubars tailored to the current major mode. - @item -A simple menubar for basic editing to help novices get started -with InfoDock. +A simple menubar for basic editing to help novices get started with InfoDock. +@item +The standard XEmacs menubar. @end enumerate -Most modes also include mode-specific popup menus. Additionally, region -and rectangle popup menus are included. - -@itemize @bullet -@item -@dfn{Hyperbole}, the everyday information manager, is a core part of +Most modes also include mode-specific popup menus. Additionally, region and +rectangle popup menus are included. + +@samp{Hyperbole}, the everyday information manager, is a core part of InfoDock. This provides context-sensitive mouse keys, a rolodex-type contact manager, programmable hypertext buttons, and an autonumbered outliner with embedded hyperlink anchors. -@item -@dfn{PIEmail}, the prototype Personalized Information Environment Mail -Tool, is included. - -@item -The @dfn{OO-Browser}, a multi-language object-oriented code browser, is -a standard part of InfoDock. -@end itemize +The @samp{OO-Browser}, a multi-language object-oriented code browser, is a +standard part of InfoDock. InfoDock saves a more extensive set of user options than other Emacs versions. @@ -3777,95 +3780,89 @@ Your working set of buffers is automatically saved and restored (if you answer yes to a prompt) between InfoDock sessions. -Refined color choices for code highlighting are provided for both dark -and light background display frames. - -The @kbd{C-z} key prefix performs frame-based commands which parallel -the @kbd{C-x} key prefix for window-based commands. +Refined color choices for code highlighting are provided for both dark and +light background display frames. + +The @kbd{C-z} key prefix performs frame-based commands which parallel the +@kbd{C-x} key prefix for window-based commands. The Smart Menu system is included for producing command menus on dumb -terminals. (InfoDock does not yet run on dumb terminals but will in -1995.) +terminals. Lisp libraries are better categorized according to function. -Extensions and improvements to many areas of Emacs are included, such -as: paragraph filling, mail reading with Rmail, shell handling, -outlining, code highlighting and browsing, and man page browsing. - +Extensions and improvements to many areas of Emacs are included, such as: +paragraph filling, mail reading with Rmail, shell handling, outlining, code +highlighting and browsing, and man page browsing. InfoDock questions, answers and discussion should go to the mail list -<URL:mailto:infodock@@hub.ucsb.edu>. - -Use <URL:mailto:infodock-request@@hub.ucsb.edu> to be added or removed -from the list. Always include your InfoDock version number when sending -help requests. - -InfoDock is available across the Internet via anonymous FTP. To get it, -first move to a directory into which you want the InfoDock archive files -placed. We will call this <DIST-DIR>. +@samp{infodock@@infodock.com}. Use +@samp{infodock-request@@infodock.com} to be added or removed from the +list. Always include your InfoDock version number when sending help +requests. + +InfoDock is available across the Internet via anonymous FTP. To get +it, first move to a directory into which you want the InfoDock archive +files placed. We will call this <DIST-DIR>. + +@example + cd <DIST-DIR> +@end example + +Ftp to ftp.xemacs.org (Internet Host ID = 128.174.252.16): @example -cd <DIST-DIR> -@end example - -FTP to ftp.cs.uiuc.edu (Internet Host ID = 128.174.252.1): - -@example -prompt> ftp ftp.cs.uiuc.edu + prompt> ftp ftp.xemacs.org @end example -Login as anonymous with your own <user-id>@@<site-name> as a password. - -@example -Name (ftp.cs.uiuc.edu): anonymous -331 Guest login ok, send your complete e-mail address as password. -Password: -<your-user-id@@your-domain> -230 Guest login ok, access restrictions apply. +Login as @samp{anonymous} with your own <user-id>@@<site-name> as a password. + +@example + Name (ftp.xemacs.org): anonymous + 331 Guest login ok, send your complete e-mail address as password. + Password: -<your-user-id@@your-domain> + 230 Guest login ok, access restrictions apply. @end example Move to the location of the InfoDock archives: @example -ftp> cd pub/xemacs/infodock + ftp> cd pub/infodock @end example Set your transfer mode to binary: @example -ftp> bin -200 Type set to I. + ftp> bin + 200 Type set to I. @end example Turn off prompting: @example -ftp> prompt -Interactive mode off. + ftp> prompt + Interactive mode off. @end example Retrieve the InfoDock archives that you want, either by using a -@code{get <file>} for each file you want or by using the following to +@samp{get <file>} for each file you want or by using the following to get a complete distribution, including all binaries: @example -ftp> mget ID-INSTALL -ftp> mget id-* + ftp> mget ID-INSTALL + ftp> mget id-* @end example Close the FTP connection: @example -ftp> quit -221 Goodbye. + ftp> quit + 221 Goodbye. @end example Read the @file{ID-INSTALL} file which you just retrieved for step-by-step installation instructions. -@emph{Note}: Hyperbole, the KOutliner, and OO-Browser are included in -XEmacs 19.14. - @node Q4.7.1, Q4.7.2, Q4.6.1, Subsystems @section What is AucTeX? Where do you get it?
--- a/src/ChangeLog Mon Aug 13 09:08:31 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:09:02 2007 +0200 @@ -1,3 +1,23 @@ +Mon Jan 27 21:46:53 1997 Tomasz J. Cholewo <tjchol01@mecca.spd.louisville.edu> + + * fileio.c (Fwrite_region_internal): pack lockname to write-region + handler. + +Mon Jan 27 04:50:50 1997 David Moore <dmoore@UCSD.EDU> + + * gmalloc.c (malloc): Guard against incompatible system mallocs + with conflicting symbols. + +Sun Jan 26 12:27:04 1997 Steven L Baur <steve@altair.xemacs.org> + + * redisplay.c (add_emchar_rune): Back out optimization change of + caching last_charset. + +Sun Jan 26 09:10:45 1997 Hrvoje Niksic <hniksic@srce.hr> + + * s/decosf4-0.h: Digital Unix 4.0 has a realpath, but it's buggy. + And I *do* mean buggy. + Thu Jan 23 10:41:19 1997 Steven L. Baur <steve@altair.xemacs.org> * puresize.h: Increase SUNPRO usage to reflect tm & cc-mode.
--- a/src/event-stream.c Mon Aug 13 09:08:31 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:09:02 2007 +0200 @@ -260,6 +260,8 @@ Chained through event_next() command_event_queue_tail is a pointer to the last-added element. */ +static Lisp_Object process_event_queue; +static Lisp_Object process_event_queue_tail; static Lisp_Object command_event_queue; static Lisp_Object command_event_queue_tail; @@ -1450,6 +1452,19 @@ /* enqueuing and dequeuing events */ /**********************************************************************/ +/* Add an event to the back of the process_event_queue */ +void +enqueue_process_event (Lisp_Object event) +{ + enqueue_event (event, &process_event_queue, &process_event_queue_tail); +} + +Lisp_Object +dequeue_process_event (void) +{ + return dequeue_event (&process_event_queue, &process_event_queue_tail); +} + /* Add an event to the back of the command-event queue: it will be the next event read after all pending events. This only works on keyboard, mouse-click, misc-user, and eval events. @@ -1839,7 +1854,8 @@ Charcount num_input_chars; static void -next_event_internal (Lisp_Object target_event, int allow_queued) +next_event_internal (Lisp_Object target_event, int allow_queued, + int allow_deferred) { struct gcpro gcpro1; /* QUIT; This is incorrect - the caller must do this because some @@ -1865,6 +1881,21 @@ } #endif } + else if (allow_deferred && !NILP (process_event_queue)) + { + Lisp_Object event = dequeue_process_event (); + Fcopy_event (event, target_event); + Fdeallocate_event (event); +#ifdef DEBUG_EMACS + if (debug_emacs_events) + { + write_c_string ("(process event queue) ", + Qexternal_debugging_output); + print_internal (target_event, Qexternal_debugging_output, 1); + write_c_string ("\n", Qexternal_debugging_output); + } +#endif + } else { struct Lisp_Event *e = XEVENT (target_event); @@ -2101,7 +2132,7 @@ { run_pre_idle_hook (); redisplay (); - next_event_internal (event, 1); + next_event_internal (event, 1, 1); Vquit_flag = Qnil; /* Read C-g as an event. */ store_this_key = 1; } @@ -2302,7 +2333,7 @@ /* This will take stuff off the command_event_queue, or read it from the event_stream, but it will not block. */ - next_event_internal (event, 1); + next_event_internal (event, 1, 1); Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it). It is vitally important that we reset Vquit_flag here. Otherwise, if we're @@ -2363,7 +2394,8 @@ Allow any pending output from subprocesses to be read by Emacs. It is read into the process' buffers or given to their filter functions. Non-nil arg PROCESS means do not return until some output has been received - from PROCESS. + from PROCESS. Nil arg PROCESS means do not return until some output has + been received from any process. If the second arg is non-nil, it is the maximum number of seconds to wait: this function will return after that much time even if no input has arrived from PROCESS. This argument may be a float, meaning wait some fractional @@ -2380,6 +2412,7 @@ Lisp_Object result = Qnil; int timeout_id; int timeout_enabled = 0; + int done = 0; struct buffer *old_buffer = current_buffer; /* We preserve the current buffer but nothing else. If a focus @@ -2392,7 +2425,7 @@ GCPRO2 (event, process); - if (!NILP (process) && (!NILP (timeout_secs) || !NILP (timeout_msecs))) + if (!NILP (timeout_secs) || !NILP (timeout_msecs)) { unsigned long msecs = 0; if (!NILP (timeout_secs)) @@ -2411,7 +2444,10 @@ event = Fmake_event (); - while (!NILP (process) + while (!done && + ((NILP (process) && timeout_enabled) || + (NILP (process) && event_stream_event_pending_p (0)) || + (!NILP (process)))) /* Calling detect_input_pending() is the wrong thing here, because that considers the Vunread_command_events and command_event_queue. We don't need to look at the command_event_queue because we are @@ -2426,13 +2462,13 @@ loop will process it, and I don't think that there is ever a time when one calls accept-process-output with a nil argument and really need the processes to be handled. */ - || (!EQ (result, Qt) && event_stream_event_pending_p (0))) { /* If our timeout has arrived, we move along. */ if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0)) { timeout_enabled = 0; - process = Qnil; /* We're done. */ + done = 1; /* We're done. */ + continue; /* Don't call next_event_internal */ } QUIT; /* next_event_internal() does not QUIT, so check for ^G @@ -2440,7 +2476,7 @@ less likely that the filter will actually be aborted. */ - next_event_internal (event, 0); + next_event_internal (event, 0, 1); /* If C-g was pressed while we were waiting, Vquit_flag got set and next_event_internal() also returns C-g. When we enqueue the C-g below, it will get discarded. The @@ -2449,9 +2485,10 @@ { case process_event: { - if (EQ (XEVENT (event)->event.process.process, process)) + if (NILP (process) || + EQ (XEVENT (event)->event.process.process, process)) { - process = Qnil; + done = 1; /* RMS's version always returns nil when proc is nil, and only returns t if input ever arrived on proc. */ result = Qt; @@ -2518,15 +2555,22 @@ consumer as well. We don't care about command and eval-events anyway. */ - next_event_internal (event, 0); /* blocks */ + next_event_internal (event, 0, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ switch (XEVENT_TYPE (event)) { + case process_event: + { + /* Avoid calling filter functions recursively by squirreling + away process events */ + enqueue_process_event (Fcopy_event (event, Qnil)); + goto DONE_LABEL; + } + case timeout_event: /* We execute the event even if it's ours, and notice that it's happened above. */ case pointer_motion_event: - case process_event: case magic_event: { EXECUTE_INTERNAL: @@ -2623,7 +2667,7 @@ consumer as well. In fact, we know there's nothing on the command_event_queue that we didn't just put there. */ - next_event_internal (event, 0); /* blocks */ + next_event_internal (event, 0, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event)) @@ -2639,6 +2683,14 @@ enqueue_command_event (Fcopy_event (event, Qnil)); break; } + + case process_event: + { + /* Avoid recursive calls to process filters */ + enqueue_process_event (Fcopy_event (event, Qnil)); + break; + } + case timeout_event: /* We execute the event even if it's ours, and notice that it's happened above. */ @@ -2693,7 +2745,7 @@ command_event_queue; there are only user and eval-events there, and we'd just have to put them back anyway. */ - next_event_internal (event, 0); + next_event_internal (event, 0, 1); /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event) || (XEVENT_TYPE (event) == eval_event) @@ -4129,6 +4181,10 @@ staticpro (&command_event_queue); command_event_queue_tail = Qnil; + process_event_queue = Qnil; + staticpro (&process_event_queue); + process_event_queue_tail = Qnil; + Vlast_selected_frame = Qnil; staticpro (&Vlast_selected_frame);
--- a/src/fileio.c Mon Aug 13 09:08:31 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:09:02 2007 +0200 @@ -3393,8 +3393,8 @@ if (!NILP (handler)) { - Lisp_Object val = call7 (handler, Qwrite_region, start, end, - filename, append, visit, codesys); + Lisp_Object val = call8 (handler, Qwrite_region, start, end, + filename, append, visit, lockname, codesys); if (visiting) { BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer);
--- a/src/gmalloc.c Mon Aug 13 09:08:31 2007 +0200 +++ b/src/gmalloc.c Mon Aug 13 09:09:02 2007 +0200 @@ -556,13 +556,13 @@ return NULL; #endif - if (__malloc_hook != NULL) - return (*__malloc_hook) (size); - if (!__malloc_initialized) if (!initialize ()) return NULL; + if (__malloc_hook != NULL) + return (*__malloc_hook) (size); + #ifdef SUNOS_LOCALTIME_BUG /* Workaround for localtime() allocating 8 bytes and writing 9 bug... */ if (size < 16)
--- a/src/redisplay.c Mon Aug 13 09:08:31 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 09:09:02 2007 +0200 @@ -876,7 +876,8 @@ data->last_char_width = -1; data->new_ascent = max (data->new_ascent, (int) fi->ascent); data->new_descent = max (data->new_descent, (int) fi->descent); - data->last_charset = charset; + /* The following line causes display goobers and I don't know why */ + /*data->last_charset = charset;*/ } width = data->last_char_width;
--- a/src/s/decosf4-0.h Mon Aug 13 09:08:31 2007 +0200 +++ b/src/s/decosf4-0.h Mon Aug 13 09:09:02 2007 +0200 @@ -26,3 +26,7 @@ #define SYSTEM_MALLOC #define HAVE_RENAME + +/* Digital Unix 4.0 has a realpath, but it's buggy. And I + *do* mean buggy. */ +#undef HAVE_REALPATH
--- a/src/scrollbar-x.c Mon Aug 13 09:08:31 2007 +0200 +++ b/src/scrollbar-x.c Mon Aug 13 09:09:02 2007 +0200 @@ -46,7 +46,7 @@ scrollbar is incredibly stupid about updating the thumb and causes lots of flicker if it is done too often. */ static int inhibit_thumb_size_change; -int stupid_vertical_scrollbar_drag_hack = 1; +int stupid_vertical_scrollbar_drag_hack; /* Doesn't work with athena */ #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) @@ -858,4 +858,5 @@ #elif defined (LWLIB_SCROLLBARS_ATHENA) Fprovide (intern ("athena-scrollbars")); #endif + stupid_vertical_scrollbar_drag_hack = 1; }