1;;; mew-draft.el --- Draft mode for Mew 2 3;; Author: Kazu Yamamoto <Kazu@Mew.org> 4;; Created: Oct 2, 1996 5 6;;; Code: 7 8(require 'mew) 9 10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11;;; 12;;; Draft info 13;;; 14 15(defvar mew-tinfo-list 16 '("header-keymap" "attach-keymap" "case" "encrypted-p" "privacy-err" 17 "encode-err" "privacy-type" "hdr-file" "field-del" "other-frame" 18 "preserved-header" "src-folder" "flowed" "use-flowed")) 19 20(mew-blinfo-defun 'mew-tinfo mew-tinfo-list) 21 22 23(defvar mew-draft-mode-syntax-table nil 24 "*Syntax table used while in Draft mode.") 25 26(unless mew-draft-mode-syntax-table 27 (setq mew-draft-mode-syntax-table (make-syntax-table text-mode-syntax-table)) 28 (modify-syntax-entry ?% "." mew-draft-mode-syntax-table)) 29 30;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31;;; 32;;; Draft mode 33;;; 34 35(defun mew-draft-set-local-variables () 36 (auto-save-mode mew-draft-mode-auto-save) 37 (make-local-variable 'completion-ignore-case) 38 (make-local-variable 'paragraph-start) 39 (setq paragraph-start (concat mew-eoh "\\|[ \t]*$\\|" page-delimiter)) 40 (make-local-variable 'paragraph-separate) 41 (setq paragraph-separate paragraph-start) 42 (make-local-variable 'mail-header-separator) 43 (setq mail-header-separator mew-header-separator) 44 (make-local-variable 'comment-start) 45 (setq comment-start mew-comment-start) 46 (make-local-variable 'comment-start-skip) 47 (setq comment-start-skip mew-comment-start-skip) 48 (add-hook 'after-change-functions 'mew-draft-dynamic-highlight nil 'local) 49 (if (boundp 'write-file-functions) 50 (add-hook 'write-file-functions 'mew-encode-make-backup nil 'local) 51 (add-hook 'local-write-file-hooks 'mew-encode-make-backup)) 52 (make-local-variable 'after-save-hook) 53 (when mew-require-final-newline 54 (make-local-variable 'require-final-newline) 55 (setq require-final-newline t)) 56 (when (featurep 'dnd) 57 (make-local-variable 'dnd-protocol-alist) 58 (setq dnd-protocol-alist 59 (append '(("^file:///" . mew-draft-dnd-handle-local-file) 60 ("^file://" . mew-draft-dnd-handle-file) 61 ("^file:" . mew-draft-dnd-handle-local-file)) 62 dnd-protocol-alist)))) 63 64(defun mew-draft-mode (&optional encrypted) 65 "A major mode for composing a MIME message. 66 67\\{mew-draft-mode-map}" 68 (interactive) 69 (setq major-mode 'mew-draft-mode) 70 (setq mode-line-buffer-identification (mew-mode-line-id)) 71 (mew-draft-set-local-variables) 72 (use-local-map mew-draft-mode-map) 73 (set-syntax-table mew-draft-mode-syntax-table) 74 (cd (expand-file-name mew-home)) 75 (mew-draft-setup-decoration) 76 (mew-ainfo-set-icon (file-name-nondirectory (buffer-file-name))) 77 (mew-tinfo-set-encrypted-p encrypted) 78 (mew-tinfo-set-privacy-err nil) 79 (mew-tinfo-set-privacy-type nil) 80 (mew-tinfo-set-use-flowed (mew-use-format-flowed (mew-tinfo-get-case))) 81 (mew-draft-mode-name) ;; must be after (mew-tinfo-set-encrypted-p encrypted) 82 (mew-run-mode-hooks 'text-mode-hook 'mew-draft-mode-hook) 83 ;; auto-fill-function is set by mew-draft-mode-hook 84 (when auto-fill-function 85 (make-local-variable 'auto-fill-function) 86 (setq auto-fill-function 'mew-draft-auto-fill)) 87 (setq buffer-undo-list nil)) 88 89(defun mew-draft-mode-name (&optional header) 90 (let ((case (mew-tinfo-get-case)) 91 pcdb sub) 92 (cond 93 ((or (mew-tinfo-get-privacy-type) (mew-tinfo-get-privacy-err)) 94 ;; If privacy err, don't display mew-protect-privacy-always-type etc. 95 (setq pcdb (mew-pcdb-by-service (mew-tinfo-get-privacy-type))) 96 (setq sub (mew-pcdb-mark pcdb))) 97 ((and (mew-tinfo-get-encrypted-p) (mew-protect-privacy-encrypted case)) 98 (setq pcdb (mew-pcdb-by-service (mew-protect-privacy-encrypted-type case))) 99 (setq sub (mew-pcdb-mark pcdb))) 100 ((mew-protect-privacy-always case) 101 (setq pcdb (mew-pcdb-by-service (mew-protect-privacy-always-type case))) 102 (setq sub (mew-pcdb-mark pcdb)))) 103 (setq mode-name (if header mew-mode-name-header mew-mode-name-draft)) 104 (if sub (setq mode-name (concat mode-name " " sub))) 105 (unless (mew-case-default-p (mew-tinfo-get-case)) 106 (setq mode-name (concat mode-name " " (mew-tinfo-get-case)))) 107 (if (mew-tinfo-get-use-flowed) 108 (setq mode-name (concat mode-name " F"))) 109 (force-mode-line-update))) 110 111;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 112;;; 113;;; Draft subfunctions 114;;; 115 116(defun mew-draft-dynamic-highlight (_beg _end _len) 117 (when (mew-in-header-p) 118 (save-match-data 119 (mew-highlight-header) 120 (when (mew-draft-p) 121 (mew-draft-header-keymap))))) 122 123(defun mew-draft-auto-fill () 124 (let ((ret1 (do-auto-fill)) ret2) 125 (when (mew-in-header-p) 126 (save-excursion 127 (beginning-of-line) 128 (while (not (or (looking-at "[^ \t\n]+:\\|[ \t]") (bobp))) 129 (setq ret2 t) 130 (insert "\t") 131 (forward-line -1) 132 (beginning-of-line)))) 133 (or ret1 ret2))) ;; if modifies, return t. 134 135(defun mew-draft-find-and-switch (draft-path &optional switch-func) 136 ;; switch-func = nil :: switch-to-buffer 137 ;; switch-func = t :: switch-to-buffer-other-window 138 (let* ((display-buffer-alist nil) 139 (same-window-buffer-names nil) 140 (same-window-regexps nil) 141 (draftname (mew-path-to-folder draft-path))) 142 (when (get-buffer draftname) 143 (with-current-buffer draftname 144 (clear-visited-file-modtime) 145 (set-buffer-modified-p nil) ;; just in case 146 (mew-delete-file buffer-auto-save-file-name) 147 (mew-remove-buffer draftname))) 148 (cond 149 (mew-use-other-frame-for-draft 150 (setq switch-func 'switch-to-buffer-other-frame)) 151 ((eq switch-func nil) 152 (setq switch-func 'switch-to-buffer)) 153 ((eq switch-func t) 154 (setq switch-func 'switch-to-buffer-other-window))) 155 (mew-frwlet mew-cs-m17n mew-cs-dummy 156 (funcall switch-func (mew-find-file-noselect draft-path))) 157 ;; draft buffer 158 (mew-set-buffer-cs mew-cs-m17n) 159 ;; copy config, first 160 (mew-tinfo-set-case mew-case) 161 (when mew-use-other-frame-for-draft 162 (mew-tinfo-set-other-frame t) 163 ;; to ensure to cite a message from summary frame. 164 (mew-remove-buffer (mew-buffer-message))) 165 (rename-buffer draftname))) 166 167(defun mew-draft-to-attach (draft) 168 "Converting draft to attach. E.g. +draft/1 -> +attach/1" 169 (mew-concat-folder mew-attach-folder (file-name-nondirectory draft))) 170 171(defun mew-attachdir (&optional draft) 172 (mew-expand-folder (mew-draft-to-attach (or draft (buffer-name))))) 173 174(defun mew-draft-header-insert-alist (halist) 175 "Insert field-body: and field-value. Return the value of 176the Body: field." 177 (let ((case-fold-search t) 178 key val ret) 179 (dolist (ent halist) 180 (setq key (mew-alist-get-key ent)) 181 (setq val (mew-alist-get-value ent)) 182 (unless (string-match ":$" key) 183 (setq key (concat key ":"))) 184 (if (string-match mew-body: key) 185 (setq ret val) 186 (mew-draft-header-insert key val))) 187 ret)) 188 189(defun mew-insert-address-list (field adrs del force-insert) 190 (let ((cnt 0) (beg (point)) med) 191 (dolist (adr adrs) 192 (unless (mew-is-my-address del adr) 193 (if (= cnt 0) 194 (insert adr) 195 (insert ", " adr)) 196 (setq del (cons (concat "^" (regexp-quote adr) "$") del)) 197 (setq cnt (1+ cnt)))) 198 (when (or force-insert (> cnt 0)) 199 (beginning-of-line) 200 (insert field " ") 201 (setq med (point)) 202 (end-of-line) 203 (insert "\n") 204 (mew-header-fold-region beg (point) med 'use-tab)) 205 del)) 206 207(defun mew-insert-address-list2 (field adrs) 208 (when adrs 209 (let ((beg (point)) med) 210 (insert field " ") 211 (setq med (point)) 212 (insert (car adrs)) 213 (setq adrs (cdr adrs)) 214 (dolist (adr adrs) 215 (insert ", " adr)) 216 (insert "\n") 217 (mew-header-fold-region beg (point) med 'use-tab)))) 218 219;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 220;;; 221;;; Draft header 222;;; 223 224(defun mew-draft-header (&optional subject nl to cc newsgroups in-reply-to references other-headers fromme) 225;; to -- string or list 226;; cc -- string or list 227;; nl -- one empty line under "----", which is necessary if 228;; attachment is prepared 229 (let ((del (unless fromme mew-regex-my-address-list)) ;; deleting list 230 case body) 231 (goto-char (point-min)) 232 (if newsgroups 233 (cond 234 ((stringp newsgroups) 235 (mew-draft-header-insert mew-newsgroups: newsgroups)) 236 ((listp newsgroups) 237 (mew-insert-address-list2 mew-newsgroups: newsgroups))) 238 ;; Insert To: first. 239 ;; All addresses inserted on To: are appended to del. 240 (cond 241 ((null to) (mew-draft-header-insert mew-to: "")) 242 ((stringp to) ;; To: specified from the mini-buffer. 243 ;; do not check to is mine. Cc: is also string 244 ;; We believe that user never specifies the same address of To: to Cc:. 245 (mew-draft-header-insert mew-to: to)) 246 ;; To: collected by reply 247 ((listp to) 248 (setq del (mew-insert-address-list mew-to: to del t)))) 249 (cond 250 ((null cc) ()) ;; do nothing 251 ((stringp cc) ;; Cc: specified from the mini-buffer. 252 (mew-draft-header-insert mew-cc: cc)) 253 ((listp cc) ;; Cc: collected by reply. 254 (mew-insert-address-list mew-cc: cc del nil)))) 255 (if mew-case-guess-when-prepared 256 (mew-draft-set-case-by-guess)) 257 (setq case (mew-tinfo-get-case)) 258 (unless newsgroups 259 (mew-draft-header-insert mew-cc: (mew-cc case))) 260 (mew-draft-header-insert mew-subj: (or subject "")) 261 (mew-draft-header-insert mew-from: (mew-from case)) 262 (mew-draft-header-insert mew-fcc: (mew-fcc case)) 263 (unless newsgroups 264 (mew-draft-header-insert mew-bcc: (mew-bcc case)) 265 (mew-draft-header-insert mew-dcc: (mew-dcc case))) 266 (mew-draft-header-insert mew-reply-to: (mew-reply-to case)) 267 (unless newsgroups 268 (mew-draft-header-insert mew-in-reply-to: in-reply-to)) 269 (mew-draft-header-insert mew-references: references) 270 (mew-draft-header-insert-xface) 271 (mew-draft-header-insert mew-organization: (mew-organization case)) 272 (setq body (mew-draft-header-insert-alist other-headers)) 273 ;; Deleting fields defined in mew-header-alist to replace them. 274 (mew-header-delete-lines (mapcar 'mew-alist-get-key (mew-header-alist case))) 275 (mew-header-goto-end) 276 (mew-draft-header-insert-alist (mew-header-alist case)) 277 ;; X-Mailer: must be the last 278 (if (mew-use-x-mailer case) 279 (mew-draft-header-insert mew-x-mailer: mew-x-mailer)) 280 ;; (mew-header-set "\n") is enough. But highlighting delayed. 281 (mew-header-prepared) 282 ;; on the body 283 (if nl (insert "\n")) 284 (if body (save-excursion (insert body))) 285 ;; move the cursor after "To: " 286 (goto-char (point-min)) 287 (search-forward ": " nil t))) 288 289(defun mew-draft-header-insert-xface () 290 (if (and mew-x-face-file 291 (file-exists-p (expand-file-name mew-x-face-file))) 292 (let (xface) 293 (with-temp-buffer 294 (mew-insert-file-contents (expand-file-name mew-x-face-file)) 295 (setq xface (mew-buffer-substring (point-min) 296 (max (buffer-size) 1)))) 297 (mew-draft-header-insert mew-x-face: xface)))) 298 299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 300;;; 301;;; Citation 302;;; 303 304(defun mew-draft-auto-set-input-method () 305 (if (and (fboundp 'activate-input-method) 306 mew-charset-input-method-alist) 307 (let* ((charset (mew-charset-guess-region 308 (mew-header-end) (or (mew-attach-begin) (point-max)))) 309 (method (mew-charset-to-input-method charset))) 310 (when (stringp method) 311 (activate-input-method method) 312 (message "Set input method to %s" method))))) 313 314(defun mew-draft-yank (&optional arg force) 315 "Copy and paste a part of message from Message mode WITHOUT 316citation prefix and label. 3171. Roughly speaking, it copies the body in Message mode. For example, 318 if text/plain is displayed, the entire Message mode is copied. 319 If message/rfc822 is displayed, the body without the header is copied. 3202. If called with '\\[universal-argument]', the header is also copied if exists. 3213. If an Emacs mark exists, the target is the region between the mark and 322 the cursor." 323;; MUST take care of C-x C-x 324;; MUST be able to cancel by C-x u 325 (interactive "P") 326 (if (and (not force) (or (mew-in-header-p) (mew-in-attach-p))) 327 (message "Cannot cite a message here") 328 (let (cite beg end) 329 (save-excursion 330 (cond 331 ((get-buffer (mew-buffer-message)) 332 (set-buffer (mew-buffer-message))) 333 ((get-buffer mew-message-last-buffer) 334 (set-buffer mew-message-last-buffer))) 335 (set-buffer (mew-buffer-message)) 336 (save-restriction 337 (widen) 338 (let ((mark-active t)) 339 (cond 340 (arg 341 (setq beg (point-min) end (point-max))) 342 ((and (not mew-cite-ignore-region) 343 (mew-mark) 344 (/= (point) (mew-mark)) 345 (not (and mew-cite-ignore-mouse-region 346 (mew-mouse-region-p)))) 347 (setq beg (region-beginning) end (region-end))) 348 ((mew-msghdr-p) 349 ;; header exists in Message mode 350 (mew-header-goto-body) 351 (setq beg (point) end (point-max))) 352 (t 353 (setq beg (point-min) end (point-max))))) 354 (setq cite (mew-buffer-substring beg end)))) 355 (mew-push-mark) 356 (insert cite) 357 (mew-draft-auto-set-input-method)))) 358 359(defvar mew-message-citation-buffer nil 360 "This value is used by mew-gnus.el to specify a buffer from where 361you can cite.") 362 363(defvar mew-message-citation-frame-id nil) 364 365(defun mew-draft-cite (&optional arg force) 366 "Copy and paste a part of message from Message mode with 367citation prefix and label. 3681. Roughly speaking, it copies the body in Message mode. For example, 369 if text/plain is displayed, the entire Message mode is copied. 370 If message/rfc822 is displayed, the body without the header is copied. 3712. If called with '\\[universal-argument]', the header is also copied if exists. 3723. If an Emacs mark exists, the target is the region between the mark and 373 the cursor." 374;; MUST take care of C-x C-x 375;; MUST be able to cancel by C-x u 376 (interactive "P") 377 (if (and (not force) (or (mew-in-header-p) (mew-in-attach-p))) 378 (message "Cannot cite a message here") 379 (let* ((nonmewbuf mew-message-citation-buffer) ;; may be buffer local 380 (fid (or mew-message-citation-frame-id (mew-frame-id))) 381 (fld (mew-current-get-fld fid)) 382 (msg (mew-current-get-msg fid)) 383 (msg-buf (mew-buffer-message)) 384 cite beg end tbuf irt-msgid) 385 (unless (get-buffer msg-buf) 386 (setq msg-buf mew-message-last-buffer)) 387 (save-excursion 388 ;; 389 ;; extract the body without header 390 ;; 391 (setq tbuf (or nonmewbuf msg-buf)) 392 (if (get-buffer tbuf) 393 (set-buffer tbuf) 394 (error "No buffer to be cited")) 395 (save-restriction 396 ;; first prepare "cite" 397 (widen) 398 (let ((mark-active t)) 399 (cond 400 ;; arg will be effect in mew-cite-original 401 ((and (not mew-cite-ignore-region) 402 (mew-mark) 403 (/= (point) (mew-mark)) 404 (not (and mew-cite-ignore-mouse-region 405 (mew-mouse-region-p)))) 406 (setq beg (region-beginning) end (region-end))) 407 ((mew-msghdr-p) 408 ;; header exists in Message mode. Skip the header 409 ;; because we will concatenate it to cite later. 410 (mew-header-goto-body) 411 (setq beg (point) end (point-max))) 412 (t 413 (setq beg (point-min) end (point-max))))) 414 (setq cite (mew-buffer-substring beg end))) 415 ;; 416 ;; concat the header 417 ;; 418 (setq tbuf (or nonmewbuf 419 (save-excursion 420 (when (get-buffer msg-buf) 421 (set-buffer msg-buf) 422 (if (mew-msghdr-p) (current-buffer)))) 423 ;; header exists only in cache if multipart 424 (mew-cache-hit fld msg))) 425 (if (get-buffer tbuf) 426 (set-buffer tbuf) 427 (error "No buffer to be cited")) 428 (save-restriction 429 (widen) 430 (mew-header-goto-end) 431 (setq cite (concat (mew-buffer-substring (point-min) (point)) 432 "\n" cite)) 433 (setq irt-msgid (mew-idstr-get-first-id 434 (mew-header-get-value mew-message-id:))))) 435 ;; 436 ;; Draft mode, insert the header and the body. 437 ;; 438 439 ;; Append message-id to In-Reply-To: 440 (if (and irt-msgid (mew-msghdr-p)) 441 (save-excursion 442 (let* ((mew-references-max-count nil) 443 (irt (mew-header-get-value mew-in-reply-to:)) 444 (irtl (mew-idstr-to-id-list irt 'rev)) 445 irtstr) 446 (mew-addq irtl irt-msgid) 447 (setq irtl (nreverse irtl)) 448 (setq irtstr (mew-id-list-to-idstr irtl)) 449 (mew-header-delete-lines (list mew-in-reply-to:)) 450 (unless irt (goto-char (mew-header-end))) 451 (mew-draft-header-insert mew-in-reply-to: irtstr)))) 452 (save-restriction 453 ;; this gets complicated due to supercite, please do not care 454 (narrow-to-region (point) (point)) ;; for (goto-char (point-min)) 455 (insert cite) 456 ;; not for C-x C-x. Do not use mew-push-mark. 457 (push-mark (point) t t) 458 (goto-char (point-min))) 459 (cond 460 (mew-cite-hook 461 (run-hooks 'mew-cite-hook)) 462 (t (mew-cite-original arg))) 463 ;; (mark-marker) indicates the point after label. 464 ;; Should we include the label too? 465 (or force (mew-highlight-body-region (mark-marker) (point) 'draft)) 466 (mew-draft-auto-set-input-method)))) 467 468(defconst mew-cite-default-prefix "> ") 469 470(defun mew-cite-original (&optional arg) 471 (if (< (marker-position (mark-marker)) (point)) 472 (exchange-point-and-mark)) 473 (let ((beg (point)) (end (marker-position (mark-marker))) 474 label prefix) 475 (save-restriction 476 (narrow-to-region beg end) 477 (condition-case nil 478 (setq label (funcall mew-cite-strings-function)) 479 (error 480 (error "Syntax of mew-cite-format was changed. Read explanation of mew-cite-fields"))) 481 (cond 482 (mew-cite-prefix-function 483 (setq prefix (funcall mew-cite-prefix-function))) 484 (mew-cite-prefix 485 (setq prefix mew-cite-prefix)) 486 (t 487 (setq prefix mew-cite-default-prefix))) 488 (if (and mew-cite-prefix-confirmp (not mew-use-format-flowed)) 489 (let ((ask (read-string 490 (format "Prefix (\"%s\"): " prefix) ""))) 491 (if (not (string= ask "")) (setq prefix ask)))) 492 ;; C-u C-c C-y cites body with header. 493 (if (eq arg nil) 494 ;; header has been already cited. So, delete it. 495 (delete-region beg (progn (mew-header-goto-body) (point)))) 496 (insert label) 497 (mew-push-mark) 498 (if (or mew-cite-prefix-function mew-cite-prefix) 499 (progn 500 (and (bolp) (insert prefix)) 501 (while (= 0 (forward-line)) 502 (or (= (point) (point-max)) 503 (insert prefix)))) 504 (if (bolp) (mew-cite-format-flowed)) 505 (while (= 0 (forward-line)) 506 (unless (= (point) (point-max)) 507 (mew-cite-format-flowed))))))) 508 509(defun mew-cite-format-flowed () 510 (insert mew-flowed-quoted) 511 (unless (char-equal (char-after) mew-flowed-quoted) 512 (insert mew-flowed-stuffed))) 513 514(defun mew-cite-get-value (field) 515 (let ((value (mew-header-get-value field)) 516 repl func) 517 (when (and (string= mew-from: field) value 518 (setq func (mew-addrbook-func mew-addrbook-for-cite-label))) 519 (setq repl (funcall func (mew-addrstr-parse-address value))) 520 (if repl (setq value repl))) 521 (or value ""))) 522 523(defun mew-cite-strings () 524 "A function to create cite labels according to 525'mew-cite-format' and 'mew-cite-fields'." 526 (if (null mew-cite-fields) 527 "" 528 (let* ((vals (mapcar 'mew-cite-get-value mew-cite-fields)) 529 (label (apply 'format mew-cite-format vals)) 530 (ellipses (if (stringp mew-draft-cite-ellipses) 531 mew-draft-cite-ellipses "")) 532 beg eol) 533 (if (not (or (eq mew-draft-cite-fill-mode 'truncate) 534 (eq mew-draft-cite-fill-mode 'wrap))) 535 label 536 (with-temp-buffer 537 (let ((fill-column 538 (or mew-draft-cite-label-fill-column fill-column))) 539 (insert label) 540 (goto-char (point-min)) 541 (while (not (eobp)) 542 (cond 543 ((eq mew-draft-cite-fill-mode 'truncate) 544 (end-of-line) 545 (if (>= fill-column (current-column)) 546 () 547 (setq eol (point)) 548 (insert ellipses) 549 (goto-char eol) 550 (while (< fill-column (current-column)) 551 (delete-char -1)))) 552 ((eq mew-draft-cite-fill-mode 'wrap) 553 (setq beg (point)) 554 (end-of-line) 555 (if (= (current-column) 0) 556 () 557 (fill-region beg (point))))) 558 (forward-line))) 559 (buffer-string)))))) 560 561(defun mew-cite-prefix-username () 562 "A good candidate for mew-cite-prefix-function. 563The citation style is 'from_address> ', e.g. 'kazu> '" 564 (let* ((from (mew-header-parse-address mew-from:)) 565 (user (mew-addrstr-extract-user from)) 566 (func (mew-addrbook-func mew-addrbook-for-cite-prefix)) 567 nickname prefix) 568 (if func (setq nickname (funcall func from))) 569 (setq prefix (or nickname user)) 570 (if mew-ask-cite-prefix 571 (setq prefix (read-string "Citation prefix: " prefix))) 572 (concat prefix mew-cite-default-prefix))) 573 574;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 575;;; 576;;; format=flowed 577;;; 578 579(defun mew-draft-encode-flowed (&optional arg) 580 "Manually encode the body with format=flowed. 581If called with '\\[universal-argument]', toggle whether or not 582format=flowed is used on composing." 583 (interactive "P") 584 (if arg 585 (progn 586 (mew-tinfo-set-use-flowed (not (mew-tinfo-get-use-flowed))) 587 (mew-draft-mode-name)) 588 (save-excursion 589 (goto-char (mew-header-end)) 590 (forward-line) 591 (if (mew-tinfo-get-flowed) 592 (progn 593 (mew-decode-flowed (point) (point-max) 594 (if (string= (mew-tinfo-get-flowed) "yes") t nil)) 595 (mew-tinfo-set-flowed nil)) 596 (let* ((charset (mew-charset-guess-region (point) (point-max))) 597 (flowed-delsp (mew-encode-flowed (point) (point-max) charset)) 598 flowed delsp) 599 (mew-set '(flowed delsp) flowed-delsp) 600 (if (not flowed) 601 (message "No line folded") 602 (mew-tinfo-set-flowed (if delsp "yes" "no"))))) 603 (mew-draft-rehighlight) 604 (setq buffer-undo-list nil)))) 605 606(defun mew-draft-use-format-flowed (&optional arg) 607 "Toggle the use of format=flowed for the current draft. 608If called with '\\[universal-argument]', enable format=flowed if the argument 609is positive. You can use `mew-draft-use-format-flowed-hooks' to 610enable interesting minor modes according to whether the message is 611flowed or not. Here is an example: 612 613\(add-hook 'mew-draft-use-format-flowed-hooks 614 '(lambda() 615 (if mew-use-format-flowed 616 (progn 617 (auto-fill-mode 0) 618 (visual-line-mode 1)) 619 (progn 620 (auto-fill-mode 1) 621 (visual-line-mode 0))) 622 ))" 623 (interactive "P") 624 (set (make-local-variable 'mew-use-format-flowed) 625 (if (null arg) 626 (not (mew-use-format-flowed)) 627 (> (prefix-numeric-value arg) 0))) 628 (mew-tinfo-set-use-flowed mew-use-format-flowed) 629 (mew-draft-mode-name) ;; Display "F" if Flowed 630 (run-hooks 'mew-draft-use-format-flowed-hooks)) 631 632;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 633;;; 634;;; Misc 635;;; 636 637(defun mew-draft-save-buffer () 638 "Save this draft." 639 (interactive) 640 (let ((after-change-functions nil)) 641 (save-excursion 642 (mew-header-clear 'keep-read-only) 643 (insert-before-markers "\n") ;; for mew-summary-reply 644 (save-buffer) 645 (delete-region (1- (point)) (point)) 646 (mew-header-prepared) 647 (set-buffer-modified-p nil)))) 648 649(defun mew-draft-kill () 650 "Kill this draft." 651 (interactive) 652 (if (not (y-or-n-p "Kill draft message? ")) 653 (message "Draft was not killed") 654 (let* ((attachdir (mew-attachdir)) ;; attachdir must be here 655 (draft (buffer-file-name)) 656 (buf (current-buffer)) 657 (mdi (concat draft mew-draft-info-suffix))) 658 (mew-elet 659 (mew-overlay-delete-buffer)) 660 (save-buffer) 661 (mew-delete-file draft) 662 (mew-delete-file mdi) 663 (if (and (mew-tinfo-get-other-frame) (> (length (frame-list)) 1)) 664 (delete-frame) 665 (mew-current-get-window-config)) 666 (mew-delete-directory-recursively attachdir) 667 (mew-remove-buffer buf) 668 (message "Draft was killed")))) 669 670(defun mew-draft-insert-signature (&optional arg) 671 "Insert the signature file specified by mew-signature-file. 672If attachments exist and mew-signature-as-lastpart is *non-nil*, 673the file is attached to the last part. Otherwise, the file is 674inserted into the body. If mew-signature-insert-last is *non-nil*, 675the file is inserted to the end of the body. Otherwise, inserted 676the cursor position. If executed with '\\[universal-argument]', 677you can set the case." 678 (interactive "P") 679 (let (case sigfile) 680 (cond 681 ((stringp arg) 682 (setq case arg)) 683 (arg 684 (setq case (mew-input-case (mew-tinfo-get-case) "Signature"))) 685 (t 686 (setq case (mew-tinfo-get-case)))) 687 (setq sigfile (expand-file-name (mew-signature-file case))) 688 (if (not (file-exists-p sigfile)) 689 (message "No signature file %s" sigfile) 690 (if (and (mew-attach-p) mew-signature-as-lastpart) 691 (progn 692 (goto-char (point-max)) 693 (forward-line -2) 694 (mew-attach-forward) 695 (mew-attach-copy sigfile "Signature") 696 (let* ((nums (mew-syntax-nums)) 697 (syntax (mew-syntax-get-entry mew-encode-syntax nums))) 698 (mew-syntax-set-cdp syntax nil) 699 (mew-syntax-set-cd syntax mew-signature-description)) 700 (mew-encode-syntax-print mew-encode-syntax)) 701 (when mew-signature-insert-last 702 (if (null (mew-attach-p)) 703 (goto-char (point-max)) 704 (goto-char (1- (mew-attach-begin)))) 705 (end-of-line) 706 (unless (bolp) (insert "\n"))) 707 (mew-insert-file-contents sigfile))))) 708 709;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 710;;; 711;;; Re-highlight 712;;; 713 714(defun mew-draft-rehighlight-body () 715 (save-excursion 716 (let ((beg (progn (goto-char (mew-header-end)) (forward-line) (point))) 717 (end (or (mew-attach-begin) (point-max)))) 718 (mew-highlight-body-region beg end 'draft 'rehighlight)))) 719 720(defun mew-draft-rehighlight () 721 "Highlight header and body again." 722 (interactive) 723 (let ((mod (buffer-modified-p))) 724 (mew-highlight-header) 725 (mew-draft-header-keymap) 726 (mew-draft-rehighlight-body) 727 (set-buffer-modified-p mod))) 728 729;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 730;;; 731;;; Privacy 732;;; 733 734(defun mew-draft-toggle-privacy-always () 735 "Toggle whether or not all drafts are protected." 736 (interactive) 737 (setq mew-protect-privacy-always (not mew-protect-privacy-always)) 738 (message "Set mew-protect-privacy-always to %s" 739 mew-protect-privacy-always) 740 (mew-draft-mode-name)) 741 742(defun mew-draft-toggle-privacy-encrypted () 743 "Toggle whether or not drafts replying to encrypted messages are 744protected." 745 (interactive) 746 (setq mew-protect-privacy-encrypted (not mew-protect-privacy-encrypted)) 747 (message "Set mew-protect-privacy-encrypted to %s" 748 mew-protect-privacy-encrypted) 749 (mew-draft-mode-name)) 750 751(defun mew-draft-set-privacy-type () 752 "\\<mew-draft-mode-map> 753Set privacy service which will be effective when \\[mew-draft-make-message]." 754 (interactive) 755 (let* ((services (mew-pcdb-services)) 756 (alist (mapcar (lambda (x) (cons (symbol-name x) x)) services)) 757 str) 758 (setq str (completing-read "Input privacy services: " alist nil t)) 759 (when (stringp str) 760 (mew-tinfo-set-privacy-type (cdr (assoc str alist))) 761 (mew-tinfo-set-privacy-err nil))) 762 (mew-draft-mode-name)) 763 764;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 765;;; 766;;; Sending and Queuing 767;;; 768 769(defun mew-draft-make-message (&optional privacy signer) 770 "Compose a MIME message then put it into a queue folder." 771 (interactive) 772 (if (string= mode-name "Edit") 773 (mew-edit-make) 774 (if (and (mew-called-interactively-p) ;; prevent the loop 775 mew-use-old-pgp 776 mew-protect-privacy-with-old-pgp-signature) 777 (mew-pgp-sign-message) 778 (mew-draft-process-message 'queue privacy signer)))) 779 780(defun mew-draft-send-message () 781 "Compose a MIME message then send it." 782 (interactive) 783 (if (string= mode-name "Edit") 784 (mew-edit-make) 785 (if (and (mew-called-interactively-p) ;; just in case 786 mew-use-old-pgp 787 mew-protect-privacy-with-old-pgp-signature) 788 (mew-pgp-sign-message) 789 (mew-draft-process-message 'send)))) 790 791(defun mew-draft-process-message (action &optional privacy signer) 792 (if (and (boundp 'visual-line-mode) visual-line-mode) (visual-line-mode -1)) 793 (run-hooks 'mew-make-message-hook) 794 (let* ((case (or (mew-tinfo-get-case) mew-case-default)) 795 (old-case case) 796 guessed-case) 797 (when mew-case-guess-when-composed 798 (setq guessed-case (mew-draft-get-case-by-guess)) 799 (when guessed-case 800 (if mew-case-guess-addition 801 (setq case (mew-draft-add-case case guessed-case)) 802 (setq case guessed-case)))) 803 (unless (string= old-case case) 804 (mew-tinfo-set-case case) 805 (mew-draft-mode-name (mew-tinfo-get-hdr-file)) 806 (mew-draft-replace-fields old-case) 807 (when (eq action 'send) 808 (mew-highlight-header) 809 (unless (mew-tinfo-get-hdr-file) (mew-draft-header-keymap))) 810 (save-buffer)) 811 (if (mew-header-existp mew-newsgroups:) 812 (mew-draft-nntp-process-message case action privacy signer) 813 (mew-draft-smtp-process-message case action privacy signer)))) 814 815(defun mew-draft-resent-p (end) 816 (let ((case-fold-search t)) 817 (save-excursion 818 (re-search-forward mew-resent-regex end t)))) 819 820(defun mew-draft-smtp-process-message (case action &optional privacy signer) 821 (run-hooks 'mew-send-hook) 822 (let* ((buf (current-buffer)) 823 (pnm (mew-smtp-info-name case)) 824 (queue (mew-queue-folder case)) 825 resentp fcc sendit msg err) 826 (if (get-process pnm) 827 (message "Another message is being sent. Try later") 828 (mew-draft-remove-invalid-fields) 829 ;; Check resentp 830 (save-excursion 831 (goto-char (point-min)) 832 (setq resentp (mew-draft-resent-p (mew-header-end)))) 833 ;; Ask Subject: before the query of "Really send". 834 ;; Typing C-g here gets back to the draft. 835 (mew-encode-ask-subject) 836 (setq fcc (mew-encode-ask-fcc resentp)) 837 (if (eq action 'queue) 838 (setq sendit t) 839 (if mew-ask-send 840 (setq sendit (y-or-n-p "Really send this message? ")) 841 (setq sendit t))) 842 (when sendit 843 ;; password should be asked in Summary mode. 844 (if (and (mew-tinfo-get-other-frame) (> (length (frame-list)) 1)) 845 (delete-frame) 846 (mew-current-get-window-config) 847 (delete-windows-on buf)) ;; just in case 848 (save-excursion 849 (save-window-excursion 850 (set-buffer buf) 851 (if (mew-smtp-encode pnm case resentp fcc privacy signer) 852 (let ((mdi (concat (buffer-file-name) mew-draft-info-suffix))) 853 (mew-delete-file mdi) 854 (setq msg (mew-smtp-queue case "from Draft mode")) 855 (mew-remove-buffer buf) 856 (if (eq action 'send) 857 (mew-smtp-send-message case queue (list msg)))) 858 (setq err t)))) 859 ;; now +queue/1 exists 860 (if err 861 (progn 862 (mew-current-set-window-config) 863 (switch-to-buffer buf) 864 (delete-other-windows)) 865 (if (and (eq action 'queue) mew-visit-queue-after-sending) 866 (mew-summary-visit-folder queue)) 867 (run-hooks 'mew-real-send-hook)))))) 868 869(defun mew-draft-nntp-process-message (case action &optional privacy signer) 870 (run-hooks 'mew-post-hook) 871 (let* ((buf (current-buffer)) 872 (pnm (mew-nntp2-info-name case)) 873 (postq (mew-postq-folder case)) 874 fcc sendit msg err) 875 (if (get-process pnm) 876 (message "Another message is being posted. Try later") 877 (mew-draft-remove-invalid-fields) 878 ;; Ask Subject: before the query of "Really post". 879 ;; Typing C-g here gets back to the draft. 880 (mew-encode-ask-subject) 881 (setq fcc (mew-encode-ask-fcc nil)) 882 (if (eq action 'queue) 883 (setq sendit t) 884 (if mew-ask-post 885 (setq sendit (y-or-n-p "Really post this message? ")) 886 (setq sendit t))) 887 (when sendit 888 ;; password should be asked in Summary mode. 889 (if (and (mew-tinfo-get-other-frame) (> (length (frame-list)) 1)) 890 (delete-frame) 891 (mew-current-get-window-config) 892 (delete-windows-on buf)) ;; just in case 893 (save-excursion 894 (save-window-excursion 895 (set-buffer buf) 896 (if (mew-nntp2-encode pnm case fcc privacy signer) 897 (let ((mdi (concat (buffer-file-name) mew-draft-info-suffix))) 898 (mew-delete-file mdi) 899 (setq msg (mew-nntp2-queue case "from Draft mode")) 900 (mew-remove-buffer buf) 901 (if (eq action 'send) 902 (mew-nntp2-send-message case postq (list msg)))) 903 (setq err t)))) 904 (if err 905 (progn 906 (mew-current-set-window-config) 907 (switch-to-buffer buf) 908 (delete-other-windows)) 909 (if (and (eq action 'queue) mew-visit-queue-after-sending) 910 (mew-summary-visit-folder postq)) 911 (run-hooks 'mew-real-post-hook)))))) 912 913(defun mew-draft-remove-invalid-fields () 914 (when (mew-header-end) 915 (save-excursion 916 (save-restriction 917 (goto-char (mew-header-end)) 918 (if (not (bolp)) (insert "\n")) 919 (narrow-to-region (point-min) (mew-header-end)) 920 (let (beg med str) 921 (mew-elet 922 ;; removing null lines 923 (goto-char (point-min)) 924 (while (and (re-search-forward "^$" nil t) 925 (not (eobp))) 926 (delete-char 1)) 927 ;; removing fields which do not have value. 928 (goto-char (point-min)) 929 (while (not (eobp)) 930 (if (not (looking-at mew-keyval)) 931 (forward-line) 932 (setq beg (match-beginning 0)) 933 (setq med (match-end 0)) 934 (forward-line) 935 (mew-header-goto-next) 936 (setq str (mew-buffer-substring med (1- (point)))) 937 ;; str may consists of multiple lines 938 ;; So, "$" does not work. We need to use "[^ ]". 939 (unless (string-match "[^ \t\n]" str) 940 (delete-region beg (point))))))))))) 941 942;; backward-compatibility 943(defalias 'mew-draft-send-letter 'mew-draft-send-message) 944 945;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 946;;; 947;;; Privacy 948;;; 949 950(defvar mew-draft-privacy-method-alist '(("pgp" . pgp) ("smime" . smime))) 951 952(defun mew-draft-set-privacy-method () 953 "Set mew-draft-privacy-method. 'pgp or 'smime." 954 (interactive) 955 (let ((method (completing-read "Privacy method: " mew-draft-privacy-method-alist nil t))) 956 (setq mew-draft-privacy-method 957 (cdr (assoc method mew-draft-privacy-method-alist))))) 958 959(defmacro mew-draft-privacy-switch (&rest form) 960 `(let ((method (mew-draft-privacy-method (mew-tinfo-get-case)))) 961 (cond 962 ,@(mapcar 963 (lambda (x) 964 (if (eq (car x) t) 965 x 966 `((eq method ',(car x)) ,(car (cdr x))))) 967 form) 968 (t (message "'%s' is not supported" method))))) 969 970(defun mew-draft-sign-message (&optional arg) 971 "Sign the entire draft. Input your passphrase." 972 (interactive "P") 973 (mew-draft-privacy-switch 974 (pgp (mew-pgp-sign-message arg)) 975 (smime (mew-smime-sign-message arg)))) 976 977(defun mew-draft-encrypt-message () 978 "Encrypt the entire draft with PGP." 979 (interactive) 980 (mew-draft-privacy-switch 981 (pgp (mew-pgp-encrypt-message)) 982 (smime (mew-smime-encrypt-message)))) 983 984(defun mew-draft-sign-encrypt-message (&optional arg) 985 "Sign then encrypt the entire draft. Input your passphrase." 986 (interactive "P") 987 (mew-draft-privacy-switch 988 (pgp (mew-pgp-sign-encrypt-message arg)) 989 (smime (mew-smime-sign-encrypt-message arg)))) 990 991(defun mew-draft-encrypt-sign-message (&optional arg) 992 "Encrypt then sign the entire draft. Input your passphrase." 993 (interactive "P") 994 (mew-draft-privacy-switch 995 (pgp (mew-pgp-encrypt-sign-message arg)) 996 (smime (mew-smime-encrypt-sign-message arg)))) 997 998(provide 'mew-draft) 999 1000;;; Copyright Notice: 1001 1002;; Copyright (C) 1996-2015 Mew developing team. 1003;; All rights reserved. 1004 1005;; Redistribution and use in source and binary forms, with or without 1006;; modification, are permitted provided that the following conditions 1007;; are met: 1008;; 1009;; 1. Redistributions of source code must retain the above copyright 1010;; notice, this list of conditions and the following disclaimer. 1011;; 2. Redistributions in binary form must reproduce the above copyright 1012;; notice, this list of conditions and the following disclaimer in the 1013;; documentation and/or other materials provided with the distribution. 1014;; 3. Neither the name of the team nor the names of its contributors 1015;; may be used to endorse or promote products derived from this software 1016;; without specific prior written permission. 1017;; 1018;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND 1019;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 1020;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 1021;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE 1022;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 1023;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 1024;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 1025;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 1026;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 1027;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 1028;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 1029 1030;;; mew-draft.el ends here 1031 1032;; Local Variables: 1033;; no-native-compile: t 1034;; End: 1035