Re: Pterodactyl Gnus v0.5 is released

[Hallvard B Furuseth <h.b.furuseth@usit.uio.no>]

Lars Magne Ingebrigtsen writes:
> You could probably hack up a library that defined those things,
> though. 

Here, except it doesn't define char-charset (rfc1522.el, rfc2047.el),
find-non-ascii-charset-region (rfc1522.el) and find-charset-region
(rfc2047.el).  I don't know how they should work.  If someone has xemacs
without MULE installed, maybe they could be copied from there.


;; gnus-e20.el -- emacs20 compatibility for Gnus on emacs19

;; Version 1, 1998-08-31

;; Copyright:  The part below the copyright notice below
;; is Copyright Free Software Foundation.


;; Cloned from emacs-20.3/src/charset.c
(if (or (not (fboundp 'char-width))
	(eq (car-safe (indirect-function 'char-width)) 'autoload))
    (defun char-width (ch)
      "Return width of CHAR when displayed in the current buffer.
The width is measured by how many columns it occupies on the screen."
      (let ((dp
	     (cond (buffer-display-table   (aref buffer-display-table   ch))
		   (standard-display-table (aref standard-display-table ch)))))
	(cond ((vectorp dp) (length dp))
	      ((< ch 32)    (cond ((eq ch 9)  tab-width)
				  ((eq ch 10) 0)
				  (t          (if ctl-arrow 2 4))))
	      ((< ch 127)   1)
	      ((eq ch 127)  (if ctl-arrow 2 4))
	      (t            4)))))

;; Cloned from emacs-20.3/src/editfns.c
(if (or (not (fboundp 'save-current-buffer))
	(eq (car-safe (indirect-function 'save-current-buffer)) 'autoload))
    (defmacro save-current-buffer (&rest args)
      "Save the current buffer; execute BODY; restore the current buffer.
Executes BODY just like `progn'."
      (let ((ScB-buffer (make-symbol "ScB-buffer")))
	`(let ((,ScB-buffer (current-buffer)))
	   (unwind-protect
	       (progn ,@args)
	     (if (buffer-name ,ScB-buffer)
		 (set-buffer ,ScB-buffer)))))))


;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;; From emacs-20.3/lisp/subr.el

(if (or (not (fboundp 'with-current-buffer))
	(eq (car-safe (indirect-function 'with-current-buffer)) 'autoload))
    (defmacro with-current-buffer (buffer &rest body)
      "Execute the forms in BODY with BUFFER as the current buffer.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
      `(save-current-buffer
	 (set-buffer ,buffer)
	 ,@body)))

(if (or (not (fboundp 'with-temp-file))
	(eq (car-safe (indirect-function 'with-temp-file)) 'autoload))
    (defmacro with-temp-file (file &rest forms)
      "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
The value of the last form in FORMS is returned, like `progn'.
See also `with-temp-buffer'."
      (let ((temp-file (make-symbol "temp-file"))
	    (temp-buffer (make-symbol "temp-buffer")))
	`(let ((,temp-file ,file)
	       (,temp-buffer
		(get-buffer-create (generate-new-buffer-name " *temp file*"))))
	   (unwind-protect
	       (prog1
		   (with-current-buffer ,temp-buffer
		     ,@forms)
		 (with-current-buffer ,temp-buffer
		   (widen)
		   (write-region (point-min) (point-max) ,temp-file nil 0)))
	     (and (buffer-name ,temp-buffer)
		  (kill-buffer ,temp-buffer)))))))

(if (or (not (fboundp 'with-temp-buffer))
	(eq (car-safe (indirect-function 'with-temp-buffer)) 'autoload))
    (defmacro with-temp-buffer (&rest forms)
      "Create a temporary buffer, and evaluate FORMS there like `progn'.
See also `with-temp-file' and `with-output-to-string'."
      (let ((temp-buffer (make-symbol "temp-buffer")))
	`(let ((,temp-buffer
		(get-buffer-create (generate-new-buffer-name " *temp*"))))
	   (unwind-protect
	       (with-current-buffer ,temp-buffer
		 ,@forms)
	     (and (buffer-name ,temp-buffer)
		  (kill-buffer ,temp-buffer)))))))

(if (or (not (fboundp 'with-output-to-string))
	(eq (car-safe (indirect-function 'with-output-to-string)) 'autoload))
    (defmacro with-output-to-string (&rest body)
      "Execute BODY, return the text it sent to `standard-output', as a string."
      `(let ((standard-output
	      (get-buffer-create (generate-new-buffer-name " *string-output*"))))
	 (let ((standard-output standard-output))
	   ,@body)
	 (with-current-buffer standard-output
	   (prog1
	       (buffer-string)
	     (kill-buffer nil))))))


(if (or (not (fboundp 'split-string))
	(eq (car-safe (indirect-function 'split-string)) 'autoload))
    (defun split-string (string &optional separators)
      "Splits STRING into substrings where there are matches for SEPARATORS.
Each match for SEPARATORS is a splitting point.
The substrings between the splitting points are made into a list
which is returned.
If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".

If there is match for SEPARATORS at the beginning of STRING, we do not
include a null substring for that.  Likewise, if there is a match
at the end of STRING, we don't include a null substring for that."
      (let ((rexp (or separators "[ \f\t\n\r\v]+"))
	    (start 0)
	    notfirst
	    (list nil))
	(while (and (string-match rexp string
				  (if (and notfirst
					   (= start (match-beginning 0))
					   (< start (length string)))
				      (1+ start) start))
		    (< (match-beginning 0) (length string)))
	  (setq notfirst t)
	  (or (eq (match-beginning 0) 0)
	      (and (eq (match-beginning 0) (match-end 0))
		   (eq (match-beginning 0) start))
	      (setq list
		    (cons (substring string start (match-beginning 0))
			  list)))
	  (setq start (match-end 0)))
	(or (eq start (length string))
	    (setq list
		  (cons (substring string start)
			list)))
	(nreverse list))))


;; From emacs-20.3/lisp/international/mule-util.el

(if (or (not (fboundp 'truncate-string-to-width))
	(eq (car-safe (indirect-function 'truncate-string-to-width)) 'autoload))
    (defun truncate-string-to-width (str end-column &optional start-column padding)
      "Truncate string STR to end at column END-COLUMN.
The optional 2nd arg START-COLUMN, if non-nil, specifies
the starting column; that means to return the characters occupying
columns START-COLUMN ... END-COLUMN of STR.

The optional 3rd arg PADDING, if non-nil, specifies a padding character
to add at the end of the result if STR doesn't reach column END-COLUMN,
or if END-COLUMN comes in the middle of a character in STR.
PADDING is also added at the beginning of the result
if column START-COLUMN appears in the middle of a character in STR.

If PADDING is nil, no padding is added in these cases, so
the resulting string may be narrower than END-COLUMN."
      (or start-column
	  (setq start-column 0))
      (let ((len (length str))
	    (idx 0)
	    (column 0)
	    (head-padding "") (tail-padding "")
	    ch last-column last-idx from-idx)
	(condition-case nil
	    (while (< column start-column)
	      (setq ch (aref str idx)
		    column (+ column (char-width ch))
		    idx (1+ idx)))
	  (args-out-of-range (setq idx len)))
	(if (< column start-column)
	    (if padding (make-string end-column padding) "")
	  (if (and padding (> column start-column))
	      (setq head-padding (make-string (- column start-column) padding)))
	  (setq from-idx idx)
	  (if (< end-column column)
	      (setq idx from-idx)
	    (condition-case nil
		(while (< column end-column)
		  (setq last-column column
			last-idx idx
			ch (aref str idx)
			column (+ column (char-width ch))
			idx (1+ idx)))
	      (args-out-of-range (setq idx len)))
	    (if (> column end-column)
		(setq column last-column idx last-idx))
	    (if (and padding (< column end-column))
		(setq tail-padding (make-string (- end-column column) padding))))
	  (setq str (substring str from-idx idx))
	  (if padding
	      (concat head-padding str tail-padding)
	    str)))))

;;; For backward compatiblity ...
(if (or (not (fboundp 'truncate-string))
	(eq (car-safe (indirect-function 'truncate-string)) 'autoload))
    (defalias 'truncate-string 'truncate-string-to-width))

-- 
Hallvard