[Mew-dist 1449] Re: case notation in ~/.im/Config

[Kazu Yamamoto ( 山本和彦 )]

From: Makoto MATSUSHITA (まつしたまこと) <matusita at example.com>
Subject: [Mew-dist 1447] Re: case notation in ~/.im/Config
Date: Tue, 05 Aug 1997 16:02:24 +0900

> とりあえず，
> 
> (setq mew-header-alist
> 	'(("Config:" . "")))
> 
> とかやっておくと，多分あんまり問題にならないんじゃないかと思います．以
> 下，imput より抜粋します．

それよりもこれを使ってみて下さい。

.emacs で
	(setq mew-configs '("wide" "mew" "nara"))
などを指定し、Config: の後で TAB を押して下さい。

--かず＠逃避中

-------------- next part --------------
;;;			   mew-complete.el
;;;
;;;		Copyright (C) 1997  Kazuhiko Yamamoto
;;;
;;;		   This emacs lisp library conforms
;;;		GNU GENERAL PUBLIC LICENSE Version 2.
;;;
;;; Author:  Kazu Yamamoto <Kazu at example.com>
;;; Created: May 30, 1997
;;; Revised: 
;;;

(defconst mew-complete-version "mew-complete.el version 0.01")

(require 'mew)

(defvar mew-fields
  '("To:" "Cc:" "Subject:" "Dcc:" "Fcc:" "Bcc:"
    "Reply-To:" "Followup-To:" "From:" "Newsgroups:"
    "Config:")
  "*Completion field list on draft mode"
  )

(defvar mew-configs nil
  "*Completion list for Config:")

(defvar mew-field-completion-switch
  '(("To:"       . mew-complete-address)
    ("Cc:"       . mew-complete-address)
    ("Dcc:"      . mew-complete-address)
    ("Bcc:"      . mew-complete-address)
    ("Reply-To:" . mew-complete-address)
    ("From:"     . mew-complete-address)
    ("Fcc:"      . mew-complete-folder)
    ("Config:"   . mew-complete-config))
  "*Completion function alist concerned with the key"
  )

(defvar mew-address-separator ":, \t\n")

;;
;; Switching completion in Draft
;;

(defun mew-draft-header-comp ()
  (interactive)
  (let ((func nil))
    (if (mew-draft-on-field-p)
	(mew-complete-field)
      (if (setq func (mew-draft-on-value-p))
	  (funcall (cdr func))
	(tab-to-tab-stop))) ;; default keybinding
    ))

(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 (re-search-forward ":" pos t) nil t))
	))
    ))
      
(defun mew-draft-on-value-p ()
  (save-excursion
    (beginning-of-line)
    (while (and (< (point-min) (point))	(looking-at mew-lwsp))
      (forward-line -1)
      )
    (if (looking-at "\\([^:]*:\\)")
	(mew-assoc-match (mew-match 1) mew-field-completion-switch 0)
      nil) ;; what a case reach here?
    ))
      
;;
;; Window management for completion candidates
;;

(defvar mew-complete-window-config nil)

(defun mew-complete-window-delete ()
  (if (null mew-complete-window-config)
      ()
    (set-window-configuration mew-complete-window-config)
    (setq mew-complete-window-config nil)
    )
  (and (get-buffer mew-buffer-completions)
       (kill-buffer mew-buffer-completions))
  )


(defun mew-complete-window-show (all)
  (or mew-complete-window-config
      (setq mew-complete-window-config (current-window-configuration)))
  (with-output-to-temp-buffer
      mew-buffer-completions
    (display-completion-list all))
  )

;;
;; Completion function
;;

(defun mew-complete-field ()
  (interactive)
  (let ((word (mew-delete-field))) ;; capitalized
    (if (null word)
	(mew-complete-window-show mew-fields)
      (mew-complete
       word
       (mew-fields-make-alist mew-fields)
       "field"
       nil) ;; use car
      )
    ))

(defun mew-complete-folder ()
  (interactive)
  (let ((word (mew-delete-backward-char)))
    (if (null word)
	(insert "+")
      (mew-complete
       word
       mew-folder-alist
       "folder"
       nil) ;; use car
      )
    ))

(defun mew-complete-address ()
  (interactive)
  (let ((word (mew-delete-backward-char)))
    (if (null word)
	(tab-to-tab-stop)
      (mew-complete
       word
       mew-alias-alist
       "alias"
       ?@) ;; use cdr
      )
    ))


