From: Stefan Monnier Date: Mon, 2 Apr 2001 22:49:38 +0000 (+0000) Subject: (mail-extr-delete-char, mail-extr-safe-move-sexp) X-Git-Tag: emacs-pretest-21.0.101~40 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7a9ebd0b8e3b96447e5e901379baedd697b2bebd;p=emacs.git (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 --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 7a58699e095..5e693dc11f4 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -618,37 +618,36 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; 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")) - - -(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)) - ))))) + (skip-chars-backward " \t\n\r\240")) + -(defmacro mail-extr-nuke-char-at (pos) - (` (save-excursion - (goto-char (, pos)) - (mail-extr-delete-char 1) - (insert ?\ )))) +(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)))))) + +(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 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." 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 @@ the form ((FULL-NAME CANONICAL-ADDRESS) ...) with one element for 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 @@ ADDRESS may be a string or a buffer. If it is a buffer, the visible (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 @@ ADDRESS may be a string or a buffer. If it is a buffer, the visible (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 @@ ADDRESS may be a string or a buffer. If it is a buffer, the visible ;; 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 @@ ADDRESS may be a string or a buffer. If it is a buffer, the visible ;; 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 @@ ADDRESS may be a string or a buffer. If it is a buffer, the visible (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)))