changeset 37148:aca2b7839d21

(mail-extr-delete-char, mail-extr-safe-move-sexp) (mail-extr-skip-whitespace-forward, mail-extr-nuke-char-at) (mail-extr-skip-whitespace-backward, mail-extr-undo-backslash-quoting): Use `defsubst' rather than a macro to ease debugging. (mail-extr-last): Remove (use `last' instead). (mail-extract-address-components): Properly reset the syntax-table after parsing an address. Use `last' rather than mail-extr-last. Make sure the end marker stays at the very end.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Mon, 02 Apr 2001 22:49:38 +0000
parents 4ba3b922976f
children 92239370ac9f
files lisp/mail/mail-extr.el
diffstat 1 files changed, 40 insertions(+), 51 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/mail-extr.el	Mon Apr 02 20:40:16 2001 +0000
+++ b/lisp/mail/mail-extr.el	Mon Apr 02 22:49:38 2001 +0000
@@ -618,37 +618,36 @@
 ;; Utility functions and macros.
 ;;
 
-(defmacro mail-extr-delete-char (n)
+(defsubst mail-extr-delete-char (n)
   ;; in v19, delete-char is compiled as a function call, but delete-region
   ;; is byte-coded, so it's much much faster.
-  (list 'delete-region '(point) (list '+ '(point) n)))
+  (delete-region (point) (+ (point) n)))
 
-(defmacro mail-extr-skip-whitespace-forward ()
+(defsubst mail-extr-skip-whitespace-forward ()
   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
-  '(skip-chars-forward " \t\n\r\240"))
+  (skip-chars-forward " \t\n\r\240"))
 
-(defmacro mail-extr-skip-whitespace-backward ()
+(defsubst mail-extr-skip-whitespace-backward ()
   ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
-  '(skip-chars-backward " \t\n\r\240"))
+  (skip-chars-backward " \t\n\r\240"))
 
 
-(defmacro mail-extr-undo-backslash-quoting (beg end)
-  (`(save-excursion
-      (save-restriction
-	(narrow-to-region (, beg) (, end))
-	(goto-char (point-min))
-	;; undo \ quoting
-	(while (search-forward "\\" nil t)
-	  (mail-extr-delete-char -1)
-	  (or (eobp)
-	      (forward-char 1))
-	  )))))
+(defsubst mail-extr-undo-backslash-quoting (beg end)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region beg end)
+      (goto-char (point-min))
+      ;; undo \ quoting
+      (while (search-forward "\\" nil t)
+	(mail-extr-delete-char -1)
+	(or (eobp)
+	    (forward-char 1))))))
 
-(defmacro mail-extr-nuke-char-at (pos)
-  (` (save-excursion
-       (goto-char (, pos))
-       (mail-extr-delete-char 1)
-       (insert ?\ ))))
+(defsubst mail-extr-nuke-char-at (pos)
+  (save-excursion
+    (goto-char pos)
+    (mail-extr-delete-char 1)
+    (insert ?\ )))
 
 (put 'mail-extr-nuke-outside-range
      'edebug-form-spec '(symbolp &optional form form atom))
@@ -693,26 +692,18 @@
       pos
     (copy-marker pos)))
 
-(defmacro mail-extr-last (list)
-  ;; Returns last element of LIST.
-  ;; Could be a subst.
-  (` (let ((list (, list)))
-       (while (not (null (cdr list)))
-	 (setq list (cdr list)))
-       (car list))))
-  
-(defmacro mail-extr-safe-move-sexp (arg)
+(defsubst mail-extr-safe-move-sexp (arg)
   ;; Safely skip over one balanced sexp, if there is one.  Return t if success.
-  (` (condition-case error
-	 (progn
-	   (goto-char (or (scan-sexps (point) (, arg)) (point)))
-	   t)
-       (error
-	;; #### kludge kludge kludge kludge kludge kludge kludge !!!
-	(if (string-equal (nth 1 error) "Unbalanced parentheses")
-	    nil
-	  (while t
-	    (signal (car error) (cdr error))))))))
+  (condition-case error
+      (progn
+	(goto-char (or (scan-sexps (point) arg) (point)))
+	t)
+    (error
+     ;; #### kludge kludge kludge kludge kludge kludge kludge !!!
+     (if (string-equal (nth 1 error) "Unbalanced parentheses")
+	 nil
+       (while t
+	 (signal (car error) (cdr error)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -735,7 +726,7 @@
 each recipient.  If ALL is nil, then if ADDRESS contains more than
 one recipients, all but the first is ignored.
 
-ADDRESS may be a string or a buffer.  If it is a buffer, the visible 
+ADDRESS may be a string or a buffer.  If it is a buffer, the visible
  (narrowed) portion of the buffer will be interpreted as the address.
  (This feature exists so that the clever caller might be able to avoid
  consing a string.)"
@@ -743,8 +734,7 @@
 	(extraction-buffer (get-buffer-create " *extract address components*"))
 	value-list)
 
-    (save-excursion
-      (set-buffer extraction-buffer)
+    (with-current-buffer (get-buffer-create extraction-buffer)
       (fundamental-mode)
       (buffer-disable-undo extraction-buffer)
       (set-syntax-table mail-extr-address-syntax-table)
@@ -766,11 +756,9 @@
 
       (set-text-properties (point-min) (point-max) nil)
 
-      (save-excursion
-	(set-buffer canonicalization-buffer)
+      (with-current-buffer (get-buffer-create canonicalization-buffer)
 	(fundamental-mode)
 	(buffer-disable-undo canonicalization-buffer)
-	(set-syntax-table mail-extr-address-syntax-table)
 	(setq case-fold-search nil))
 
       
@@ -804,6 +792,7 @@
 	      ;;	mailbox-name-processed-flag
 	      disable-initial-guessing-flag) ; dynamically set from -voodoo
 
+	  (set-syntax-table mail-extr-address-syntax-table)
 	  (goto-char (point-min))
 
 	  ;; Insert extra space at beginning to allow later replacement with <
@@ -868,12 +857,12 @@
 			    ;; BUG FIX: This test was reversed.  Thanks to the
 			    ;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
 			    ;; for discovering this!
-			    (< (mail-extr-last <-pos) (car >-pos)))))
+			    (< (car (last <-pos)) (car >-pos)))))
 	      ;; The argument contains more than one address.
 	      ;; Temporarily hide everything after this one.
-	      (setq end-of-address (copy-marker (1+ (point))))
+	      (setq end-of-address (copy-marker (1+ (point)) t))
 	      (narrow-to-region (point-min) (1+ (point)))
-	      (mail-extr-delete-char 1)
+	      (delete-char 1)
 	      (setq char ?\() ; HAVE I NO SHAME??
 	      )
 	     ;; record the position of various interesting chars, determine
@@ -1145,7 +1134,7 @@
 			       (mail-extr-@-binds-tighter-than-!
 				(setq insert-point (point-max)))
 			       (%-pos
-				(setq insert-point (mail-extr-last %-pos)
+				(setq insert-point (car (last %-pos))
 				      saved-%-pos (mapcar 'mail-extr-markerize %-pos)
 				      %-pos nil
 				      @-pos (mail-extr-markerize @-pos)))