Mercurial > hg > xemacs-beta
changeset 60:2e6f5e180fb8 r19-16-pre5
Import from CVS: tag r19-16-pre5
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:58:59 +0200 |
| parents | 37115eea810c |
| children | dd3566f69ebd |
| files | CHANGES-beta lisp/gnus/md5.el lisp/prim/glyphs.el lisp/tl/mu-cite.el lisp/tl/std11-parse.el lisp/tl/std11.el lisp/version.el lisp/w3/md5.el man/internals/internals.texi src/dired.c src/glyphs-x.c src/s/irix6-0.h |
| diffstat | 12 files changed, 60 insertions(+), 2036 deletions(-) [+] |
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 08:58:38 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 08:58:59 2007 +0200 @@ -1,4 +1,10 @@ -*- indented-text -*- +to 19.16 pre5 -- "Staten Island" +-- Irix 6 build problem fixed +-- `directory-files' stack overrun fixed +-- jpeg detection corrected +-- image autodetection and jpeg load fix synched with 20.3 + to 19.16 pre4 -- "Bronx" -- etc/Joke files restored -- Various build patches from Darrell Kindred
--- a/lisp/gnus/md5.el Mon Aug 13 08:58:38 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,409 +0,0 @@ -;;; md5.el -- MD5 Message Digest Algorithm -;;; Gareth Rees <gdr11@cl.cam.ac.uk> - -;; LCD Archive Entry: -;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| -;; MD5 cryptographic message digest algorithm| -;; 13-Nov-95|1.0|~/misc/md5.el.Z| - -;;; Details: ------------------------------------------------------------------ - -;; This is a direct translation into Emacs LISP of the reference C -;; implementation of the MD5 Message-Digest Algorithm written by RSA -;; Data Security, Inc. -;; -;; The algorithm takes a message (that is, a string of bytes) and -;; computes a 16-byte checksum or "digest" for the message. This digest -;; is supposed to be cryptographically strong in the sense that if you -;; are given a 16-byte digest D, then there is no easier way to -;; construct a message whose digest is D than to exhaustively search the -;; space of messages. However, the robustness of the algorithm has not -;; been proven, and a similar algorithm (MD4) was shown to be unsound, -;; so treat with caution! -;; -;; The C algorithm uses 32-bit integers; because GNU Emacs -;; implementations provide 28-bit integers (with 24-bit integers on -;; versions prior to 19.29), the code represents a 32-bit integer as the -;; cons of two 16-bit integers. The most significant word is stored in -;; the car and the least significant in the cdr. The algorithm requires -;; at least 17 bits of integer representation in order to represent the -;; carry from a 16-bit addition. - -;;; Usage: -------------------------------------------------------------------- - -;; To compute the MD5 Message Digest for a message M (represented as a -;; string or as a vector of bytes), call -;; -;; (md5-encode M) -;; -;; which returns the message digest as a vector of 16 bytes. If you -;; need to supply the message in pieces M1, M2, ... Mn, then call -;; -;; (md5-init) -;; (md5-update M1) -;; (md5-update M2) -;; ... -;; (md5-update Mn) -;; (md5-final) - -;;; Copyright and licence: ---------------------------------------------------- - -;; Copyright (C) 1995 by Gareth Rees -;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; -;; md5.el 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. -;; -;; md5.el 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. -;; -;; The original copyright notice is given below, as required by the -;; licence for the original code. This code is distributed under *both* -;; RSA's original licence and the GNU General Public Licence. (There -;; should be no problems, as the former is more liberal than the -;; latter). - -;;; Original copyright notice: ------------------------------------------------ - -;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. -;; -;; License to copy and use this software is granted provided that it is -;; identified as the "RSA Data Security, Inc. MD5 Message- Digest -;; Algorithm" in all material mentioning or referencing this software or -;; this function. -;; -;; License is also granted to make and use derivative works provided -;; that such works are identified as "derived from the RSA Data -;; Security, Inc. MD5 Message-Digest Algorithm" in all material -;; mentioning or referencing the derived work. -;; -;; RSA Data Security, Inc. makes no representations concerning either -;; the merchantability of this software or the suitability of this -;; software for any particular purpose. It is provided "as is" without -;; express or implied warranty of any kind. -;; -;; These notices must be retained in any copies of any part of this -;; documentation and/or software. - -;;; Code: --------------------------------------------------------------------- - -(defvar md5-program "md5" - "*Program that reads a message on its standard input and writes an -MD5 digest on its output.") - -(defvar md5-maximum-internal-length 4096 - "*The maximum size of a piece of data that should use the MD5 routines -written in lisp. If a message exceeds this, it will be run through an -external filter for processing. Also see the `md5-program' variable. -This variable has no effect if you call the md5-init|update|final -functions - only used by the `md5' function's simpler interface.") - -(defvar md5-bits (make-vector 4 0) - "Number of bits handled, modulo 2^64. -Represented as four 16-bit numbers, least significant first.") -(defvar md5-buffer (make-vector 4 '(0 . 0)) - "Scratch buffer (four 32-bit integers).") -(defvar md5-input (make-vector 64 0) - "Input buffer (64 bytes).") - -(defun md5-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun md5-encode (message) - "Encodes MESSAGE using the MD5 message digest algorithm. -MESSAGE must be a string or an array of bytes. -Returns a vector of 16 bytes containing the message digest." - (if (<= (length message) md5-maximum-internal-length) - (progn - (md5-init) - (md5-update message) - (md5-final)) - (save-excursion - (set-buffer (get-buffer-create " *md5-work*")) - (erase-buffer) - (insert message) - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") - t (current-buffer) nil - "-c" md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (let ((data (buffer-substring (point-min) (+ (point-min) 32))) - (vec (make-vector 16 0)) - (ctr 0)) - (while (< ctr 16) - (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) - (md5-unhex (aref data (1+ (* ctr 2)))))) - (setq ctr (1+ ctr))))))) - -(defsubst md5-add (x y) - "Return 32-bit sum of 32-bit integers X and Y." - (let ((m (+ (car x) (car y))) - (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) - -;; FF, GG, HH and II are basic MD5 functions, providing transformations -;; for rounds 1, 2, 3 and 4 respectively. Each function follows this -;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x -;; by y bits to the left): -;; -;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; -;; so we use the macro `md5-make-step' to construct each one. The -;; helper functions F, G, H and I operate on 16-bit numbers; the full -;; operation splits its inputs, operates on the halves separately and -;; then puts the results together. - -(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) -(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) -(defsubst md5-H (x y z) (logxor x y z)) -(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) - -(defmacro md5-make-step (name func) - (` - (defun (, name) (a b c d x s ac) - (let* - ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) - (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) - (m2 (logand 65535 (+ m1 (lsh l1 -16)))) - (l2 (logand 65535 l1)) - (m3 (logand 65535 (if (> s 15) - (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh m2 s) (lsh l2 (- s 16)))))) - (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) - (+ (lsh l2 s) (lsh m2 (- s 16))))))) - (md5-add (cons m3 l3) b))))) - -(md5-make-step md5-FF md5-F) -(md5-make-step md5-GG md5-G) -(md5-make-step md5-HH md5-H) -(md5-make-step md5-II md5-I) - -(defun md5-init () - "Initialise the state of the message-digest routines." - (aset md5-bits 0 0) - (aset md5-bits 1 0) - (aset md5-bits 2 0) - (aset md5-bits 3 0) - (aset md5-buffer 0 '(26437 . 8961)) - (aset md5-buffer 1 '(61389 . 43913)) - (aset md5-buffer 2 '(39098 . 56574)) - (aset md5-buffer 3 '( 4146 . 21622))) - -(defun md5-update (string) - "Update the current MD5 state with STRING (an array of bytes)." - (let ((len (length string)) - (i 0) - (j 0)) - (while (< i len) - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Store this byte (truncating to 8 bits to be sure) - (aset md5-input j (logand 255 (aref string i))) - - ;; Update number of bits by 8 (modulo 2^64) - (let ((c 8) (k 0)) - (while (and (> c 0) (< k 4)) - (let ((b (aref md5-bits k))) - (aset md5-bits k (logand 65535 (+ b c))) - (setq c (if (> b (- 65535 c)) 1 0) - k (1+ k))))) - - ;; Increment number of bytes processed - (setq i (1+ i)) - - ;; When 64 bytes accumulated, pack them into sixteen 32-bit - ;; integers in the array `in' and then tranform them. - (if (= j 63) - (let ((in (make-vector 16 (cons 0 0))) - (k 0) - (kk 0)) - (while (< k 16) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4))) - (md5-transform in)))))) - -(defun md5-pack (array i) - "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." - (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) - (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) - -(defun md5-byte (array n b) - "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." - (let ((e (aref array n))) - (cond ((eq b 0) (logand 255 (cdr e))) - ((eq b 1) (lsh (cdr e) -8)) - ((eq b 2) (logand 255 (car e))) - ((eq b 3) (lsh (car e) -8))))) - -(defun md5-final () - (let ((in (make-vector 16 (cons 0 0))) - (j 0) - (digest (make-vector 16 0)) - (padding)) - - ;; Save the number of bits in the message - (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) - (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) - - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Pad out computation to 56 bytes modulo 64 - (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) - (aset padding 0 128) - (md5-update padding) - - ;; Append length in bits and transform - (let ((k 0) (kk 0)) - (while (< k 14) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4)))) - (md5-transform in) - - ;; Store the results in the digest - (let ((k 0) (kk 0)) - (while (< k 4) - (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) - (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) - (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) - (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) - (setq k (+ k 1) kk (+ kk 4)))) - - ;; Return digest - digest)) - -;; It says in the RSA source, "Note that if the Mysterious Constants are -;; arranged backwards in little-endian order and decrypted with the DES -;; they produce OCCULT MESSAGES!" Security through obscurity? - -(defun md5-transform (in) - "Basic MD5 step. Transform md5-buffer based on array IN." - (let ((a (aref md5-buffer 0)) - (b (aref md5-buffer 1)) - (c (aref md5-buffer 2)) - (d (aref md5-buffer 3))) - (setq - a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) - d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) - c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) - b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) - a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) - d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) - c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) - b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) - a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) - d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) - c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) - b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) - a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) - d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) - c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) - b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) - a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) - d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) - c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) - b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) - a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) - d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) - c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) - b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) - a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) - d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) - c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) - b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) - a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) - d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) - c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) - b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) - a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) - d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) - c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) - b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) - a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) - d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) - c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) - b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) - a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) - d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) - c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) - b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) - a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) - d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) - c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) - b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) - a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) - d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) - c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) - b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) - a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) - d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) - c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) - b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) - a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) - d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) - c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) - b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) - a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) - d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) - c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) - b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Here begins the merger with the XEmacs API and the md5.el from the URL -;;; package. Courtesy wmperry@spry.com -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments START and END denote buffer positions for computing the -hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (<= (point-max) md5-maximum-internal-length) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") - t buffer nil - "-c" md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (kill-buffer buffer) nil)))) - -(provide 'md5) - -;;; md5.el ends here ----------------------------------------------------------
--- a/lisp/prim/glyphs.el Mon Aug 13 08:58:38 2007 +0200 +++ b/lisp/prim/glyphs.el Mon Aug 13 08:58:59 2007 +0200 @@ -596,19 +596,19 @@ ;; initialize default image types (if (featurep 'x) (set-console-type-image-conversion-list 'x - `(,@(if (featurep 'xpm) '(("\.xpm$" [xpm :file nil] 2))) - ,@(if (featurep 'xpm) '(("^/\\* XPM \\*/" [xpm :data nil] 2))) - ,@(if (featurep 'xface) '(("^X-Face:" [xface :data nil] 2))) - ,@(if (featurep 'gif) '(("\.gif$" [gif :file nil] 2))) - ,@(if (featurep 'gif) '(("^GIF8[79]" [gif :data nil] 2))) - ,@(if (featurep 'jpeg) '(("\.jpeg$" [jpeg :file nil] 2))) - ,@(if (featurep 'jpeg) '(("\.jpg$" [jpeg :file nil] 2))) + `(,@(if (featurep 'xpm) '(("\\.xpm$\\'" [xpm :file nil] 2))) + ("\\.xbm\\'" [xbm :file nil] 2) + ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2))) + ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2))) + ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2))) + ,@(if (featurep 'gif) '(("\\`GIF8[79]" [gif :data nil] 2))) + ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2))) ;; all of the JFIF-format JPEG's that I've seen begin with ;; the following. I have no idea if this is standard. - ,@(if (featurep 'jpeg) '(("^\377\330\340\000\020JFIF" + ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF" [jpeg :data nil] 2))) - ,@(if (featurep 'png) '(("\.png$" [png :file nil] 2))) - ,@(if (featurep 'png) '(("^\211PNG" [png :data nil] 2))) + ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) + ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) ("" [autodetect :data nil] 2)))) ;; #### this should really be formatted-string, not string but we ;; don't have it implemented yet
--- a/lisp/tl/mu-cite.el Mon Aug 13 08:58:38 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,480 +0,0 @@ -;;; mu-cite.el --- yet another citation tool for GNU Emacs - -;; Copyright (C) 1995,1996 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.1.1.1 $ -;; Keywords: mail, news, citation - -;; This file is 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 this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; - How to use -;; 1. bytecompile this file and copy it to the apropriate directory. -;; 2. put the following lines to your ~/.emacs: -;; for EMACS 19 or later and XEmacs -;; (autoload 'mu-cite/cite-original "mu-cite" nil t) -;; ;; for all but message-mode -;; (add-hook 'mail-citation-hook 'mu-cite/cite-original) -;; ;; for message-mode only -;; (setq message-cite-function (function mu-cite/cite-original)) -;; for EMACS 18 -;; ;; for all but mh-e -;; (add-hook 'mail-yank-hooks (function mu-cite/cite-original)) -;; ;; for mh-e only -;; (add-hook 'mh-yank-hooks (function mu-cite/cite-original)) - -;;; Code: - -(require 'std11) -(require 'tl-str) -(require 'tl-list) - - -;;; @ version -;;; - -(defconst mu-cite/RCS-ID - "$Id: mu-cite.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $") -(defconst mu-cite/version (get-version-string mu-cite/RCS-ID)) - - -;;; @ formats -;;; - -(defvar cited-prefix-regexp "^[^ \t>]*[>|]+[ \t#]*") -(defvar mu-cite/cited-prefix-regexp "\\(^[^ \t\n>]+>+[ \t]*\\|^[ \t]*$\\)") - -(defvar mu-cite/prefix-format '(prefix-register-verbose "> ") - "*List to represent citation prefix. -Each elements must be string or method name.") -(defvar mu-cite/top-format '(in-id - ">>>>> " from " wrote:\n") - "*List to represent top string of citation. -Each elements must be string or method name.") - - -;;; @ hooks -;;; - -(defvar mu-cite/pre-cite-hook nil - "*List of functions called before citing a region of text.") -(defvar mu-cite/post-cite-hook nil - "*List of functions called after citing a region of text.") - - -;;; @ field -;;; - -(defvar mu-cite/get-field-value-method-alist - (list (cons 'mh-letter-mode - (function - (lambda (name) - (if (and (stringp mh-sent-from-folder) - (numberp mh-sent-from-msg)) - (save-excursion - (set-buffer mh-sent-from-folder) - (set-buffer mh-show-buffer) - (and (boundp 'mime::preview/article-buffer) - (bufferp mime::preview/article-buffer) - (set-buffer mime::preview/article-buffer)) - (std11-field-body name) - )) - ))))) - -(defun mu-cite/get-field-value (name) - (or (std11-field-body name) - (let ((method (assq major-mode mu-cite/get-field-value-method-alist))) - (if method - (funcall (cdr method) name) - )))) - - -;;; @ prefix registration -;;; - -(defvar mu-cite/registration-file - (expand-file-name "~/.mu-cite.el") - "*The name of the user environment file for mu-cite.") - -(defvar mu-cite/allow-null-string-registration nil - "*If non-nil, null-string citation-name is registered.") - -(defvar mu-cite/registration-symbol 'mu-cite/citation-name-alist) - -(defvar mu-cite/citation-name-alist nil) -(load mu-cite/registration-file t t t) -(or (eq 'mu-cite/citation-name-alist mu-cite/registration-symbol) - (setq mu-cite/citation-name-alist - (symbol-value mu-cite/registration-symbol)) - ) -(defvar mu-cite/minibuffer-history nil) - -;; get citation-name from the database -(defun mu-cite/get-citation-name (from) - (assoc-value from mu-cite/citation-name-alist) - ) - -;; register citation-name to the database -(defun mu-cite/add-citation-name (name from) - (setq mu-cite/citation-name-alist - (put-alist from name mu-cite/citation-name-alist)) - (mu-cite/save-to-file) - ) - -;; save to file -(defun mu-cite/save-to-file () - (let* ((filename mu-cite/registration-file) - (buffer (get-buffer-create " *mu-register*"))) - (save-excursion - (set-buffer buffer) - (setq buffer-file-name filename) - (erase-buffer) - (insert - (format ";;; %s\n" (file-name-nondirectory filename))) - (insert - (format ";;; This file is generated automatically by mu-cite %s.\n\n" - mu-cite/version)) - (insert (format "(setq %s\n '(" mu-cite/registration-symbol)) - (insert (mapconcat - (function prin1-to-string) - mu-cite/citation-name-alist "\n ")) - (insert "\n ))\n\n") - (insert - (format ";;; %s ends here.\n" (file-name-nondirectory filename))) - (save-buffer)) - (kill-buffer buffer))) - - -;;; @ item methods -;;; - -;;; @@ ML count -;;; - -(defvar mu-cite/ml-count-field-list - '("X-Ml-Count" "X-Mail-Count" "X-Seqno" "X-Sequence" "Mailinglist-Id")) - -(defun mu-cite/get-ml-count-method () - (let ((field-list mu-cite/ml-count-field-list)) - (catch 'tag - (while field-list - (let* ((field (car field-list)) - (ml-count (mu-cite/get-field-value field))) - (if (and ml-count (string-match "[0-9]+" ml-count)) - (throw 'tag - (substring ml-count - (match-beginning 0)(match-end 0)) - )) - (setq field-list (cdr field-list)) - ))))) - - -;;; @@ prefix and registration -;;; - -(defun mu-cite/get-prefix-method () - (or (mu-cite/get-citation-name (mu-cite/get-value 'address)) - ">") - ) - -(defun mu-cite/get-prefix-register-method () - (let ((addr (mu-cite/get-value 'address))) - (or (mu-cite/get-citation-name addr) - (let ((return - (read-string "Citation name? " - (or (mu-cite/get-value 'x-attribution) - (mu-cite/get-value 'full-name)) - 'mu-cite/minibuffer-history) - )) - (if (and (or mu-cite/allow-null-string-registration - (not (string-equal return ""))) - (y-or-n-p (format "Register \"%s\"? " return))) - (mu-cite/add-citation-name return addr) - ) - return)))) - -(defun mu-cite/get-prefix-register-verbose-method () - (let* ((addr (mu-cite/get-value 'address)) - (return1 (mu-cite/get-citation-name addr)) - (return (read-string "Citation name? " - (or return1 - (mu-cite/get-value 'x-attribution) - (mu-cite/get-value 'full-name)) - 'mu-cite/minibuffer-history)) - ) - (if (and (or mu-cite/allow-null-string-registration - (not (string-equal return ""))) - (not (string-equal return return1)) - (y-or-n-p (format "Register \"%s\"? " return)) - ) - (mu-cite/add-citation-name return addr) - ) - return)) - - -;;; @@ set up -;;; - -(defvar mu-cite/default-methods-alist - (list (cons 'from - (function - (lambda () - (mu-cite/get-field-value "From") - ))) - (cons 'date - (function - (lambda () - (mu-cite/get-field-value "Date") - ))) - (cons 'message-id - (function - (lambda () - (mu-cite/get-field-value "Message-Id") - ))) - (cons 'subject - (function - (lambda () - (mu-cite/get-field-value "Subject") - ))) - (cons 'ml-name - (function - (lambda () - (mu-cite/get-field-value "X-Ml-Name") - ))) - (cons 'ml-count (function mu-cite/get-ml-count-method)) - (cons 'address-structure - (function - (lambda () - (car - (std11-parse-address-string (mu-cite/get-value 'from)) - )))) - (cons 'full-name - (function - (lambda () - (std11-full-name-string - (mu-cite/get-value 'address-structure)) - ))) - (cons 'address - (function - (lambda () - (std11-address-string - (mu-cite/get-value 'address-structure)) - ))) - (cons 'id - (function - (lambda () - (let ((ml-name (mu-cite/get-value 'ml-name))) - (if ml-name - (concat "[" - ml-name - " : No." - (mu-cite/get-value 'ml-count) - "]") - (mu-cite/get-value 'message-id) - ))))) - (cons 'in-id - (function - (lambda () - (let ((id (mu-cite/get-value 'id))) - (if id - (format ">>>>> In %s \n" id) - ""))))) - (cons 'prefix (function mu-cite/get-prefix-method)) - (cons 'prefix-register - (function mu-cite/get-prefix-register-method)) - (cons 'prefix-register-verbose - (function mu-cite/get-prefix-register-verbose-method)) - (cons 'x-attribution - (function - (lambda () - (mu-cite/get-field-value "X-Attribution") - ))) - )) - - -;;; @ fundamentals -;;; - -(defvar mu-cite/methods-alist nil) - -(defun mu-cite/make-methods () - (setq mu-cite/methods-alist - (copy-alist mu-cite/default-methods-alist)) - (run-hooks 'mu-cite/instantiation-hook) - ) - -(defun mu-cite/get-value (item) - (let ((ret (assoc-value item mu-cite/methods-alist))) - (if (functionp ret) - (prog1 - (setq ret (funcall ret)) - (set-alist 'mu-cite/methods-alist item ret) - ) - ret))) - -(defun mu-cite/eval-format (list) - (mapconcat (function - (lambda (elt) - (cond ((stringp elt) elt) - ((symbolp elt) (mu-cite/get-value elt)) - ))) - list "") - ) - - -;;; @ main function -;;; - -(defun mu-cite/cite-original () - "Citing filter function. -This is callable from the various mail and news readers' reply -function according to the agreed upon standard." - (interactive) - (mu-cite/make-methods) - (save-restriction - (if (< (mark t) (point)) - (exchange-point-and-mark)) - (narrow-to-region (point)(point-max)) - (run-hooks 'mu-cite/pre-cite-hook) - (let ((last-point (point)) - (top (mu-cite/eval-format mu-cite/top-format)) - (prefix (mu-cite/eval-format mu-cite/prefix-format)) - ) - (if (re-search-forward "^$\\|^-+$" nil nil) - (forward-line 1) - ) - (widen) - (delete-region last-point (point)) - (insert top) - (setq last-point (point)) - (while (< (point)(mark t)) - (or (looking-at mu-cite/cited-prefix-regexp) - (insert prefix)) - (forward-line 1)) - (goto-char last-point) - ) - (run-hooks 'mu-cite/post-cite-hook) - )) - - -;;; @ message editing utilities -;;; - -(defun fill-cited-region (beg end) - (interactive "*r") - (save-excursion - (save-restriction - (goto-char end) - (while (not (eolp)) - (backward-char) - ) - (setq end (point)) - (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 - (nth 1 ret) - (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)) - ) - (goto-char (point-min)) - (while (search-forward pat nil t) - (if (and (> (match-beginning 0) (point-min)) - (member (char-category - (char-before (match-beginning 0))) - '("a" "l")) - ) - (replace-match " ") - (replace-match "") - ) - ) - (goto-char (point-min)) - (fill-region (point-min) (point-max)) - )))) - -(defvar citation-mark-chars ">}|") - -(defun compress-cited-prefix () - (interactive) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (while (re-search-forward - (concat "^\\([ \t]*[^ \t\n" citation-mark-chars "]*[" - citation-mark-chars "]\\)+") nil t) - (let* ((b (match-beginning 0)) - (e (match-end 0)) - (prefix (buffer-substring b e)) - ps pe (s 0) - (nest (let ((i 0)) - (if (string-match "<[^<>]+>" prefix) - (setq prefix (substring prefix 0 (match-beginning 0))) - ) - (while (string-match - (concat "\\([" citation-mark-chars "]+\\)[ \t]*") - prefix s) - (setq i (+ i (- (match-end 1)(match-beginning 1))) - ps s - pe (match-beginning 1) - s (match-end 0) - )) - i))) - (if (and ps (< ps pe)) - (progn - (delete-region b e) - (insert (concat (substring prefix ps pe) (make-string nest ?>))) - )))))) - -(defun replace-top-string (old new) - (interactive "*sOld string: \nsNew string: ") - (while (re-search-forward - (concat "^" (regexp-quote old)) nil t) - (replace-match new) - )) - - -;;; @ end -;;; - -(provide 'mu-cite) - -(run-hooks 'mu-cite-load-hook) - -;;; mu-cite.el ends here
--- a/lisp/tl/std11-parse.el Mon Aug 13 08:58:38 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,441 +0,0 @@ -;;; std11-parse.el --- STD 11 parser for GNU Emacs - -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11-parse.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $ - -;; This file is 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 This program; 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 'std11) - -(autoload 'find-charset-string "emu") - - -;;; @ lexical analyze -;;; - -(defconst std11-space-chars " \t\n") -(defconst std11-spaces-regexp (concat "^[" std11-space-chars "]+")) -(defconst std11-special-chars "][()<>@,;:\\<>.\"") -(defconst std11-atom-regexp - (concat "^[^" std11-special-chars std11-space-chars "]+")) - -(defun std11-analyze-spaces (str) - (if (string-match std11-spaces-regexp str) - (let ((end (match-end 0))) - (cons (cons 'spaces (substring str 0 end)) - (substring str end) - )))) - -(defun std11-analyze-special (str) - (if (and (> (length str) 0) - (find (aref str 0) std11-special-chars) - ) - (cons (cons 'specials (substring str 0 1)) - (substring str 1) - ))) - -(defun std11-analyze-atom (str) - (if (string-match std11-atom-regexp str) - (let ((end (match-end 0))) - (cons (cons 'atom (substring str 0 end)) - (substring str end) - )))) - -(defun std11-check-enclosure (str open close &optional recursive from) - (let ((len (length str)) - (i (or from 0)) - ) - (if (and (> len i) - (eq (aref str i) open)) - (let (p chr dest) - (setq i (1+ i)) - (catch 'tag - (while (< i len) - (setq chr (aref str i)) - (cond ((eq chr ?\\) - (setq i (1+ i)) - (if (>= i len) - (throw 'tag nil) - ) - (setq i (1+ i)) - ) - ((eq chr close) - (throw 'tag (1+ i)) - ) - ((eq chr open) - (if (and recursive - (setq p (std11-check-enclosure - str open close recursive i)) - ) - (setq i p) - (throw 'tag nil) - )) - (t - (setq i (1+ i)) - )) - )))))) - -(defun std11-analyze-quoted-string (str) - (let ((p (std11-check-enclosure str ?\" ?\"))) - (if p - (cons (cons 'quoted-string (substring str 1 (1- p))) - (substring str p)) - ))) - -(defun std11-analyze-domain-literal (str) - (let ((p (std11-check-enclosure str ?\[ ?\]))) - (if p - (cons (cons 'domain-literal (substring str 1 (1- p))) - (substring str p)) - ))) - -(defun std11-analyze-comment (str) - (let ((p (std11-check-enclosure str ?\( ?\) t))) - (if p - (cons (cons 'comment (substring str 1 (1- p))) - (substring str p)) - ))) - -(defun std11-lexical-analyze (str) - (let (dest ret) - (while (not (string-equal str "")) - (setq ret - (or (std11-analyze-quoted-string str) - (std11-analyze-domain-literal str) - (std11-analyze-comment str) - (std11-analyze-spaces str) - (std11-analyze-special str) - (std11-analyze-atom str) - '((error) . "") - )) - (setq dest (cons (car ret) dest)) - (setq str (cdr ret)) - ) - (nreverse dest) - )) - - -;;; @ parser -;;; - -(defun std11-ignored-token-p (token) - (let ((type (car token))) - (or (eq type 'spaces)(eq type 'comment)) - )) - -(defun std11-parse-token (lal) - (let (token itl) - (while (and lal - (progn - (setq token (car lal)) - (std11-ignored-token-p token) - )) - (setq lal (cdr lal)) - (setq itl (cons token itl)) - ) - (cons (nreverse (cons token itl)) - (cdr lal)) - )) - -(defun std11-parse-ascii-token (lal) - (let (token itl parsed token-value) - (while (and lal - (setq token (car lal)) - (if (and (setq token-value (cdr token)) - (find-charset-string token-value) - ) - (setq token nil) - (std11-ignored-token-p token) - )) - (setq lal (cdr lal)) - (setq itl (cons token itl)) - ) - (if (and token - (setq parsed (nreverse (cons token itl))) - ) - (cons parsed (cdr lal)) - ))) - -(defun std11-parse-token-or-comment (lal) - (let (token itl) - (while (and lal - (progn - (setq token (car lal)) - (eq (car token) 'spaces) - )) - (setq lal (cdr lal)) - (setq itl (cons token itl)) - ) - (cons (nreverse (cons token itl)) - (cdr lal)) - )) - -(defun std11-parse-word (lal) - (let ((ret (std11-parse-ascii-token lal))) - (if ret - (let ((elt (car ret)) - (rest (cdr ret)) - ) - (if (or (assq 'atom elt) - (assq 'quoted-string elt)) - (cons (cons 'word elt) rest) - ))))) - -(defun std11-parse-word-or-comment (lal) - (let ((ret (std11-parse-token-or-comment lal))) - (if ret - (let ((elt (car ret)) - (rest (cdr ret)) - ) - (cond ((or (assq 'atom elt) - (assq 'quoted-string elt)) - (cons (cons 'word elt) rest) - ) - ((assq 'comment elt) - (cons (cons 'comment-word elt) rest) - )) - )))) - -(defun std11-parse-phrase (lal) - (let (ret phrase) - (while (setq ret (std11-parse-word-or-comment lal)) - (setq phrase (append phrase (cdr (car ret)))) - (setq lal (cdr ret)) - ) - (if phrase - (cons (cons 'phrase phrase) lal) - ))) - -(defun std11-parse-local-part (lal) - (let ((ret (std11-parse-word lal))) - (if ret - (let ((local-part (cdr (car ret))) dot) - (setq lal (cdr ret)) - (while (and (setq ret (std11-parse-ascii-token lal)) - (setq dot (car ret)) - (string-equal (cdr (assq 'specials dot)) ".") - (setq ret (std11-parse-word (cdr ret))) - (setq local-part - (append local-part dot (cdr (car ret))) - ) - (setq lal (cdr ret)) - )) - (cons (cons 'local-part local-part) lal) - )))) - -(defun std11-parse-sub-domain (lal) - (let ((ret (std11-parse-ascii-token lal))) - (if ret - (let ((sub-domain (car ret))) - (if (or (assq 'atom sub-domain) - (assq 'domain-literal sub-domain) - ) - (cons (cons 'sub-domain sub-domain) - (cdr ret) - ) - ))))) - -(defun std11-parse-domain (lal) - (let ((ret (std11-parse-sub-domain lal))) - (if ret - (let ((domain (cdr (car ret))) dot) - (setq lal (cdr ret)) - (while (and (setq ret (std11-parse-ascii-token lal)) - (setq dot (car ret)) - (string-equal (cdr (assq 'specials dot)) ".") - (setq ret (std11-parse-sub-domain (cdr ret))) - (setq domain - (append domain dot (cdr (car ret))) - ) - (setq lal (cdr ret)) - )) - (cons (cons 'domain domain) lal) - )))) - -(defun std11-parse-at-domain (lal) - (let ((ret (std11-parse-ascii-token lal)) at-sign) - (if (and ret - (setq at-sign (car ret)) - (string-equal (cdr (assq 'specials at-sign)) "@") - (setq ret (std11-parse-domain (cdr ret))) - ) - (cons (cons 'at-domain (append at-sign (cdr (car ret)))) - (cdr ret)) - ))) - -(defun std11-parse-addr-spec (lal) - (let ((ret (std11-parse-local-part lal)) - addr) - (if (and ret - (prog1 - (setq addr (cdr (car ret))) - (setq lal (cdr ret)) - (and (setq ret (std11-parse-at-domain lal)) - (setq addr (append addr (cdr (car ret)))) - (setq lal (cdr ret)) - ))) - (cons (cons 'addr-spec addr) lal) - ))) - -(defun std11-parse-route (lal) - (let ((ret (std11-parse-at-domain lal)) - route comma colon) - (if (and ret - (progn - (setq route (cdr (car ret))) - (setq lal (cdr ret)) - (while (and (setq ret (std11-parse-ascii-token lal)) - (setq comma (car ret)) - (string-equal (cdr (assq 'specials comma)) ",") - (setq ret (std11-parse-at-domain (cdr ret))) - ) - (setq route (append route comma (cdr (car ret)))) - (setq lal (cdr ret)) - ) - (and (setq ret (std11-parse-ascii-token lal)) - (setq colon (car ret)) - (string-equal (cdr (assq 'specials colon)) ":") - (setq route (append route colon)) - ) - )) - (cons (cons 'route route) - (cdr ret) - ) - ))) - -(defun std11-parse-route-addr (lal) - (let ((ret (std11-parse-ascii-token lal)) - < route addr-spec >) - (if (and ret - (setq < (car ret)) - (string-equal (cdr (assq 'specials <)) "<") - (setq lal (cdr ret)) - (progn (and (setq ret (std11-parse-route lal)) - (setq route (cdr (car ret))) - (setq lal (cdr ret)) - ) - (setq ret (std11-parse-addr-spec lal)) - ) - (setq addr-spec (cdr (car ret))) - (setq lal (cdr ret)) - (setq ret (std11-parse-ascii-token lal)) - (setq > (car ret)) - (string-equal (cdr (assq 'specials >)) ">") - ) - (cons (cons 'route-addr (append route addr-spec)) - (cdr ret) - ) - ))) - -(defun std11-parse-phrase-route-addr (lal) - (let ((ret (std11-parse-phrase lal)) phrase) - (if ret - (progn - (setq phrase (cdr (car ret))) - (setq lal (cdr ret)) - )) - (if (setq ret (std11-parse-route-addr lal)) - (cons (list 'phrase-route-addr - phrase - (cdr (car ret))) - (cdr ret)) - ))) - -(defun std11-parse-mailbox (lal) - (let ((ret (or (std11-parse-phrase-route-addr lal) - (std11-parse-addr-spec lal))) - mbox comment) - (if (and ret - (prog1 - (setq mbox (car ret)) - (setq lal (cdr ret)) - (if (and (setq ret (std11-parse-token-or-comment lal)) - (setq comment (cdr (assq 'comment (car ret)))) - ) - (setq lal (cdr ret)) - ))) - (cons (list 'mailbox mbox comment) - lal) - ))) - -(defun std11-parse-group (lal) - (let ((ret (std11-parse-phrase lal)) - phrase colon comma mbox semicolon) - (if (and ret - (setq phrase (cdr (car ret))) - (setq lal (cdr ret)) - (setq ret (std11-parse-ascii-token lal)) - (setq colon (car ret)) - (string-equal (cdr (assq 'specials colon)) ":") - (setq lal (cdr ret)) - (progn - (and (setq ret (std11-parse-mailbox lal)) - (setq mbox (list (car ret))) - (setq lal (cdr ret)) - (progn - (while (and (setq ret (std11-parse-ascii-token lal)) - (setq comma (car ret)) - (string-equal - (cdr (assq 'specials comma)) ",") - (setq lal (cdr ret)) - (setq ret (std11-parse-mailbox lal)) - (setq mbox (cons (car ret) mbox)) - (setq lal (cdr ret)) - ) - ))) - (and (setq ret (std11-parse-ascii-token lal)) - (setq semicolon (car ret)) - (string-equal (cdr (assq 'specials semicolon)) ";") - ))) - (cons (list 'group phrase (nreverse mbox)) - (cdr ret) - ) - ))) - -(defun std11-parse-address (lal) - (or (std11-parse-group lal) - (std11-parse-mailbox lal) - )) - -(defun std11-parse-addresses (lal) - (let ((ret (std11-parse-address lal))) - (if ret - (let ((dest (list (car ret)))) - (setq lal (cdr ret)) - (while (and (setq ret (std11-parse-ascii-token lal)) - (string-equal (cdr (assq 'specials (car ret))) ",") - (setq ret (std11-parse-address (cdr ret))) - ) - (setq dest (cons (car ret) dest)) - (setq lal (cdr ret)) - ) - (nreverse dest) - )))) - - -;;; @ end -;;; - -(provide 'std11-parse) - -;;; std11-parse.el ends here
--- a/lisp/tl/std11.el Mon Aug 13 08:58:38 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,284 +0,0 @@ -;;; std11.el --- STD 11 functions for GNU Emacs - -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $ - -;; This file is 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 This program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(autoload 'buffer-substring-no-properties "emu") -(autoload 'member "emu") - - -;;; @ field -;;; - -(defconst std11-field-name-regexp "[!-9;-~]+") -(defconst std11-field-head-regexp - (concat "^" std11-field-name-regexp ":")) -(defconst std11-next-field-head-regexp - (concat "\n" std11-field-name-regexp ":")) - -(defun std11-field-end () - "Move to end of field and return this point. [std11.el]" - (if (re-search-forward std11-next-field-head-regexp nil t) - (goto-char (match-beginning 0)) - (if (re-search-forward "^$" nil t) - (goto-char (1- (match-beginning 0))) - (end-of-line) - )) - (point) - ) - -(defun std11-field-body (name &optional boundary) - "Return body of field NAME. -If BOUNDARY is not nil, it is used as message header separator. -\[std11.el]" - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (re-search-forward (concat "^" name ":[ \t]*") nil t) - (buffer-substring-no-properties (match-end 0) (std11-field-end)) - ))))) - -(defun std11-find-field-body (field-names &optional boundary) - "Return the first found field-body specified by FIELD-NAMES -of the message header in current buffer. If BOUNDARY is not nil, it is -used as message header separator. [std11.el]" - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (let ((case-fold-search t) - field-name) - (catch 'tag - (while (setq field-name (car field-names)) - (goto-char (point-min)) - (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) - (throw 'tag - (buffer-substring-no-properties - (match-end 0) (std11-field-end))) - ) - (setq field-names (cdr field-names)) - )))))) - -(defun std11-field-bodies (field-names &optional default-value boundary) - "Return list of each field-bodies of FIELD-NAMES of the message header -in current buffer. If BOUNDARY is not nil, it is used as message -header separator. [std11.el]" - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (let* ((case-fold-search t) - (dest (make-list (length field-names) default-value)) - (s-rest field-names) - (d-rest dest) - field-name) - (while (setq field-name (car s-rest)) - (goto-char (point-min)) - (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) - (setcar d-rest - (buffer-substring-no-properties - (match-end 0) (std11-field-end))) - ) - (setq s-rest (cdr s-rest) - d-rest (cdr d-rest)) - ) - dest)))) - - -;;; @ unfolding -;;; - -(defun std11-unfold-string (string) - "Unfold STRING as message header field. [std11.el]" - (let ((dest "")) - (while (string-match "\n\\s +" string) - (setq dest (concat dest (substring string 0 (match-beginning 0)) " ")) - (setq string (substring string (match-end 0))) - ) - (concat dest string) - )) - - -;;; @ header -;;; - -(defun std11-narrow-to-header (&optional boundary) - "Narrow to the message header. -If BOUNDARY is not nil, it is used as message header separator. -\[std11.el]" - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$") - nil t) - (match-beginning 0) - (point-max) - ))) - -(defun std11-header-string (regexp &optional boundary) - "Return string of message header fields matched by REGEXP. -If BOUNDARY is not nil, it is used as message header separator. -\[std11.el]" - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (goto-char (point-min)) - (let (field header) - (while (re-search-forward std11-field-head-regexp nil t) - (setq field - (buffer-substring (match-beginning 0) (std11-field-end))) - (if (string-match regexp field) - (setq header (concat header field "\n")) - )) - header) - )))) - -(defun std11-header-string-except (regexp &optional boundary) - "Return string of message header fields not matched by REGEXP. -If BOUNDARY is not nil, it is used as message header separator. -\[std11.el]" - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (goto-char (point-min)) - (let (field header) - (while (re-search-forward std11-field-head-regexp nil t) - (setq field - (buffer-substring (match-beginning 0) (std11-field-end))) - (if (not (string-match regexp field)) - (setq header (concat header field "\n")) - )) - header) - )))) - -(defun std11-collect-field-names (&optional boundary) - "Return list of all field-names of the message header in current buffer. -If BOUNDARY is not nil, it is used as message header separator. -\[std11.el]" - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (goto-char (point-min)) - (let (dest name) - (while (re-search-forward std11-field-head-regexp nil t) - (setq name (buffer-substring-no-properties - (match-beginning 0)(1- (match-end 0)))) - (or (member name dest) - (setq dest (cons name dest)) - ) - ) - dest)))) - - -;;; @ composer -;;; - -(defun std11-addr-to-string (seq) - "Return string from lexical analyzed list SEQ -represents addr-spec of RFC 822. [std11.el]" - (mapconcat (function - (lambda (token) - (if (let ((name (car token))) - (or (eq name 'spaces) - (eq name 'comment) - )) - "" - (cdr token) - ))) - seq "") - ) - -(defun std11-address-string (address) - "Return string of address part from parsed ADDRESS of RFC 822. -\[std11.el]" - (cond ((eq (car address) 'group) - (mapconcat (function std11-address-string) - (car (cdr address)) - ", ") - ) - ((eq (car address) 'mailbox) - (let ((addr (nth 1 address))) - (std11-addr-to-string - (if (eq (car addr) 'phrase-route-addr) - (nth 2 addr) - (cdr addr) - ) - ))))) - -(defun std11-full-name-string (address) - "Return string of full-name part from parsed ADDRESS of RFC 822. -\[std11.el]" - (cond ((eq (car address) 'group) - (mapconcat (function - (lambda (token) - (cdr token) - )) - (nth 1 address) "") - ) - ((eq (car address) 'mailbox) - (let ((addr (nth 1 address)) - (comment (nth 2 address)) - phrase) - (if (eq (car addr) 'phrase-route-addr) - (setq phrase (mapconcat (function - (lambda (token) - (cdr token) - )) - (nth 1 addr) "")) - ) - (or phrase comment) - )))) - - -;;; @ parser -;;; - -(defun std11-parse-address-string (string) - "Parse STRING as mail address. [std11.el]" - (std11-parse-address (std11-lexical-analyze string)) - ) - -(defun std11-parse-addresses-string (string) - "Parse STRING as mail address list. [std11.el]" - (std11-parse-addresses (std11-lexical-analyze string)) - ) - -(provide 'std11) - -(mapcar (function - (lambda (func) - (autoload func "std11-parse") - )) - '(std11-lexical-analyze - std11-parse-address std11-parse-addresses - std11-parse-address-string)) - - -;;; @ end -;;; - -;;; std11.el ends here
--- a/lisp/version.el Mon Aug 13 08:58:38 2007 +0200 +++ b/lisp/version.el Mon Aug 13 08:58:59 2007 +0200 @@ -55,7 +55,7 @@ "Non-nil when this is a test (beta) version of XEmacs. Warning, this variable did not exist in XEmacs versions prior to 20.3") -(defconst xemacs-codename "Bronx" +(defconst xemacs-codename "Staten Island" "Symbolic name of XEmacs build. Warning, this variable did not exist in XEmacs versions prior to 19.16 and 20.3")
--- a/lisp/w3/md5.el Mon Aug 13 08:58:38 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,406 +0,0 @@ -;;; md5.el -- MD5 Message Digest Algorithm -;;; Gareth Rees <gdr11@cl.cam.ac.uk> - -;; LCD Archive Entry: -;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| -;; MD5 cryptographic message digest algorithm| -;; 13-Nov-95|1.0|~/misc/md5.el.Z| - -;;; Details: ------------------------------------------------------------------ - -;; This is a direct translation into Emacs LISP of the reference C -;; implementation of the MD5 Message-Digest Algorithm written by RSA -;; Data Security, Inc. -;; -;; The algorithm takes a message (that is, a string of bytes) and -;; computes a 16-byte checksum or "digest" for the message. This digest -;; is supposed to be cryptographically strong in the sense that if you -;; are given a 16-byte digest D, then there is no easier way to -;; construct a message whose digest is D than to exhaustively search the -;; space of messages. However, the robustness of the algorithm has not -;; been proven, and a similar algorithm (MD4) was shown to be unsound, -;; so treat with caution! -;; -;; The C algorithm uses 32-bit integers; because GNU Emacs -;; implementations provide 28-bit integers (with 24-bit integers on -;; versions prior to 19.29), the code represents a 32-bit integer as the -;; cons of two 16-bit integers. The most significant word is stored in -;; the car and the least significant in the cdr. The algorithm requires -;; at least 17 bits of integer representation in order to represent the -;; carry from a 16-bit addition. - -;;; Usage: -------------------------------------------------------------------- - -;; To compute the MD5 Message Digest for a message M (represented as a -;; string or as a vector of bytes), call -;; -;; (md5-encode M) -;; -;; which returns the message digest as a vector of 16 bytes. If you -;; need to supply the message in pieces M1, M2, ... Mn, then call -;; -;; (md5-init) -;; (md5-update M1) -;; (md5-update M2) -;; ... -;; (md5-update Mn) -;; (md5-final) - -;;; Copyright and licence: ---------------------------------------------------- - -;; Copyright (C) 1995, 1996, 1997 by Gareth Rees -;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; -;; md5.el 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. -;; -;; md5.el 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. -;; -;; The original copyright notice is given below, as required by the -;; licence for the original code. This code is distributed under *both* -;; RSA's original licence and the GNU General Public Licence. (There -;; should be no problems, as the former is more liberal than the -;; latter). - -;;; Original copyright notice: ------------------------------------------------ - -;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. -;; -;; License to copy and use this software is granted provided that it is -;; identified as the "RSA Data Security, Inc. MD5 Message- Digest -;; Algorithm" in all material mentioning or referencing this software or -;; this function. -;; -;; License is also granted to make and use derivative works provided -;; that such works are identified as "derived from the RSA Data -;; Security, Inc. MD5 Message-Digest Algorithm" in all material -;; mentioning or referencing the derived work. -;; -;; RSA Data Security, Inc. makes no representations concerning either -;; the merchantability of this software or the suitability of this -;; software for any particular purpose. It is provided "as is" without -;; express or implied warranty of any kind. -;; -;; These notices must be retained in any copies of any part of this -;; documentation and/or software. - -;;; Code: --------------------------------------------------------------------- - -(defvar md5-program "md5" - "*Program that reads a message on its standard input and writes an -MD5 digest on its output.") - -(defvar md5-maximum-internal-length 4096 - "*The maximum size of a piece of data that should use the MD5 routines -written in lisp. If a message exceeds this, it will be run through an -external filter for processing. Also see the `md5-program' variable. -This variable has no effect if you call the md5-init|update|final -functions - only used by the `md5' function's simpler interface.") - -(defvar md5-bits (make-vector 4 0) - "Number of bits handled, modulo 2^64. -Represented as four 16-bit numbers, least significant first.") -(defvar md5-buffer (make-vector 4 '(0 . 0)) - "Scratch buffer (four 32-bit integers).") -(defvar md5-input (make-vector 64 0) - "Input buffer (64 bytes).") - -(defun md5-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun md5-encode (message) - "Encodes MESSAGE using the MD5 message digest algorithm. -MESSAGE must be a string or an array of bytes. -Returns a vector of 16 bytes containing the message digest." - (if (<= (length message) md5-maximum-internal-length) - (progn - (md5-init) - (md5-update message) - (md5-final)) - (save-excursion - (set-buffer (get-buffer-create " *md5-work*")) - (erase-buffer) - (insert message) - (call-process-region (point-min) (point-max) - md5-program - t (current-buffer)) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (let ((data (buffer-substring (point-min) (+ (point-min) 32))) - (vec (make-vector 16 0)) - (ctr 0)) - (while (< ctr 16) - (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) - (md5-unhex (aref data (1+ (* ctr 2)))))) - (setq ctr (1+ ctr))))))) - -(defsubst md5-add (x y) - "Return 32-bit sum of 32-bit integers X and Y." - (let ((m (+ (car x) (car y))) - (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) - -;; FF, GG, HH and II are basic MD5 functions, providing transformations -;; for rounds 1, 2, 3 and 4 respectively. Each function follows this -;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x -;; by y bits to the left): -;; -;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; -;; so we use the macro `md5-make-step' to construct each one. The -;; helper functions F, G, H and I operate on 16-bit numbers; the full -;; operation splits its inputs, operates on the halves separately and -;; then puts the results together. - -(defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) -(defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) -(defsubst md5-H (x y z) (logxor x y z)) -(defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) - -(defmacro md5-make-step (name func) - (` - (defun (, name) (a b c d x s ac) - (let* - ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) - (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) - (m2 (logand 65535 (+ m1 (lsh l1 -16)))) - (l2 (logand 65535 l1)) - (m3 (logand 65535 (if (> s 15) - (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh m2 s) (lsh l2 (- s 16)))))) - (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) - (+ (lsh l2 s) (lsh m2 (- s 16))))))) - (md5-add (cons m3 l3) b))))) - -(md5-make-step md5-FF md5-F) -(md5-make-step md5-GG md5-G) -(md5-make-step md5-HH md5-H) -(md5-make-step md5-II md5-I) - -(defun md5-init () - "Initialise the state of the message-digest routines." - (aset md5-bits 0 0) - (aset md5-bits 1 0) - (aset md5-bits 2 0) - (aset md5-bits 3 0) - (aset md5-buffer 0 '(26437 . 8961)) - (aset md5-buffer 1 '(61389 . 43913)) - (aset md5-buffer 2 '(39098 . 56574)) - (aset md5-buffer 3 '( 4146 . 21622))) - -(defun md5-update (string) - "Update the current MD5 state with STRING (an array of bytes)." - (let ((len (length string)) - (i 0) - (j 0)) - (while (< i len) - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Store this byte (truncating to 8 bits to be sure) - (aset md5-input j (logand 255 (aref string i))) - - ;; Update number of bits by 8 (modulo 2^64) - (let ((c 8) (k 0)) - (while (and (> c 0) (< k 4)) - (let ((b (aref md5-bits k))) - (aset md5-bits k (logand 65535 (+ b c))) - (setq c (if (> b (- 65535 c)) 1 0) - k (1+ k))))) - - ;; Increment number of bytes processed - (setq i (1+ i)) - - ;; When 64 bytes accumulated, pack them into sixteen 32-bit - ;; integers in the array `in' and then tranform them. - (if (= j 63) - (let ((in (make-vector 16 (cons 0 0))) - (k 0) - (kk 0)) - (while (< k 16) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4))) - (md5-transform in)))))) - -(defun md5-pack (array i) - "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." - (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) - (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) - -(defun md5-byte (array n b) - "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." - (let ((e (aref array n))) - (cond ((eq b 0) (logand 255 (cdr e))) - ((eq b 1) (lsh (cdr e) -8)) - ((eq b 2) (logand 255 (car e))) - ((eq b 3) (lsh (car e) -8))))) - -(defun md5-final () - (let ((in (make-vector 16 (cons 0 0))) - (j 0) - (digest (make-vector 16 0)) - (padding)) - - ;; Save the number of bits in the message - (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) - (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) - - ;; Compute number of bytes modulo 64 - (setq j (% (/ (aref md5-bits 0) 8) 64)) - - ;; Pad out computation to 56 bytes modulo 64 - (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) - (aset padding 0 128) - (md5-update padding) - - ;; Append length in bits and transform - (let ((k 0) (kk 0)) - (while (< k 14) - (aset in k (md5-pack md5-input kk)) - (setq k (+ k 1) kk (+ kk 4)))) - (md5-transform in) - - ;; Store the results in the digest - (let ((k 0) (kk 0)) - (while (< k 4) - (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) - (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) - (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) - (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) - (setq k (+ k 1) kk (+ kk 4)))) - - ;; Return digest - digest)) - -;; It says in the RSA source, "Note that if the Mysterious Constants are -;; arranged backwards in little-endian order and decrypted with the DES -;; they produce OCCULT MESSAGES!" Security through obscurity? - -(defun md5-transform (in) - "Basic MD5 step. Transform md5-buffer based on array IN." - (let ((a (aref md5-buffer 0)) - (b (aref md5-buffer 1)) - (c (aref md5-buffer 2)) - (d (aref md5-buffer 3))) - (setq - a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) - d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) - c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) - b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) - a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) - d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) - c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) - b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) - a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) - d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) - c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) - b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) - a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) - d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) - c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) - b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) - a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) - d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) - c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) - b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) - a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) - d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) - c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) - b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) - a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) - d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) - c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) - b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) - a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) - d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) - c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) - b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) - a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) - d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) - c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) - b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) - a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) - d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) - c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) - b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) - a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) - d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) - c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) - b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) - a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) - d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) - c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) - b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) - a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) - d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) - c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) - b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) - a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) - d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) - c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) - b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) - a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) - d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) - c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) - b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) - a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) - d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) - c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) - b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) - - (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) - (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) - (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) - (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Here begins the merger with the XEmacs API and the md5.el from the URL -;;; package. Courtesy wmperry@cs.indiana.edu -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. -OBJECT is either a string or a buffer. -Optional arguments START and END denote buffer positions for computing the -hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (<= (point-max) md5-maximum-internal-length) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - shell-file-name - t buffer nil - shell-command-switch md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (kill-buffer buffer) nil)))) - -(provide 'md5)
--- a/man/internals/internals.texi Mon Aug 13 08:58:38 2007 +0200 +++ b/man/internals/internals.texi Mon Aug 13 08:58:59 2007 +0200 @@ -590,6 +590,8 @@ @itemize @bullet @item version 20.1 released September 17, 1997. +@item +version 20.2 released September 20, 1997. @end itemize @node XEmacs
--- a/src/dired.c Mon Aug 13 08:58:38 2007 +0200 +++ b/src/dired.c Mon Aug 13 08:58:59 2007 +0200 @@ -58,16 +58,17 @@ Bytecount dirname_length; Lisp_Object list, name, dirfilename = Qnil; Lisp_Object handler; + Lisp_Object errstring; struct re_pattern_buffer *bufp; - char statbuf [MAXNAMLEN+2]; + char statbuf [4096]; /* BOGUS -- fixed in 20.3 */ char *statbuf_tail; Lisp_Object tail_cons = Qnil; - char slashfilename[MAXNAMLEN+2]; + char slashfilename[4096]; /* BOGUS -- fixed in 20.3 */ char *filename = slashfilename; - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (dirname, dirfilename, tail_cons); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + GCPRO4 (dirname, dirfilename, tail_cons, errstring); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -92,6 +93,10 @@ /* XEmacs: this should come before the opendir() because it might error. */ Lisp_Object name_as_dir = Ffile_name_as_directory (dirname); CHECK_STRING (name_as_dir); + if (XSTRING_LENGTH(name_as_dir) >= sizeof (statbuf)) + { + report_file_error("Directory name too long", list1(name_as_dir)); + } memcpy (statbuf, ((char *) XSTRING_DATA (name_as_dir)), XSTRING_LENGTH (name_as_dir)); statbuf_tail = statbuf + XSTRING_LENGTH (name_as_dir); @@ -136,6 +141,12 @@ if (dirname_length == 0 || !IS_ANY_SEP (XSTRING_BYTE (dirname, dirname_length - 1))) { + if ((filename - slashfilename) >= (sizeof (slashfilename) - 1)) + { + closedir(d); + errstring = make_string(statbuf, 255); + report_file_error("Directory name too long", list1(errstring)); + } *filename++ = DIRECTORY_SEP; dirname_length++; } @@ -153,6 +164,13 @@ { int result; Lisp_Object oinhibit_quit = Vinhibit_quit; + if (((filename - slashfilename) + len) >= + (sizeof (slashfilename) - 1)) + { + closedir(d); + errstring = make_string(slashfilename, 255); + report_file_error("Directory name too long", list1(errstring)); + } strncpy (filename, dp->d_name, len); filename[len] = 0; /* re_search can now QUIT, so prevent it to avoid @@ -168,6 +186,14 @@ int dir_p; struct stat st; + if (((statbuf_tail - statbuf) + len) >= + (sizeof (statbuf) - 1)) + { + closedir(d); + errstring = make_string(statbuf, 255); + report_file_error("Directory name too long", + list1(errstring)); + } memcpy (statbuf_tail, filename, len); statbuf_tail [len] = 0;
--- a/src/glyphs-x.c Mon Aug 13 08:58:38 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 08:58:59 2007 +0200 @@ -1213,7 +1213,8 @@ if (!src) { return; } else if (num_bytes > src->bytes_in_buffer) { - num_bytes = (long)src->bytes_in_buffer; + ERREXIT(cinfo, JERR_INPUT_EOF); + /*NOTREACHED*/ } src->bytes_in_buffer -= num_bytes;
--- a/src/s/irix6-0.h Mon Aug 13 08:58:38 2007 +0200 +++ b/src/s/irix6-0.h Mon Aug 13 08:58:59 2007 +0200 @@ -25,3 +25,12 @@ * This should probably be set by configure. */ #define HAVE_UINTPTR_T 1 + +/* R. Cognot 09/24/97 + * This may be needed for other ABIs, but at least I'm sure it is + * is needed on n32, as purify reports UMRs in siglongjmp and + * xemacs dumps core every once in a while... + */ +#if (_MIPS_SIM==_MIPS_SIM_ABIN32) +#undef HAVE_SIGSETJMP +#endif