Mercurial > emacs
view lisp/url/url-mailto.el @ 72863:526dc1f36b09
(produce_image_glyph): Automatically crop wide images at
right window edge so we can draw the cursor on the same row to
avoid confusing redisplay by placing the cursor outside the visible
window area.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Thu, 14 Sep 2006 09:37:44 +0000 |
parents | e8a3fb527b77 |
children | e3694f1cb928 d04d8ccb3c41 |
line wrap: on
line source
;;; url-mail.el --- Mail Uniform Resource Locator retrieval code ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (require 'url-vars) (require 'url-parse) (require 'url-util) ;;;###autoload (defun url-mail (&rest args) (interactive "P") (if (fboundp 'message-mail) (apply 'message-mail args) (or (apply 'mail args) (error "Mail aborted")))) (defun url-mail-goto-field (field) (if (not field) (goto-char (point-max)) (let ((dest nil) (lim nil) (case-fold-search t)) (save-excursion (goto-char (point-min)) (if (re-search-forward (regexp-quote mail-header-separator) nil t) (setq lim (match-beginning 0))) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote field) ":") lim t) (setq dest (match-beginning 0)))) (if dest (progn (goto-char dest) (end-of-line)) (goto-char lim) (insert (capitalize field) ": ") (save-excursion (insert "\n")))))) ;;;###autoload (defun url-mailto (url) "Handle the mailto: URL syntax." (if (url-user url) ;; malformed mailto URL (mailto://wmperry@gnu.org) instead of ;; mailto:wmperry@gnu.org (url-set-filename url (concat (url-user url) "@" (url-filename url)))) (setq url (url-filename url)) (let (to args source-url subject func headers-start) (if (string-match (regexp-quote "?") url) (setq headers-start (match-end 0) to (url-unhex-string (substring url 0 (match-beginning 0))) args (url-parse-query-string (substring url headers-start nil) t t)) (setq to (url-unhex-string url))) (setq source-url (url-view-url t)) (if (and url-request-data (not (assoc "subject" args))) (setq args (cons (list "subject" (concat "Automatic submission from " url-package-name "/" url-package-version)) args))) (if (and source-url (not (assoc "x-url-from" args))) (setq args (cons (list "x-url-from" source-url) args))) (let ((tolist (assoc "to" args))) (if tolist (if (not (string= to "")) (setcdr tolist (list (concat to ", " (cadr tolist))))) (setq args (cons (list "to" to) args)))) (setq subject (cdr-safe (assoc "subject" args))) (if (eq url-mail-command 'compose-mail) (compose-mail nil nil nil 'new) (if (eq url-mail-command 'mail) (mail 'new) (funcall url-mail-command))) (while args (if (string= (caar args) "body") (progn (goto-char (point-max)) (insert (mapconcat #'(lambda (string) (replace-regexp-in-string "\r\n" "\n" string)) (cdar args) "\n"))) (url-mail-goto-field (caar args)) (setq func (intern-soft (concat "mail-" (caar args)))) (insert (mapconcat 'identity (cdar args) ", "))) (setq args (cdr args))) ;; (url-mail-goto-field "User-Agent") ;; (insert url-package-name "/" url-package-version " URL/" url-version) (if (not url-request-data) (progn (set-buffer-modified-p nil) (if subject (url-mail-goto-field nil) (url-mail-goto-field "subject"))) (if url-request-extra-headers (mapconcat (lambda (x) (url-mail-goto-field (car x)) (insert (cdr x))) url-request-extra-headers "")) (goto-char (point-max)) (insert url-request-data) ;; It seems Microsoft-ish to send without warning. ;; Fixme: presumably this should depend on a privacy setting. (if (y-or-n-p "Send this auto-generated mail? ") (let ((buffer (current-buffer))) (cond ((eq url-mail-command 'compose-mail) (funcall (get mail-user-agent 'sendfunc) nil)) ;; otherwise, we can't be sure ((fboundp 'message-send-and-exit) (message-send-and-exit)) (t (mail-send-and-exit nil))) (kill-buffer buffer)))) nil)) (provide 'url-mailto) ;; arch-tag: 7b7ad52e-8760-497b-9444-75fae14e34c5 ;;; url-mailto.el ends here