~ubuntu-branches/ubuntu/lucid/mew-beta/lucid

;;; mew-complete.el --- Completion magic for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>

;; Created: May 30, 1997

;;; Code:

(require 'mew)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Low level functions

;;;

(defun mew-draft-on-field-p ()

  (if (bolp)

      (if (bobp)

	  t

	(save-excursion

	  (forward-line -1)

	  (if (looking-at ".*,[ \t]?$") nil t)))

    (let ((pos (point)))

      (save-excursion

	(beginning-of-line)

	(if (looking-at mew-lwsp)

	    nil

	  (if (search-forward ":" pos t) nil t))))))

(defun mew-draft-on-value-p (switch)

  (save-excursion

    (beginning-of-line)

    (while (and (< (point-min) (point))	(looking-at mew-lwsp))

      (forward-line -1))

    (if (looking-at "\\([^:]*:\\)")

	(mew-field-get-func (match-string 1) switch)

      nil))) ;; what a case reaches here?

;;

;; Window management for completion candidates

;;

(defvar mew-complete-candidates nil)

(defun mew-complete-window-delete (&optional force)

  (when (mew-ainfo-get-win-cfg)

    ;; (mew-ainfo-get-win-cfg) remains when the last completion

    ;; finished with multiple candidates.

    ;; (e.g. foo<RET> when foo and foobar are displayed.)

    ;; In this case, this function is called in another

    ;; completion thread but setting window configuration is not

    ;; desired. If we set window configuration with the old

    ;; (mew-ainfo-get-win-cfg), the cursor jumps to mini buffer.

    ;; This was a stupid bug of Mew. So, let's see if the complete

    ;; buffer is displayed or not.

    (if (or force (get-buffer-window mew-buffer-completions))

	(set-window-configuration (mew-ainfo-get-win-cfg)))

    (mew-ainfo-set-win-cfg nil))

  (mew-remove-buffer mew-buffer-completions)

  (setq mew-complete-candidates nil))

(defun mew-complete-insert-folder-function (choice buffer mini-p base-size)

  (let ((start (mew-minibuf-point-min))

	(proto (substring choice 0 1))

	(pos (point)))

    (while (not (or (= start (point))

		    (not (char-before))

		    (char-equal (char-before) ?,)))

      (forward-char -1))

    (if (and (member proto mew-folder-prefixes)

	     (looking-at (concat "\\("

				 (regexp-opt mew-config-cases t)

				 ":\\)"

				 (regexp-quote proto))))

	(progn

	  (delete-region (match-end 1) pos)

	  (goto-char (match-end 1)))

      (delete-region (point) pos))

    (insert choice)

    (remove-text-properties start (point-max) '(mouse-face nil))

    (mew-complete-window-delete 'force)

    t))

(defun mew-complete-window-show (all)

  (unless (mew-ainfo-get-win-cfg)

    (mew-ainfo-set-win-cfg (current-window-configuration)))

  (if (and (get-buffer-window mew-buffer-completions)

	   (equal mew-complete-candidates all))

      (let ((win (get-buffer-window mew-buffer-completions)))

	(save-excursion

	  (set-buffer mew-buffer-completions)

	  (if (pos-visible-in-window-p (point-max) win)

	      (set-window-start win 1)

	    (scroll-other-window))))

    (setq mew-complete-candidates all)

    (with-output-to-temp-buffer mew-buffer-completions

      (when mew-inherit-complete-folder

	(make-local-variable 'choose-completion-string-functions)

	(add-hook 'choose-completion-string-functions

		  'mew-complete-insert-folder-function))

      (display-completion-list all))))

(defun mew-complete-backscroll ()

  "Backscroll the *Completion* buffer."

  (interactive)

  (let* ((win (get-buffer-window mew-buffer-completions))

	 (height (and win (window-height win))))

    (and win (scroll-other-window (- 3 height)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Completion function for a draft only

;;;

(defun mew-draft-set-completion-ignore-case (case)

  ;; Need to set the global variable "completion-ignore-case",

  ;; since clicking a candidate on a completion buffer checks

  ;; the global variable.

  ;; Yes, this has side-effect.

  (when (mew-draft-or-header-p)

    (setq completion-ignore-case case)))

(defun mew-draft-header-comp ()

  "Complete and expand address short names.

First, a short name is completed. When completed solely or the @ character

is inserted before the cursor, the short name is expanded to its address."

  (interactive)

  (if (mew-draft-on-field-p)

      (mew-complete-field)

    (let ((func (mew-draft-on-value-p mew-field-completion-switch)))

      (if func

	  (funcall func)

	(tab-to-tab-stop))))) ;; default keybinding

(defun mew-complete-field ()

  "Field complete function."

  (interactive)

  (let ((word (mew-delete-key))) ;; capitalized

    (if (null word)

	(mew-complete-window-show mew-fields)

      (mew-complete

       word

       (mapcar (lambda (x) (list (concat (mew-capitalize x) " "))) mew-fields)

       "field"

       nil))))

(defun mew-complete-newsgroups ()

  "Newsgroup complete function."

  (interactive)

  (let ((word (mew-delete-backward-char)))

    (if (null word)

	(tab-to-tab-stop)

      (mew-complete

       word

       (mew-nntp-folder-alist2 (mew-tinfo-get-case))

       "newsgroup"

       nil))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Completion function for both a draft and the minibuffer

;;;

(defun mew-complete-address ()

  "Complete and expand an address short name.

First alias key is completed. When completed solely or the @ character

is inserted before the cursor, the short name is expanded to its address."

  (interactive)

  (mew-draft-set-completion-ignore-case mew-complete-address-ignore-case)

  (let ((word (mew-delete-backward-char))

    	(completion-ignore-case mew-complete-address-ignore-case))

    (if (null word)

	(tab-to-tab-stop)

      (if mew-use-full-alias

	  (mew-complete

	   word mew-addrbook-alist "alias" nil nil nil

	   'mew-addrbook-alias-get

	   'mew-addrbook-alias-hit)

	(if (string-match "@." word)

	    (insert (or (mew-addrbook-alias-next word mew-addrbook-alist) word))

	  (mew-complete

	   word mew-addrbook-alist "alias" ?@ nil nil

	   'mew-addrbook-alias-get

	   'mew-addrbook-alias-hit))))))

(defun mew-draft-addrbook-expand ()

  (interactive)

  (mew-draft-set-completion-ignore-case mew-complete-address-ignore-case)

  (let ((word (mew-delete-backward-char))

    	(completion-ignore-case mew-complete-address-ignore-case)

	try)

    (if (null word)

	(message "No expand key")

      (setq try (try-completion word mew-addrbook-alist))

      (if (or (eq try t)

	      (and (stringp try) (string= word try)))

	  (insert (mew-addrbook-alias-get word mew-addrbook-alist))

	(insert word)

	(message "'%s' cannot be expanded" word)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Completing folders

;;;

(defmacro mew-complete-proto-folder (sym &rest body)

  ;; (declare (indent 1))

  `(if mew-input-folder-search-direction

       (mew-input-folder-search-complete)

     (mew-draft-set-completion-ignore-case mew-complete-folder-ignore-case)

     (let ((,sym (mew-delete-backward-char))

	   (completion-ignore-case mew-complete-folder-ignore-case)

	   (mew-inherit-complete-folder t))

       ,@body)))

(put 'mew-complete-proto-folder 'lisp-indent-function 1)

(defun mew-complete-local-folder ()

  "Local folder complete function."

  (interactive)

  (mew-complete-proto-folder word

    (if (null word)

       (mew-complete-window-show (list "+"))

     (if (and (mew-folder-absolutep word)

	      (not (mew-draft-or-header-p)))

	 (mew-complete word (mew-complete-directory-alist word) "directory" nil)

       (mew-complete word (mew-local-folder-alist) "folder" nil)))))

;; case is specified by mew-inherit-case.

(defun mew-complete-imap-folder ()

  "IMAP folder complete function."

  (interactive)

  (mew-complete-proto-folder word

    (if (null word)

	(mew-complete-window-show (list "%"))

      (mew-complete

       word

       (mew-imap-folder-alist mew-inherit-case) ;; ie mew-sinfo-get-case

       "mailbox"

       nil))))

(defun mew-complete-fcc-folder ()

  "Fcc: folder complete function."

  (interactive)

  (mew-complete-proto-folder word

    (if (null word)

	(mew-complete-window-show (list "+" "%"))

      (cond

       ((and (mew-folder-absolutep word) (not (mew-draft-or-header-p)))

	(mew-complete word (mew-complete-directory-alist word) "directory" nil))

       ((mew-folder-imapp word)

	(mew-complete word (mew-imap-folder-alist (mew-tinfo-get-case)) "mailbox" nil))

       (t

	(mew-complete word (mew-local-folder-alist) "folder" nil))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Completion function for the minibuffer only

;;;

(defun mew-complete-folder ()

  "Folder complete function."

  (interactive)

  (if mew-input-folder-search-direction

      (mew-input-folder-search-complete)

    (mew-complete-folder2)))

(defun mew-input-folder-search-complete ()

  (let ((mew-inherit-complete-folder t)

	keys)

    (save-excursion

      (set-buffer mew-input-folder-search-buf)

      (save-excursion

	(goto-char (point-min))

	(while (search-forward (or mew-input-folder-search-key "\n") nil t)

	  (setq keys

		(cons (buffer-substring (progn (beginning-of-line) (point))

					(progn (end-of-line) (point)))

		      keys)))))

    (mew-complete-window-show (nreverse (delete "" keys)))

    (mew-highlight-folder-comp-search-window)))

(defun mew-complete-folder2 ()

  (let ((word (mew-delete-backward-char nil ", \t\n"))

	(completion-ignore-case mew-complete-folder-ignore-case)

	(mew-inherit-complete-folder t)

	case folder)

    (cond

     ((null word)

      (mew-complete-window-show mew-config-cases2))

     ((setq case (mew-case:folder-case word))

      (setq folder (mew-case:folder-folder word))

      (cond

       ((mew-folder-localp folder)

	(mew-complete2 folder (mew-local-folder-alist) case))

       ((mew-folder-popp folder)

	(mew-complete2 folder (mew-pop-folder-alist) case))

       ((mew-folder-nntpp folder)

	(mew-complete2 folder (mew-nntp-folder-alist case) case))

       ((mew-folder-imapp folder)

	(mew-complete2 folder (mew-imap-folder-alist case) case))

       ((mew-folder-virtualp folder)

	(mew-complete

	 word (mew-buffer-list "^\\*" t 'mew-virtual-mode) "folder" nil))

       ((string= folder "")

	(insert word)

	(mew-complete-window-show

	 (mapcar (lambda (x) (concat case ":" x)) mew-folder-prefixes)))

       (t

	(insert word)

	(if (window-minibuffer-p (get-buffer-window (current-buffer)))

	    (mew-temp-minibuffer-message " [No matching folder]")

	  (message "No matching folder")))))

     (t

      (cond

       ((mew-folder-localp word)

	(mew-complete word (mew-local-folder-alist) "folder" nil))

       ((mew-folder-popp word)

	(mew-complete word (mew-pop-folder-alist) "folder" nil))

       ((mew-folder-nntpp word)

	(mew-complete word (mew-nntp-folder-alist nil) "newsgroup" nil))

       ((mew-folder-imapp word)

	(mew-complete word (mew-imap-folder-alist nil) "mailbox" nil))

       ((mew-folder-virtualp word)

	(mew-complete

	 word (mew-buffer-list "^\\*" t 'mew-virtual-mode) "folder" nil))

       ((mew-folder-absolutep word)

	(mew-complete word (mew-complete-directory-alist word) "directory" nil))

       (t

	(mew-complete

	 word

	 (mapcar (lambda (x) (list (concat x ":")))  mew-config-cases)

	 "case"

	 nil)))))))

(defun mew-complete-case ()

  "Complete function for cases."

  (interactive)

  (let ((word (or (mew-delete-backward-char) ""))

    	(completion-ignore-case mew-complete-case-ignore-case))

    (mew-complete

     word

     (mapcar 'list mew-config-cases)

     "case"

     nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Circular completion function for a draft only

;;;

(defun mew-draft-circular-comp ()

  "Switch function for circular complete functions."

  (interactive)

  (let ((func (mew-draft-on-value-p mew-field-circular-completion-switch)))

    (if func

	(funcall func)

      (message "No circular completion here"))))

(defun mew-circular-complete-domain ()

  "Circular completion of domains for To:, Cc:, etc.

If the @ character does not exist, the first value of

mew-mail-domain-list is inserted. If exists, the next value of

mew-mail-domain-list concerned with the string between @ and

the cursor is inserted."

  (interactive)

  (mew-draft-set-completion-ignore-case

   mew-circular-complete-domain-ignore-case)

  (let ((word (mew-delete-backward-char "@"))

	(completion-ignore-case mew-circular-complete-domain-ignore-case))

    (cond

     ((eq word nil) ;; @ does not exist.

      (if (null mew-mail-domain-list)

	  (message "For domain circular completion, set mew-mail-domain-list")

	(insert "@")

	(insert (car mew-mail-domain-list))

	(mew-complete-window-delete)))

     ((eq word t) ;; just after @

      (if (null mew-mail-domain-list)

	  (message "For domain circular completion, set mew-mail-domain-list")

	(insert (car mew-mail-domain-list))

	(mew-complete-window-delete)))

     (t

      ;; cannot use mew-get-next since completion is necessary sometime.

      (mew-complete

       word

       (mew-slide-pair mew-mail-domain-list)

       "domain"

       t))))) ;; use cdr

(defun mew-circular-complete (msg sym &optional minibuf) ;; xxx msg

  "General circular complete function."

  (interactive)

  (let ((name (symbol-name sym))

	(val (symbol-value sym))

	str alst match)

    (if (null val)

	(mew-temp-minibuffer-message (format "[Set '%s']" name))

      (setq str (mew-delete-value nil minibuf))

      (setq alst (mew-slide-pair val))

      (if (or (null str) ;; draft

	      (and (string= str "") (null (assoc "" alst)))) ;; minibuf

	  (insert (car val))

	(setq match (assoc str alst))

	(if match

	    (insert (cdr match))

	  (insert str)

	  (mew-temp-minibuffer-message (format "[No matching %s]" msg)))))))

(defun mew-circular-complete-from ()

  "Circular complete function for From:."

  (interactive)

  (mew-circular-complete "from" 'mew-from-list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Circular completion function for the minibuffer only

;;;

(defvar mew-circular-complete-function nil)

(defun mew-circular-complete-switch ()

  "A switch function to call a function defined to

'mew-circular-complete-function'."

  (interactive)

  (if mew-circular-complete-function (funcall mew-circular-complete-function)))

(defun mew-circular-complete-pick-pattern ()

  (mew-circular-complete "pick pattern" 'mew-pick-pattern-list 'minibuf))

(defun mew-circular-complete-case ()

  (mew-circular-complete "case" 'mew-config-cases 'minibuf))

(defun mew-circular-complete-case: ()

  (cond

   ((eq mew-input-complete-function 'mew-complete-local-folder)

    ())

   (mew-input-folder-search-direction

    (mew-input-folder-self-insert))

   (t

    (let (cases oldcase newcase insert-:)

      (save-excursion

	(if (search-backward "," nil t)

	    (forward-char 1)

	  (beginning-of-line))

	(if (looking-at mew-regex-case2)

	    (progn

	      (setq oldcase (mew-match-string 1))

	      (delete-region (match-beginning 1) (match-end 1)))

	  (setq oldcase mew-case-default)

	  (setq insert-: t))

	(if (setq cases (member oldcase mew-config-cases))

	    (if (> (length cases) 1)

		(setq newcase (nth 1 cases))

	      (setq newcase (car mew-config-cases)))

	  (setq newcase mew-case-default))

	(if (string= newcase mew-case-default)

	    (unless insert-: (delete-char 1))

	  (insert newcase)

	  (if insert-: (insert ":"))))

      (if (or (= (point) (mew-minibuf-point-min))

	      (save-excursion

		(forward-char -1)

		(looking-at "[:,]")))

	  (if (search-forward "," nil t)

	      (forward-char -1)

	    (goto-char (point-max))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Expansion for a draft only

;;;

(defun mew-draft-expand ()

  "Switch function for expand functions."

  (interactive)

  (let ((func (mew-draft-on-value-p mew-field-expansion-switch)))

    (if func

	(funcall func)

      (message "No expansion here"))))

(defun mew-expand-address ()

  "Address expansion function for To:, Cc:, etc.

'user@domain' will be expands 'name <user@domain>' if

the name exists."

  (interactive)

  (let ((word (mew-delete-backward-char)) func name)

    (if (null word)

	(message "No address here")

      (setq func (mew-addrbook-func mew-addrbook-for-address-expansion))

      (if (null func)

	  (insert word)

	(setq name (funcall func word))

	(insert (if name (format "%s <%s>" name word) word))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Other completion stuff

;;;

;; dummy

(defvar mew-ext-host "")

(defvar mew-ext-user "")

(defun mew-complete-rfile ()

  "Complete a remote file."

  (interactive)

  (let* ((path-file (mew-delete-file-name))

	 (path (car path-file))

	 (file (cdr path-file))

	 rpath)

    (setq rpath (format "/%s@%s:%s" mew-ext-user mew-ext-host path))

    (mew-complete

     file

     rpath

     "remote file"

     nil

     'mew-ext-file-name-completion

     'mew-ext-file-name-all-completions)))

(defun mew-complete-pick-pattern ()

  "Complete pick patterns."

  (interactive)

  (let* ((pat (mew-delete-pattern))

	 (clist (append '("(" "!")

			mew-pick-field-list

			(mapcar 'car mew-pick-macro-alist))))

    (if (null pat)

	(mew-complete-window-show clist)

      (mew-complete

       pat

       (mapcar 'list clist)

       "pick pattern"

       nil))))

(defun mew-complete-sort-key ()

  "Complete sort keys."

  (interactive)

  (let* ((word (mew-delete-line))

	 field alist)

    (if (string-match ":" word)

	(progn

	  ;; If WORD contains ':', change alist for completion.

	  (setq field (car (mew-split word ?:)))

	  (setq alist

		(mapcar (lambda (str) (list (concat field ":" str))) mew-sort-modes)))

      ;; Otherwise, alist is mew-sort-key-alist itself.

      (setq alist mew-sort-key-alist))

    (mew-complete word alist "sort key" nil)))

(defun mew-complete-directory-alist (dir)

  "Return alist of directories for completion."

  (let ((odir dir) odir1 dirs1 sub dirs2)

    (setq dir (mew-file-chase-links (expand-file-name dir)))

    (when (file-directory-p dir)

      (setq odir1 (file-name-as-directory odir))

      (setq dirs1 (mapcar

		   (lambda (x)

		     (when (file-directory-p (expand-file-name x dir))

		       (cons (concat odir1 (file-name-as-directory x)) x)))

		   (directory-files dir nil "[^.]" 'nosort))))

    (setq sub (file-name-nondirectory dir))

    (setq odir (file-name-directory odir))

    (setq dir (file-name-directory dir))

    (when (and dir odir sub (not (string= sub "")))

      (setq odir (file-name-as-directory odir))

      (setq dirs2 (mapcar

		   (lambda (x)

		     (when (file-directory-p (expand-file-name x dir))

		       (cons (concat odir (file-name-as-directory x)) x)))

		   (directory-files dir nil

				    (concat "^" (regexp-quote sub))

				    'nosort))))

    (sort (delq nil (append dirs2 dirs1))

	  (lambda (x y) (string< (car x) (car y))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Hart function for completions

;;;

(defalias 'mew-complete-hit 'assoc)

(defun mew-complete-get (key alist)

  (cdr (mew-complete-hit key alist)))

(defun mew-complete (WORD ALIST MSG EXPAND-CHAR &optional TRY ALL GET HIT)

  (let* ((ftry (or TRY 'try-completion))

	 (fall (or ALL 'all-completions))

	 (fget (or GET 'mew-complete-get))

	 (fhit (or HIT 'mew-complete-hit))

	 (cmp (funcall ftry WORD ALIST))

	 (all (funcall fall WORD ALIST))

	 (len (length WORD))

	 subkey)

    (cond

     ;; already completed

     ((eq cmp t)

      (if EXPAND-CHAR ;; may be "t"

	  (insert (funcall fget WORD ALIST)) ;; use cdr

	(insert WORD)) ;; use car

      (mew-complete-window-delete))

     ;; EXPAND

     ((and (mew-characterp EXPAND-CHAR)

	   (char-equal (aref WORD (1- len)) EXPAND-CHAR)

	   (setq subkey (substring WORD 0 (1- len)))

	   (funcall fhit subkey ALIST))

      (insert (funcall fget subkey ALIST)) ;; use cdr

      (mew-complete-window-delete))

     ;; just one candidate

     ((= 1 (length all))

      (insert cmp)

      (if (window-minibuffer-p (get-buffer-window (current-buffer)))

	  (mew-temp-minibuffer-message " [Sole completion]")

	(message "Sole completion"))

      (mew-complete-window-delete))

     ;; two or more candidates

     ((stringp cmp) ;; (length all) > 1

      (insert cmp)

      (mew-complete-window-show all)

      (if (and (mew-characterp EXPAND-CHAR) (funcall fhit cmp ALIST))

	  (message

	   "To expand '%s', type '%c' then '%s'"

	   cmp EXPAND-CHAR

 	   (substitute-command-keys

	    "\\<mew-draft-header-map>\\[mew-draft-header-comp]"))))

     ;; no candidate

     (t

      (insert WORD)

      ;;(mew-complete-window-delete)

      (if (window-minibuffer-p (get-buffer-window (current-buffer)))

	  (mew-temp-minibuffer-message (format " [No matching %s]" MSG))

	(message "No matching %s" MSG))))))

(defun mew-complete2-insert (case word)

  (if case

      (insert case ":" word)

    (insert word)))

(defun mew-complete2 (word alist case)

  (let* ((cmp (try-completion word alist))

	 (all (all-completions word alist)))

    (cond

     ;; already completed

     ((eq cmp t)

      (mew-complete2-insert case word) ;; use car

      (mew-complete-window-delete))

     ;; just one candidate

     ((= 1 (length all))

      (mew-complete2-insert case cmp)

      (if (window-minibuffer-p (get-buffer-window (current-buffer)))

	  (mew-temp-minibuffer-message " [Sole completion]")

	(message "Sole completion"))

      (mew-complete-window-delete))

     ;; two or more candidates

     ((stringp cmp) ;; (length all) > 1

      (mew-complete2-insert case cmp)

      (mew-complete-window-show all))

     ;; no candidate

     (t

      (mew-complete2-insert case word)

      ;;(mew-complete-window-delete)

      (if (window-minibuffer-p (get-buffer-window (current-buffer)))

	  (mew-temp-minibuffer-message " [No matching folder]")

	(message "No matching folder"))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;; Minibuf magic

;;;

(defun mew-temp-minibuffer-message (m)

  (let ((savemax (point-max)))

    (save-excursion

      (goto-char (point-max))

      (insert m))

    (let ((inhibit-quit t))

      (mew-let-user-read)

      (delete-region savemax (point-max))

      (when quit-flag

	(setq quit-flag nil)

	(setq unread-command-events (list 7)))))) ;; 7 == C-g

;;

;; Extracting completion key

;;

(defun mew-delete-backward-char (&optional here sep)

  "Delete appropriate preceding word and return it."

  (interactive)

  (let ((case-fold-search t)

        (start nil)

        (end (point))

        (regex (concat "[^" (or sep mew-address-separator) "]")))

    (save-excursion

      (while (and (not (bobp))

                  (string-match regex (mew-buffer-substring (1- (point)) (point))))

        (forward-char -1))

      (if (and here (not (re-search-forward (regexp-quote here) end t)))

          nil ;; "here" does not exist.

          (setq start (point))

          (if (= start end)

              (if here t nil) ;; just after "here",  just after separator

            (prog1

                (mew-buffer-substring start end)

              (delete-region start end)))))))

(defun mew-delete-file-name ()

  (if (search-backward mew-path-separator nil t)

      (forward-char 1)

    (beginning-of-line))

  (prog1

      (cons (mew-buffer-substring (mew-minibuf-point-min) (point))

	    (mew-buffer-substring (point) (point-max)))

    (delete-region (point) (point-max))))

(defun mew-delete-pattern ()

  (let ((pos (point)))

    (if (re-search-backward " \\|(\\|&\\||\\|!\\|," nil t)

	(forward-char 1)

      (beginning-of-line))

    (prog1

	(mew-buffer-substring (point) pos)

      (delete-region (point) pos))))

(defun mew-delete-line ()

  (let ((pos (point)))

    (beginning-of-line)

    (prog1

	(mew-buffer-substring (point) pos)

      (delete-region (point) pos))))

(defun mew-delete-key ()

  (let ((pos (point)))

    (beginning-of-line)

    (prog1

	(mew-capitalize (mew-buffer-substring (point) pos))

      (delete-region (point) pos))))

(defun mew-delete-value (&optional here minibuf)

  (beginning-of-line)

  (if minibuf

      (let ((start (point)) ret)

	(end-of-line)

	(setq ret (mew-buffer-substring start (point)))

	(delete-region start (point))

	ret)

    (when (looking-at "[^:]+:")

      (goto-char (match-end 0))

      (if (looking-at "[ \t]")

	  (forward-char 1)

	(insert " "))

      (if (eolp)

	  nil

	(let ((start (point)) ret)

	  (end-of-line)

	  (if (and here (re-search-backward (regexp-quote here) start t))

	      (progn

		(setq start (1+ (point)))

		(end-of-line)))

	  (setq ret (mew-buffer-substring start (point)))

	  (delete-region start (point))

	  ret)))))

;;

;; Making alist

;;