;;; mew-func.el --- Basic functions for Mew

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Mar 23, 1997
;; Revised: Oct 25, 1997

;;; Code:

(defconst mew-func-version "mew-func.el version 0.10")

(require 'mew)

;;
;; List functions
;;

(defun mew-folder-member (a list)
  (catch 'member
    (while list
      (if (or (equal (car list) a)
	      (equal (car list) (file-name-as-directory a)))
	  (throw 'member t))
      (setq list (cdr list)))))

(defmacro mew-case-equal (str1 str2)
  (` (equal (downcase (, str1)) (downcase (, str2)))))

(defun mew-member (a list)
  (catch 'member
    (while list
      (if (equal (car list) a)
	  (throw 'member t))
      (setq list (cdr list)))))

(defun mew-member-case-equal (str list)
  (let ((n 0))
    (catch 'member
      (while list
	(if (equal (downcase (car list)) (downcase str))
	    (throw 'member n))
	(setq list (cdr list))
	(setq n (1+ n))))))

(defun mew-member-match (str list &optional case-ignore)
  (let ((n 0) (case-fold-search case-ignore))
    (catch 'member
      (while list
	(if (string-match (car list) str)
	    (throw 'member n))
	(setq list (cdr list))
	(setq n (1+ n))))))

;;
;; Associative list functions
;;

(defun mew-assoc-equal (key alist nth)
  (let (a n)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (equal n key) (eq n t))
	    (throw 'loop a))
	(setq alist (cdr alist))))))

(defun mew-assoc-case-equal (key alist nth)
  (let ((skey (downcase key)) a n)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (and (stringp n) (equal (downcase n) skey))
		(eq n t))
	    (throw 'loop a))
	(setq alist (cdr alist))))))

(defun mew-assoc-case-equal3 (key alist nth)
  (let ((skey (downcase key)) (i 0) a n)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (and (stringp n) (equal (downcase n) skey))
		(eq n t))
	    (throw 'loop (cons i a)))
	(setq i (1+ i))
	(setq alist (cdr alist))))))

(defun mew-assoc-match (key alist nth)
  (let ((case-fold-search t) a n)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (and (stringp n) (string-match key n))
		(equal n key) (eq n t))
	    (throw 'loop a))
	(setq alist (cdr alist))))))

(defun mew-assoc-match2 (key alist nth)
  (let ((case-fold-search t) a n)
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (and (stringp n) (string-match n key))
		(equal n key) (eq n t))
	    (throw 'loop a))
	(setq alist (cdr alist))))))

(defun mew-assoc-match3 (key alist nth)
  (let ((case-fold-search t) (i 0) a n )
    (catch 'loop
      (while alist
	(setq a (car alist))
	(setq n (nth nth a))
	(if (or (and (stringp n) (string-match n key))
		(equal n key) (eq n t))
	    (throw 'loop (cons i a)))
	(setq i (1+ i))
	(setq alist (cdr alist))))))

(defun mew-assoc-member (key lol nth)
  (let (l)
    (catch 'loop
      (while lol
	(setq l (car lol))
	(setq lol (cdr lol))
	(if (mew-member key (nth nth l)) (throw 'loop l))))))
;;
;; Generic extract functions
;;

(defun mew-subsequence (seq beg &optional end)
  (cond
   ((vectorp seq)
    (mew-subvector seq beg end))
   ((stringp seq)
    (substring  seq beg end))
   ((listp seq)
    (mew-sublist seq beg end))
   (t nil)
   )
  )

(defun mew-sublist (list beg &optional end)
  (let (i ret)
    (if (null end) (setq end (length list)))
    (setq end (1- end))
    (setq i end)
    (while (<= beg i)
      (setq ret (cons (nth i list) ret))
      (setq i (1- i)))
    ret
    )
  )

(defun mew-subvector (vec beg &optional end)
  (let (i j ret)
    (if (null end) (setq end (length vec)))
    (setq ret (make-vector (- end beg) nil))
    (setq i beg j 0)
    (while (< i end)
      (aset ret j (aref vec i))
      (setq i (1+ i) j (1+ j)))
    ret
    )
  )

;;
;; String
;;

(defun mew-replace-character (string from to)
  (let ((len (length string))
	(cnt 0))
    (while (< cnt len)
      (if (char-equal (aref string cnt) from)
	  (aset string cnt to))
      (setq cnt (1+ cnt)))
    string
    ))

(defun mew-match (pos &optional string)
  "Substring POSth matched from STRING or the current buffer"
  (cond 
   ((stringp string)
    (substring string (match-beginning pos) (match-end pos)))
   (t 
    (mew-buffer-substring (match-beginning pos) (match-end pos)))
   )
  )

(defun mew-substring (str width)
  "Return multi-lingual-safe substring. The length of results
are less than or equal to width."
  ;; This code supposes that "str" is short enough.
  ;; The algorithm is not effective. O(N).
  (if (fboundp (function mew-string-to-list))
      (let ((char-list (mew-string-to-list str))
	    (i 0) (w 0) (last 0))
	(while (and char-list (<= w width))
	  (setq w (+ w (char-width (car char-list))))
	  (setq last i)
	  (setq i (+ i (length (char-to-string (car char-list)))))
	  (setq char-list (cdr char-list)))
	(substring str 0 last))
    (substring str 0 width)))

;;
;; Stolen form Perl
;;

(defun mew-join (separator string-list)
  (let ((ret-str ""))
    (if (null string-list) 
	"" ;; return strings anyway
      (setq ret-str (car string-list))
      (setq string-list (cdr string-list))
      (while string-list
	(setq ret-str (concat ret-str separator (car string-list)))
	(setq string-list (cdr string-list))
	)
      ret-str
      )
    ))

(defun mew-split (separator str)
  (let ((len (length separator))
	(reg-sep (regexp-quote separator))
	(start 0)
	(last 0)
	(ret-list ()))
    (while (setq start (string-match reg-sep str start))
      (setq ret-list (cons (substring str last start) ret-list))
      (setq start (+ start len))
      (setq last start)
      )
    (setq ret-list (cons (substring str last nil) ret-list))
    (nreverse ret-list)
    ))

;;
;; Folder
;;

(defun mew-folder-mailp (folder)
  (string-match "^+" folder)
  )

(defun mew-folder-newsp (folder)
  (string-match "^-" folder)
  )

(defun mew-folder-local-newsp (folder)
  (string-match "^=" folder)
  )

(defun mew-folder-imapp (folder)
  (string-match "^%" folder)
  )

(defun mew-folder-to-dir (folder)
  (if (string-match "^[+=]" folder)
      (substring folder 1 nil)
    folder)
  )

(defun mew-expand-folder (folder &optional message)
  (let ((subdir (substring folder 1 nil))
	dir)
    (cond
     ((mew-folder-mailp folder)
      (setq dir (expand-file-name subdir mew-mail-path)))
     ((mew-folder-local-newsp folder)
      (setq dir (expand-file-name subdir mew-news-path)))
     ((mew-folder-imapp folder)
      (let ((spec (mew-imap-folder-fullspec folder)))
	(string-match
	 "^%\\([^:]+\\):\\([^/]+\\)/\\([^@]+\\)@\\([^/]+\\).*$" spec)
	(setq dir
	      (expand-file-name
	       (concat "@" (mew-match 4 spec)
		       "#" (mew-match 2 spec)
		       mew-path-separator (mew-match 1 spec))
	       mew-mail-path))
	)))
    (if message
	(expand-file-name message dir)
      dir)
    ))

(defun mew-imap-folder-fullspec (folder)
  "Make full-spec IMAP folder name of FOLDER."
  (let ((fold nil)
	(user (or (getenv "USER") (getenv "LOGNAME") (user-login-name)))
	(auth "/AUTH")
	(host "@localhost"))
    (if mew-imap-account
	(progn
	  (string-match
	   "^\\([^/@]+\\)?\\(/[^@]+\\)?\\(@.+\\)?$" mew-imap-account)
	  (if (match-beginning 1) (setq user (mew-match 1 mew-imap-account)))
	  (if (match-beginning 2) (setq auth (mew-match 2 mew-imap-account)))
	  (if (match-beginning 3) (setq host (mew-match 3 mew-imap-account)))
	  ))
    (string-match
     "^\\([^:@]+\\)\\(:\\([^/@]+\\)\\)?\\(/[^@]+\\)?\\(@.+\\)?$" folder)
    (setq fold (mew-match 1 folder))
    (if (match-beginning 3) (setq user (mew-match 3 folder)))
    (if (match-beginning 4) (setq auth (mew-match 4 folder)))
    (if (match-beginning 5) (setq host (mew-match 5 folder)))
    (concat fold ":" user auth host)
    ))

(defun mew-folder-check (folder)
  "A function to see if FOLDER exists.
Return t if exists or created. Otherwise, return nil."
  (if (not (stringp folder))
      nil ;; wrong
    (let ((absdir (mew-expand-folder folder))  ;; /home/Mail/foo
	  (folders-file (expand-file-name mew-folders-file mew-mail-path))
	  create-it)
      (if (file-exists-p absdir)
	  (if (file-directory-p absdir)
	      t ;; exists
	    (message "%s is a file" folder)
	    nil ;; exists but a file
	    )
 	(if (mew-folder-imapp folder)
	    (if (y-or-n-p (format "Maybe %s doesn't exist (cache-dir not found). Create it? " folder))
		(setq create-it t))
	  (if (y-or-n-p (format "%s doesn't exist. Create it? " folder))
	      (setq create-it t)))
	(if (not create-it)
	    nil ;; not created
	  (mew-make-directory absdir)
	  (setq mew-folder-list (cons folder mew-folder-list))
	  (setq mew-folder-alist 
		(cons (mew-folder-pair folder) mew-folder-alist))
	  (if (file-readable-p folders-file)
	      (save-excursion
		(mew-set-buffer-tmp)
		(insert folder)
		(insert "\n")
		(write-region (point-min) (point-max)
			      folders-file 'append 'no-msg)))
	  t ;; created
	  )))))

(defun mew-folder-new-message (folder &optional num-only)
  (let ((files (directory-files (mew-expand-folder folder)))
	(max 0) cur file maxfile)
    (while files
      (setq file (car files))
      (setq files (cdr files))
      (if (not (string-match "^[0-9]+$" file))
	  ()
	(setq cur (string-to-int file))
	(if (> cur max)
	    (setq max cur))))
    (setq max (int-to-string (1+ max)))
    (setq maxfile (mew-expand-folder folder max))
    (if (not (file-exists-p maxfile))
	() ;; OK
	;; due to NFS?
      (mew-touch-folder folder) ;; can clear cache?
      (setq files (directory-files (mew-expand-folder folder)))
      (setq max 0)
      (while files
	(setq file (car files))
	(setq files (cdr files))
	(if (not (string-match "^[0-9]+$" file))
	    ()
	  (setq cur (string-to-int file))
	  (if (> cur max)
	      (setq max cur))))
      (setq max (int-to-string (1+ max)))
      (setq maxfile (mew-expand-folder folder max)))
    (while (file-exists-p maxfile)
      (setq max (read-string (format "%s/%s exists. Input a message number : " max folder)))
      (while (not (string-match "^[0-9]+$" max))
	(setq max (read-string "Input NUMBER : ")))
      (setq maxfile (mew-expand-folder folder max)))
    (if num-only
	max
      maxfile)))

(defun mew-folder-list (folder)
  "List up subfolders of FOLDER."
  (let (folders)
    (condition-case nil
	(let ((case-fold-search t)
	      curdir dirent relpath abspath attr
	      subprefix subfolder)
	  (setq curdir (mew-expand-folder folder))
	  (if (string-match "^[+=]$" folder)
	      (setq subprefix folder)
	    (setq subprefix (concat folder mew-path-separator)))
	  (setq dirent (directory-files curdir))
	  (while dirent
	    (setq relpath (car dirent))
	    (setq dirent (cdr dirent))
	    (setq abspath (expand-file-name relpath curdir))
	    (setq attr (mew-file-attributes abspath))
	    (if (or (equal relpath ".")
		    (equal relpath "..")
		    (not (nth 0 attr))) ;; this is a file
		() 
	      (setq subfolder (concat subprefix relpath))
	      (setq folders (nconc folders (list subfolder)))
	      (if (or (and mew-folder-list-skip-pattern
			   (not (string-match mew-folder-list-skip-pattern
					      relpath)))
		      (> (nth 1 attr) 2))
		  (setq folders (nconc folders (mew-folder-list subfolder))))))
	  folders) ;; return value
      (file-error folders))))

;;
;; Directory
;;

(defmacro mew-directory-empty-p (dir)
  "See if DIR never contains files"
  (` (null (car (cdr (cdr (directory-files (, dir)))))))
  )

(defun mew-make-directory (path)
  (let ((parent (directory-file-name (file-name-directory path))))
    (if (null (file-directory-p parent))
	(mew-make-directory parent))
    (if (and (file-exists-p path) (not (file-directory-p path)))
	(delete-file path))
    (make-directory path)
    (set-file-modes path mew-folder-mode)
    ))

(defun mew-delete-directory-recursively (dir)
  (let ((files (directory-files dir t "^[^.]\\|^.[^.]")))
    (while files
      (cond
       ((file-symlink-p (car files))
	;; never chase symlink which points a directory
	(delete-file (car files)))
       ((file-directory-p (car files))
	(mew-delete-directory-recursively (car files)))
       (t
	(delete-file (car files)))
       )
      (setq files (cdr files))
      ))
  (delete-directory dir)
  )

;;
;; File existence
;;

(defun mew-which (file path)
  (catch 'loop
    (while path
      (if (file-exists-p (expand-file-name file (car path)))
	  (throw 'loop (expand-file-name file (car path)))
	(setq path (cdr path)))
      )
    ))

(defun mew-which-el (elfile path)
  (or (mew-which (concat elfile ".el") path)
      (mew-which (concat elfile ".elc") path))
  )


(defun mew-file-attributes (filename)
  "Same as file-attributes, but chase it if FILENAME is a symbolic-link."
  (let ((w32-get-true-file-link-count t) ; for Meadow
	attr symlnk)
    (while (stringp (setq symlnk (car (setq attr (file-attributes filename)))))
      (setq filename
	    (expand-file-name symlnk (file-name-directory filename))))
    attr))

;; file-regular-p is not available in Emacs 19.
;; This allows symbolic link now.
;; Should be writable, anyway.
(defmacro mew-file-regular-p (file)
  (` (and (file-exists-p (, file))
	  (file-writable-p (, file))
	  (not (file-directory-p (, file))))))

(defun mew-get-file-modes (file)
  (let* ((mode (nth 8 (file-attributes file)))
	 (len (length mode))
	 (i 1)
	 (dec 0))
    (while (< i len)
      (setq dec (* dec 2))
      (if (not (char-equal (aref mode i) ?-))
	  (setq dec (1+ dec)))
      (setq i (1+ i)))
    dec))

;;
;; temp name
;;

(defun mew-make-temp-name ()
  (if (not (file-exists-p mew-temp-dir))
      (mew-make-directory mew-temp-dir)) ;; just in case
  (make-temp-name mew-temp-file))

;;
;; Random
;;

(defvar mew-random-last nil)

(defun mew-random-string ()
  (let ((num (% (abs (random)) 1000)))
    (while (equal mew-random-last num)
      (setq num (% (abs (random)) 1000))
      )
    (setq mew-random-last num)
    (int-to-string num)
    ))

(defvar mew-random-base "0123456789abcdefghijklmnopqrstuvwxwz")

(defun mew-random-char ()
  (let* ((len (length mew-random-base))
	 (idx (% (abs (random)) len)))
    (substring mew-random-base idx (1+ idx))
    ))

(defun mew-random-filename (dir &optional suffix)
  (let ((cnt 0) (max (length mew-random-base))
	file filepath)
    (setq file (concat (mew-random-char) suffix))
    (setq filepath (expand-file-name file dir))
    (while (and (file-exists-p filepath) (< cnt max))
      (setq file (concat (mew-random-char) suffix))
      (setq filepath (expand-file-name file dir))
      (setq cnt (1+ cnt)))
    (if (file-exists-p filepath) 
	nil
      filepath)
    ))

;;
;; Buffer
;;

(defun mew-set-buffer-tmp (&optional dir)
  (set-buffer (get-buffer-create mew-buffer-tmp))
  (mew-erase-buffer)
  (if dir (cd dir) (cd mew-home))
  )

(defun mew-erase-buffer ()  
  (setq buffer-read-only nil)
  (widen)
  (erase-buffer)
  )

;;
;; process
;;

(defun mew-im-call-process (msg prog &rest arg)
  (let (ret)
    (and msg (message "%s ..." msg))
    (setq ret (apply (function call-process)
		     prog nil t nil (append arg mew-prog-im-arg)))
    (if (equal ret 0)
	(progn
	  (and msg (message "%s ... done" msg))
	  t)
      (if msg (message "%s ... failed" msg) (message "failed"))
      nil)))

(defun mew-im-call-process-no-output (msg prog &rest arg)
  (let (ret)
    (and msg (message "%s ..." msg))
    (setq ret (apply (function call-process)
		     prog nil nil nil (append arg mew-prog-im-arg)))
    (if (equal ret 0)
	(progn
	  (and msg (message "%s ... done" msg))
	  t)
      (if msg (message "%s ... failed" msg) (message "failed"))
      nil)))

(defun mew-im-start-process (prog name &rest arg)
  (apply (function start-process)
	 name (current-buffer) prog
	 (append arg mew-prog-im-arg)))

(provide 'mew-func)

;;; Copyright Notice:

;; Copyright (C) 1997, 1998 Mew developing team.
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;; 
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;; 3. All advertising materials mentioning features or use of this software
;;    must display the following acknowledgement:
;;       This product includes software developed by 
;;       Mew developing team and its contributors.
;; 4. Neither the name of the team nor the names of its contributors
;;    may be used to endorse or promote products derived from this software
;;    without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; mew-func.el ends here
