# HG changeset patch # User Stefan Monnier # Date 986251778 0 # Node ID aca2b7839d21e63688473af9fa290235255f0213 # Parent 4ba3b922976fe1e740bfcfc70f7d9b3917f1f8ff (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. diff -r 4ba3b922976f -r aca2b7839d21 lisp/mail/mail-extr.el --- 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 ;; 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)))