X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmessage.el;h=cf7926a268cf57bb6cbecbe41a6f0341ce99afe6;hp=b359eb7ed74e0a752d84bfec51fd31b413b2ed69;hb=829fe7e073a13eaf991e04e90b1e731b1ccce0c2;hpb=b83561e18ceb438203812786590893bd5fc2a6cc diff --git a/lisp/message.el b/lisp/message.el index b359eb7ed..cf7926a26 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -371,7 +371,7 @@ few false positives here." (defcustom message-archive-header "X-No-Archive: Yes\n" "Header to insert when you don't want your article to be archived. -Archives \(such as groups.google.com\) respect this header." +Archives \(such as groups.google.com) respect this header." :version "22.1" :type 'string :link '(custom-manual "(message)Header Commands") @@ -549,7 +549,7 @@ The provided functions are: newsgroup), in brackets followed by the subject * `message-forward-subject-name-subject' Source of article (name of author or newsgroup), in brackets followed by the subject -* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended +* `message-forward-subject-fwd' Subject of article with `Fwd:' prepended to it." :group 'message-forwarding :link '(custom-manual "(message)Forwarding") @@ -893,7 +893,7 @@ It may also be a function. For e.g., if you wish to set the envelope sender address so that bounces go to the right place or to deal with listserv's usage of that address, you -might set this variable to '(\"-f\" \"you@some.where\")." +might set this variable to (\"-f\" \"you@some.where\")." :group 'message-sending :link '(custom-manual "(message)Mail Variables") :type '(choice (function) @@ -1017,7 +1017,8 @@ are replaced: %n The mail address, e.g. \"john.doe@example.invalid\". %N The real name if present, e.g.: \"John Doe\", else fall back to the mail address. - %F The first name if present, e.g.: \"John\". + %F The first name if present, e.g.: \"John\", else fall + back to the mail address. %L The last name if present, e.g.: \"Doe\". %Z, %z The time zone in the numeric form, e.g.:\"+0000\". @@ -1157,7 +1158,7 @@ Note: Many newsgroups frown upon nontraditional reply styles. You probably want to set this variable only for specific groups, e.g. using `gnus-posting-styles': - (eval (set (make-local-variable 'message-cite-reply-position) 'above))" + (eval (set (make-local-variable \\='message-cite-reply-position) \\='above))" :version "24.1" :type '(choice (const :tag "Reply inline" traditional) (const :tag "Reply above" above) @@ -1166,7 +1167,7 @@ e.g. using `gnus-posting-styles': (defcustom message-cite-style nil "*The overall style to be used when yanking cited text. -Value is either `nil' (no variable overrides) or a let-style list +Value is either nil (no variable overrides) or a let-style list of pairs (VARIABLE VALUE) that will be bound in `message-yank-original' to do the quoting. @@ -1174,7 +1175,7 @@ Presets to impersonate popular mail agents are found in the message-cite-style-* variables. This variable is intended for use in `gnus-posting-styles', such as: - ((posting-from-work-p) (eval (set (make-local-variable 'message-cite-style) message-cite-style-outlook)))" + ((posting-from-work-p) (eval (set (make-local-variable \\='message-cite-style) message-cite-style-outlook)))" :version "24.1" :group 'message-insertion :type '(choice (const :tag "Do not override variables" :value nil) @@ -1243,7 +1244,7 @@ If stringp, use this; if non-nil, use no host name (user name only)." (defvar message-reply-headers nil "The headers of the current replied article. It is a vector of the following headers: -\[number subject from date id references chars lines xref extra].") +[number subject from date id references chars lines xref extra].") (defvar message-newsreader nil) (defvar message-mailer nil) (defvar message-sent-message-via nil) @@ -1346,7 +1347,7 @@ actually occur." "Alist of ways to send outgoing messages. Each element has the form - \(TYPE PREDICATE FUNCTION) + (TYPE PREDICATE FUNCTION) where TYPE is a symbol that names the method; PREDICATE is a function called without any parameters to determine whether the message is @@ -1806,7 +1807,10 @@ no, only reply back to the author." (let (mucs-ignore-version-incompatibilities) (require 'un-define)) (error))) - (condition-case nil (require 'idna) (file-error)) + (condition-case nil + (require 'idna) + (file-error) + (invalid-operation)) idna-program (executable-find idna-program) (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o") @@ -2012,7 +2016,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." ;; "dead" nato bitnet uucp "Regular expression that matches a valid FQDN." ;; see also: gnus-button-valid-fqdn-regexp - :version "22.1" + :version "25.1" :group 'message-headers :type 'regexp) @@ -2045,6 +2049,17 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (unless (fboundp 'mail-dont-reply-to) (defalias 'mail-dont-reply-to 'rmail-dont-reply-to)) +(eval-and-compile + (if (featurep 'emacs) + (progn + (defun message-kill-all-overlays () + (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))) + (defalias 'message-window-inside-pixel-edges + 'window-inside-pixel-edges)) + (defun message-kill-all-overlays () + (map-extents (lambda (extent ignore) (delete-extent extent)))) + (defalias 'message-window-inside-pixel-edges 'ignore))) + ;;; @@ -2264,7 +2279,7 @@ contains a valid encoded word. Decode again? " (unless cs-coding (setq cs-coding (mm-read-coding-system - (format "\ + (gnus-format-message "\ Decoded Subject \"%s\" contains an encoded word. The charset `%s' is unknown or invalid. Hit RET to replace non-decodable characters with \"%s\" or enter replacement @@ -3004,6 +3019,30 @@ See also `message-forbidden-properties'." (autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. +(defvar message-smileys '(":-)" ":)" + ":-(" ":(" + ";-)" ";)") + "A list of recognized smiley faces in `message-mode'.") + +(defun message--syntax-propertize (beg end) + "Syntax-propertize certain message text specially." + (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$")) + (smiley-regexp (regexp-opt message-smileys))) + (goto-char beg) + (while (search-forward-regexp citation-regexp + end 'noerror) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (add-text-properties start (1+ start) + `(syntax-table ,(string-to-syntax "<"))) + (add-text-properties end (min (1+ end) (point-max)) + `(syntax-table ,(string-to-syntax ">"))))) + (goto-char beg) + (while (search-forward-regexp smiley-regexp + end 'noerror) + (add-text-properties (match-beginning 0) (match-end 0) + `(syntax-table ,(string-to-syntax ".")))))) + ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent. @@ -3106,7 +3145,13 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." ;; multibyte is not necessary at all. -- zsh (mm-enable-multibyte)) (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation. - (mml-mode)) + (mml-mode) + ;; Syntactic fontification. Helps `show-paren-mode', + ;; `electric-pair-mode', and C-M-* navigation by syntactically + ;; excluding citations and other artifacts. + ;; + (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize) + (set (make-local-variable 'parse-sexp-ignore-comments) t)) (defun message-setup-fill-variables () "Setup message fill variables." @@ -4007,8 +4052,6 @@ This function uses `mail-citation-hook' if that is non-nil." "Cite function in the standard Message manner." (message-cite-original-1 nil)) -(defvar gnus-extract-address-components) - (autoload 'format-spec "format-spec") (autoload 'gnus-date-get-time "gnus-util") @@ -4030,7 +4073,7 @@ See `message-citation-line-format'." (unless from (setq from (mail-header-from message-reply-headers))) (let* ((data (condition-case () - (funcall (if (boundp gnus-extract-address-components) + (funcall (if (boundp 'gnus-extract-address-components) gnus-extract-address-components 'mail-extract-address-components) from) @@ -4083,7 +4126,7 @@ See `message-citation-line-format'." (setq fname lname lname newlname))))) ;; The following letters are not used in `format-time-string': (push ?E lst) (push "" lst) - (push ?F lst) (push fname lst) + (push ?F lst) (push (or fname name-or-net) lst) ;; We might want to use "" instead of "" later. (push ?J lst) (push "" lst) (push ?K lst) (push "" lst) @@ -4392,8 +4435,7 @@ conformance." to (cdar regions) regions (cdr regions)) (put-text-property from to 'invisible nil) - (message-overlay-put (message-make-overlay from to) - 'face 'highlight)) + (overlay-put (make-overlay from to) 'face 'highlight)) (unless (yes-or-no-p "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) @@ -4420,8 +4462,7 @@ conformance." control-1)) (not (get-text-property (point) 'untranslated-utf-8)))) - (message-overlay-put (message-make-overlay (point) (1+ (point))) - 'face 'highlight) + (overlay-put (make-overlay (point) (1+ (point))) 'face 'highlight) (setq found t)) (forward-char)) (when found @@ -4513,7 +4554,7 @@ This function could be useful in `message-setup-hook'." (dolist (bog (message-bogus-recipient-p addr)) (and bog (not (y-or-n-p - (format + (gnus-format-message "Address `%s'%s might be bogus. Continue? " bog ;; If the encoded version of the email address @@ -4950,6 +4991,11 @@ evaluates `message-send-mail-hook' just before sending a message. It is useful if your ISP requires the POP-before-SMTP authentication. See the Gnus manual for details." (run-hooks 'message-send-mail-hook) + ;; Change header-delimiter to be what smtpmail expects. + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n")) (smtpmail-send-it)) (defun message-send-mail-with-mailclient () @@ -6928,7 +6974,8 @@ want to get rid of this query permanently."))) (while (string-match "[ \t][ \t]+" recipients) (setq recipients (replace-match " " t t recipients))) ;; Remove addresses that match `mail-dont-reply-to-names'. - (let ((mail-dont-reply-to-names (message-dont-reply-to-names))) + (let* ((mail-dont-reply-to-names (message-dont-reply-to-names)) + (rmail-dont-reply-to-names mail-dont-reply-to-names)) (setq recipients (mail-dont-reply-to recipients))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") @@ -7208,7 +7255,7 @@ want to get rid of this query permanently.")) (defun message-is-yours-p () "Non-nil means current article is yours. -If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles +If you have added `cancel-messages' to `message-shoot-gnksa-feet', all articles are yours except those that have Cancel-Lock header not belonging to you. Instead of shooting GNKSA feet, you should modify `message-alternative-emails' regexp to match all of yours addresses." @@ -7892,14 +7939,6 @@ which specify the range to operate on." (goto-char (prog1 (mark t) (set-marker (mark-marker) (point))))) -(defalias 'message-make-overlay 'make-overlay) -(defalias 'message-delete-overlay 'delete-overlay) -(defalias 'message-overlay-put 'overlay-put) -(defun message-kill-all-overlays () - (if (featurep 'xemacs) - (map-extents (lambda (extent ignore) (delete-extent extent))) - (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))) - ;; Support for toolbar (defvar tool-bar-mode) @@ -8183,7 +8222,7 @@ The following arguments may contain lists of values." (defun message-flatten-list (list) "Return a new, flat list that contains all elements of LIST. -\(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) +\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) => (1 2 3 4 5 6 7)" (cond ((consp list) (apply 'append (mapcar 'message-flatten-list list))) @@ -8336,7 +8375,7 @@ From headers in the original article." (list message-hidden-headers) message-hidden-headers)) (inhibit-point-motion-hooks t) - (after-change-functions nil) + (inhibit-modification-hooks t) (end-of-headers (point-min))) (when regexps (save-excursion @@ -8491,11 +8530,11 @@ Header and body are separated by `mail-header-separator'." (when force (sit-for message-send-form-letter-delay)) (if (or force - (y-or-n-p (format "Send message to `%s'? " to))) + (y-or-n-p (gnus-format-message "Send message to `%s'? " to))) (progn (setq sent (1+ sent)) (message-send-and-exit)) - (message (format "Message to `%s' skipped." to)) + (message "Message to `%s' skipped." to) (setq skipped (1+ skipped))) (when (buffer-live-p buff) (kill-buffer buff)))) @@ -8554,14 +8593,44 @@ Used in `message-simplify-recipients'." ;;; multipart/related and HTML support. (defun message-make-html-message-with-image-files (files) + "Make a message containing the current dired-marked image files." (interactive (list (dired-get-marked-files nil current-prefix-arg))) (message-mail) (message-goto-body) (insert "<#part type=text/html>\n\n") (dolist (file files) (insert (format "\n\n" file))) + (message-toggle-image-thumbnails) (message-goto-to)) +(defun message-toggle-image-thumbnails () + "For any included image files, insert a thumbnail of that image." + (interactive) + (let ((overlays (overlays-in (point-min) (point-max))) + (displayed nil)) + (while overlays + (let ((overlay (car overlays))) + (when (overlay-get overlay 'put-image) + (delete-overlay overlay) + (setq displayed t))) + (setq overlays (cdr overlays))) + (unless displayed + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "