[PATCH 21.5] Add missing do
18 years, 9 months
Jerry James
Jerry James
PATCH 21.5
I'm still having trouble getting Gnus up and running, so here's the most
critical of the patches I needed to get XEmacs 21.5 going. The current
dangling "while(0)" could cause some very interesting bugs.
Index: src/ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.926
diff -d -u -r1.926 ChangeLog
--- src/ChangeLog 2006/03/02 17:11:45 1.926
+++ src/ChangeLog 2006/03/09 18:53:32
＠＠ -1,3 +1,7 ＠＠
+2006-03-09 Jerry James <james(a)xemacs.org>
+
+ * profile.h (RETURN_UNGCPRO_EXIT_PROFILING): Add missing do.
+
2006-03-02 Marcus Crestani <crestani(a)xemacs.org>
* gc.c (show_gc_cursor_and_message): New.
Index: src/profile.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.h,v
retrieving revision 1.3
diff -d -u -r1.3 profile.h
--- src/profile.h 2005/10/25 11:16:27 1.3
+++ src/profile.h 2006/03/09 18:53:32
＠＠ -113,6 +113,7 ＠＠
RETURN_EXIT_PROFILING (tag, Lisp_Object, expr)
#define RETURN_UNGCPRO_EXIT_PROFILING(tag, expr) \
+do \
{ \
Lisp_Object ret_ungc_val = (expr); \
UNGCPRO; \
Regards,
--
Jerry James, Assistant Professor Email: Jerry.James(a)usu.edu
Computer Science Dept. Web: http://www.cs.usu.edu/~jerry/
Utah State University
- 1 participants
- 0 comments
[PATCH] mail-lib: starttls fixes for smtpmail.el
18 years, 9 months
Simon Josefsson
Simon Josefsson
I've installed this, but it needs review and testing.
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/ChangeLog,v
retrieving revision 1.163
retrieving revision 1.166
diff -u -p -r1.163 -r1.166
--- ChangeLog 28 Oct 2005 05:16:48 -0000 1.163
+++ ChangeLog 8 Mar 2006 10:13:04 -0000 1.166
＠＠ -1,3 +1,12 ＠＠
+2006-03-08 Simon Josefsson <jas(a)extundo.com>
+
+ * smtpmail.el: Sync with GNU Emacs, adds support for GnuTLS and
+ some other fixes.
+
+ * tls.el: Sync with GNU Emacs, adds support for OpenSSL.
+
+ * starttls.el: Sync cosmetic fixes with GNU Emacs CVS HEAD.
+
2005-10-28 Norbert Koch <viteno(a)xemacs.org>
* Makefile (VERSION): XEmacs package 1.75 released.
Index: smtpmail.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/smtpmail.el,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -p -r1.23 -r1.24
--- smtpmail.el 26 Oct 2005 07:53:20 -0000 1.23
+++ smtpmail.el 8 Mar 2006 10:12:55 -0000 1.24
＠＠ -1,7 +1,7 ＠＠
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005,
+;; 2006 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani(a)rbc.ncl.omron.co.jp>
;; Maintainer: Simon Josefsson <simon(a)josefsson.org>
＠＠ -26,10 +26,8 ＠＠
;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Emacs 21.3 from CVS 2002-09-17
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
＠＠ -170,9 +168,9 ＠＠ need to enter a `realm' too, add it to t
looks like `user＠realm'."
:type '(choice file
(repeat (list (string :tag "Server")
- (integer :tag "Port")
- (string :tag "Username")
- (choice (const :tag "Query when needed" nil)
+ (integer :tag "Port")
+ (string :tag "Username")
+ (choice (const :tag "Query when needed" nil)
(string :tag "Password")))))
:group 'smtpmail)
＠＠ -208,7 +206,7 ＠＠ This is relative to `smtpmail-queue-dir'
(defvar smtpmail-queue-index (concat smtpmail-queue-dir
smtpmail-queue-index-file))
-(defconst smtpmail-auth-supported '(cram-md5 login)
+(defconst smtpmail-auth-supported '(cram-md5 plain login)
"List of supported SMTP AUTH mechanisms.")
;;;
＠＠ -216,7 +214,7 ＠＠ This is relative to `smtpmail-queue-dir'
;;;
(defvar smtpmail-mail-address nil
- "Value of `user-mail-address' in ambient buffer.")
+ "Value to use for envelope-from address for mail from ambient buffer.")
;;;###autoload
(defun smtpmail-send-it ()
＠＠ -227,7 +225,11 ＠＠ This is relative to `smtpmail-queue-dir'
(case-fold-search nil)
delimline
(mailbuf (current-buffer))
- (smtpmail-mail-address (user-mail-address)) ;; XEmacs
+ ;; Examine this variable now, so that
+ ;; local binding in the mail buffer will take effect.
+ (smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ (user-mail-address))) ;; XEmacs
;; XEmacs: Don't frob `smtpmail-code-conv-from' here
)
(unwind-protect
＠＠ -359,9 +361,11 ＠＠ This is relative to `smtpmail-queue-dir'
(buffer-data (create-file-buffer file-data))
(buffer-elisp (create-file-buffer file-elisp))
(buffer-scratch "*queue-mail*"))
+ (unless (file-exists-p smtpmail-queue-dir)
+ (make-directory smtpmail-queue-dir t))
(with-current-buffer buffer-data
(erase-buffer)
- (insert-buffer tembuf)
+ (insert-buffer-substring tembuf)
(write-file file-data)
(set-buffer buffer-elisp)
(erase-buffer)
＠＠ -383,6 +387,7 ＠＠ This is relative to `smtpmail-queue-dir'
(if (bufferp errbuf)
(kill-buffer errbuf)))))
+;;;###autoload
(defun smtpmail-send-queued-mail ()
"Send mail that was queued as a result of setting `smtpmail-queue-mail'."
(interactive)
＠＠ -393,7 +398,7 ＠＠ This is relative to `smtpmail-queue-dir'
(insert-file-contents smtpmail-queue-index)
(goto-char (point-min))
(while (not (eobp))
- (setq file-msg (buffer-substring (point) (point-at-eol))) ;; XEmacs
+ (setq file-msg (buffer-substring (point) (line-end-position)))
(load file-msg)
;; Insert the message literally: it is already encoded as per
;; the MIME headers, and code conversions might guess the
＠＠ -401,14 +406,17 ＠＠ This is relative to `smtpmail-queue-dir'
(with-temp-buffer
(let ((coding-system-for-read 'binary)) ;; XEmacs
(insert-file-contents file-msg))
- (if (not (null smtpmail-recipient-address-list))
- (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
- (current-buffer)))
- (error "Sending failed; SMTP protocol error"))
- (error "Sending failed; no recipients")))
+ (let ((smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ (user-mail-address)))) ;; XEmacs
+ (if (not (null smtpmail-recipient-address-list))
+ (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
- (delete-region (point) (save-excursion (forward-line 1) (point))))
+ (delete-region (point-at-bol) (point-at-bol 2)))
(write-region (point-min) (point-max) smtpmail-queue-index))))
;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
＠＠ -457,25 +465,41 ＠＠ This is relative to `smtpmail-queue-dir'
(push el2 result)))
(nreverse result)))
+(defvar starttls-extra-args)
+(defvar starttls-extra-arguments)
+
(defun smtpmail-open-stream (process-buffer host port)
(let ((cred (smtpmail-find-credentials
smtpmail-starttls-credentials host port)))
(if (null (and cred (condition-case ()
- (progn
+ (with-no-warnings
(require 'starttls)
- (call-process starttls-program))
+ (call-process (if starttls-use-gnutls
+ starttls-gnutls-program
+ starttls-program)))
(error nil))))
;; The normal case.
(open-network-stream "SMTP" process-buffer host port)
(let* ((cred-key (smtpmail-cred-key cred))
(cred-cert (smtpmail-cred-cert cred))
(starttls-extra-args
- (when (and (stringp cred-key) (stringp cred-cert)
- (file-regular-p
- (setq cred-key (expand-file-name cred-key)))
- (file-regular-p
- (setq cred-cert (expand-file-name cred-cert))))
- (list "--key-file" cred-key "--cert-file" cred-cert))))
+ (append
+ starttls-extra-args
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--key-file" cred-key "--cert-file" cred-cert))))
+ (starttls-extra-arguments
+ (append
+ starttls-extra-arguments
+ (when (and (stringp cred-key) (stringp cred-cert)
+ (file-regular-p
+ (setq cred-key (expand-file-name cred-key)))
+ (file-regular-p
+ (setq cred-cert (expand-file-name cred-cert))))
+ (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
(starttls-open-stream "SMTP" process-buffer host port)))))
(defun smtpmail-try-auth-methods (process supported-extensions host port)
＠＠ -483,9 +507,9 ＠＠ This is relative to `smtpmail-queue-dir'
(mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
(cred (if (stringp smtpmail-auth-credentials)
(let* ((netrc (netrc-parse smtpmail-auth-credentials))
- (hostentry (netrc-machine
- netrc host (format "%s" (or port "smtp"))
- "smtp")))
+ (port-name (format "%s" (or port "smtp")))
+ (hostentry (netrc-machine netrc host port-name
+ port-name)))
(when hostentry
(list host port
(netrc-get hostentry "login")
＠＠ -499,10 +523,10 ＠＠ This is relative to `smtpmail-queue-dir'
(smtpmail-cred-server cred)
(smtpmail-cred-port cred))))))
ret)
- (when cred
+ (when (and cred mech)
(cond
((eq mech 'cram-md5)
- (smtpmail-send-command process (format "AUTH %s" mech))
+ (smtpmail-send-command process (upcase (format "AUTH %s" mech)))
(if (or (null (car (setq ret (smtpmail-read-response process))))
(not (integerp (car ret)))
(>= (car ret) 400))
＠＠ -535,6 +559,24 ＠＠ This is relative to `smtpmail-queue-dir'
(not (integerp (car ret)))
(>= (car ret) 400))
(throw 'done nil)))
+ ((eq mech 'plain)
+ ;; We used to send an empty initial request, and wait for an
+ ;; empty response, and then send the password, but this
+ ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
+ ;; is not sent if the server did not advertise AUTH PLAIN in
+ ;; the EHLO response. See RFC 2554 for more info.
+ (smtpmail-send-command process
+ (concat "AUTH PLAIN "
+ (base64-encode-string
+ (concat "\0"
+ (smtpmail-cred-user cred)
+ "\0"
+ passwd))))
+ (if (or (null (car (setq ret (smtpmail-read-response process))))
+ (not (integerp (car ret)))
+ (not (equal (car ret) 235)))
+ (throw 'done nil)))
+
(t
(error "Mechanism %s not implemented" mech)))
;; Remember the password.
＠＠ -547,10 +589,12 ＠＠ This is relative to `smtpmail-queue-dir'
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
(port smtpmail-smtp-service)
- (envelope-from (or (mail-envelope-from)
- smtpmail-mail-address
- ;; XEmacs:
- (user-mail-address)))
+ ;; smtpmail-mail-address should be set to the appropriate
+ ;; buffer-local value by the caller, but in case not:
+ (envelope-from (or smtpmail-mail-address
+ (and mail-specify-envelope-from
+ (mail-envelope-from))
+ (user-mail-address))) ;; XEmacs
response-code
greeting
process-buffer
＠＠ -563,6 +607,7 ＠＠ This is relative to `smtpmail-queue-dir'
;; clear the trace buffer of old output
(with-current-buffer process-buffer
+ (setq buffer-undo-list t)
(erase-buffer))
;; open the connection to the server
＠＠ -666,7 +711,7 ＠＠ This is relative to `smtpmail-queue-dir'
(>= (car response-code) 400))
(throw 'done nil))))
- ;; MAIL FROM: <sender>
+ ;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
(assoc 'size supported-extensions))
＠＠ -675,13 +720,8 ＠＠ This is relative to `smtpmail-queue-dir'
;; size estimate:
(+ (- (point-max) (point-min))
;; Add one byte for each change-of-line
- ;; because or CR-LF representation:
- (count-lines (point-min) (point-max))
- ;; For some reason, an empty line is
- ;; added to the message. Maybe this
- ;; is a bug, but it can't hurt to add
- ;; those two bytes anyway:
- 2)))
+ ;; because of CR-LF representation:
+ (count-lines (point-min) (point-max)))))
""))
(body-part
(if (member '8bitmime supported-extensions)
＠＠ -701,8 +741,8 ＠＠ This is relative to `smtpmail-queue-dir'
"")
"")))
; (smtpmail-send-command process (format "MAIL FROM:%s＠%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"
- envelope-from
+ (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
+ envelope-from
size-part
body-part))
＠＠ -712,10 +752,10 ＠＠ This is relative to `smtpmail-queue-dir'
(throw 'done nil)
))
- ;; RCPT TO: <recipient>
+ ;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO: <%s>" (smtpmail-maybe-append-domain (nth n recipient))))
+ (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
(setq n (1+ n))
(setq response-code (smtpmail-read-response process))
＠＠ -778,49 +818,49 ＠＠ This is relative to `smtpmail-queue-dir'
(response-continue t)
(return-value '(nil ()))
match-end)
+ (catch 'done
+ (while response-continue
+ (goto-char smtpmail-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (unless (memq (process-status process) '(open run))
+ (throw 'done nil))
+ (accept-process-output process)
+ (goto-char smtpmail-read-point))
- (while response-continue
- (goto-char smtpmail-read-point)
- (while (not (search-forward "\r\n" nil t))
- (accept-process-output process)
- (goto-char smtpmail-read-point))
-
- (setq match-end (point))
- (setq response-strings
- (cons (buffer-substring smtpmail-read-point (- match-end 2))
- response-strings))
-
- (goto-char smtpmail-read-point)
- (if (looking-at "[0-9]+ ")
- (let ((begin (match-beginning 0))
- (end (match-end 0)))
- (if smtpmail-debug-info
- (message "%s" (car response-strings)))
-
- (setq smtpmail-read-point match-end)
-
- ;; ignore lines that start with "0"
- (if (looking-at "0[0-9]+ ")
- nil
+ (setq match-end (point))
+ (setq response-strings
+ (cons (buffer-substring smtpmail-read-point (- match-end 2))
+ response-strings))
+
+ (goto-char smtpmail-read-point)
+ (if (looking-at "[0-9]+ ")
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+
+ (setq smtpmail-read-point match-end)
+
+ ;; ignore lines that start with "0"
+ (if (looking-at "0[0-9]+ ")
+ nil
+ (setq response-continue nil)
+ (setq return-value
+ (cons (string-to-number
+ (buffer-substring begin end))
+ (nreverse response-strings)))))
+
+ (if (looking-at "[0-9]+-")
+ (progn (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+ (setq smtpmail-read-point match-end)
+ (setq response-continue t))
+ (progn
+ (setq smtpmail-read-point match-end)
(setq response-continue nil)
(setq return-value
- (cons (string-to-int
- (buffer-substring begin end))
- (nreverse response-strings)))))
-
- (if (looking-at "[0-9]+-")
- (progn (if smtpmail-debug-info
- (message "%s" (car response-strings)))
- (setq smtpmail-read-point match-end)
- (setq response-continue t))
- (progn
- (setq smtpmail-read-point match-end)
- (setq response-continue nil)
- (setq return-value
- (cons nil (nreverse response-strings)))
- )
- )))
- (setq smtpmail-read-point match-end)
+ (cons nil (nreverse response-strings)))))))
+ (setq smtpmail-read-point match-end))
return-value))
＠＠ -853,31 +893,15 ＠＠ This is relative to `smtpmail-queue-dir'
)
(defun smtpmail-send-data (process buffer)
- (let
- ((data-continue t)
- (sending-data nil)
- this-line
- this-line-end)
-
+ (let ((data-continue t) sending-data)
(with-current-buffer buffer
(goto-char (point-min)))
-
(while data-continue
(with-current-buffer buffer
- (beginning-of-line)
- (setq this-line (point))
- (end-of-line)
- (setq this-line-end (point))
- (setq sending-data nil)
- (setq sending-data (buffer-substring this-line this-line-end))
- (if (/= (forward-line 1) 0)
- (setq data-continue nil)))
-
- (smtpmail-send-data-1 process sending-data)
- )
- )
- )
-
+ (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
+ (end-of-line 2)
+ (setq data-continue (not (eobp))))
+ (smtpmail-send-data-1 process sending-data))))
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
"Get address list suitable for smtp RCPT TO: <address>."
＠＠ -955,4 +979,5 ＠＠ many continuation lines."
(provide 'smtpmail)
+;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here
Index: starttls.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/starttls.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -p -r1.4 -r1.5
--- starttls.el 23 Sep 2005 13:01:15 -0000 1.4
+++ starttls.el 8 Mar 2006 09:59:10 -0000 1.5
＠＠ -1,7 +1,7 ＠＠
;;; starttls.el --- STARTTLS functions
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno(a)unixuser.org>
;; Author: Simon Josefsson <simon(a)josefsson.org>
＠＠ -32,7 +32,7 ＠＠
;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
;; by Chris Newman <chris.newman(a)innosoft.com> (1999/06)
-;; This file now contain a combination of the two previous
+;; This file now contains a combination of the two previous
;; implementations both called "starttls.el". The first one is Daiki
;; Ueno's starttls.el which uses his own "starttls" command line tool,
;; and the second one is Simon Josefsson's starttls.el which uses
＠＠ -44,7 +44,7 ＠＠
;; both tools installed. It is recommended to use GNUTLS, though, as
;; it performs more verification of the certificates.
-;; The GNUTLS support require GNUTLS 0.9.90 (released 2003-10-08) or
+;; The GNUTLS support requires GNUTLS 0.9.90 (released 2003-10-08) or
;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls"
;; from <ftp://ftp.opaopa.org/pub/elisp/>.
＠＠ -58,7 +58,7 ＠＠
;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp))
;; (process-send-string tmp "EHLO foo\n"))
-;; An example run yield the following output:
+;; An example run yields the following output:
;;
;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65]
;; 220 2.0.0 Ready to start TLS
＠＠ -144,15 +144,14 ＠＠ i.e. when `starttls-use-gnutls' is nil."
(defcustom starttls-extra-args nil
"Extra arguments to `starttls-program'.
-This program is used when the `starttls' command is used,
-i.e. when `starttls-use-gnutls' is nil."
+These apply when the `starttls' command is used, i.e. when
+`starttls-use-gnutls' is nil."
:type '(repeat string)
:group 'starttls)
(defcustom starttls-extra-arguments nil
"Extra arguments to `starttls-program'.
-This program is used when GNUTLS is used, i.e. when
-`starttls-use-gnutls' is non-nil.
+These apply when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil.
For example, non-TLS compliant servers may require
'(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to
＠＠ -168,7 +167,7 ＠＠ find out which parameters are available.
(defcustom starttls-connect "- Simple Client Mode:\n\n"
"*Regular expression indicating successful connection.
The default is what GNUTLS's \"gnutls-cli\" outputs."
- ;; GNUTLS cli.c:main() print this string when it is starting to run
+ ;; GNUTLS cli.c:main() prints this string when it is starting to run
;; in the application read/write phase. If the logic, or the string
;; itself, is modified, this must be updated.
:type 'regexp
＠＠ -177,7 +176,7 ＠＠ The default is what GNUTLS's \"gnutls-cl
(defcustom starttls-failure "\\*\\*\\* Handshake has failed"
"*Regular expression indicating failed TLS handshake.
The default is what GNUTLS's \"gnutls-cli\" outputs."
- ;; GNUTLS cli.c:do_handshake() print this string on failure. If the
+ ;; GNUTLS cli.c:do_handshake() prints this string on failure. If the
;; logic, or the string itself, is modified, this must be updated.
:type 'regexp
:group 'starttls)
＠＠ -193,10 +192,10 ＠＠ The default is what GNUTLS's \"gnutls-cl
:group 'starttls)
(defun starttls-negotiate-gnutls (process)
- "Negotiate TLS on process opened by `open-starttls-stream'.
-This should typically only be done once. It typically return a
+ "Negotiate TLS on PROCESS opened by `open-starttls-stream'.
+This should typically only be done once. It typically returns a
multi-line informational message with information about the
-handshake, or NIL on failure."
+handshake, or nil on failure."
(let (buffer info old-max done-ok done-bad)
(if (null (setq buffer (process-buffer process)))
;; XXX How to remove/extract the TLS negotiation junk?
＠＠ -236,16 +235,16 ＠＠ handshake, or NIL on failure."
(defalias 'starttls-set-process-query-on-exit-flag
'process-kill-without-query)))
-(defun starttls-open-stream-gnutls (name buffer host service)
+(defun starttls-open-stream-gnutls (name buffer host port)
(message "Opening STARTTLS connection to `%s'..." host)
(let* (done
(old-max (with-current-buffer buffer (point-max)))
(process-connection-type starttls-process-connection-type)
(process (apply #'start-process name buffer
starttls-gnutls-program "-s" host
- "-p" (if (integerp service)
- (int-to-string service)
- service)
+ "-p" (if (integerp port)
+ (int-to-string port)
+ port)
starttls-extra-arguments)))
(starttls-set-process-query-on-exit-flag process nil)
(while (and (processp process)
＠＠ -266,11 +265,11 ＠＠ handshake, or NIL on failure."
host (if done "done" "failed"))
process))
-(defun starttls-open-stream (name buffer host service)
- "Open a TLS connection for a service to a host.
-Returns a subprocess-object to represent the connection.
+(defun starttls-open-stream (name buffer host port)
+ "Open a TLS connection for a port to a host.
+Returns a subprocess object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
+Args are NAME BUFFER HOST PORT.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or `buffer-name') to associate with the process.
Process output goes at end of that buffer, unless you specify
＠＠ -278,14 +277,15 ＠＠ BUFFER is the buffer (or `buffer-name')
BUFFER may be also nil, meaning that this process is not associated
with any buffer
Third arg is name of the host to connect to, or its IP address.
-Fourth arg SERVICE is name of the service desired, or an integer
-specifying a port number to connect to."
+Fourth arg PORT is an integer specifying a port to connect to.
+If `starttls-use-gnutls' is nil, this may also be a service name, but
+GNUTLS requires a port number."
(if starttls-use-gnutls
- (starttls-open-stream-gnutls name buffer host service)
+ (starttls-open-stream-gnutls name buffer host port)
(let* ((process-connection-type starttls-process-connection-type)
(process (apply #'start-process
name buffer starttls-program
- host (format "%s" service)
+ host (format "%s" port)
starttls-extra-args)))
(starttls-set-process-query-on-exit-flag process nil)
process)))
Index: tls.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/tls.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -p -r1.2 -r1.3
--- tls.el 16 Sep 2004 13:01:29 -0000 1.2
+++ tls.el 8 Mar 2006 10:00:35 -0000 1.3
＠＠ -1,6 +1,7 ＠＠
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-;; Copyright (C) 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon(a)josefsson.org>
;; Keywords: comm, tls, gnutls, ssl
＠＠ -19,8 +20,8 ＠＠
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
＠＠ -55,7 +56,8 ＠＠
:group 'comm)
(defcustom tls-program '("gnutls-cli -p %p %h"
- "gnutls-cli -p %p %h --protocols ssl3")
+ "gnutls-cli -p %p %h --protocols ssl3"
+ "openssl s_client -connect %h:%p -no_ssl2")
"List of strings containing commands to start TLS stream to a host.
Each entry in the list is tried until a connection is successful.
%s is replaced with server hostname, %p with port to connect to.
＠＠ -70,17 +72,47 ＠＠ after successful negotiation."
:type 'boolean
:group 'tls)
-(defcustom tls-success "- Handshake was completed"
+(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
"*Regular expression indicating completed TLS handshakes.
-The default is what GNUTLS's \"gnutls-cli\" outputs."
+The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
+\"openssl s_client\" outputs."
:type 'regexp
:group 'tls)
-(defun open-tls-stream (name buffer host service)
- "Open a TLS connection for a service to a host.
+(defcustom tls-certtool-program (executable-find "certtool")
+ "Name of GnuTLS certtool.
+Used by `tls-certificate-information'."
+:type '(repeat string)
+:group 'tls)
+
+(defun tls-certificate-information (der)
+ "Parse X.509 certificate in DER format into an assoc list."
+ (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
+ (base64-encode-string der)
+ "\n-----END CERTIFICATE-----\n"))
+ (exit-code 0))
+ (with-current-buffer (get-buffer-create " *certtool*")
+ (erase-buffer)
+ (insert certificate)
+ (setq exit-code (condition-case ()
+ (call-process-region (point-min) (point-max)
+ tls-certtool-program
+ t (list (current-buffer) nil) t
+ "--certificate-info")
+ (error -1)))
+ (if (/= exit-code 0)
+ nil
+ (let ((vals nil))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
+ (push (cons (match-string 1) (match-string 2)) vals))
+ (nreverse vals))))))
+
+(defun open-tls-stream (name buffer host port)
+ "Open a TLS connection for a port to a host.
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
+Args are NAME BUFFER HOST PORT.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
＠＠ -88,8 +120,7 ＠＠ BUFFER is the buffer (or buffer-name) to
BUFFER may be also nil, meaning that this process is not associated
with any buffer
Third arg is name of the host to connect to, or its IP address.
-Fourth arg SERVICE is name of the service desired, or an integer
-specifying a port number to connect to."
+Fourth arg PORT is an integer specifying a port to connect to."
(let ((cmds tls-program) cmd done)
(message "Opening TLS connection to `%s'..." host)
(while (and (not done) (setq cmd (pop cmds)))
＠＠ -101,9 +132,9 ＠＠ specifying a port number to connect to."
cmd
(format-spec-make
?h host
- ?p (if (integerp service)
- (int-to-string service)
- service)))))
+ ?p (if (integerp port)
+ (int-to-string port)
+ port)))))
response)
(while (and process
(memq (process-status process) '(open run))
- 1 participants
- 0 comments
[Patch Packages] Error when marking entry in RefTeX's buffer
18 years, 9 months
Vin Shelton
Vin Shelton
Forwarded to xemacs-patches for review.
---------- Forwarded message ----------
From: Braun Gabor <braung(a)renyi.hu>
Date: Mar 7, 2006 11:14 AM
Subject: [Bug: 21.4.19] Error when marking entry in RefTeX's buffer
To: XEmacs Beta <xemacs-beta(a)xemacs.org>
Dear Bug Team!
I started XEmacs with
xemacs test.tex&
(Init file and test.tex is included below.)
I tried to insert several references using RefTeX: I typed C-c ). I
typed s to select the section label type. A new buffer appeared at
the bottom with the list of the sections. I pressed down to move to
the first section, which was highlighted with a light green
background. I pressed m to mark the reference for insertion. The
entry for the first section appeared in bold and on the top a new
buffer *Backtrace* whose content is included below.
I expected that after pressing m, there is no error and *1* appears
after > in the marked entry and not in the error message. Otherwise,
XEmacs behaved as I expected.
I think the problem is a missing string to glyph conversion in
reftex-select-mark (supported by the wrong type argument error on the
top of the backtrace) when ir calls reftex-overlay-put. I haven't
found any shorter way for the conversion than
(make-glyph (vector 'string ':data STRING))
where STRING is a Lisp expression evaluating to a string.
I suggest the following patch, which adds the above string to glyph
conversion (also for reftex-select-unmark for completeness):
--- /usr/local/lib/xemacs/xemacs-packages/lisp/reftex/reftex-sel.el
2004-03-15 16:50:20.000000000 +0100
+++ /home/gabor/.xemacs-igazi/xemacs-packages/lisp/reftex/reftex-sel.el
2006-03-07 16:23:35.000000000 +0100
＠＠ -609,10 +609,11 ＠＠
(reftex-overlay-put ovl 'face reftex-select-mark-face)
(if (featurep 'xemacs)
(reftex-overlay-put ovl 'begin-glyph
+ (make-glyph (vector 'string ':data
(if separator
(format "*%c%d* " separator
(length reftex-select-marked))
- (format "*%d* " (length reftex-select-marked)))))
+ (format "*%d* " (length reftex-select-marked)))))))
(message "Entry has mark no. %d" (length reftex-select-marked))))
(defun reftex-select-mark-comma ()
＠＠ -646,9 +647,10 ＠＠
(mapcar (lambda (c)
(setq sep (nth 2 c))
(reftex-overlay-put (nth 1 c) 'begin-glyph
+ (make-glyph (vector 'string ':data
(if sep
(format "*%c%d* " sep (decf cnt))
- (format "*%d* " (decf cnt)))))
+ (format "*%d* " (decf cnt)))))))
reftex-select-marked)))
(message "Entry no longer marked")))
I have tried the patch and seems to fix the problem.
Files for reproducing the bug:
Lines starting with --- mark the beginning and end of file but do not
belong to the file.
--- ~/.xemacs/init.el
(setq debug-on-error t)
(require 'tex-site) ;AUCTeX
(setq TeX-parse-self t
TeX-auto-save t)
;;RefTeX
(add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
(add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
(setq reftex-plug-into-AUCTeX t) ; RefTeX -> AUCTeX
--- End of ~/.xemacs/init.el
--- test.tex
\documentclass{article}
\begin{document}
\section{First section}
\label{sec:first-section}
\section{Second section}
\label{sec:second-section}
\end{document}
-- End of test.tex
--- Buffer *Backtrace*
Debugger entered--Lisp error: (wrong-type-argument glyphp "*1* ")
reftex-overlay-put(#<extent [22, 101) 0x88d7f54 in buffer *RefTeX
Select*> begin-glyph "*1* ")
#<compiled-function (&optional separator) "...(96)" [separator eoe
boe data ovl reftex-select-marked get-text-property :data nil error
"No entry to mark at point" "Entry is already marked"
previous-single-property-change next-single-property-change
reftex-make-overlay reftex-overlay-put face featurep xemacs
begin-glyph format "*%c%d* " "*%d* " message "Entry has mark no. %d"
reftex-select-mark-face] 8
("/usr/local/lib/xemacs/xemacs-packages/lisp/reftex/reftex-sel.elc" .
10843) nil>()
call-interactively(reftex-select-mark)
recursive-edit()
byte-code("..." [prompt keymap reftex-last-line reftex-last-data
offset truncate-lines t reftex-find-start-point 0 make-local-variable
reftex-last-follow-point ((byte-code "\nÉ"ˆŠ
qˆÄÃ!ˆÅÆÇÈ#ˆÅÉÊÈ#ˆ)ËÌ\"‡" ... 4)) use-local-map add-hook
pre-command-hook reftex-select-pre-command-hook nil post-command-hook
reftex-select-post-command-hook princ featurep xemacs run-hooks
recursive-edit reftex-recursive-edit-marker] 5)
byte-code("..." [((byte-code "ÆÇe \n$ˆÈyˆÉÊ!`LˆËŽÌ
!ˆÍÎÏÐÆ$ˆÍÑÒÐÆ$ˆÓ!ˆ`Ð"ˆÔÕ!«„ÖÑ!ˆ× )‡" ... 5))] 1)
reftex-select-item("Select: [n]ext [p]revious [r]escan [ ]context
e[x]tern [q]uit RET [?]HELP+more" " n / p Go to next/previous
label (Cursor motion works as well)\n C-c C-n/p Go to next/previous
section heading.\n b / l Jump back to previous selection / Reuse
last referenced label.\n z Jump to a specific section, e.g.
'3 z' jumps to section 3.\n g / s Update menu / Switch label
type.\n r / C-u r Reparse document / Reparse entire document.\n x
Switch to label menu of external document (with LaTeX package
`xr').\n F t c Toggle: [F]ile borders, [t]able of contents,
[c]ontext\n # % Toggle: [#] label counters, [%] labels in
comments\n SPC / f Show full context in other window / Toggle
follow mode.\n . Show insertion point in other window.\n v
/ V Toggle \\ref <-> \\vref / Rotate \\ref <=> \\fref <=> \\Fref\n
TAB Enter a label with completion.\n m , - + Mark entry.
`,-+' also assign a separator.!
\n a / A Put all marked entries into one/many \\ref commands.\n
q / RET Quit without referencing / Accept current label (also on
mouse-2)." #<keymap size 52 0x1fd0> (toc "toc" " 1 First section"
"/home/gabor/tmp/reftex/test.tex" #<marker at 43 in test.tex
0x8956c54> 2 "1" "\\section{First section}" 43)
reftex-show-label-location nil)
byte-code("..." [here-I-am typekey offset buf entries key
delete-other-windows syntax-table reftex-select-label-mode
switch-to-buffer-other-window reftex-make-selection-buffer-name
"*RefTeX Select*" reftex-erase-buffer add-to-list selection-buffers t
"---- " mode-line-buffer-identification " " global-mode-string "
(" ")" " S<" refstyle ">" " -%-" 0 buffer-size nil message "Creating
Selection Buffer..." reftex-insert-docstruct reftex-get-offset
reftex-select-item reftex-show-label-location 2 throw exit ?g ?r ?R
reftex-reparse-document ?c ?s reftex-query-label-type ?t
prefix-numeric-value ?F ?\# ?% ...] 13)
byte-code("..." [((byte-code "Æ ˆ NÇ OÈ PQ«ÉŠ qˆÊ !)!ˆª‡ÉË!ˆÌ
ˆ)RÈa¬ƒÈ ˆÍÎp\"ˆÏSÐÑÒÓÔTÕÖ×ØÙ¯ UÚÛ U«¢Ü IÝÞ!ˆß ＠
ÜABCD(r)\nJÜ& )ª«ˆà
#ª‚ÏÏI\n(r)ÏÜáVWX\nâY&‰E＠EA＠FãE8KÏ
¬…äåÜ\"ˆ
æa«†Ì ˆ‚Ñ
ça¬…
èa«"G«‚èÌ ˆé K
#ˆ‚Ñ
êa«‹Ì ˆB?B‚Ñ
ëa«‰Zì ‚Ñ
ía«˜Ì ˆG«‰îG![‚Ñ＠?＠‚Ñ
ïa«‹Ì ˆA?A‚Ñ
ða«‹Ì ˆC?C‚Ñ
ña«‹Ì ˆD?D‚Ñ
òa«‹LäåÏ\"ˆ‚Ñ
óa«(c)ôH?\"?õ?H8A!(r)ƒö÷!?H8＠(r)øJ qˆù ˆªÒ
;«•ú
\\J\"(r)ƒ
DCCäåÏ\"ˆª¹
ûs«°M«†MŸªF«‡FCCª‚Ü «Œ
ük«„ý B L qˆäåÏ\"ˆª„öþ!ˆÜ‡" ... 13))] 1)
reftex-offer-label-menu("s")
#<compiled-function (&optional type no-insert cut) "...(270)" [cut
label reftex-format-ref-function form type labels
reftex-check-recursive-edit reftex-access-scan-info
reftex-guess-label-type reftex-query-label-type reftex-typekey-check
"\\vref" "\\fref" "\\ref" "\\ref{%s}" nil reftex-offer-label-menu
reftex-ensure-compiled-variables concat mapconcat car "," assoc
message "Quit" 2 backward-delete-char ?~ string-to-char (?\ ?\t ?\n
?\. ?~) 1 reftex-format-vref reftex-format-fref "\\Fref"
reftex-format-Fref format "" refstyle sep1 sep
reftex-select-return-marker current-prefix-arg reftex-vref-is-default
reftex-fref-is-default reftex-typekey-to-format-alist no-insert
reftex-multiref-punctuation] 5
("/usr/local/lib/xemacs/xemacs-packages/lisp/reftex/reftex-ref.elc" .
7672) nil>()
call-interactively(reftex-reference)
--- End of *Backtrace*
Best wishes,
Gabor Braun
================================================================
System Info to help track down your bug:
---------------------------------------
uname -a: Linux gabor 2.6.15-1-686 #1 Tue Feb 21 20:25:22 UTC 2006
i686 GNU/Linux
./configure '--dynamic' '--with-msw=no' '--with-widgets=athena'
'--with-athena=3d' '--with-sound=esd,native' '--with-mule'
'--with-xfs' '--pdump' '--with-file-coding'
XEmacs 21.4.19 "Constant Variable" configured for `i686-pc-linux'.
Compilation / Installation:
Source code location: /home/gabor/xemacs-21.4.19
Installation prefix: /usr/local
Operating system description file: `s/linux.h'
Machine description file: `m/intel386.h'
Compiler: gcc -g -O3 -Wall -Wno-switch
-Winline -Wmissing-prototypes -Wsign-compare -fno-strict-aliasing
-Wshadow
Compiler version: gcc (GCC) 3.3.5 (Debian 1:3.3.5-13)
Compiler specs file: /usr/lib/gcc-lib/i486-linux/3.3.5/specs
Relocating allocator for buffers: no
GNU version of malloc: yes
- Using Doug Lea's new malloc from the GNU C Library.
Need to guess glibc1/2/etc here
Window System:
Compiling in support for the X window system:
- X Windows headers location: /usr/X11R6/include
- X Windows libraries location: /usr/X11R6/lib
- Handling WM_COMMAND properly.
Compiling in support for the Athena widget set:
- Athena headers location: X11/Xaw3d
- Athena library to link: Xaw3d
Using Lucid menubars.
Using Lucid scrollbars.
Using Athena dialog boxes.
Using Athena native widgets.
TTY:
Compiling in support for ncurses.
Images:
Compiling in support for GIF images (builtin).
Compiling in support for XPM images.
Compiling in support for PNG images.
Compiling in support for JPEG images.
Compiling in support for TIFF images.
Sound:
Compiling in support for sound (native).
Compiling in support for ESD (Enlightened Sound Daemon).
Databases:
Internationalization:
Compiling in support for Mule (multi-lingual Emacs).
Compiling in support for file coding.
Compiling in support for XIM (X11R5+ I18N input method).
- Using raw Xlib to provide XIM support.
- Using XFontSet to provide bilingual menubar.
Mail:
Compiling in support for "dot-locking" mail spool file locking method.
Other Features:
Inhibiting IPv6 canonicalization at startup.
Compiling in support for dynamic shared object modules.
Using the new portable dumper.
Load-Path Lisp Shadows:
----------------------
nil
Installed XEmacs Packages:
-------------------------
(xslide ver: 1.09 upstream: 0.2.2)
(xlib ver: 1.14 upstream: lg(a)xwem.org--2005/xlib--main--2.1--version-0)
(xemacs-devel ver: 1.72 upstream: No-Upstream-Ver)
(xemacs-base ver: 2.01 upstream: No-Upstream-Ver)
(x-symbol ver: 1.1 upstream: 4.5.1)
(w3 ver: 1.32 upstream: 4.0pre47)
(vm ver: 7.22 upstream: 7.17)
(vc ver: 1.41 upstream: No-Upstream-Ver)
(tramp ver: 1.28 upstream: 2.0.51)
(textools ver: 1.15 upstream: No-Upstream-Ver)
(text-modes ver: 1.9 upstream: No-Upstream-Ver)
(texinfo ver: 1.3 upstream: No-Upstream-Ver)
(supercite ver: 1.21 upstream: 3.55x3)
(strokes ver: 1.1 upstream: No-Upstream-Ver)
(speedbar ver: 1.28 upstream: 0.14beta4)
(sounds-wav ver: 1.12 upstream: No-Upstream-Ver)
(sh-script ver: 1.21 upstream: 2.0f)
(sasl ver: 1.16 upstream: 1.14.4)
(reftex ver: 1.34 upstream: 4.21)
(re-builder ver: 1.05 upstream: 1.20)
(python-modes ver: 1.07 upstream: No-Upstream-Ver)
(psgml ver: 1.44 upstream: 1.3.1)
(ps-print ver: 1.11 upstream: 6.5.6)
(prog-modes ver: 2.06 upstream: No-Upstream-Ver)
(pgg ver: 1.06 upstream: 0.1)
(perl-modes ver: 1.08 upstream: No-Upstream-Ver)
(pcomplete ver: 1.04 upstream: 1.1.6)
(pcl-cvs ver: 1.66 upstream: R-2_9_9)
(pc ver: 1.28 upstream: No-Upstream-Ver)
(os-utils ver: 1.36 upstream: No-Upstream-Ver)
(net-utils ver: 1.48 upstream: N/A)
(mmm-mode ver: 1.02 upstream: 0.4.7)
(mail-lib ver: 1.75 upstream: No-Upstream-Ver)
(ispell ver: 1.32 upstream: 3.6)
(ilisp ver: 1.33 upstream: 5.12.0)
(igrep ver: 1.14 upstream: 2.111)
(ibuffer ver: 1.09 upstream: No-Upstream-Ver)
(hm--html-menus ver: 1.23 upstream: 5.9)
(gnats ver: 1.17 upstream: 3.101)
(general-docs ver: 1.04 upstream: No-Upstream-Ver)
(fsf-compat ver: 1.15 upstream: No-Upstream-Ver)
(frame-icon ver: 1.11 upstream: No-Upstream-Ver)
(eterm ver: 1.17 upstream: No-Upstream-Ver)
(eshell ver: 1.1 upstream: 2.4.1)
(escreen ver: 1.01 upstream: 1.16)
(emerge ver: 1.11 upstream: No-Upstream-Ver)
(elib ver: 1.11 upstream: 1.0)
(eieio ver: 1.05 upstream: 0.17)
(efs ver: 1.33 upstream: 1.23)
(edit-utils ver: 2.32 upstream: No-Upstream-Ver)
(ediff ver: 1.6 upstream: 2.75)
(edebug ver: 1.21 upstream: No-Upstream-Ver)
(ecrypto ver: 0.2 upstream: 2.0)
(ecb ver: 1.22 upstream: 2.31)
(docbookide ver: 0.07000000000000001 upstream: 0.1)
(dired ver: 1.17 upstream: 7.13)
(debug ver: 1.17 upstream: No-Upstream-Ver)
(cc-mode ver: 1.45 upstream: 5.30.10)
(c-support ver: 1.22 upstream: No-Upstream-Ver)
(bbdb ver: 1.29 upstream: 2.34)
(auctex ver: 1.46 upstream: 11.55)
(apel ver: 1.32 upstream: 10.6)
(mule-ucs ver: 1.14 upstream: 0.84)
(mule-base ver: 1.47 upstream: No-Upstream-Ver)
(lookup ver: 1.15 upstream: 1.0)
(locale ver: 1.22 upstream: No-Upstream-Ver)
(leim ver: 1.22 upstream: No-Upstream-Ver)
(latin-unity ver: 1.16 upstream: 1.16)
(latin-euro-standards ver: 1.07 upstream: 1.07)
Installed Modules:
-----------------
Features:
--------
(mail-abbrevs xemacsbug shadow sendmail rfc822 debug reftex-sel
reftex-parse reftex-ref reftex-vcr reftex-dcr reftex-auc reftex
reftex-vars outline font-latex font disp-table font-lock cus-face
latex tex advice advice-preload regexp-opt efs-cu tex-site
xslide-autoloads xlib-autoloads xemacs-devel-autoloads
xemacs-base-autoloads x-symbol-autoloads w3-autoloads vm-autoloads
vc-autoloads tramp-autoloads textools-autoloads text-modes-autoloads
texinfo-autoloads supercite-autoloads strokes-autoloads
speedbar-autoloads sounds-wav-autoloads sh-script-autoloads
sasl-autoloads reftex-autoloads re-builder-autoloads
python-modes-autoloads psgml-autoloads ps-print-autoloads
prog-modes-autoloads pgg-autoloads perl-modes-autoloads
pcomplete-autoloads pcl-cvs-autoloads pc-autoloads os-utils-autoloads
net-utils-autoloads mmm-mode-autoloads mail-lib-autoloads
ispell-autoloads ilisp-autoloads igrep-autoloads ibuffer-autoloads
hm--html-menus-autoloads gnats-autoloads general-docs-autoloads
fsf-compat-autoloads frame-icon-autoloads eterm-autoloads
eshell-autoloads escreen-autoloads emerge-autoloads elib-autoloads
eieio-autoloads efs-autoloads edit-utils-autoloads ediff-autoloads
edebug-autoloads ecrypto-autoloads ecb-autoloads docbookide-autoloads
dired-autoloads debug-autoloads cc-mode-autoloads c-support-autoloads
bbdb-autoloads auctex-autoloads apel-autoloads mule-ucs-autoloads
mule-base-autoloads lookup-autoloads locale-autoloads leim-autoloads
latin-unity-autoloads latin-euro-standards-autoloads lisp-autoloads
loadhist auto-show fontl-hooks x-iso8859-1 slovenian czech romanian
ccl mule-help code-cmds gutter-items menubar-items x-menubar
mode-motion mouse itimer auto-save lisp-mode easymenu iso8859-1 page
buff-menu lib-complete cus-file derived frame text-props obsolete
cus-start custom widget cl-extra mini-cl cl cl-19 packages backquote
very-early-lisp file-coding mule lucid-scrollbars cut-buffer
lucid-menubars athena-dialogs x c-balloon-help tty-frames tty toolbar
esd-sound native-sound scrollbar unix-processes multicast
network-streams subprocesses modules menu-accelerator-support menubar
md5 xemacs xim gutter tiff png gif jpeg xpm xbm lisp-float-type linux
dialog devices window-system base64)
Recent keystrokes:
-----------------
C-c ) s down m misc-user
Recent messages (most recent first):
-----------------------------------
Loading xemacsbug...done
Loading xemacsbug...
Entering debugger...
Loading debug...done
Loading debug...
Select: [n]ext [p]revious [r]escan [ ]context e[x]tern [q]uit RET [?]HELP+more
Select: [n]ext [p]revious [r]escan [ ]context e[x]tern [q]uit RET [?]HELP+more
Creating Selection Buffer...
Loading reftex-sel...done
Loading reftex-sel...
Label type: [ efinNst]
Label type: [ efinNst] (?=Help)
Scanning document... done
Scanning section 2 ...
Scanning section 1 ...
Scanning file /home/gabor/tmp/reftex/test.tex
Scanning entire document...
Loading reftex-parse...done
Loading reftex-parse...
Compiling label environment definitions...done
--
Whoever you are, no matter how lonely,
the world offers itself to your imagination,
calls to you like the wild geese, harsh and exciting--
over and over announcing your place
in the family of things. Mary Oliver
- 1 participants
- 0 comments
[C pkgs] Update JDE to 2.3.3
18 years, 9 months
Ville Skyttä
Ville Skyttä
COMMIT
As mentioned on xemacs-beta, I've synced JDE with upstream 2.3.3, Andy
ack'd the update. Diff from the previous version even with whitespace
ignored is 1.5MB, so not posted here. I gather it's available through
the commits list anyway.
2006-03-03 Ville Skyttä <scop(a)xemacs.org>
* Sync with upstream 2.3.3.
- 4 participants
- 6 comments
[AC21.5] Fix GC mouse cursor
18 years, 9 months
Marcus Crestani
Marcus Crestani
APPROVE COMMIT 21.5
NOTE: This patch has been committed.
The GC mouse cursor gets stuck on the little watch icon that indicates
ongoing garbage collection activity, although NEW_GC is already done
with collecting garbage. This fixes it.
src/ChangeLog addition:
2006-03-02 Marcus Crestani <crestani(a)xemacs.org>
* gc.c (show_gc_cursor_and_message): New.
* gc.c (remove_gc_cursor_and_message): New.
* gc.c (gc_prepare): Move mouse pointer code to
show_gc_cursor_and_message.
* gc.c (gc_finish): Move mouse pointer code to
remove_gc_cursor_and_message.
* gc.c (gc): Call show/remove_gc_cursor_and_message.
* gc.c (garbage_collect_1): Call
show/remove_gc_cursor_and_message.
xemacs-21.5 source patch:
Diff command: cvs -q diff -u
Files affected: src/gc.c
Index: src/gc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gc.c,v
retrieving revision 1.2
diff -u -r1.2 gc.c
--- src/gc.c 27 Feb 2006 16:29:26 -0000 1.2
+++ src/gc.c 2 Mar 2006 16:54:37 -0000
＠＠ -1499,24 +1499,11 ＠＠
#endif
void
-gc_prepare (void)
+show_gc_cursor_and_message (void)
{
-#if MAX_SAVE_STACK > 0
- char stack_top_variable;
- extern char *stack_bottom;
-#endif
-
-#ifdef NEW_GC
- GC_STAT_START_NEW_GC;
- GC_SET_PHASE (INIT_GC);
-#endif /* NEW_GC */
-
- do_backtrace = profiling_active || backtrace_with_internal_sections;
-
- assert (!gc_in_progress);
- assert (!in_display || gc_currently_forbidden);
-
- PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
+ /* Now show the GC cursor/message. */
+ pre_gc_cursor = Qnil;
+ cursor_changed = 0;
/* We used to call selected_frame() here.
＠＠ -1533,18 +1520,6 ＠＠
f = XFRAME (frame);
}
- pre_gc_cursor = Qnil;
- cursor_changed = 0;
-
- need_to_signal_post_gc = 0;
- recompute_funcall_allocation_flag ();
-
- if (!gc_hooks_inhibited)
- run_hook_trapping_problems
- (Qgarbage_collecting, Qpre_gc_hook,
- INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
-
- /* Now show the GC cursor/message. */
if (!noninteractive)
{
if (FRAME_WIN_P (f))
＠＠ -1578,6 +1553,65 ＠＠
}
}
}
+}
+
+void
+remove_gc_cursor_and_message (void)
+{
+ /* Now remove the GC cursor/message */
+ if (!noninteractive)
+ {
+ if (cursor_changed)
+ Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
+ else if (!FRAME_STREAM_P (f))
+ {
+ /* Show "...done" only if the echo area would otherwise be empty. */
+ if (NILP (clear_echo_area (selected_frame (),
+ Qgarbage_collecting, 0)))
+ {
+ if (garbage_collection_messages)
+ {
+ Lisp_Object args[2], whole_msg;
+ args[0] = (STRINGP (Vgc_message) ? Vgc_message :
+ build_msg_string (gc_default_message));
+ args[1] = build_msg_string ("... done");
+ whole_msg = Fconcat (2, args);
+ echo_area_message (selected_frame (), (Ibyte *) 0,
+ whole_msg, 0, -1,
+ Qgarbage_collecting);
+ }
+ }
+ }
+ }
+}
+
+void
+gc_prepare (void)
+{
+#if MAX_SAVE_STACK > 0
+ char stack_top_variable;
+ extern char *stack_bottom;
+#endif
+
+#ifdef NEW_GC
+ GC_STAT_START_NEW_GC;
+ GC_SET_PHASE (INIT_GC);
+#endif /* NEW_GC */
+
+ do_backtrace = profiling_active || backtrace_with_internal_sections;
+
+ assert (!gc_in_progress);
+ assert (!in_display || gc_currently_forbidden);
+
+ PROFILE_RECORD_ENTERING_SECTION (QSin_garbage_collection);
+
+ need_to_signal_post_gc = 0;
+ recompute_funcall_allocation_flag ();
+
+ if (!gc_hooks_inhibited)
+ run_hook_trapping_problems
+ (Qgarbage_collecting, Qpre_gc_hook,
+ INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION);
/***** Now we actually start the garbage collection. */
＠＠ -1813,32 +1847,6 ＠＠
/******* End of garbage collection ********/
- /* Now remove the GC cursor/message */
- if (!noninteractive)
- {
- if (cursor_changed)
- Fset_frame_pointer (wrap_frame (f), pre_gc_cursor);
- else if (!FRAME_STREAM_P (f))
- {
- /* Show "...done" only if the echo area would otherwise be empty. */
- if (NILP (clear_echo_area (selected_frame (),
- Qgarbage_collecting, 0)))
- {
- if (garbage_collection_messages)
- {
- Lisp_Object args[2], whole_msg;
- args[0] = (STRINGP (Vgc_message) ? Vgc_message :
- build_msg_string (gc_default_message));
- args[1] = build_msg_string ("... done");
- whole_msg = Fconcat (2, args);
- echo_area_message (selected_frame (), (Ibyte *) 0,
- whole_msg, 0, -1,
- Qgarbage_collecting);
- }
- }
- }
- }
-
#ifndef NEW_GC
if (!breathing_space)
{
＠＠ -1984,8 +1992,12 ＠＠
have infinite GC recursion. */
speccount = begin_gc_forbidden ();
+ show_gc_cursor_and_message ();
+
gc_1 (incremental);
+ remove_gc_cursor_and_message ();
+
/* now stop inhibiting GC */
unbind_to (speccount);
}
＠＠ -2045,6 +2057,8 ＠＠
have infinite GC recursion. */
speccount = begin_gc_forbidden ();
+ show_gc_cursor_and_message ();
+
gc_prepare ();
#ifdef USE_KKCC
kkcc_gc_stack_init();
＠＠ -2065,6 +2079,8 ＠＠
#endif /* USE_KKCC */
gc_sweep_1 ();
gc_finish ();
+
+ remove_gc_cursor_and_message ();
/* now stop inhibiting GC */
unbind_to (speccount);
--
Marcus
- 1 participants
- 0 comments