(defun mew-complete-config ()
  (interactive)
  (let ((word (mew-delete-backward-char)))
    (if (null word)
	(if mew-configs (insert (car mew-configs)))
      (mew-complete
       word
       (mew-slide-pair mew-configs)
       "config"
	t) ;; use cdr
      )
    ))

;;
;; C-cC-t
;;

(defun mew-draft-domain-comp ()
  (interactive)
  (let ((field (mew-draft-on-value-p)))
    (if (or (null field) (not (equal (cdr field) 'mew-complete-address)))
	(tab-to-tab-stop)
      (mew-complete-domain)
      )
    ))

(defun mew-complete-domain ()
  (interactive)
  (let ((word (mew-delete-backward-char "@")))
    (cond
     ((equal word nil) ;; @ doesn't exist.
      (if (null mew-mail-domain-list)
	  ()
	(insert "@")
	(insert (car mew-mail-domain-list))
	(mew-complete-window-delete))
      )
     ((equal word t) ;; just after @
      (if (null mew-mail-domain-list)
	  ()
	(insert (car mew-mail-domain-list))
	(mew-complete-window-delete))
      )
     (t
      (mew-complete
       word
       (mew-slide-pair mew-mail-domain-list)
       "domain"
	t) ;; use cdr
      )
     )
    ))

;;
;; Hart function for completions
;;

(defun mew-complete (WORD ALIST MSG EPAND-CHAR)
  (let ((cmp (try-completion WORD ALIST))
	(all (all-completions WORD ALIST))
	(len (length WORD)))
    (cond
     ;; already completed
     ((eq cmp t)
      (if EPAND-CHAR
	  (insert (cdr (assoc WORD ALIST))) ;; use cdr
	(insert WORD)) ;; use car
      (mew-complete-window-delete))
     ;; EXPAND
     ((and (mew-characterp EPAND-CHAR)
	   (char-equal (aref WORD (1- len)) EPAND-CHAR)
	   (assoc (substring WORD 0 (1- len)) ALIST))
      (insert (cdr (assoc (substring WORD 0 (1- len)) ALIST))) ;; use cdr
      (mew-complete-window-delete))
     ;; just one candidate
     ((equal 1 (length all))
      (insert cmp)
      (mew-complete-window-delete)
      (if (window-minibuffer-p (get-buffer-window (current-buffer)))
	  (mew-temp-minibuffer-message " [Sole completion]")
	(message "Sole completion")))
     ;; two or more candidates
     ((stringp cmp) ;; (length all) > 1
      (insert cmp)
      (mew-complete-window-show all))
     ;; no candidate
     (t
      (insert WORD)
      ;;(mew-complete-window-delete)
      (if (window-minibuffer-p (get-buffer-window (current-buffer)))
	  (mew-temp-minibuffer-message (concat " No matching " MSG))
	(message "No matching %s" MSG))
      )
     )
    ))

;;
;; Minibuf magic
;;

(defun mew-temp-minibuffer-message (m)
  (let ((savemax (point-max)))
    (save-excursion
      (goto-char (point-max))
      (insert m))
    (let ((inhibit-quit t))
      (sit-for 2)
      (delete-region savemax (point-max))
      (if quit-flag (setq quit-flag nil	unread-command-events 7))
      )))


;;
;; Extracting completion key
;;

(defun mew-delete-backward-char (&optional here)
  "Delete appropriate preceeding word and return it."
  (interactive)
  (let ((case-fold-search t)
	(start nil)
	(end (point))
	(regex (concat "[^" 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" doesn't 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-field ()
  (let ((pos (point)))
    (beginning-of-line)
    (prog1
	(capitalize (mew-buffer-substring (point) pos))
      (delete-region (point) pos)
      )
    ))

;;
;; Making alist
;;

(defun mew-fields-make-alist (list)
  (mapcar
   (function (lambda (x) (cons (concat (capitalize x) " ") nil)))
   list)
  )

(defun mew-slide-pair (x)
  (let ((ret nil)
	(first (car x)))
    (cond 
     ((eq x 0) nil)
     ((eq x 1) (cons first first))
     (t
      (while (cdr x)
	(setq ret (cons (cons (nth 0 x) (nth 1 x)) ret))
	(setq x (cdr x))
	)
      (setq ret (cons (cons (car x) first) ret))
      (nreverse ret)
      )
     )
    ))

(provide 'mew-complete)