1;;; mew-complete.el --- Completion magic for Mew 2 3;; Author: Kazu Yamamoto <Kazu@Mew.org> 4;; Created: May 30, 1997 5 6;;; Code: 7 8(require 'mew) 9 10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11;;; 12;;; Low level functions 13;;; 14 15(defun mew-draft-on-field-p () 16 (if (bolp) 17 (if (bobp) 18 t 19 (save-excursion 20 (forward-line -1) 21 (if (looking-at ".*,[ \t]?$") nil t))) 22 (let ((pos (point))) 23 (save-excursion 24 (beginning-of-line) 25 (if (looking-at mew-lwsp) 26 nil 27 (if (search-forward ":" pos t) nil t)))))) 28 29(defun mew-draft-on-value-p (switch) 30 (save-excursion 31 (beginning-of-line) 32 (while (and (< (point-min) (point)) (looking-at mew-lwsp)) 33 (forward-line -1)) 34 (if (looking-at "\\([^:]*:\\)") 35 (mew-field-get-func (match-string 1) switch) 36 nil))) ;; what a case reaches here? 37 38;; 39;; Window management for completion candidates 40;; 41 42(defvar mew-complete-candidates nil) 43 44(defun mew-complete-window-delete (&optional force) 45 (when (mew-ainfo-get-win-cfg) 46 ;; (mew-ainfo-get-win-cfg) remains when the last completion 47 ;; finished with multiple candidates. 48 ;; (e.g. foo<RET> when foo and foobar are displayed.) 49 ;; In this case, this function is called in another 50 ;; completion thread but setting window configuration is not 51 ;; desired. If we set window configuration with the old 52 ;; (mew-ainfo-get-win-cfg), the cursor jumps to mini buffer. 53 ;; This was a stupid bug of Mew. So, let's see if the complete 54 ;; buffer is displayed or not. 55 (if (or force (get-buffer-window mew-buffer-completions)) 56 (set-window-configuration (mew-ainfo-get-win-cfg))) 57 (mew-ainfo-set-win-cfg nil)) 58 (mew-remove-buffer mew-buffer-completions) 59 (setq mew-complete-candidates nil)) 60 61(defun mew-complete-insert-folder-function (choice _buffer _mini-p _base-size) 62 (let ((start (mew-minibuf-point-min)) 63 (proto (substring choice 0 1)) 64 (pos (point))) 65 (while (not (or (= start (point)) 66 (not (char-before)) 67 (char-equal (char-before) ?,))) 68 (forward-char -1)) 69 (if (and (member proto mew-folder-prefixes) 70 (looking-at (concat "\\(" 71 (regexp-opt mew-config-cases t) 72 ":\\)" 73 (regexp-quote proto)))) 74 (progn 75 (delete-region (match-end 1) pos) 76 (goto-char (match-end 1))) 77 (delete-region (point) pos)) 78 (insert choice) 79 (remove-text-properties start (point-max) '(mouse-face nil)) 80 (mew-complete-window-delete 'force) 81 t)) 82 83(defun mew-complete-window-show (all) 84 (unless (mew-ainfo-get-win-cfg) 85 (mew-ainfo-set-win-cfg (current-window-configuration))) 86 (if (and (get-buffer-window mew-buffer-completions) 87 (equal mew-complete-candidates all)) 88 (let ((win (get-buffer-window mew-buffer-completions))) 89 (with-current-buffer mew-buffer-completions 90 (if (pos-visible-in-window-p (point-max) win) 91 (set-window-start win 1) 92 (scroll-other-window)))) 93 (setq mew-complete-candidates all) 94 (with-output-to-temp-buffer mew-buffer-completions 95 (when mew-inherit-complete-folder 96 (make-local-variable 'choose-completion-string-functions) 97 (add-hook 'choose-completion-string-functions 98 'mew-complete-insert-folder-function)) 99 (display-completion-list all)))) 100 101(defun mew-complete-backscroll () 102 "Backscroll the *Completion* buffer." 103 (interactive) 104 (let* ((win (get-buffer-window mew-buffer-completions)) 105 (height (and win (window-height win)))) 106 (and win (scroll-other-window (- 3 height))))) 107 108;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 109;;; 110;;; Completion function for a draft only 111;;; 112 113(defun mew-draft-set-completion-ignore-case (case) 114 ;; Need to set the global variable "completion-ignore-case", 115 ;; since clicking a candidate on a completion buffer checks 116 ;; the global variable. 117 ;; Yes, this has side-effect. 118 (when (mew-draft-or-header-p) 119 (setq completion-ignore-case case))) 120 121(defun mew-draft-header-comp () 122 "Complete and expand address short names. 123First, a short name is completed. When completed solely or the @ character 124is inserted before the cursor, the short name is expanded to its address." 125 (interactive) 126 (if (mew-draft-on-field-p) 127 (mew-complete-field) 128 (let ((func (mew-draft-on-value-p mew-field-completion-switch))) 129 (if func 130 (funcall func) 131 (tab-to-tab-stop))))) ;; default keybinding 132 133(defun mew-complete-field () 134 "Field complete function." 135 (interactive) 136 (let ((word (mew-delete-key))) ;; capitalized 137 (if (null word) 138 (mew-complete-window-show mew-fields) 139 (mew-complete 140 word 141 (mapcar (lambda (x) (list (concat (mew-capitalize x) " "))) mew-fields) 142 "field" 143 nil)))) 144 145(defun mew-complete-newsgroups () 146 "Newsgroup complete function." 147 (interactive) 148 (let ((word (mew-delete-backward-char))) 149 (if (null word) 150 (tab-to-tab-stop) 151 (mew-complete 152 word 153 (mew-nntp-folder-alist2 (mew-tinfo-get-case)) 154 "newsgroup" 155 nil)))) 156 157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 158;;; 159;;; Completion function for both a draft and the minibuffer 160;;; 161 162(defun mew-complete-address () 163 "Complete and expand an address short name. 164First alias key is completed. When completed solely or the @ character 165is inserted before the cursor, the short name is expanded to its address." 166 (interactive) 167 (mew-draft-set-completion-ignore-case mew-complete-address-ignore-case) 168 (let ((word (mew-delete-backward-char)) 169 (completion-ignore-case mew-complete-address-ignore-case)) 170 (if (null word) 171 (tab-to-tab-stop) 172 (if mew-use-full-alias 173 (mew-complete 174 word mew-addrbook-alist "alias" nil nil nil 175 'mew-addrbook-alias-get 176 'mew-addrbook-alias-hit) 177 (if (string-match "@." word) 178 (insert (or (mew-addrbook-alias-next word mew-addrbook-alist) word)) 179 (mew-complete 180 word mew-addrbook-alist "alias" ?@ nil nil 181 'mew-addrbook-alias-get 182 'mew-addrbook-alias-hit)))))) 183 184(defun mew-draft-addrbook-expand () 185 (interactive) 186 (mew-draft-set-completion-ignore-case mew-complete-address-ignore-case) 187 (let ((word (mew-delete-backward-char)) 188 (completion-ignore-case mew-complete-address-ignore-case) 189 try) 190 (if (null word) 191 (message "No expand key") 192 (setq try (try-completion word mew-addrbook-alist)) 193 (if (or (eq try t) 194 (and (stringp try) (string= word try))) 195 (insert (mew-addrbook-alias-get word mew-addrbook-alist)) 196 (insert word) 197 (message "'%s' cannot be expanded" word))))) 198 199;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 200;;; 201;;; Completing folders 202;;; 203 204(defmacro mew-complete-proto-folder (sym &rest body) 205 ;; (declare (indent 1)) 206 `(if mew-input-folder-search-direction 207 (mew-input-folder-search-complete) 208 (mew-draft-set-completion-ignore-case mew-complete-folder-ignore-case) 209 (let ((,sym (mew-delete-backward-char)) 210 (completion-ignore-case mew-complete-folder-ignore-case) 211 (mew-inherit-complete-folder t)) 212 ,@body))) 213 214(put 'mew-complete-proto-folder 'lisp-indent-function 1) 215 216(defun mew-complete-local-folder () 217 "Local folder complete function." 218 (interactive) 219 (mew-complete-proto-folder word 220 (if (null word) 221 (mew-complete-window-show (list "+")) 222 (if (and (mew-folder-absolutep word) 223 (not (mew-draft-or-header-p))) 224 (mew-complete word (mew-complete-directory-alist word) "directory" nil) 225 (mew-complete word (mew-local-folder-alist) "folder" nil))))) 226 227;; case is specified by mew-inherit-case. 228(defun mew-complete-imap-folder () 229 "IMAP folder complete function." 230 (interactive) 231 (mew-complete-proto-folder word 232 (if (null word) 233 (mew-complete-window-show (list "%")) 234 (mew-complete 235 word 236 (mew-imap-folder-alist mew-inherit-case) ;; ie mew-sinfo-get-case 237 "mailbox" 238 nil)))) 239 240(defun mew-complete-fcc-folder () 241 "Fcc: folder complete function." 242 (interactive) 243 (mew-complete-proto-folder word 244 (if (null word) 245 (mew-complete-window-show (list "+" "%")) 246 (cond 247 ((and (mew-folder-absolutep word) (not (mew-draft-or-header-p))) 248 (mew-complete word (mew-complete-directory-alist word) "directory" nil)) 249 ((mew-folder-imapp word) 250 (mew-complete word (mew-imap-folder-alist (mew-tinfo-get-case)) "mailbox" nil)) 251 (t 252 (mew-complete word (mew-local-folder-alist) "folder" nil)))))) 253 254;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 255;;; 256;;; Completion function for the minibuffer only 257;;; 258 259(defun mew-complete-folder () 260 "Folder complete function." 261 (interactive) 262 (if mew-input-folder-search-direction 263 (mew-input-folder-search-complete) 264 (mew-complete-folder2))) 265 266(defun mew-input-folder-search-complete () 267 (let ((mew-inherit-complete-folder t) 268 keys) 269 (with-current-buffer mew-input-folder-search-buf 270 (save-excursion 271 (goto-char (point-min)) 272 (while (search-forward (or mew-input-folder-search-key "\n") nil t) 273 (setq keys 274 (cons (buffer-substring (progn (beginning-of-line) (point)) 275 (progn (end-of-line) (point))) 276 keys))))) 277 (mew-complete-window-show (nreverse (delete "" keys))) 278 (mew-highlight-folder-comp-search-window))) 279 280(defun mew-complete-folder2 () 281 (let ((word (mew-delete-backward-char nil ", \t\n")) 282 (completion-ignore-case mew-complete-folder-ignore-case) 283 (mew-inherit-complete-folder t) 284 case folder) 285 (cond 286 ((null word) 287 (mew-complete-window-show mew-config-cases2)) 288 ((setq case (mew-case:folder-case word)) 289 (setq folder (mew-case:folder-folder word)) 290 (cond 291 ((mew-folder-localp folder) 292 (mew-complete2 folder (mew-local-folder-alist) case)) 293 ((mew-folder-popp folder) 294 (mew-complete2 folder (mew-pop-folder-alist) case)) 295 ((mew-folder-nntpp folder) 296 (mew-complete2 folder (mew-nntp-folder-alist case) case)) 297 ((mew-folder-imapp folder) 298 (mew-complete2 folder (mew-imap-folder-alist case) case)) 299 ((mew-folder-virtualp folder) 300 (mew-complete 301 word (mew-buffer-list "^\\*" t 'mew-virtual-mode) "folder" nil)) 302 ((string= folder "") 303 (insert word) 304 (mew-complete-window-show 305 (mapcar (lambda (x) (concat case ":" x)) mew-folder-prefixes))) 306 (t 307 (insert word) 308 (if (window-minibuffer-p (get-buffer-window (current-buffer))) 309 (mew-temp-minibuffer-message " [No matching folder]") 310 (message "No matching folder"))))) 311 (t 312 (cond 313 ((mew-folder-localp word) 314 (mew-complete word (mew-local-folder-alist) "folder" nil)) 315 ((mew-folder-popp word) 316 (mew-complete word (mew-pop-folder-alist) "folder" nil)) 317 ((mew-folder-nntpp word) 318 (mew-complete word (mew-nntp-folder-alist nil) "newsgroup" nil)) 319 ((mew-folder-imapp word) 320 (mew-complete word (mew-imap-folder-alist nil) "mailbox" nil)) 321 ((mew-folder-virtualp word) 322 (mew-complete 323 word (mew-buffer-list "^\\*" t 'mew-virtual-mode) "folder" nil)) 324 ((mew-folder-absolutep word) 325 (mew-complete word (mew-complete-directory-alist word) "directory" nil)) 326 (t 327 (mew-complete 328 word 329 (mapcar (lambda (x) (list (concat x ":"))) mew-config-cases) 330 "case" 331 nil))))))) 332 333(defun mew-complete-case () 334 "Complete function for cases." 335 (interactive) 336 (let ((word (or (mew-delete-backward-char) "")) 337 (completion-ignore-case mew-complete-case-ignore-case)) 338 (mew-complete 339 word 340 (mapcar 'list mew-config-cases) 341 "case" 342 nil))) 343 344;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 345;;; 346;;; Circular completion function for a draft only 347;;; 348 349(defun mew-draft-circular-comp () 350 "Switch function for circular complete functions." 351 (interactive) 352 (let ((func (mew-draft-on-value-p mew-field-circular-completion-switch))) 353 (if func 354 (funcall func) 355 (message "No circular completion here")))) 356 357(defun mew-circular-complete-domain () 358 "Circular completion of domains for To:, Cc:, etc. 359If the @ character does not exist, the first value of 360mew-mail-domain-list is inserted. If exists, the next value of 361mew-mail-domain-list concerned with the string between @ and 362the cursor is inserted." 363 (interactive) 364 (mew-draft-set-completion-ignore-case 365 mew-circular-complete-domain-ignore-case) 366 (let ((word (mew-delete-backward-char "@")) 367 (completion-ignore-case mew-circular-complete-domain-ignore-case)) 368 (cond 369 ((eq word nil) ;; @ does not exist. 370 (if (null mew-mail-domain-list) 371 (message "For domain circular completion, set mew-mail-domain-list") 372 (insert "@") 373 (insert (car mew-mail-domain-list)) 374 (mew-complete-window-delete))) 375 ((eq word t) ;; just after @ 376 (if (null mew-mail-domain-list) 377 (message "For domain circular completion, set mew-mail-domain-list") 378 (insert (car mew-mail-domain-list)) 379 (mew-complete-window-delete))) 380 (t 381 ;; cannot use mew-get-next since completion is necessary sometime. 382 (mew-complete 383 word 384 (mew-slide-pair mew-mail-domain-list) 385 "domain" 386 t))))) ;; use cdr 387 388(defun mew-circular-complete (msg sym &optional minibuf) ;; xxx msg 389 "General circular complete function." 390 (interactive) 391 (let ((name (symbol-name sym)) 392 (val (symbol-value sym)) 393 str alst match) 394 (if (null val) 395 (mew-temp-minibuffer-message (format "[Set '%s']" name)) 396 (setq str (mew-delete-value nil minibuf)) 397 (setq alst (mew-slide-pair val)) 398 (if (or (null str) ;; draft 399 (and (string= str "") (null (assoc "" alst)))) ;; minibuf 400 (insert (car val)) 401 (setq match (assoc str alst)) 402 (if match 403 (insert (cdr match)) 404 (insert str) 405 (mew-temp-minibuffer-message (format "[No matching %s]" msg))))))) 406 407(defun mew-circular-complete-from () 408 "Circular complete function for From:." 409 (interactive) 410 (mew-circular-complete "from" 'mew-from-list)) 411 412;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 413;;; 414;;; Circular completion function for the minibuffer only 415;;; 416 417(defvar mew-circular-complete-function nil) 418 419(defun mew-circular-complete-switch () 420 "A switch function to call a function defined to 421'mew-circular-complete-function'." 422 (interactive) 423 (if mew-circular-complete-function (funcall mew-circular-complete-function))) 424 425(defun mew-circular-complete-pick-pattern () 426 (mew-circular-complete "pick pattern" 'mew-pick-pattern-list 'minibuf)) 427 428(defun mew-circular-complete-case () 429 (mew-circular-complete "case" 'mew-config-cases 'minibuf)) 430 431(defun mew-circular-complete-case: () 432 (cond 433 ((eq mew-input-complete-function 'mew-complete-local-folder) 434 ()) 435 (mew-input-folder-search-direction 436 (mew-input-folder-self-insert)) 437 (t 438 (let (cases oldcase newcase insert-:) 439 (save-excursion 440 (if (search-backward "," nil t) 441 (forward-char 1) 442 (beginning-of-line)) 443 (if (looking-at mew-regex-case2) 444 (progn 445 (setq oldcase (mew-match-string 1)) 446 (delete-region (match-beginning 1) (match-end 1))) 447 (setq oldcase mew-case-default) 448 (setq insert-: t)) 449 (if (setq cases (member oldcase mew-config-cases)) 450 (if (> (length cases) 1) 451 (setq newcase (nth 1 cases)) 452 (setq newcase (car mew-config-cases))) 453 (setq newcase mew-case-default)) 454 (if (string= newcase mew-case-default) 455 (unless insert-: (delete-char 1)) 456 (insert newcase) 457 (if insert-: (insert ":")))) 458 (if (or (= (point) (mew-minibuf-point-min)) 459 (save-excursion 460 (forward-char -1) 461 (looking-at "[:,]"))) 462 (if (search-forward "," nil t) 463 (forward-char -1) 464 (goto-char (point-max)))))))) 465 466;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 467;;; 468;;; Expansion for a draft only 469;;; 470 471(defun mew-draft-expand () 472 "Switch function for expand functions." 473 (interactive) 474 (let ((func (mew-draft-on-value-p mew-field-expansion-switch))) 475 (if func 476 (funcall func) 477 (message "No expansion here")))) 478 479(defun mew-expand-address () 480 "Address expansion function for To:, Cc:, etc. 481'user@domain' will be expands 'name <user@domain>' if 482the name exists." 483 (interactive) 484 (let ((word (mew-delete-backward-char)) func name) 485 (if (null word) 486 (message "No address here") 487 (setq func (mew-addrbook-func mew-addrbook-for-address-expansion)) 488 (if (null func) 489 (insert word) 490 (setq name (funcall func word)) 491 (insert (if name (format "%s <%s>" name word) word)))))) 492 493;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 494;;; 495;;; Other completion stuff 496;;; 497 498;; dummy 499(defvar mew-ext-host "") 500(defvar mew-ext-user "") 501 502(defun mew-complete-rfile () 503 "Complete a remote file." 504 (interactive) 505 (let* ((path-file (mew-delete-file-name)) 506 (path (car path-file)) 507 (file (cdr path-file)) 508 rpath) 509 (setq rpath (format "/%s@%s:%s" mew-ext-user mew-ext-host path)) 510 (mew-complete 511 file 512 rpath 513 "remote file" 514 nil 515 'mew-ext-file-name-completion 516 'mew-ext-file-name-all-completions))) 517 518(defun mew-complete-pick-pattern () 519 "Complete pick patterns." 520 (interactive) 521 (let* ((pat (mew-delete-pattern)) 522 (clist (append '("(" "!") 523 mew-pick-field-list 524 (mapcar 'car mew-pick-macro-alist)))) 525 (if (null pat) 526 (mew-complete-window-show clist) 527 (mew-complete 528 pat 529 (mapcar 'list clist) 530 "pick pattern" 531 nil)))) 532 533(defun mew-complete-sort-key () 534 "Complete sort keys." 535 (interactive) 536 (let* ((word (mew-delete-line)) 537 field alist) 538 (if (string-match ":" word) 539 (progn 540 ;; If WORD contains ':', change alist for completion. 541 (setq field (car (mew-split word ?:))) 542 (setq alist 543 (mapcar (lambda (str) (list (concat field ":" str))) mew-sort-modes))) 544 ;; Otherwise, alist is mew-sort-key-alist itself. 545 (setq alist mew-sort-key-alist)) 546 (mew-complete word alist "sort key" nil))) 547 548(defun mew-complete-directory-alist (dir) 549 "Return alist of directories for completion." 550 (let ((odir dir) odir1 dirs1 sub dirs2) 551 (setq dir (mew-file-chase-links (expand-file-name dir))) 552 (when (file-directory-p dir) 553 (setq odir1 (file-name-as-directory odir)) 554 (setq dirs1 (mapcar 555 (lambda (x) 556 (when (file-directory-p (expand-file-name x dir)) 557 (cons (concat odir1 (file-name-as-directory x)) x))) 558 (directory-files dir nil "[^.]" 'nosort)))) 559 (setq sub (file-name-nondirectory dir)) 560 (setq odir (file-name-directory odir)) 561 (setq dir (file-name-directory dir)) 562 (when (and dir odir sub (not (string= sub ""))) 563 (setq odir (file-name-as-directory odir)) 564 (setq dirs2 (mapcar 565 (lambda (x) 566 (when (file-directory-p (expand-file-name x dir)) 567 (cons (concat odir (file-name-as-directory x)) x))) 568 (directory-files dir nil 569 (concat "^" (regexp-quote sub)) 570 'nosort)))) 571 (sort (delq nil (append dirs2 dirs1)) 572 (lambda (x y) (string< (car x) (car y)))))) 573 574;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 575;;; 576;;; Hart function for completions 577;;; 578 579(defalias 'mew-complete-hit 'assoc) 580 581(defun mew-complete-get (key alist) 582 (cdr (mew-complete-hit key alist))) 583 584(defun mew-complete (WORD ALIST MSG EXPAND-CHAR &optional TRY ALL GET HIT) 585 (let* ((ftry (or TRY 'try-completion)) 586 (fall (or ALL 'all-completions)) 587 (fget (or GET 'mew-complete-get)) 588 (fhit (or HIT 'mew-complete-hit)) 589 (cmp (funcall ftry WORD ALIST)) 590 (all (funcall fall WORD ALIST)) 591 (len (length WORD)) 592 subkey) 593 (cond 594 ;; already completed 595 ((eq cmp t) 596 (if EXPAND-CHAR ;; may be "t" 597 (insert (funcall fget WORD ALIST)) ;; use cdr 598 (insert WORD)) ;; use car 599 (mew-complete-window-delete)) 600 ;; EXPAND 601 ((and (mew-characterp EXPAND-CHAR) 602 (char-equal (aref WORD (1- len)) EXPAND-CHAR) 603 (setq subkey (substring WORD 0 (1- len))) 604 (funcall fhit subkey ALIST)) 605 (insert (funcall fget subkey ALIST)) ;; use cdr 606 (mew-complete-window-delete)) 607 ;; just one candidate 608 ((= 1 (length all)) 609 (insert cmp) 610 (if (window-minibuffer-p (get-buffer-window (current-buffer))) 611 (mew-temp-minibuffer-message " [Sole completion]") 612 (message "Sole completion")) 613 (mew-complete-window-delete)) 614 ;; two or more candidates 615 ((stringp cmp) ;; (length all) > 1 616 (insert cmp) 617 (mew-complete-window-show all) 618 (if (and (mew-characterp EXPAND-CHAR) (funcall fhit cmp ALIST)) 619 (message 620 "To expand '%s', type '%c' then '%s'" 621 cmp EXPAND-CHAR 622 (substitute-command-keys 623 "\\<mew-draft-header-map>\\[mew-draft-header-comp]")))) 624 ;; no candidate 625 (t 626 (insert WORD) 627 ;;(mew-complete-window-delete) 628 (if (window-minibuffer-p (get-buffer-window (current-buffer))) 629 (mew-temp-minibuffer-message (format " [No matching %s]" MSG)) 630 (message "No matching %s" MSG)))))) 631 632(defun mew-complete2-insert (case word) 633 (if case 634 (insert case ":" word) 635 (insert word))) 636 637(defun mew-complete2 (word alist case) 638 (let* ((cmp (try-completion word alist)) 639 (all (all-completions word alist))) 640 (cond 641 ;; already completed 642 ((eq cmp t) 643 (mew-complete2-insert case word) ;; use car 644 (mew-complete-window-delete)) 645 ;; just one candidate 646 ((= 1 (length all)) 647 (mew-complete2-insert case cmp) 648 (if (window-minibuffer-p (get-buffer-window (current-buffer))) 649 (mew-temp-minibuffer-message " [Sole completion]") 650 (message "Sole completion")) 651 (mew-complete-window-delete)) 652 ;; two or more candidates 653 ((stringp cmp) ;; (length all) > 1 654 (mew-complete2-insert case cmp) 655 (mew-complete-window-show all)) 656 ;; no candidate 657 (t 658 (mew-complete2-insert case word) 659 ;;(mew-complete-window-delete) 660 (if (window-minibuffer-p (get-buffer-window (current-buffer))) 661 (mew-temp-minibuffer-message " [No matching folder]") 662 (message "No matching folder")))))) 663 664;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 665;;; 666;;; Minibuf magic 667;;; 668 669(defun mew-temp-minibuffer-message (m) 670 (let ((savemax (point-max))) 671 (save-excursion 672 (goto-char (point-max)) 673 (insert m)) 674 (let ((inhibit-quit t)) 675 (mew-let-user-read) 676 (delete-region savemax (point-max)) 677 (when quit-flag 678 (setq quit-flag nil) 679 (setq unread-command-events (list 7)))))) ;; 7 == C-g 680 681;; 682;; Extracting completion key 683;; 684 685(defun mew-delete-backward-char (&optional here sep) 686 "Delete appropriate preceding word and return it." 687 (interactive) 688 (let ((case-fold-search t) 689 (start nil) 690 (end (point)) 691 (regex (concat "[^" (or sep mew-address-separator) "]"))) 692 (save-excursion 693 (while (and (not (bobp)) 694 (string-match regex (mew-buffer-substring (1- (point)) (point)))) 695 (forward-char -1)) 696 (if (and here (not (re-search-forward (regexp-quote here) end t))) 697 nil ;; "here" does not exist. 698 (setq start (point)) 699 (if (= start end) 700 (if here t nil) ;; just after "here", just after separator 701 (prog1 702 (mew-buffer-substring start end) 703 (delete-region start end))))))) 704 705(defun mew-delete-file-name () 706 (if (search-backward mew-path-separator nil t) 707 (forward-char 1) 708 (beginning-of-line)) 709 (prog1 710 (cons (mew-buffer-substring (mew-minibuf-point-min) (point)) 711 (mew-buffer-substring (point) (point-max))) 712 (delete-region (point) (point-max)))) 713 714(defun mew-delete-pattern () 715 (let ((pos (point))) 716 (if (re-search-backward " \\|(\\|&\\||\\|!\\|," nil t) 717 (forward-char 1) 718 (beginning-of-line)) 719 (prog1 720 (mew-buffer-substring (point) pos) 721 (delete-region (point) pos)))) 722 723(defun mew-delete-line () 724 (let ((pos (point))) 725 (beginning-of-line) 726 (prog1 727 (mew-buffer-substring (point) pos) 728 (delete-region (point) pos)))) 729 730(defun mew-delete-key () 731 (let ((pos (point))) 732 (beginning-of-line) 733 (prog1 734 (mew-capitalize (mew-buffer-substring (point) pos)) 735 (delete-region (point) pos)))) 736 737(defun mew-delete-value (&optional here minibuf) 738 (beginning-of-line) 739 (if minibuf 740 (let ((start (point)) ret) 741 (end-of-line) 742 (setq ret (mew-buffer-substring start (point))) 743 (delete-region start (point)) 744 ret) 745 (when (looking-at "[^:]+:") 746 (goto-char (match-end 0)) 747 (if (looking-at "[ \t]") 748 (forward-char 1) 749 (insert " ")) 750 (if (eolp) 751 nil 752 (let ((start (point)) ret) 753 (end-of-line) 754 (if (and here (re-search-backward (regexp-quote here) start t)) 755 (progn 756 (setq start (1+ (point))) 757 (end-of-line))) 758 (setq ret (mew-buffer-substring start (point))) 759 (delete-region start (point)) 760 ret))))) 761 762;; 763;; Making alist 764;; 765 766(defun mew-slide-pair (x) 767 (let ((len (length x)) 768 (ret nil) 769 (first (car x))) 770 (cond 771 ((= len 0) nil) 772 ((= len 1) (list (cons first first))) 773 (t 774 (while (cdr x) 775 (setq ret (cons (cons (nth 0 x) (nth 1 x)) ret)) 776 (setq x (cdr x))) 777 (setq ret (cons (cons (car x) first) ret)) 778 (nreverse ret))))) 779 780(provide 'mew-complete) 781 782;;; Copyright Notice: 783 784;; Copyright (C) 1997-2015 Mew developing team. 785;; All rights reserved. 786 787;; Redistribution and use in source and binary forms, with or without 788;; modification, are permitted provided that the following conditions 789;; are met: 790;; 791;; 1. Redistributions of source code must retain the above copyright 792;; notice, this list of conditions and the following disclaimer. 793;; 2. Redistributions in binary form must reproduce the above copyright 794;; notice, this list of conditions and the following disclaimer in the 795;; documentation and/or other materials provided with the distribution. 796;; 3. Neither the name of the team nor the names of its contributors 797;; may be used to endorse or promote products derived from this software 798;; without specific prior written permission. 799;; 800;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND 801;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 802;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 803;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE 804;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 805;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 806;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 807;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 808;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 809;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 810;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 811 812;;; mew-complete.el ends here 813 814;; Local Variables: 815;; no-native-compile: t 816;; End: 817